uuagc-0.9.52.2/0000755000000000000000000000000013433540502011240 5ustar0000000000000000uuagc-0.9.52.2/Setup.hs0000644000000000000000000000243313433540502012676 0ustar0000000000000000-- Note: to bootstrap uuagc with a commandline uuagc, -- pass the -DEXTERNAL_UUAGC to GHC -- when building setup.hs. This can be accomplished using -- cabal install with --ghc-options="-DEXTERNAL_UUAGC". -- -- When this option is used, a cabal flag will be set so -- that the Haskell sources will be regenerated from -- the attribute grammar sources -- -- Note: it would be nicer if this behavior could be enabled -- with a configure flag. However, a compiled Setup.hs is -- required in order to perform 'configure', so configure -- flags are regarded too late in the process. -- Also note that this Setup.hs has conditional package -- requirements depending on what code is used. {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-# LANGUAGE CPP #-} module Main where #ifdef EXTERNAL_UUAGC import System.Environment (getArgs) import Distribution.Simple (defaultMainWithHooksArgs) import Distribution.Simple.UUAGC (uuagcUserHook) main :: IO () main = args >>= defaultMainWithHooksArgs uuagcUserHook args :: IO [String] args = do as <- getArgs let addFlags | "configure" `elem` as = ("--flags=bootstrap_external" :) | otherwise = id return (addFlags as) #else import Distribution.Simple (defaultMain, defaultMainWithHooksArgs) main :: IO () main = defaultMain #endif uuagc-0.9.52.2/LICENSE0000644000000000000000000000270213433540502012246 0ustar0000000000000000All 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 the Universiteit Utrecht 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 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 UNIVERSITEIT UTRECHT 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. uuagc-0.9.52.2/README0000644000000000000000000000104513433540502012120 0ustar0000000000000000To install UUAG, use cabal in combination with Setup.hs By default, "cabal install" will install UUAGC from the included Haskell sources. To build from the AG sources using an existing uuagc installation, use: cabal install --ghc-options="-DEXTERNAL_UUAGC" Note: to produce a source release, you'll need to use the Setup.hs because cabal-install at the time is not able to do this in combination with the cabal plugin: -- cabal clean # remove possible junk ghc --make Setup.hs -o setup ./setup configure --user ./setup build ./setup sdist -- uuagc-0.9.52.2/uuagc_options0000644000000000000000000001204013433540502014037 0ustar0000000000000000file: "src-ag/AbstractSyntax.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell file: "src-ag/ConcreteSyntax.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell file: "src-ag/ErrorMessages.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell file: "src-ag/HsToken.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell file: "src-ag/Code.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell file: "src-ag/Expression.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell file: "src-ag/Patterns.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell file: "src-ag/Interfaces.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell file: "src-ag/CodeSyntax.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell file: "src-ag/DeclBlocks.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell file: "src-ag/VisageSyntax.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell file: "src-ag/VisagePatterns.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell file: "src-ag/ExecutionPlan.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell file: "src-ag/LOAG/Order.ag" options: module, pretty, checkParseHaskell, self, wrappers, signatures, catas, semfuns, genlinepragmas, kennedywarren file: "src-ag/LOAG/Prepare.ag" options: module, pretty, checkParseHaskell, self, wrappers, signatures, catas, semfuns, genlinepragmas, kennedywarren file: "src-ag/LOAG/Rep.ag" options: module, pretty, checkParseHaskell, self, datarecords, data, optimize file: "src-ag/Macro.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell file: "src-ag/Desugar.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren, visit file: "src-ag/DefaultRules.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren, visit file: "src-ag/GenerateCode.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/PrintCleanCode.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/PrintOcamlCode.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/PrintCode.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/PrintVisitCode.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/PrintErrorMessages.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/SemHsTokens.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/Transform.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/Order.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/KWOrder.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/ResolveLocals.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/AbstractSyntaxDump.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/CodeSyntaxDump.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/Visage.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/TfmToVisage.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/AG2AspectAG.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/ExecutionPlan2Hs.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/ExecutionPlan2Clean.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/ExecutionPlan2Caml.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren file: "src-ag/InterfacesRules.lag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren uuagc-0.9.52.2/uuagc.cabal0000644000000000000000000000612113433540502013330 0ustar0000000000000000cabal-version: >= 1.8 build-type: Custom name: uuagc version: 0.9.52.2 license: BSD3 license-file: LICENSE maintainer: Jeroen Bransen homepage: http://www.cs.uu.nl/wiki/HUT/WebHome description: Generates Haskell files from an attribute grammar specification synopsis: Attribute Grammar System of Universiteit Utrecht category: Development stability: Stable copyright: Universiteit Utrecht author: Software Technology at Universiteit Utrecht bug-reports: hut-developers@cs.uu.nl tested-with: GHC >= 6.12 extra-source-files: README extra-source-files: uuagc_options extra-source-files: src-ag/DistChildAttr.ag extra-source-files: src-ag/ExecutionPlanCommon.ag extra-source-files: src-ag/ExecutionPlanPre.ag extra-source-files: src-ag/LOAG/Prepare.ag -- This flag will be set by Setup.hs, use -- cabal configure --ghc-options="-DEXTERNAL_UUAGC" flag bootstrap_external description: Use an external uuagc executable for bootstrapping default: False manual: True flag with-loag description: Use MiniSat as external SAT-solver to schedule all Linear Ordered AGs default: False manual: True executable uuagc build-depends: uuagc-cabal >= 1.0.2.0 build-depends: base >= 4, base < 5 -- Self dependency, depend on library below build-depends: uuagc main-is: Main.hs hs-source-dirs: src-main library build-depends: uuagc-cabal >= 1.0.2.0 build-depends: base >= 4, base < 5, ghc-prim >= 0.2.0.0 if flag(with-loag) build-depends: minisat cpp-options: -DWITH_LOAG build-depends: containers >= 0.3, directory >= 1.0.1.1, array >= 0.3.0.1 build-depends: uulib >= 0.9.14, mtl >= 1.1.1.1 build-depends: haskell-src-exts >= 1.11.1 build-depends: filepath >= 1.1.0.4 hs-source-dirs: src, src-version, src-ag, src-options if !flag(bootstrap_external) hs-source-dirs: src-generated exposed-modules: UU.UUAGC, UU.UUAGC.Version extensions: TypeSynonymInstances, MultiParamTypeClasses other-modules: Paths_uuagc , Ag , CommonTypes , GrammarInfo , HsTokenScanner , Options , PPUtil , Parser , Pretty , Scanner , SequentialComputation , SequentialTypes , TokenDef , Version , AbstractSyntax , AbstractSyntaxDump , Code , CodeSyntax , CodeSyntaxDump , ConcreteSyntax , DeclBlocks , DefaultRules , Desugar , ErrorMessages , Expression , GenerateCode , HsToken , Interfaces , InterfacesRules , Order , Patterns , PrintCode , PrintOcamlCode , PrintCleanCode , PrintVisitCode , PrintErrorMessages , SemHsTokens , Transform , ATermWrite , ATermAbstractSyntax , TfmToVisage , Visage , VisageSyntax , VisagePatterns , AG2AspectAG , Macro , RhsCheck , ResolveLocals , Knuth1 , KennedyWarren , KWOrder , ExecutionPlan , ExecutionPlan2Hs , ExecutionPlan2Clean , ExecutionPlan2Caml , LOAG.AOAG , LOAG.Chordal , LOAG.Common , LOAG.Graphs , LOAG.Order , LOAG.Rep if flag(with-loag) other-modules: LOAG.Solver.MiniSat, LOAG.Optimise uuagc-0.9.52.2/src-generated/0000755000000000000000000000000013433540502013763 5ustar0000000000000000uuagc-0.9.52.2/src-generated/ExecutionPlan2Caml.hs0000644000000000000000000125365313433540502017773 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module ExecutionPlan2Caml where {-# LINE 2 "src-ag/HsToken.ag" #-} import CommonTypes import UU.Scanner.Position(Pos) {-# LINE 10 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 2 "src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken {-# LINE 16 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 23 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 2 "src-ag/ExecutionPlan.ag" #-} -- VisitSyntax.ag imports import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import CommonTypes import ErrorMessages import qualified Data.Set as Set import Data.Set(Set) import qualified Data.Map as Map import Data.Map(Map) {-# LINE 37 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 32 "src-ag/ExecutionPlan2Caml.ag" #-} import ExecutionPlan import Pretty import PPUtil import Options import Data.Monoid(mappend,mempty) import Data.Maybe import Data.Graph import Debug.Trace import System.IO import System.Directory import System.FilePath import UU.Scanner.Position import TokenDef import HsToken import ErrorMessages import Data.Set (Set) import qualified Data.Set as Set import Data.Map (Map) import qualified Data.Map as Map import Data.Sequence(Seq) import qualified Data.Sequence as Seq import Data.Foldable(toList) {-# LINE 65 "dist/build/ExecutionPlan2Caml.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 175 "src-ag/ExecutionPlan2Caml.ag" #-} ppRecordTp :: PP a => [a] -> PP_Doc ppRecordTp es | null es = text "unit" | otherwise = pp_block "{" "}" "; " (map pp es) ppRecordVal :: PP a => [a] -> PP_Doc ppRecordVal es | null es = text "()" | otherwise = pp_block "{" "}" "; " (map pp es) ppFieldsVal :: Bool -> [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)] -> PP_Doc ppFieldsVal record fields | null fields = text "()" | record = ppRecordVal [ r >#< "=" >#< x | (r,x,_,_) <- fields ] | otherwise = pp_block "(" ")" "," [ x | (_,x,_,_) <- fields ] ppFieldsType :: Bool -> Bool -> [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)] -> PP_Doc ppFieldsType record defor fields | null fields = text "unit" | record = ppRecordTp [ r >#< ":" >#< (if defor then d else f) | (r,_,d,f) <- fields ] | otherwise = pp_block "(" ")" "*" [ if defor then d else f | (_,_,d,f) <- fields ] {-# LINE 91 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 288 "src-ag/ExecutionPlan2Caml.ag" #-} ppTp :: Type -> PP_Doc ppTp tp = case tp of Haskell t -> pp t -- ocaml type NT nt tps deforested | nt == _SELF -> pp "?SELF?" | null tps -> ppNontTp nt deforested | otherwise -> pp_parens (ppSpaced (map pp_parens tps) >#< ppNontTp nt deforested) Self -> pp "?SELF?" ppNontTp :: NontermIdent -> Bool -> PP_Doc ppNontTp nt True = pp "t_" >|< pp nt ppNontTp nt False = pp nt -- multiple type parameters go into a tuple ppTypeParams :: PP a => [a] -> PP_Doc ppTypeParams [] = empty ppTypeParams [x] = pp x ppTypeParams xs = pp_block "(" ")" "," (map pp xs) {-# LINE 113 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 361 "src-ag/ExecutionPlan2Caml.ag" #-} -- convention for nonterminals to module names modName :: NontermIdent -> PP_Doc modName nt = pp "M_" >|< pp nt ppFunDecl :: Bool -> PP_Doc -> [(PP_Doc,PP_Doc)] -> PP_Doc -> PP_Doc -> PP_Doc ppFunDecl gensigs nm args resSig expr = body where body = nm >#< ppSpaced (map arg args) >#< ppRes >#< "=" >-< indent 2 expr arg (arg,tp) = ppArg gensigs arg tp ppRes | gensigs = ":" >#< resSig | otherwise = empty ppArg :: Bool -> PP_Doc -> PP_Doc -> PP_Doc ppArg gensigs arg tp | gensigs = pp_parens (arg >#< ":" >#< tp) | otherwise = arg {-# LINE 135 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 428 "src-ag/ExecutionPlan2Caml.ag" #-} type VisitStateState = (VisitIdentifier,StateIdentifier, StateIdentifier) {-# LINE 139 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 464 "src-ag/ExecutionPlan2Caml.ag" #-} -- -- conventions -- -- type of the state of a node: a closure containing the children states and attributes, -- with code of type 'type_nt_sem' that represents the subsequent visits to successor states. type_nt_state nt st = "s_" >|< nt >|< "_" >|< st -- type of a visit to a node (the initial, and when in a given state) -- an instance of this type is called the "semantics" type_nt_sem_top nt = "t_" >|< nt type_nt_sem nt st = type_nt_sem_top nt >|< "_s" >|< st -- type of a caller (contains visit selection + inputs + continuation) type_caller nt st = "c_" >|< nt >|< "_s" >|< st -- names of records nm_attach nt = "attach_">|< nt nm_invoke nt st = "inv_" >|< nt >|< "_s" >|< st -- name of the type variable representing the result type of the continuation cont_tvar = text "'cont__" -- order states in reverse topological order so that successor states are -- earlier in the resulting list. orderStates :: StateIdentifier -> [VisitStateState] -> [StateIdentifier] orderStates initial edges = res where source = Map.singleton initial Set.empty -- ensures that the initial state is in graph even when there are no edges targets = [ Map.singleton t Set.empty | (_,_,t) <- edges ] deps = [ Map.singleton f (Set.singleton t) | (_,f,t) <- edges ] mp = Map.unionsWith Set.union (source : (targets ++ deps)) es = [ (f,f,Set.toList ts) | (f,ts) <- Map.toList mp ] cps = stronglyConnComp es res = flattenSCCs cps {-# LINE 179 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 521 "src-ag/ExecutionPlan2Caml.ag" #-} type_caller_visit nt v = "c_" >|< nt >|< "_v" >|< v con_visit nt v = "C_" >|< nt >|< "_v" >|< v -- field names nm_inh nt v = "inh_" >|< nt >|< "_v" >|< v nm_cont nt v = "cont_" >|< nt >|< "_v" >|< v {-# LINE 189 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 567 "src-ag/ExecutionPlan2Caml.ag" #-} -- more naming conventions nm_inarg nm nt v = "i_" >|< nm >|< "_" >|< nt >|< "_v" >|< v nm_outarg nm nt v = "o_" >|< nm >|< "_" >|< nt >|< "_v" >|< v nm_outarg_cont = nm_outarg "_cont" conNmTVisit nt vId = "t_" >|< nt >|< "_v" >|< vId conNmTVisitIn nt vId = "t_" >|< nt >|< "_vIn" >|< vId conNmTVisitOut nt vId = "t_" >|< nt >|< "_vOut" >|< vId -- todo: remove ppMonadType ppMonadType :: Options -> PP_Doc ppMonadType opts | parallelInvoke opts = text "IO" | otherwise = text "Identity" {-# LINE 207 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 780 "src-ag/ExecutionPlan2Caml.ag" #-} nm_visit v = "__v" >|< v nm_k st = "__k" >|< st nm_st st = "__st" >|< st mklets :: (PP b, PP c) => [b] -> c -> PP_Doc mklets defs body = res where ppLet def = "let" >#< def >#< "in" res = vlist (map ppLet defs) >-< body {-# LINE 219 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 822 "src-ag/ExecutionPlan2Caml.ag" #-} resultValName :: String resultValName = "__result_" nextStName :: String nextStName = "__st_" {-# LINE 228 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 963 "src-ag/ExecutionPlan2Caml.ag" #-} stname :: Identifier -> Int -> String stname child st = "_" ++ getName child ++ "X" ++ show st -- should actually return some conversion info compatibleAttach :: VisitKind -> NontermIdent -> Options -> Bool compatibleAttach _ _ _ = True {-# LINE 238 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 1030 "src-ag/ExecutionPlan2Caml.ag" #-} dummyPat :: Options -> Bool -> PP_Doc dummyPat opts noArgs | not noArgs = empty | strictDummyToken opts = text "()" | otherwise = text "(_ : unit)" dummyArg :: Options -> Bool -> PP_Doc dummyArg opts noArgs | not noArgs = empty | otherwise = text "()" dummyType :: Options -> Bool -> PP_Doc dummyType opts noArgs | not noArgs = empty | otherwise = text "unit" {-# LINE 257 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 1106 "src-ag/ExecutionPlan2Caml.ag" #-} data NonLocalAttr = AttrInh Identifier Identifier | AttrSyn Identifier Identifier deriving Show mkNonLocalAttr :: Bool -> Identifier -> Identifier -> NonLocalAttr mkNonLocalAttr True = AttrInh -- True: inherited attr mkNonLocalAttr False = AttrSyn lookupAttrType :: NonLocalAttr -> Map Identifier Attributes -> Map Identifier Attributes -> Map Identifier Type -> Maybe PP_Doc lookupAttrType (AttrInh child name) inhs _ = lookupType child name inhs lookupAttrType (AttrSyn child name) _ syns = lookupType child name syns -- Note: if the child takes type parameters, the type of an attribute of this child may refer to these parameters. This means that -- the actual type of the attribute needs to have its type parameters substituted with the actual type argument of the child. -- However, for now we simply decide to return Nothing in this case, which skips the type annotation. lookupType :: Identifier -> Identifier -> Map Identifier Attributes -> Map Identifier Type -> Maybe PP_Doc lookupType child name attrMp childMp | noParameters childTp = Just ppDoc | otherwise = Nothing where attrTp = Map.findWithDefault (error "lookupType: the attribute is not in the attrs of the child") name childAttrs childAttrs = Map.findWithDefault (error "lookupType: the attributes of the nonterm are not in the map") nonterm attrMp nonterm = extractNonterminal childTp childTp = Map.findWithDefault (error ("lookupType: the child " ++ show child ++ "is not in the appropriate map")) child childMp ppDoc = ppTp attrTp noParameters :: Type -> Bool noParameters (Haskell _) = True noParameters (NT _ args _) = null args {-# LINE 290 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 1204 "src-ag/ExecutionPlan2Caml.ag" #-} contNm = text "__cont_" inpsNm = text "__inps_" -- a `compatibleKind` b means: can kind b be invoked from a compatibleKind :: VisitKind -> VisitKind -> Bool compatibleKind _ _ = True compatibleRule :: VisitKind -> Bool -> Bool compatibleRule (VisitPure _) False = False compatibleRule _ _ = True {-# LINE 304 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 1229 "src-ag/ExecutionPlan2Caml.ag" #-} unionWithSum = Map.unionWith (+) {-# LINE 309 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 1252 "src-ag/ExecutionPlan2Caml.ag" #-} uwSetUnion :: (Ord a, Ord b) => Map a (Set b) -> Map a (Set b) -> Map a (Set b) uwSetUnion = Map.unionWith Set.union uwMapUnion :: (Ord a, Ord b) => Map a (Map b c) -> Map a (Map b c) -> Map a (Map b c) uwMapUnion = Map.unionWith Map.union {-# LINE 318 "dist/build/ExecutionPlan2Caml.hs" #-} -- EChild ------------------------------------------------------ -- wrapper data Inh_EChild = Inh_EChild { allInitStates_Inh_EChild :: (Map NontermIdent Int), con_Inh_EChild :: (ConstructorIdent), mainFile_Inh_EChild :: (String), mainName_Inh_EChild :: (String), nt_Inh_EChild :: (NontermIdent), options_Inh_EChild :: (Options) } data Syn_EChild = Syn_EChild { argnamesw_Syn_EChild :: ( PP_Doc ), childTypes_Syn_EChild :: (Map Identifier Type), childintros_Syn_EChild :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), sigs_Syn_EChild :: ([(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]), terminaldefs_Syn_EChild :: (Set String) } {-# INLINABLE wrap_EChild #-} wrap_EChild :: T_EChild -> Inh_EChild -> (Syn_EChild ) wrap_EChild (T_EChild act) (Inh_EChild _lhsIallInitStates _lhsIcon _lhsImainFile _lhsImainName _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_EChild_vIn1 _lhsIallInitStates _lhsIcon _lhsImainFile _lhsImainName _lhsInt _lhsIoptions (T_EChild_vOut1 _lhsOargnamesw _lhsOchildTypes _lhsOchildintros _lhsOsigs _lhsOterminaldefs) <- return (inv_EChild_s2 sem arg1) return (Syn_EChild _lhsOargnamesw _lhsOchildTypes _lhsOchildintros _lhsOsigs _lhsOterminaldefs) ) -- cata {-# NOINLINE sem_EChild #-} sem_EChild :: EChild -> T_EChild sem_EChild ( EChild name_ tp_ kind_ hasAround_ merges_ isMerged_ ) = sem_EChild_EChild name_ tp_ kind_ hasAround_ merges_ isMerged_ sem_EChild ( ETerm name_ tp_ ) = sem_EChild_ETerm name_ tp_ -- semantic domain newtype T_EChild = T_EChild { attach_T_EChild :: Identity (T_EChild_s2 ) } newtype T_EChild_s2 = C_EChild_s2 { inv_EChild_s2 :: (T_EChild_v1 ) } data T_EChild_s3 = C_EChild_s3 type T_EChild_v1 = (T_EChild_vIn1 ) -> (T_EChild_vOut1 ) data T_EChild_vIn1 = T_EChild_vIn1 (Map NontermIdent Int) (ConstructorIdent) (String) (String) (NontermIdent) (Options) data T_EChild_vOut1 = T_EChild_vOut1 ( PP_Doc ) (Map Identifier Type) (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) ([(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) (Set String) {-# NOINLINE sem_EChild_EChild #-} sem_EChild_EChild :: (Identifier) -> (Type) -> (ChildKind) -> (Bool) -> (Maybe [Identifier]) -> (Bool) -> T_EChild sem_EChild_EChild arg_name_ arg_tp_ arg_kind_ arg_hasAround_ _ _ = T_EChild (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_EChild_v1 v1 = \ (T_EChild_vIn1 _lhsIallInitStates _lhsIcon _lhsImainFile _lhsImainName _lhsInt _lhsIoptions) -> ( let _tpDocFor = rule0 arg_tp_ _tpDocDefor = rule1 arg_tp_ _fieldNm = rule2 _lhsIcon _lhsInt arg_name_ _childNm = rule3 arg_name_ _field = rule4 _childNm _fieldNm _tpDocDefor _tpDocFor _lhsOsigs :: [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)] _lhsOsigs = rule5 _field arg_kind_ _lhsOargnamesw :: PP_Doc _lhsOargnamesw = rule6 _lhsIoptions _nt arg_kind_ arg_name_ _lhsOchildintros :: Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) _lhsOchildintros = rule7 _introcode arg_name_ _isDefor = rule8 arg_tp_ _valcode = rule9 _isDefor _lhsIoptions _nt arg_kind_ arg_name_ _aroundcode = rule10 _lhsIoptions arg_hasAround_ arg_name_ _introcode = rule11 _aroundcode _initSt _isDefor _lhsIoptions _nt _valcode arg_hasAround_ arg_kind_ arg_name_ _nt = rule12 arg_tp_ _lhsOchildTypes :: Map Identifier Type _lhsOchildTypes = rule13 arg_name_ arg_tp_ _initSt = rule14 _lhsIallInitStates _nt _lhsOterminaldefs :: Set String _lhsOterminaldefs = rule15 () __result_ = T_EChild_vOut1 _lhsOargnamesw _lhsOchildTypes _lhsOchildintros _lhsOsigs _lhsOterminaldefs in __result_ ) in C_EChild_s2 v1 {-# INLINE rule0 #-} {-# LINE 278 "src-ag/ExecutionPlan2Caml.ag" #-} rule0 = \ tp_ -> {-# LINE 278 "src-ag/ExecutionPlan2Caml.ag" #-} ppTp $ removeDeforested tp_ {-# LINE 386 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule1 #-} {-# LINE 279 "src-ag/ExecutionPlan2Caml.ag" #-} rule1 = \ tp_ -> {-# LINE 279 "src-ag/ExecutionPlan2Caml.ag" #-} ppTp $ forceDeforested tp_ {-# LINE 392 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule2 #-} {-# LINE 280 "src-ag/ExecutionPlan2Caml.ag" #-} rule2 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) name_ -> {-# LINE 280 "src-ag/ExecutionPlan2Caml.ag" #-} text $ recordFieldname _lhsInt _lhsIcon name_ {-# LINE 398 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule3 #-} {-# LINE 281 "src-ag/ExecutionPlan2Caml.ag" #-} rule3 = \ name_ -> {-# LINE 281 "src-ag/ExecutionPlan2Caml.ag" #-} text (fieldname name_) {-# LINE 404 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule4 #-} {-# LINE 282 "src-ag/ExecutionPlan2Caml.ag" #-} rule4 = \ _childNm _fieldNm _tpDocDefor _tpDocFor -> {-# LINE 282 "src-ag/ExecutionPlan2Caml.ag" #-} (_fieldNm , _childNm , _tpDocDefor , _tpDocFor ) {-# LINE 410 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule5 #-} {-# LINE 283 "src-ag/ExecutionPlan2Caml.ag" #-} rule5 = \ _field kind_ -> {-# LINE 283 "src-ag/ExecutionPlan2Caml.ag" #-} case kind_ of ChildAttr -> [] _ -> [_field ] {-# LINE 418 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule6 #-} {-# LINE 396 "src-ag/ExecutionPlan2Caml.ag" #-} rule6 = \ ((_lhsIoptions) :: Options) _nt kind_ name_ -> {-# LINE 396 "src-ag/ExecutionPlan2Caml.ag" #-} case kind_ of ChildSyntax -> "(" >#< prefix _lhsIoptions >|< _nt >#< name_ >|< "_" >#< ")" ChildAttr -> empty ChildReplace tp -> "(" >#< prefix _lhsIoptions >|< extractNonterminal tp >#< name_ >|< "_" >#< ")" {-# LINE 427 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule7 #-} {-# LINE 923 "src-ag/ExecutionPlan2Caml.ag" #-} rule7 = \ _introcode name_ -> {-# LINE 923 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton name_ _introcode {-# LINE 433 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule8 #-} {-# LINE 924 "src-ag/ExecutionPlan2Caml.ag" #-} rule8 = \ tp_ -> {-# LINE 924 "src-ag/ExecutionPlan2Caml.ag" #-} case tp_ of NT _ _ defor -> defor _ -> False {-# LINE 441 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule9 #-} {-# LINE 927 "src-ag/ExecutionPlan2Caml.ag" #-} rule9 = \ _isDefor ((_lhsIoptions) :: Options) _nt kind_ name_ -> {-# LINE 927 "src-ag/ExecutionPlan2Caml.ag" #-} case kind_ of ChildSyntax -> name_ >|< "_" ChildAttr -> let head | not _isDefor = if lateHigherOrderBinding _lhsIoptions then lateSemNtLabel _nt >#< lhsname _lhsIoptions True idLateBindingAttr else prefix _lhsIoptions >|< _nt | otherwise = empty in pp_parens (head >#< instname name_) ChildReplace _ -> pp_parens (instname name_ >#< name_ >|< "_") {-# LINE 456 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule10 #-} {-# LINE 938 "src-ag/ExecutionPlan2Caml.ag" #-} rule10 = \ ((_lhsIoptions) :: Options) hasAround_ name_ -> {-# LINE 938 "src-ag/ExecutionPlan2Caml.ag" #-} if hasAround_ then locname _lhsIoptions name_ >|< "_around" else empty {-# LINE 464 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule11 #-} {-# LINE 941 "src-ag/ExecutionPlan2Caml.ag" #-} rule11 = \ _aroundcode _initSt _isDefor ((_lhsIoptions) :: Options) _nt _valcode hasAround_ kind_ name_ -> {-# LINE 941 "src-ag/ExecutionPlan2Caml.ag" #-} \kind -> let pat = text $ stname name_ _initSt attach = pp_parens (_aroundcode >#< _valcode ) >|< "." >|< nm_attach _nt >#< "()" decl = pat >#< "=" >#< attach in if compatibleAttach kind _nt _lhsIoptions then Right ( "let" >#< decl >#< "in" , Set.singleton (stname name_ _initSt ) , case kind_ of ChildAttr -> Map.insert (instname name_) Nothing $ ( if _isDefor || not (lateHigherOrderBinding _lhsIoptions) then id else Map.insert (lhsname _lhsIoptions True idLateBindingAttr) (Just $ AttrInh _LHS idLateBindingAttr) ) $ ( if hasAround_ then Map.insert (locname _lhsIoptions (name_) ++ "_around") Nothing else id ) $ Map.empty ChildReplace _ -> Map.singleton (instname name_) Nothing ChildSyntax -> Map.empty ) else Left $ IncompatibleAttachKind name_ kind {-# LINE 489 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule12 #-} {-# LINE 961 "src-ag/ExecutionPlan2Caml.ag" #-} rule12 = \ tp_ -> {-# LINE 961 "src-ag/ExecutionPlan2Caml.ag" #-} extractNonterminal tp_ {-# LINE 495 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule13 #-} {-# LINE 1424 "src-ag/ExecutionPlan2Caml.ag" #-} rule13 = \ name_ tp_ -> {-# LINE 1424 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton name_ tp_ {-# LINE 501 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule14 #-} {-# LINE 1468 "src-ag/ExecutionPlan2Caml.ag" #-} rule14 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) _nt -> {-# LINE 1468 "src-ag/ExecutionPlan2Caml.ag" #-} Map.findWithDefault (error "nonterminal not in allInitStates map") _nt _lhsIallInitStates {-# LINE 507 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule15 #-} rule15 = \ (_ :: ()) -> Set.empty {-# NOINLINE sem_EChild_ETerm #-} sem_EChild_ETerm :: (Identifier) -> (Type) -> T_EChild sem_EChild_ETerm arg_name_ arg_tp_ = T_EChild (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_EChild_v1 v1 = \ (T_EChild_vIn1 _lhsIallInitStates _lhsIcon _lhsImainFile _lhsImainName _lhsInt _lhsIoptions) -> ( let _tpDocFor = rule16 arg_tp_ _tpDocDefor = rule17 arg_tp_ _fieldNm = rule18 _lhsIcon _lhsInt arg_name_ _childNm = rule19 arg_name_ _field = rule20 _childNm _fieldNm _tpDocDefor _tpDocFor _lhsOsigs :: [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)] _lhsOsigs = rule21 _field _lhsOargnamesw :: PP_Doc _lhsOargnamesw = rule22 arg_name_ _lhsOchildintros :: Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) _lhsOchildintros = rule23 arg_name_ _lhsOterminaldefs :: Set String _lhsOterminaldefs = rule24 arg_name_ _lhsOchildTypes :: Map Identifier Type _lhsOchildTypes = rule25 arg_name_ arg_tp_ __result_ = T_EChild_vOut1 _lhsOargnamesw _lhsOchildTypes _lhsOchildintros _lhsOsigs _lhsOterminaldefs in __result_ ) in C_EChild_s2 v1 {-# INLINE rule16 #-} {-# LINE 278 "src-ag/ExecutionPlan2Caml.ag" #-} rule16 = \ tp_ -> {-# LINE 278 "src-ag/ExecutionPlan2Caml.ag" #-} ppTp $ removeDeforested tp_ {-# LINE 541 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule17 #-} {-# LINE 279 "src-ag/ExecutionPlan2Caml.ag" #-} rule17 = \ tp_ -> {-# LINE 279 "src-ag/ExecutionPlan2Caml.ag" #-} ppTp $ forceDeforested tp_ {-# LINE 547 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule18 #-} {-# LINE 280 "src-ag/ExecutionPlan2Caml.ag" #-} rule18 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) name_ -> {-# LINE 280 "src-ag/ExecutionPlan2Caml.ag" #-} text $ recordFieldname _lhsInt _lhsIcon name_ {-# LINE 553 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule19 #-} {-# LINE 281 "src-ag/ExecutionPlan2Caml.ag" #-} rule19 = \ name_ -> {-# LINE 281 "src-ag/ExecutionPlan2Caml.ag" #-} text (fieldname name_) {-# LINE 559 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule20 #-} {-# LINE 282 "src-ag/ExecutionPlan2Caml.ag" #-} rule20 = \ _childNm _fieldNm _tpDocDefor _tpDocFor -> {-# LINE 282 "src-ag/ExecutionPlan2Caml.ag" #-} (_fieldNm , _childNm , _tpDocDefor , _tpDocFor ) {-# LINE 565 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule21 #-} {-# LINE 286 "src-ag/ExecutionPlan2Caml.ag" #-} rule21 = \ _field -> {-# LINE 286 "src-ag/ExecutionPlan2Caml.ag" #-} [_field ] {-# LINE 571 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule22 #-} {-# LINE 400 "src-ag/ExecutionPlan2Caml.ag" #-} rule22 = \ name_ -> {-# LINE 400 "src-ag/ExecutionPlan2Caml.ag" #-} text $ fieldname name_ {-# LINE 577 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule23 #-} {-# LINE 922 "src-ag/ExecutionPlan2Caml.ag" #-} rule23 = \ name_ -> {-# LINE 922 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton name_ (\_ -> Right (empty, Set.empty, Map.empty)) {-# LINE 583 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule24 #-} {-# LINE 1266 "src-ag/ExecutionPlan2Caml.ag" #-} rule24 = \ name_ -> {-# LINE 1266 "src-ag/ExecutionPlan2Caml.ag" #-} Set.singleton $ fieldname name_ {-# LINE 589 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule25 #-} {-# LINE 1424 "src-ag/ExecutionPlan2Caml.ag" #-} rule25 = \ name_ tp_ -> {-# LINE 1424 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton name_ tp_ {-# LINE 595 "dist/build/ExecutionPlan2Caml.hs"#-} -- EChildren --------------------------------------------------- -- wrapper data Inh_EChildren = Inh_EChildren { allInitStates_Inh_EChildren :: (Map NontermIdent Int), con_Inh_EChildren :: (ConstructorIdent), mainFile_Inh_EChildren :: (String), mainName_Inh_EChildren :: (String), nt_Inh_EChildren :: (NontermIdent), options_Inh_EChildren :: (Options) } data Syn_EChildren = Syn_EChildren { argnamesw_Syn_EChildren :: ([PP_Doc]), childTypes_Syn_EChildren :: (Map Identifier Type), childintros_Syn_EChildren :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), sigs_Syn_EChildren :: ([(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]), terminaldefs_Syn_EChildren :: (Set String) } {-# INLINABLE wrap_EChildren #-} wrap_EChildren :: T_EChildren -> Inh_EChildren -> (Syn_EChildren ) wrap_EChildren (T_EChildren act) (Inh_EChildren _lhsIallInitStates _lhsIcon _lhsImainFile _lhsImainName _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_EChildren_vIn4 _lhsIallInitStates _lhsIcon _lhsImainFile _lhsImainName _lhsInt _lhsIoptions (T_EChildren_vOut4 _lhsOargnamesw _lhsOchildTypes _lhsOchildintros _lhsOsigs _lhsOterminaldefs) <- return (inv_EChildren_s5 sem arg4) return (Syn_EChildren _lhsOargnamesw _lhsOchildTypes _lhsOchildintros _lhsOsigs _lhsOterminaldefs) ) -- cata {-# NOINLINE sem_EChildren #-} sem_EChildren :: EChildren -> T_EChildren sem_EChildren list = Prelude.foldr sem_EChildren_Cons sem_EChildren_Nil (Prelude.map sem_EChild list) -- semantic domain newtype T_EChildren = T_EChildren { attach_T_EChildren :: Identity (T_EChildren_s5 ) } newtype T_EChildren_s5 = C_EChildren_s5 { inv_EChildren_s5 :: (T_EChildren_v4 ) } data T_EChildren_s6 = C_EChildren_s6 type T_EChildren_v4 = (T_EChildren_vIn4 ) -> (T_EChildren_vOut4 ) data T_EChildren_vIn4 = T_EChildren_vIn4 (Map NontermIdent Int) (ConstructorIdent) (String) (String) (NontermIdent) (Options) data T_EChildren_vOut4 = T_EChildren_vOut4 ([PP_Doc]) (Map Identifier Type) (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) ([(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) (Set String) {-# NOINLINE sem_EChildren_Cons #-} sem_EChildren_Cons :: T_EChild -> T_EChildren -> T_EChildren sem_EChildren_Cons arg_hd_ arg_tl_ = T_EChildren (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_EChildren_v4 v4 = \ (T_EChildren_vIn4 _lhsIallInitStates _lhsIcon _lhsImainFile _lhsImainName _lhsInt _lhsIoptions) -> ( let _hdX2 = Control.Monad.Identity.runIdentity (attach_T_EChild (arg_hd_)) _tlX5 = Control.Monad.Identity.runIdentity (attach_T_EChildren (arg_tl_)) (T_EChild_vOut1 _hdIargnamesw _hdIchildTypes _hdIchildintros _hdIsigs _hdIterminaldefs) = inv_EChild_s2 _hdX2 (T_EChild_vIn1 _hdOallInitStates _hdOcon _hdOmainFile _hdOmainName _hdOnt _hdOoptions) (T_EChildren_vOut4 _tlIargnamesw _tlIchildTypes _tlIchildintros _tlIsigs _tlIterminaldefs) = inv_EChildren_s5 _tlX5 (T_EChildren_vIn4 _tlOallInitStates _tlOcon _tlOmainFile _tlOmainName _tlOnt _tlOoptions) _lhsOargnamesw :: [PP_Doc] _lhsOargnamesw = rule26 _hdIargnamesw _tlIargnamesw _lhsOchildTypes :: Map Identifier Type _lhsOchildTypes = rule27 _hdIchildTypes _tlIchildTypes _lhsOchildintros :: Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) _lhsOchildintros = rule28 _hdIchildintros _tlIchildintros _lhsOsigs :: [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)] _lhsOsigs = rule29 _hdIsigs _tlIsigs _lhsOterminaldefs :: Set String _lhsOterminaldefs = rule30 _hdIterminaldefs _tlIterminaldefs _hdOallInitStates = rule31 _lhsIallInitStates _hdOcon = rule32 _lhsIcon _hdOmainFile = rule33 _lhsImainFile _hdOmainName = rule34 _lhsImainName _hdOnt = rule35 _lhsInt _hdOoptions = rule36 _lhsIoptions _tlOallInitStates = rule37 _lhsIallInitStates _tlOcon = rule38 _lhsIcon _tlOmainFile = rule39 _lhsImainFile _tlOmainName = rule40 _lhsImainName _tlOnt = rule41 _lhsInt _tlOoptions = rule42 _lhsIoptions __result_ = T_EChildren_vOut4 _lhsOargnamesw _lhsOchildTypes _lhsOchildintros _lhsOsigs _lhsOterminaldefs in __result_ ) in C_EChildren_s5 v4 {-# INLINE rule26 #-} rule26 = \ ((_hdIargnamesw) :: PP_Doc ) ((_tlIargnamesw) :: [PP_Doc]) -> _hdIargnamesw : _tlIargnamesw {-# INLINE rule27 #-} rule27 = \ ((_hdIchildTypes) :: Map Identifier Type) ((_tlIchildTypes) :: Map Identifier Type) -> _hdIchildTypes `mappend` _tlIchildTypes {-# INLINE rule28 #-} rule28 = \ ((_hdIchildintros) :: Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) ((_tlIchildintros) :: Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _hdIchildintros `Map.union` _tlIchildintros {-# INLINE rule29 #-} rule29 = \ ((_hdIsigs) :: [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) ((_tlIsigs) :: [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) -> _hdIsigs ++ _tlIsigs {-# INLINE rule30 #-} rule30 = \ ((_hdIterminaldefs) :: Set String) ((_tlIterminaldefs) :: Set String) -> _hdIterminaldefs `Set.union` _tlIterminaldefs {-# INLINE rule31 #-} rule31 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule32 #-} rule32 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule33 #-} rule33 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule34 #-} rule34 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule35 #-} rule35 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule36 #-} rule36 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule37 #-} rule37 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule38 #-} rule38 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule39 #-} rule39 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule40 #-} rule40 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule41 #-} rule41 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule42 #-} rule42 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_EChildren_Nil #-} sem_EChildren_Nil :: T_EChildren sem_EChildren_Nil = T_EChildren (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_EChildren_v4 v4 = \ (T_EChildren_vIn4 _lhsIallInitStates _lhsIcon _lhsImainFile _lhsImainName _lhsInt _lhsIoptions) -> ( let _lhsOargnamesw :: [PP_Doc] _lhsOargnamesw = rule43 () _lhsOchildTypes :: Map Identifier Type _lhsOchildTypes = rule44 () _lhsOchildintros :: Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) _lhsOchildintros = rule45 () _lhsOsigs :: [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)] _lhsOsigs = rule46 () _lhsOterminaldefs :: Set String _lhsOterminaldefs = rule47 () __result_ = T_EChildren_vOut4 _lhsOargnamesw _lhsOchildTypes _lhsOchildintros _lhsOsigs _lhsOterminaldefs in __result_ ) in C_EChildren_s5 v4 {-# INLINE rule43 #-} rule43 = \ (_ :: ()) -> [] {-# INLINE rule44 #-} rule44 = \ (_ :: ()) -> mempty {-# INLINE rule45 #-} rule45 = \ (_ :: ()) -> Map.empty {-# INLINE rule46 #-} rule46 = \ (_ :: ()) -> [] {-# INLINE rule47 #-} rule47 = \ (_ :: ()) -> Set.empty -- ENonterminal ------------------------------------------------ -- wrapper data Inh_ENonterminal = Inh_ENonterminal { allFromToStates_Inh_ENonterminal :: (Map VisitIdentifier (Int,Int)), allInitStates_Inh_ENonterminal :: (Map NontermIdent Int), allVisitKinds_Inh_ENonterminal :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_ENonterminal :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)), avisitdefs_Inh_ENonterminal :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_ENonterminal :: (Map VisitIdentifier (Set Identifier)), inhmap_Inh_ENonterminal :: (Map NontermIdent Attributes), localAttrTypes_Inh_ENonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))), mainFile_Inh_ENonterminal :: (String), mainName_Inh_ENonterminal :: (String), options_Inh_ENonterminal :: (Options), synmap_Inh_ENonterminal :: (Map NontermIdent Attributes), typeSyns_Inh_ENonterminal :: (TypeSyns), wrappers_Inh_ENonterminal :: (Set NontermIdent) } data Syn_ENonterminal = Syn_ENonterminal { childvisit_Syn_ENonterminal :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)), code_Syn_ENonterminal :: (PP_Doc), datas_Syn_ENonterminal :: (PP_Doc), errors_Syn_ENonterminal :: (Seq Error), fromToStates_Syn_ENonterminal :: (Map VisitIdentifier (Int,Int)), initStates_Syn_ENonterminal :: (Map NontermIdent Int), modules_Syn_ENonterminal :: (PP_Doc), semFunBndDefs_Syn_ENonterminal :: (Seq PP_Doc), semFunBndTps_Syn_ENonterminal :: (Seq PP_Doc), visitKinds_Syn_ENonterminal :: (Map VisitIdentifier VisitKind), visitdefs_Syn_ENonterminal :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_ENonterminal :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_ENonterminal #-} wrap_ENonterminal :: T_ENonterminal -> Inh_ENonterminal -> (Syn_ENonterminal ) wrap_ENonterminal (T_ENonterminal act) (Inh_ENonterminal _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_ENonterminal_vIn7 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers (T_ENonterminal_vOut7 _lhsOchildvisit _lhsOcode _lhsOdatas _lhsOerrors _lhsOfromToStates _lhsOinitStates _lhsOmodules _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_ENonterminal_s8 sem arg7) return (Syn_ENonterminal _lhsOchildvisit _lhsOcode _lhsOdatas _lhsOerrors _lhsOfromToStates _lhsOinitStates _lhsOmodules _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# INLINE sem_ENonterminal #-} sem_ENonterminal :: ENonterminal -> T_ENonterminal sem_ENonterminal ( ENonterminal nt_ params_ classCtxs_ initial_ initialv_ nextVisits_ prevVisits_ prods_ recursive_ hoInfo_ ) = sem_ENonterminal_ENonterminal nt_ params_ classCtxs_ initial_ initialv_ nextVisits_ prevVisits_ ( sem_EProductions prods_ ) recursive_ hoInfo_ -- semantic domain newtype T_ENonterminal = T_ENonterminal { attach_T_ENonterminal :: Identity (T_ENonterminal_s8 ) } newtype T_ENonterminal_s8 = C_ENonterminal_s8 { inv_ENonterminal_s8 :: (T_ENonterminal_v7 ) } data T_ENonterminal_s9 = C_ENonterminal_s9 type T_ENonterminal_v7 = (T_ENonterminal_vIn7 ) -> (T_ENonterminal_vOut7 ) data T_ENonterminal_vIn7 = T_ENonterminal_vIn7 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Int) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map NontermIdent Attributes) (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) (String) (String) (Options) (Map NontermIdent Attributes) (TypeSyns) (Set NontermIdent) data T_ENonterminal_vOut7 = T_ENonterminal_vOut7 (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) (PP_Doc) (PP_Doc) (Seq Error) (Map VisitIdentifier (Int,Int)) (Map NontermIdent Int) (PP_Doc) (Seq PP_Doc) (Seq PP_Doc) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_ENonterminal_ENonterminal #-} sem_ENonterminal_ENonterminal :: (NontermIdent) -> ([Identifier]) -> (ClassContext) -> (StateIdentifier) -> ([VisitIdentifier]) -> (Map StateIdentifier StateCtx) -> (Map StateIdentifier StateCtx) -> T_EProductions -> (Bool) -> (HigherOrderInfo) -> T_ENonterminal sem_ENonterminal_ENonterminal arg_nt_ arg_params_ _ arg_initial_ arg_initialv_ arg_nextVisits_ arg_prevVisits_ arg_prods_ _ _ = T_ENonterminal (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_ENonterminal_v7 v7 = \ (T_ENonterminal_vIn7 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers) -> ( let _prodsX17 = Control.Monad.Identity.runIdentity (attach_T_EProductions (arg_prods_)) (T_EProductions_vOut16 _prodsIallvisits _prodsIchildvisit _prodsIcount _prodsIdatatype _prodsIdatatype_call _prodsIdatatype_con _prodsIerrors _prodsIfromToStates _prodsIsemFunBndDefs _prodsIsemFunBndTps _prodsIsem_nt _prodsIsem_prod _prodsIt_visits _prodsIvisitKinds _prodsIvisitdefs _prodsIvisituses) = inv_EProductions_s17 _prodsX17 (T_EProductions_vIn16 _prodsOallFromToStates _prodsOallInhmap _prodsOallInitStates _prodsOallSynmap _prodsOallVisitKinds _prodsOallchildvisit _prodsOallstates _prodsOavisitdefs _prodsOavisituses _prodsOinhmap _prodsOinitial _prodsOlocalAttrTypes _prodsOmainFile _prodsOmainName _prodsOnextVisits _prodsOnt _prodsOntType _prodsOoptions _prodsOparams _prodsOprevVisits _prodsOrename _prodsOsynmap) _prodsOrename = rule48 _lhsIoptions _prodsOnt = rule49 arg_nt_ _prodsOparams = rule50 arg_params_ _lhsOdatas :: PP_Doc _lhsOdatas = rule51 _c_states _datatypeNt _datatypeProds _hasWrapper _lhsIoptions _prodsIt_visits _t_init _t_states _wr_inh _wr_syn arg_nt_ _lhsOcode :: PP_Doc _lhsOcode = rule52 _datatypeCon _hasWrapper _lhsIoptions _prodsIsem_prod _sem_nt _wrapper arg_nt_ _lhsOmodules :: PP_Doc _lhsOmodules = rule53 _moduleDecl _hasWrapper = rule54 _lhsIwrappers arg_nt_ _t_params = rule55 arg_params_ _aliasPre = rule56 _t_params arg_nt_ _aliasMod = rule57 _aliasPre arg_nt_ _datatypeNt = rule58 _aliasMod _aliasPre _lhsItypeSyns _prodsIdatatype _prodsIdatatype_call _t_params arg_nt_ _datatypeCon = rule59 _lhsItypeSyns _prodsIdatatype_con arg_nt_ _moduleDecl = rule60 _lhsItypeSyns arg_nt_ _datatypeProds = rule61 _prodsIdatatype _fsemname = rule62 _lhsIoptions _semname = rule63 _fsemname arg_nt_ _frecarg = rule64 _fsemname _sem_param_tp = rule65 _t_params arg_nt_ _sem_res_tp = rule66 _t_params _t_type _sem_tp = rule67 _sem_param_tp _sem_res_tp _o_sigs = rule68 _lhsIoptions _sem_nt_body = rule69 _prodsIsem_nt _sem_nt = rule70 _frecarg _fsemname _lhsItypeSyns _o_sigs _sem_nt_body _sem_param_tp _sem_res_tp _semname arg_nt_ (Just _prodsOinhmap) = rule71 _lhsIinhmap arg_nt_ (Just _prodsOsynmap) = rule72 _lhsIsynmap arg_nt_ _prodsOallInhmap = rule73 _lhsIinhmap _prodsOallSynmap = rule74 _lhsIsynmap _allstates = rule75 _prodsIallvisits arg_initial_ _stvisits = rule76 _prodsIallvisits _t_type = rule77 arg_nt_ _t_c_params = rule78 arg_params_ _t_init = rule79 _t_params _t_type arg_initial_ arg_nt_ _t_states = rule80 _allstates _t_c_params _t_params arg_nextVisits_ arg_nt_ _c_states = rule81 _allstates _prodsIallvisits _t_c_params arg_nextVisits_ arg_nt_ _wr_inh = rule82 _genwrap _wr_inhs1 _wr_syn = rule83 _genwrap _wr_syns _genwrap = rule84 _t_params arg_nt_ _inhAttrs = rule85 _lhsIinhmap arg_nt_ _wr_inhs = rule86 _inhAttrs _wr_filter _wr_inhs1 = rule87 _inhAttrs _wr_filter = rule88 _lhsIoptions _wr_syns = rule89 _lhsIsynmap arg_nt_ _wrapname = rule90 arg_nt_ _inhname = rule91 arg_nt_ _synname = rule92 arg_nt_ _firstVisitInfo = rule93 arg_initial_ arg_nextVisits_ _wrapArgSemTp = rule94 _t_params _t_type _wrapArgInhTp = rule95 _inhname _t_params _wrapArgPats = rule96 _lhsIoptions _wr_inhs1 arg_nt_ _wrapResTp = rule97 _synname _t_params _wrapper = rule98 _o_sigs _wrapArgInhTp _wrapArgPats _wrapArgSemTp _wrapResTp _wrapname _wrapperPreamble _wrapperPreamble = rule99 _lhsImainName _lhsIoptions _wrapperBody _wrapperBody = rule100 _firstVisitInfo _lhsIoptions _wr_inhs _wr_syns arg_initial_ arg_initialv_ arg_nt_ _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule101 _prodsIsemFunBndDefs _semFunBndDef _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule102 _prodsIsemFunBndTps _semFunBndTp _semFunBndDef = rule103 _semFunBndNm _semname _semFunBndTp = rule104 _semFunBndNm _sem_tp _semFunBndNm = rule105 arg_nt_ _prodsOinitial = rule106 arg_initial_ _prodsOallstates = rule107 _allstates _prodsOnextVisits = rule108 arg_nextVisits_ _prodsOprevVisits = rule109 arg_prevVisits_ _prodsOlocalAttrTypes = rule110 _lhsIlocalAttrTypes arg_nt_ _lhsOinitStates :: Map NontermIdent Int _lhsOinitStates = rule111 arg_initial_ arg_nt_ _ntType = rule112 arg_nt_ arg_params_ _lhsOchildvisit :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) _lhsOchildvisit = rule113 _prodsIchildvisit _lhsOerrors :: Seq Error _lhsOerrors = rule114 _prodsIerrors _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule115 _prodsIfromToStates _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule116 _prodsIvisitKinds _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule117 _prodsIvisitdefs _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule118 _prodsIvisituses _prodsOallFromToStates = rule119 _lhsIallFromToStates _prodsOallInitStates = rule120 _lhsIallInitStates _prodsOallVisitKinds = rule121 _lhsIallVisitKinds _prodsOallchildvisit = rule122 _lhsIallchildvisit _prodsOavisitdefs = rule123 _lhsIavisitdefs _prodsOavisituses = rule124 _lhsIavisituses _prodsOmainFile = rule125 _lhsImainFile _prodsOmainName = rule126 _lhsImainName _prodsOntType = rule127 _ntType _prodsOoptions = rule128 _lhsIoptions __result_ = T_ENonterminal_vOut7 _lhsOchildvisit _lhsOcode _lhsOdatas _lhsOerrors _lhsOfromToStates _lhsOinitStates _lhsOmodules _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_ENonterminal_s8 v7 {-# INLINE rule48 #-} {-# LINE 78 "src-ag/ExecutionPlan2Caml.ag" #-} rule48 = \ ((_lhsIoptions) :: Options) -> {-# LINE 78 "src-ag/ExecutionPlan2Caml.ag" #-} rename _lhsIoptions {-# LINE 890 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule49 #-} {-# LINE 86 "src-ag/ExecutionPlan2Caml.ag" #-} rule49 = \ nt_ -> {-# LINE 86 "src-ag/ExecutionPlan2Caml.ag" #-} nt_ {-# LINE 896 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule50 #-} {-# LINE 96 "src-ag/ExecutionPlan2Caml.ag" #-} rule50 = \ params_ -> {-# LINE 96 "src-ag/ExecutionPlan2Caml.ag" #-} params_ {-# LINE 902 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule51 #-} {-# LINE 115 "src-ag/ExecutionPlan2Caml.ag" #-} rule51 = \ _c_states _datatypeNt _datatypeProds _hasWrapper ((_lhsIoptions) :: Options) ((_prodsIt_visits) :: PP_Doc) _t_init _t_states _wr_inh _wr_syn nt_ -> {-# LINE 115 "src-ag/ExecutionPlan2Caml.ag" #-} ( text "" >-< "(* *** " ++ getName nt_ ++ " *** [data] *)") >-< (if dataTypes _lhsIoptions then pp "(* data *)" >-< _datatypeNt >-< _datatypeProds >-< "" else empty) >-< (if _hasWrapper then pp "(* wrapper *)" >-< _wr_inh >-< _wr_syn >-< "" else empty) >-< (if semfuns _lhsIoptions then pp "(* semantic domain *)" >-< _t_init >-< _t_states >-< _c_states >-< _prodsIt_visits >-< "" else empty) {-# LINE 929 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule52 #-} {-# LINE 138 "src-ag/ExecutionPlan2Caml.ag" #-} rule52 = \ _datatypeCon _hasWrapper ((_lhsIoptions) :: Options) ((_prodsIsem_prod) :: PP_Doc) _sem_nt _wrapper nt_ -> {-# LINE 138 "src-ag/ExecutionPlan2Caml.ag" #-} ( text "" >-< "(* *** " ++ getName nt_ ++ " *** [code] *)") >-< (if dataTypes _lhsIoptions then pp "(* constructor functions *)" >-< _datatypeCon else empty) >-< (if _hasWrapper then pp "(* wrapper *)" >-< _wrapper >-< "" else empty) >-< (if folds _lhsIoptions then "(* cata *)" >-< _sem_nt >-< "" else empty) >-< (if semfuns _lhsIoptions then "(* semantic domain *)" >-< _prodsIsem_prod >-< "" else empty) {-# LINE 955 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule53 #-} {-# LINE 163 "src-ag/ExecutionPlan2Caml.ag" #-} rule53 = \ _moduleDecl -> {-# LINE 163 "src-ag/ExecutionPlan2Caml.ag" #-} _moduleDecl {-# LINE 961 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule54 #-} {-# LINE 165 "src-ag/ExecutionPlan2Caml.ag" #-} rule54 = \ ((_lhsIwrappers) :: Set NontermIdent) nt_ -> {-# LINE 165 "src-ag/ExecutionPlan2Caml.ag" #-} nt_ `Set.member` _lhsIwrappers {-# LINE 967 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule55 #-} {-# LINE 216 "src-ag/ExecutionPlan2Caml.ag" #-} rule55 = \ params_ -> {-# LINE 216 "src-ag/ExecutionPlan2Caml.ag" #-} ppTypeParams params_ {-# LINE 973 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule56 #-} {-# LINE 217 "src-ag/ExecutionPlan2Caml.ag" #-} rule56 = \ _t_params nt_ -> {-# LINE 217 "src-ag/ExecutionPlan2Caml.ag" #-} "and" >#< _t_params >#< nt_ >#< "=" {-# LINE 979 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule57 #-} {-# LINE 218 "src-ag/ExecutionPlan2Caml.ag" #-} rule57 = \ _aliasPre nt_ -> {-# LINE 218 "src-ag/ExecutionPlan2Caml.ag" #-} _aliasPre >#< modName nt_ >|< ".t" {-# LINE 985 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule58 #-} {-# LINE 220 "src-ag/ExecutionPlan2Caml.ag" #-} rule58 = \ _aliasMod _aliasPre ((_lhsItypeSyns) :: TypeSyns) ((_prodsIdatatype) :: [PP_Doc]) ((_prodsIdatatype_call) :: [PP_Doc]) _t_params nt_ -> {-# LINE 220 "src-ag/ExecutionPlan2Caml.ag" #-} case lookup nt_ _lhsItypeSyns of Just (List t) -> _aliasPre >#< ppTp t >#< "list" Just (Maybe t) -> _aliasPre >#< ppTp t >#< "option" Just (Tuple ts) -> _aliasPre >#< (pp_block "(" ")" " * " $ map (ppTp . snd) ts) Just (Map k v) -> _aliasMod Just (IntMap t) -> _aliasMod Just (OrdSet t) -> _aliasMod Just IntSet -> _aliasMod _ -> "and" >#< _t_params >#< nt_ >#< "=" >-< ( if null _prodsIdatatype then pp "unit" else indent 2 $ vlist _prodsIdatatype_call ) {-# LINE 1003 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule59 #-} {-# LINE 239 "src-ag/ExecutionPlan2Caml.ag" #-} rule59 = \ ((_lhsItypeSyns) :: TypeSyns) ((_prodsIdatatype_con) :: [PP_Doc]) nt_ -> {-# LINE 239 "src-ag/ExecutionPlan2Caml.ag" #-} case lookup nt_ _lhsItypeSyns of Just _ -> empty Nothing -> vlist _prodsIdatatype_con {-# LINE 1011 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule60 #-} {-# LINE 244 "src-ag/ExecutionPlan2Caml.ag" #-} rule60 = \ ((_lhsItypeSyns) :: TypeSyns) nt_ -> {-# LINE 244 "src-ag/ExecutionPlan2Caml.ag" #-} let ppModule :: PP a => a -> PP_Doc ppModule expr = "module" >#< modName nt_ >#< "=" in case lookup nt_ _lhsItypeSyns of Just (Map k _) -> ppModule ("Map.Make" >#< pp_parens (ppTp k)) Just (IntMap _) -> ppModule ("Map.Make ()") Just (OrdSet t) -> ppModule ("Set.Make" >#< pp_parens (ppTp t)) Just IntSet -> ppModule ("Set.Make (struct type t = int let compare = Pervasives.compare end)") _ -> empty {-# LINE 1024 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule61 #-} {-# LINE 253 "src-ag/ExecutionPlan2Caml.ag" #-} rule61 = \ ((_prodsIdatatype) :: [PP_Doc]) -> {-# LINE 253 "src-ag/ExecutionPlan2Caml.ag" #-} vlist _prodsIdatatype {-# LINE 1030 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule62 #-} {-# LINE 313 "src-ag/ExecutionPlan2Caml.ag" #-} rule62 = \ ((_lhsIoptions) :: Options) -> {-# LINE 313 "src-ag/ExecutionPlan2Caml.ag" #-} \x -> prefix _lhsIoptions ++ show x {-# LINE 1036 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule63 #-} {-# LINE 314 "src-ag/ExecutionPlan2Caml.ag" #-} rule63 = \ _fsemname nt_ -> {-# LINE 314 "src-ag/ExecutionPlan2Caml.ag" #-} _fsemname nt_ {-# LINE 1042 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule64 #-} {-# LINE 315 "src-ag/ExecutionPlan2Caml.ag" #-} rule64 = \ _fsemname -> {-# LINE 315 "src-ag/ExecutionPlan2Caml.ag" #-} \t x -> case t of NT nt _ _ -> pp_parens (_fsemname nt >#< x) _ -> x {-# LINE 1050 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule65 #-} {-# LINE 319 "src-ag/ExecutionPlan2Caml.ag" #-} rule65 = \ _t_params nt_ -> {-# LINE 319 "src-ag/ExecutionPlan2Caml.ag" #-} _t_params >#< nt_ {-# LINE 1056 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule66 #-} {-# LINE 320 "src-ag/ExecutionPlan2Caml.ag" #-} rule66 = \ _t_params _t_type -> {-# LINE 320 "src-ag/ExecutionPlan2Caml.ag" #-} _t_params >#< _t_type {-# LINE 1062 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule67 #-} {-# LINE 321 "src-ag/ExecutionPlan2Caml.ag" #-} rule67 = \ _sem_param_tp _sem_res_tp -> {-# LINE 321 "src-ag/ExecutionPlan2Caml.ag" #-} _sem_param_tp >#< "->" >#< _sem_res_tp {-# LINE 1068 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule68 #-} {-# LINE 323 "src-ag/ExecutionPlan2Caml.ag" #-} rule68 = \ ((_lhsIoptions) :: Options) -> {-# LINE 323 "src-ag/ExecutionPlan2Caml.ag" #-} typeSigs _lhsIoptions {-# LINE 1074 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule69 #-} {-# LINE 324 "src-ag/ExecutionPlan2Caml.ag" #-} rule69 = \ ((_prodsIsem_nt) :: PP_Doc) -> {-# LINE 324 "src-ag/ExecutionPlan2Caml.ag" #-} "match arg with" >-< (indent 2 $ _prodsIsem_nt) {-# LINE 1080 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule70 #-} {-# LINE 325 "src-ag/ExecutionPlan2Caml.ag" #-} rule70 = \ _frecarg _fsemname ((_lhsItypeSyns) :: TypeSyns) _o_sigs _sem_nt_body _sem_param_tp _sem_res_tp _semname nt_ -> {-# LINE 325 "src-ag/ExecutionPlan2Caml.ag" #-} let genSem :: PP a => a -> PP_Doc -> PP_Doc genSem nm body = "and" >#< ppFunDecl _o_sigs (pp _semname ) [(pp nm, _sem_param_tp )] _sem_res_tp body genAlias alts = genSem (pp "arg") (pp "match arg with" >-< (indent 2 $ vlist $ map (pp "|" >#<) alts)) genMap v = let body = modName nt_ >|< ".fold" >#< _semname >|< "_Entry" >#< _semname >|< "_Nil" >#< els els = case v of NT nt _ _ -> pp_parens (modName nt_ >|< ".map" >#< _fsemname nt >#< "m") _ -> pp "m" in genSem "m" body genSet mbNt = let body = "List.fold_right" >#< _semname >|< "_Entry" >#< els (pp_parens (modName nt_ >|< ".elements" >#< "s")) >#< _semname >|< "_Nil" els r = maybe r (\nt -> pp_parens ("List.map" >#< _fsemname nt >#< r)) mbNt in genSem "s" body in case lookup nt_ _lhsItypeSyns of Just (List t) -> let body = "List.fold_right" >#< _semname >|< "_Cons" >#< els >#< _semname >|< "_Nil" els = case t of NT nt _ _ -> pp_parens ("List.map" >#< _fsemname nt >#< "list") _ -> pp "list" in genSem "list" body Just (Tuple ts) -> let pat = pp_parens (ppCommas $ map fst ts) body = _semname >|< "_Tuple" >#< ppSpaced (map (\t -> _frecarg (snd t) (pp $ fst t)) ts) in genSem pat body Just (Map _ v) -> genMap v Just (IntMap v) -> genMap v Just (Maybe t) -> genAlias [ "None" >#< "->" >#< "=" >#< _semname >|< "_Nothing" , "Some" >#< "just" >#< "->" >#< _semname >|< "_Just" >#< _frecarg t (pp "just") ] Just (OrdSet t) -> genSet $ case t of NT nt _ _ -> Just nt _ -> Nothing Just (IntSet) -> genSet Nothing _ -> genSem "arg" _sem_nt_body {-# LINE 1117 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule71 #-} {-# LINE 420 "src-ag/ExecutionPlan2Caml.ag" #-} rule71 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) nt_ -> {-# LINE 420 "src-ag/ExecutionPlan2Caml.ag" #-} Map.lookup nt_ _lhsIinhmap {-# LINE 1123 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule72 #-} {-# LINE 421 "src-ag/ExecutionPlan2Caml.ag" #-} rule72 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) nt_ -> {-# LINE 421 "src-ag/ExecutionPlan2Caml.ag" #-} Map.lookup nt_ _lhsIsynmap {-# LINE 1129 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule73 #-} {-# LINE 422 "src-ag/ExecutionPlan2Caml.ag" #-} rule73 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) -> {-# LINE 422 "src-ag/ExecutionPlan2Caml.ag" #-} _lhsIinhmap {-# LINE 1135 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule74 #-} {-# LINE 423 "src-ag/ExecutionPlan2Caml.ag" #-} rule74 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) -> {-# LINE 423 "src-ag/ExecutionPlan2Caml.ag" #-} _lhsIsynmap {-# LINE 1141 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule75 #-} {-# LINE 444 "src-ag/ExecutionPlan2Caml.ag" #-} rule75 = \ ((_prodsIallvisits) :: [VisitStateState]) initial_ -> {-# LINE 444 "src-ag/ExecutionPlan2Caml.ag" #-} orderStates initial_ _prodsIallvisits {-# LINE 1147 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule76 #-} {-# LINE 445 "src-ag/ExecutionPlan2Caml.ag" #-} rule76 = \ ((_prodsIallvisits) :: [VisitStateState]) -> {-# LINE 445 "src-ag/ExecutionPlan2Caml.ag" #-} \st -> filter (\(v,f,t) -> f == st) _prodsIallvisits {-# LINE 1153 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule77 #-} {-# LINE 446 "src-ag/ExecutionPlan2Caml.ag" #-} rule77 = \ nt_ -> {-# LINE 446 "src-ag/ExecutionPlan2Caml.ag" #-} type_nt_sem_top nt_ {-# LINE 1159 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule78 #-} {-# LINE 447 "src-ag/ExecutionPlan2Caml.ag" #-} rule78 = \ params_ -> {-# LINE 447 "src-ag/ExecutionPlan2Caml.ag" #-} ppTypeParams (cont_tvar : map pp params_) {-# LINE 1165 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule79 #-} {-# LINE 450 "src-ag/ExecutionPlan2Caml.ag" #-} rule79 = \ _t_params _t_type initial_ nt_ -> {-# LINE 450 "src-ag/ExecutionPlan2Caml.ag" #-} "and" >#< _t_params >#< _t_type >#< "=" >#< pp_braces ( nm_attach nt_ >#< ":" >#< "unit" >#< "->" >#< _t_params >#< type_nt_sem nt_ initial_) {-# LINE 1171 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule80 #-} {-# LINE 453 "src-ag/ExecutionPlan2Caml.ag" #-} rule80 = \ _allstates _t_c_params _t_params nextVisits_ nt_ -> {-# LINE 453 "src-ag/ExecutionPlan2Caml.ag" #-} vlist $ map (\st -> let s_st = type_nt_state nt_ st t_st = type_nt_sem nt_ st c_st = type_caller nt_ st nextVisits = Map.findWithDefault ManyVis st nextVisits_ decl = "and" >#< _t_params >#< t_st >#< "=" in case nextVisits of NoneVis -> decl >#< "unit" _ -> decl >#< ppRecordVal [ nm_invoke nt_ st >#< ":" >#< cont_tvar >#< "." >#< _t_c_params >#< c_st >#< "->" >#< cont_tvar ] ) _allstates {-# LINE 1186 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule81 #-} {-# LINE 506 "src-ag/ExecutionPlan2Caml.ag" #-} rule81 = \ _allstates ((_prodsIallvisits) :: [VisitStateState]) _t_c_params nextVisits_ nt_ -> {-# LINE 506 "src-ag/ExecutionPlan2Caml.ag" #-} vlist $ map (\st -> let nt_st = type_nt_state nt_ st c_st = type_caller nt_ st outg = filter (\(_,f,_) -> f == st) _prodsIallvisits nextVisits = Map.findWithDefault ManyVis st nextVisits_ declHead = "and" >#< _t_c_params >#< c_st >#< "=" visitcons = vlist $ map (\(v,_,_) -> "|" >#< con_visit nt_ v >#< "of" >#< _t_c_params >#< type_caller_visit nt_ v ) outg in case nextVisits of NoneVis -> empty OneVis v -> declHead >#< _t_c_params >#< type_caller_visit nt_ v ManyVis -> declHead >-< indent 3 visitcons ) _allstates {-# LINE 1205 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule82 #-} {-# LINE 588 "src-ag/ExecutionPlan2Caml.ag" #-} rule82 = \ _genwrap _wr_inhs1 -> {-# LINE 588 "src-ag/ExecutionPlan2Caml.ag" #-} _genwrap "inh" _wr_inhs1 {-# LINE 1211 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule83 #-} {-# LINE 589 "src-ag/ExecutionPlan2Caml.ag" #-} rule83 = \ _genwrap _wr_syns -> {-# LINE 589 "src-ag/ExecutionPlan2Caml.ag" #-} _genwrap "syn" _wr_syns {-# LINE 1217 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule84 #-} {-# LINE 590 "src-ag/ExecutionPlan2Caml.ag" #-} rule84 = \ _t_params nt_ -> {-# LINE 590 "src-ag/ExecutionPlan2Caml.ag" #-} \nm attrs -> "and" >#< _t_params >#< nm >|< "_" >|< nt_ >#< "=" >#< ppRecordTp [ i >|< "_" >|< nm >|< "_" >|< nt_ >#< ":" >#< ppTp t | (i,t) <- attrs ] {-# LINE 1225 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule85 #-} {-# LINE 594 "src-ag/ExecutionPlan2Caml.ag" #-} rule85 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) nt_ -> {-# LINE 594 "src-ag/ExecutionPlan2Caml.ag" #-} fromJust $ Map.lookup nt_ _lhsIinhmap {-# LINE 1231 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule86 #-} {-# LINE 595 "src-ag/ExecutionPlan2Caml.ag" #-} rule86 = \ _inhAttrs _wr_filter -> {-# LINE 595 "src-ag/ExecutionPlan2Caml.ag" #-} Map.toList $ _wr_filter $ _inhAttrs {-# LINE 1237 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule87 #-} {-# LINE 596 "src-ag/ExecutionPlan2Caml.ag" #-} rule87 = \ _inhAttrs -> {-# LINE 596 "src-ag/ExecutionPlan2Caml.ag" #-} Map.toList _inhAttrs {-# LINE 1243 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule88 #-} {-# LINE 597 "src-ag/ExecutionPlan2Caml.ag" #-} rule88 = \ ((_lhsIoptions) :: Options) -> {-# LINE 597 "src-ag/ExecutionPlan2Caml.ag" #-} if kennedyWarren _lhsIoptions && lateHigherOrderBinding _lhsIoptions then Map.delete idLateBindingAttr else id {-# LINE 1251 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule89 #-} {-# LINE 600 "src-ag/ExecutionPlan2Caml.ag" #-} rule89 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) nt_ -> {-# LINE 600 "src-ag/ExecutionPlan2Caml.ag" #-} Map.toList $ fromJust $ Map.lookup nt_ _lhsIsynmap {-# LINE 1257 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule90 #-} {-# LINE 602 "src-ag/ExecutionPlan2Caml.ag" #-} rule90 = \ nt_ -> {-# LINE 602 "src-ag/ExecutionPlan2Caml.ag" #-} text ("wrap_" ++ show nt_) {-# LINE 1263 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule91 #-} {-# LINE 603 "src-ag/ExecutionPlan2Caml.ag" #-} rule91 = \ nt_ -> {-# LINE 603 "src-ag/ExecutionPlan2Caml.ag" #-} text ("inh_" ++ show nt_) {-# LINE 1269 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule92 #-} {-# LINE 604 "src-ag/ExecutionPlan2Caml.ag" #-} rule92 = \ nt_ -> {-# LINE 604 "src-ag/ExecutionPlan2Caml.ag" #-} text ("syn_" ++ show nt_) {-# LINE 1275 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule93 #-} {-# LINE 605 "src-ag/ExecutionPlan2Caml.ag" #-} rule93 = \ initial_ nextVisits_ -> {-# LINE 605 "src-ag/ExecutionPlan2Caml.ag" #-} Map.findWithDefault ManyVis initial_ nextVisits_ {-# LINE 1281 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule94 #-} {-# LINE 607 "src-ag/ExecutionPlan2Caml.ag" #-} rule94 = \ _t_params _t_type -> {-# LINE 607 "src-ag/ExecutionPlan2Caml.ag" #-} _t_params >#< _t_type {-# LINE 1287 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule95 #-} {-# LINE 608 "src-ag/ExecutionPlan2Caml.ag" #-} rule95 = \ _inhname _t_params -> {-# LINE 608 "src-ag/ExecutionPlan2Caml.ag" #-} _t_params >#< _inhname {-# LINE 1293 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule96 #-} {-# LINE 609 "src-ag/ExecutionPlan2Caml.ag" #-} rule96 = \ ((_lhsIoptions) :: Options) _wr_inhs1 nt_ -> {-# LINE 609 "src-ag/ExecutionPlan2Caml.ag" #-} ppRecordVal [ i >|< "_inh_" >|< nt_ >#< "=" >#< lhsname _lhsIoptions True i | (i,_) <- _wr_inhs1 ] {-# LINE 1299 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule97 #-} {-# LINE 610 "src-ag/ExecutionPlan2Caml.ag" #-} rule97 = \ _synname _t_params -> {-# LINE 610 "src-ag/ExecutionPlan2Caml.ag" #-} _t_params >#< _synname {-# LINE 1305 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule98 #-} {-# LINE 611 "src-ag/ExecutionPlan2Caml.ag" #-} rule98 = \ _o_sigs _wrapArgInhTp _wrapArgPats _wrapArgSemTp _wrapResTp _wrapname _wrapperPreamble -> {-# LINE 611 "src-ag/ExecutionPlan2Caml.ag" #-} "and" >#< ppFunDecl _o_sigs _wrapname [(pp "act", _wrapArgSemTp ), (_wrapArgPats , _wrapArgInhTp )] _wrapResTp _wrapperPreamble {-# LINE 1311 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule99 #-} {-# LINE 613 "src-ag/ExecutionPlan2Caml.ag" #-} rule99 = \ ((_lhsImainName) :: String) ((_lhsIoptions) :: Options) _wrapperBody -> {-# LINE 613 "src-ag/ExecutionPlan2Caml.ag" #-} ( if lateHigherOrderBinding _lhsIoptions then "let" >#< lhsname _lhsIoptions True idLateBindingAttr >#< "=" >#< lateBindingFieldNm _lhsImainName >#< "in" else empty ) >-< _wrapperBody {-# LINE 1321 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule100 #-} {-# LINE 619 "src-ag/ExecutionPlan2Caml.ag" #-} rule100 = \ _firstVisitInfo ((_lhsIoptions) :: Options) _wr_inhs _wr_syns initial_ initialv_ nt_ -> {-# LINE 619 "src-ag/ExecutionPlan2Caml.ag" #-} case initialv_ of [] -> text "{ }" (initv:_) -> let attach = "let" >#< "sem" >#< "=" >#< "act." >|< nm_attach nt_ >#< "()" >#< "in" pat = ppRecordVal [ nm_outarg i nt_ initv >#< "=" >#< lhsname _lhsIoptions False i | (i,_) <- _wr_syns ] bld = ppRecordVal [ i >|< "_syn_" >|< nt_ >#< "=" >#< lhsname _lhsIoptions False i | (i,_) <- _wr_syns ] res = "let res = function" >#< pat >#< "->" >#< bld >#< "in" inps = "let" >#< "inps" >#< "=" >#< ppRecordVal [ nm_inarg i nt_ initv >#< "=" >#< lhsname _lhsIoptions True i | (i,_) <- _wr_inhs ] >#< "in" arg = "let" >#< "arg" >#< "=" >#< argcon >#< argrec >#< "in" argcon = case _firstVisitInfo of ManyVis -> con_visit nt_ initv _ -> empty argrec = ppRecordVal [ nm_inh nt_ initv >#< "=" >#< "inps" , nm_cont nt_ initv >#< "=" >#< "res" ] invoke = "sem." >|< nm_invoke nt_ initial_ >#< "arg" in attach >-< res >-< inps >-< arg >-< invoke {-# LINE 1344 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule101 #-} {-# LINE 648 "src-ag/ExecutionPlan2Caml.ag" #-} rule101 = \ ((_prodsIsemFunBndDefs) :: Seq PP_Doc) _semFunBndDef -> {-# LINE 648 "src-ag/ExecutionPlan2Caml.ag" #-} _semFunBndDef Seq.<| _prodsIsemFunBndDefs {-# LINE 1350 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule102 #-} {-# LINE 649 "src-ag/ExecutionPlan2Caml.ag" #-} rule102 = \ ((_prodsIsemFunBndTps) :: Seq PP_Doc) _semFunBndTp -> {-# LINE 649 "src-ag/ExecutionPlan2Caml.ag" #-} _semFunBndTp Seq.<| _prodsIsemFunBndTps {-# LINE 1356 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule103 #-} {-# LINE 650 "src-ag/ExecutionPlan2Caml.ag" #-} rule103 = \ _semFunBndNm _semname -> {-# LINE 650 "src-ag/ExecutionPlan2Caml.ag" #-} _semFunBndNm >#< "=" >#< _semname {-# LINE 1362 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule104 #-} {-# LINE 651 "src-ag/ExecutionPlan2Caml.ag" #-} rule104 = \ _semFunBndNm _sem_tp -> {-# LINE 651 "src-ag/ExecutionPlan2Caml.ag" #-} _semFunBndNm >#< ":" >#< _sem_tp {-# LINE 1368 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule105 #-} {-# LINE 652 "src-ag/ExecutionPlan2Caml.ag" #-} rule105 = \ nt_ -> {-# LINE 652 "src-ag/ExecutionPlan2Caml.ag" #-} lateSemNtLabel nt_ {-# LINE 1374 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule106 #-} {-# LINE 682 "src-ag/ExecutionPlan2Caml.ag" #-} rule106 = \ initial_ -> {-# LINE 682 "src-ag/ExecutionPlan2Caml.ag" #-} initial_ {-# LINE 1380 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule107 #-} {-# LINE 683 "src-ag/ExecutionPlan2Caml.ag" #-} rule107 = \ _allstates -> {-# LINE 683 "src-ag/ExecutionPlan2Caml.ag" #-} _allstates {-# LINE 1386 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule108 #-} {-# LINE 1390 "src-ag/ExecutionPlan2Caml.ag" #-} rule108 = \ nextVisits_ -> {-# LINE 1390 "src-ag/ExecutionPlan2Caml.ag" #-} nextVisits_ {-# LINE 1392 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule109 #-} {-# LINE 1391 "src-ag/ExecutionPlan2Caml.ag" #-} rule109 = \ prevVisits_ -> {-# LINE 1391 "src-ag/ExecutionPlan2Caml.ag" #-} prevVisits_ {-# LINE 1398 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule110 #-} {-# LINE 1435 "src-ag/ExecutionPlan2Caml.ag" #-} rule110 = \ ((_lhsIlocalAttrTypes) :: Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) nt_ -> {-# LINE 1435 "src-ag/ExecutionPlan2Caml.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIlocalAttrTypes {-# LINE 1404 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule111 #-} {-# LINE 1462 "src-ag/ExecutionPlan2Caml.ag" #-} rule111 = \ initial_ nt_ -> {-# LINE 1462 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton nt_ initial_ {-# LINE 1410 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule112 #-} {-# LINE 1476 "src-ag/ExecutionPlan2Caml.ag" #-} rule112 = \ nt_ params_ -> {-# LINE 1476 "src-ag/ExecutionPlan2Caml.ag" #-} NT nt_ (map show params_) False {-# LINE 1416 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule113 #-} rule113 = \ ((_prodsIchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _prodsIchildvisit {-# INLINE rule114 #-} rule114 = \ ((_prodsIerrors) :: Seq Error) -> _prodsIerrors {-# INLINE rule115 #-} rule115 = \ ((_prodsIfromToStates) :: Map VisitIdentifier (Int,Int)) -> _prodsIfromToStates {-# INLINE rule116 #-} rule116 = \ ((_prodsIvisitKinds) :: Map VisitIdentifier VisitKind) -> _prodsIvisitKinds {-# INLINE rule117 #-} rule117 = \ ((_prodsIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _prodsIvisitdefs {-# INLINE rule118 #-} rule118 = \ ((_prodsIvisituses) :: Map VisitIdentifier (Set Identifier)) -> _prodsIvisituses {-# INLINE rule119 #-} rule119 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule120 #-} rule120 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule121 #-} rule121 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule122 #-} rule122 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _lhsIallchildvisit {-# INLINE rule123 #-} rule123 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule124 #-} rule124 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule125 #-} rule125 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule126 #-} rule126 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule127 #-} rule127 = \ _ntType -> _ntType {-# INLINE rule128 #-} rule128 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- ENonterminals ----------------------------------------------- -- wrapper data Inh_ENonterminals = Inh_ENonterminals { allFromToStates_Inh_ENonterminals :: (Map VisitIdentifier (Int,Int)), allInitStates_Inh_ENonterminals :: (Map NontermIdent Int), allVisitKinds_Inh_ENonterminals :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_ENonterminals :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)), avisitdefs_Inh_ENonterminals :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_ENonterminals :: (Map VisitIdentifier (Set Identifier)), inhmap_Inh_ENonterminals :: (Map NontermIdent Attributes), localAttrTypes_Inh_ENonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))), mainFile_Inh_ENonterminals :: (String), mainName_Inh_ENonterminals :: (String), options_Inh_ENonterminals :: (Options), synmap_Inh_ENonterminals :: (Map NontermIdent Attributes), typeSyns_Inh_ENonterminals :: (TypeSyns), wrappers_Inh_ENonterminals :: (Set NontermIdent) } data Syn_ENonterminals = Syn_ENonterminals { childvisit_Syn_ENonterminals :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)), code_Syn_ENonterminals :: (PP_Doc), datas_Syn_ENonterminals :: (PP_Doc), errors_Syn_ENonterminals :: (Seq Error), fromToStates_Syn_ENonterminals :: (Map VisitIdentifier (Int,Int)), initStates_Syn_ENonterminals :: (Map NontermIdent Int), modules_Syn_ENonterminals :: (PP_Doc), semFunBndDefs_Syn_ENonterminals :: (Seq PP_Doc), semFunBndTps_Syn_ENonterminals :: (Seq PP_Doc), visitKinds_Syn_ENonterminals :: (Map VisitIdentifier VisitKind), visitdefs_Syn_ENonterminals :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_ENonterminals :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_ENonterminals #-} wrap_ENonterminals :: T_ENonterminals -> Inh_ENonterminals -> (Syn_ENonterminals ) wrap_ENonterminals (T_ENonterminals act) (Inh_ENonterminals _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do sem <- act let arg10 = T_ENonterminals_vIn10 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers (T_ENonterminals_vOut10 _lhsOchildvisit _lhsOcode _lhsOdatas _lhsOerrors _lhsOfromToStates _lhsOinitStates _lhsOmodules _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_ENonterminals_s11 sem arg10) return (Syn_ENonterminals _lhsOchildvisit _lhsOcode _lhsOdatas _lhsOerrors _lhsOfromToStates _lhsOinitStates _lhsOmodules _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# NOINLINE sem_ENonterminals #-} sem_ENonterminals :: ENonterminals -> T_ENonterminals sem_ENonterminals list = Prelude.foldr sem_ENonterminals_Cons sem_ENonterminals_Nil (Prelude.map sem_ENonterminal list) -- semantic domain newtype T_ENonterminals = T_ENonterminals { attach_T_ENonterminals :: Identity (T_ENonterminals_s11 ) } newtype T_ENonterminals_s11 = C_ENonterminals_s11 { inv_ENonterminals_s11 :: (T_ENonterminals_v10 ) } data T_ENonterminals_s12 = C_ENonterminals_s12 type T_ENonterminals_v10 = (T_ENonterminals_vIn10 ) -> (T_ENonterminals_vOut10 ) data T_ENonterminals_vIn10 = T_ENonterminals_vIn10 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Int) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map NontermIdent Attributes) (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) (String) (String) (Options) (Map NontermIdent Attributes) (TypeSyns) (Set NontermIdent) data T_ENonterminals_vOut10 = T_ENonterminals_vOut10 (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) (PP_Doc) (PP_Doc) (Seq Error) (Map VisitIdentifier (Int,Int)) (Map NontermIdent Int) (PP_Doc) (Seq PP_Doc) (Seq PP_Doc) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_ENonterminals_Cons #-} sem_ENonterminals_Cons :: T_ENonterminal -> T_ENonterminals -> T_ENonterminals sem_ENonterminals_Cons arg_hd_ arg_tl_ = T_ENonterminals (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_ENonterminals_v10 v10 = \ (T_ENonterminals_vIn10 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers) -> ( let _hdX8 = Control.Monad.Identity.runIdentity (attach_T_ENonterminal (arg_hd_)) _tlX11 = Control.Monad.Identity.runIdentity (attach_T_ENonterminals (arg_tl_)) (T_ENonterminal_vOut7 _hdIchildvisit _hdIcode _hdIdatas _hdIerrors _hdIfromToStates _hdIinitStates _hdImodules _hdIsemFunBndDefs _hdIsemFunBndTps _hdIvisitKinds _hdIvisitdefs _hdIvisituses) = inv_ENonterminal_s8 _hdX8 (T_ENonterminal_vIn7 _hdOallFromToStates _hdOallInitStates _hdOallVisitKinds _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOinhmap _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOoptions _hdOsynmap _hdOtypeSyns _hdOwrappers) (T_ENonterminals_vOut10 _tlIchildvisit _tlIcode _tlIdatas _tlIerrors _tlIfromToStates _tlIinitStates _tlImodules _tlIsemFunBndDefs _tlIsemFunBndTps _tlIvisitKinds _tlIvisitdefs _tlIvisituses) = inv_ENonterminals_s11 _tlX11 (T_ENonterminals_vIn10 _tlOallFromToStates _tlOallInitStates _tlOallVisitKinds _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOinhmap _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOoptions _tlOsynmap _tlOtypeSyns _tlOwrappers) _lhsOchildvisit :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) _lhsOchildvisit = rule129 _hdIchildvisit _tlIchildvisit _lhsOcode :: PP_Doc _lhsOcode = rule130 _hdIcode _tlIcode _lhsOdatas :: PP_Doc _lhsOdatas = rule131 _hdIdatas _tlIdatas _lhsOerrors :: Seq Error _lhsOerrors = rule132 _hdIerrors _tlIerrors _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule133 _hdIfromToStates _tlIfromToStates _lhsOinitStates :: Map NontermIdent Int _lhsOinitStates = rule134 _hdIinitStates _tlIinitStates _lhsOmodules :: PP_Doc _lhsOmodules = rule135 _hdImodules _tlImodules _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule136 _hdIsemFunBndDefs _tlIsemFunBndDefs _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule137 _hdIsemFunBndTps _tlIsemFunBndTps _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule138 _hdIvisitKinds _tlIvisitKinds _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule139 _hdIvisitdefs _tlIvisitdefs _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule140 _hdIvisituses _tlIvisituses _hdOallFromToStates = rule141 _lhsIallFromToStates _hdOallInitStates = rule142 _lhsIallInitStates _hdOallVisitKinds = rule143 _lhsIallVisitKinds _hdOallchildvisit = rule144 _lhsIallchildvisit _hdOavisitdefs = rule145 _lhsIavisitdefs _hdOavisituses = rule146 _lhsIavisituses _hdOinhmap = rule147 _lhsIinhmap _hdOlocalAttrTypes = rule148 _lhsIlocalAttrTypes _hdOmainFile = rule149 _lhsImainFile _hdOmainName = rule150 _lhsImainName _hdOoptions = rule151 _lhsIoptions _hdOsynmap = rule152 _lhsIsynmap _hdOtypeSyns = rule153 _lhsItypeSyns _hdOwrappers = rule154 _lhsIwrappers _tlOallFromToStates = rule155 _lhsIallFromToStates _tlOallInitStates = rule156 _lhsIallInitStates _tlOallVisitKinds = rule157 _lhsIallVisitKinds _tlOallchildvisit = rule158 _lhsIallchildvisit _tlOavisitdefs = rule159 _lhsIavisitdefs _tlOavisituses = rule160 _lhsIavisituses _tlOinhmap = rule161 _lhsIinhmap _tlOlocalAttrTypes = rule162 _lhsIlocalAttrTypes _tlOmainFile = rule163 _lhsImainFile _tlOmainName = rule164 _lhsImainName _tlOoptions = rule165 _lhsIoptions _tlOsynmap = rule166 _lhsIsynmap _tlOtypeSyns = rule167 _lhsItypeSyns _tlOwrappers = rule168 _lhsIwrappers __result_ = T_ENonterminals_vOut10 _lhsOchildvisit _lhsOcode _lhsOdatas _lhsOerrors _lhsOfromToStates _lhsOinitStates _lhsOmodules _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_ENonterminals_s11 v10 {-# INLINE rule129 #-} rule129 = \ ((_hdIchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) ((_tlIchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _hdIchildvisit `Map.union` _tlIchildvisit {-# INLINE rule130 #-} rule130 = \ ((_hdIcode) :: PP_Doc) ((_tlIcode) :: PP_Doc) -> _hdIcode >-< _tlIcode {-# INLINE rule131 #-} rule131 = \ ((_hdIdatas) :: PP_Doc) ((_tlIdatas) :: PP_Doc) -> _hdIdatas >-< _tlIdatas {-# INLINE rule132 #-} rule132 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule133 #-} rule133 = \ ((_hdIfromToStates) :: Map VisitIdentifier (Int,Int)) ((_tlIfromToStates) :: Map VisitIdentifier (Int,Int)) -> _hdIfromToStates `mappend` _tlIfromToStates {-# INLINE rule134 #-} rule134 = \ ((_hdIinitStates) :: Map NontermIdent Int) ((_tlIinitStates) :: Map NontermIdent Int) -> _hdIinitStates `mappend` _tlIinitStates {-# INLINE rule135 #-} rule135 = \ ((_hdImodules) :: PP_Doc) ((_tlImodules) :: PP_Doc) -> _hdImodules >-< _tlImodules {-# INLINE rule136 #-} rule136 = \ ((_hdIsemFunBndDefs) :: Seq PP_Doc) ((_tlIsemFunBndDefs) :: Seq PP_Doc) -> _hdIsemFunBndDefs Seq.>< _tlIsemFunBndDefs {-# INLINE rule137 #-} rule137 = \ ((_hdIsemFunBndTps) :: Seq PP_Doc) ((_tlIsemFunBndTps) :: Seq PP_Doc) -> _hdIsemFunBndTps Seq.>< _tlIsemFunBndTps {-# INLINE rule138 #-} rule138 = \ ((_hdIvisitKinds) :: Map VisitIdentifier VisitKind) ((_tlIvisitKinds) :: Map VisitIdentifier VisitKind) -> _hdIvisitKinds `mappend` _tlIvisitKinds {-# INLINE rule139 #-} rule139 = \ ((_hdIvisitdefs) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisitdefs `uwSetUnion` _tlIvisitdefs {-# INLINE rule140 #-} rule140 = \ ((_hdIvisituses) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisituses) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisituses `uwSetUnion` _tlIvisituses {-# INLINE rule141 #-} rule141 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule142 #-} rule142 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule143 #-} rule143 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule144 #-} rule144 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _lhsIallchildvisit {-# INLINE rule145 #-} rule145 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule146 #-} rule146 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule147 #-} rule147 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) -> _lhsIinhmap {-# INLINE rule148 #-} rule148 = \ ((_lhsIlocalAttrTypes) :: Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) -> _lhsIlocalAttrTypes {-# INLINE rule149 #-} rule149 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule150 #-} rule150 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule151 #-} rule151 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule152 #-} rule152 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) -> _lhsIsynmap {-# INLINE rule153 #-} rule153 = \ ((_lhsItypeSyns) :: TypeSyns) -> _lhsItypeSyns {-# INLINE rule154 #-} rule154 = \ ((_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# INLINE rule155 #-} rule155 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule156 #-} rule156 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule157 #-} rule157 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule158 #-} rule158 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _lhsIallchildvisit {-# INLINE rule159 #-} rule159 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule160 #-} rule160 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule161 #-} rule161 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) -> _lhsIinhmap {-# INLINE rule162 #-} rule162 = \ ((_lhsIlocalAttrTypes) :: Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) -> _lhsIlocalAttrTypes {-# INLINE rule163 #-} rule163 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule164 #-} rule164 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule165 #-} rule165 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule166 #-} rule166 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) -> _lhsIsynmap {-# INLINE rule167 #-} rule167 = \ ((_lhsItypeSyns) :: TypeSyns) -> _lhsItypeSyns {-# INLINE rule168 #-} rule168 = \ ((_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# NOINLINE sem_ENonterminals_Nil #-} sem_ENonterminals_Nil :: T_ENonterminals sem_ENonterminals_Nil = T_ENonterminals (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_ENonterminals_v10 v10 = \ (T_ENonterminals_vIn10 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers) -> ( let _lhsOchildvisit :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) _lhsOchildvisit = rule169 () _lhsOcode :: PP_Doc _lhsOcode = rule170 () _lhsOdatas :: PP_Doc _lhsOdatas = rule171 () _lhsOerrors :: Seq Error _lhsOerrors = rule172 () _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule173 () _lhsOinitStates :: Map NontermIdent Int _lhsOinitStates = rule174 () _lhsOmodules :: PP_Doc _lhsOmodules = rule175 () _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule176 () _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule177 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule178 () _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule179 () _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule180 () __result_ = T_ENonterminals_vOut10 _lhsOchildvisit _lhsOcode _lhsOdatas _lhsOerrors _lhsOfromToStates _lhsOinitStates _lhsOmodules _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_ENonterminals_s11 v10 {-# INLINE rule169 #-} rule169 = \ (_ :: ()) -> Map.empty {-# INLINE rule170 #-} rule170 = \ (_ :: ()) -> empty {-# INLINE rule171 #-} rule171 = \ (_ :: ()) -> empty {-# INLINE rule172 #-} rule172 = \ (_ :: ()) -> Seq.empty {-# INLINE rule173 #-} rule173 = \ (_ :: ()) -> mempty {-# INLINE rule174 #-} rule174 = \ (_ :: ()) -> mempty {-# INLINE rule175 #-} rule175 = \ (_ :: ()) -> empty {-# INLINE rule176 #-} rule176 = \ (_ :: ()) -> Seq.empty {-# INLINE rule177 #-} rule177 = \ (_ :: ()) -> Seq.empty {-# INLINE rule178 #-} rule178 = \ (_ :: ()) -> mempty {-# INLINE rule179 #-} rule179 = \ (_ :: ()) -> Map.empty {-# INLINE rule180 #-} rule180 = \ (_ :: ()) -> Map.empty -- EProduction ------------------------------------------------- -- wrapper data Inh_EProduction = Inh_EProduction { allFromToStates_Inh_EProduction :: (Map VisitIdentifier (Int,Int)), allInhmap_Inh_EProduction :: (Map NontermIdent Attributes), allInitStates_Inh_EProduction :: (Map NontermIdent Int), allSynmap_Inh_EProduction :: (Map NontermIdent Attributes), allVisitKinds_Inh_EProduction :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_EProduction :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)), allstates_Inh_EProduction :: ([StateIdentifier]), avisitdefs_Inh_EProduction :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_EProduction :: (Map VisitIdentifier (Set Identifier)), inhmap_Inh_EProduction :: (Attributes), initial_Inh_EProduction :: (StateIdentifier), localAttrTypes_Inh_EProduction :: (Map ConstructorIdent (Map Identifier Type)), mainFile_Inh_EProduction :: (String), mainName_Inh_EProduction :: (String), nextVisits_Inh_EProduction :: (Map StateIdentifier StateCtx), nt_Inh_EProduction :: (NontermIdent), ntType_Inh_EProduction :: (Type), options_Inh_EProduction :: (Options), params_Inh_EProduction :: ([Identifier]), prevVisits_Inh_EProduction :: (Map StateIdentifier StateCtx), rename_Inh_EProduction :: (Bool), synmap_Inh_EProduction :: (Attributes) } data Syn_EProduction = Syn_EProduction { allvisits_Syn_EProduction :: ([VisitStateState]), childvisit_Syn_EProduction :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)), count_Syn_EProduction :: (Int), datatype_Syn_EProduction :: (PP_Doc), datatype_call_Syn_EProduction :: (PP_Doc), datatype_con_Syn_EProduction :: (PP_Doc), errors_Syn_EProduction :: (Seq Error), fromToStates_Syn_EProduction :: (Map VisitIdentifier (Int,Int)), semFunBndDefs_Syn_EProduction :: (Seq PP_Doc), semFunBndTps_Syn_EProduction :: (Seq PP_Doc), sem_nt_Syn_EProduction :: (PP_Doc), sem_prod_Syn_EProduction :: (PP_Doc), t_visits_Syn_EProduction :: (PP_Doc), visitKinds_Syn_EProduction :: (Map VisitIdentifier VisitKind), visitdefs_Syn_EProduction :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_EProduction :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_EProduction #-} wrap_EProduction :: T_EProduction -> Inh_EProduction -> (Syn_EProduction ) wrap_EProduction (T_EProduction act) (Inh_EProduction _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg13 = T_EProduction_vIn13 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap (T_EProduction_vOut13 _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOdatatype_call _lhsOdatatype_con _lhsOerrors _lhsOfromToStates _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_EProduction_s14 sem arg13) return (Syn_EProduction _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOdatatype_call _lhsOdatatype_con _lhsOerrors _lhsOfromToStates _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# INLINE sem_EProduction #-} sem_EProduction :: EProduction -> T_EProduction sem_EProduction ( EProduction con_ params_ constraints_ rules_ children_ visits_ ) = sem_EProduction_EProduction con_ params_ constraints_ ( sem_ERules rules_ ) ( sem_EChildren children_ ) ( sem_Visits visits_ ) -- semantic domain newtype T_EProduction = T_EProduction { attach_T_EProduction :: Identity (T_EProduction_s14 ) } newtype T_EProduction_s14 = C_EProduction_s14 { inv_EProduction_s14 :: (T_EProduction_v13 ) } data T_EProduction_s15 = C_EProduction_s15 type T_EProduction_v13 = (T_EProduction_vIn13 ) -> (T_EProduction_vOut13 ) data T_EProduction_vIn13 = T_EProduction_vIn13 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Attributes) (Map NontermIdent Int) (Map NontermIdent Attributes) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) ([StateIdentifier]) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Attributes) (StateIdentifier) (Map ConstructorIdent (Map Identifier Type)) (String) (String) (Map StateIdentifier StateCtx) (NontermIdent) (Type) (Options) ([Identifier]) (Map StateIdentifier StateCtx) (Bool) (Attributes) data T_EProduction_vOut13 = T_EProduction_vOut13 ([VisitStateState]) (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) (Int) (PP_Doc) (PP_Doc) (PP_Doc) (Seq Error) (Map VisitIdentifier (Int,Int)) (Seq PP_Doc) (Seq PP_Doc) (PP_Doc) (PP_Doc) (PP_Doc) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_EProduction_EProduction #-} sem_EProduction_EProduction :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_ERules -> T_EChildren -> T_Visits -> T_EProduction sem_EProduction_EProduction arg_con_ arg_params_ _ arg_rules_ arg_children_ arg_visits_ = T_EProduction (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_EProduction_v13 v13 = \ (T_EProduction_vIn13 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap) -> ( let _rulesX23 = Control.Monad.Identity.runIdentity (attach_T_ERules (arg_rules_)) _childrenX5 = Control.Monad.Identity.runIdentity (attach_T_EChildren (arg_children_)) _visitsX56 = Control.Monad.Identity.runIdentity (attach_T_Visits (arg_visits_)) (T_ERules_vOut22 _rulesIerrors _rulesImrules _rulesIruledefs _rulesIruleuses _rulesIsem_rules) = inv_ERules_s23 _rulesX23 (T_ERules_vIn22 _rulesOallInhmap _rulesOallSynmap _rulesOchildTypes _rulesOcon _rulesOinhmap _rulesOlazyIntras _rulesOlocalAttrTypes _rulesOmainFile _rulesOmainName _rulesOnt _rulesOoptions _rulesOruleKinds _rulesOsynmap _rulesOusageInfo) (T_EChildren_vOut4 _childrenIargnamesw _childrenIchildTypes _childrenIchildintros _childrenIsigs _childrenIterminaldefs) = inv_EChildren_s5 _childrenX5 (T_EChildren_vIn4 _childrenOallInitStates _childrenOcon _childrenOmainFile _childrenOmainName _childrenOnt _childrenOoptions) (T_Visits_vOut55 _visitsIallvisits _visitsIchildvisit _visitsIerrors _visitsIfromToStates _visitsIintramap _visitsIlazyIntras _visitsIruleKinds _visitsIruleUsage _visitsIsem_visit _visitsIt_visits _visitsIvisitKinds _visitsIvisitdefs _visitsIvisituses) = inv_Visits_s56 _visitsX56 (T_Visits_vIn55 _visitsOallFromToStates _visitsOallInhmap _visitsOallInitStates _visitsOallSynmap _visitsOallVisitKinds _visitsOallchildvisit _visitsOallintramap _visitsOavisitdefs _visitsOavisituses _visitsOchildTypes _visitsOchildintros _visitsOcon _visitsOinhmap _visitsOmrules _visitsOnextVisits _visitsOnt _visitsOoptions _visitsOparams _visitsOprevVisits _visitsOruledefs _visitsOruleuses _visitsOsynmap _visitsOterminaldefs) _childrenOcon = rule181 arg_con_ _rulesOcon = rule182 arg_con_ _visitsOcon = rule183 arg_con_ _o_records = rule184 _lhsIoptions _t_params = rule185 _lhsIparams _t_c_params = rule186 arg_params_ _conname = rule187 _lhsInt _lhsIrename arg_con_ _recname = rule188 _conname _lhsOdatatype :: PP_Doc _lhsOdatatype = rule189 _childrenIsigs _o_records _recname _t_params _lhsOdatatype_call :: PP_Doc _lhsOdatatype_call = rule190 _conname _recname _t_params _lhsOdatatype_con :: PP_Doc _lhsOdatatype_con = rule191 _childrenIsigs _conname _lhsInt _o_records _o_sigs _t_params arg_con_ _lhsOcount :: Int _lhsOcount = rule192 () _lhsOsem_nt :: PP_Doc _lhsOsem_nt = rule193 _childrenIargnamesw _childrenIsigs _lhsInt _lhsIoptions _lhsIrename _o_records arg_con_ _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule194 _semFunBndDef _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule195 _semFunBndTp _semFunBndDef = rule196 _semFunBndNm _semname _semFunBndTp = rule197 _semFunBndNm _sem_tp _semFunBndNm = rule198 _lhsInt arg_con_ _o_sigs = rule199 _lhsIoptions _t_type = rule200 _lhsInt _semname = rule201 _lhsInt _lhsIoptions arg_con_ _sem_res_tp = rule202 _t_params _t_type _sem_tp = rule203 _childrenIsigs _sem_res_tp _initializer = rule204 () _sem_prod = rule205 _childrenIsigs _o_sigs _prod_body _sem_res_tp _semname _prod_body = rule206 _initializer _lhsIinitial _lhsInt _rulesIsem_rules _statefuns arg_con_ _statefuns = rule207 _genstfn _lhsIallstates _genstfn = rule208 _lhsIinitial _lhsInextVisits _lhsInt _stargs _stks _stvs _stargs = rule209 _childTypes _lhsIallInhmap _lhsIallSynmap _lhsIoptions _localAttrTypes _visitsIintramap _stvisits = rule210 _visitsIallvisits _stks = rule211 _lhsInextVisits _lhsInt _stvisits _t_c_params arg_con_ _stvs = rule212 _visitsIsem_visit _visitsOmrules = rule213 _rulesImrules _visitsOchildintros = rule214 _childrenIchildintros _rulesOusageInfo = rule215 _visitsIruleUsage _rulesOruleKinds = rule216 _visitsIruleKinds _visitsOallintramap = rule217 _visitsIintramap _visitsOterminaldefs = rule218 _childrenIterminaldefs _visitsOruledefs = rule219 _rulesIruledefs _visitsOruleuses = rule220 _rulesIruleuses _lazyIntras = rule221 _visitsIlazyIntras _childTypes = rule222 _childrenIchildTypes _lhsIntType _localAttrTypes = rule223 _lhsIlocalAttrTypes arg_con_ _lhsOchildvisit :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) _lhsOchildvisit = rule224 _visitsIchildvisit _lhsOerrors :: Seq Error _lhsOerrors = rule225 _rulesIerrors _visitsIerrors _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule226 _visitsIfromToStates _lhsOt_visits :: PP_Doc _lhsOt_visits = rule227 _visitsIt_visits _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule228 _visitsIvisitKinds _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule229 _visitsIvisitdefs _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule230 _visitsIvisituses _lhsOallvisits :: [VisitStateState] _lhsOallvisits = rule231 _visitsIallvisits _lhsOsem_prod :: PP_Doc _lhsOsem_prod = rule232 _sem_prod _rulesOallInhmap = rule233 _lhsIallInhmap _rulesOallSynmap = rule234 _lhsIallSynmap _rulesOchildTypes = rule235 _childTypes _rulesOinhmap = rule236 _lhsIinhmap _rulesOlazyIntras = rule237 _lazyIntras _rulesOlocalAttrTypes = rule238 _localAttrTypes _rulesOmainFile = rule239 _lhsImainFile _rulesOmainName = rule240 _lhsImainName _rulesOnt = rule241 _lhsInt _rulesOoptions = rule242 _lhsIoptions _rulesOsynmap = rule243 _lhsIsynmap _childrenOallInitStates = rule244 _lhsIallInitStates _childrenOmainFile = rule245 _lhsImainFile _childrenOmainName = rule246 _lhsImainName _childrenOnt = rule247 _lhsInt _childrenOoptions = rule248 _lhsIoptions _visitsOallFromToStates = rule249 _lhsIallFromToStates _visitsOallInhmap = rule250 _lhsIallInhmap _visitsOallInitStates = rule251 _lhsIallInitStates _visitsOallSynmap = rule252 _lhsIallSynmap _visitsOallVisitKinds = rule253 _lhsIallVisitKinds _visitsOallchildvisit = rule254 _lhsIallchildvisit _visitsOavisitdefs = rule255 _lhsIavisitdefs _visitsOavisituses = rule256 _lhsIavisituses _visitsOchildTypes = rule257 _childTypes _visitsOinhmap = rule258 _lhsIinhmap _visitsOnextVisits = rule259 _lhsInextVisits _visitsOnt = rule260 _lhsInt _visitsOoptions = rule261 _lhsIoptions _visitsOparams = rule262 _lhsIparams _visitsOprevVisits = rule263 _lhsIprevVisits _visitsOsynmap = rule264 _lhsIsynmap __result_ = T_EProduction_vOut13 _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOdatatype_call _lhsOdatatype_con _lhsOerrors _lhsOfromToStates _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_EProduction_s14 v13 {-# INLINE rule181 #-} {-# LINE 90 "src-ag/ExecutionPlan2Caml.ag" #-} rule181 = \ con_ -> {-# LINE 90 "src-ag/ExecutionPlan2Caml.ag" #-} con_ {-# LINE 1904 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule182 #-} {-# LINE 91 "src-ag/ExecutionPlan2Caml.ag" #-} rule182 = \ con_ -> {-# LINE 91 "src-ag/ExecutionPlan2Caml.ag" #-} con_ {-# LINE 1910 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule183 #-} {-# LINE 92 "src-ag/ExecutionPlan2Caml.ag" #-} rule183 = \ con_ -> {-# LINE 92 "src-ag/ExecutionPlan2Caml.ag" #-} con_ {-# LINE 1916 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule184 #-} {-# LINE 259 "src-ag/ExecutionPlan2Caml.ag" #-} rule184 = \ ((_lhsIoptions) :: Options) -> {-# LINE 259 "src-ag/ExecutionPlan2Caml.ag" #-} dataRecords _lhsIoptions {-# LINE 1922 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule185 #-} {-# LINE 260 "src-ag/ExecutionPlan2Caml.ag" #-} rule185 = \ ((_lhsIparams) :: [Identifier]) -> {-# LINE 260 "src-ag/ExecutionPlan2Caml.ag" #-} ppTypeParams _lhsIparams {-# LINE 1928 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule186 #-} {-# LINE 261 "src-ag/ExecutionPlan2Caml.ag" #-} rule186 = \ params_ -> {-# LINE 261 "src-ag/ExecutionPlan2Caml.ag" #-} ppTypeParams (cont_tvar : map pp params_) {-# LINE 1934 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule187 #-} {-# LINE 262 "src-ag/ExecutionPlan2Caml.ag" #-} rule187 = \ ((_lhsInt) :: NontermIdent) ((_lhsIrename) :: Bool) con_ -> {-# LINE 262 "src-ag/ExecutionPlan2Caml.ag" #-} conname _lhsIrename _lhsInt con_ {-# LINE 1940 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule188 #-} {-# LINE 263 "src-ag/ExecutionPlan2Caml.ag" #-} rule188 = \ _conname -> {-# LINE 263 "src-ag/ExecutionPlan2Caml.ag" #-} pp "fields_" >|< _conname {-# LINE 1946 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule189 #-} {-# LINE 264 "src-ag/ExecutionPlan2Caml.ag" #-} rule189 = \ ((_childrenIsigs) :: [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) _o_records _recname _t_params -> {-# LINE 264 "src-ag/ExecutionPlan2Caml.ag" #-} "and" >#< _t_params >#< _recname >#< "=" >#< ppFieldsType _o_records False _childrenIsigs {-# LINE 1953 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule190 #-} {-# LINE 266 "src-ag/ExecutionPlan2Caml.ag" #-} rule190 = \ _conname _recname _t_params -> {-# LINE 266 "src-ag/ExecutionPlan2Caml.ag" #-} pp "|" >#< _conname >#< "of" >#< pp_parens (_t_params >#< _recname ) {-# LINE 1959 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule191 #-} {-# LINE 268 "src-ag/ExecutionPlan2Caml.ag" #-} rule191 = \ ((_childrenIsigs) :: [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) _conname ((_lhsInt) :: NontermIdent) _o_records _o_sigs _t_params con_ -> {-# LINE 268 "src-ag/ExecutionPlan2Caml.ag" #-} let funNm = _lhsInt >|< "_" >|< con_ decl = "and" >#< ppFunDecl _o_sigs funNm params (_t_params >#< _lhsInt) body params = [ (x, t) | (_,x,_,t) <- _childrenIsigs ] body = _conname >#< ppFieldsVal _o_records _childrenIsigs in decl {-# LINE 1969 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule192 #-} {-# LINE 384 "src-ag/ExecutionPlan2Caml.ag" #-} rule192 = \ (_ :: ()) -> {-# LINE 384 "src-ag/ExecutionPlan2Caml.ag" #-} 1 {-# LINE 1975 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule193 #-} {-# LINE 389 "src-ag/ExecutionPlan2Caml.ag" #-} rule193 = \ ((_childrenIargnamesw) :: [PP_Doc]) ((_childrenIsigs) :: [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) ((_lhsIrename) :: Bool) _o_records con_ -> {-# LINE 389 "src-ag/ExecutionPlan2Caml.ag" #-} "|" >#< conname _lhsIrename _lhsInt con_ >#< ppFieldsVal _o_records _childrenIsigs >#< "->" >#< prefix _lhsIoptions >|< _lhsInt >|< "_" >|< con_ >#< ppSpaced _childrenIargnamesw {-# LINE 1982 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule194 #-} {-# LINE 655 "src-ag/ExecutionPlan2Caml.ag" #-} rule194 = \ _semFunBndDef -> {-# LINE 655 "src-ag/ExecutionPlan2Caml.ag" #-} Seq.singleton _semFunBndDef {-# LINE 1988 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule195 #-} {-# LINE 656 "src-ag/ExecutionPlan2Caml.ag" #-} rule195 = \ _semFunBndTp -> {-# LINE 656 "src-ag/ExecutionPlan2Caml.ag" #-} Seq.singleton _semFunBndTp {-# LINE 1994 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule196 #-} {-# LINE 657 "src-ag/ExecutionPlan2Caml.ag" #-} rule196 = \ _semFunBndNm _semname -> {-# LINE 657 "src-ag/ExecutionPlan2Caml.ag" #-} _semFunBndNm >#< "=" >#< _semname {-# LINE 2000 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule197 #-} {-# LINE 658 "src-ag/ExecutionPlan2Caml.ag" #-} rule197 = \ _semFunBndNm _sem_tp -> {-# LINE 658 "src-ag/ExecutionPlan2Caml.ag" #-} _semFunBndNm >#< ":" >#< _sem_tp {-# LINE 2006 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule198 #-} {-# LINE 659 "src-ag/ExecutionPlan2Caml.ag" #-} rule198 = \ ((_lhsInt) :: NontermIdent) con_ -> {-# LINE 659 "src-ag/ExecutionPlan2Caml.ag" #-} lateSemConLabel _lhsInt con_ {-# LINE 2012 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule199 #-} {-# LINE 686 "src-ag/ExecutionPlan2Caml.ag" #-} rule199 = \ ((_lhsIoptions) :: Options) -> {-# LINE 686 "src-ag/ExecutionPlan2Caml.ag" #-} typeSigs _lhsIoptions {-# LINE 2018 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule200 #-} {-# LINE 687 "src-ag/ExecutionPlan2Caml.ag" #-} rule200 = \ ((_lhsInt) :: NontermIdent) -> {-# LINE 687 "src-ag/ExecutionPlan2Caml.ag" #-} type_nt_sem_top _lhsInt {-# LINE 2024 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule201 #-} {-# LINE 688 "src-ag/ExecutionPlan2Caml.ag" #-} rule201 = \ ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) con_ -> {-# LINE 688 "src-ag/ExecutionPlan2Caml.ag" #-} prefix _lhsIoptions >|< _lhsInt >|< "_" >|< con_ {-# LINE 2030 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule202 #-} {-# LINE 689 "src-ag/ExecutionPlan2Caml.ag" #-} rule202 = \ _t_params _t_type -> {-# LINE 689 "src-ag/ExecutionPlan2Caml.ag" #-} _t_params >#< _t_type {-# LINE 2036 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule203 #-} {-# LINE 690 "src-ag/ExecutionPlan2Caml.ag" #-} rule203 = \ ((_childrenIsigs) :: [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) _sem_res_tp -> {-# LINE 690 "src-ag/ExecutionPlan2Caml.ag" #-} pp_block "" "" "->" [ d | (_,_,d,_) <- _childrenIsigs ] >#< "->" >#< _sem_res_tp {-# LINE 2042 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule204 #-} {-# LINE 693 "src-ag/ExecutionPlan2Caml.ag" #-} rule204 = \ (_ :: ()) -> {-# LINE 693 "src-ag/ExecutionPlan2Caml.ag" #-} empty {-# LINE 2048 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule205 #-} {-# LINE 699 "src-ag/ExecutionPlan2Caml.ag" #-} rule205 = \ ((_childrenIsigs) :: [(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]) _o_sigs _prod_body _sem_res_tp _semname -> {-# LINE 699 "src-ag/ExecutionPlan2Caml.ag" #-} "and" >#< ppFunDecl _o_sigs _semname [ (x,d) | (_,x,d,_) <- _childrenIsigs ] _sem_res_tp _prod_body {-# LINE 2054 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule206 #-} {-# LINE 701 "src-ag/ExecutionPlan2Caml.ag" #-} rule206 = \ _initializer ((_lhsIinitial) :: StateIdentifier) ((_lhsInt) :: NontermIdent) ((_rulesIsem_rules) :: PP_Doc) _statefuns con_ -> {-# LINE 701 "src-ag/ExecutionPlan2Caml.ag" #-} _initializer >-< "{" >#< nm_attach _lhsInt >#< "=" >#< "function () ->" >-< indent 2 ( "(* rules of production" >#< con_ >#< "*)" >-< _rulesIsem_rules >-< "(* states of production" >#< con_ >#< "*)" >-< vlist _statefuns >-< nm_st _lhsIinitial ) >#< "}" {-# LINE 2069 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule207 #-} {-# LINE 717 "src-ag/ExecutionPlan2Caml.ag" #-} rule207 = \ _genstfn ((_lhsIallstates) :: [StateIdentifier]) -> {-# LINE 717 "src-ag/ExecutionPlan2Caml.ag" #-} map _genstfn _lhsIallstates {-# LINE 2075 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule208 #-} {-# LINE 719 "src-ag/ExecutionPlan2Caml.ag" #-} rule208 = \ ((_lhsIinitial) :: StateIdentifier) ((_lhsInextVisits) :: Map StateIdentifier StateCtx) ((_lhsInt) :: NontermIdent) _stargs _stks _stvs -> {-# LINE 719 "src-ag/ExecutionPlan2Caml.ag" #-} \st -> let nextVisitInfo = Map.findWithDefault ManyVis st _lhsInextVisits stNm = nm_st st stDef body = "let" >#< stNm >#< (if st == _lhsIinitial then empty else _stargs st) >#< "=" >-< indent 2 body >#< "in" in case nextVisitInfo of NoneVis -> if st == _lhsIinitial then stDef (pp "unit") else empty _ -> stDef $ mklets (_stvs st ++ _stks st) $ ppRecordVal [ nm_invoke _lhsInt st >#< "=" >#< nm_k st ] {-# LINE 2091 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule209 #-} {-# LINE 739 "src-ag/ExecutionPlan2Caml.ag" #-} rule209 = \ _childTypes ((_lhsIallInhmap) :: Map NontermIdent Attributes) ((_lhsIallSynmap) :: Map NontermIdent Attributes) ((_lhsIoptions) :: Options) _localAttrTypes ((_visitsIintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> {-# LINE 739 "src-ag/ExecutionPlan2Caml.ag" #-} \st -> let attrs = maybe Map.empty id $ Map.lookup st _visitsIintramap in ppSpaced [ case mbAttr of Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs _lhsIoptions) -> case Map.lookup nm _localAttrTypes of Just tp -> pp_parens (strNm >#< ":" >#< ppTp tp) Nothing -> pp strNm Just attr | not (noPerStateTypeSigs _lhsIoptions) -> case lookupAttrType attr _lhsIallInhmap _lhsIallSynmap _childTypes of Just tpDoc -> pp_parens (strNm >#< ":" >#< tpDoc) Nothing -> pp strNm _ -> pp strNm | (strNm, mbAttr) <- Map.assocs attrs ] >#< dummyPat _lhsIoptions (Map.null attrs) {-# LINE 2109 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule210 #-} {-# LINE 754 "src-ag/ExecutionPlan2Caml.ag" #-} rule210 = \ ((_visitsIallvisits) :: [VisitStateState]) -> {-# LINE 754 "src-ag/ExecutionPlan2Caml.ag" #-} \st -> filter (\(_,f,_) -> f == st) _visitsIallvisits {-# LINE 2115 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule211 #-} {-# LINE 756 "src-ag/ExecutionPlan2Caml.ag" #-} rule211 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) ((_lhsInt) :: NontermIdent) _stvisits _t_c_params con_ -> {-# LINE 756 "src-ag/ExecutionPlan2Caml.ag" #-} \st -> let stvisits = _stvisits st def = ppFunDecl False (pp $ nm_k st) [(pp "arg", _t_c_params >#< type_caller _lhsInt st)] (pp cont_tvar) body nextVisitInfo = Map.findWithDefault ManyVis st _lhsInextVisits body = case nextVisitInfo of NoneVis -> text "?no next visit?" OneVis v -> dispatch "arg" v ManyVis -> let alt (v,_,_) = "|" >#< con_visit _lhsInt v >#< "chosen" >#< "->" >-< indent 2 (dispatch "chosen" v) in "match arg with" >-< (indent 2 $ vlist $ map alt stvisits) dispatch nm v = "let" >#< ppRecordVal [ nm_inh _lhsInt v >#< "=" >#< "inp" , nm_cont _lhsInt v >#< "=" >#< "cont" ] >#< "=" >#< pp nm >-< "in" >#< "cont" >#< pp_parens (nm_visit v >#< "inp") in if null stvisits then [] else [ "(* k-function for production" >#< con_ >#< " *)" >-< def ] {-# LINE 2137 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule212 #-} {-# LINE 777 "src-ag/ExecutionPlan2Caml.ag" #-} rule212 = \ ((_visitsIsem_visit) :: [(StateIdentifier,PP_Doc)] ) -> {-# LINE 777 "src-ag/ExecutionPlan2Caml.ag" #-} \st -> [ppf | (f,ppf) <- _visitsIsem_visit, f == st] {-# LINE 2143 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule213 #-} {-# LINE 778 "src-ag/ExecutionPlan2Caml.ag" #-} rule213 = \ ((_rulesImrules) :: Map Identifier (VisitKind -> Either Error PP_Doc)) -> {-# LINE 778 "src-ag/ExecutionPlan2Caml.ag" #-} _rulesImrules {-# LINE 2149 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule214 #-} {-# LINE 919 "src-ag/ExecutionPlan2Caml.ag" #-} rule214 = \ ((_childrenIchildintros) :: Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> {-# LINE 919 "src-ag/ExecutionPlan2Caml.ag" #-} _childrenIchildintros {-# LINE 2155 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule215 #-} {-# LINE 1225 "src-ag/ExecutionPlan2Caml.ag" #-} rule215 = \ ((_visitsIruleUsage) :: Map Identifier Int) -> {-# LINE 1225 "src-ag/ExecutionPlan2Caml.ag" #-} _visitsIruleUsage {-# LINE 2161 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule216 #-} {-# LINE 1240 "src-ag/ExecutionPlan2Caml.ag" #-} rule216 = \ ((_visitsIruleKinds) :: Map Identifier (Set VisitKind)) -> {-# LINE 1240 "src-ag/ExecutionPlan2Caml.ag" #-} _visitsIruleKinds {-# LINE 2167 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule217 #-} {-# LINE 1269 "src-ag/ExecutionPlan2Caml.ag" #-} rule217 = \ ((_visitsIintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> {-# LINE 1269 "src-ag/ExecutionPlan2Caml.ag" #-} _visitsIintramap {-# LINE 2173 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule218 #-} {-# LINE 1270 "src-ag/ExecutionPlan2Caml.ag" #-} rule218 = \ ((_childrenIterminaldefs) :: Set String) -> {-# LINE 1270 "src-ag/ExecutionPlan2Caml.ag" #-} _childrenIterminaldefs {-# LINE 2179 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule219 #-} {-# LINE 1294 "src-ag/ExecutionPlan2Caml.ag" #-} rule219 = \ ((_rulesIruledefs) :: Map Identifier (Set String)) -> {-# LINE 1294 "src-ag/ExecutionPlan2Caml.ag" #-} _rulesIruledefs {-# LINE 2185 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule220 #-} {-# LINE 1295 "src-ag/ExecutionPlan2Caml.ag" #-} rule220 = \ ((_rulesIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> {-# LINE 1295 "src-ag/ExecutionPlan2Caml.ag" #-} _rulesIruleuses {-# LINE 2191 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule221 #-} {-# LINE 1349 "src-ag/ExecutionPlan2Caml.ag" #-} rule221 = \ ((_visitsIlazyIntras) :: Set String) -> {-# LINE 1349 "src-ag/ExecutionPlan2Caml.ag" #-} _visitsIlazyIntras {-# LINE 2197 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule222 #-} {-# LINE 1421 "src-ag/ExecutionPlan2Caml.ag" #-} rule222 = \ ((_childrenIchildTypes) :: Map Identifier Type) ((_lhsIntType) :: Type) -> {-# LINE 1421 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton _LHS _lhsIntType `Map.union` _childrenIchildTypes {-# LINE 2203 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule223 #-} {-# LINE 1438 "src-ag/ExecutionPlan2Caml.ag" #-} rule223 = \ ((_lhsIlocalAttrTypes) :: Map ConstructorIdent (Map Identifier Type)) con_ -> {-# LINE 1438 "src-ag/ExecutionPlan2Caml.ag" #-} Map.findWithDefault Map.empty con_ _lhsIlocalAttrTypes {-# LINE 2209 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule224 #-} rule224 = \ ((_visitsIchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _visitsIchildvisit {-# INLINE rule225 #-} rule225 = \ ((_rulesIerrors) :: Seq Error) ((_visitsIerrors) :: Seq Error) -> _rulesIerrors Seq.>< _visitsIerrors {-# INLINE rule226 #-} rule226 = \ ((_visitsIfromToStates) :: Map VisitIdentifier (Int,Int)) -> _visitsIfromToStates {-# INLINE rule227 #-} rule227 = \ ((_visitsIt_visits) :: PP_Doc) -> _visitsIt_visits {-# INLINE rule228 #-} rule228 = \ ((_visitsIvisitKinds) :: Map VisitIdentifier VisitKind) -> _visitsIvisitKinds {-# INLINE rule229 #-} rule229 = \ ((_visitsIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _visitsIvisitdefs {-# INLINE rule230 #-} rule230 = \ ((_visitsIvisituses) :: Map VisitIdentifier (Set Identifier)) -> _visitsIvisituses {-# INLINE rule231 #-} rule231 = \ ((_visitsIallvisits) :: [VisitStateState]) -> _visitsIallvisits {-# INLINE rule232 #-} rule232 = \ _sem_prod -> _sem_prod {-# INLINE rule233 #-} rule233 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule234 #-} rule234 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule235 #-} rule235 = \ _childTypes -> _childTypes {-# INLINE rule236 #-} rule236 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule237 #-} rule237 = \ _lazyIntras -> _lazyIntras {-# INLINE rule238 #-} rule238 = \ _localAttrTypes -> _localAttrTypes {-# INLINE rule239 #-} rule239 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule240 #-} rule240 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule241 #-} rule241 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule242 #-} rule242 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule243 #-} rule243 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule244 #-} rule244 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule245 #-} rule245 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule246 #-} rule246 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule247 #-} rule247 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule248 #-} rule248 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule249 #-} rule249 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule250 #-} rule250 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule251 #-} rule251 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule252 #-} rule252 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule253 #-} rule253 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule254 #-} rule254 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _lhsIallchildvisit {-# INLINE rule255 #-} rule255 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule256 #-} rule256 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule257 #-} rule257 = \ _childTypes -> _childTypes {-# INLINE rule258 #-} rule258 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule259 #-} rule259 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) -> _lhsInextVisits {-# INLINE rule260 #-} rule260 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule261 #-} rule261 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule262 #-} rule262 = \ ((_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule263 #-} rule263 = \ ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) -> _lhsIprevVisits {-# INLINE rule264 #-} rule264 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap -- EProductions ------------------------------------------------ -- wrapper data Inh_EProductions = Inh_EProductions { allFromToStates_Inh_EProductions :: (Map VisitIdentifier (Int,Int)), allInhmap_Inh_EProductions :: (Map NontermIdent Attributes), allInitStates_Inh_EProductions :: (Map NontermIdent Int), allSynmap_Inh_EProductions :: (Map NontermIdent Attributes), allVisitKinds_Inh_EProductions :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_EProductions :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)), allstates_Inh_EProductions :: ([StateIdentifier]), avisitdefs_Inh_EProductions :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_EProductions :: (Map VisitIdentifier (Set Identifier)), inhmap_Inh_EProductions :: (Attributes), initial_Inh_EProductions :: (StateIdentifier), localAttrTypes_Inh_EProductions :: (Map ConstructorIdent (Map Identifier Type)), mainFile_Inh_EProductions :: (String), mainName_Inh_EProductions :: (String), nextVisits_Inh_EProductions :: (Map StateIdentifier StateCtx), nt_Inh_EProductions :: (NontermIdent), ntType_Inh_EProductions :: (Type), options_Inh_EProductions :: (Options), params_Inh_EProductions :: ([Identifier]), prevVisits_Inh_EProductions :: (Map StateIdentifier StateCtx), rename_Inh_EProductions :: (Bool), synmap_Inh_EProductions :: (Attributes) } data Syn_EProductions = Syn_EProductions { allvisits_Syn_EProductions :: ([VisitStateState]), childvisit_Syn_EProductions :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)), count_Syn_EProductions :: (Int), datatype_Syn_EProductions :: ([PP_Doc]), datatype_call_Syn_EProductions :: ([PP_Doc]), datatype_con_Syn_EProductions :: ([PP_Doc]), errors_Syn_EProductions :: (Seq Error), fromToStates_Syn_EProductions :: (Map VisitIdentifier (Int,Int)), semFunBndDefs_Syn_EProductions :: (Seq PP_Doc), semFunBndTps_Syn_EProductions :: (Seq PP_Doc), sem_nt_Syn_EProductions :: (PP_Doc), sem_prod_Syn_EProductions :: (PP_Doc), t_visits_Syn_EProductions :: (PP_Doc), visitKinds_Syn_EProductions :: (Map VisitIdentifier VisitKind), visitdefs_Syn_EProductions :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_EProductions :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_EProductions #-} wrap_EProductions :: T_EProductions -> Inh_EProductions -> (Syn_EProductions ) wrap_EProductions (T_EProductions act) (Inh_EProductions _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg16 = T_EProductions_vIn16 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap (T_EProductions_vOut16 _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOdatatype_call _lhsOdatatype_con _lhsOerrors _lhsOfromToStates _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_EProductions_s17 sem arg16) return (Syn_EProductions _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOdatatype_call _lhsOdatatype_con _lhsOerrors _lhsOfromToStates _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# NOINLINE sem_EProductions #-} sem_EProductions :: EProductions -> T_EProductions sem_EProductions list = Prelude.foldr sem_EProductions_Cons sem_EProductions_Nil (Prelude.map sem_EProduction list) -- semantic domain newtype T_EProductions = T_EProductions { attach_T_EProductions :: Identity (T_EProductions_s17 ) } newtype T_EProductions_s17 = C_EProductions_s17 { inv_EProductions_s17 :: (T_EProductions_v16 ) } data T_EProductions_s18 = C_EProductions_s18 type T_EProductions_v16 = (T_EProductions_vIn16 ) -> (T_EProductions_vOut16 ) data T_EProductions_vIn16 = T_EProductions_vIn16 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Attributes) (Map NontermIdent Int) (Map NontermIdent Attributes) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) ([StateIdentifier]) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Attributes) (StateIdentifier) (Map ConstructorIdent (Map Identifier Type)) (String) (String) (Map StateIdentifier StateCtx) (NontermIdent) (Type) (Options) ([Identifier]) (Map StateIdentifier StateCtx) (Bool) (Attributes) data T_EProductions_vOut16 = T_EProductions_vOut16 ([VisitStateState]) (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) (Int) ([PP_Doc]) ([PP_Doc]) ([PP_Doc]) (Seq Error) (Map VisitIdentifier (Int,Int)) (Seq PP_Doc) (Seq PP_Doc) (PP_Doc) (PP_Doc) (PP_Doc) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_EProductions_Cons #-} sem_EProductions_Cons :: T_EProduction -> T_EProductions -> T_EProductions sem_EProductions_Cons arg_hd_ arg_tl_ = T_EProductions (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_EProductions_v16 v16 = \ (T_EProductions_vIn16 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_EProduction (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_EProductions (arg_tl_)) (T_EProduction_vOut13 _hdIallvisits _hdIchildvisit _hdIcount _hdIdatatype _hdIdatatype_call _hdIdatatype_con _hdIerrors _hdIfromToStates _hdIsemFunBndDefs _hdIsemFunBndTps _hdIsem_nt _hdIsem_prod _hdIt_visits _hdIvisitKinds _hdIvisitdefs _hdIvisituses) = inv_EProduction_s14 _hdX14 (T_EProduction_vIn13 _hdOallFromToStates _hdOallInhmap _hdOallInitStates _hdOallSynmap _hdOallVisitKinds _hdOallchildvisit _hdOallstates _hdOavisitdefs _hdOavisituses _hdOinhmap _hdOinitial _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOnextVisits _hdOnt _hdOntType _hdOoptions _hdOparams _hdOprevVisits _hdOrename _hdOsynmap) (T_EProductions_vOut16 _tlIallvisits _tlIchildvisit _tlIcount _tlIdatatype _tlIdatatype_call _tlIdatatype_con _tlIerrors _tlIfromToStates _tlIsemFunBndDefs _tlIsemFunBndTps _tlIsem_nt _tlIsem_prod _tlIt_visits _tlIvisitKinds _tlIvisitdefs _tlIvisituses) = inv_EProductions_s17 _tlX17 (T_EProductions_vIn16 _tlOallFromToStates _tlOallInhmap _tlOallInitStates _tlOallSynmap _tlOallVisitKinds _tlOallchildvisit _tlOallstates _tlOavisitdefs _tlOavisituses _tlOinhmap _tlOinitial _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOnextVisits _tlOnt _tlOntType _tlOoptions _tlOparams _tlOprevVisits _tlOrename _tlOsynmap) _lhsOallvisits :: [VisitStateState] _lhsOallvisits = rule265 _hdIallvisits _lhsOt_visits :: PP_Doc _lhsOt_visits = rule266 _hdIt_visits _lhsOchildvisit :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) _lhsOchildvisit = rule267 _hdIchildvisit _tlIchildvisit _lhsOcount :: Int _lhsOcount = rule268 _hdIcount _tlIcount _lhsOdatatype :: [PP_Doc] _lhsOdatatype = rule269 _hdIdatatype _tlIdatatype _lhsOdatatype_call :: [PP_Doc] _lhsOdatatype_call = rule270 _hdIdatatype_call _tlIdatatype_call _lhsOdatatype_con :: [PP_Doc] _lhsOdatatype_con = rule271 _hdIdatatype_con _tlIdatatype_con _lhsOerrors :: Seq Error _lhsOerrors = rule272 _hdIerrors _tlIerrors _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule273 _hdIfromToStates _tlIfromToStates _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule274 _hdIsemFunBndDefs _tlIsemFunBndDefs _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule275 _hdIsemFunBndTps _tlIsemFunBndTps _lhsOsem_nt :: PP_Doc _lhsOsem_nt = rule276 _hdIsem_nt _tlIsem_nt _lhsOsem_prod :: PP_Doc _lhsOsem_prod = rule277 _hdIsem_prod _tlIsem_prod _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule278 _hdIvisitKinds _tlIvisitKinds _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule279 _hdIvisitdefs _tlIvisitdefs _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule280 _hdIvisituses _tlIvisituses _hdOallFromToStates = rule281 _lhsIallFromToStates _hdOallInhmap = rule282 _lhsIallInhmap _hdOallInitStates = rule283 _lhsIallInitStates _hdOallSynmap = rule284 _lhsIallSynmap _hdOallVisitKinds = rule285 _lhsIallVisitKinds _hdOallchildvisit = rule286 _lhsIallchildvisit _hdOallstates = rule287 _lhsIallstates _hdOavisitdefs = rule288 _lhsIavisitdefs _hdOavisituses = rule289 _lhsIavisituses _hdOinhmap = rule290 _lhsIinhmap _hdOinitial = rule291 _lhsIinitial _hdOlocalAttrTypes = rule292 _lhsIlocalAttrTypes _hdOmainFile = rule293 _lhsImainFile _hdOmainName = rule294 _lhsImainName _hdOnextVisits = rule295 _lhsInextVisits _hdOnt = rule296 _lhsInt _hdOntType = rule297 _lhsIntType _hdOoptions = rule298 _lhsIoptions _hdOparams = rule299 _lhsIparams _hdOprevVisits = rule300 _lhsIprevVisits _hdOrename = rule301 _lhsIrename _hdOsynmap = rule302 _lhsIsynmap _tlOallFromToStates = rule303 _lhsIallFromToStates _tlOallInhmap = rule304 _lhsIallInhmap _tlOallInitStates = rule305 _lhsIallInitStates _tlOallSynmap = rule306 _lhsIallSynmap _tlOallVisitKinds = rule307 _lhsIallVisitKinds _tlOallchildvisit = rule308 _lhsIallchildvisit _tlOallstates = rule309 _lhsIallstates _tlOavisitdefs = rule310 _lhsIavisitdefs _tlOavisituses = rule311 _lhsIavisituses _tlOinhmap = rule312 _lhsIinhmap _tlOinitial = rule313 _lhsIinitial _tlOlocalAttrTypes = rule314 _lhsIlocalAttrTypes _tlOmainFile = rule315 _lhsImainFile _tlOmainName = rule316 _lhsImainName _tlOnextVisits = rule317 _lhsInextVisits _tlOnt = rule318 _lhsInt _tlOntType = rule319 _lhsIntType _tlOoptions = rule320 _lhsIoptions _tlOparams = rule321 _lhsIparams _tlOprevVisits = rule322 _lhsIprevVisits _tlOrename = rule323 _lhsIrename _tlOsynmap = rule324 _lhsIsynmap __result_ = T_EProductions_vOut16 _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOdatatype_call _lhsOdatatype_con _lhsOerrors _lhsOfromToStates _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_EProductions_s17 v16 {-# INLINE rule265 #-} {-# LINE 439 "src-ag/ExecutionPlan2Caml.ag" #-} rule265 = \ ((_hdIallvisits) :: [VisitStateState]) -> {-# LINE 439 "src-ag/ExecutionPlan2Caml.ag" #-} _hdIallvisits {-# LINE 2459 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule266 #-} {-# LINE 534 "src-ag/ExecutionPlan2Caml.ag" #-} rule266 = \ ((_hdIt_visits) :: PP_Doc) -> {-# LINE 534 "src-ag/ExecutionPlan2Caml.ag" #-} _hdIt_visits {-# LINE 2465 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule267 #-} rule267 = \ ((_hdIchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) ((_tlIchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _hdIchildvisit `Map.union` _tlIchildvisit {-# INLINE rule268 #-} rule268 = \ ((_hdIcount) :: Int) ((_tlIcount) :: Int) -> _hdIcount + _tlIcount {-# INLINE rule269 #-} rule269 = \ ((_hdIdatatype) :: PP_Doc) ((_tlIdatatype) :: [PP_Doc]) -> _hdIdatatype : _tlIdatatype {-# INLINE rule270 #-} rule270 = \ ((_hdIdatatype_call) :: PP_Doc) ((_tlIdatatype_call) :: [PP_Doc]) -> _hdIdatatype_call : _tlIdatatype_call {-# INLINE rule271 #-} rule271 = \ ((_hdIdatatype_con) :: PP_Doc) ((_tlIdatatype_con) :: [PP_Doc]) -> _hdIdatatype_con : _tlIdatatype_con {-# INLINE rule272 #-} rule272 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule273 #-} rule273 = \ ((_hdIfromToStates) :: Map VisitIdentifier (Int,Int)) ((_tlIfromToStates) :: Map VisitIdentifier (Int,Int)) -> _hdIfromToStates `mappend` _tlIfromToStates {-# INLINE rule274 #-} rule274 = \ ((_hdIsemFunBndDefs) :: Seq PP_Doc) ((_tlIsemFunBndDefs) :: Seq PP_Doc) -> _hdIsemFunBndDefs Seq.>< _tlIsemFunBndDefs {-# INLINE rule275 #-} rule275 = \ ((_hdIsemFunBndTps) :: Seq PP_Doc) ((_tlIsemFunBndTps) :: Seq PP_Doc) -> _hdIsemFunBndTps Seq.>< _tlIsemFunBndTps {-# INLINE rule276 #-} rule276 = \ ((_hdIsem_nt) :: PP_Doc) ((_tlIsem_nt) :: PP_Doc) -> _hdIsem_nt >-< _tlIsem_nt {-# INLINE rule277 #-} rule277 = \ ((_hdIsem_prod) :: PP_Doc) ((_tlIsem_prod) :: PP_Doc) -> _hdIsem_prod >-< _tlIsem_prod {-# INLINE rule278 #-} rule278 = \ ((_hdIvisitKinds) :: Map VisitIdentifier VisitKind) ((_tlIvisitKinds) :: Map VisitIdentifier VisitKind) -> _hdIvisitKinds `mappend` _tlIvisitKinds {-# INLINE rule279 #-} rule279 = \ ((_hdIvisitdefs) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisitdefs `uwSetUnion` _tlIvisitdefs {-# INLINE rule280 #-} rule280 = \ ((_hdIvisituses) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisituses) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisituses `uwSetUnion` _tlIvisituses {-# INLINE rule281 #-} rule281 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule282 #-} rule282 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule283 #-} rule283 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule284 #-} rule284 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule285 #-} rule285 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule286 #-} rule286 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _lhsIallchildvisit {-# INLINE rule287 #-} rule287 = \ ((_lhsIallstates) :: [StateIdentifier]) -> _lhsIallstates {-# INLINE rule288 #-} rule288 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule289 #-} rule289 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule290 #-} rule290 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule291 #-} rule291 = \ ((_lhsIinitial) :: StateIdentifier) -> _lhsIinitial {-# INLINE rule292 #-} rule292 = \ ((_lhsIlocalAttrTypes) :: Map ConstructorIdent (Map Identifier Type)) -> _lhsIlocalAttrTypes {-# INLINE rule293 #-} rule293 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule294 #-} rule294 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule295 #-} rule295 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) -> _lhsInextVisits {-# INLINE rule296 #-} rule296 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule297 #-} rule297 = \ ((_lhsIntType) :: Type) -> _lhsIntType {-# INLINE rule298 #-} rule298 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule299 #-} rule299 = \ ((_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule300 #-} rule300 = \ ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) -> _lhsIprevVisits {-# INLINE rule301 #-} rule301 = \ ((_lhsIrename) :: Bool) -> _lhsIrename {-# INLINE rule302 #-} rule302 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule303 #-} rule303 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule304 #-} rule304 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule305 #-} rule305 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule306 #-} rule306 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule307 #-} rule307 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule308 #-} rule308 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _lhsIallchildvisit {-# INLINE rule309 #-} rule309 = \ ((_lhsIallstates) :: [StateIdentifier]) -> _lhsIallstates {-# INLINE rule310 #-} rule310 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule311 #-} rule311 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule312 #-} rule312 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule313 #-} rule313 = \ ((_lhsIinitial) :: StateIdentifier) -> _lhsIinitial {-# INLINE rule314 #-} rule314 = \ ((_lhsIlocalAttrTypes) :: Map ConstructorIdent (Map Identifier Type)) -> _lhsIlocalAttrTypes {-# INLINE rule315 #-} rule315 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule316 #-} rule316 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule317 #-} rule317 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) -> _lhsInextVisits {-# INLINE rule318 #-} rule318 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule319 #-} rule319 = \ ((_lhsIntType) :: Type) -> _lhsIntType {-# INLINE rule320 #-} rule320 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule321 #-} rule321 = \ ((_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule322 #-} rule322 = \ ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) -> _lhsIprevVisits {-# INLINE rule323 #-} rule323 = \ ((_lhsIrename) :: Bool) -> _lhsIrename {-# INLINE rule324 #-} rule324 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_EProductions_Nil #-} sem_EProductions_Nil :: T_EProductions sem_EProductions_Nil = T_EProductions (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_EProductions_v16 v16 = \ (T_EProductions_vIn16 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap) -> ( let _lhsOallvisits :: [VisitStateState] _lhsOallvisits = rule325 () _lhsOchildvisit :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) _lhsOchildvisit = rule326 () _lhsOcount :: Int _lhsOcount = rule327 () _lhsOdatatype :: [PP_Doc] _lhsOdatatype = rule328 () _lhsOdatatype_call :: [PP_Doc] _lhsOdatatype_call = rule329 () _lhsOdatatype_con :: [PP_Doc] _lhsOdatatype_con = rule330 () _lhsOerrors :: Seq Error _lhsOerrors = rule331 () _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule332 () _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule333 () _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule334 () _lhsOsem_nt :: PP_Doc _lhsOsem_nt = rule335 () _lhsOsem_prod :: PP_Doc _lhsOsem_prod = rule336 () _lhsOt_visits :: PP_Doc _lhsOt_visits = rule337 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule338 () _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule339 () _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule340 () __result_ = T_EProductions_vOut16 _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOdatatype_call _lhsOdatatype_con _lhsOerrors _lhsOfromToStates _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_EProductions_s17 v16 {-# INLINE rule325 #-} {-# LINE 440 "src-ag/ExecutionPlan2Caml.ag" #-} rule325 = \ (_ :: ()) -> {-# LINE 440 "src-ag/ExecutionPlan2Caml.ag" #-} error "Every nonterminal should have at least 1 production" {-# LINE 2687 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule326 #-} rule326 = \ (_ :: ()) -> Map.empty {-# INLINE rule327 #-} rule327 = \ (_ :: ()) -> 0 {-# INLINE rule328 #-} rule328 = \ (_ :: ()) -> [] {-# INLINE rule329 #-} rule329 = \ (_ :: ()) -> [] {-# INLINE rule330 #-} rule330 = \ (_ :: ()) -> [] {-# INLINE rule331 #-} rule331 = \ (_ :: ()) -> Seq.empty {-# INLINE rule332 #-} rule332 = \ (_ :: ()) -> mempty {-# INLINE rule333 #-} rule333 = \ (_ :: ()) -> Seq.empty {-# INLINE rule334 #-} rule334 = \ (_ :: ()) -> Seq.empty {-# INLINE rule335 #-} rule335 = \ (_ :: ()) -> empty {-# INLINE rule336 #-} rule336 = \ (_ :: ()) -> empty {-# INLINE rule337 #-} rule337 = \ (_ :: ()) -> empty {-# INLINE rule338 #-} rule338 = \ (_ :: ()) -> mempty {-# INLINE rule339 #-} rule339 = \ (_ :: ()) -> Map.empty {-# INLINE rule340 #-} rule340 = \ (_ :: ()) -> Map.empty -- ERule ------------------------------------------------------- -- wrapper data Inh_ERule = Inh_ERule { allInhmap_Inh_ERule :: (Map NontermIdent Attributes), allSynmap_Inh_ERule :: (Map NontermIdent Attributes), childTypes_Inh_ERule :: (Map Identifier Type), con_Inh_ERule :: (ConstructorIdent), inhmap_Inh_ERule :: (Attributes), lazyIntras_Inh_ERule :: (Set String), localAttrTypes_Inh_ERule :: (Map Identifier Type), mainFile_Inh_ERule :: (String), mainName_Inh_ERule :: (String), nt_Inh_ERule :: (NontermIdent), options_Inh_ERule :: (Options), ruleKinds_Inh_ERule :: (Map Identifier (Set VisitKind)), synmap_Inh_ERule :: (Attributes), usageInfo_Inh_ERule :: (Map Identifier Int) } data Syn_ERule = Syn_ERule { errors_Syn_ERule :: (Seq Error), mrules_Syn_ERule :: (Map Identifier (VisitKind -> Either Error PP_Doc)), ruledefs_Syn_ERule :: (Map Identifier (Set String)), ruleuses_Syn_ERule :: (Map Identifier (Map String (Maybe NonLocalAttr))), sem_rules_Syn_ERule :: (PP_Doc) } {-# INLINABLE wrap_ERule #-} wrap_ERule :: T_ERule -> Inh_ERule -> (Syn_ERule ) wrap_ERule (T_ERule act) (Inh_ERule _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsIusageInfo) = Control.Monad.Identity.runIdentity ( do sem <- act let arg19 = T_ERule_vIn19 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsIusageInfo (T_ERule_vOut19 _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules) <- return (inv_ERule_s20 sem arg19) return (Syn_ERule _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules) ) -- cata {-# INLINE sem_ERule #-} sem_ERule :: ERule -> T_ERule sem_ERule ( ERule name_ pattern_ rhs_ owrt_ origin_ explicit_ pure_ mbError_ ) = sem_ERule_ERule name_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ mbError_ -- semantic domain newtype T_ERule = T_ERule { attach_T_ERule :: Identity (T_ERule_s20 ) } newtype T_ERule_s20 = C_ERule_s20 { inv_ERule_s20 :: (T_ERule_v19 ) } data T_ERule_s21 = C_ERule_s21 type T_ERule_v19 = (T_ERule_vIn19 ) -> (T_ERule_vOut19 ) data T_ERule_vIn19 = T_ERule_vIn19 (Map NontermIdent Attributes) (Map NontermIdent Attributes) (Map Identifier Type) (ConstructorIdent) (Attributes) (Set String) (Map Identifier Type) (String) (String) (NontermIdent) (Options) (Map Identifier (Set VisitKind)) (Attributes) (Map Identifier Int) data T_ERule_vOut19 = T_ERule_vOut19 (Seq Error) (Map Identifier (VisitKind -> Either Error PP_Doc)) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (PP_Doc) {-# NOINLINE sem_ERule_ERule #-} sem_ERule_ERule :: (Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Maybe Error) -> T_ERule sem_ERule_ERule arg_name_ arg_pattern_ arg_rhs_ _ _ arg_explicit_ arg_pure_ arg_mbError_ = T_ERule (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_ERule_v19 v19 = \ (T_ERule_vIn19 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsIusageInfo) -> ( let _patternX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) _rhsX29 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) (T_Pattern_vOut40 _patternIattrTypes _patternIattrs _patternIcopy _patternIextraDefs _patternIisUnderscore _patternIsem_lhs) = inv_Pattern_s41 _patternX41 (T_Pattern_vIn40 _patternOallInhmap _patternOallSynmap _patternOanyLazyKind _patternOinhmap _patternOlocalAttrTypes _patternOoptions _patternOsynmap) (T_Expression_vOut28 _rhsIattrs _rhsIpos _rhsIsemfunc _rhsItks) = inv_Expression_s29 _rhsX29 (T_Expression_vIn28 _rhsOoptions) _lhsOsem_rules :: PP_Doc _lhsOsem_rules = rule341 _rulecode _used _rulecode = rule342 _declHead _endpragma _genpragma _pragma _rhsIpos _rhsIsemfunc _pragma = rule343 _lhsIoptions _rhsIpos _endpragma = rule344 _lhsImainFile _lhsIoptions _genpragma = rule345 _haspos _lhsIoptions arg_explicit_ _haspos = rule346 _rhsIpos _declHead = rule347 _argPats _lhsIoptions _rhsIattrs arg_name_ _argPats = rule348 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIlocalAttrTypes _lhsIoptions _rhsIattrs _argExprs = rule349 _rhsIattrs _stepcode = rule350 _argExprs _lhsIoptions _patternIextraDefs _patternIsem_lhs _rhsIattrs arg_name_ arg_pure_ _lhsOmrules :: Map Identifier (VisitKind -> Either Error PP_Doc) _lhsOmrules = rule351 _stepcode arg_name_ _used = rule352 _lhsIusageInfo arg_name_ _kinds = rule353 _lhsIruleKinds arg_name_ _anyLazyKind = rule354 _kinds _lhsOruledefs :: Map Identifier (Set String) _lhsOruledefs = rule355 _patternIattrs arg_name_ _lhsOruleuses :: Map Identifier (Map String (Maybe NonLocalAttr)) _lhsOruleuses = rule356 _rhsIattrs arg_name_ _lhsOerrors :: Seq Error _lhsOerrors = rule357 _used arg_mbError_ _patternOallInhmap = rule358 _lhsIallInhmap _patternOallSynmap = rule359 _lhsIallSynmap _patternOanyLazyKind = rule360 _anyLazyKind _patternOinhmap = rule361 _lhsIinhmap _patternOlocalAttrTypes = rule362 _lhsIlocalAttrTypes _patternOoptions = rule363 _lhsIoptions _patternOsynmap = rule364 _lhsIsynmap _rhsOoptions = rule365 _lhsIoptions __result_ = T_ERule_vOut19 _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules in __result_ ) in C_ERule_s20 v19 {-# INLINE rule341 #-} {-# LINE 977 "src-ag/ExecutionPlan2Caml.ag" #-} rule341 = \ _rulecode _used -> {-# LINE 977 "src-ag/ExecutionPlan2Caml.ag" #-} if _used == 0 then empty else _rulecode {-# LINE 2815 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule342 #-} {-# LINE 980 "src-ag/ExecutionPlan2Caml.ag" #-} rule342 = \ _declHead _endpragma _genpragma _pragma ((_rhsIpos) :: Pos) ((_rhsIsemfunc) :: PP_Doc) -> {-# LINE 980 "src-ag/ExecutionPlan2Caml.ag" #-} ( if _genpragma then _pragma else empty ) >-< _declHead >-< indent ((column _rhsIpos - 2) `max` 2) ( if _genpragma then _pragma >-< _rhsIsemfunc >-< _endpragma else _rhsIsemfunc ) >#< "in" {-# LINE 2831 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule343 #-} {-# LINE 993 "src-ag/ExecutionPlan2Caml.ag" #-} rule343 = \ ((_lhsIoptions) :: Options) ((_rhsIpos) :: Pos) -> {-# LINE 993 "src-ag/ExecutionPlan2Caml.ag" #-} ppLinePragma _lhsIoptions (line _rhsIpos) (file _rhsIpos) {-# LINE 2837 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule344 #-} {-# LINE 994 "src-ag/ExecutionPlan2Caml.ag" #-} rule344 = \ ((_lhsImainFile) :: String) ((_lhsIoptions) :: Options) -> {-# LINE 994 "src-ag/ExecutionPlan2Caml.ag" #-} ppWithLineNr (\ln -> ppLinePragma _lhsIoptions (ln+1) _lhsImainFile) {-# LINE 2843 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule345 #-} {-# LINE 995 "src-ag/ExecutionPlan2Caml.ag" #-} rule345 = \ _haspos ((_lhsIoptions) :: Options) explicit_ -> {-# LINE 995 "src-ag/ExecutionPlan2Caml.ag" #-} genLinePragmas _lhsIoptions && explicit_ && _haspos {-# LINE 2849 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule346 #-} {-# LINE 996 "src-ag/ExecutionPlan2Caml.ag" #-} rule346 = \ ((_rhsIpos) :: Pos) -> {-# LINE 996 "src-ag/ExecutionPlan2Caml.ag" #-} line _rhsIpos > 0 && column _rhsIpos >= 0 && not (null (file _rhsIpos)) {-# LINE 2855 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule347 #-} {-# LINE 1000 "src-ag/ExecutionPlan2Caml.ag" #-} rule347 = \ _argPats ((_lhsIoptions) :: Options) ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) name_ -> {-# LINE 1000 "src-ag/ExecutionPlan2Caml.ag" #-} "let" >#< name_ >#< _argPats >#< dummyPat _lhsIoptions (Map.null _rhsIattrs) >#< "=" {-# LINE 2861 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule348 #-} {-# LINE 1002 "src-ag/ExecutionPlan2Caml.ag" #-} rule348 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) ((_lhsIallSynmap) :: Map NontermIdent Attributes) ((_lhsIchildTypes) :: Map Identifier Type) ((_lhsIlocalAttrTypes) :: Map Identifier Type) ((_lhsIoptions) :: Options) ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) -> {-# LINE 1002 "src-ag/ExecutionPlan2Caml.ag" #-} ppSpaced [ case mbAttr of Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs _lhsIoptions) -> case Map.lookup nm _lhsIlocalAttrTypes of Just tp -> pp_parens (strNm >#< ":" >#< ppTp tp) Nothing -> pp strNm Just attr | not (noPerStateTypeSigs _lhsIoptions) -> case lookupAttrType attr _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes of Just tpDoc -> pp_parens (strNm >#< ":" >#< tpDoc) Nothing -> pp strNm _ -> pp strNm | (strNm, mbAttr) <- Map.assocs _rhsIattrs ] {-# LINE 2879 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule349 #-} {-# LINE 1016 "src-ag/ExecutionPlan2Caml.ag" #-} rule349 = \ ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) -> {-# LINE 1016 "src-ag/ExecutionPlan2Caml.ag" #-} ppSpaced $ Map.keys _rhsIattrs {-# LINE 2885 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule350 #-} {-# LINE 1017 "src-ag/ExecutionPlan2Caml.ag" #-} rule350 = \ _argExprs ((_lhsIoptions) :: Options) ((_patternIextraDefs) :: [(PP_Doc,PP_Doc)]) ((_patternIsem_lhs) :: PP_Doc ) ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) name_ pure_ -> {-# LINE 1017 "src-ag/ExecutionPlan2Caml.ag" #-} \kind -> let mkBind (pat,expr) = "let" >#< pat >#< "=" >#< expr >#< "in" in if kind `compatibleRule` pure_ then Right $ mkBind (_patternIsem_lhs, name_ >#< _argExprs >#< dummyArg _lhsIoptions (Map.null _rhsIattrs)) >-< vlist (map mkBind _patternIextraDefs) else Left $ IncompatibleRuleKind name_ kind {-# LINE 2896 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule351 #-} {-# LINE 1024 "src-ag/ExecutionPlan2Caml.ag" #-} rule351 = \ _stepcode name_ -> {-# LINE 1024 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton name_ _stepcode {-# LINE 2902 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule352 #-} {-# LINE 1227 "src-ag/ExecutionPlan2Caml.ag" #-} rule352 = \ ((_lhsIusageInfo) :: Map Identifier Int) name_ -> {-# LINE 1227 "src-ag/ExecutionPlan2Caml.ag" #-} Map.findWithDefault 0 name_ _lhsIusageInfo {-# LINE 2908 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule353 #-} {-# LINE 1243 "src-ag/ExecutionPlan2Caml.ag" #-} rule353 = \ ((_lhsIruleKinds) :: Map Identifier (Set VisitKind)) name_ -> {-# LINE 1243 "src-ag/ExecutionPlan2Caml.ag" #-} Map.findWithDefault Set.empty name_ _lhsIruleKinds {-# LINE 2914 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule354 #-} {-# LINE 1244 "src-ag/ExecutionPlan2Caml.ag" #-} rule354 = \ _kinds -> {-# LINE 1244 "src-ag/ExecutionPlan2Caml.ag" #-} Set.fold (\k r -> isLazyKind k || r) False _kinds {-# LINE 2920 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule355 #-} {-# LINE 1290 "src-ag/ExecutionPlan2Caml.ag" #-} rule355 = \ ((_patternIattrs) :: Set String) name_ -> {-# LINE 1290 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton name_ _patternIattrs {-# LINE 2926 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule356 #-} {-# LINE 1291 "src-ag/ExecutionPlan2Caml.ag" #-} rule356 = \ ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) name_ -> {-# LINE 1291 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton name_ _rhsIattrs {-# LINE 2932 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule357 #-} {-# LINE 1485 "src-ag/ExecutionPlan2Caml.ag" #-} rule357 = \ _used mbError_ -> {-# LINE 1485 "src-ag/ExecutionPlan2Caml.ag" #-} case mbError_ of Just e | _used > 0 -> Seq.singleton e _ -> Seq.empty {-# LINE 2940 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule358 #-} rule358 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule359 #-} rule359 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule360 #-} rule360 = \ _anyLazyKind -> _anyLazyKind {-# INLINE rule361 #-} rule361 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule362 #-} rule362 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule363 #-} rule363 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule364 #-} rule364 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule365 #-} rule365 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- ERules ------------------------------------------------------ -- wrapper data Inh_ERules = Inh_ERules { allInhmap_Inh_ERules :: (Map NontermIdent Attributes), allSynmap_Inh_ERules :: (Map NontermIdent Attributes), childTypes_Inh_ERules :: (Map Identifier Type), con_Inh_ERules :: (ConstructorIdent), inhmap_Inh_ERules :: (Attributes), lazyIntras_Inh_ERules :: (Set String), localAttrTypes_Inh_ERules :: (Map Identifier Type), mainFile_Inh_ERules :: (String), mainName_Inh_ERules :: (String), nt_Inh_ERules :: (NontermIdent), options_Inh_ERules :: (Options), ruleKinds_Inh_ERules :: (Map Identifier (Set VisitKind)), synmap_Inh_ERules :: (Attributes), usageInfo_Inh_ERules :: (Map Identifier Int) } data Syn_ERules = Syn_ERules { errors_Syn_ERules :: (Seq Error), mrules_Syn_ERules :: (Map Identifier (VisitKind -> Either Error PP_Doc)), ruledefs_Syn_ERules :: (Map Identifier (Set String)), ruleuses_Syn_ERules :: (Map Identifier (Map String (Maybe NonLocalAttr))), sem_rules_Syn_ERules :: (PP_Doc) } {-# INLINABLE wrap_ERules #-} wrap_ERules :: T_ERules -> Inh_ERules -> (Syn_ERules ) wrap_ERules (T_ERules act) (Inh_ERules _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsIusageInfo) = Control.Monad.Identity.runIdentity ( do sem <- act let arg22 = T_ERules_vIn22 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsIusageInfo (T_ERules_vOut22 _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules) <- return (inv_ERules_s23 sem arg22) return (Syn_ERules _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules) ) -- cata {-# NOINLINE sem_ERules #-} sem_ERules :: ERules -> T_ERules sem_ERules list = Prelude.foldr sem_ERules_Cons sem_ERules_Nil (Prelude.map sem_ERule list) -- semantic domain newtype T_ERules = T_ERules { attach_T_ERules :: Identity (T_ERules_s23 ) } newtype T_ERules_s23 = C_ERules_s23 { inv_ERules_s23 :: (T_ERules_v22 ) } data T_ERules_s24 = C_ERules_s24 type T_ERules_v22 = (T_ERules_vIn22 ) -> (T_ERules_vOut22 ) data T_ERules_vIn22 = T_ERules_vIn22 (Map NontermIdent Attributes) (Map NontermIdent Attributes) (Map Identifier Type) (ConstructorIdent) (Attributes) (Set String) (Map Identifier Type) (String) (String) (NontermIdent) (Options) (Map Identifier (Set VisitKind)) (Attributes) (Map Identifier Int) data T_ERules_vOut22 = T_ERules_vOut22 (Seq Error) (Map Identifier (VisitKind -> Either Error PP_Doc)) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (PP_Doc) {-# NOINLINE sem_ERules_Cons #-} sem_ERules_Cons :: T_ERule -> T_ERules -> T_ERules sem_ERules_Cons arg_hd_ arg_tl_ = T_ERules (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_ERules_v22 v22 = \ (T_ERules_vIn22 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsIusageInfo) -> ( let _hdX20 = Control.Monad.Identity.runIdentity (attach_T_ERule (arg_hd_)) _tlX23 = Control.Monad.Identity.runIdentity (attach_T_ERules (arg_tl_)) (T_ERule_vOut19 _hdIerrors _hdImrules _hdIruledefs _hdIruleuses _hdIsem_rules) = inv_ERule_s20 _hdX20 (T_ERule_vIn19 _hdOallInhmap _hdOallSynmap _hdOchildTypes _hdOcon _hdOinhmap _hdOlazyIntras _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOnt _hdOoptions _hdOruleKinds _hdOsynmap _hdOusageInfo) (T_ERules_vOut22 _tlIerrors _tlImrules _tlIruledefs _tlIruleuses _tlIsem_rules) = inv_ERules_s23 _tlX23 (T_ERules_vIn22 _tlOallInhmap _tlOallSynmap _tlOchildTypes _tlOcon _tlOinhmap _tlOlazyIntras _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOnt _tlOoptions _tlOruleKinds _tlOsynmap _tlOusageInfo) _lhsOerrors :: Seq Error _lhsOerrors = rule366 _hdIerrors _tlIerrors _lhsOmrules :: Map Identifier (VisitKind -> Either Error PP_Doc) _lhsOmrules = rule367 _hdImrules _tlImrules _lhsOruledefs :: Map Identifier (Set String) _lhsOruledefs = rule368 _hdIruledefs _tlIruledefs _lhsOruleuses :: Map Identifier (Map String (Maybe NonLocalAttr)) _lhsOruleuses = rule369 _hdIruleuses _tlIruleuses _lhsOsem_rules :: PP_Doc _lhsOsem_rules = rule370 _hdIsem_rules _tlIsem_rules _hdOallInhmap = rule371 _lhsIallInhmap _hdOallSynmap = rule372 _lhsIallSynmap _hdOchildTypes = rule373 _lhsIchildTypes _hdOcon = rule374 _lhsIcon _hdOinhmap = rule375 _lhsIinhmap _hdOlazyIntras = rule376 _lhsIlazyIntras _hdOlocalAttrTypes = rule377 _lhsIlocalAttrTypes _hdOmainFile = rule378 _lhsImainFile _hdOmainName = rule379 _lhsImainName _hdOnt = rule380 _lhsInt _hdOoptions = rule381 _lhsIoptions _hdOruleKinds = rule382 _lhsIruleKinds _hdOsynmap = rule383 _lhsIsynmap _hdOusageInfo = rule384 _lhsIusageInfo _tlOallInhmap = rule385 _lhsIallInhmap _tlOallSynmap = rule386 _lhsIallSynmap _tlOchildTypes = rule387 _lhsIchildTypes _tlOcon = rule388 _lhsIcon _tlOinhmap = rule389 _lhsIinhmap _tlOlazyIntras = rule390 _lhsIlazyIntras _tlOlocalAttrTypes = rule391 _lhsIlocalAttrTypes _tlOmainFile = rule392 _lhsImainFile _tlOmainName = rule393 _lhsImainName _tlOnt = rule394 _lhsInt _tlOoptions = rule395 _lhsIoptions _tlOruleKinds = rule396 _lhsIruleKinds _tlOsynmap = rule397 _lhsIsynmap _tlOusageInfo = rule398 _lhsIusageInfo __result_ = T_ERules_vOut22 _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules in __result_ ) in C_ERules_s23 v22 {-# INLINE rule366 #-} rule366 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule367 #-} rule367 = \ ((_hdImrules) :: Map Identifier (VisitKind -> Either Error PP_Doc)) ((_tlImrules) :: Map Identifier (VisitKind -> Either Error PP_Doc)) -> _hdImrules `Map.union` _tlImrules {-# INLINE rule368 #-} rule368 = \ ((_hdIruledefs) :: Map Identifier (Set String)) ((_tlIruledefs) :: Map Identifier (Set String)) -> _hdIruledefs `uwSetUnion` _tlIruledefs {-# INLINE rule369 #-} rule369 = \ ((_hdIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) ((_tlIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _hdIruleuses `uwMapUnion` _tlIruleuses {-# INLINE rule370 #-} rule370 = \ ((_hdIsem_rules) :: PP_Doc) ((_tlIsem_rules) :: PP_Doc) -> _hdIsem_rules >-< _tlIsem_rules {-# INLINE rule371 #-} rule371 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule372 #-} rule372 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule373 #-} rule373 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule374 #-} rule374 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule375 #-} rule375 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule376 #-} rule376 = \ ((_lhsIlazyIntras) :: Set String) -> _lhsIlazyIntras {-# INLINE rule377 #-} rule377 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule378 #-} rule378 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule379 #-} rule379 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule380 #-} rule380 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule381 #-} rule381 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule382 #-} rule382 = \ ((_lhsIruleKinds) :: Map Identifier (Set VisitKind)) -> _lhsIruleKinds {-# INLINE rule383 #-} rule383 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule384 #-} rule384 = \ ((_lhsIusageInfo) :: Map Identifier Int) -> _lhsIusageInfo {-# INLINE rule385 #-} rule385 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule386 #-} rule386 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule387 #-} rule387 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule388 #-} rule388 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule389 #-} rule389 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule390 #-} rule390 = \ ((_lhsIlazyIntras) :: Set String) -> _lhsIlazyIntras {-# INLINE rule391 #-} rule391 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule392 #-} rule392 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule393 #-} rule393 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule394 #-} rule394 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule395 #-} rule395 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule396 #-} rule396 = \ ((_lhsIruleKinds) :: Map Identifier (Set VisitKind)) -> _lhsIruleKinds {-# INLINE rule397 #-} rule397 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule398 #-} rule398 = \ ((_lhsIusageInfo) :: Map Identifier Int) -> _lhsIusageInfo {-# NOINLINE sem_ERules_Nil #-} sem_ERules_Nil :: T_ERules sem_ERules_Nil = T_ERules (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_ERules_v22 v22 = \ (T_ERules_vIn22 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsIusageInfo) -> ( let _lhsOerrors :: Seq Error _lhsOerrors = rule399 () _lhsOmrules :: Map Identifier (VisitKind -> Either Error PP_Doc) _lhsOmrules = rule400 () _lhsOruledefs :: Map Identifier (Set String) _lhsOruledefs = rule401 () _lhsOruleuses :: Map Identifier (Map String (Maybe NonLocalAttr)) _lhsOruleuses = rule402 () _lhsOsem_rules :: PP_Doc _lhsOsem_rules = rule403 () __result_ = T_ERules_vOut22 _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules in __result_ ) in C_ERules_s23 v22 {-# INLINE rule399 #-} rule399 = \ (_ :: ()) -> Seq.empty {-# INLINE rule400 #-} rule400 = \ (_ :: ()) -> Map.empty {-# INLINE rule401 #-} rule401 = \ (_ :: ()) -> Map.empty {-# INLINE rule402 #-} rule402 = \ (_ :: ()) -> Map.empty {-# INLINE rule403 #-} rule403 = \ (_ :: ()) -> empty -- ExecutionPlan ----------------------------------------------- -- wrapper data Inh_ExecutionPlan = Inh_ExecutionPlan { inhmap_Inh_ExecutionPlan :: (Map NontermIdent Attributes), localAttrTypes_Inh_ExecutionPlan :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))), mainFile_Inh_ExecutionPlan :: (String), mainName_Inh_ExecutionPlan :: (String), options_Inh_ExecutionPlan :: (Options), synmap_Inh_ExecutionPlan :: (Map NontermIdent Attributes) } data Syn_ExecutionPlan = Syn_ExecutionPlan { code_Syn_ExecutionPlan :: (PP_Doc), datas_Syn_ExecutionPlan :: (PP_Doc), errors_Syn_ExecutionPlan :: (Seq Error), modules_Syn_ExecutionPlan :: (PP_Doc) } {-# INLINABLE wrap_ExecutionPlan #-} wrap_ExecutionPlan :: T_ExecutionPlan -> Inh_ExecutionPlan -> (Syn_ExecutionPlan ) wrap_ExecutionPlan (T_ExecutionPlan act) (Inh_ExecutionPlan _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg25 = T_ExecutionPlan_vIn25 _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap (T_ExecutionPlan_vOut25 _lhsOcode _lhsOdatas _lhsOerrors _lhsOmodules) <- return (inv_ExecutionPlan_s26 sem arg25) return (Syn_ExecutionPlan _lhsOcode _lhsOdatas _lhsOerrors _lhsOmodules) ) -- cata {-# INLINE sem_ExecutionPlan #-} sem_ExecutionPlan :: ExecutionPlan -> T_ExecutionPlan sem_ExecutionPlan ( ExecutionPlan nonts_ typeSyns_ wrappers_ derivings_ ) = sem_ExecutionPlan_ExecutionPlan ( sem_ENonterminals nonts_ ) typeSyns_ wrappers_ derivings_ -- semantic domain newtype T_ExecutionPlan = T_ExecutionPlan { attach_T_ExecutionPlan :: Identity (T_ExecutionPlan_s26 ) } newtype T_ExecutionPlan_s26 = C_ExecutionPlan_s26 { inv_ExecutionPlan_s26 :: (T_ExecutionPlan_v25 ) } data T_ExecutionPlan_s27 = C_ExecutionPlan_s27 type T_ExecutionPlan_v25 = (T_ExecutionPlan_vIn25 ) -> (T_ExecutionPlan_vOut25 ) data T_ExecutionPlan_vIn25 = T_ExecutionPlan_vIn25 (Map NontermIdent Attributes) (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) (String) (String) (Options) (Map NontermIdent Attributes) data T_ExecutionPlan_vOut25 = T_ExecutionPlan_vOut25 (PP_Doc) (PP_Doc) (Seq Error) (PP_Doc) {-# NOINLINE sem_ExecutionPlan_ExecutionPlan #-} sem_ExecutionPlan_ExecutionPlan :: T_ENonterminals -> (TypeSyns) -> (Set NontermIdent) -> (Derivings) -> T_ExecutionPlan sem_ExecutionPlan_ExecutionPlan arg_nonts_ arg_typeSyns_ arg_wrappers_ _ = T_ExecutionPlan (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_ExecutionPlan_v25 v25 = \ (T_ExecutionPlan_vIn25 _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap) -> ( let _nontsX11 = Control.Monad.Identity.runIdentity (attach_T_ENonterminals (arg_nonts_)) (T_ENonterminals_vOut10 _nontsIchildvisit _nontsIcode _nontsIdatas _nontsIerrors _nontsIfromToStates _nontsIinitStates _nontsImodules _nontsIsemFunBndDefs _nontsIsemFunBndTps _nontsIvisitKinds _nontsIvisitdefs _nontsIvisituses) = inv_ENonterminals_s11 _nontsX11 (T_ENonterminals_vIn10 _nontsOallFromToStates _nontsOallInitStates _nontsOallVisitKinds _nontsOallchildvisit _nontsOavisitdefs _nontsOavisituses _nontsOinhmap _nontsOlocalAttrTypes _nontsOmainFile _nontsOmainName _nontsOoptions _nontsOsynmap _nontsOtypeSyns _nontsOwrappers) _lhsOcode :: PP_Doc _lhsOcode = rule404 _nontsIcode _wrappersExtra _lhsOdatas :: PP_Doc _lhsOdatas = rule405 _commonExtra _nontsIdatas _nontsOwrappers = rule406 arg_wrappers_ _nontsOtypeSyns = rule407 arg_typeSyns_ _wrappersExtra = rule408 _lateSemBndDef _lhsIoptions _commonExtra = rule409 _lateSemBndTp _lhsIoptions _lateSemBndTp = rule410 _lhsImainName _nontsIsemFunBndTps _lateSemBndDef = rule411 _lhsImainName _nontsIsemFunBndDefs _nontsOallchildvisit = rule412 _nontsIchildvisit _nontsOavisitdefs = rule413 _nontsIvisitdefs _nontsOavisituses = rule414 _nontsIvisituses _nontsOallFromToStates = rule415 _nontsIfromToStates _nontsOallVisitKinds = rule416 _nontsIvisitKinds _nontsOallInitStates = rule417 _nontsIinitStates _lhsOerrors :: Seq Error _lhsOerrors = rule418 _nontsIerrors _lhsOmodules :: PP_Doc _lhsOmodules = rule419 _nontsImodules _nontsOinhmap = rule420 _lhsIinhmap _nontsOlocalAttrTypes = rule421 _lhsIlocalAttrTypes _nontsOmainFile = rule422 _lhsImainFile _nontsOmainName = rule423 _lhsImainName _nontsOoptions = rule424 _lhsIoptions _nontsOsynmap = rule425 _lhsIsynmap __result_ = T_ExecutionPlan_vOut25 _lhsOcode _lhsOdatas _lhsOerrors _lhsOmodules in __result_ ) in C_ExecutionPlan_s26 v25 {-# INLINE rule404 #-} {-# LINE 105 "src-ag/ExecutionPlan2Caml.ag" #-} rule404 = \ ((_nontsIcode) :: PP_Doc) _wrappersExtra -> {-# LINE 105 "src-ag/ExecutionPlan2Caml.ag" #-} _nontsIcode >-< _wrappersExtra {-# LINE 3256 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule405 #-} {-# LINE 106 "src-ag/ExecutionPlan2Caml.ag" #-} rule405 = \ _commonExtra ((_nontsIdatas) :: PP_Doc) -> {-# LINE 106 "src-ag/ExecutionPlan2Caml.ag" #-} _nontsIdatas >-< _commonExtra {-# LINE 3262 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule406 #-} {-# LINE 112 "src-ag/ExecutionPlan2Caml.ag" #-} rule406 = \ wrappers_ -> {-# LINE 112 "src-ag/ExecutionPlan2Caml.ag" #-} wrappers_ {-# LINE 3268 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule407 #-} {-# LINE 173 "src-ag/ExecutionPlan2Caml.ag" #-} rule407 = \ typeSyns_ -> {-# LINE 173 "src-ag/ExecutionPlan2Caml.ag" #-} typeSyns_ {-# LINE 3274 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule408 #-} {-# LINE 663 "src-ag/ExecutionPlan2Caml.ag" #-} rule408 = \ _lateSemBndDef ((_lhsIoptions) :: Options) -> {-# LINE 663 "src-ag/ExecutionPlan2Caml.ag" #-} if lateHigherOrderBinding _lhsIoptions then _lateSemBndDef else empty {-# LINE 3282 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule409 #-} {-# LINE 666 "src-ag/ExecutionPlan2Caml.ag" #-} rule409 = \ _lateSemBndTp ((_lhsIoptions) :: Options) -> {-# LINE 666 "src-ag/ExecutionPlan2Caml.ag" #-} if lateHigherOrderBinding _lhsIoptions then _lateSemBndTp else empty {-# LINE 3290 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule410 #-} {-# LINE 669 "src-ag/ExecutionPlan2Caml.ag" #-} rule410 = \ ((_lhsImainName) :: String) ((_nontsIsemFunBndTps) :: Seq PP_Doc) -> {-# LINE 669 "src-ag/ExecutionPlan2Caml.ag" #-} "and" >#< lateBindingTypeNm _lhsImainName >#< "=" >#< ppRecordTp (toList _nontsIsemFunBndTps) {-# LINE 3296 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule411 #-} {-# LINE 670 "src-ag/ExecutionPlan2Caml.ag" #-} rule411 = \ ((_lhsImainName) :: String) ((_nontsIsemFunBndDefs) :: Seq PP_Doc) -> {-# LINE 670 "src-ag/ExecutionPlan2Caml.ag" #-} "and" >#< lateBindingFieldNm _lhsImainName >#< ":" >#< lateBindingTypeNm _lhsImainName >#< "=" >-< (indent 2 $ ppRecordVal $ toList _nontsIsemFunBndDefs) {-# LINE 3303 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule412 #-} {-# LINE 1157 "src-ag/ExecutionPlan2Caml.ag" #-} rule412 = \ ((_nontsIchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> {-# LINE 1157 "src-ag/ExecutionPlan2Caml.ag" #-} _nontsIchildvisit {-# LINE 3309 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule413 #-} {-# LINE 1315 "src-ag/ExecutionPlan2Caml.ag" #-} rule413 = \ ((_nontsIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> {-# LINE 1315 "src-ag/ExecutionPlan2Caml.ag" #-} _nontsIvisitdefs {-# LINE 3315 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule414 #-} {-# LINE 1316 "src-ag/ExecutionPlan2Caml.ag" #-} rule414 = \ ((_nontsIvisituses) :: Map VisitIdentifier (Set Identifier)) -> {-# LINE 1316 "src-ag/ExecutionPlan2Caml.ag" #-} _nontsIvisituses {-# LINE 3321 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule415 #-} {-# LINE 1407 "src-ag/ExecutionPlan2Caml.ag" #-} rule415 = \ ((_nontsIfromToStates) :: Map VisitIdentifier (Int,Int)) -> {-# LINE 1407 "src-ag/ExecutionPlan2Caml.ag" #-} _nontsIfromToStates {-# LINE 3327 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule416 #-} {-# LINE 1451 "src-ag/ExecutionPlan2Caml.ag" #-} rule416 = \ ((_nontsIvisitKinds) :: Map VisitIdentifier VisitKind) -> {-# LINE 1451 "src-ag/ExecutionPlan2Caml.ag" #-} _nontsIvisitKinds {-# LINE 3333 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule417 #-} {-# LINE 1465 "src-ag/ExecutionPlan2Caml.ag" #-} rule417 = \ ((_nontsIinitStates) :: Map NontermIdent Int) -> {-# LINE 1465 "src-ag/ExecutionPlan2Caml.ag" #-} _nontsIinitStates {-# LINE 3339 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule418 #-} rule418 = \ ((_nontsIerrors) :: Seq Error) -> _nontsIerrors {-# INLINE rule419 #-} rule419 = \ ((_nontsImodules) :: PP_Doc) -> _nontsImodules {-# INLINE rule420 #-} rule420 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) -> _lhsIinhmap {-# INLINE rule421 #-} rule421 = \ ((_lhsIlocalAttrTypes) :: Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) -> _lhsIlocalAttrTypes {-# INLINE rule422 #-} rule422 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule423 #-} rule423 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule424 #-} rule424 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule425 #-} rule425 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) -> _lhsIsynmap -- Expression -------------------------------------------------- -- wrapper data Inh_Expression = Inh_Expression { options_Inh_Expression :: (Options) } data Syn_Expression = Syn_Expression { attrs_Syn_Expression :: (Map String (Maybe NonLocalAttr)), pos_Syn_Expression :: (Pos), semfunc_Syn_Expression :: (PP_Doc), tks_Syn_Expression :: ([HsToken]) } {-# INLINABLE wrap_Expression #-} wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) wrap_Expression (T_Expression act) (Inh_Expression _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg28 = T_Expression_vIn28 _lhsIoptions (T_Expression_vOut28 _lhsOattrs _lhsOpos _lhsOsemfunc _lhsOtks) <- return (inv_Expression_s29 sem arg28) return (Syn_Expression _lhsOattrs _lhsOpos _lhsOsemfunc _lhsOtks) ) -- cata {-# INLINE sem_Expression #-} sem_Expression :: Expression -> T_Expression sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_ -- semantic domain newtype T_Expression = T_Expression { attach_T_Expression :: Identity (T_Expression_s29 ) } newtype T_Expression_s29 = C_Expression_s29 { inv_Expression_s29 :: (T_Expression_v28 ) } data T_Expression_s30 = C_Expression_s30 type T_Expression_v28 = (T_Expression_vIn28 ) -> (T_Expression_vOut28 ) data T_Expression_vIn28 = T_Expression_vIn28 (Options) data T_Expression_vOut28 = T_Expression_vOut28 (Map String (Maybe NonLocalAttr)) (Pos) (PP_Doc) ([HsToken]) {-# NOINLINE sem_Expression_Expression #-} sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression sem_Expression_Expression arg_pos_ arg_tks_ = T_Expression (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Expression_v28 v28 = \ (T_Expression_vIn28 _lhsIoptions) -> ( let _lhsOtks :: [HsToken] _lhsOtks = rule426 arg_tks_ _lhsOpos :: Pos _lhsOpos = rule427 arg_pos_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule428 _inhhstoken arg_tks_ _lhsOsemfunc :: PP_Doc _lhsOsemfunc = rule429 _inhhstoken arg_tks_ _inhhstoken = rule430 _lhsIoptions __result_ = T_Expression_vOut28 _lhsOattrs _lhsOpos _lhsOsemfunc _lhsOtks in __result_ ) in C_Expression_s29 v28 {-# INLINE rule426 #-} {-# LINE 1028 "src-ag/ExecutionPlan2Caml.ag" #-} rule426 = \ tks_ -> {-# LINE 1028 "src-ag/ExecutionPlan2Caml.ag" #-} tks_ {-# LINE 3419 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule427 #-} {-# LINE 1049 "src-ag/ExecutionPlan2Caml.ag" #-} rule427 = \ pos_ -> {-# LINE 1049 "src-ag/ExecutionPlan2Caml.ag" #-} pos_ {-# LINE 3425 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule428 #-} {-# LINE 1141 "src-ag/ExecutionPlan2Caml.ag" #-} rule428 = \ _inhhstoken tks_ -> {-# LINE 1141 "src-ag/ExecutionPlan2Caml.ag" #-} Map.unions $ map (\tok -> attrs_Syn_HsToken (wrap_HsToken (sem_HsToken tok) _inhhstoken )) tks_ {-# LINE 3431 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule429 #-} {-# LINE 1142 "src-ag/ExecutionPlan2Caml.ag" #-} rule429 = \ _inhhstoken tks_ -> {-# LINE 1142 "src-ag/ExecutionPlan2Caml.ag" #-} vlist $ showTokens $ map (\tok -> tok_Syn_HsToken (wrap_HsToken (sem_HsToken tok) _inhhstoken )) tks_ {-# LINE 3437 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule430 #-} {-# LINE 1143 "src-ag/ExecutionPlan2Caml.ag" #-} rule430 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1143 "src-ag/ExecutionPlan2Caml.ag" #-} Inh_HsToken _lhsIoptions {-# LINE 3443 "dist/build/ExecutionPlan2Caml.hs"#-} -- HsToken ----------------------------------------------------- -- wrapper data Inh_HsToken = Inh_HsToken { options_Inh_HsToken :: (Options) } data Syn_HsToken = Syn_HsToken { attrs_Syn_HsToken :: (Map String (Maybe NonLocalAttr)), tok_Syn_HsToken :: ((Pos,String)) } {-# INLINABLE wrap_HsToken #-} wrap_HsToken :: T_HsToken -> Inh_HsToken -> (Syn_HsToken ) wrap_HsToken (T_HsToken act) (Inh_HsToken _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg31 = T_HsToken_vIn31 _lhsIoptions (T_HsToken_vOut31 _lhsOattrs _lhsOtok) <- return (inv_HsToken_s32 sem arg31) return (Syn_HsToken _lhsOattrs _lhsOtok) ) -- cata {-# NOINLINE sem_HsToken #-} sem_HsToken :: HsToken -> T_HsToken sem_HsToken ( AGLocal var_ pos_ rdesc_ ) = sem_HsToken_AGLocal var_ pos_ rdesc_ sem_HsToken ( AGField field_ attr_ pos_ rdesc_ ) = sem_HsToken_AGField field_ attr_ pos_ rdesc_ sem_HsToken ( HsToken value_ pos_ ) = sem_HsToken_HsToken value_ pos_ sem_HsToken ( CharToken value_ pos_ ) = sem_HsToken_CharToken value_ pos_ sem_HsToken ( StrToken value_ pos_ ) = sem_HsToken_StrToken value_ pos_ sem_HsToken ( Err mesg_ pos_ ) = sem_HsToken_Err mesg_ pos_ -- semantic domain newtype T_HsToken = T_HsToken { attach_T_HsToken :: Identity (T_HsToken_s32 ) } newtype T_HsToken_s32 = C_HsToken_s32 { inv_HsToken_s32 :: (T_HsToken_v31 ) } data T_HsToken_s33 = C_HsToken_s33 type T_HsToken_v31 = (T_HsToken_vIn31 ) -> (T_HsToken_vOut31 ) data T_HsToken_vIn31 = T_HsToken_vIn31 (Options) data T_HsToken_vOut31 = T_HsToken_vOut31 (Map String (Maybe NonLocalAttr)) ((Pos,String)) {-# NOINLINE sem_HsToken_AGLocal #-} sem_HsToken_AGLocal :: (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGLocal arg_var_ arg_pos_ _ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule431 arg_var_ _tok = rule432 arg_pos_ arg_var_ _lhsOtok :: (Pos,String) _lhsOtok = rule433 _tok __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule431 #-} {-# LINE 1100 "src-ag/ExecutionPlan2Caml.ag" #-} rule431 = \ var_ -> {-# LINE 1100 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton (fieldname var_) Nothing {-# LINE 3500 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule432 #-} {-# LINE 1363 "src-ag/ExecutionPlan2Caml.ag" #-} rule432 = \ pos_ var_ -> {-# LINE 1363 "src-ag/ExecutionPlan2Caml.ag" #-} (pos_,fieldname var_) {-# LINE 3506 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule433 #-} rule433 = \ _tok -> _tok {-# NOINLINE sem_HsToken_AGField #-} sem_HsToken_AGField :: (Identifier) -> (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGField arg_field_ arg_attr_ arg_pos_ arg_rdesc_ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _mbAttr = rule434 arg_attr_ arg_field_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule435 _lhsIoptions _mbAttr arg_attr_ arg_field_ _addTrace = rule436 arg_attr_ arg_field_ arg_rdesc_ _lhsOtok :: (Pos,String) _lhsOtok = rule437 _addTrace _lhsIoptions arg_attr_ arg_field_ arg_pos_ __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule434 #-} {-# LINE 1101 "src-ag/ExecutionPlan2Caml.ag" #-} rule434 = \ attr_ field_ -> {-# LINE 1101 "src-ag/ExecutionPlan2Caml.ag" #-} if field_ == _INST || field_ == _FIELD || field_ == _INST' then Nothing else Just $ mkNonLocalAttr (field_ == _LHS) field_ attr_ {-# LINE 3533 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule435 #-} {-# LINE 1104 "src-ag/ExecutionPlan2Caml.ag" #-} rule435 = \ ((_lhsIoptions) :: Options) _mbAttr attr_ field_ -> {-# LINE 1104 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton (attrname _lhsIoptions True field_ attr_) _mbAttr {-# LINE 3539 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule436 #-} {-# LINE 1367 "src-ag/ExecutionPlan2Caml.ag" #-} rule436 = \ attr_ field_ rdesc_ -> {-# LINE 1367 "src-ag/ExecutionPlan2Caml.ag" #-} case rdesc_ of Just d -> \x -> "(prerr_endline " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ "; " ++ x ++ ")" Nothing -> id {-# LINE 3547 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule437 #-} {-# LINE 1370 "src-ag/ExecutionPlan2Caml.ag" #-} rule437 = \ _addTrace ((_lhsIoptions) :: Options) attr_ field_ pos_ -> {-# LINE 1370 "src-ag/ExecutionPlan2Caml.ag" #-} (pos_, _addTrace $ attrname _lhsIoptions True field_ attr_) {-# LINE 3553 "dist/build/ExecutionPlan2Caml.hs"#-} {-# NOINLINE sem_HsToken_HsToken #-} sem_HsToken_HsToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_HsToken arg_value_ arg_pos_ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _lhsOtok :: (Pos,String) _lhsOtok = rule438 arg_pos_ arg_value_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule439 () __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule438 #-} {-# LINE 1372 "src-ag/ExecutionPlan2Caml.ag" #-} rule438 = \ pos_ value_ -> {-# LINE 1372 "src-ag/ExecutionPlan2Caml.ag" #-} (pos_, value_) {-# LINE 3573 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule439 #-} rule439 = \ (_ :: ()) -> Map.empty {-# NOINLINE sem_HsToken_CharToken #-} sem_HsToken_CharToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_CharToken arg_value_ arg_pos_ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _lhsOtok :: (Pos,String) _lhsOtok = rule440 arg_pos_ arg_value_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule441 () __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule440 #-} {-# LINE 1374 "src-ag/ExecutionPlan2Caml.ag" #-} rule440 = \ pos_ value_ -> {-# LINE 1374 "src-ag/ExecutionPlan2Caml.ag" #-} (pos_, if null value_ then "" else showCharShort (head value_) ) {-# LINE 3599 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule441 #-} rule441 = \ (_ :: ()) -> Map.empty {-# NOINLINE sem_HsToken_StrToken #-} sem_HsToken_StrToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_StrToken arg_value_ arg_pos_ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _lhsOtok :: (Pos,String) _lhsOtok = rule442 arg_pos_ arg_value_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule443 () __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule442 #-} {-# LINE 1379 "src-ag/ExecutionPlan2Caml.ag" #-} rule442 = \ pos_ value_ -> {-# LINE 1379 "src-ag/ExecutionPlan2Caml.ag" #-} (pos_, showStrShort value_) {-# LINE 3622 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule443 #-} rule443 = \ (_ :: ()) -> Map.empty {-# NOINLINE sem_HsToken_Err #-} sem_HsToken_Err :: (String) -> (Pos) -> T_HsToken sem_HsToken_Err _ arg_pos_ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _lhsOtok :: (Pos,String) _lhsOtok = rule444 arg_pos_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule445 () __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule444 #-} {-# LINE 1380 "src-ag/ExecutionPlan2Caml.ag" #-} rule444 = \ pos_ -> {-# LINE 1380 "src-ag/ExecutionPlan2Caml.ag" #-} (pos_, "") {-# LINE 3645 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule445 #-} rule445 = \ (_ :: ()) -> Map.empty -- HsTokens ---------------------------------------------------- -- wrapper data Inh_HsTokens = Inh_HsTokens { options_Inh_HsTokens :: (Options) } data Syn_HsTokens = Syn_HsTokens { tks_Syn_HsTokens :: ([(Pos,String)]) } {-# INLINABLE wrap_HsTokens #-} wrap_HsTokens :: T_HsTokens -> Inh_HsTokens -> (Syn_HsTokens ) wrap_HsTokens (T_HsTokens act) (Inh_HsTokens _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg34 = T_HsTokens_vIn34 _lhsIoptions (T_HsTokens_vOut34 _lhsOtks) <- return (inv_HsTokens_s35 sem arg34) return (Syn_HsTokens _lhsOtks) ) -- cata {-# NOINLINE sem_HsTokens #-} sem_HsTokens :: HsTokens -> T_HsTokens sem_HsTokens list = Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) -- semantic domain newtype T_HsTokens = T_HsTokens { attach_T_HsTokens :: Identity (T_HsTokens_s35 ) } newtype T_HsTokens_s35 = C_HsTokens_s35 { inv_HsTokens_s35 :: (T_HsTokens_v34 ) } data T_HsTokens_s36 = C_HsTokens_s36 type T_HsTokens_v34 = (T_HsTokens_vIn34 ) -> (T_HsTokens_vOut34 ) data T_HsTokens_vIn34 = T_HsTokens_vIn34 (Options) data T_HsTokens_vOut34 = T_HsTokens_vOut34 ([(Pos,String)]) {-# NOINLINE sem_HsTokens_Cons #-} sem_HsTokens_Cons :: T_HsToken -> T_HsTokens -> T_HsTokens sem_HsTokens_Cons arg_hd_ arg_tl_ = T_HsTokens (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_HsTokens_v34 v34 = \ (T_HsTokens_vIn34 _lhsIoptions) -> ( let _hdX32 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_)) _tlX35 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_)) (T_HsToken_vOut31 _hdIattrs _hdItok) = inv_HsToken_s32 _hdX32 (T_HsToken_vIn31 _hdOoptions) (T_HsTokens_vOut34 _tlItks) = inv_HsTokens_s35 _tlX35 (T_HsTokens_vIn34 _tlOoptions) _lhsOtks :: [(Pos,String)] _lhsOtks = rule446 _hdItok _tlItks _hdOoptions = rule447 _lhsIoptions _tlOoptions = rule448 _lhsIoptions __result_ = T_HsTokens_vOut34 _lhsOtks in __result_ ) in C_HsTokens_s35 v34 {-# INLINE rule446 #-} {-# LINE 1359 "src-ag/ExecutionPlan2Caml.ag" #-} rule446 = \ ((_hdItok) :: (Pos,String)) ((_tlItks) :: [(Pos,String)]) -> {-# LINE 1359 "src-ag/ExecutionPlan2Caml.ag" #-} _hdItok : _tlItks {-# LINE 3703 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule447 #-} rule447 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule448 #-} rule448 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_HsTokens_Nil #-} sem_HsTokens_Nil :: T_HsTokens sem_HsTokens_Nil = T_HsTokens (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_HsTokens_v34 v34 = \ (T_HsTokens_vIn34 _lhsIoptions) -> ( let _lhsOtks :: [(Pos,String)] _lhsOtks = rule449 () __result_ = T_HsTokens_vOut34 _lhsOtks in __result_ ) in C_HsTokens_s35 v34 {-# INLINE rule449 #-} {-# LINE 1360 "src-ag/ExecutionPlan2Caml.ag" #-} rule449 = \ (_ :: ()) -> {-# LINE 1360 "src-ag/ExecutionPlan2Caml.ag" #-} [] {-# LINE 3727 "dist/build/ExecutionPlan2Caml.hs"#-} -- HsTokensRoot ------------------------------------------------ -- wrapper data Inh_HsTokensRoot = Inh_HsTokensRoot { options_Inh_HsTokensRoot :: (Options) } data Syn_HsTokensRoot = Syn_HsTokensRoot { } {-# INLINABLE wrap_HsTokensRoot #-} wrap_HsTokensRoot :: T_HsTokensRoot -> Inh_HsTokensRoot -> (Syn_HsTokensRoot ) wrap_HsTokensRoot (T_HsTokensRoot act) (Inh_HsTokensRoot _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg37 = T_HsTokensRoot_vIn37 _lhsIoptions (T_HsTokensRoot_vOut37 ) <- return (inv_HsTokensRoot_s38 sem arg37) return (Syn_HsTokensRoot ) ) -- cata {-# INLINE sem_HsTokensRoot #-} sem_HsTokensRoot :: HsTokensRoot -> T_HsTokensRoot sem_HsTokensRoot ( HsTokensRoot tokens_ ) = sem_HsTokensRoot_HsTokensRoot ( sem_HsTokens tokens_ ) -- semantic domain newtype T_HsTokensRoot = T_HsTokensRoot { attach_T_HsTokensRoot :: Identity (T_HsTokensRoot_s38 ) } newtype T_HsTokensRoot_s38 = C_HsTokensRoot_s38 { inv_HsTokensRoot_s38 :: (T_HsTokensRoot_v37 ) } data T_HsTokensRoot_s39 = C_HsTokensRoot_s39 type T_HsTokensRoot_v37 = (T_HsTokensRoot_vIn37 ) -> (T_HsTokensRoot_vOut37 ) data T_HsTokensRoot_vIn37 = T_HsTokensRoot_vIn37 (Options) data T_HsTokensRoot_vOut37 = T_HsTokensRoot_vOut37 {-# NOINLINE sem_HsTokensRoot_HsTokensRoot #-} sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> T_HsTokensRoot sem_HsTokensRoot_HsTokensRoot arg_tokens_ = T_HsTokensRoot (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_HsTokensRoot_v37 v37 = \ (T_HsTokensRoot_vIn37 _lhsIoptions) -> ( let _tokensX35 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tokens_)) (T_HsTokens_vOut34 _tokensItks) = inv_HsTokens_s35 _tokensX35 (T_HsTokens_vIn34 _tokensOoptions) _tokensOoptions = rule450 _lhsIoptions __result_ = T_HsTokensRoot_vOut37 in __result_ ) in C_HsTokensRoot_s38 v37 {-# INLINE rule450 #-} rule450 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { allInhmap_Inh_Pattern :: (Map NontermIdent Attributes), allSynmap_Inh_Pattern :: (Map NontermIdent Attributes), anyLazyKind_Inh_Pattern :: (Bool), inhmap_Inh_Pattern :: (Attributes), localAttrTypes_Inh_Pattern :: (Map Identifier Type), options_Inh_Pattern :: (Options), synmap_Inh_Pattern :: (Attributes) } data Syn_Pattern = Syn_Pattern { attrTypes_Syn_Pattern :: (PP_Doc), attrs_Syn_Pattern :: (Set String), copy_Syn_Pattern :: (Pattern), extraDefs_Syn_Pattern :: ([(PP_Doc,PP_Doc)]), isUnderscore_Syn_Pattern :: (Bool), sem_lhs_Syn_Pattern :: ( PP_Doc ) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern (T_Pattern act) (Inh_Pattern _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg40 = T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap (T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOextraDefs _lhsOisUnderscore _lhsOsem_lhs) <- return (inv_Pattern_s41 sem arg40) return (Syn_Pattern _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOextraDefs _lhsOisUnderscore _lhsOsem_lhs) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s41 ) } newtype T_Pattern_s41 = C_Pattern_s41 { inv_Pattern_s41 :: (T_Pattern_v40 ) } data T_Pattern_s42 = C_Pattern_s42 type T_Pattern_v40 = (T_Pattern_vIn40 ) -> (T_Pattern_vOut40 ) data T_Pattern_vIn40 = T_Pattern_vIn40 (Map NontermIdent Attributes) (Map NontermIdent Attributes) (Bool) (Attributes) (Map Identifier Type) (Options) (Attributes) data T_Pattern_vOut40 = T_Pattern_vOut40 (PP_Doc) (Set String) (Pattern) ([(PP_Doc,PP_Doc)]) (Bool) ( PP_Doc ) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIattrTypes _patsIattrs _patsIcopy _patsIextraDefs _patsIsem_lhs) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 _patsOallInhmap _patsOallSynmap _patsOanyLazyKind _patsOinhmap _patsOlocalAttrTypes _patsOoptions _patsOsynmap) _lhsOsem_lhs :: PP_Doc _lhsOsem_lhs = rule451 _patsIsem_lhs arg_name_ _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule452 () _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule453 _patsIattrTypes _lhsOattrs :: Set String _lhsOattrs = rule454 _patsIattrs _lhsOextraDefs :: [(PP_Doc,PP_Doc)] _lhsOextraDefs = rule455 _patsIextraDefs _copy = rule456 _patsIcopy arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule457 _copy _patsOallInhmap = rule458 _lhsIallInhmap _patsOallSynmap = rule459 _lhsIallSynmap _patsOanyLazyKind = rule460 _lhsIanyLazyKind _patsOinhmap = rule461 _lhsIinhmap _patsOlocalAttrTypes = rule462 _lhsIlocalAttrTypes _patsOoptions = rule463 _lhsIoptions _patsOsynmap = rule464 _lhsIsynmap __result_ = T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOextraDefs _lhsOisUnderscore _lhsOsem_lhs in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule451 #-} {-# LINE 1066 "src-ag/ExecutionPlan2Caml.ag" #-} rule451 = \ ((_patsIsem_lhs) :: [PP_Doc]) name_ -> {-# LINE 1066 "src-ag/ExecutionPlan2Caml.ag" #-} pp_parens $ name_ >#< pp_block "(" ")" "," _patsIsem_lhs {-# LINE 3847 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule452 #-} {-# LINE 1075 "src-ag/ExecutionPlan2Caml.ag" #-} rule452 = \ (_ :: ()) -> {-# LINE 1075 "src-ag/ExecutionPlan2Caml.ag" #-} False {-# LINE 3853 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule453 #-} rule453 = \ ((_patsIattrTypes) :: PP_Doc) -> _patsIattrTypes {-# INLINE rule454 #-} rule454 = \ ((_patsIattrs) :: Set String) -> _patsIattrs {-# INLINE rule455 #-} rule455 = \ ((_patsIextraDefs) :: [(PP_Doc,PP_Doc)]) -> _patsIextraDefs {-# INLINE rule456 #-} rule456 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule457 #-} rule457 = \ _copy -> _copy {-# INLINE rule458 #-} rule458 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule459 #-} rule459 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule460 #-} rule460 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule461 #-} rule461 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule462 #-} rule462 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule463 #-} rule463 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule464 #-} rule464 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIattrTypes _patsIattrs _patsIcopy _patsIextraDefs _patsIsem_lhs) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 _patsOallInhmap _patsOallSynmap _patsOanyLazyKind _patsOinhmap _patsOlocalAttrTypes _patsOoptions _patsOsynmap) _lhsOsem_lhs :: PP_Doc _lhsOsem_lhs = rule465 _patsIsem_lhs _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule466 () _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule467 _patsIattrTypes _lhsOattrs :: Set String _lhsOattrs = rule468 _patsIattrs _lhsOextraDefs :: [(PP_Doc,PP_Doc)] _lhsOextraDefs = rule469 _patsIextraDefs _copy = rule470 _patsIcopy arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule471 _copy _patsOallInhmap = rule472 _lhsIallInhmap _patsOallSynmap = rule473 _lhsIallSynmap _patsOanyLazyKind = rule474 _lhsIanyLazyKind _patsOinhmap = rule475 _lhsIinhmap _patsOlocalAttrTypes = rule476 _lhsIlocalAttrTypes _patsOoptions = rule477 _lhsIoptions _patsOsynmap = rule478 _lhsIsynmap __result_ = T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOextraDefs _lhsOisUnderscore _lhsOsem_lhs in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule465 #-} {-# LINE 1065 "src-ag/ExecutionPlan2Caml.ag" #-} rule465 = \ ((_patsIsem_lhs) :: [PP_Doc]) -> {-# LINE 1065 "src-ag/ExecutionPlan2Caml.ag" #-} pp_block "(" ")" "," _patsIsem_lhs {-# LINE 3927 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule466 #-} {-# LINE 1076 "src-ag/ExecutionPlan2Caml.ag" #-} rule466 = \ (_ :: ()) -> {-# LINE 1076 "src-ag/ExecutionPlan2Caml.ag" #-} False {-# LINE 3933 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule467 #-} rule467 = \ ((_patsIattrTypes) :: PP_Doc) -> _patsIattrTypes {-# INLINE rule468 #-} rule468 = \ ((_patsIattrs) :: Set String) -> _patsIattrs {-# INLINE rule469 #-} rule469 = \ ((_patsIextraDefs) :: [(PP_Doc,PP_Doc)]) -> _patsIextraDefs {-# INLINE rule470 #-} rule470 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule471 #-} rule471 = \ _copy -> _copy {-# INLINE rule472 #-} rule472 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule473 #-} rule473 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule474 #-} rule474 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule475 #-} rule475 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule476 #-} rule476 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule477 #-} rule477 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule478 #-} rule478 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIattrTypes _patIattrs _patIcopy _patIextraDefs _patIisUnderscore _patIsem_lhs) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 _patOallInhmap _patOallSynmap _patOanyLazyKind _patOinhmap _patOlocalAttrTypes _patOoptions _patOsynmap) _var = rule479 _lhsIoptions arg_attr_ arg_field_ _hasTp = rule480 _mbTp _o_sigs = rule481 _lhsIoptions _lhsOsem_lhs :: PP_Doc _lhsOsem_lhs = rule482 _hasTp _mbTp _o_sigs _var _lhsOextraDefs :: [(PP_Doc,PP_Doc)] _lhsOextraDefs = rule483 _patIisUnderscore _patIsem_lhs _var _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule484 () _lhsOattrs :: Set String _lhsOattrs = rule485 _lhsIoptions _patIattrs arg_attr_ arg_field_ _mbTp = rule486 _lhsIlocalAttrTypes _lhsIsynmap arg_attr_ arg_field_ _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule487 _lhsIoptions _mbTp _patIattrTypes arg_attr_ arg_field_ _copy = rule488 _patIcopy arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule489 _copy _patOallInhmap = rule490 _lhsIallInhmap _patOallSynmap = rule491 _lhsIallSynmap _patOanyLazyKind = rule492 _lhsIanyLazyKind _patOinhmap = rule493 _lhsIinhmap _patOlocalAttrTypes = rule494 _lhsIlocalAttrTypes _patOoptions = rule495 _lhsIoptions _patOsynmap = rule496 _lhsIsynmap __result_ = T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOextraDefs _lhsOisUnderscore _lhsOsem_lhs in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule479 #-} {-# LINE 1057 "src-ag/ExecutionPlan2Caml.ag" #-} rule479 = \ ((_lhsIoptions) :: Options) attr_ field_ -> {-# LINE 1057 "src-ag/ExecutionPlan2Caml.ag" #-} text $ attrname _lhsIoptions False field_ attr_ {-# LINE 4011 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule480 #-} {-# LINE 1058 "src-ag/ExecutionPlan2Caml.ag" #-} rule480 = \ _mbTp -> {-# LINE 1058 "src-ag/ExecutionPlan2Caml.ag" #-} isJust _mbTp {-# LINE 4017 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule481 #-} {-# LINE 1059 "src-ag/ExecutionPlan2Caml.ag" #-} rule481 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1059 "src-ag/ExecutionPlan2Caml.ag" #-} typeSigs _lhsIoptions {-# LINE 4023 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule482 #-} {-# LINE 1061 "src-ag/ExecutionPlan2Caml.ag" #-} rule482 = \ _hasTp _mbTp _o_sigs _var -> {-# LINE 1061 "src-ag/ExecutionPlan2Caml.ag" #-} ppArg (_hasTp && _o_sigs ) _var (maybe (text "?no type?") ppTp _mbTp ) {-# LINE 4029 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule483 #-} {-# LINE 1062 "src-ag/ExecutionPlan2Caml.ag" #-} rule483 = \ ((_patIisUnderscore) :: Bool) ((_patIsem_lhs) :: PP_Doc ) _var -> {-# LINE 1062 "src-ag/ExecutionPlan2Caml.ag" #-} if _patIisUnderscore then [] else [ (_patIsem_lhs, _var ) ] {-# LINE 4037 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule484 #-} {-# LINE 1077 "src-ag/ExecutionPlan2Caml.ag" #-} rule484 = \ (_ :: ()) -> {-# LINE 1077 "src-ag/ExecutionPlan2Caml.ag" #-} False {-# LINE 4043 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule485 #-} {-# LINE 1083 "src-ag/ExecutionPlan2Caml.ag" #-} rule485 = \ ((_lhsIoptions) :: Options) ((_patIattrs) :: Set String) attr_ field_ -> {-# LINE 1083 "src-ag/ExecutionPlan2Caml.ag" #-} Set.insert (attrname _lhsIoptions False field_ attr_) _patIattrs {-# LINE 4049 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule486 #-} {-# LINE 1089 "src-ag/ExecutionPlan2Caml.ag" #-} rule486 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) ((_lhsIsynmap) :: Attributes) attr_ field_ -> {-# LINE 1089 "src-ag/ExecutionPlan2Caml.ag" #-} if field_ == _LHS then Map.lookup attr_ _lhsIsynmap else if field_ == _LOC then Map.lookup attr_ _lhsIlocalAttrTypes else Nothing {-# LINE 4059 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule487 #-} {-# LINE 1094 "src-ag/ExecutionPlan2Caml.ag" #-} rule487 = \ ((_lhsIoptions) :: Options) _mbTp ((_patIattrTypes) :: PP_Doc) attr_ field_ -> {-# LINE 1094 "src-ag/ExecutionPlan2Caml.ag" #-} maybe empty (\tp -> (attrname _lhsIoptions False field_ attr_) >#< "::" >#< ppTp tp) _mbTp >-< _patIattrTypes {-# LINE 4066 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule488 #-} rule488 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule489 #-} rule489 = \ _copy -> _copy {-# INLINE rule490 #-} rule490 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule491 #-} rule491 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule492 #-} rule492 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule493 #-} rule493 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule494 #-} rule494 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule495 #-} rule495 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule496 #-} rule496 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIattrTypes _patIattrs _patIcopy _patIextraDefs _patIisUnderscore _patIsem_lhs) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 _patOallInhmap _patOallSynmap _patOanyLazyKind _patOinhmap _patOlocalAttrTypes _patOoptions _patOsynmap) _lhsOsem_lhs :: PP_Doc _lhsOsem_lhs = rule497 _patIsem_lhs _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule498 _patIattrTypes _lhsOattrs :: Set String _lhsOattrs = rule499 _patIattrs _lhsOextraDefs :: [(PP_Doc,PP_Doc)] _lhsOextraDefs = rule500 _patIextraDefs _copy = rule501 _patIcopy _lhsOcopy :: Pattern _lhsOcopy = rule502 _copy _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule503 _patIisUnderscore _patOallInhmap = rule504 _lhsIallInhmap _patOallSynmap = rule505 _lhsIallSynmap _patOanyLazyKind = rule506 _lhsIanyLazyKind _patOinhmap = rule507 _lhsIinhmap _patOlocalAttrTypes = rule508 _lhsIlocalAttrTypes _patOoptions = rule509 _lhsIoptions _patOsynmap = rule510 _lhsIsynmap __result_ = T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOextraDefs _lhsOisUnderscore _lhsOsem_lhs in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule497 #-} {-# LINE 1068 "src-ag/ExecutionPlan2Caml.ag" #-} rule497 = \ ((_patIsem_lhs) :: PP_Doc ) -> {-# LINE 1068 "src-ag/ExecutionPlan2Caml.ag" #-} pp_parens (text "lazy" >#< _patIsem_lhs) {-# LINE 4131 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule498 #-} rule498 = \ ((_patIattrTypes) :: PP_Doc) -> _patIattrTypes {-# INLINE rule499 #-} rule499 = \ ((_patIattrs) :: Set String) -> _patIattrs {-# INLINE rule500 #-} rule500 = \ ((_patIextraDefs) :: [(PP_Doc,PP_Doc)]) -> _patIextraDefs {-# INLINE rule501 #-} rule501 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule502 #-} rule502 = \ _copy -> _copy {-# INLINE rule503 #-} rule503 = \ ((_patIisUnderscore) :: Bool) -> _patIisUnderscore {-# INLINE rule504 #-} rule504 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule505 #-} rule505 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule506 #-} rule506 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule507 #-} rule507 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule508 #-} rule508 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule509 #-} rule509 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule510 #-} rule510 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore arg_pos_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _lhsOsem_lhs :: PP_Doc _lhsOsem_lhs = rule511 () _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule512 () _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule513 () _lhsOattrs :: Set String _lhsOattrs = rule514 () _lhsOextraDefs :: [(PP_Doc,PP_Doc)] _lhsOextraDefs = rule515 () _copy = rule516 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule517 _copy __result_ = T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOextraDefs _lhsOisUnderscore _lhsOsem_lhs in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule511 #-} {-# LINE 1067 "src-ag/ExecutionPlan2Caml.ag" #-} rule511 = \ (_ :: ()) -> {-# LINE 1067 "src-ag/ExecutionPlan2Caml.ag" #-} text "_" {-# LINE 4199 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule512 #-} {-# LINE 1078 "src-ag/ExecutionPlan2Caml.ag" #-} rule512 = \ (_ :: ()) -> {-# LINE 1078 "src-ag/ExecutionPlan2Caml.ag" #-} True {-# LINE 4205 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule513 #-} rule513 = \ (_ :: ()) -> empty {-# INLINE rule514 #-} rule514 = \ (_ :: ()) -> Set.empty {-# INLINE rule515 #-} rule515 = \ (_ :: ()) -> [] {-# INLINE rule516 #-} rule516 = \ pos_ -> Underscore pos_ {-# INLINE rule517 #-} rule517 = \ _copy -> _copy -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { allInhmap_Inh_Patterns :: (Map NontermIdent Attributes), allSynmap_Inh_Patterns :: (Map NontermIdent Attributes), anyLazyKind_Inh_Patterns :: (Bool), inhmap_Inh_Patterns :: (Attributes), localAttrTypes_Inh_Patterns :: (Map Identifier Type), options_Inh_Patterns :: (Options), synmap_Inh_Patterns :: (Attributes) } data Syn_Patterns = Syn_Patterns { attrTypes_Syn_Patterns :: (PP_Doc), attrs_Syn_Patterns :: (Set String), copy_Syn_Patterns :: (Patterns), extraDefs_Syn_Patterns :: ([(PP_Doc,PP_Doc)]), sem_lhs_Syn_Patterns :: ([PP_Doc]) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns (T_Patterns act) (Inh_Patterns _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg43 = T_Patterns_vIn43 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap (T_Patterns_vOut43 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOextraDefs _lhsOsem_lhs) <- return (inv_Patterns_s44 sem arg43) return (Syn_Patterns _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOextraDefs _lhsOsem_lhs) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s44 ) } newtype T_Patterns_s44 = C_Patterns_s44 { inv_Patterns_s44 :: (T_Patterns_v43 ) } data T_Patterns_s45 = C_Patterns_s45 type T_Patterns_v43 = (T_Patterns_vIn43 ) -> (T_Patterns_vOut43 ) data T_Patterns_vIn43 = T_Patterns_vIn43 (Map NontermIdent Attributes) (Map NontermIdent Attributes) (Bool) (Attributes) (Map Identifier Type) (Options) (Attributes) data T_Patterns_vOut43 = T_Patterns_vOut43 (PP_Doc) (Set String) (Patterns) ([(PP_Doc,PP_Doc)]) ([PP_Doc]) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_Patterns_v43 v43 = \ (T_Patterns_vIn43 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut40 _hdIattrTypes _hdIattrs _hdIcopy _hdIextraDefs _hdIisUnderscore _hdIsem_lhs) = inv_Pattern_s41 _hdX41 (T_Pattern_vIn40 _hdOallInhmap _hdOallSynmap _hdOanyLazyKind _hdOinhmap _hdOlocalAttrTypes _hdOoptions _hdOsynmap) (T_Patterns_vOut43 _tlIattrTypes _tlIattrs _tlIcopy _tlIextraDefs _tlIsem_lhs) = inv_Patterns_s44 _tlX44 (T_Patterns_vIn43 _tlOallInhmap _tlOallSynmap _tlOanyLazyKind _tlOinhmap _tlOlocalAttrTypes _tlOoptions _tlOsynmap) _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule518 _hdIattrTypes _tlIattrTypes _lhsOattrs :: Set String _lhsOattrs = rule519 _hdIattrs _tlIattrs _lhsOextraDefs :: [(PP_Doc,PP_Doc)] _lhsOextraDefs = rule520 _hdIextraDefs _tlIextraDefs _lhsOsem_lhs :: [PP_Doc] _lhsOsem_lhs = rule521 _hdIsem_lhs _tlIsem_lhs _copy = rule522 _hdIcopy _tlIcopy _lhsOcopy :: Patterns _lhsOcopy = rule523 _copy _hdOallInhmap = rule524 _lhsIallInhmap _hdOallSynmap = rule525 _lhsIallSynmap _hdOanyLazyKind = rule526 _lhsIanyLazyKind _hdOinhmap = rule527 _lhsIinhmap _hdOlocalAttrTypes = rule528 _lhsIlocalAttrTypes _hdOoptions = rule529 _lhsIoptions _hdOsynmap = rule530 _lhsIsynmap _tlOallInhmap = rule531 _lhsIallInhmap _tlOallSynmap = rule532 _lhsIallSynmap _tlOanyLazyKind = rule533 _lhsIanyLazyKind _tlOinhmap = rule534 _lhsIinhmap _tlOlocalAttrTypes = rule535 _lhsIlocalAttrTypes _tlOoptions = rule536 _lhsIoptions _tlOsynmap = rule537 _lhsIsynmap __result_ = T_Patterns_vOut43 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOextraDefs _lhsOsem_lhs in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule518 #-} rule518 = \ ((_hdIattrTypes) :: PP_Doc) ((_tlIattrTypes) :: PP_Doc) -> _hdIattrTypes >-< _tlIattrTypes {-# INLINE rule519 #-} rule519 = \ ((_hdIattrs) :: Set String) ((_tlIattrs) :: Set String) -> _hdIattrs `Set.union` _tlIattrs {-# INLINE rule520 #-} rule520 = \ ((_hdIextraDefs) :: [(PP_Doc,PP_Doc)]) ((_tlIextraDefs) :: [(PP_Doc,PP_Doc)]) -> _hdIextraDefs ++ _tlIextraDefs {-# INLINE rule521 #-} rule521 = \ ((_hdIsem_lhs) :: PP_Doc ) ((_tlIsem_lhs) :: [PP_Doc]) -> _hdIsem_lhs : _tlIsem_lhs {-# INLINE rule522 #-} rule522 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule523 #-} rule523 = \ _copy -> _copy {-# INLINE rule524 #-} rule524 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule525 #-} rule525 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule526 #-} rule526 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule527 #-} rule527 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule528 #-} rule528 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule529 #-} rule529 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule530 #-} rule530 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule531 #-} rule531 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule532 #-} rule532 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule533 #-} rule533 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule534 #-} rule534 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule535 #-} rule535 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule536 #-} rule536 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule537 #-} rule537 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_Patterns_v43 v43 = \ (T_Patterns_vIn43 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule538 () _lhsOattrs :: Set String _lhsOattrs = rule539 () _lhsOextraDefs :: [(PP_Doc,PP_Doc)] _lhsOextraDefs = rule540 () _lhsOsem_lhs :: [PP_Doc] _lhsOsem_lhs = rule541 () _copy = rule542 () _lhsOcopy :: Patterns _lhsOcopy = rule543 _copy __result_ = T_Patterns_vOut43 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOextraDefs _lhsOsem_lhs in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule538 #-} rule538 = \ (_ :: ()) -> empty {-# INLINE rule539 #-} rule539 = \ (_ :: ()) -> Set.empty {-# INLINE rule540 #-} rule540 = \ (_ :: ()) -> [] {-# INLINE rule541 #-} rule541 = \ (_ :: ()) -> [] {-# INLINE rule542 #-} rule542 = \ (_ :: ()) -> [] {-# INLINE rule543 #-} rule543 = \ _copy -> _copy -- Visit ------------------------------------------------------- -- wrapper data Inh_Visit = Inh_Visit { allFromToStates_Inh_Visit :: (Map VisitIdentifier (Int,Int)), allInhmap_Inh_Visit :: (Map NontermIdent Attributes), allInitStates_Inh_Visit :: (Map NontermIdent Int), allSynmap_Inh_Visit :: (Map NontermIdent Attributes), allVisitKinds_Inh_Visit :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_Visit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)), allintramap_Inh_Visit :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))), avisitdefs_Inh_Visit :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_Visit :: (Map VisitIdentifier (Set Identifier)), childTypes_Inh_Visit :: (Map Identifier Type), childintros_Inh_Visit :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), con_Inh_Visit :: (ConstructorIdent), inhmap_Inh_Visit :: (Attributes), mrules_Inh_Visit :: (Map Identifier (VisitKind -> Either Error PP_Doc)), nextVisits_Inh_Visit :: (Map StateIdentifier StateCtx), nt_Inh_Visit :: (NontermIdent), options_Inh_Visit :: (Options), params_Inh_Visit :: ([Identifier]), prevVisits_Inh_Visit :: (Map StateIdentifier StateCtx), ruledefs_Inh_Visit :: (Map Identifier (Set String)), ruleuses_Inh_Visit :: (Map Identifier (Map String (Maybe NonLocalAttr))), synmap_Inh_Visit :: (Attributes), terminaldefs_Inh_Visit :: (Set String) } data Syn_Visit = Syn_Visit { allvisits_Syn_Visit :: ( VisitStateState ), childvisit_Syn_Visit :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)), errors_Syn_Visit :: (Seq Error), fromToStates_Syn_Visit :: (Map VisitIdentifier (Int,Int)), intramap_Syn_Visit :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))), lazyIntras_Syn_Visit :: (Set String), ruleKinds_Syn_Visit :: (Map Identifier (Set VisitKind)), ruleUsage_Syn_Visit :: (Map Identifier Int), sem_visit_Syn_Visit :: ( (StateIdentifier,PP_Doc) ), t_visits_Syn_Visit :: (PP_Doc), visitKinds_Syn_Visit :: (Map VisitIdentifier VisitKind), visitdefs_Syn_Visit :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_Visit :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_Visit #-} wrap_Visit :: T_Visit -> Inh_Visit -> (Syn_Visit ) wrap_Visit (T_Visit act) (Inh_Visit _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) = Control.Monad.Identity.runIdentity ( do sem <- act let arg46 = T_Visit_vIn46 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs (T_Visit_vOut46 _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_Visit_s47 sem arg46) return (Syn_Visit _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# INLINE sem_Visit #-} sem_Visit :: Visit -> T_Visit sem_Visit ( Visit ident_ from_ to_ inh_ syn_ steps_ kind_ ) = sem_Visit_Visit ident_ from_ to_ inh_ syn_ ( sem_VisitSteps steps_ ) kind_ -- semantic domain newtype T_Visit = T_Visit { attach_T_Visit :: Identity (T_Visit_s47 ) } newtype T_Visit_s47 = C_Visit_s47 { inv_Visit_s47 :: (T_Visit_v46 ) } data T_Visit_s48 = C_Visit_s48 type T_Visit_v46 = (T_Visit_vIn46 ) -> (T_Visit_vOut46 ) data T_Visit_vIn46 = T_Visit_vIn46 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Attributes) (Map NontermIdent Int) (Map NontermIdent Attributes) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) (Map StateIdentifier (Map String (Maybe NonLocalAttr))) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map Identifier Type) (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) (ConstructorIdent) (Attributes) (Map Identifier (VisitKind -> Either Error PP_Doc)) (Map StateIdentifier StateCtx) (NontermIdent) (Options) ([Identifier]) (Map StateIdentifier StateCtx) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (Attributes) (Set String) data T_Visit_vOut46 = T_Visit_vOut46 ( VisitStateState ) (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) (Seq Error) (Map VisitIdentifier (Int,Int)) (Map StateIdentifier (Map String (Maybe NonLocalAttr))) (Set String) (Map Identifier (Set VisitKind)) (Map Identifier Int) ( (StateIdentifier,PP_Doc) ) (PP_Doc) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_Visit_Visit #-} sem_Visit_Visit :: (VisitIdentifier) -> (StateIdentifier) -> (StateIdentifier) -> (Set Identifier) -> (Set Identifier) -> T_VisitSteps -> (VisitKind) -> T_Visit sem_Visit_Visit arg_ident_ arg_from_ arg_to_ arg_inh_ arg_syn_ arg_steps_ arg_kind_ = T_Visit (return st47) where {-# NOINLINE st47 #-} st47 = let v46 :: T_Visit_v46 v46 = \ (T_Visit_vIn46 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) -> ( let _stepsX53 = Control.Monad.Identity.runIdentity (attach_T_VisitSteps (arg_steps_)) (T_VisitSteps_vOut52 _stepsIdefs _stepsIerrors _stepsIindex _stepsIisLast _stepsIlazyIntras _stepsIprevMaxSimRefs _stepsIruleKinds _stepsIruleUsage _stepsIsem_steps _stepsIsize _stepsIuses _stepsIvisitKinds) = inv_VisitSteps_s53 _stepsX53 (T_VisitSteps_vIn52 _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfollow _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOprevMaxSimRefs _stepsOruledefs _stepsOruleuses _stepsOuseParallel) _lhsOallvisits :: VisitStateState _lhsOallvisits = rule544 arg_from_ arg_ident_ arg_to_ _nameTIn_visit = rule545 _lhsInt arg_ident_ _nameTOut_visit = rule546 _lhsInt arg_ident_ _nameNextState = rule547 _lhsInt arg_to_ _nameCaller_visit = rule548 _lhsInt arg_ident_ _nextVisitInfo = rule549 _lhsInextVisits arg_to_ _t_params = rule550 _lhsIparams _t_c_params = rule551 _lhsIparams _lhsOt_visits :: PP_Doc _lhsOt_visits = rule552 _contpart _inhpart _lhsInt _nameCaller_visit _nameTIn_visit _nameTOut_visit _synpart _t_c_params _t_params arg_ident_ _contpart = rule553 _lhsInt _nameNextState _nextVisitInfo _t_params arg_ident_ _inhpart = rule554 _lhsIinhmap _ppTypeList arg_inh_ _synpart = rule555 _lhsIsynmap _ppTypeList arg_syn_ _ppTypeList = rule556 _lhsInt arg_ident_ _o_sigs = rule557 _lhsIoptions _lhsOsem_visit :: (StateIdentifier,PP_Doc) _lhsOsem_visit = rule558 _lhsInt _lhsIoptions _nameTIn_visit _nameTOut_visit _o_sigs _stepsIsem_steps _t_params arg_from_ arg_ident_ arg_inh_ _stepsOfollow = rule559 _nextStBuild _resultval _nextArgsMp = rule560 _lhsIallintramap arg_to_ _nextArgs = rule561 _nextArgsMp _nextStExp = rule562 _lhsIoptions _nextArgs _nextArgsMp arg_to_ _resultval = rule563 _lhsInt _lhsIoptions _nextStRefExp arg_ident_ arg_syn_ (_nextStBuild,_nextStRefExp) = rule564 _lhsInt _nextStExp _nextVisitInfo arg_ident_ _stepsOkind = rule565 arg_kind_ _stepsOindex = rule566 () _stepsOprevMaxSimRefs = rule567 () _stepsOuseParallel = rule568 () _prevVisitInfo = rule569 _lhsInextVisits arg_from_ _lhsOchildvisit :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) _lhsOchildvisit = rule570 _invokecode arg_ident_ _invokecode = rule571 _lhsInt _lhsIoptions _nameTOut_visit _nextVisitInfo _o_sigs _prevVisitInfo arg_from_ arg_ident_ arg_inh_ arg_kind_ arg_syn_ arg_to_ _thisintra = rule572 _defsAsMap _nextintra _uses _lhsOintramap :: Map StateIdentifier (Map String (Maybe NonLocalAttr)) _lhsOintramap = rule573 _thisintra arg_from_ _nextintra = rule574 _lhsIallintramap arg_to_ _uses = rule575 _lhsIoptions _stepsIuses arg_syn_ _inhVarNms = rule576 _lhsIoptions arg_inh_ _defs = rule577 _inhVarNms _lhsIterminaldefs _stepsIdefs _defsAsMap = rule578 _defs _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule579 arg_ident_ arg_syn_ _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule580 arg_ident_ arg_inh_ _lazyIntrasInh = rule581 _inhVarNms _stepsIdefs arg_kind_ _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule582 _lazyIntrasInh _stepsIlazyIntras _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule583 arg_from_ arg_ident_ arg_to_ _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule584 arg_ident_ arg_kind_ _lhsOerrors :: Seq Error _lhsOerrors = rule585 _stepsIerrors _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule586 _stepsIruleKinds _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule587 _stepsIruleUsage _stepsOallFromToStates = rule588 _lhsIallFromToStates _stepsOallInitStates = rule589 _lhsIallInitStates _stepsOallVisitKinds = rule590 _lhsIallVisitKinds _stepsOallchildvisit = rule591 _lhsIallchildvisit _stepsOavisitdefs = rule592 _lhsIavisitdefs _stepsOavisituses = rule593 _lhsIavisituses _stepsOchildTypes = rule594 _lhsIchildTypes _stepsOchildintros = rule595 _lhsIchildintros _stepsOmrules = rule596 _lhsImrules _stepsOoptions = rule597 _lhsIoptions _stepsOruledefs = rule598 _lhsIruledefs _stepsOruleuses = rule599 _lhsIruleuses __result_ = T_Visit_vOut46 _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_Visit_s47 v46 {-# INLINE rule544 #-} {-# LINE 436 "src-ag/ExecutionPlan2Caml.ag" #-} rule544 = \ from_ ident_ to_ -> {-# LINE 436 "src-ag/ExecutionPlan2Caml.ag" #-} (ident_, from_, to_) {-# LINE 4507 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule545 #-} {-# LINE 539 "src-ag/ExecutionPlan2Caml.ag" #-} rule545 = \ ((_lhsInt) :: NontermIdent) ident_ -> {-# LINE 539 "src-ag/ExecutionPlan2Caml.ag" #-} conNmTVisitIn _lhsInt ident_ {-# LINE 4513 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule546 #-} {-# LINE 540 "src-ag/ExecutionPlan2Caml.ag" #-} rule546 = \ ((_lhsInt) :: NontermIdent) ident_ -> {-# LINE 540 "src-ag/ExecutionPlan2Caml.ag" #-} conNmTVisitOut _lhsInt ident_ {-# LINE 4519 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule547 #-} {-# LINE 541 "src-ag/ExecutionPlan2Caml.ag" #-} rule547 = \ ((_lhsInt) :: NontermIdent) to_ -> {-# LINE 541 "src-ag/ExecutionPlan2Caml.ag" #-} type_nt_sem _lhsInt to_ {-# LINE 4525 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule548 #-} {-# LINE 542 "src-ag/ExecutionPlan2Caml.ag" #-} rule548 = \ ((_lhsInt) :: NontermIdent) ident_ -> {-# LINE 542 "src-ag/ExecutionPlan2Caml.ag" #-} type_caller_visit _lhsInt ident_ {-# LINE 4531 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule549 #-} {-# LINE 544 "src-ag/ExecutionPlan2Caml.ag" #-} rule549 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) to_ -> {-# LINE 544 "src-ag/ExecutionPlan2Caml.ag" #-} Map.findWithDefault ManyVis to_ _lhsInextVisits {-# LINE 4537 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule550 #-} {-# LINE 546 "src-ag/ExecutionPlan2Caml.ag" #-} rule550 = \ ((_lhsIparams) :: [Identifier]) -> {-# LINE 546 "src-ag/ExecutionPlan2Caml.ag" #-} ppTypeParams _lhsIparams {-# LINE 4543 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule551 #-} {-# LINE 547 "src-ag/ExecutionPlan2Caml.ag" #-} rule551 = \ ((_lhsIparams) :: [Identifier]) -> {-# LINE 547 "src-ag/ExecutionPlan2Caml.ag" #-} ppTypeParams (cont_tvar : map pp _lhsIparams) {-# LINE 4549 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule552 #-} {-# LINE 551 "src-ag/ExecutionPlan2Caml.ag" #-} rule552 = \ _contpart _inhpart ((_lhsInt) :: NontermIdent) _nameCaller_visit _nameTIn_visit _nameTOut_visit _synpart _t_c_params _t_params ident_ -> {-# LINE 551 "src-ag/ExecutionPlan2Caml.ag" #-} "and" >#< _t_c_params >#< _nameCaller_visit >#< "=" >#< ppRecordTp [ nm_inh _lhsInt ident_ >#< ":" >#< _t_params >#< conNmTVisitIn _lhsInt ident_ , nm_cont _lhsInt ident_ >#< ":" >#< _t_params >#< conNmTVisitOut _lhsInt ident_ >#< "->" >#< cont_tvar ] >-< "and" >#< _t_params >#< _nameTIn_visit >#< "=" >#< ppRecordTp _inhpart >-< "and" >#< _t_params >#< _nameTOut_visit >#< "=" >#< ppRecordTp (_synpart ++ _contpart ) {-# LINE 4560 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule553 #-} {-# LINE 558 "src-ag/ExecutionPlan2Caml.ag" #-} rule553 = \ ((_lhsInt) :: NontermIdent) _nameNextState _nextVisitInfo _t_params ident_ -> {-# LINE 558 "src-ag/ExecutionPlan2Caml.ag" #-} case _nextVisitInfo of NoneVis -> [] _ -> [ nm_outarg_cont _lhsInt ident_ >#< ":" >#< _t_params >#< _nameNextState ] {-# LINE 4568 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule554 #-} {-# LINE 562 "src-ag/ExecutionPlan2Caml.ag" #-} rule554 = \ ((_lhsIinhmap) :: Attributes) _ppTypeList inh_ -> {-# LINE 562 "src-ag/ExecutionPlan2Caml.ag" #-} _ppTypeList nm_inarg inh_ _lhsIinhmap {-# LINE 4574 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule555 #-} {-# LINE 563 "src-ag/ExecutionPlan2Caml.ag" #-} rule555 = \ ((_lhsIsynmap) :: Attributes) _ppTypeList syn_ -> {-# LINE 563 "src-ag/ExecutionPlan2Caml.ag" #-} _ppTypeList nm_outarg syn_ _lhsIsynmap {-# LINE 4580 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule556 #-} {-# LINE 564 "src-ag/ExecutionPlan2Caml.ag" #-} rule556 = \ ((_lhsInt) :: NontermIdent) ident_ -> {-# LINE 564 "src-ag/ExecutionPlan2Caml.ag" #-} \f s m -> map (\i -> case Map.lookup i m of Just tp -> f i _lhsInt ident_ >#< ":" >#< ppTp tp ) $ Set.toList s {-# LINE 4587 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule557 #-} {-# LINE 798 "src-ag/ExecutionPlan2Caml.ag" #-} rule557 = \ ((_lhsIoptions) :: Options) -> {-# LINE 798 "src-ag/ExecutionPlan2Caml.ag" #-} typeSigs _lhsIoptions {-# LINE 4593 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule558 #-} {-# LINE 799 "src-ag/ExecutionPlan2Caml.ag" #-} rule558 = \ ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) _nameTIn_visit _nameTOut_visit _o_sigs ((_stepsIsem_steps) :: PP_Doc) _t_params from_ ident_ inh_ -> {-# LINE 799 "src-ag/ExecutionPlan2Caml.ag" #-} ( from_ , let resTp = _t_params >#< _nameTOut_visit argTp = _t_params >#< _nameTIn_visit argMatch = ppRecordVal [ nm_inarg i _lhsInt ident_ >#< "=" >#< lhsname _lhsIoptions True i | i <- Set.toList inh_ ] in ppFunDecl _o_sigs (nm_visit ident_) [(argMatch, argTp)] resTp _stepsIsem_steps ) {-# LINE 4604 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule559 #-} {-# LINE 806 "src-ag/ExecutionPlan2Caml.ag" #-} rule559 = \ _nextStBuild _resultval -> {-# LINE 806 "src-ag/ExecutionPlan2Caml.ag" #-} _nextStBuild >-< _resultval {-# LINE 4610 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule560 #-} {-# LINE 808 "src-ag/ExecutionPlan2Caml.ag" #-} rule560 = \ ((_lhsIallintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) to_ -> {-# LINE 808 "src-ag/ExecutionPlan2Caml.ag" #-} maybe Map.empty id $ Map.lookup to_ _lhsIallintramap {-# LINE 4616 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule561 #-} {-# LINE 809 "src-ag/ExecutionPlan2Caml.ag" #-} rule561 = \ _nextArgsMp -> {-# LINE 809 "src-ag/ExecutionPlan2Caml.ag" #-} ppSpaced $ Map.keys $ _nextArgsMp {-# LINE 4622 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule562 #-} {-# LINE 810 "src-ag/ExecutionPlan2Caml.ag" #-} rule562 = \ ((_lhsIoptions) :: Options) _nextArgs _nextArgsMp to_ -> {-# LINE 810 "src-ag/ExecutionPlan2Caml.ag" #-} nm_st to_ >#< _nextArgs >#< dummyArg _lhsIoptions (Map.null _nextArgsMp ) {-# LINE 4628 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule563 #-} {-# LINE 812 "src-ag/ExecutionPlan2Caml.ag" #-} rule563 = \ ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) _nextStRefExp ident_ syn_ -> {-# LINE 812 "src-ag/ExecutionPlan2Caml.ag" #-} ppRecordVal ( [ nm_outarg i _lhsInt ident_ >#< "=" >#< lhsname _lhsIoptions False i | i <- Set.toList syn_ ] ++ [ _nextStRefExp ]) {-# LINE 4636 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule564 #-} {-# LINE 817 "src-ag/ExecutionPlan2Caml.ag" #-} rule564 = \ ((_lhsInt) :: NontermIdent) _nextStExp _nextVisitInfo ident_ -> {-# LINE 817 "src-ag/ExecutionPlan2Caml.ag" #-} case _nextVisitInfo of NoneVis -> (empty, empty) _ -> ( "let" >#< nextStName >#< "=" >#< _nextStExp >#< "in" , nm_outarg_cont _lhsInt ident_ >#< "=" >#< nextStName) {-# LINE 4645 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule565 #-} {-# LINE 832 "src-ag/ExecutionPlan2Caml.ag" #-} rule565 = \ kind_ -> {-# LINE 832 "src-ag/ExecutionPlan2Caml.ag" #-} kind_ {-# LINE 4651 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule566 #-} {-# LINE 884 "src-ag/ExecutionPlan2Caml.ag" #-} rule566 = \ (_ :: ()) -> {-# LINE 884 "src-ag/ExecutionPlan2Caml.ag" #-} 0 {-# LINE 4657 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule567 #-} {-# LINE 891 "src-ag/ExecutionPlan2Caml.ag" #-} rule567 = \ (_ :: ()) -> {-# LINE 891 "src-ag/ExecutionPlan2Caml.ag" #-} 0 {-# LINE 4663 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule568 #-} {-# LINE 908 "src-ag/ExecutionPlan2Caml.ag" #-} rule568 = \ (_ :: ()) -> {-# LINE 908 "src-ag/ExecutionPlan2Caml.ag" #-} False {-# LINE 4669 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule569 #-} {-# LINE 1165 "src-ag/ExecutionPlan2Caml.ag" #-} rule569 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) from_ -> {-# LINE 1165 "src-ag/ExecutionPlan2Caml.ag" #-} Map.findWithDefault ManyVis from_ _lhsInextVisits {-# LINE 4675 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule570 #-} {-# LINE 1166 "src-ag/ExecutionPlan2Caml.ag" #-} rule570 = \ _invokecode ident_ -> {-# LINE 1166 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton ident_ _invokecode {-# LINE 4681 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule571 #-} {-# LINE 1168 "src-ag/ExecutionPlan2Caml.ag" #-} rule571 = \ ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) _nameTOut_visit _nextVisitInfo _o_sigs _prevVisitInfo from_ ident_ inh_ kind_ syn_ to_ -> {-# LINE 1168 "src-ag/ExecutionPlan2Caml.ag" #-} \chld childTp kind follow -> let code = cont >-< inps >-< call childNmTo = text $ stname chld to_ childNmFrom = text $ stname chld from_ childTpArgs = case childTp of NT _ args _ -> args _ -> error "generate visit call: type of the child is not a nonterminal!" cont = "let" >#< contNm >#< ppArg _o_sigs (ppRecordVal cont_in) cont_in_tp >#< "=" >-< indent 2 follow >#< "in" cont_in = [ nm_outarg i _lhsInt ident_ >#< "=" >#< attrname _lhsIoptions True chld i | i <- Set.toList syn_ ] ++ case _nextVisitInfo of NoneVis -> [] _ -> [ nm_outarg_cont _lhsInt ident_ >#< "=" >#< childNmTo ] cont_in_tp = ppTypeParams childTpArgs >#< _nameTOut_visit inps = "let" >#< inpsNm >#< "=" >#< ppRecordVal [ nm_inh _lhsInt ident_ >#< "=" >#< ppRecordVal inps_in , nm_cont _lhsInt ident_ >#< "=" >#< contNm ] >#< "in" inps_in = [ nm_inarg i _lhsInt ident_ >#< "=" >#< attrname _lhsIoptions False chld i | i <- Set.toList inh_ ] call = childNmFrom >|< "." >|< nm_invoke _lhsInt from_ >#< arg arg = case _prevVisitInfo of NoneVis -> error "error: invocation of a visit from a state that has no next visits" OneVis _ -> pp inpsNm ManyVis -> pp_parens (con_visit _lhsInt ident_ >#< inpsNm) in if kind `compatibleKind` kind_ then Right code else Left $ IncompatibleVisitKind chld ident_ kind kind_ {-# LINE 4714 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule572 #-} {-# LINE 1273 "src-ag/ExecutionPlan2Caml.ag" #-} rule572 = \ _defsAsMap _nextintra _uses -> {-# LINE 1273 "src-ag/ExecutionPlan2Caml.ag" #-} (_uses `Map.union` _nextintra ) `Map.difference` _defsAsMap {-# LINE 4720 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule573 #-} {-# LINE 1274 "src-ag/ExecutionPlan2Caml.ag" #-} rule573 = \ _thisintra from_ -> {-# LINE 1274 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton from_ _thisintra {-# LINE 4726 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule574 #-} {-# LINE 1275 "src-ag/ExecutionPlan2Caml.ag" #-} rule574 = \ ((_lhsIallintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) to_ -> {-# LINE 1275 "src-ag/ExecutionPlan2Caml.ag" #-} maybe Map.empty id $ Map.lookup to_ _lhsIallintramap {-# LINE 4732 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule575 #-} {-# LINE 1276 "src-ag/ExecutionPlan2Caml.ag" #-} rule575 = \ ((_lhsIoptions) :: Options) ((_stepsIuses) :: Map String (Maybe NonLocalAttr)) syn_ -> {-# LINE 1276 "src-ag/ExecutionPlan2Caml.ag" #-} let mp1 = _stepsIuses mp2 = Map.fromList [ (lhsname _lhsIoptions False i, Just (AttrSyn _LHS i)) | i <- Set.elems syn_ ] in mp1 `Map.union` mp2 {-# LINE 4740 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule576 #-} {-# LINE 1279 "src-ag/ExecutionPlan2Caml.ag" #-} rule576 = \ ((_lhsIoptions) :: Options) inh_ -> {-# LINE 1279 "src-ag/ExecutionPlan2Caml.ag" #-} Set.map (lhsname _lhsIoptions True) inh_ {-# LINE 4746 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule577 #-} {-# LINE 1280 "src-ag/ExecutionPlan2Caml.ag" #-} rule577 = \ _inhVarNms ((_lhsIterminaldefs) :: Set String) ((_stepsIdefs) :: Set String) -> {-# LINE 1280 "src-ag/ExecutionPlan2Caml.ag" #-} _stepsIdefs `Set.union` _inhVarNms `Set.union` _lhsIterminaldefs {-# LINE 4752 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule578 #-} {-# LINE 1281 "src-ag/ExecutionPlan2Caml.ag" #-} rule578 = \ _defs -> {-# LINE 1281 "src-ag/ExecutionPlan2Caml.ag" #-} Map.fromList [ (a, Nothing) | a <- Set.elems _defs ] {-# LINE 4758 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule579 #-} {-# LINE 1305 "src-ag/ExecutionPlan2Caml.ag" #-} rule579 = \ ident_ syn_ -> {-# LINE 1305 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton ident_ syn_ {-# LINE 4764 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule580 #-} {-# LINE 1306 "src-ag/ExecutionPlan2Caml.ag" #-} rule580 = \ ident_ inh_ -> {-# LINE 1306 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton ident_ inh_ {-# LINE 4770 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule581 #-} {-# LINE 1338 "src-ag/ExecutionPlan2Caml.ag" #-} rule581 = \ _inhVarNms ((_stepsIdefs) :: Set String) kind_ -> {-# LINE 1338 "src-ag/ExecutionPlan2Caml.ag" #-} case kind_ of VisitPure False -> _inhVarNms `Set.union` _stepsIdefs _ -> Set.empty {-# LINE 4778 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule582 #-} {-# LINE 1341 "src-ag/ExecutionPlan2Caml.ag" #-} rule582 = \ _lazyIntrasInh ((_stepsIlazyIntras) :: Set String) -> {-# LINE 1341 "src-ag/ExecutionPlan2Caml.ag" #-} _lazyIntrasInh `Set.union` _stepsIlazyIntras {-# LINE 4784 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule583 #-} {-# LINE 1404 "src-ag/ExecutionPlan2Caml.ag" #-} rule583 = \ from_ ident_ to_ -> {-# LINE 1404 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton ident_ (from_, to_) {-# LINE 4790 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule584 #-} {-# LINE 1448 "src-ag/ExecutionPlan2Caml.ag" #-} rule584 = \ ident_ kind_ -> {-# LINE 1448 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton ident_ kind_ {-# LINE 4796 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule585 #-} rule585 = \ ((_stepsIerrors) :: Seq Error) -> _stepsIerrors {-# INLINE rule586 #-} rule586 = \ ((_stepsIruleKinds) :: Map Identifier (Set VisitKind)) -> _stepsIruleKinds {-# INLINE rule587 #-} rule587 = \ ((_stepsIruleUsage) :: Map Identifier Int) -> _stepsIruleUsage {-# INLINE rule588 #-} rule588 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule589 #-} rule589 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule590 #-} rule590 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule591 #-} rule591 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _lhsIallchildvisit {-# INLINE rule592 #-} rule592 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule593 #-} rule593 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule594 #-} rule594 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule595 #-} rule595 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule596 #-} rule596 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule597 #-} rule597 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule598 #-} rule598 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule599 #-} rule599 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses -- VisitStep --------------------------------------------------- -- wrapper data Inh_VisitStep = Inh_VisitStep { allFromToStates_Inh_VisitStep :: (Map VisitIdentifier (Int,Int)), allInitStates_Inh_VisitStep :: (Map NontermIdent Int), allVisitKinds_Inh_VisitStep :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_VisitStep :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)), avisitdefs_Inh_VisitStep :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_VisitStep :: (Map VisitIdentifier (Set Identifier)), childTypes_Inh_VisitStep :: (Map Identifier Type), childintros_Inh_VisitStep :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), follow_Inh_VisitStep :: (PP_Doc), index_Inh_VisitStep :: (Int), isLast_Inh_VisitStep :: (Bool), kind_Inh_VisitStep :: (VisitKind), mrules_Inh_VisitStep :: (Map Identifier (VisitKind -> Either Error PP_Doc)), options_Inh_VisitStep :: (Options), prevMaxSimRefs_Inh_VisitStep :: (Int), ruledefs_Inh_VisitStep :: (Map Identifier (Set String)), ruleuses_Inh_VisitStep :: (Map Identifier (Map String (Maybe NonLocalAttr))), useParallel_Inh_VisitStep :: (Bool) } data Syn_VisitStep = Syn_VisitStep { defs_Syn_VisitStep :: (Set String), errors_Syn_VisitStep :: (Seq Error), index_Syn_VisitStep :: (Int), isLast_Syn_VisitStep :: (Bool), lazyIntras_Syn_VisitStep :: (Set String), prevMaxSimRefs_Syn_VisitStep :: (Int), ruleKinds_Syn_VisitStep :: (Map Identifier (Set VisitKind)), ruleUsage_Syn_VisitStep :: (Map Identifier Int), sem_steps_Syn_VisitStep :: (PP_Doc), uses_Syn_VisitStep :: (Map String (Maybe NonLocalAttr)), visitKinds_Syn_VisitStep :: (Map VisitIdentifier VisitKind) } {-# INLINABLE wrap_VisitStep #-} wrap_VisitStep :: T_VisitStep -> Inh_VisitStep -> (Syn_VisitStep ) wrap_VisitStep (T_VisitStep act) (Inh_VisitStep _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfollow _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) = Control.Monad.Identity.runIdentity ( do sem <- act let arg49 = T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfollow _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel (T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOuses _lhsOvisitKinds) <- return (inv_VisitStep_s50 sem arg49) return (Syn_VisitStep _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOuses _lhsOvisitKinds) ) -- cata {-# NOINLINE sem_VisitStep #-} sem_VisitStep :: VisitStep -> T_VisitStep sem_VisitStep ( Sem name_ ) = sem_VisitStep_Sem name_ sem_VisitStep ( ChildVisit child_ nonterm_ visit_ ) = sem_VisitStep_ChildVisit child_ nonterm_ visit_ sem_VisitStep ( PureGroup steps_ ordered_ ) = sem_VisitStep_PureGroup ( sem_VisitSteps steps_ ) ordered_ sem_VisitStep ( Sim steps_ ) = sem_VisitStep_Sim ( sem_VisitSteps steps_ ) sem_VisitStep ( ChildIntro child_ ) = sem_VisitStep_ChildIntro child_ -- semantic domain newtype T_VisitStep = T_VisitStep { attach_T_VisitStep :: Identity (T_VisitStep_s50 ) } newtype T_VisitStep_s50 = C_VisitStep_s50 { inv_VisitStep_s50 :: (T_VisitStep_v49 ) } data T_VisitStep_s51 = C_VisitStep_s51 type T_VisitStep_v49 = (T_VisitStep_vIn49 ) -> (T_VisitStep_vOut49 ) data T_VisitStep_vIn49 = T_VisitStep_vIn49 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Int) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map Identifier Type) (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) (PP_Doc) (Int) (Bool) (VisitKind) (Map Identifier (VisitKind -> Either Error PP_Doc)) (Options) (Int) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (Bool) data T_VisitStep_vOut49 = T_VisitStep_vOut49 (Set String) (Seq Error) (Int) (Bool) (Set String) (Int) (Map Identifier (Set VisitKind)) (Map Identifier Int) (PP_Doc) (Map String (Maybe NonLocalAttr)) (Map VisitIdentifier VisitKind) {-# NOINLINE sem_VisitStep_Sem #-} sem_VisitStep_Sem :: (Identifier) -> T_VisitStep sem_VisitStep_Sem arg_name_ = T_VisitStep (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_VisitStep_v49 v49 = \ (T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfollow _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) -> ( let _ruleItf = rule600 _lhsImrules arg_name_ _lhsOerrors :: Seq Error (_lhsOerrors,_sem_steps) = rule601 _lhsIkind _ruleItf _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule602 _lhsIfollow _sem_steps _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule603 arg_name_ _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule604 _lhsIkind arg_name_ _lhsOdefs :: Set String _lhsOdefs = rule605 _lhsIruledefs arg_name_ _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule606 _lhsIruleuses arg_name_ _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule607 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule608 () _lhsOindex :: Int _lhsOindex = rule609 _lhsIindex _lhsOisLast :: Bool _lhsOisLast = rule610 _lhsIisLast _lhsOprevMaxSimRefs :: Int _lhsOprevMaxSimRefs = rule611 _lhsIprevMaxSimRefs __result_ = T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitStep_s50 v49 {-# INLINE rule600 #-} {-# LINE 849 "src-ag/ExecutionPlan2Caml.ag" #-} rule600 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> Either Error PP_Doc)) name_ -> {-# LINE 849 "src-ag/ExecutionPlan2Caml.ag" #-} Map.findWithDefault (error $ "Rule " ++ show name_ ++ " not found") name_ _lhsImrules {-# LINE 4915 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule601 #-} {-# LINE 850 "src-ag/ExecutionPlan2Caml.ag" #-} rule601 = \ ((_lhsIkind) :: VisitKind) _ruleItf -> {-# LINE 850 "src-ag/ExecutionPlan2Caml.ag" #-} case _ruleItf _lhsIkind of Left e -> (Seq.singleton e, empty) Right stmt -> (Seq.empty, stmt) {-# LINE 4923 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule602 #-} {-# LINE 853 "src-ag/ExecutionPlan2Caml.ag" #-} rule602 = \ ((_lhsIfollow) :: PP_Doc) _sem_steps -> {-# LINE 853 "src-ag/ExecutionPlan2Caml.ag" #-} _sem_steps >-< _lhsIfollow {-# LINE 4929 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule603 #-} {-# LINE 1226 "src-ag/ExecutionPlan2Caml.ag" #-} rule603 = \ name_ -> {-# LINE 1226 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton name_ 1 {-# LINE 4935 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule604 #-} {-# LINE 1236 "src-ag/ExecutionPlan2Caml.ag" #-} rule604 = \ ((_lhsIkind) :: VisitKind) name_ -> {-# LINE 1236 "src-ag/ExecutionPlan2Caml.ag" #-} Map.singleton name_ (Set.singleton _lhsIkind) {-# LINE 4941 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule605 #-} {-# LINE 1321 "src-ag/ExecutionPlan2Caml.ag" #-} rule605 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) name_ -> {-# LINE 1321 "src-ag/ExecutionPlan2Caml.ag" #-} maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruledefs {-# LINE 4947 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule606 #-} {-# LINE 1322 "src-ag/ExecutionPlan2Caml.ag" #-} rule606 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) name_ -> {-# LINE 1322 "src-ag/ExecutionPlan2Caml.ag" #-} maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruleuses {-# LINE 4953 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule607 #-} rule607 = \ (_ :: ()) -> Set.empty {-# INLINE rule608 #-} rule608 = \ (_ :: ()) -> mempty {-# INLINE rule609 #-} rule609 = \ ((_lhsIindex) :: Int) -> _lhsIindex {-# INLINE rule610 #-} rule610 = \ ((_lhsIisLast) :: Bool) -> _lhsIisLast {-# INLINE rule611 #-} rule611 = \ ((_lhsIprevMaxSimRefs) :: Int) -> _lhsIprevMaxSimRefs {-# NOINLINE sem_VisitStep_ChildVisit #-} sem_VisitStep_ChildVisit :: (Identifier) -> (NontermIdent) -> (VisitIdentifier) -> T_VisitStep sem_VisitStep_ChildVisit arg_child_ _ arg_visit_ = T_VisitStep (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_VisitStep_v49 v49 = \ (T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfollow _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) -> ( let _visitItf = rule612 _lhsIallchildvisit arg_visit_ _childType = rule613 _lhsIchildTypes arg_child_ _lhsOerrors :: Seq Error _lhsOsem_steps :: PP_Doc (_lhsOerrors,_lhsOsem_steps) = rule614 _childType _lhsIfollow _lhsIkind _visitItf arg_child_ _lhsOdefs :: Set String _lhsOdefs = rule615 _lhsIavisitdefs _lhsIoptions _to arg_child_ arg_visit_ _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule616 _from _lhsIavisituses _lhsIoptions arg_child_ arg_visit_ (_from,_to) = rule617 _lhsIallFromToStates arg_visit_ _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule618 () _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule619 () _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule620 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule621 () _lhsOindex :: Int _lhsOindex = rule622 _lhsIindex _lhsOisLast :: Bool _lhsOisLast = rule623 _lhsIisLast _lhsOprevMaxSimRefs :: Int _lhsOprevMaxSimRefs = rule624 _lhsIprevMaxSimRefs __result_ = T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitStep_s50 v49 {-# INLINE rule612 #-} {-# LINE 860 "src-ag/ExecutionPlan2Caml.ag" #-} rule612 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) visit_ -> {-# LINE 860 "src-ag/ExecutionPlan2Caml.ag" #-} Map.findWithDefault (error $ "Visit " ++ show visit_ ++ " not found") visit_ _lhsIallchildvisit {-# LINE 5008 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule613 #-} {-# LINE 861 "src-ag/ExecutionPlan2Caml.ag" #-} rule613 = \ ((_lhsIchildTypes) :: Map Identifier Type) child_ -> {-# LINE 861 "src-ag/ExecutionPlan2Caml.ag" #-} Map.findWithDefault (error ("type of child " ++ show child_ ++ " is not in the childTypes map! " ++ show _lhsIchildTypes)) child_ _lhsIchildTypes {-# LINE 5014 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule614 #-} {-# LINE 862 "src-ag/ExecutionPlan2Caml.ag" #-} rule614 = \ _childType ((_lhsIfollow) :: PP_Doc) ((_lhsIkind) :: VisitKind) _visitItf child_ -> {-# LINE 862 "src-ag/ExecutionPlan2Caml.ag" #-} case _visitItf child_ _childType _lhsIkind _lhsIfollow of Left e -> (Seq.singleton e, empty) Right steps -> (Seq.empty, steps) {-# LINE 5022 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule615 #-} {-# LINE 1323 "src-ag/ExecutionPlan2Caml.ag" #-} rule615 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) ((_lhsIoptions) :: Options) _to child_ visit_ -> {-# LINE 1323 "src-ag/ExecutionPlan2Caml.ag" #-} Set.insert (stname child_ _to) $ maybe (error "Visit not found") (Set.map $ attrname _lhsIoptions True child_) $ Map.lookup visit_ _lhsIavisitdefs {-# LINE 5028 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule616 #-} {-# LINE 1324 "src-ag/ExecutionPlan2Caml.ag" #-} rule616 = \ _from ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) ((_lhsIoptions) :: Options) child_ visit_ -> {-# LINE 1324 "src-ag/ExecutionPlan2Caml.ag" #-} let convert attrs = Map.fromList [ (attrname _lhsIoptions False child_ attr, Just $ mkNonLocalAttr True child_ attr) | attr <- Set.elems attrs ] in Map.insert (stname child_ _from) Nothing $ convert $ maybe (error "Visit not found") id $ Map.lookup visit_ _lhsIavisituses {-# LINE 5036 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule617 #-} {-# LINE 1410 "src-ag/ExecutionPlan2Caml.ag" #-} rule617 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) visit_ -> {-# LINE 1410 "src-ag/ExecutionPlan2Caml.ag" #-} Map.findWithDefault (error "visit not in allFromToStates") visit_ _lhsIallFromToStates {-# LINE 5042 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule618 #-} rule618 = \ (_ :: ()) -> Set.empty {-# INLINE rule619 #-} rule619 = \ (_ :: ()) -> Map.empty {-# INLINE rule620 #-} rule620 = \ (_ :: ()) -> Map.empty {-# INLINE rule621 #-} rule621 = \ (_ :: ()) -> mempty {-# INLINE rule622 #-} rule622 = \ ((_lhsIindex) :: Int) -> _lhsIindex {-# INLINE rule623 #-} rule623 = \ ((_lhsIisLast) :: Bool) -> _lhsIisLast {-# INLINE rule624 #-} rule624 = \ ((_lhsIprevMaxSimRefs) :: Int) -> _lhsIprevMaxSimRefs {-# NOINLINE sem_VisitStep_PureGroup #-} sem_VisitStep_PureGroup :: T_VisitSteps -> (Bool) -> T_VisitStep sem_VisitStep_PureGroup arg_steps_ arg_ordered_ = T_VisitStep (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_VisitStep_v49 v49 = \ (T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfollow _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) -> ( let _stepsX53 = Control.Monad.Identity.runIdentity (attach_T_VisitSteps (arg_steps_)) (T_VisitSteps_vOut52 _stepsIdefs _stepsIerrors _stepsIindex _stepsIisLast _stepsIlazyIntras _stepsIprevMaxSimRefs _stepsIruleKinds _stepsIruleUsage _stepsIsem_steps _stepsIsize _stepsIuses _stepsIvisitKinds) = inv_VisitSteps_s53 _stepsX53 (T_VisitSteps_vIn52 _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfollow _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOprevMaxSimRefs _stepsOruledefs _stepsOruleuses _stepsOuseParallel) _stepsOkind = rule625 arg_ordered_ _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule626 _stepsIdefs _stepsIlazyIntras arg_ordered_ _lhsOdefs :: Set String _lhsOdefs = rule627 _stepsIdefs _lhsOerrors :: Seq Error _lhsOerrors = rule628 _stepsIerrors _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule629 _stepsIruleKinds _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule630 _stepsIruleUsage _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule631 _stepsIsem_steps _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule632 _stepsIuses _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule633 _stepsIvisitKinds _lhsOindex :: Int _lhsOindex = rule634 _stepsIindex _lhsOisLast :: Bool _lhsOisLast = rule635 _stepsIisLast _lhsOprevMaxSimRefs :: Int _lhsOprevMaxSimRefs = rule636 _stepsIprevMaxSimRefs _stepsOallFromToStates = rule637 _lhsIallFromToStates _stepsOallInitStates = rule638 _lhsIallInitStates _stepsOallVisitKinds = rule639 _lhsIallVisitKinds _stepsOallchildvisit = rule640 _lhsIallchildvisit _stepsOavisitdefs = rule641 _lhsIavisitdefs _stepsOavisituses = rule642 _lhsIavisituses _stepsOchildTypes = rule643 _lhsIchildTypes _stepsOchildintros = rule644 _lhsIchildintros _stepsOfollow = rule645 _lhsIfollow _stepsOindex = rule646 _lhsIindex _stepsOmrules = rule647 _lhsImrules _stepsOoptions = rule648 _lhsIoptions _stepsOprevMaxSimRefs = rule649 _lhsIprevMaxSimRefs _stepsOruledefs = rule650 _lhsIruledefs _stepsOruleuses = rule651 _lhsIruleuses _stepsOuseParallel = rule652 _lhsIuseParallel __result_ = T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitStep_s50 v49 {-# INLINE rule625 #-} {-# LINE 836 "src-ag/ExecutionPlan2Caml.ag" #-} rule625 = \ ordered_ -> {-# LINE 836 "src-ag/ExecutionPlan2Caml.ag" #-} VisitPure ordered_ {-# LINE 5120 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule626 #-} {-# LINE 1344 "src-ag/ExecutionPlan2Caml.ag" #-} rule626 = \ ((_stepsIdefs) :: Set String) ((_stepsIlazyIntras) :: Set String) ordered_ -> {-# LINE 1344 "src-ag/ExecutionPlan2Caml.ag" #-} if ordered_ then _stepsIlazyIntras else _stepsIdefs {-# LINE 5128 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule627 #-} rule627 = \ ((_stepsIdefs) :: Set String) -> _stepsIdefs {-# INLINE rule628 #-} rule628 = \ ((_stepsIerrors) :: Seq Error) -> _stepsIerrors {-# INLINE rule629 #-} rule629 = \ ((_stepsIruleKinds) :: Map Identifier (Set VisitKind)) -> _stepsIruleKinds {-# INLINE rule630 #-} rule630 = \ ((_stepsIruleUsage) :: Map Identifier Int) -> _stepsIruleUsage {-# INLINE rule631 #-} rule631 = \ ((_stepsIsem_steps) :: PP_Doc) -> _stepsIsem_steps {-# INLINE rule632 #-} rule632 = \ ((_stepsIuses) :: Map String (Maybe NonLocalAttr)) -> _stepsIuses {-# INLINE rule633 #-} rule633 = \ ((_stepsIvisitKinds) :: Map VisitIdentifier VisitKind) -> _stepsIvisitKinds {-# INLINE rule634 #-} rule634 = \ ((_stepsIindex) :: Int) -> _stepsIindex {-# INLINE rule635 #-} rule635 = \ ((_stepsIisLast) :: Bool) -> _stepsIisLast {-# INLINE rule636 #-} rule636 = \ ((_stepsIprevMaxSimRefs) :: Int) -> _stepsIprevMaxSimRefs {-# INLINE rule637 #-} rule637 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule638 #-} rule638 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule639 #-} rule639 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule640 #-} rule640 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _lhsIallchildvisit {-# INLINE rule641 #-} rule641 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule642 #-} rule642 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule643 #-} rule643 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule644 #-} rule644 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule645 #-} rule645 = \ ((_lhsIfollow) :: PP_Doc) -> _lhsIfollow {-# INLINE rule646 #-} rule646 = \ ((_lhsIindex) :: Int) -> _lhsIindex {-# INLINE rule647 #-} rule647 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule648 #-} rule648 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule649 #-} rule649 = \ ((_lhsIprevMaxSimRefs) :: Int) -> _lhsIprevMaxSimRefs {-# INLINE rule650 #-} rule650 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule651 #-} rule651 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# INLINE rule652 #-} rule652 = \ ((_lhsIuseParallel) :: Bool) -> _lhsIuseParallel {-# NOINLINE sem_VisitStep_Sim #-} sem_VisitStep_Sim :: T_VisitSteps -> T_VisitStep sem_VisitStep_Sim arg_steps_ = T_VisitStep (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_VisitStep_v49 v49 = \ (T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfollow _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) -> ( let _stepsX53 = Control.Monad.Identity.runIdentity (attach_T_VisitSteps (arg_steps_)) (T_VisitSteps_vOut52 _stepsIdefs _stepsIerrors _stepsIindex _stepsIisLast _stepsIlazyIntras _stepsIprevMaxSimRefs _stepsIruleKinds _stepsIruleUsage _stepsIsem_steps _stepsIsize _stepsIuses _stepsIvisitKinds) = inv_VisitSteps_s53 _stepsX53 (T_VisitSteps_vIn52 _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfollow _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOprevMaxSimRefs _stepsOruledefs _stepsOruleuses _stepsOuseParallel) _stepsOindex = rule653 () _lhsOindex :: Int _lhsOindex = rule654 _lhsIindex _lhsOprevMaxSimRefs :: Int _lhsOprevMaxSimRefs = rule655 _lhsIprevMaxSimRefs _stepsIindex _useParallel _useParallel = rule656 _lhsIoptions _stepsIsize _lhsOdefs :: Set String _lhsOdefs = rule657 _stepsIdefs _lhsOerrors :: Seq Error _lhsOerrors = rule658 _stepsIerrors _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule659 _stepsIlazyIntras _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule660 _stepsIruleKinds _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule661 _stepsIruleUsage _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule662 _stepsIsem_steps _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule663 _stepsIuses _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule664 _stepsIvisitKinds _lhsOisLast :: Bool _lhsOisLast = rule665 _stepsIisLast _stepsOallFromToStates = rule666 _lhsIallFromToStates _stepsOallInitStates = rule667 _lhsIallInitStates _stepsOallVisitKinds = rule668 _lhsIallVisitKinds _stepsOallchildvisit = rule669 _lhsIallchildvisit _stepsOavisitdefs = rule670 _lhsIavisitdefs _stepsOavisituses = rule671 _lhsIavisituses _stepsOchildTypes = rule672 _lhsIchildTypes _stepsOchildintros = rule673 _lhsIchildintros _stepsOfollow = rule674 _lhsIfollow _stepsOkind = rule675 _lhsIkind _stepsOmrules = rule676 _lhsImrules _stepsOoptions = rule677 _lhsIoptions _stepsOprevMaxSimRefs = rule678 _lhsIprevMaxSimRefs _stepsOruledefs = rule679 _lhsIruledefs _stepsOruleuses = rule680 _lhsIruleuses _stepsOuseParallel = rule681 _useParallel __result_ = T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitStep_s50 v49 {-# INLINE rule653 #-} {-# LINE 885 "src-ag/ExecutionPlan2Caml.ag" #-} rule653 = \ (_ :: ()) -> {-# LINE 885 "src-ag/ExecutionPlan2Caml.ag" #-} 0 {-# LINE 5264 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule654 #-} {-# LINE 886 "src-ag/ExecutionPlan2Caml.ag" #-} rule654 = \ ((_lhsIindex) :: Int) -> {-# LINE 886 "src-ag/ExecutionPlan2Caml.ag" #-} _lhsIindex {-# LINE 5270 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule655 #-} {-# LINE 893 "src-ag/ExecutionPlan2Caml.ag" #-} rule655 = \ ((_lhsIprevMaxSimRefs) :: Int) ((_stepsIindex) :: Int) _useParallel -> {-# LINE 893 "src-ag/ExecutionPlan2Caml.ag" #-} if _useParallel then _lhsIprevMaxSimRefs `max` (_stepsIindex - 1) else _lhsIprevMaxSimRefs {-# LINE 5278 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule656 #-} {-# LINE 909 "src-ag/ExecutionPlan2Caml.ag" #-} rule656 = \ ((_lhsIoptions) :: Options) ((_stepsIsize) :: Int) -> {-# LINE 909 "src-ag/ExecutionPlan2Caml.ag" #-} parallelInvoke _lhsIoptions && _stepsIsize > 1 {-# LINE 5284 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule657 #-} rule657 = \ ((_stepsIdefs) :: Set String) -> _stepsIdefs {-# INLINE rule658 #-} rule658 = \ ((_stepsIerrors) :: Seq Error) -> _stepsIerrors {-# INLINE rule659 #-} rule659 = \ ((_stepsIlazyIntras) :: Set String) -> _stepsIlazyIntras {-# INLINE rule660 #-} rule660 = \ ((_stepsIruleKinds) :: Map Identifier (Set VisitKind)) -> _stepsIruleKinds {-# INLINE rule661 #-} rule661 = \ ((_stepsIruleUsage) :: Map Identifier Int) -> _stepsIruleUsage {-# INLINE rule662 #-} rule662 = \ ((_stepsIsem_steps) :: PP_Doc) -> _stepsIsem_steps {-# INLINE rule663 #-} rule663 = \ ((_stepsIuses) :: Map String (Maybe NonLocalAttr)) -> _stepsIuses {-# INLINE rule664 #-} rule664 = \ ((_stepsIvisitKinds) :: Map VisitIdentifier VisitKind) -> _stepsIvisitKinds {-# INLINE rule665 #-} rule665 = \ ((_stepsIisLast) :: Bool) -> _stepsIisLast {-# INLINE rule666 #-} rule666 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule667 #-} rule667 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule668 #-} rule668 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule669 #-} rule669 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _lhsIallchildvisit {-# INLINE rule670 #-} rule670 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule671 #-} rule671 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule672 #-} rule672 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule673 #-} rule673 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule674 #-} rule674 = \ ((_lhsIfollow) :: PP_Doc) -> _lhsIfollow {-# INLINE rule675 #-} rule675 = \ ((_lhsIkind) :: VisitKind) -> _lhsIkind {-# INLINE rule676 #-} rule676 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule677 #-} rule677 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule678 #-} rule678 = \ ((_lhsIprevMaxSimRefs) :: Int) -> _lhsIprevMaxSimRefs {-# INLINE rule679 #-} rule679 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule680 #-} rule680 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# INLINE rule681 #-} rule681 = \ _useParallel -> _useParallel {-# NOINLINE sem_VisitStep_ChildIntro #-} sem_VisitStep_ChildIntro :: (Identifier) -> T_VisitStep sem_VisitStep_ChildIntro arg_child_ = T_VisitStep (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_VisitStep_v49 v49 = \ (T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfollow _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) -> ( let _attachItf = rule682 _lhsIchildintros arg_child_ _lhsOerrors :: Seq Error _lhsOdefs :: Set String _lhsOuses :: Map String (Maybe NonLocalAttr) (_lhsOerrors,_sem_steps,_lhsOdefs,_lhsOuses) = rule683 _attachItf _lhsIkind _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule684 _lhsIfollow _sem_steps _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule685 () _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule686 () _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule687 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule688 () _lhsOindex :: Int _lhsOindex = rule689 _lhsIindex _lhsOisLast :: Bool _lhsOisLast = rule690 _lhsIisLast _lhsOprevMaxSimRefs :: Int _lhsOprevMaxSimRefs = rule691 _lhsIprevMaxSimRefs __result_ = T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitStep_s50 v49 {-# INLINE rule682 #-} {-# LINE 854 "src-ag/ExecutionPlan2Caml.ag" #-} rule682 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) child_ -> {-# LINE 854 "src-ag/ExecutionPlan2Caml.ag" #-} Map.findWithDefault (error $ "Child " ++ show child_ ++ " not found") child_ _lhsIchildintros {-# LINE 5396 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule683 #-} {-# LINE 856 "src-ag/ExecutionPlan2Caml.ag" #-} rule683 = \ _attachItf ((_lhsIkind) :: VisitKind) -> {-# LINE 856 "src-ag/ExecutionPlan2Caml.ag" #-} case _attachItf _lhsIkind of Left e -> (Seq.singleton e, empty, Set.empty, Map.empty) Right (code, defs, uses) -> (Seq.empty, code, defs, uses) {-# LINE 5404 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule684 #-} {-# LINE 859 "src-ag/ExecutionPlan2Caml.ag" #-} rule684 = \ ((_lhsIfollow) :: PP_Doc) _sem_steps -> {-# LINE 859 "src-ag/ExecutionPlan2Caml.ag" #-} _sem_steps >-< _lhsIfollow {-# LINE 5410 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule685 #-} rule685 = \ (_ :: ()) -> Set.empty {-# INLINE rule686 #-} rule686 = \ (_ :: ()) -> Map.empty {-# INLINE rule687 #-} rule687 = \ (_ :: ()) -> Map.empty {-# INLINE rule688 #-} rule688 = \ (_ :: ()) -> mempty {-# INLINE rule689 #-} rule689 = \ ((_lhsIindex) :: Int) -> _lhsIindex {-# INLINE rule690 #-} rule690 = \ ((_lhsIisLast) :: Bool) -> _lhsIisLast {-# INLINE rule691 #-} rule691 = \ ((_lhsIprevMaxSimRefs) :: Int) -> _lhsIprevMaxSimRefs -- VisitSteps -------------------------------------------------- -- wrapper data Inh_VisitSteps = Inh_VisitSteps { allFromToStates_Inh_VisitSteps :: (Map VisitIdentifier (Int,Int)), allInitStates_Inh_VisitSteps :: (Map NontermIdent Int), allVisitKinds_Inh_VisitSteps :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_VisitSteps :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)), avisitdefs_Inh_VisitSteps :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_VisitSteps :: (Map VisitIdentifier (Set Identifier)), childTypes_Inh_VisitSteps :: (Map Identifier Type), childintros_Inh_VisitSteps :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), follow_Inh_VisitSteps :: (PP_Doc), index_Inh_VisitSteps :: (Int), kind_Inh_VisitSteps :: (VisitKind), mrules_Inh_VisitSteps :: (Map Identifier (VisitKind -> Either Error PP_Doc)), options_Inh_VisitSteps :: (Options), prevMaxSimRefs_Inh_VisitSteps :: (Int), ruledefs_Inh_VisitSteps :: (Map Identifier (Set String)), ruleuses_Inh_VisitSteps :: (Map Identifier (Map String (Maybe NonLocalAttr))), useParallel_Inh_VisitSteps :: (Bool) } data Syn_VisitSteps = Syn_VisitSteps { defs_Syn_VisitSteps :: (Set String), errors_Syn_VisitSteps :: (Seq Error), index_Syn_VisitSteps :: (Int), isLast_Syn_VisitSteps :: (Bool), lazyIntras_Syn_VisitSteps :: (Set String), prevMaxSimRefs_Syn_VisitSteps :: (Int), ruleKinds_Syn_VisitSteps :: (Map Identifier (Set VisitKind)), ruleUsage_Syn_VisitSteps :: (Map Identifier Int), sem_steps_Syn_VisitSteps :: (PP_Doc), size_Syn_VisitSteps :: (Int), uses_Syn_VisitSteps :: (Map String (Maybe NonLocalAttr)), visitKinds_Syn_VisitSteps :: (Map VisitIdentifier VisitKind) } {-# INLINABLE wrap_VisitSteps #-} wrap_VisitSteps :: T_VisitSteps -> Inh_VisitSteps -> (Syn_VisitSteps ) wrap_VisitSteps (T_VisitSteps act) (Inh_VisitSteps _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfollow _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) = Control.Monad.Identity.runIdentity ( do sem <- act let arg52 = T_VisitSteps_vIn52 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfollow _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel (T_VisitSteps_vOut52 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsize _lhsOuses _lhsOvisitKinds) <- return (inv_VisitSteps_s53 sem arg52) return (Syn_VisitSteps _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsize _lhsOuses _lhsOvisitKinds) ) -- cata {-# NOINLINE sem_VisitSteps #-} sem_VisitSteps :: VisitSteps -> T_VisitSteps sem_VisitSteps list = Prelude.foldr sem_VisitSteps_Cons sem_VisitSteps_Nil (Prelude.map sem_VisitStep list) -- semantic domain newtype T_VisitSteps = T_VisitSteps { attach_T_VisitSteps :: Identity (T_VisitSteps_s53 ) } newtype T_VisitSteps_s53 = C_VisitSteps_s53 { inv_VisitSteps_s53 :: (T_VisitSteps_v52 ) } data T_VisitSteps_s54 = C_VisitSteps_s54 type T_VisitSteps_v52 = (T_VisitSteps_vIn52 ) -> (T_VisitSteps_vOut52 ) data T_VisitSteps_vIn52 = T_VisitSteps_vIn52 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Int) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map Identifier Type) (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) (PP_Doc) (Int) (VisitKind) (Map Identifier (VisitKind -> Either Error PP_Doc)) (Options) (Int) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (Bool) data T_VisitSteps_vOut52 = T_VisitSteps_vOut52 (Set String) (Seq Error) (Int) (Bool) (Set String) (Int) (Map Identifier (Set VisitKind)) (Map Identifier Int) (PP_Doc) (Int) (Map String (Maybe NonLocalAttr)) (Map VisitIdentifier VisitKind) {-# NOINLINE sem_VisitSteps_Cons #-} sem_VisitSteps_Cons :: T_VisitStep -> T_VisitSteps -> T_VisitSteps sem_VisitSteps_Cons arg_hd_ arg_tl_ = T_VisitSteps (return st53) where {-# NOINLINE st53 #-} st53 = let v52 :: T_VisitSteps_v52 v52 = \ (T_VisitSteps_vIn52 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfollow _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) -> ( let _hdX50 = Control.Monad.Identity.runIdentity (attach_T_VisitStep (arg_hd_)) _tlX53 = Control.Monad.Identity.runIdentity (attach_T_VisitSteps (arg_tl_)) (T_VisitStep_vOut49 _hdIdefs _hdIerrors _hdIindex _hdIisLast _hdIlazyIntras _hdIprevMaxSimRefs _hdIruleKinds _hdIruleUsage _hdIsem_steps _hdIuses _hdIvisitKinds) = inv_VisitStep_s50 _hdX50 (T_VisitStep_vIn49 _hdOallFromToStates _hdOallInitStates _hdOallVisitKinds _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOchildTypes _hdOchildintros _hdOfollow _hdOindex _hdOisLast _hdOkind _hdOmrules _hdOoptions _hdOprevMaxSimRefs _hdOruledefs _hdOruleuses _hdOuseParallel) (T_VisitSteps_vOut52 _tlIdefs _tlIerrors _tlIindex _tlIisLast _tlIlazyIntras _tlIprevMaxSimRefs _tlIruleKinds _tlIruleUsage _tlIsem_steps _tlIsize _tlIuses _tlIvisitKinds) = inv_VisitSteps_s53 _tlX53 (T_VisitSteps_vIn52 _tlOallFromToStates _tlOallInitStates _tlOallVisitKinds _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOchildTypes _tlOchildintros _tlOfollow _tlOindex _tlOkind _tlOmrules _tlOoptions _tlOprevMaxSimRefs _tlOruledefs _tlOruleuses _tlOuseParallel) _hdOfollow = rule692 _tlIsem_steps _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule693 _hdIsem_steps _lhsOsize :: Int _lhsOsize = rule694 _tlIsize _hdOindex = rule695 _lhsIindex _tlOindex = rule696 _lhsIindex _lhsOindex :: Int _lhsOindex = rule697 _tlIindex _lhsOisLast :: Bool _lhsOisLast = rule698 () _hdOisLast = rule699 _tlIisLast _lhsOdefs :: Set String _lhsOdefs = rule700 _hdIdefs _tlIdefs _lhsOerrors :: Seq Error _lhsOerrors = rule701 _hdIerrors _tlIerrors _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule702 _hdIlazyIntras _tlIlazyIntras _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule703 _hdIruleKinds _tlIruleKinds _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule704 _hdIruleUsage _tlIruleUsage _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule705 _hdIuses _tlIuses _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule706 _hdIvisitKinds _tlIvisitKinds _lhsOprevMaxSimRefs :: Int _lhsOprevMaxSimRefs = rule707 _tlIprevMaxSimRefs _hdOallFromToStates = rule708 _lhsIallFromToStates _hdOallInitStates = rule709 _lhsIallInitStates _hdOallVisitKinds = rule710 _lhsIallVisitKinds _hdOallchildvisit = rule711 _lhsIallchildvisit _hdOavisitdefs = rule712 _lhsIavisitdefs _hdOavisituses = rule713 _lhsIavisituses _hdOchildTypes = rule714 _lhsIchildTypes _hdOchildintros = rule715 _lhsIchildintros _hdOkind = rule716 _lhsIkind _hdOmrules = rule717 _lhsImrules _hdOoptions = rule718 _lhsIoptions _hdOprevMaxSimRefs = rule719 _lhsIprevMaxSimRefs _hdOruledefs = rule720 _lhsIruledefs _hdOruleuses = rule721 _lhsIruleuses _hdOuseParallel = rule722 _lhsIuseParallel _tlOallFromToStates = rule723 _lhsIallFromToStates _tlOallInitStates = rule724 _lhsIallInitStates _tlOallVisitKinds = rule725 _lhsIallVisitKinds _tlOallchildvisit = rule726 _lhsIallchildvisit _tlOavisitdefs = rule727 _lhsIavisitdefs _tlOavisituses = rule728 _lhsIavisituses _tlOchildTypes = rule729 _lhsIchildTypes _tlOchildintros = rule730 _lhsIchildintros _tlOfollow = rule731 _lhsIfollow _tlOkind = rule732 _lhsIkind _tlOmrules = rule733 _lhsImrules _tlOoptions = rule734 _lhsIoptions _tlOprevMaxSimRefs = rule735 _hdIprevMaxSimRefs _tlOruledefs = rule736 _lhsIruledefs _tlOruleuses = rule737 _lhsIruleuses _tlOuseParallel = rule738 _lhsIuseParallel __result_ = T_VisitSteps_vOut52 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsize _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitSteps_s53 v52 {-# INLINE rule692 #-} {-# LINE 844 "src-ag/ExecutionPlan2Caml.ag" #-} rule692 = \ ((_tlIsem_steps) :: PP_Doc) -> {-# LINE 844 "src-ag/ExecutionPlan2Caml.ag" #-} _tlIsem_steps {-# LINE 5541 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule693 #-} {-# LINE 845 "src-ag/ExecutionPlan2Caml.ag" #-} rule693 = \ ((_hdIsem_steps) :: PP_Doc) -> {-# LINE 845 "src-ag/ExecutionPlan2Caml.ag" #-} _hdIsem_steps {-# LINE 5547 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule694 #-} {-# LINE 876 "src-ag/ExecutionPlan2Caml.ag" #-} rule694 = \ ((_tlIsize) :: Int) -> {-# LINE 876 "src-ag/ExecutionPlan2Caml.ag" #-} 1 + _tlIsize {-# LINE 5553 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule695 #-} {-# LINE 881 "src-ag/ExecutionPlan2Caml.ag" #-} rule695 = \ ((_lhsIindex) :: Int) -> {-# LINE 881 "src-ag/ExecutionPlan2Caml.ag" #-} _lhsIindex {-# LINE 5559 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule696 #-} {-# LINE 882 "src-ag/ExecutionPlan2Caml.ag" #-} rule696 = \ ((_lhsIindex) :: Int) -> {-# LINE 882 "src-ag/ExecutionPlan2Caml.ag" #-} 1 + _lhsIindex {-# LINE 5565 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule697 #-} {-# LINE 883 "src-ag/ExecutionPlan2Caml.ag" #-} rule697 = \ ((_tlIindex) :: Int) -> {-# LINE 883 "src-ag/ExecutionPlan2Caml.ag" #-} _tlIindex {-# LINE 5571 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule698 #-} {-# LINE 902 "src-ag/ExecutionPlan2Caml.ag" #-} rule698 = \ (_ :: ()) -> {-# LINE 902 "src-ag/ExecutionPlan2Caml.ag" #-} False {-# LINE 5577 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule699 #-} {-# LINE 903 "src-ag/ExecutionPlan2Caml.ag" #-} rule699 = \ ((_tlIisLast) :: Bool) -> {-# LINE 903 "src-ag/ExecutionPlan2Caml.ag" #-} _tlIisLast {-# LINE 5583 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule700 #-} rule700 = \ ((_hdIdefs) :: Set String) ((_tlIdefs) :: Set String) -> _hdIdefs `Set.union` _tlIdefs {-# INLINE rule701 #-} rule701 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule702 #-} rule702 = \ ((_hdIlazyIntras) :: Set String) ((_tlIlazyIntras) :: Set String) -> _hdIlazyIntras `Set.union` _tlIlazyIntras {-# INLINE rule703 #-} rule703 = \ ((_hdIruleKinds) :: Map Identifier (Set VisitKind)) ((_tlIruleKinds) :: Map Identifier (Set VisitKind)) -> _hdIruleKinds `unionWithMappend` _tlIruleKinds {-# INLINE rule704 #-} rule704 = \ ((_hdIruleUsage) :: Map Identifier Int) ((_tlIruleUsage) :: Map Identifier Int) -> _hdIruleUsage `unionWithSum` _tlIruleUsage {-# INLINE rule705 #-} rule705 = \ ((_hdIuses) :: Map String (Maybe NonLocalAttr)) ((_tlIuses) :: Map String (Maybe NonLocalAttr)) -> _hdIuses `Map.union` _tlIuses {-# INLINE rule706 #-} rule706 = \ ((_hdIvisitKinds) :: Map VisitIdentifier VisitKind) ((_tlIvisitKinds) :: Map VisitIdentifier VisitKind) -> _hdIvisitKinds `mappend` _tlIvisitKinds {-# INLINE rule707 #-} rule707 = \ ((_tlIprevMaxSimRefs) :: Int) -> _tlIprevMaxSimRefs {-# INLINE rule708 #-} rule708 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule709 #-} rule709 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule710 #-} rule710 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule711 #-} rule711 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _lhsIallchildvisit {-# INLINE rule712 #-} rule712 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule713 #-} rule713 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule714 #-} rule714 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule715 #-} rule715 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule716 #-} rule716 = \ ((_lhsIkind) :: VisitKind) -> _lhsIkind {-# INLINE rule717 #-} rule717 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule718 #-} rule718 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule719 #-} rule719 = \ ((_lhsIprevMaxSimRefs) :: Int) -> _lhsIprevMaxSimRefs {-# INLINE rule720 #-} rule720 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule721 #-} rule721 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# INLINE rule722 #-} rule722 = \ ((_lhsIuseParallel) :: Bool) -> _lhsIuseParallel {-# INLINE rule723 #-} rule723 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule724 #-} rule724 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule725 #-} rule725 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule726 #-} rule726 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _lhsIallchildvisit {-# INLINE rule727 #-} rule727 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule728 #-} rule728 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule729 #-} rule729 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule730 #-} rule730 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule731 #-} rule731 = \ ((_lhsIfollow) :: PP_Doc) -> _lhsIfollow {-# INLINE rule732 #-} rule732 = \ ((_lhsIkind) :: VisitKind) -> _lhsIkind {-# INLINE rule733 #-} rule733 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule734 #-} rule734 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule735 #-} rule735 = \ ((_hdIprevMaxSimRefs) :: Int) -> _hdIprevMaxSimRefs {-# INLINE rule736 #-} rule736 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule737 #-} rule737 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# INLINE rule738 #-} rule738 = \ ((_lhsIuseParallel) :: Bool) -> _lhsIuseParallel {-# NOINLINE sem_VisitSteps_Nil #-} sem_VisitSteps_Nil :: T_VisitSteps sem_VisitSteps_Nil = T_VisitSteps (return st53) where {-# NOINLINE st53 #-} st53 = let v52 :: T_VisitSteps_v52 v52 = \ (T_VisitSteps_vIn52 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfollow _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) -> ( let _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule739 _lhsIfollow _lhsOsize :: Int _lhsOsize = rule740 () _lhsOisLast :: Bool _lhsOisLast = rule741 () _lhsOdefs :: Set String _lhsOdefs = rule742 () _lhsOerrors :: Seq Error _lhsOerrors = rule743 () _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule744 () _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule745 () _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule746 () _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule747 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule748 () _lhsOindex :: Int _lhsOindex = rule749 _lhsIindex _lhsOprevMaxSimRefs :: Int _lhsOprevMaxSimRefs = rule750 _lhsIprevMaxSimRefs __result_ = T_VisitSteps_vOut52 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsize _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitSteps_s53 v52 {-# INLINE rule739 #-} {-# LINE 846 "src-ag/ExecutionPlan2Caml.ag" #-} rule739 = \ ((_lhsIfollow) :: PP_Doc) -> {-# LINE 846 "src-ag/ExecutionPlan2Caml.ag" #-} _lhsIfollow {-# LINE 5740 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule740 #-} {-# LINE 875 "src-ag/ExecutionPlan2Caml.ag" #-} rule740 = \ (_ :: ()) -> {-# LINE 875 "src-ag/ExecutionPlan2Caml.ag" #-} 0 {-# LINE 5746 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule741 #-} {-# LINE 901 "src-ag/ExecutionPlan2Caml.ag" #-} rule741 = \ (_ :: ()) -> {-# LINE 901 "src-ag/ExecutionPlan2Caml.ag" #-} True {-# LINE 5752 "dist/build/ExecutionPlan2Caml.hs"#-} {-# INLINE rule742 #-} rule742 = \ (_ :: ()) -> Set.empty {-# INLINE rule743 #-} rule743 = \ (_ :: ()) -> Seq.empty {-# INLINE rule744 #-} rule744 = \ (_ :: ()) -> Set.empty {-# INLINE rule745 #-} rule745 = \ (_ :: ()) -> Map.empty {-# INLINE rule746 #-} rule746 = \ (_ :: ()) -> Map.empty {-# INLINE rule747 #-} rule747 = \ (_ :: ()) -> Map.empty {-# INLINE rule748 #-} rule748 = \ (_ :: ()) -> mempty {-# INLINE rule749 #-} rule749 = \ ((_lhsIindex) :: Int) -> _lhsIindex {-# INLINE rule750 #-} rule750 = \ ((_lhsIprevMaxSimRefs) :: Int) -> _lhsIprevMaxSimRefs -- Visits ------------------------------------------------------ -- wrapper data Inh_Visits = Inh_Visits { allFromToStates_Inh_Visits :: (Map VisitIdentifier (Int,Int)), allInhmap_Inh_Visits :: (Map NontermIdent Attributes), allInitStates_Inh_Visits :: (Map NontermIdent Int), allSynmap_Inh_Visits :: (Map NontermIdent Attributes), allVisitKinds_Inh_Visits :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_Visits :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)), allintramap_Inh_Visits :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))), avisitdefs_Inh_Visits :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_Visits :: (Map VisitIdentifier (Set Identifier)), childTypes_Inh_Visits :: (Map Identifier Type), childintros_Inh_Visits :: (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), con_Inh_Visits :: (ConstructorIdent), inhmap_Inh_Visits :: (Attributes), mrules_Inh_Visits :: (Map Identifier (VisitKind -> Either Error PP_Doc)), nextVisits_Inh_Visits :: (Map StateIdentifier StateCtx), nt_Inh_Visits :: (NontermIdent), options_Inh_Visits :: (Options), params_Inh_Visits :: ([Identifier]), prevVisits_Inh_Visits :: (Map StateIdentifier StateCtx), ruledefs_Inh_Visits :: (Map Identifier (Set String)), ruleuses_Inh_Visits :: (Map Identifier (Map String (Maybe NonLocalAttr))), synmap_Inh_Visits :: (Attributes), terminaldefs_Inh_Visits :: (Set String) } data Syn_Visits = Syn_Visits { allvisits_Syn_Visits :: ([VisitStateState]), childvisit_Syn_Visits :: (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)), errors_Syn_Visits :: (Seq Error), fromToStates_Syn_Visits :: (Map VisitIdentifier (Int,Int)), intramap_Syn_Visits :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))), lazyIntras_Syn_Visits :: (Set String), ruleKinds_Syn_Visits :: (Map Identifier (Set VisitKind)), ruleUsage_Syn_Visits :: (Map Identifier Int), sem_visit_Syn_Visits :: ( [(StateIdentifier,PP_Doc)] ), t_visits_Syn_Visits :: (PP_Doc), visitKinds_Syn_Visits :: (Map VisitIdentifier VisitKind), visitdefs_Syn_Visits :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_Visits :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_Visits #-} wrap_Visits :: T_Visits -> Inh_Visits -> (Syn_Visits ) wrap_Visits (T_Visits act) (Inh_Visits _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) = Control.Monad.Identity.runIdentity ( do sem <- act let arg55 = T_Visits_vIn55 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs (T_Visits_vOut55 _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_Visits_s56 sem arg55) return (Syn_Visits _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# NOINLINE sem_Visits #-} sem_Visits :: Visits -> T_Visits sem_Visits list = Prelude.foldr sem_Visits_Cons sem_Visits_Nil (Prelude.map sem_Visit list) -- semantic domain newtype T_Visits = T_Visits { attach_T_Visits :: Identity (T_Visits_s56 ) } newtype T_Visits_s56 = C_Visits_s56 { inv_Visits_s56 :: (T_Visits_v55 ) } data T_Visits_s57 = C_Visits_s57 type T_Visits_v55 = (T_Visits_vIn55 ) -> (T_Visits_vOut55 ) data T_Visits_vIn55 = T_Visits_vIn55 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Attributes) (Map NontermIdent Int) (Map NontermIdent Attributes) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) (Map StateIdentifier (Map String (Maybe NonLocalAttr))) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map Identifier Type) (Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) (ConstructorIdent) (Attributes) (Map Identifier (VisitKind -> Either Error PP_Doc)) (Map StateIdentifier StateCtx) (NontermIdent) (Options) ([Identifier]) (Map StateIdentifier StateCtx) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (Attributes) (Set String) data T_Visits_vOut55 = T_Visits_vOut55 ([VisitStateState]) (Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) (Seq Error) (Map VisitIdentifier (Int,Int)) (Map StateIdentifier (Map String (Maybe NonLocalAttr))) (Set String) (Map Identifier (Set VisitKind)) (Map Identifier Int) ( [(StateIdentifier,PP_Doc)] ) (PP_Doc) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_Visits_Cons #-} sem_Visits_Cons :: T_Visit -> T_Visits -> T_Visits sem_Visits_Cons arg_hd_ arg_tl_ = T_Visits (return st56) where {-# NOINLINE st56 #-} st56 = let v55 :: T_Visits_v55 v55 = \ (T_Visits_vIn55 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) -> ( let _hdX47 = Control.Monad.Identity.runIdentity (attach_T_Visit (arg_hd_)) _tlX56 = Control.Monad.Identity.runIdentity (attach_T_Visits (arg_tl_)) (T_Visit_vOut46 _hdIallvisits _hdIchildvisit _hdIerrors _hdIfromToStates _hdIintramap _hdIlazyIntras _hdIruleKinds _hdIruleUsage _hdIsem_visit _hdIt_visits _hdIvisitKinds _hdIvisitdefs _hdIvisituses) = inv_Visit_s47 _hdX47 (T_Visit_vIn46 _hdOallFromToStates _hdOallInhmap _hdOallInitStates _hdOallSynmap _hdOallVisitKinds _hdOallchildvisit _hdOallintramap _hdOavisitdefs _hdOavisituses _hdOchildTypes _hdOchildintros _hdOcon _hdOinhmap _hdOmrules _hdOnextVisits _hdOnt _hdOoptions _hdOparams _hdOprevVisits _hdOruledefs _hdOruleuses _hdOsynmap _hdOterminaldefs) (T_Visits_vOut55 _tlIallvisits _tlIchildvisit _tlIerrors _tlIfromToStates _tlIintramap _tlIlazyIntras _tlIruleKinds _tlIruleUsage _tlIsem_visit _tlIt_visits _tlIvisitKinds _tlIvisitdefs _tlIvisituses) = inv_Visits_s56 _tlX56 (T_Visits_vIn55 _tlOallFromToStates _tlOallInhmap _tlOallInitStates _tlOallSynmap _tlOallVisitKinds _tlOallchildvisit _tlOallintramap _tlOavisitdefs _tlOavisituses _tlOchildTypes _tlOchildintros _tlOcon _tlOinhmap _tlOmrules _tlOnextVisits _tlOnt _tlOoptions _tlOparams _tlOprevVisits _tlOruledefs _tlOruleuses _tlOsynmap _tlOterminaldefs) _lhsOallvisits :: [VisitStateState] _lhsOallvisits = rule751 _hdIallvisits _tlIallvisits _lhsOchildvisit :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) _lhsOchildvisit = rule752 _hdIchildvisit _tlIchildvisit _lhsOerrors :: Seq Error _lhsOerrors = rule753 _hdIerrors _tlIerrors _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule754 _hdIfromToStates _tlIfromToStates _lhsOintramap :: Map StateIdentifier (Map String (Maybe NonLocalAttr)) _lhsOintramap = rule755 _hdIintramap _tlIintramap _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule756 _hdIlazyIntras _tlIlazyIntras _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule757 _hdIruleKinds _tlIruleKinds _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule758 _hdIruleUsage _tlIruleUsage _lhsOsem_visit :: [(StateIdentifier,PP_Doc)] _lhsOsem_visit = rule759 _hdIsem_visit _tlIsem_visit _lhsOt_visits :: PP_Doc _lhsOt_visits = rule760 _hdIt_visits _tlIt_visits _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule761 _hdIvisitKinds _tlIvisitKinds _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule762 _hdIvisitdefs _tlIvisitdefs _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule763 _hdIvisituses _tlIvisituses _hdOallFromToStates = rule764 _lhsIallFromToStates _hdOallInhmap = rule765 _lhsIallInhmap _hdOallInitStates = rule766 _lhsIallInitStates _hdOallSynmap = rule767 _lhsIallSynmap _hdOallVisitKinds = rule768 _lhsIallVisitKinds _hdOallchildvisit = rule769 _lhsIallchildvisit _hdOallintramap = rule770 _lhsIallintramap _hdOavisitdefs = rule771 _lhsIavisitdefs _hdOavisituses = rule772 _lhsIavisituses _hdOchildTypes = rule773 _lhsIchildTypes _hdOchildintros = rule774 _lhsIchildintros _hdOcon = rule775 _lhsIcon _hdOinhmap = rule776 _lhsIinhmap _hdOmrules = rule777 _lhsImrules _hdOnextVisits = rule778 _lhsInextVisits _hdOnt = rule779 _lhsInt _hdOoptions = rule780 _lhsIoptions _hdOparams = rule781 _lhsIparams _hdOprevVisits = rule782 _lhsIprevVisits _hdOruledefs = rule783 _lhsIruledefs _hdOruleuses = rule784 _lhsIruleuses _hdOsynmap = rule785 _lhsIsynmap _hdOterminaldefs = rule786 _lhsIterminaldefs _tlOallFromToStates = rule787 _lhsIallFromToStates _tlOallInhmap = rule788 _lhsIallInhmap _tlOallInitStates = rule789 _lhsIallInitStates _tlOallSynmap = rule790 _lhsIallSynmap _tlOallVisitKinds = rule791 _lhsIallVisitKinds _tlOallchildvisit = rule792 _lhsIallchildvisit _tlOallintramap = rule793 _lhsIallintramap _tlOavisitdefs = rule794 _lhsIavisitdefs _tlOavisituses = rule795 _lhsIavisituses _tlOchildTypes = rule796 _lhsIchildTypes _tlOchildintros = rule797 _lhsIchildintros _tlOcon = rule798 _lhsIcon _tlOinhmap = rule799 _lhsIinhmap _tlOmrules = rule800 _lhsImrules _tlOnextVisits = rule801 _lhsInextVisits _tlOnt = rule802 _lhsInt _tlOoptions = rule803 _lhsIoptions _tlOparams = rule804 _lhsIparams _tlOprevVisits = rule805 _lhsIprevVisits _tlOruledefs = rule806 _lhsIruledefs _tlOruleuses = rule807 _lhsIruleuses _tlOsynmap = rule808 _lhsIsynmap _tlOterminaldefs = rule809 _lhsIterminaldefs __result_ = T_Visits_vOut55 _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_Visits_s56 v55 {-# INLINE rule751 #-} rule751 = \ ((_hdIallvisits) :: VisitStateState ) ((_tlIallvisits) :: [VisitStateState]) -> _hdIallvisits : _tlIallvisits {-# INLINE rule752 #-} rule752 = \ ((_hdIchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) ((_tlIchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _hdIchildvisit `Map.union` _tlIchildvisit {-# INLINE rule753 #-} rule753 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule754 #-} rule754 = \ ((_hdIfromToStates) :: Map VisitIdentifier (Int,Int)) ((_tlIfromToStates) :: Map VisitIdentifier (Int,Int)) -> _hdIfromToStates `mappend` _tlIfromToStates {-# INLINE rule755 #-} rule755 = \ ((_hdIintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) ((_tlIintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> _hdIintramap `uwMapUnion` _tlIintramap {-# INLINE rule756 #-} rule756 = \ ((_hdIlazyIntras) :: Set String) ((_tlIlazyIntras) :: Set String) -> _hdIlazyIntras `Set.union` _tlIlazyIntras {-# INLINE rule757 #-} rule757 = \ ((_hdIruleKinds) :: Map Identifier (Set VisitKind)) ((_tlIruleKinds) :: Map Identifier (Set VisitKind)) -> _hdIruleKinds `unionWithMappend` _tlIruleKinds {-# INLINE rule758 #-} rule758 = \ ((_hdIruleUsage) :: Map Identifier Int) ((_tlIruleUsage) :: Map Identifier Int) -> _hdIruleUsage `unionWithSum` _tlIruleUsage {-# INLINE rule759 #-} rule759 = \ ((_hdIsem_visit) :: (StateIdentifier,PP_Doc) ) ((_tlIsem_visit) :: [(StateIdentifier,PP_Doc)] ) -> _hdIsem_visit : _tlIsem_visit {-# INLINE rule760 #-} rule760 = \ ((_hdIt_visits) :: PP_Doc) ((_tlIt_visits) :: PP_Doc) -> _hdIt_visits >-< _tlIt_visits {-# INLINE rule761 #-} rule761 = \ ((_hdIvisitKinds) :: Map VisitIdentifier VisitKind) ((_tlIvisitKinds) :: Map VisitIdentifier VisitKind) -> _hdIvisitKinds `mappend` _tlIvisitKinds {-# INLINE rule762 #-} rule762 = \ ((_hdIvisitdefs) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisitdefs `uwSetUnion` _tlIvisitdefs {-# INLINE rule763 #-} rule763 = \ ((_hdIvisituses) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisituses) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisituses `uwSetUnion` _tlIvisituses {-# INLINE rule764 #-} rule764 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule765 #-} rule765 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule766 #-} rule766 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule767 #-} rule767 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule768 #-} rule768 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule769 #-} rule769 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _lhsIallchildvisit {-# INLINE rule770 #-} rule770 = \ ((_lhsIallintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> _lhsIallintramap {-# INLINE rule771 #-} rule771 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule772 #-} rule772 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule773 #-} rule773 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule774 #-} rule774 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule775 #-} rule775 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule776 #-} rule776 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule777 #-} rule777 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule778 #-} rule778 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) -> _lhsInextVisits {-# INLINE rule779 #-} rule779 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule780 #-} rule780 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule781 #-} rule781 = \ ((_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule782 #-} rule782 = \ ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) -> _lhsIprevVisits {-# INLINE rule783 #-} rule783 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule784 #-} rule784 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# INLINE rule785 #-} rule785 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule786 #-} rule786 = \ ((_lhsIterminaldefs) :: Set String) -> _lhsIterminaldefs {-# INLINE rule787 #-} rule787 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule788 #-} rule788 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule789 #-} rule789 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule790 #-} rule790 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule791 #-} rule791 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule792 #-} rule792 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)) -> _lhsIallchildvisit {-# INLINE rule793 #-} rule793 = \ ((_lhsIallintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> _lhsIallintramap {-# INLINE rule794 #-} rule794 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule795 #-} rule795 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule796 #-} rule796 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule797 #-} rule797 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule798 #-} rule798 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule799 #-} rule799 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule800 #-} rule800 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule801 #-} rule801 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) -> _lhsInextVisits {-# INLINE rule802 #-} rule802 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule803 #-} rule803 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule804 #-} rule804 = \ ((_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule805 #-} rule805 = \ ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) -> _lhsIprevVisits {-# INLINE rule806 #-} rule806 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule807 #-} rule807 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# INLINE rule808 #-} rule808 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule809 #-} rule809 = \ ((_lhsIterminaldefs) :: Set String) -> _lhsIterminaldefs {-# NOINLINE sem_Visits_Nil #-} sem_Visits_Nil :: T_Visits sem_Visits_Nil = T_Visits (return st56) where {-# NOINLINE st56 #-} st56 = let v55 :: T_Visits_v55 v55 = \ (T_Visits_vIn55 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) -> ( let _lhsOallvisits :: [VisitStateState] _lhsOallvisits = rule810 () _lhsOchildvisit :: Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc) _lhsOchildvisit = rule811 () _lhsOerrors :: Seq Error _lhsOerrors = rule812 () _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule813 () _lhsOintramap :: Map StateIdentifier (Map String (Maybe NonLocalAttr)) _lhsOintramap = rule814 () _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule815 () _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule816 () _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule817 () _lhsOsem_visit :: [(StateIdentifier,PP_Doc)] _lhsOsem_visit = rule818 () _lhsOt_visits :: PP_Doc _lhsOt_visits = rule819 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule820 () _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule821 () _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule822 () __result_ = T_Visits_vOut55 _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_Visits_s56 v55 {-# INLINE rule810 #-} rule810 = \ (_ :: ()) -> [] {-# INLINE rule811 #-} rule811 = \ (_ :: ()) -> Map.empty {-# INLINE rule812 #-} rule812 = \ (_ :: ()) -> Seq.empty {-# INLINE rule813 #-} rule813 = \ (_ :: ()) -> mempty {-# INLINE rule814 #-} rule814 = \ (_ :: ()) -> Map.empty {-# INLINE rule815 #-} rule815 = \ (_ :: ()) -> Set.empty {-# INLINE rule816 #-} rule816 = \ (_ :: ()) -> Map.empty {-# INLINE rule817 #-} rule817 = \ (_ :: ()) -> Map.empty {-# INLINE rule818 #-} rule818 = \ (_ :: ()) -> [] {-# INLINE rule819 #-} rule819 = \ (_ :: ()) -> empty {-# INLINE rule820 #-} rule820 = \ (_ :: ()) -> mempty {-# INLINE rule821 #-} rule821 = \ (_ :: ()) -> Map.empty {-# INLINE rule822 #-} rule822 = \ (_ :: ()) -> Map.empty uuagc-0.9.52.2/src-generated/PrintCode.hs0000644000000000000000000057260513433540502016225 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} module PrintCode where {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 12 "dist/build/PrintCode.hs" #-} {-# LINE 2 "src-ag/Code.ag" #-} import Patterns import Data.Set(Set) import qualified Data.Set as Set import Data.Map(Map) import qualified Data.Map as Map {-# LINE 21 "dist/build/PrintCode.hs" #-} {-# LINE 10 "src-ag/PrintCode.ag" #-} import Data.Char (isAlphaNum) import Pretty import Code import Options import CommonTypes (attrname, _LOC, nullIdent) import Data.List(intersperse) import System.IO import System.Directory import System.FilePath import CommonTypes(BlockInfo, BlockKind(..)) {-# LINE 35 "dist/build/PrintCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 146 "src-ag/Code.ag" #-} -- Unboxed tuples -- unbox Whether unboxed tuples are wanted or not -- inh The inherited attributes. -- If there are none, no unboxing can take place, -- because in that case the semantic function (a top-level identifier) would have an unboxed type. -- Of course we can't have an unboxed 1-tuple mkTupleExpr :: Bool -> Bool -> Exprs -> Expr mkTupleExpr unbox' noInh exprs | not unbox' || noInh || length exprs == 1 = TupleExpr exprs | otherwise = UnboxedTupleExpr exprs mkTupleType :: Bool -> Bool -> Types -> Type mkTupleType unbox' noInh tps | not unbox' || noInh || length tps == 1 = TupleType tps | otherwise = UnboxedTupleType tps mkTupleLhs :: Bool -> Bool -> [String] -> Lhs mkTupleLhs unbox' noInh comps | not unbox' || noInh || length comps == 1 = TupleLhs comps | otherwise = UnboxedTupleLhs comps {-# LINE 55 "dist/build/PrintCode.hs" #-} {-# LINE 23 "src-ag/PrintCode.ag" #-} type PP_Docs = [PP_Doc] {-# LINE 60 "dist/build/PrintCode.hs" #-} {-# LINE 27 "src-ag/PrintCode.ag" #-} ppMultiSeqH :: [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeqH = ppMultiSeq' (>#<) ppMultiSeqV :: [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeqV = ppMultiSeq' (>-<) ppMultiSeq' :: (PP_Doc -> PP_Doc -> PP_Doc) -> [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeq' next strictArgs expr = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs {-# LINE 73 "dist/build/PrintCode.hs" #-} {-# LINE 303 "src-ag/PrintCode.ag" #-} reallySimple :: String -> Bool reallySimple = and . map (\x -> isAlphaNum x || x=='_') ppTuple :: Bool -> [PP_Doc] -> PP_Doc ppTuple True pps = "(" >|< pp_block " " (replicate (length pps `max` 1) ')') ",(" pps ppTuple False pps = "(" >|< pp_block " " ")" "," pps ppUnboxedTuple :: Bool -> [PP_Doc] -> PP_Doc ppUnboxedTuple True pps = "(# " >|< pp_block " " (concat $ replicate (length pps `max` 1) " #)") ",(# " pps ppUnboxedTuple False pps = "(# " >|< pp_block " " " #)" "," pps {-# LINE 88 "dist/build/PrintCode.hs" #-} {-# LINE 404 "src-ag/PrintCode.ag" #-} locname' :: Identifier -> [Char] locname' n = "_loc_" ++ getName n {-# LINE 94 "dist/build/PrintCode.hs" #-} {-# LINE 479 "src-ag/PrintCode.ag" #-} renderDocs :: [PP_Doc] -> String renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) "" {-# LINE 100 "dist/build/PrintCode.hs" #-} {-# LINE 527 "src-ag/PrintCode.ag" #-} writeModule :: FilePath -> [PP_Doc] -> IO () writeModule path docs = do bExists <- doesFileExist path if bExists then do input <- readFile path seq (length input) (return ()) if input /= output then dumpIt else return () else dumpIt where output = renderDocs docs dumpIt = writeFile path output {-# LINE 117 "dist/build/PrintCode.hs" #-} -- CaseAlt ----------------------------------------------------- -- wrapper data Inh_CaseAlt = Inh_CaseAlt { nested_Inh_CaseAlt :: !(Bool), options_Inh_CaseAlt :: !(Options), outputfile_Inh_CaseAlt :: !(String) } data Syn_CaseAlt = Syn_CaseAlt { pps_Syn_CaseAlt :: !(PP_Docs) } {-# INLINABLE wrap_CaseAlt #-} wrap_CaseAlt :: T_CaseAlt -> Inh_CaseAlt -> (Syn_CaseAlt ) wrap_CaseAlt !(T_CaseAlt act) !(Inh_CaseAlt _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg1 = T_CaseAlt_vIn1 _lhsInested _lhsIoptions _lhsIoutputfile !(T_CaseAlt_vOut1 _lhsOpps) <- return (inv_CaseAlt_s2 sem arg1) return (Syn_CaseAlt _lhsOpps) ) -- cata {-# NOINLINE sem_CaseAlt #-} sem_CaseAlt :: CaseAlt -> T_CaseAlt sem_CaseAlt ( CaseAlt left_ expr_ ) = sem_CaseAlt_CaseAlt ( sem_Lhs left_ ) ( sem_Expr expr_ ) -- semantic domain newtype T_CaseAlt = T_CaseAlt { attach_T_CaseAlt :: Identity (T_CaseAlt_s2 ) } newtype T_CaseAlt_s2 = C_CaseAlt_s2 { inv_CaseAlt_s2 :: (T_CaseAlt_v1 ) } data T_CaseAlt_s3 = C_CaseAlt_s3 type T_CaseAlt_v1 = (T_CaseAlt_vIn1 ) -> (T_CaseAlt_vOut1 ) data T_CaseAlt_vIn1 = T_CaseAlt_vIn1 (Bool) (Options) (String) data T_CaseAlt_vOut1 = T_CaseAlt_vOut1 (PP_Docs) {-# NOINLINE sem_CaseAlt_CaseAlt #-} sem_CaseAlt_CaseAlt :: T_Lhs -> T_Expr -> T_CaseAlt sem_CaseAlt_CaseAlt arg_left_ arg_expr_ = T_CaseAlt (return st2) where {-# NOINLINE st2 #-} !st2 = let v1 :: T_CaseAlt_v1 v1 = \ !(T_CaseAlt_vIn1 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) _lhsOpps :: PP_Docs _lhsOpps = rule0 _exprIpp _leftIpp _leftOisDeclOfLet = rule1 () _leftOnested = rule2 _lhsInested _leftOoptions = rule3 _lhsIoptions _leftOoutputfile = rule4 _lhsIoutputfile _exprOnested = rule5 _lhsInested _exprOoptions = rule6 _lhsIoptions _exprOoutputfile = rule7 _lhsIoutputfile !__result_ = T_CaseAlt_vOut1 _lhsOpps in __result_ ) in C_CaseAlt_s2 v1 {-# INLINE rule0 #-} {-# LINE 218 "src-ag/PrintCode.ag" #-} rule0 = \ ((_exprIpp) :: PP_Doc) ((_leftIpp) :: PP_Doc) -> {-# LINE 218 "src-ag/PrintCode.ag" #-} ["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"] {-# LINE 176 "dist/build/PrintCode.hs"#-} {-# INLINE rule1 #-} {-# LINE 428 "src-ag/PrintCode.ag" #-} rule1 = \ (_ :: ()) -> {-# LINE 428 "src-ag/PrintCode.ag" #-} False {-# LINE 182 "dist/build/PrintCode.hs"#-} {-# INLINE rule2 #-} rule2 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule3 #-} rule3 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule4 #-} rule4 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule5 #-} rule5 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule6 #-} rule6 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule7 #-} rule7 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile -- CaseAlts ---------------------------------------------------- -- wrapper data Inh_CaseAlts = Inh_CaseAlts { nested_Inh_CaseAlts :: !(Bool), options_Inh_CaseAlts :: !(Options), outputfile_Inh_CaseAlts :: !(String) } data Syn_CaseAlts = Syn_CaseAlts { pps_Syn_CaseAlts :: !(PP_Docs) } {-# INLINABLE wrap_CaseAlts #-} wrap_CaseAlts :: T_CaseAlts -> Inh_CaseAlts -> (Syn_CaseAlts ) wrap_CaseAlts !(T_CaseAlts act) !(Inh_CaseAlts _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg4 = T_CaseAlts_vIn4 _lhsInested _lhsIoptions _lhsIoutputfile !(T_CaseAlts_vOut4 _lhsOpps) <- return (inv_CaseAlts_s5 sem arg4) return (Syn_CaseAlts _lhsOpps) ) -- cata {-# NOINLINE sem_CaseAlts #-} sem_CaseAlts :: CaseAlts -> T_CaseAlts sem_CaseAlts list = Prelude.foldr sem_CaseAlts_Cons sem_CaseAlts_Nil (Prelude.map sem_CaseAlt list) -- semantic domain newtype T_CaseAlts = T_CaseAlts { attach_T_CaseAlts :: Identity (T_CaseAlts_s5 ) } newtype T_CaseAlts_s5 = C_CaseAlts_s5 { inv_CaseAlts_s5 :: (T_CaseAlts_v4 ) } data T_CaseAlts_s6 = C_CaseAlts_s6 type T_CaseAlts_v4 = (T_CaseAlts_vIn4 ) -> (T_CaseAlts_vOut4 ) data T_CaseAlts_vIn4 = T_CaseAlts_vIn4 (Bool) (Options) (String) data T_CaseAlts_vOut4 = T_CaseAlts_vOut4 (PP_Docs) {-# NOINLINE sem_CaseAlts_Cons #-} sem_CaseAlts_Cons :: T_CaseAlt -> T_CaseAlts -> T_CaseAlts sem_CaseAlts_Cons arg_hd_ arg_tl_ = T_CaseAlts (return st5) where {-# NOINLINE st5 #-} !st5 = let v4 :: T_CaseAlts_v4 v4 = \ !(T_CaseAlts_vIn4 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _hdX2 = Control.Monad.Identity.runIdentity (attach_T_CaseAlt (arg_hd_)) _tlX5 = Control.Monad.Identity.runIdentity (attach_T_CaseAlts (arg_tl_)) (T_CaseAlt_vOut1 _hdIpps) = inv_CaseAlt_s2 _hdX2 (T_CaseAlt_vIn1 _hdOnested _hdOoptions _hdOoutputfile) (T_CaseAlts_vOut4 _tlIpps) = inv_CaseAlts_s5 _tlX5 (T_CaseAlts_vIn4 _tlOnested _tlOoptions _tlOoutputfile) _lhsOpps :: PP_Docs _lhsOpps = rule8 _hdIpps _tlIpps _hdOnested = rule9 _lhsInested _hdOoptions = rule10 _lhsIoptions _hdOoutputfile = rule11 _lhsIoutputfile _tlOnested = rule12 _lhsInested _tlOoptions = rule13 _lhsIoptions _tlOoutputfile = rule14 _lhsIoutputfile !__result_ = T_CaseAlts_vOut4 _lhsOpps in __result_ ) in C_CaseAlts_s5 v4 {-# INLINE rule8 #-} {-# LINE 68 "src-ag/PrintCode.ag" #-} rule8 = \ ((_hdIpps) :: PP_Docs) ((_tlIpps) :: PP_Docs) -> {-# LINE 68 "src-ag/PrintCode.ag" #-} _hdIpps ++ _tlIpps {-# LINE 259 "dist/build/PrintCode.hs"#-} {-# INLINE rule9 #-} rule9 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule10 #-} rule10 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule11 #-} rule11 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule12 #-} rule12 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule13 #-} rule13 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule14 #-} rule14 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_CaseAlts_Nil #-} sem_CaseAlts_Nil :: T_CaseAlts sem_CaseAlts_Nil = T_CaseAlts (return st5) where {-# NOINLINE st5 #-} !st5 = let v4 :: T_CaseAlts_v4 v4 = \ !(T_CaseAlts_vIn4 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule15 () !__result_ = T_CaseAlts_vOut4 _lhsOpps in __result_ ) in C_CaseAlts_s5 v4 {-# INLINE rule15 #-} {-# LINE 69 "src-ag/PrintCode.ag" #-} rule15 = \ (_ :: ()) -> {-# LINE 69 "src-ag/PrintCode.ag" #-} [] {-# LINE 295 "dist/build/PrintCode.hs"#-} -- Chunk ------------------------------------------------------- -- wrapper data Inh_Chunk = Inh_Chunk { importBlocks_Inh_Chunk :: !(PP_Doc), isDeclOfLet_Inh_Chunk :: !(Bool), mainFile_Inh_Chunk :: !(String), mainName_Inh_Chunk :: !(String), moduleHeader_Inh_Chunk :: !(String -> String -> String -> Bool -> String), nested_Inh_Chunk :: !(Bool), options_Inh_Chunk :: !(Options), optionsLine_Inh_Chunk :: !(String), pragmaBlocks_Inh_Chunk :: !(String), textBlockMap_Inh_Chunk :: !(Map BlockInfo PP_Doc), textBlocks_Inh_Chunk :: !(PP_Doc) } data Syn_Chunk = Syn_Chunk { appendCommon_Syn_Chunk :: !([[PP_Doc]]), appendMain_Syn_Chunk :: !([[PP_Doc]]), genSems_Syn_Chunk :: !(IO ()), imports_Syn_Chunk :: !([String]), pps_Syn_Chunk :: !(PP_Docs) } {-# INLINABLE wrap_Chunk #-} wrap_Chunk :: T_Chunk -> Inh_Chunk -> (Syn_Chunk ) wrap_Chunk !(T_Chunk act) !(Inh_Chunk _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg7 = T_Chunk_vIn7 _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks !(T_Chunk_vOut7 _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps) <- return (inv_Chunk_s8 sem arg7) return (Syn_Chunk _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps) ) -- cata {-# INLINE sem_Chunk #-} sem_Chunk :: Chunk -> T_Chunk sem_Chunk ( Chunk !name_ comment_ info_ dataDef_ cataFun_ semDom_ semWrapper_ semFunctions_ !semNames_ ) = sem_Chunk_Chunk name_ ( sem_Decl comment_ ) ( sem_Decls info_ ) ( sem_Decls dataDef_ ) ( sem_Decls cataFun_ ) ( sem_Decls semDom_ ) ( sem_Decls semWrapper_ ) ( sem_Decls semFunctions_ ) semNames_ -- semantic domain newtype T_Chunk = T_Chunk { attach_T_Chunk :: Identity (T_Chunk_s8 ) } newtype T_Chunk_s8 = C_Chunk_s8 { inv_Chunk_s8 :: (T_Chunk_v7 ) } data T_Chunk_s9 = C_Chunk_s9 type T_Chunk_v7 = (T_Chunk_vIn7 ) -> (T_Chunk_vOut7 ) data T_Chunk_vIn7 = T_Chunk_vIn7 (PP_Doc) (Bool) (String) (String) (String -> String -> String -> Bool -> String) (Bool) (Options) (String) (String) (Map BlockInfo PP_Doc) (PP_Doc) data T_Chunk_vOut7 = T_Chunk_vOut7 ([[PP_Doc]]) ([[PP_Doc]]) (IO ()) ([String]) (PP_Docs) {-# NOINLINE sem_Chunk_Chunk #-} sem_Chunk_Chunk :: (String) -> T_Decl -> T_Decls -> T_Decls -> T_Decls -> T_Decls -> T_Decls -> T_Decls -> ([String]) -> T_Chunk sem_Chunk_Chunk !arg_name_ arg_comment_ arg_info_ arg_dataDef_ arg_cataFun_ arg_semDom_ arg_semWrapper_ arg_semFunctions_ !arg_semNames_ = T_Chunk (return st8) where {-# NOINLINE st8 #-} !st8 = let v7 :: T_Chunk_v7 v7 = \ !(T_Chunk_vIn7 _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) -> ( let _commentX20 = Control.Monad.Identity.runIdentity (attach_T_Decl (arg_comment_)) _infoX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_info_)) _dataDefX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_dataDef_)) _cataFunX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_cataFun_)) _semDomX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_semDom_)) _semWrapperX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_semWrapper_)) _semFunctionsX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_semFunctions_)) (T_Decl_vOut19 _commentIpp) = inv_Decl_s20 _commentX20 (T_Decl_vIn19 _commentOisDeclOfLet _commentOnested _commentOoptions _commentOoutputfile) (T_Decls_vOut22 _infoIpps) = inv_Decls_s23 _infoX23 (T_Decls_vIn22 _infoOisDeclOfLet _infoOnested _infoOoptions _infoOoutputfile) (T_Decls_vOut22 _dataDefIpps) = inv_Decls_s23 _dataDefX23 (T_Decls_vIn22 _dataDefOisDeclOfLet _dataDefOnested _dataDefOoptions _dataDefOoutputfile) (T_Decls_vOut22 _cataFunIpps) = inv_Decls_s23 _cataFunX23 (T_Decls_vIn22 _cataFunOisDeclOfLet _cataFunOnested _cataFunOoptions _cataFunOoutputfile) (T_Decls_vOut22 _semDomIpps) = inv_Decls_s23 _semDomX23 (T_Decls_vIn22 _semDomOisDeclOfLet _semDomOnested _semDomOoptions _semDomOoutputfile) (T_Decls_vOut22 _semWrapperIpps) = inv_Decls_s23 _semWrapperX23 (T_Decls_vIn22 _semWrapperOisDeclOfLet _semWrapperOnested _semWrapperOoptions _semWrapperOoutputfile) (T_Decls_vOut22 _semFunctionsIpps) = inv_Decls_s23 _semFunctionsX23 (T_Decls_vIn22 _semFunctionsOisDeclOfLet _semFunctionsOnested _semFunctionsOoptions _semFunctionsOoutputfile) _outputfile = rule16 _lhsImainFile _lhsIoptions arg_name_ _lhsOpps :: PP_Docs _lhsOpps = rule17 _cataFunIpps _commentIpp _dataDefIpps _infoIpps _lhsItextBlockMap _semDomIpps _semFunctionsIpps _semWrapperIpps arg_name_ _lhsOimports :: [String] _lhsOimports = rule18 _lhsImainName arg_name_ _lhsOappendCommon :: [[PP_Doc]] _lhsOappendCommon = rule19 _commentIpp _dataDefIpps _lhsIoptions _semDomIpps _semWrapperIpps _lhsOappendMain :: [[PP_Doc]] _lhsOappendMain = rule20 _cataFunIpps _commentIpp _lhsIoptions _semWrapperIpps _lhsOgenSems :: IO () _lhsOgenSems = rule21 _commentIpp _exports _infoIpps _lhsImainName _lhsImoduleHeader _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _outputfile _semFunctionsIpps arg_name_ _exports = rule22 arg_semNames_ _commentOisDeclOfLet = rule23 _lhsIisDeclOfLet _commentOnested = rule24 _lhsInested _commentOoptions = rule25 _lhsIoptions _commentOoutputfile = rule26 _outputfile _infoOisDeclOfLet = rule27 _lhsIisDeclOfLet _infoOnested = rule28 _lhsInested _infoOoptions = rule29 _lhsIoptions _infoOoutputfile = rule30 _outputfile _dataDefOisDeclOfLet = rule31 _lhsIisDeclOfLet _dataDefOnested = rule32 _lhsInested _dataDefOoptions = rule33 _lhsIoptions _dataDefOoutputfile = rule34 _outputfile _cataFunOisDeclOfLet = rule35 _lhsIisDeclOfLet _cataFunOnested = rule36 _lhsInested _cataFunOoptions = rule37 _lhsIoptions _cataFunOoutputfile = rule38 _outputfile _semDomOisDeclOfLet = rule39 _lhsIisDeclOfLet _semDomOnested = rule40 _lhsInested _semDomOoptions = rule41 _lhsIoptions _semDomOoutputfile = rule42 _outputfile _semWrapperOisDeclOfLet = rule43 _lhsIisDeclOfLet _semWrapperOnested = rule44 _lhsInested _semWrapperOoptions = rule45 _lhsIoptions _semWrapperOoutputfile = rule46 _outputfile _semFunctionsOisDeclOfLet = rule47 _lhsIisDeclOfLet _semFunctionsOnested = rule48 _lhsInested _semFunctionsOoptions = rule49 _lhsIoptions _semFunctionsOoutputfile = rule50 _outputfile !__result_ = T_Chunk_vOut7 _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps in __result_ ) in C_Chunk_s8 v7 {-# INLINE rule16 #-} {-# LINE 43 "src-ag/PrintCode.ag" #-} rule16 = \ ((_lhsImainFile) :: String) ((_lhsIoptions) :: Options) name_ -> {-# LINE 43 "src-ag/PrintCode.ag" #-} if sepSemMods _lhsIoptions then replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ "_" ++ name_) else _lhsImainFile {-# LINE 398 "dist/build/PrintCode.hs"#-} {-# INLINE rule17 #-} {-# LINE 96 "src-ag/PrintCode.ag" #-} rule17 = \ ((_cataFunIpps) :: PP_Docs) ((_commentIpp) :: PP_Doc) ((_dataDefIpps) :: PP_Docs) ((_infoIpps) :: PP_Docs) ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) ((_semDomIpps) :: PP_Docs) ((_semFunctionsIpps) :: PP_Docs) ((_semWrapperIpps) :: PP_Docs) name_ -> {-# LINE 96 "src-ag/PrintCode.ag" #-} _commentIpp : _infoIpps ++ _dataDefIpps ++ _cataFunIpps ++ _semDomIpps ++ _semWrapperIpps ++ _semFunctionsIpps ++ [Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap] {-# LINE 411 "dist/build/PrintCode.hs"#-} {-# INLINE rule18 #-} {-# LINE 487 "src-ag/PrintCode.ag" #-} rule18 = \ ((_lhsImainName) :: String) name_ -> {-# LINE 487 "src-ag/PrintCode.ag" #-} ["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"] {-# LINE 417 "dist/build/PrintCode.hs"#-} {-# INLINE rule19 #-} {-# LINE 494 "src-ag/PrintCode.ag" #-} rule19 = \ ((_commentIpp) :: PP_Doc) ((_dataDefIpps) :: PP_Docs) ((_lhsIoptions) :: Options) ((_semDomIpps) :: PP_Docs) ((_semWrapperIpps) :: PP_Docs) -> {-# LINE 494 "src-ag/PrintCode.ag" #-} [ [_commentIpp] , _dataDefIpps , _semDomIpps , if reference _lhsIoptions then _semWrapperIpps else [] ] {-# LINE 427 "dist/build/PrintCode.hs"#-} {-# INLINE rule20 #-} {-# LINE 500 "src-ag/PrintCode.ag" #-} rule20 = \ ((_cataFunIpps) :: PP_Docs) ((_commentIpp) :: PP_Doc) ((_lhsIoptions) :: Options) ((_semWrapperIpps) :: PP_Docs) -> {-# LINE 500 "src-ag/PrintCode.ag" #-} [ [_commentIpp] , _cataFunIpps , if reference _lhsIoptions then [] else _semWrapperIpps ] {-# LINE 436 "dist/build/PrintCode.hs"#-} {-# INLINE rule21 #-} {-# LINE 510 "src-ag/PrintCode.ag" #-} rule21 = \ ((_commentIpp) :: PP_Doc) _exports ((_infoIpps) :: PP_Docs) ((_lhsImainName) :: String) ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIoptionsLine) :: String) ((_lhsIpragmaBlocks) :: String) ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) _outputfile ((_semFunctionsIpps) :: PP_Docs) name_ -> {-# LINE 510 "src-ag/PrintCode.ag" #-} writeModule _outputfile [ pp $ _lhsIpragmaBlocks , pp $ Map.findWithDefault empty (BlockPragma, Just $ identifier name_) _lhsItextBlockMap , pp $ _lhsIoptionsLine , pp $ _lhsImoduleHeader _lhsImainName ("_" ++ name_) _exports True , pp $ ("import " ++ _lhsImainName ++ "_common\n") , pp $ Map.findWithDefault empty (BlockImport, Just $ identifier name_) _lhsItextBlockMap , _commentIpp , vlist_sep "" _infoIpps , vlist_sep "" _semFunctionsIpps , Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap ] {-# LINE 453 "dist/build/PrintCode.hs"#-} {-# INLINE rule22 #-} {-# LINE 525 "src-ag/PrintCode.ag" #-} rule22 = \ semNames_ -> {-# LINE 525 "src-ag/PrintCode.ag" #-} concat $ intersperse "," semNames_ {-# LINE 459 "dist/build/PrintCode.hs"#-} {-# INLINE rule23 #-} rule23 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule24 #-} rule24 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule25 #-} rule25 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule26 #-} rule26 = \ _outputfile -> _outputfile {-# INLINE rule27 #-} rule27 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule28 #-} rule28 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule29 #-} rule29 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule30 #-} rule30 = \ _outputfile -> _outputfile {-# INLINE rule31 #-} rule31 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule32 #-} rule32 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule33 #-} rule33 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule34 #-} rule34 = \ _outputfile -> _outputfile {-# INLINE rule35 #-} rule35 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule36 #-} rule36 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule37 #-} rule37 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule38 #-} rule38 = \ _outputfile -> _outputfile {-# INLINE rule39 #-} rule39 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule40 #-} rule40 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule41 #-} rule41 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule42 #-} rule42 = \ _outputfile -> _outputfile {-# INLINE rule43 #-} rule43 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule44 #-} rule44 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule45 #-} rule45 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule46 #-} rule46 = \ _outputfile -> _outputfile {-# INLINE rule47 #-} rule47 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule48 #-} rule48 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule49 #-} rule49 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule50 #-} rule50 = \ _outputfile -> _outputfile -- Chunks ------------------------------------------------------ -- wrapper data Inh_Chunks = Inh_Chunks { importBlocks_Inh_Chunks :: !(PP_Doc), isDeclOfLet_Inh_Chunks :: !(Bool), mainFile_Inh_Chunks :: !(String), mainName_Inh_Chunks :: !(String), moduleHeader_Inh_Chunks :: !(String -> String -> String -> Bool -> String), nested_Inh_Chunks :: !(Bool), options_Inh_Chunks :: !(Options), optionsLine_Inh_Chunks :: !(String), pragmaBlocks_Inh_Chunks :: !(String), textBlockMap_Inh_Chunks :: !(Map BlockInfo PP_Doc), textBlocks_Inh_Chunks :: !(PP_Doc) } data Syn_Chunks = Syn_Chunks { appendCommon_Syn_Chunks :: !([[PP_Doc]]), appendMain_Syn_Chunks :: !([[PP_Doc]]), genSems_Syn_Chunks :: !(IO ()), imports_Syn_Chunks :: !([String]), pps_Syn_Chunks :: !(PP_Docs) } {-# INLINABLE wrap_Chunks #-} wrap_Chunks :: T_Chunks -> Inh_Chunks -> (Syn_Chunks ) wrap_Chunks !(T_Chunks act) !(Inh_Chunks _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg10 = T_Chunks_vIn10 _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks !(T_Chunks_vOut10 _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps) <- return (inv_Chunks_s11 sem arg10) return (Syn_Chunks _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps) ) -- cata {-# NOINLINE sem_Chunks #-} sem_Chunks :: Chunks -> T_Chunks sem_Chunks list = Prelude.foldr sem_Chunks_Cons sem_Chunks_Nil (Prelude.map sem_Chunk list) -- semantic domain newtype T_Chunks = T_Chunks { attach_T_Chunks :: Identity (T_Chunks_s11 ) } newtype T_Chunks_s11 = C_Chunks_s11 { inv_Chunks_s11 :: (T_Chunks_v10 ) } data T_Chunks_s12 = C_Chunks_s12 type T_Chunks_v10 = (T_Chunks_vIn10 ) -> (T_Chunks_vOut10 ) data T_Chunks_vIn10 = T_Chunks_vIn10 (PP_Doc) (Bool) (String) (String) (String -> String -> String -> Bool -> String) (Bool) (Options) (String) (String) (Map BlockInfo PP_Doc) (PP_Doc) data T_Chunks_vOut10 = T_Chunks_vOut10 ([[PP_Doc]]) ([[PP_Doc]]) (IO ()) ([String]) (PP_Docs) {-# NOINLINE sem_Chunks_Cons #-} sem_Chunks_Cons :: T_Chunk -> T_Chunks -> T_Chunks sem_Chunks_Cons arg_hd_ arg_tl_ = T_Chunks (return st11) where {-# NOINLINE st11 #-} !st11 = let v10 :: T_Chunks_v10 v10 = \ !(T_Chunks_vIn10 _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) -> ( let _hdX8 = Control.Monad.Identity.runIdentity (attach_T_Chunk (arg_hd_)) _tlX11 = Control.Monad.Identity.runIdentity (attach_T_Chunks (arg_tl_)) (T_Chunk_vOut7 _hdIappendCommon _hdIappendMain _hdIgenSems _hdIimports _hdIpps) = inv_Chunk_s8 _hdX8 (T_Chunk_vIn7 _hdOimportBlocks _hdOisDeclOfLet _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnested _hdOoptions _hdOoptionsLine _hdOpragmaBlocks _hdOtextBlockMap _hdOtextBlocks) (T_Chunks_vOut10 _tlIappendCommon _tlIappendMain _tlIgenSems _tlIimports _tlIpps) = inv_Chunks_s11 _tlX11 (T_Chunks_vIn10 _tlOimportBlocks _tlOisDeclOfLet _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnested _tlOoptions _tlOoptionsLine _tlOpragmaBlocks _tlOtextBlockMap _tlOtextBlocks) _lhsOpps :: PP_Docs _lhsOpps = rule51 _hdIpps _tlIpps _lhsOappendCommon :: [[PP_Doc]] _lhsOappendCommon = rule52 _hdIappendCommon _tlIappendCommon _lhsOappendMain :: [[PP_Doc]] _lhsOappendMain = rule53 _hdIappendMain _tlIappendMain _lhsOgenSems :: IO () _lhsOgenSems = rule54 _hdIgenSems _tlIgenSems _lhsOimports :: [String] _lhsOimports = rule55 _hdIimports _tlIimports _hdOimportBlocks = rule56 _lhsIimportBlocks _hdOisDeclOfLet = rule57 _lhsIisDeclOfLet _hdOmainFile = rule58 _lhsImainFile _hdOmainName = rule59 _lhsImainName _hdOmoduleHeader = rule60 _lhsImoduleHeader _hdOnested = rule61 _lhsInested _hdOoptions = rule62 _lhsIoptions _hdOoptionsLine = rule63 _lhsIoptionsLine _hdOpragmaBlocks = rule64 _lhsIpragmaBlocks _hdOtextBlockMap = rule65 _lhsItextBlockMap _hdOtextBlocks = rule66 _lhsItextBlocks _tlOimportBlocks = rule67 _lhsIimportBlocks _tlOisDeclOfLet = rule68 _lhsIisDeclOfLet _tlOmainFile = rule69 _lhsImainFile _tlOmainName = rule70 _lhsImainName _tlOmoduleHeader = rule71 _lhsImoduleHeader _tlOnested = rule72 _lhsInested _tlOoptions = rule73 _lhsIoptions _tlOoptionsLine = rule74 _lhsIoptionsLine _tlOpragmaBlocks = rule75 _lhsIpragmaBlocks _tlOtextBlockMap = rule76 _lhsItextBlockMap _tlOtextBlocks = rule77 _lhsItextBlocks !__result_ = T_Chunks_vOut10 _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps in __result_ ) in C_Chunks_s11 v10 {-# INLINE rule51 #-} {-# LINE 88 "src-ag/PrintCode.ag" #-} rule51 = \ ((_hdIpps) :: PP_Docs) ((_tlIpps) :: PP_Docs) -> {-# LINE 88 "src-ag/PrintCode.ag" #-} _hdIpps ++ _tlIpps {-# LINE 626 "dist/build/PrintCode.hs"#-} {-# INLINE rule52 #-} rule52 = \ ((_hdIappendCommon) :: [[PP_Doc]]) ((_tlIappendCommon) :: [[PP_Doc]]) -> _hdIappendCommon ++ _tlIappendCommon {-# INLINE rule53 #-} rule53 = \ ((_hdIappendMain) :: [[PP_Doc]]) ((_tlIappendMain) :: [[PP_Doc]]) -> _hdIappendMain ++ _tlIappendMain {-# INLINE rule54 #-} rule54 = \ ((_hdIgenSems) :: IO ()) ((_tlIgenSems) :: IO ()) -> _hdIgenSems >> _tlIgenSems {-# INLINE rule55 #-} rule55 = \ ((_hdIimports) :: [String]) ((_tlIimports) :: [String]) -> _hdIimports ++ _tlIimports {-# INLINE rule56 #-} rule56 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule57 #-} rule57 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule58 #-} rule58 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule59 #-} rule59 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule60 #-} rule60 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule61 #-} rule61 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule62 #-} rule62 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule63 #-} rule63 = \ ((_lhsIoptionsLine) :: String) -> _lhsIoptionsLine {-# INLINE rule64 #-} rule64 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule65 #-} rule65 = \ ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) -> _lhsItextBlockMap {-# INLINE rule66 #-} rule66 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule67 #-} rule67 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule68 #-} rule68 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule69 #-} rule69 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule70 #-} rule70 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule71 #-} rule71 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule72 #-} rule72 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule73 #-} rule73 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule74 #-} rule74 = \ ((_lhsIoptionsLine) :: String) -> _lhsIoptionsLine {-# INLINE rule75 #-} rule75 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule76 #-} rule76 = \ ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) -> _lhsItextBlockMap {-# INLINE rule77 #-} rule77 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# NOINLINE sem_Chunks_Nil #-} sem_Chunks_Nil :: T_Chunks sem_Chunks_Nil = T_Chunks (return st11) where {-# NOINLINE st11 #-} !st11 = let v10 :: T_Chunks_v10 v10 = \ !(T_Chunks_vIn10 _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule78 () _lhsOappendCommon :: [[PP_Doc]] _lhsOappendCommon = rule79 () _lhsOappendMain :: [[PP_Doc]] _lhsOappendMain = rule80 () _lhsOgenSems :: IO () _lhsOgenSems = rule81 () _lhsOimports :: [String] _lhsOimports = rule82 () !__result_ = T_Chunks_vOut10 _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps in __result_ ) in C_Chunks_s11 v10 {-# INLINE rule78 #-} {-# LINE 89 "src-ag/PrintCode.ag" #-} rule78 = \ (_ :: ()) -> {-# LINE 89 "src-ag/PrintCode.ag" #-} [] {-# LINE 730 "dist/build/PrintCode.hs"#-} {-# INLINE rule79 #-} rule79 = \ (_ :: ()) -> [] {-# INLINE rule80 #-} rule80 = \ (_ :: ()) -> [] {-# INLINE rule81 #-} rule81 = \ (_ :: ()) -> return () {-# INLINE rule82 #-} rule82 = \ (_ :: ()) -> [] -- DataAlt ----------------------------------------------------- -- wrapper data Inh_DataAlt = Inh_DataAlt { nested_Inh_DataAlt :: !(Bool), strictPre_Inh_DataAlt :: !(PP_Doc) } data Syn_DataAlt = Syn_DataAlt { pp_Syn_DataAlt :: !(PP_Doc) } {-# INLINABLE wrap_DataAlt #-} wrap_DataAlt :: T_DataAlt -> Inh_DataAlt -> (Syn_DataAlt ) wrap_DataAlt !(T_DataAlt act) !(Inh_DataAlt _lhsInested _lhsIstrictPre) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg13 = T_DataAlt_vIn13 _lhsInested _lhsIstrictPre !(T_DataAlt_vOut13 _lhsOpp) <- return (inv_DataAlt_s14 sem arg13) return (Syn_DataAlt _lhsOpp) ) -- cata {-# NOINLINE sem_DataAlt #-} sem_DataAlt :: DataAlt -> T_DataAlt sem_DataAlt ( DataAlt !name_ args_ ) = sem_DataAlt_DataAlt name_ ( sem_Types args_ ) sem_DataAlt ( Record !name_ args_ ) = sem_DataAlt_Record name_ ( sem_NamedTypes args_ ) -- semantic domain newtype T_DataAlt = T_DataAlt { attach_T_DataAlt :: Identity (T_DataAlt_s14 ) } newtype T_DataAlt_s14 = C_DataAlt_s14 { inv_DataAlt_s14 :: (T_DataAlt_v13 ) } data T_DataAlt_s15 = C_DataAlt_s15 type T_DataAlt_v13 = (T_DataAlt_vIn13 ) -> (T_DataAlt_vOut13 ) data T_DataAlt_vIn13 = T_DataAlt_vIn13 (Bool) (PP_Doc) data T_DataAlt_vOut13 = T_DataAlt_vOut13 (PP_Doc) {-# NOINLINE sem_DataAlt_DataAlt #-} sem_DataAlt_DataAlt :: (String) -> T_Types -> T_DataAlt sem_DataAlt_DataAlt !arg_name_ arg_args_ = T_DataAlt (return st14) where {-# NOINLINE st14 #-} !st14 = let v13 :: T_DataAlt_v13 v13 = \ !(T_DataAlt_vIn13 _lhsInested _lhsIstrictPre) -> ( let _argsX53 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_args_)) (T_Types_vOut52 _argsIpps) = inv_Types_s53 _argsX53 (T_Types_vIn52 _argsOnested) _lhsOpp :: PP_Doc _lhsOpp = rule83 _argsIpps _lhsIstrictPre arg_name_ _argsOnested = rule84 _lhsInested !__result_ = T_DataAlt_vOut13 _lhsOpp in __result_ ) in C_DataAlt_s14 v13 {-# INLINE rule83 #-} {-# LINE 221 "src-ag/PrintCode.ag" #-} rule83 = \ ((_argsIpps) :: PP_Docs) ((_lhsIstrictPre) :: PP_Doc) name_ -> {-# LINE 221 "src-ag/PrintCode.ag" #-} name_ >#< hv_sp (map ((_lhsIstrictPre >|<) . pp_parens) _argsIpps) {-# LINE 795 "dist/build/PrintCode.hs"#-} {-# INLINE rule84 #-} rule84 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_DataAlt_Record #-} sem_DataAlt_Record :: (String) -> T_NamedTypes -> T_DataAlt sem_DataAlt_Record !arg_name_ arg_args_ = T_DataAlt (return st14) where {-# NOINLINE st14 #-} !st14 = let v13 :: T_DataAlt_v13 v13 = \ !(T_DataAlt_vIn13 _lhsInested _lhsIstrictPre) -> ( let _argsX38 = Control.Monad.Identity.runIdentity (attach_T_NamedTypes (arg_args_)) (T_NamedTypes_vOut37 _argsIpps) = inv_NamedTypes_s38 _argsX38 (T_NamedTypes_vIn37 _argsOnested) _lhsOpp :: PP_Doc _lhsOpp = rule85 _argsIpps arg_name_ _argsOnested = rule86 _lhsInested !__result_ = T_DataAlt_vOut13 _lhsOpp in __result_ ) in C_DataAlt_s14 v13 {-# INLINE rule85 #-} {-# LINE 222 "src-ag/PrintCode.ag" #-} rule85 = \ ((_argsIpps) :: PP_Docs) name_ -> {-# LINE 222 "src-ag/PrintCode.ag" #-} name_ >#< pp_block "{" "}" "," _argsIpps {-# LINE 819 "dist/build/PrintCode.hs"#-} {-# INLINE rule86 #-} rule86 = \ ((_lhsInested) :: Bool) -> _lhsInested -- DataAlts ---------------------------------------------------- -- wrapper data Inh_DataAlts = Inh_DataAlts { nested_Inh_DataAlts :: !(Bool), strictPre_Inh_DataAlts :: !(PP_Doc) } data Syn_DataAlts = Syn_DataAlts { pps_Syn_DataAlts :: !(PP_Docs) } {-# INLINABLE wrap_DataAlts #-} wrap_DataAlts :: T_DataAlts -> Inh_DataAlts -> (Syn_DataAlts ) wrap_DataAlts !(T_DataAlts act) !(Inh_DataAlts _lhsInested _lhsIstrictPre) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg16 = T_DataAlts_vIn16 _lhsInested _lhsIstrictPre !(T_DataAlts_vOut16 _lhsOpps) <- return (inv_DataAlts_s17 sem arg16) return (Syn_DataAlts _lhsOpps) ) -- cata {-# NOINLINE sem_DataAlts #-} sem_DataAlts :: DataAlts -> T_DataAlts sem_DataAlts list = Prelude.foldr sem_DataAlts_Cons sem_DataAlts_Nil (Prelude.map sem_DataAlt list) -- semantic domain newtype T_DataAlts = T_DataAlts { attach_T_DataAlts :: Identity (T_DataAlts_s17 ) } newtype T_DataAlts_s17 = C_DataAlts_s17 { inv_DataAlts_s17 :: (T_DataAlts_v16 ) } data T_DataAlts_s18 = C_DataAlts_s18 type T_DataAlts_v16 = (T_DataAlts_vIn16 ) -> (T_DataAlts_vOut16 ) data T_DataAlts_vIn16 = T_DataAlts_vIn16 (Bool) (PP_Doc) data T_DataAlts_vOut16 = T_DataAlts_vOut16 (PP_Docs) {-# NOINLINE sem_DataAlts_Cons #-} sem_DataAlts_Cons :: T_DataAlt -> T_DataAlts -> T_DataAlts sem_DataAlts_Cons arg_hd_ arg_tl_ = T_DataAlts (return st17) where {-# NOINLINE st17 #-} !st17 = let v16 :: T_DataAlts_v16 v16 = \ !(T_DataAlts_vIn16 _lhsInested _lhsIstrictPre) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_DataAlt (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_DataAlts (arg_tl_)) (T_DataAlt_vOut13 _hdIpp) = inv_DataAlt_s14 _hdX14 (T_DataAlt_vIn13 _hdOnested _hdOstrictPre) (T_DataAlts_vOut16 _tlIpps) = inv_DataAlts_s17 _tlX17 (T_DataAlts_vIn16 _tlOnested _tlOstrictPre) _lhsOpps :: PP_Docs _lhsOpps = rule87 _hdIpp _tlIpps _hdOnested = rule88 _lhsInested _hdOstrictPre = rule89 _lhsIstrictPre _tlOnested = rule90 _lhsInested _tlOstrictPre = rule91 _lhsIstrictPre !__result_ = T_DataAlts_vOut16 _lhsOpps in __result_ ) in C_DataAlts_s17 v16 {-# INLINE rule87 #-} {-# LINE 72 "src-ag/PrintCode.ag" #-} rule87 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 72 "src-ag/PrintCode.ag" #-} _hdIpp : _tlIpps {-# LINE 879 "dist/build/PrintCode.hs"#-} {-# INLINE rule88 #-} rule88 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule89 #-} rule89 = \ ((_lhsIstrictPre) :: PP_Doc) -> _lhsIstrictPre {-# INLINE rule90 #-} rule90 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule91 #-} rule91 = \ ((_lhsIstrictPre) :: PP_Doc) -> _lhsIstrictPre {-# NOINLINE sem_DataAlts_Nil #-} sem_DataAlts_Nil :: T_DataAlts sem_DataAlts_Nil = T_DataAlts (return st17) where {-# NOINLINE st17 #-} !st17 = let v16 :: T_DataAlts_v16 v16 = \ !(T_DataAlts_vIn16 _lhsInested _lhsIstrictPre) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule92 () !__result_ = T_DataAlts_vOut16 _lhsOpps in __result_ ) in C_DataAlts_s17 v16 {-# INLINE rule92 #-} {-# LINE 73 "src-ag/PrintCode.ag" #-} rule92 = \ (_ :: ()) -> {-# LINE 73 "src-ag/PrintCode.ag" #-} [] {-# LINE 909 "dist/build/PrintCode.hs"#-} -- Decl -------------------------------------------------------- -- wrapper data Inh_Decl = Inh_Decl { isDeclOfLet_Inh_Decl :: !(Bool), nested_Inh_Decl :: !(Bool), options_Inh_Decl :: !(Options), outputfile_Inh_Decl :: !(String) } data Syn_Decl = Syn_Decl { pp_Syn_Decl :: !(PP_Doc) } {-# INLINABLE wrap_Decl #-} wrap_Decl :: T_Decl -> Inh_Decl -> (Syn_Decl ) wrap_Decl !(T_Decl act) !(Inh_Decl _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg19 = T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile !(T_Decl_vOut19 _lhsOpp) <- return (inv_Decl_s20 sem arg19) return (Syn_Decl _lhsOpp) ) -- cata {-# NOINLINE sem_Decl #-} sem_Decl :: Decl -> T_Decl sem_Decl ( Decl left_ rhs_ !binds_ !uses_ ) = sem_Decl_Decl ( sem_Lhs left_ ) ( sem_Expr rhs_ ) binds_ uses_ sem_Decl ( Bind left_ rhs_ ) = sem_Decl_Bind ( sem_Lhs left_ ) ( sem_Expr rhs_ ) sem_Decl ( BindLet left_ rhs_ ) = sem_Decl_BindLet ( sem_Lhs left_ ) ( sem_Expr rhs_ ) sem_Decl ( Data !name_ !params_ alts_ !strict_ !derivings_ ) = sem_Decl_Data name_ params_ ( sem_DataAlts alts_ ) strict_ derivings_ sem_Decl ( NewType !name_ !params_ !con_ tp_ ) = sem_Decl_NewType name_ params_ con_ ( sem_Type tp_ ) sem_Decl ( Type !name_ !params_ tp_ ) = sem_Decl_Type name_ params_ ( sem_Type tp_ ) sem_Decl ( TSig !name_ tp_ ) = sem_Decl_TSig name_ ( sem_Type tp_ ) sem_Decl ( Comment !txt_ ) = sem_Decl_Comment txt_ sem_Decl ( PragmaDecl !txt_ ) = sem_Decl_PragmaDecl txt_ sem_Decl ( Resume !monadic_ !nt_ left_ rhs_ ) = sem_Decl_Resume monadic_ nt_ ( sem_Lhs left_ ) ( sem_Expr rhs_ ) sem_Decl ( EvalDecl !nt_ left_ rhs_ ) = sem_Decl_EvalDecl nt_ ( sem_Lhs left_ ) ( sem_Expr rhs_ ) -- semantic domain newtype T_Decl = T_Decl { attach_T_Decl :: Identity (T_Decl_s20 ) } newtype T_Decl_s20 = C_Decl_s20 { inv_Decl_s20 :: (T_Decl_v19 ) } data T_Decl_s21 = C_Decl_s21 type T_Decl_v19 = (T_Decl_vIn19 ) -> (T_Decl_vOut19 ) data T_Decl_vIn19 = T_Decl_vIn19 (Bool) (Bool) (Options) (String) data T_Decl_vOut19 = T_Decl_vOut19 (PP_Doc) {-# NOINLINE sem_Decl_Decl #-} sem_Decl_Decl :: T_Lhs -> T_Expr -> (Set String) -> (Set String) -> T_Decl sem_Decl_Decl arg_left_ arg_rhs_ _ _ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOnested _rhsOoptions _rhsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule93 _leftIpp _rhsIpp _leftOisDeclOfLet = rule94 _lhsIisDeclOfLet _leftOnested = rule95 _lhsInested _leftOoptions = rule96 _lhsIoptions _leftOoutputfile = rule97 _lhsIoutputfile _rhsOnested = rule98 _lhsInested _rhsOoptions = rule99 _lhsIoptions _rhsOoutputfile = rule100 _lhsIoutputfile !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule93 #-} {-# LINE 106 "src-ag/PrintCode.ag" #-} rule93 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) -> {-# LINE 106 "src-ag/PrintCode.ag" #-} _leftIpp >#< "=" >-< indent 4 _rhsIpp {-# LINE 980 "dist/build/PrintCode.hs"#-} {-# INLINE rule94 #-} rule94 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule95 #-} rule95 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule96 #-} rule96 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule97 #-} rule97 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule98 #-} rule98 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule99 #-} rule99 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule100 #-} rule100 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Decl_Bind #-} sem_Decl_Bind :: T_Lhs -> T_Expr -> T_Decl sem_Decl_Bind arg_left_ arg_rhs_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOnested _rhsOoptions _rhsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule101 _leftIpp _rhsIpp _leftOisDeclOfLet = rule102 _lhsIisDeclOfLet _leftOnested = rule103 _lhsInested _leftOoptions = rule104 _lhsIoptions _leftOoutputfile = rule105 _lhsIoutputfile _rhsOnested = rule106 _lhsInested _rhsOoptions = rule107 _lhsIoptions _rhsOoutputfile = rule108 _lhsIoutputfile !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule101 #-} {-# LINE 108 "src-ag/PrintCode.ag" #-} rule101 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) -> {-# LINE 108 "src-ag/PrintCode.ag" #-} _leftIpp >#< "<-" >#< _rhsIpp {-# LINE 1030 "dist/build/PrintCode.hs"#-} {-# INLINE rule102 #-} rule102 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule103 #-} rule103 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule104 #-} rule104 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule105 #-} rule105 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule106 #-} rule106 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule107 #-} rule107 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule108 #-} rule108 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Decl_BindLet #-} sem_Decl_BindLet :: T_Lhs -> T_Expr -> T_Decl sem_Decl_BindLet arg_left_ arg_rhs_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOnested _rhsOoptions _rhsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule109 _leftIpp _rhsIpp _leftOisDeclOfLet = rule110 _lhsIisDeclOfLet _leftOnested = rule111 _lhsInested _leftOoptions = rule112 _lhsIoptions _leftOoutputfile = rule113 _lhsIoutputfile _rhsOnested = rule114 _lhsInested _rhsOoptions = rule115 _lhsIoptions _rhsOoutputfile = rule116 _lhsIoutputfile !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule109 #-} {-# LINE 109 "src-ag/PrintCode.ag" #-} rule109 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) -> {-# LINE 109 "src-ag/PrintCode.ag" #-} "let" >#< _leftIpp >#< "=" >#< _rhsIpp {-# LINE 1080 "dist/build/PrintCode.hs"#-} {-# INLINE rule110 #-} rule110 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule111 #-} rule111 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule112 #-} rule112 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule113 #-} rule113 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule114 #-} rule114 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule115 #-} rule115 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule116 #-} rule116 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Decl_Data #-} sem_Decl_Data :: (String) -> ([String]) -> T_DataAlts -> (Bool) -> ([String]) -> T_Decl sem_Decl_Data !arg_name_ !arg_params_ arg_alts_ !arg_strict_ !arg_derivings_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _altsX17 = Control.Monad.Identity.runIdentity (attach_T_DataAlts (arg_alts_)) (T_DataAlts_vOut16 _altsIpps) = inv_DataAlts_s17 _altsX17 (T_DataAlts_vIn16 _altsOnested _altsOstrictPre) _lhsOpp :: PP_Doc _lhsOpp = rule117 _altsIpps arg_derivings_ arg_name_ arg_params_ _altsOstrictPre = rule118 arg_strict_ _altsOnested = rule119 _lhsInested !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule117 #-} {-# LINE 110 "src-ag/PrintCode.ag" #-} rule117 = \ ((_altsIpps) :: PP_Docs) derivings_ name_ params_ -> {-# LINE 110 "src-ag/PrintCode.ag" #-} "data" >#< hv_sp (name_ : params_) >#< ( case _altsIpps of [] -> empty (x:xs) -> "=" >#< x >-< vlist (map ("|" >#<) xs) >-< if null derivings_ then empty else "deriving" >#< ppTuple False (map text derivings_) ) {-# LINE 1131 "dist/build/PrintCode.hs"#-} {-# INLINE rule118 #-} {-# LINE 325 "src-ag/PrintCode.ag" #-} rule118 = \ strict_ -> {-# LINE 325 "src-ag/PrintCode.ag" #-} if strict_ then pp "!" else empty {-# LINE 1137 "dist/build/PrintCode.hs"#-} {-# INLINE rule119 #-} rule119 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Decl_NewType #-} sem_Decl_NewType :: (String) -> ([String]) -> (String) -> T_Type -> T_Decl sem_Decl_NewType !arg_name_ !arg_params_ !arg_con_ arg_tp_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOpp :: PP_Doc _lhsOpp = rule120 _tpIpp arg_con_ arg_name_ arg_params_ _tpOnested = rule121 _lhsInested !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule120 #-} {-# LINE 119 "src-ag/PrintCode.ag" #-} rule120 = \ ((_tpIpp) :: PP_Doc) con_ name_ params_ -> {-# LINE 119 "src-ag/PrintCode.ag" #-} "newtype" >#< hv_sp (name_ : params_) >#< "=" >#< con_ >#< pp_parens _tpIpp {-# LINE 1161 "dist/build/PrintCode.hs"#-} {-# INLINE rule121 #-} rule121 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Decl_Type #-} sem_Decl_Type :: (String) -> ([String]) -> T_Type -> T_Decl sem_Decl_Type !arg_name_ !arg_params_ arg_tp_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOpp :: PP_Doc _lhsOpp = rule122 _tpIpp arg_name_ arg_params_ _tpOnested = rule123 _lhsInested !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule122 #-} {-# LINE 120 "src-ag/PrintCode.ag" #-} rule122 = \ ((_tpIpp) :: PP_Doc) name_ params_ -> {-# LINE 120 "src-ag/PrintCode.ag" #-} "type" >#< hv_sp (name_ : params_) >#< "=" >#< _tpIpp {-# LINE 1185 "dist/build/PrintCode.hs"#-} {-# INLINE rule123 #-} rule123 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Decl_TSig #-} sem_Decl_TSig :: (String) -> T_Type -> T_Decl sem_Decl_TSig !arg_name_ arg_tp_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOpp :: PP_Doc _lhsOpp = rule124 _tpIpp arg_name_ _tpOnested = rule125 _lhsInested !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule124 #-} {-# LINE 121 "src-ag/PrintCode.ag" #-} rule124 = \ ((_tpIpp) :: PP_Doc) name_ -> {-# LINE 121 "src-ag/PrintCode.ag" #-} name_ >#< "::" >#< _tpIpp {-# LINE 1209 "dist/build/PrintCode.hs"#-} {-# INLINE rule125 #-} rule125 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Decl_Comment #-} sem_Decl_Comment :: (String) -> T_Decl sem_Decl_Comment !arg_txt_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule126 arg_txt_ !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule126 #-} {-# LINE 122 "src-ag/PrintCode.ag" #-} rule126 = \ txt_ -> {-# LINE 122 "src-ag/PrintCode.ag" #-} if '\n' `elem` txt_ then "{-" >-< vlist (lines txt_) >-< "-}" else "--" >#< txt_ {-# LINE 1232 "dist/build/PrintCode.hs"#-} {-# NOINLINE sem_Decl_PragmaDecl #-} sem_Decl_PragmaDecl :: (String) -> T_Decl sem_Decl_PragmaDecl !arg_txt_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule127 arg_txt_ !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule127 #-} {-# LINE 125 "src-ag/PrintCode.ag" #-} rule127 = \ txt_ -> {-# LINE 125 "src-ag/PrintCode.ag" #-} "{-#" >#< text txt_ >#< "#-}" {-# LINE 1250 "dist/build/PrintCode.hs"#-} {-# NOINLINE sem_Decl_Resume #-} sem_Decl_Resume :: (Bool) -> (String) -> T_Lhs -> T_Expr -> T_Decl sem_Decl_Resume !arg_monadic_ _ arg_left_ arg_rhs_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOnested _rhsOoptions _rhsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule128 _leftIpp _rhsIpp arg_monadic_ _leftOisDeclOfLet = rule129 _lhsIisDeclOfLet _leftOnested = rule130 _lhsInested _leftOoptions = rule131 _lhsIoptions _leftOoutputfile = rule132 _lhsIoutputfile _rhsOnested = rule133 _lhsInested _rhsOoptions = rule134 _lhsIoptions _rhsOoutputfile = rule135 _lhsIoutputfile !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule128 #-} {-# LINE 126 "src-ag/PrintCode.ag" #-} rule128 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) monadic_ -> {-# LINE 126 "src-ag/PrintCode.ag" #-} if monadic_ then _leftIpp >#< "<-" >#< _rhsIpp else _leftIpp >#< "=" >-< indent 4 _rhsIpp {-# LINE 1281 "dist/build/PrintCode.hs"#-} {-# INLINE rule129 #-} rule129 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule130 #-} rule130 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule131 #-} rule131 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule132 #-} rule132 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule133 #-} rule133 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule134 #-} rule134 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule135 #-} rule135 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Decl_EvalDecl #-} sem_Decl_EvalDecl :: (String) -> T_Lhs -> T_Expr -> T_Decl sem_Decl_EvalDecl !arg_nt_ arg_left_ arg_rhs_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOnested _rhsOoptions _rhsOoutputfile) _strat = rule136 _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule137 _leftIpp _lhsIoptions _rhsIpp _strat arg_nt_ _leftOisDeclOfLet = rule138 _lhsIisDeclOfLet _leftOnested = rule139 _lhsInested _leftOoptions = rule140 _lhsIoptions _leftOoutputfile = rule141 _lhsIoutputfile _rhsOnested = rule142 _lhsInested _rhsOoptions = rule143 _lhsIoptions _rhsOoutputfile = rule144 _lhsIoutputfile !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule136 #-} {-# LINE 129 "src-ag/PrintCode.ag" #-} rule136 = \ ((_lhsIoptions) :: Options) -> {-# LINE 129 "src-ag/PrintCode.ag" #-} if breadthFirstStrict _lhsIoptions then "stepwiseEval" else "lazyEval" {-# LINE 1334 "dist/build/PrintCode.hs"#-} {-# INLINE rule137 #-} {-# LINE 132 "src-ag/PrintCode.ag" #-} rule137 = \ ((_leftIpp) :: PP_Doc) ((_lhsIoptions) :: Options) ((_rhsIpp) :: PP_Doc) _strat nt_ -> {-# LINE 132 "src-ag/PrintCode.ag" #-} if breadthFirst _lhsIoptions then _leftIpp >#< "=" >#< "case" >#< _strat >#< pp_parens _rhsIpp >#< "of" >-< indent 4 ( pp_parens (nt_ >|< "_Syn" >#< "_val") >#< "-> _val" ) else _leftIpp >#< "=" >#< _rhsIpp {-# LINE 1345 "dist/build/PrintCode.hs"#-} {-# INLINE rule138 #-} rule138 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule139 #-} rule139 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule140 #-} rule140 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule141 #-} rule141 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule142 #-} rule142 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule143 #-} rule143 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule144 #-} rule144 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile -- Decls ------------------------------------------------------- -- wrapper data Inh_Decls = Inh_Decls { isDeclOfLet_Inh_Decls :: !(Bool), nested_Inh_Decls :: !(Bool), options_Inh_Decls :: !(Options), outputfile_Inh_Decls :: !(String) } data Syn_Decls = Syn_Decls { pps_Syn_Decls :: !(PP_Docs) } {-# INLINABLE wrap_Decls #-} wrap_Decls :: T_Decls -> Inh_Decls -> (Syn_Decls ) wrap_Decls !(T_Decls act) !(Inh_Decls _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg22 = T_Decls_vIn22 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile !(T_Decls_vOut22 _lhsOpps) <- return (inv_Decls_s23 sem arg22) return (Syn_Decls _lhsOpps) ) -- cata {-# NOINLINE sem_Decls #-} sem_Decls :: Decls -> T_Decls sem_Decls list = Prelude.foldr sem_Decls_Cons sem_Decls_Nil (Prelude.map sem_Decl list) -- semantic domain newtype T_Decls = T_Decls { attach_T_Decls :: Identity (T_Decls_s23 ) } newtype T_Decls_s23 = C_Decls_s23 { inv_Decls_s23 :: (T_Decls_v22 ) } data T_Decls_s24 = C_Decls_s24 type T_Decls_v22 = (T_Decls_vIn22 ) -> (T_Decls_vOut22 ) data T_Decls_vIn22 = T_Decls_vIn22 (Bool) (Bool) (Options) (String) data T_Decls_vOut22 = T_Decls_vOut22 (PP_Docs) {-# NOINLINE sem_Decls_Cons #-} sem_Decls_Cons :: T_Decl -> T_Decls -> T_Decls sem_Decls_Cons arg_hd_ arg_tl_ = T_Decls (return st23) where {-# NOINLINE st23 #-} !st23 = let v22 :: T_Decls_v22 v22 = \ !(T_Decls_vIn22 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _hdX20 = Control.Monad.Identity.runIdentity (attach_T_Decl (arg_hd_)) _tlX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_tl_)) (T_Decl_vOut19 _hdIpp) = inv_Decl_s20 _hdX20 (T_Decl_vIn19 _hdOisDeclOfLet _hdOnested _hdOoptions _hdOoutputfile) (T_Decls_vOut22 _tlIpps) = inv_Decls_s23 _tlX23 (T_Decls_vIn22 _tlOisDeclOfLet _tlOnested _tlOoptions _tlOoutputfile) _lhsOpps :: PP_Docs _lhsOpps = rule145 _hdIpp _tlIpps _hdOisDeclOfLet = rule146 _lhsIisDeclOfLet _hdOnested = rule147 _lhsInested _hdOoptions = rule148 _lhsIoptions _hdOoutputfile = rule149 _lhsIoutputfile _tlOisDeclOfLet = rule150 _lhsIisDeclOfLet _tlOnested = rule151 _lhsInested _tlOoptions = rule152 _lhsIoptions _tlOoutputfile = rule153 _lhsIoutputfile !__result_ = T_Decls_vOut22 _lhsOpps in __result_ ) in C_Decls_s23 v22 {-# INLINE rule145 #-} {-# LINE 84 "src-ag/PrintCode.ag" #-} rule145 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 84 "src-ag/PrintCode.ag" #-} _hdIpp : _tlIpps {-# LINE 1427 "dist/build/PrintCode.hs"#-} {-# INLINE rule146 #-} rule146 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule147 #-} rule147 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule148 #-} rule148 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule149 #-} rule149 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule150 #-} rule150 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule151 #-} rule151 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule152 #-} rule152 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule153 #-} rule153 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Decls_Nil #-} sem_Decls_Nil :: T_Decls sem_Decls_Nil = T_Decls (return st23) where {-# NOINLINE st23 #-} !st23 = let v22 :: T_Decls_v22 v22 = \ !(T_Decls_vIn22 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule154 () !__result_ = T_Decls_vOut22 _lhsOpps in __result_ ) in C_Decls_s23 v22 {-# INLINE rule154 #-} {-# LINE 85 "src-ag/PrintCode.ag" #-} rule154 = \ (_ :: ()) -> {-# LINE 85 "src-ag/PrintCode.ag" #-} [] {-# LINE 1469 "dist/build/PrintCode.hs"#-} -- Expr -------------------------------------------------------- -- wrapper data Inh_Expr = Inh_Expr { nested_Inh_Expr :: !(Bool), options_Inh_Expr :: !(Options), outputfile_Inh_Expr :: !(String) } data Syn_Expr = Syn_Expr { pp_Syn_Expr :: !(PP_Doc) } {-# INLINABLE wrap_Expr #-} wrap_Expr :: T_Expr -> Inh_Expr -> (Syn_Expr ) wrap_Expr !(T_Expr act) !(Inh_Expr _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg25 = T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile !(T_Expr_vOut25 _lhsOpp) <- return (inv_Expr_s26 sem arg25) return (Syn_Expr _lhsOpp) ) -- cata {-# NOINLINE sem_Expr #-} sem_Expr :: Expr -> T_Expr sem_Expr ( Let decls_ body_ ) = sem_Expr_Let ( sem_Decls decls_ ) ( sem_Expr body_ ) sem_Expr ( Case expr_ alts_ ) = sem_Expr_Case ( sem_Expr expr_ ) ( sem_CaseAlts alts_ ) sem_Expr ( Do stmts_ body_ ) = sem_Expr_Do ( sem_Decls stmts_ ) ( sem_Expr body_ ) sem_Expr ( Lambda args_ body_ ) = sem_Expr_Lambda ( sem_Exprs args_ ) ( sem_Expr body_ ) sem_Expr ( TupleExpr exprs_ ) = sem_Expr_TupleExpr ( sem_Exprs exprs_ ) sem_Expr ( UnboxedTupleExpr exprs_ ) = sem_Expr_UnboxedTupleExpr ( sem_Exprs exprs_ ) sem_Expr ( App !name_ args_ ) = sem_Expr_App name_ ( sem_Exprs args_ ) sem_Expr ( SimpleExpr !txt_ ) = sem_Expr_SimpleExpr txt_ sem_Expr ( TextExpr !lns_ ) = sem_Expr_TextExpr lns_ sem_Expr ( Trace !txt_ expr_ ) = sem_Expr_Trace txt_ ( sem_Expr expr_ ) sem_Expr ( PragmaExpr !onLeftSide_ !onNewLine_ !txt_ expr_ ) = sem_Expr_PragmaExpr onLeftSide_ onNewLine_ txt_ ( sem_Expr expr_ ) sem_Expr ( LineExpr expr_ ) = sem_Expr_LineExpr ( sem_Expr expr_ ) sem_Expr ( TypedExpr expr_ tp_ ) = sem_Expr_TypedExpr ( sem_Expr expr_ ) ( sem_Type tp_ ) sem_Expr ( ResultExpr !nt_ expr_ ) = sem_Expr_ResultExpr nt_ ( sem_Expr expr_ ) sem_Expr ( InvokeExpr !nt_ expr_ args_ ) = sem_Expr_InvokeExpr nt_ ( sem_Expr expr_ ) ( sem_Exprs args_ ) sem_Expr ( ResumeExpr !nt_ expr_ left_ rhs_ ) = sem_Expr_ResumeExpr nt_ ( sem_Expr expr_ ) ( sem_Lhs left_ ) ( sem_Expr rhs_ ) sem_Expr ( SemFun !nt_ args_ body_ ) = sem_Expr_SemFun nt_ ( sem_Exprs args_ ) ( sem_Expr body_ ) -- semantic domain newtype T_Expr = T_Expr { attach_T_Expr :: Identity (T_Expr_s26 ) } newtype T_Expr_s26 = C_Expr_s26 { inv_Expr_s26 :: (T_Expr_v25 ) } data T_Expr_s27 = C_Expr_s27 type T_Expr_v25 = (T_Expr_vIn25 ) -> (T_Expr_vOut25 ) data T_Expr_vIn25 = T_Expr_vIn25 (Bool) (Options) (String) data T_Expr_vOut25 = T_Expr_vOut25 (PP_Doc) {-# NOINLINE sem_Expr_Let #-} sem_Expr_Let :: T_Decls -> T_Expr -> T_Expr sem_Expr_Let arg_decls_ arg_body_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _declsX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_decls_)) _bodyX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_body_)) (T_Decls_vOut22 _declsIpps) = inv_Decls_s23 _declsX23 (T_Decls_vIn22 _declsOisDeclOfLet _declsOnested _declsOoptions _declsOoutputfile) (T_Expr_vOut25 _bodyIpp) = inv_Expr_s26 _bodyX26 (T_Expr_vIn25 _bodyOnested _bodyOoptions _bodyOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule155 _bodyIpp _declsIpps _declsOisDeclOfLet = rule156 () _declsOnested = rule157 _lhsInested _declsOoptions = rule158 _lhsIoptions _declsOoutputfile = rule159 _lhsIoutputfile _bodyOnested = rule160 _lhsInested _bodyOoptions = rule161 _lhsIoptions _bodyOoutputfile = rule162 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule155 #-} {-# LINE 140 "src-ag/PrintCode.ag" #-} rule155 = \ ((_bodyIpp) :: PP_Doc) ((_declsIpps) :: PP_Docs) -> {-# LINE 140 "src-ag/PrintCode.ag" #-} pp_parens ( "let" >#< (vlist _declsIpps) >-< "in " >#< _bodyIpp ) {-# LINE 1547 "dist/build/PrintCode.hs"#-} {-# INLINE rule156 #-} {-# LINE 420 "src-ag/PrintCode.ag" #-} rule156 = \ (_ :: ()) -> {-# LINE 420 "src-ag/PrintCode.ag" #-} True {-# LINE 1553 "dist/build/PrintCode.hs"#-} {-# INLINE rule157 #-} rule157 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule158 #-} rule158 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule159 #-} rule159 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule160 #-} rule160 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule161 #-} rule161 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule162 #-} rule162 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_Case #-} sem_Expr_Case :: T_Expr -> T_CaseAlts -> T_Expr sem_Expr_Case arg_expr_ arg_alts_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) _altsX5 = Control.Monad.Identity.runIdentity (attach_T_CaseAlts (arg_alts_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) (T_CaseAlts_vOut4 _altsIpps) = inv_CaseAlts_s5 _altsX5 (T_CaseAlts_vIn4 _altsOnested _altsOoptions _altsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule163 _altsIpps _exprIpp _exprOnested = rule164 _lhsInested _exprOoptions = rule165 _lhsIoptions _exprOoutputfile = rule166 _lhsIoutputfile _altsOnested = rule167 _lhsInested _altsOoptions = rule168 _lhsIoptions _altsOoutputfile = rule169 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule163 #-} {-# LINE 143 "src-ag/PrintCode.ag" #-} rule163 = \ ((_altsIpps) :: PP_Docs) ((_exprIpp) :: PP_Doc) -> {-# LINE 143 "src-ag/PrintCode.ag" #-} pp_parens ( "case" >#< pp_parens _exprIpp >#< "of" >-< (vlist _altsIpps) ) {-# LINE 1601 "dist/build/PrintCode.hs"#-} {-# INLINE rule164 #-} rule164 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule165 #-} rule165 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule166 #-} rule166 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule167 #-} rule167 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule168 #-} rule168 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule169 #-} rule169 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_Do #-} sem_Expr_Do :: T_Decls -> T_Expr -> T_Expr sem_Expr_Do arg_stmts_ arg_body_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _stmtsX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_stmts_)) _bodyX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_body_)) (T_Decls_vOut22 _stmtsIpps) = inv_Decls_s23 _stmtsX23 (T_Decls_vIn22 _stmtsOisDeclOfLet _stmtsOnested _stmtsOoptions _stmtsOoutputfile) (T_Expr_vOut25 _bodyIpp) = inv_Expr_s26 _bodyX26 (T_Expr_vIn25 _bodyOnested _bodyOoptions _bodyOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule170 _bodyIpp _stmtsIpps _stmtsOisDeclOfLet = rule171 () _stmtsOnested = rule172 _lhsInested _stmtsOoptions = rule173 _lhsIoptions _stmtsOoutputfile = rule174 _lhsIoutputfile _bodyOnested = rule175 _lhsInested _bodyOoptions = rule176 _lhsIoptions _bodyOoutputfile = rule177 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule170 #-} {-# LINE 146 "src-ag/PrintCode.ag" #-} rule170 = \ ((_bodyIpp) :: PP_Doc) ((_stmtsIpps) :: PP_Docs) -> {-# LINE 146 "src-ag/PrintCode.ag" #-} pp_parens ( "do" >#< ( vlist _stmtsIpps >-< ("return" >#< _bodyIpp)) ) {-# LINE 1650 "dist/build/PrintCode.hs"#-} {-# INLINE rule171 #-} {-# LINE 422 "src-ag/PrintCode.ag" #-} rule171 = \ (_ :: ()) -> {-# LINE 422 "src-ag/PrintCode.ag" #-} False {-# LINE 1656 "dist/build/PrintCode.hs"#-} {-# INLINE rule172 #-} rule172 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule173 #-} rule173 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule174 #-} rule174 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule175 #-} rule175 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule176 #-} rule176 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule177 #-} rule177 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_Lambda #-} sem_Expr_Lambda :: T_Exprs -> T_Expr -> T_Expr sem_Expr_Lambda arg_args_ arg_body_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _argsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_args_)) _bodyX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_body_)) (T_Exprs_vOut28 _argsIpps) = inv_Exprs_s29 _argsX29 (T_Exprs_vIn28 _argsOnested _argsOoptions _argsOoutputfile) (T_Expr_vOut25 _bodyIpp) = inv_Expr_s26 _bodyX26 (T_Expr_vIn25 _bodyOnested _bodyOoptions _bodyOoutputfile) _strictParams = rule178 _argsIpps _lhsIoptions _addBang = rule179 _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule180 _addBang _argsIpps _bodyIpp _strictParams _argsOnested = rule181 _lhsInested _argsOoptions = rule182 _lhsIoptions _argsOoutputfile = rule183 _lhsIoutputfile _bodyOnested = rule184 _lhsInested _bodyOoptions = rule185 _lhsIoptions _bodyOoutputfile = rule186 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule178 #-} {-# LINE 149 "src-ag/PrintCode.ag" #-} rule178 = \ ((_argsIpps) :: PP_Docs) ((_lhsIoptions) :: Options) -> {-# LINE 149 "src-ag/PrintCode.ag" #-} if strictSems _lhsIoptions then _argsIpps else [] {-# LINE 1706 "dist/build/PrintCode.hs"#-} {-# INLINE rule179 #-} {-# LINE 152 "src-ag/PrintCode.ag" #-} rule179 = \ ((_lhsIoptions) :: Options) -> {-# LINE 152 "src-ag/PrintCode.ag" #-} if bangpats _lhsIoptions then \p -> pp_parens ("!" >|< p) else id {-# LINE 1714 "dist/build/PrintCode.hs"#-} {-# INLINE rule180 #-} {-# LINE 155 "src-ag/PrintCode.ag" #-} rule180 = \ _addBang ((_argsIpps) :: PP_Docs) ((_bodyIpp) :: PP_Doc) _strictParams -> {-# LINE 155 "src-ag/PrintCode.ag" #-} pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->" >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp) ) {-# LINE 1722 "dist/build/PrintCode.hs"#-} {-# INLINE rule181 #-} rule181 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule182 #-} rule182 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule183 #-} rule183 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule184 #-} rule184 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule185 #-} rule185 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule186 #-} rule186 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_TupleExpr #-} sem_Expr_TupleExpr :: T_Exprs -> T_Expr sem_Expr_TupleExpr arg_exprs_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_exprs_)) (T_Exprs_vOut28 _exprsIpps) = inv_Exprs_s29 _exprsX29 (T_Exprs_vIn28 _exprsOnested _exprsOoptions _exprsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule187 _exprsIpps _lhsInested _exprsOnested = rule188 _lhsInested _exprsOoptions = rule189 _lhsIoptions _exprsOoutputfile = rule190 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule187 #-} {-# LINE 158 "src-ag/PrintCode.ag" #-} rule187 = \ ((_exprsIpps) :: PP_Docs) ((_lhsInested) :: Bool) -> {-# LINE 158 "src-ag/PrintCode.ag" #-} ppTuple _lhsInested _exprsIpps {-# LINE 1763 "dist/build/PrintCode.hs"#-} {-# INLINE rule188 #-} rule188 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule189 #-} rule189 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule190 #-} rule190 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_UnboxedTupleExpr #-} sem_Expr_UnboxedTupleExpr :: T_Exprs -> T_Expr sem_Expr_UnboxedTupleExpr arg_exprs_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_exprs_)) (T_Exprs_vOut28 _exprsIpps) = inv_Exprs_s29 _exprsX29 (T_Exprs_vIn28 _exprsOnested _exprsOoptions _exprsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule191 _exprsIpps _lhsInested _exprsOnested = rule192 _lhsInested _exprsOoptions = rule193 _lhsIoptions _exprsOoutputfile = rule194 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule191 #-} {-# LINE 159 "src-ag/PrintCode.ag" #-} rule191 = \ ((_exprsIpps) :: PP_Docs) ((_lhsInested) :: Bool) -> {-# LINE 159 "src-ag/PrintCode.ag" #-} ppUnboxedTuple _lhsInested _exprsIpps {-# LINE 1795 "dist/build/PrintCode.hs"#-} {-# INLINE rule192 #-} rule192 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule193 #-} rule193 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule194 #-} rule194 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_App #-} sem_Expr_App :: (String) -> T_Exprs -> T_Expr sem_Expr_App !arg_name_ arg_args_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _argsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_args_)) (T_Exprs_vOut28 _argsIpps) = inv_Exprs_s29 _argsX29 (T_Exprs_vIn28 _argsOnested _argsOoptions _argsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule195 _argsIpps arg_name_ _argsOnested = rule196 _lhsInested _argsOoptions = rule197 _lhsIoptions _argsOoutputfile = rule198 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule195 #-} {-# LINE 160 "src-ag/PrintCode.ag" #-} rule195 = \ ((_argsIpps) :: PP_Docs) name_ -> {-# LINE 160 "src-ag/PrintCode.ag" #-} pp_parens $ name_ >#< hv_sp _argsIpps {-# LINE 1827 "dist/build/PrintCode.hs"#-} {-# INLINE rule196 #-} rule196 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule197 #-} rule197 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule198 #-} rule198 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_SimpleExpr #-} sem_Expr_SimpleExpr :: (String) -> T_Expr sem_Expr_SimpleExpr !arg_txt_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule199 arg_txt_ !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule199 #-} {-# LINE 161 "src-ag/PrintCode.ag" #-} rule199 = \ txt_ -> {-# LINE 161 "src-ag/PrintCode.ag" #-} text txt_ {-# LINE 1854 "dist/build/PrintCode.hs"#-} {-# NOINLINE sem_Expr_TextExpr #-} sem_Expr_TextExpr :: ([String]) -> T_Expr sem_Expr_TextExpr !arg_lns_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule200 arg_lns_ !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule200 #-} {-# LINE 162 "src-ag/PrintCode.ag" #-} rule200 = \ lns_ -> {-# LINE 162 "src-ag/PrintCode.ag" #-} vlist (map text lns_) {-# LINE 1872 "dist/build/PrintCode.hs"#-} {-# NOINLINE sem_Expr_Trace #-} sem_Expr_Trace :: (String) -> T_Expr -> T_Expr sem_Expr_Trace !arg_txt_ arg_expr_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule201 _exprIpp arg_txt_ _exprOnested = rule202 _lhsInested _exprOoptions = rule203 _lhsIoptions _exprOoutputfile = rule204 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule201 #-} {-# LINE 163 "src-ag/PrintCode.ag" #-} rule201 = \ ((_exprIpp) :: PP_Doc) txt_ -> {-# LINE 163 "src-ag/PrintCode.ag" #-} "trace" >#< ( pp_parens ("\"" >|< text txt_ >|< "\"") >-< pp_parens _exprIpp ) {-# LINE 1897 "dist/build/PrintCode.hs"#-} {-# INLINE rule202 #-} rule202 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule203 #-} rule203 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule204 #-} rule204 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_PragmaExpr #-} sem_Expr_PragmaExpr :: (Bool) -> (Bool) -> (String) -> T_Expr -> T_Expr sem_Expr_PragmaExpr !arg_onLeftSide_ !arg_onNewLine_ !arg_txt_ arg_expr_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule205 _exprIpp arg_onLeftSide_ arg_onNewLine_ arg_txt_ _exprOnested = rule206 _lhsInested _exprOoptions = rule207 _lhsIoptions _exprOoutputfile = rule208 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule205 #-} {-# LINE 166 "src-ag/PrintCode.ag" #-} rule205 = \ ((_exprIpp) :: PP_Doc) onLeftSide_ onNewLine_ txt_ -> {-# LINE 166 "src-ag/PrintCode.ag" #-} let pragmaDoc = "{-#" >#< txt_ >#< "#-}" op = if onNewLine_ then (>-<) else (>#<) leftOp x y = if onLeftSide_ then x `op` y else y rightOp x y = if onLeftSide_ then x else x `op` y in pp_parens (pragmaDoc `leftOp` _exprIpp `rightOp` pragmaDoc) {-# LINE 1939 "dist/build/PrintCode.hs"#-} {-# INLINE rule206 #-} rule206 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule207 #-} rule207 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule208 #-} rule208 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_LineExpr #-} sem_Expr_LineExpr :: T_Expr -> T_Expr sem_Expr_LineExpr arg_expr_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule209 _exprIpp _lhsIoutputfile _exprOnested = rule210 _lhsInested _exprOoptions = rule211 _lhsIoptions _exprOoutputfile = rule212 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule209 #-} {-# LINE 177 "src-ag/PrintCode.ag" #-} rule209 = \ ((_exprIpp) :: PP_Doc) ((_lhsIoutputfile) :: String) -> {-# LINE 177 "src-ag/PrintCode.ag" #-} _exprIpp >-< "{-# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show _lhsIoutputfile >#< "#-}" >-< "" {-# LINE 1972 "dist/build/PrintCode.hs"#-} {-# INLINE rule210 #-} rule210 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule211 #-} rule211 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule212 #-} rule212 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_TypedExpr #-} sem_Expr_TypedExpr :: T_Expr -> T_Type -> T_Expr sem_Expr_TypedExpr arg_expr_ arg_tp_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) (T_Type_vOut49 _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOpp :: PP_Doc _lhsOpp = rule213 _exprIpp _tpIpp _exprOnested = rule214 _lhsInested _exprOoptions = rule215 _lhsIoptions _exprOoutputfile = rule216 _lhsIoutputfile _tpOnested = rule217 _lhsInested !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule213 #-} {-# LINE 179 "src-ag/PrintCode.ag" #-} rule213 = \ ((_exprIpp) :: PP_Doc) ((_tpIpp) :: PP_Doc) -> {-# LINE 179 "src-ag/PrintCode.ag" #-} pp_parens (_exprIpp >#< "::" >#< _tpIpp) {-# LINE 2007 "dist/build/PrintCode.hs"#-} {-# INLINE rule214 #-} rule214 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule215 #-} rule215 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule216 #-} rule216 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule217 #-} rule217 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Expr_ResultExpr #-} sem_Expr_ResultExpr :: (String) -> T_Expr -> T_Expr sem_Expr_ResultExpr !arg_nt_ arg_expr_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule218 _exprIpp _lhsIoptions arg_nt_ _exprOnested = rule219 _lhsInested _exprOoptions = rule220 _lhsIoptions _exprOoutputfile = rule221 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule218 #-} {-# LINE 180 "src-ag/PrintCode.ag" #-} rule218 = \ ((_exprIpp) :: PP_Doc) ((_lhsIoptions) :: Options) nt_ -> {-# LINE 180 "src-ag/PrintCode.ag" #-} if breadthFirst _lhsIoptions then "final" >#< pp_parens (nt_ >|< "_Syn" >#< pp_parens _exprIpp) else _exprIpp {-# LINE 2045 "dist/build/PrintCode.hs"#-} {-# INLINE rule219 #-} rule219 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule220 #-} rule220 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule221 #-} rule221 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_InvokeExpr #-} sem_Expr_InvokeExpr :: (String) -> T_Expr -> T_Exprs -> T_Expr sem_Expr_InvokeExpr !arg_nt_ arg_expr_ arg_args_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) _argsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_args_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) (T_Exprs_vOut28 _argsIpps) = inv_Exprs_s29 _argsX29 (T_Exprs_vIn28 _argsOnested _argsOoptions _argsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule222 _argsIpps _exprIpp _lhsIoptions arg_nt_ _exprOnested = rule223 _lhsInested _exprOoptions = rule224 _lhsIoptions _exprOoutputfile = rule225 _lhsIoutputfile _argsOnested = rule226 _lhsInested _argsOoptions = rule227 _lhsIoptions _argsOoutputfile = rule228 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule222 #-} {-# LINE 184 "src-ag/PrintCode.ag" #-} rule222 = \ ((_argsIpps) :: PP_Docs) ((_exprIpp) :: PP_Doc) ((_lhsIoptions) :: Options) nt_ -> {-# LINE 184 "src-ag/PrintCode.ag" #-} if breadthFirst _lhsIoptions then "invoke" >#< pp_parens _exprIpp >#< pp_parens ( nt_ >|< "_Inh" >#< pp_parens (ppTuple False _argsIpps)) else _exprIpp >#< hv_sp _argsIpps {-# LINE 2085 "dist/build/PrintCode.hs"#-} {-# INLINE rule223 #-} rule223 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule224 #-} rule224 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule225 #-} rule225 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule226 #-} rule226 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule227 #-} rule227 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule228 #-} rule228 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_ResumeExpr #-} sem_Expr_ResumeExpr :: (String) -> T_Expr -> T_Lhs -> T_Expr -> T_Expr sem_Expr_ResumeExpr !arg_nt_ arg_expr_ arg_left_ arg_rhs_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOnested _rhsOoptions _rhsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule229 _exprIpp _leftIpp _lhsIoptions _rhsIpp arg_nt_ _leftOisDeclOfLet = rule230 () _exprOnested = rule231 _lhsInested _exprOoptions = rule232 _lhsIoptions _exprOoutputfile = rule233 _lhsIoutputfile _leftOnested = rule234 _lhsInested _leftOoptions = rule235 _lhsIoptions _leftOoutputfile = rule236 _lhsIoutputfile _rhsOnested = rule237 _lhsInested _rhsOoptions = rule238 _lhsIoptions _rhsOoutputfile = rule239 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule229 #-} {-# LINE 188 "src-ag/PrintCode.ag" #-} rule229 = \ ((_exprIpp) :: PP_Doc) ((_leftIpp) :: PP_Doc) ((_lhsIoptions) :: Options) ((_rhsIpp) :: PP_Doc) nt_ -> {-# LINE 188 "src-ag/PrintCode.ag" #-} if breadthFirst _lhsIoptions then pp_parens ("resume" >#< pp_parens _exprIpp >-< indent 2 (pp_parens ( "\\" >|< pp_parens ("~" >|< pp_parens (nt_ >|< "_Syn" >#< "_inh_arg")) >#< "->" >-< indent 2 ( "let" >#< _leftIpp >#< "= _inh_arg" >-< indent 2 ("in" >#< _rhsIpp) )))) else pp_parens ( "case" >#< pp_parens _exprIpp >#< "of" >-< ("{" >#< _leftIpp >#< "->") >-< indent 4 (_rhsIpp >#< "}") ) {-# LINE 2148 "dist/build/PrintCode.hs"#-} {-# INLINE rule230 #-} {-# LINE 424 "src-ag/PrintCode.ag" #-} rule230 = \ (_ :: ()) -> {-# LINE 424 "src-ag/PrintCode.ag" #-} False {-# LINE 2154 "dist/build/PrintCode.hs"#-} {-# INLINE rule231 #-} rule231 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule232 #-} rule232 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule233 #-} rule233 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule234 #-} rule234 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule235 #-} rule235 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule236 #-} rule236 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule237 #-} rule237 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule238 #-} rule238 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule239 #-} rule239 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_SemFun #-} sem_Expr_SemFun :: (String) -> T_Exprs -> T_Expr -> T_Expr sem_Expr_SemFun !arg_nt_ arg_args_ arg_body_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _argsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_args_)) _bodyX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_body_)) (T_Exprs_vOut28 _argsIpps) = inv_Exprs_s29 _argsX29 (T_Exprs_vIn28 _argsOnested _argsOoptions _argsOoutputfile) (T_Expr_vOut25 _bodyIpp) = inv_Expr_s26 _bodyX26 (T_Expr_vIn25 _bodyOnested _bodyOoptions _bodyOoutputfile) _strictParams = rule240 _argsIpps _lhsIoptions _addBang = rule241 _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule242 _addBang _argsIpps _bodyIpp _lhsIoptions _strictParams arg_nt_ _argsOnested = rule243 _lhsInested _argsOoptions = rule244 _lhsIoptions _argsOoutputfile = rule245 _lhsIoutputfile _bodyOnested = rule246 _lhsInested _bodyOoptions = rule247 _lhsIoptions _bodyOoutputfile = rule248 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule240 #-} {-# LINE 200 "src-ag/PrintCode.ag" #-} rule240 = \ ((_argsIpps) :: PP_Docs) ((_lhsIoptions) :: Options) -> {-# LINE 200 "src-ag/PrintCode.ag" #-} if strictSems _lhsIoptions then _argsIpps else [] {-# LINE 2213 "dist/build/PrintCode.hs"#-} {-# INLINE rule241 #-} {-# LINE 203 "src-ag/PrintCode.ag" #-} rule241 = \ ((_lhsIoptions) :: Options) -> {-# LINE 203 "src-ag/PrintCode.ag" #-} if bangpats _lhsIoptions then \p -> pp_parens ("!" >|< p) else id {-# LINE 2221 "dist/build/PrintCode.hs"#-} {-# INLINE rule242 #-} {-# LINE 206 "src-ag/PrintCode.ag" #-} rule242 = \ _addBang ((_argsIpps) :: PP_Docs) ((_bodyIpp) :: PP_Doc) ((_lhsIoptions) :: Options) _strictParams nt_ -> {-# LINE 206 "src-ag/PrintCode.ag" #-} if breadthFirst _lhsIoptions then "Child" >#< pp_parens ( "\\" >|< pp_parens (nt_ >|< "_Inh" >#< ppTuple False (map _addBang _argsIpps)) >#< "->" >-< indent 2 (_strictParams `ppMultiSeqV` _bodyIpp)) else if null _argsIpps then _bodyIpp else pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->" >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp) ) {-# LINE 2236 "dist/build/PrintCode.hs"#-} {-# INLINE rule243 #-} rule243 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule244 #-} rule244 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule245 #-} rule245 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule246 #-} rule246 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule247 #-} rule247 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule248 #-} rule248 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile -- Exprs ------------------------------------------------------- -- wrapper data Inh_Exprs = Inh_Exprs { nested_Inh_Exprs :: !(Bool), options_Inh_Exprs :: !(Options), outputfile_Inh_Exprs :: !(String) } data Syn_Exprs = Syn_Exprs { pps_Syn_Exprs :: !(PP_Docs) } {-# INLINABLE wrap_Exprs #-} wrap_Exprs :: T_Exprs -> Inh_Exprs -> (Syn_Exprs ) wrap_Exprs !(T_Exprs act) !(Inh_Exprs _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg28 = T_Exprs_vIn28 _lhsInested _lhsIoptions _lhsIoutputfile !(T_Exprs_vOut28 _lhsOpps) <- return (inv_Exprs_s29 sem arg28) return (Syn_Exprs _lhsOpps) ) -- cata {-# NOINLINE sem_Exprs #-} sem_Exprs :: Exprs -> T_Exprs sem_Exprs list = Prelude.foldr sem_Exprs_Cons sem_Exprs_Nil (Prelude.map sem_Expr list) -- semantic domain newtype T_Exprs = T_Exprs { attach_T_Exprs :: Identity (T_Exprs_s29 ) } newtype T_Exprs_s29 = C_Exprs_s29 { inv_Exprs_s29 :: (T_Exprs_v28 ) } data T_Exprs_s30 = C_Exprs_s30 type T_Exprs_v28 = (T_Exprs_vIn28 ) -> (T_Exprs_vOut28 ) data T_Exprs_vIn28 = T_Exprs_vIn28 (Bool) (Options) (String) data T_Exprs_vOut28 = T_Exprs_vOut28 (PP_Docs) {-# NOINLINE sem_Exprs_Cons #-} sem_Exprs_Cons :: T_Expr -> T_Exprs -> T_Exprs sem_Exprs_Cons arg_hd_ arg_tl_ = T_Exprs (return st29) where {-# NOINLINE st29 #-} !st29 = let v28 :: T_Exprs_v28 v28 = \ !(T_Exprs_vIn28 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _hdX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_hd_)) _tlX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_tl_)) (T_Expr_vOut25 _hdIpp) = inv_Expr_s26 _hdX26 (T_Expr_vIn25 _hdOnested _hdOoptions _hdOoutputfile) (T_Exprs_vOut28 _tlIpps) = inv_Exprs_s29 _tlX29 (T_Exprs_vIn28 _tlOnested _tlOoptions _tlOoutputfile) _lhsOpps :: PP_Docs _lhsOpps = rule249 _hdIpp _tlIpps _hdOnested = rule250 _lhsInested _hdOoptions = rule251 _lhsIoptions _hdOoutputfile = rule252 _lhsIoutputfile _tlOnested = rule253 _lhsInested _tlOoptions = rule254 _lhsIoptions _tlOoutputfile = rule255 _lhsIoutputfile !__result_ = T_Exprs_vOut28 _lhsOpps in __result_ ) in C_Exprs_s29 v28 {-# INLINE rule249 #-} {-# LINE 64 "src-ag/PrintCode.ag" #-} rule249 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 64 "src-ag/PrintCode.ag" #-} _hdIpp : _tlIpps {-# LINE 2313 "dist/build/PrintCode.hs"#-} {-# INLINE rule250 #-} rule250 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule251 #-} rule251 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule252 #-} rule252 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule253 #-} rule253 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule254 #-} rule254 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule255 #-} rule255 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Exprs_Nil #-} sem_Exprs_Nil :: T_Exprs sem_Exprs_Nil = T_Exprs (return st29) where {-# NOINLINE st29 #-} !st29 = let v28 :: T_Exprs_v28 v28 = \ !(T_Exprs_vIn28 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule256 () !__result_ = T_Exprs_vOut28 _lhsOpps in __result_ ) in C_Exprs_s29 v28 {-# INLINE rule256 #-} {-# LINE 65 "src-ag/PrintCode.ag" #-} rule256 = \ (_ :: ()) -> {-# LINE 65 "src-ag/PrintCode.ag" #-} [] {-# LINE 2349 "dist/build/PrintCode.hs"#-} -- Lhs --------------------------------------------------------- -- wrapper data Inh_Lhs = Inh_Lhs { isDeclOfLet_Inh_Lhs :: !(Bool), nested_Inh_Lhs :: !(Bool), options_Inh_Lhs :: !(Options), outputfile_Inh_Lhs :: !(String) } data Syn_Lhs = Syn_Lhs { pp_Syn_Lhs :: !(PP_Doc) } {-# INLINABLE wrap_Lhs #-} wrap_Lhs :: T_Lhs -> Inh_Lhs -> (Syn_Lhs ) wrap_Lhs !(T_Lhs act) !(Inh_Lhs _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg31 = T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile !(T_Lhs_vOut31 _lhsOpp) <- return (inv_Lhs_s32 sem arg31) return (Syn_Lhs _lhsOpp) ) -- cata {-# NOINLINE sem_Lhs #-} sem_Lhs :: Lhs -> T_Lhs sem_Lhs ( Pattern3 pat3_ ) = sem_Lhs_Pattern3 ( sem_Pattern pat3_ ) sem_Lhs ( Pattern3SM pat3_ ) = sem_Lhs_Pattern3SM ( sem_Pattern pat3_ ) sem_Lhs ( TupleLhs !comps_ ) = sem_Lhs_TupleLhs comps_ sem_Lhs ( UnboxedTupleLhs !comps_ ) = sem_Lhs_UnboxedTupleLhs comps_ sem_Lhs ( Fun !name_ args_ ) = sem_Lhs_Fun name_ ( sem_Exprs args_ ) sem_Lhs ( Unwrap !name_ sub_ ) = sem_Lhs_Unwrap name_ ( sem_Lhs sub_ ) -- semantic domain newtype T_Lhs = T_Lhs { attach_T_Lhs :: Identity (T_Lhs_s32 ) } newtype T_Lhs_s32 = C_Lhs_s32 { inv_Lhs_s32 :: (T_Lhs_v31 ) } data T_Lhs_s33 = C_Lhs_s33 type T_Lhs_v31 = (T_Lhs_vIn31 ) -> (T_Lhs_vOut31 ) data T_Lhs_vIn31 = T_Lhs_vIn31 (Bool) (Bool) (Options) (String) data T_Lhs_vOut31 = T_Lhs_vOut31 (PP_Doc) {-# NOINLINE sem_Lhs_Pattern3 #-} sem_Lhs_Pattern3 :: T_Pattern -> T_Lhs sem_Lhs_Pattern3 arg_pat3_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _pat3X41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat3_)) (T_Pattern_vOut40 _pat3Icopy _pat3IisUnderscore _pat3Ipp _pat3Ipp' _pat3IstrictVars) = inv_Pattern_s41 _pat3X41 (T_Pattern_vIn40 _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions) _addStrictGuard = rule257 _hasStrictVars _lhsIoptions _strictGuard _strictGuard = rule258 _pat3IstrictVars _hasStrictVars = rule259 _pat3IstrictVars _lhsOpp :: PP_Doc _lhsOpp = rule260 _addStrictGuard _pat3Ipp _pat3ObelowIrrefutable = rule261 () _pat3OisDeclOfLet = rule262 _lhsIisDeclOfLet _pat3Ooptions = rule263 _lhsIoptions !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule257 #-} {-# LINE 231 "src-ag/PrintCode.ag" #-} rule257 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> {-# LINE 231 "src-ag/PrintCode.ag" #-} if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id {-# LINE 2411 "dist/build/PrintCode.hs"#-} {-# INLINE rule258 #-} {-# LINE 233 "src-ag/PrintCode.ag" #-} rule258 = \ ((_pat3IstrictVars) :: [PP_Doc]) -> {-# LINE 233 "src-ag/PrintCode.ag" #-} _pat3IstrictVars `ppMultiSeqH` (pp "True") {-# LINE 2417 "dist/build/PrintCode.hs"#-} {-# INLINE rule259 #-} {-# LINE 234 "src-ag/PrintCode.ag" #-} rule259 = \ ((_pat3IstrictVars) :: [PP_Doc]) -> {-# LINE 234 "src-ag/PrintCode.ag" #-} not (null _pat3IstrictVars) {-# LINE 2423 "dist/build/PrintCode.hs"#-} {-# INLINE rule260 #-} {-# LINE 251 "src-ag/PrintCode.ag" #-} rule260 = \ _addStrictGuard ((_pat3Ipp) :: PP_Doc) -> {-# LINE 251 "src-ag/PrintCode.ag" #-} _addStrictGuard _pat3Ipp {-# LINE 2429 "dist/build/PrintCode.hs"#-} {-# INLINE rule261 #-} {-# LINE 385 "src-ag/PrintCode.ag" #-} rule261 = \ (_ :: ()) -> {-# LINE 385 "src-ag/PrintCode.ag" #-} False {-# LINE 2435 "dist/build/PrintCode.hs"#-} {-# INLINE rule262 #-} rule262 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule263 #-} rule263 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Lhs_Pattern3SM #-} sem_Lhs_Pattern3SM :: T_Pattern -> T_Lhs sem_Lhs_Pattern3SM arg_pat3_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _pat3X41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat3_)) (T_Pattern_vOut40 _pat3Icopy _pat3IisUnderscore _pat3Ipp _pat3Ipp' _pat3IstrictVars) = inv_Pattern_s41 _pat3X41 (T_Pattern_vIn40 _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions) _lhsOpp :: PP_Doc _lhsOpp = rule264 _pat3Ipp' _pat3ObelowIrrefutable = rule265 () _pat3OisDeclOfLet = rule266 _lhsIisDeclOfLet _pat3Ooptions = rule267 _lhsIoptions !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule264 #-} {-# LINE 252 "src-ag/PrintCode.ag" #-} rule264 = \ ((_pat3Ipp') :: PP_Doc) -> {-# LINE 252 "src-ag/PrintCode.ag" #-} _pat3Ipp' {-# LINE 2464 "dist/build/PrintCode.hs"#-} {-# INLINE rule265 #-} {-# LINE 385 "src-ag/PrintCode.ag" #-} rule265 = \ (_ :: ()) -> {-# LINE 385 "src-ag/PrintCode.ag" #-} False {-# LINE 2470 "dist/build/PrintCode.hs"#-} {-# INLINE rule266 #-} rule266 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule267 #-} rule267 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Lhs_TupleLhs #-} sem_Lhs_TupleLhs :: ([String]) -> T_Lhs sem_Lhs_TupleLhs !arg_comps_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _addStrictGuard = rule268 _hasStrictVars _lhsIoptions _strictGuard _strictGuard = rule269 _lhsIisDeclOfLet _lhsIoptions arg_comps_ _hasStrictVars = rule270 arg_comps_ _addBang = rule271 _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule272 _addBang _addStrictGuard _lhsInested arg_comps_ !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule268 #-} {-# LINE 231 "src-ag/PrintCode.ag" #-} rule268 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> {-# LINE 231 "src-ag/PrintCode.ag" #-} if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id {-# LINE 2498 "dist/build/PrintCode.hs"#-} {-# INLINE rule269 #-} {-# LINE 236 "src-ag/PrintCode.ag" #-} rule269 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) comps_ -> {-# LINE 236 "src-ag/PrintCode.ag" #-} if stricterCases _lhsIoptions && not _lhsIisDeclOfLet then map text comps_ `ppMultiSeqH` (pp "True") else pp "True" {-# LINE 2506 "dist/build/PrintCode.hs"#-} {-# INLINE rule270 #-} {-# LINE 239 "src-ag/PrintCode.ag" #-} rule270 = \ comps_ -> {-# LINE 239 "src-ag/PrintCode.ag" #-} not (null comps_) {-# LINE 2512 "dist/build/PrintCode.hs"#-} {-# INLINE rule271 #-} {-# LINE 247 "src-ag/PrintCode.ag" #-} rule271 = \ ((_lhsIoptions) :: Options) -> {-# LINE 247 "src-ag/PrintCode.ag" #-} if bangpats _lhsIoptions then \p -> "!" >|< p else id {-# LINE 2520 "dist/build/PrintCode.hs"#-} {-# INLINE rule272 #-} {-# LINE 253 "src-ag/PrintCode.ag" #-} rule272 = \ _addBang _addStrictGuard ((_lhsInested) :: Bool) comps_ -> {-# LINE 253 "src-ag/PrintCode.ag" #-} _addStrictGuard $ ppTuple _lhsInested (map (_addBang . text) comps_) {-# LINE 2526 "dist/build/PrintCode.hs"#-} {-# NOINLINE sem_Lhs_UnboxedTupleLhs #-} sem_Lhs_UnboxedTupleLhs :: ([String]) -> T_Lhs sem_Lhs_UnboxedTupleLhs !arg_comps_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _addStrictGuard = rule273 _hasStrictVars _lhsIoptions _strictGuard _strictGuard = rule274 _lhsIisDeclOfLet _lhsIoptions arg_comps_ _hasStrictVars = rule275 arg_comps_ _addBang = rule276 _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule277 _addBang _addStrictGuard _lhsInested arg_comps_ !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule273 #-} {-# LINE 231 "src-ag/PrintCode.ag" #-} rule273 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> {-# LINE 231 "src-ag/PrintCode.ag" #-} if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id {-# LINE 2548 "dist/build/PrintCode.hs"#-} {-# INLINE rule274 #-} {-# LINE 236 "src-ag/PrintCode.ag" #-} rule274 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) comps_ -> {-# LINE 236 "src-ag/PrintCode.ag" #-} if stricterCases _lhsIoptions && not _lhsIisDeclOfLet then map text comps_ `ppMultiSeqH` (pp "True") else pp "True" {-# LINE 2556 "dist/build/PrintCode.hs"#-} {-# INLINE rule275 #-} {-# LINE 239 "src-ag/PrintCode.ag" #-} rule275 = \ comps_ -> {-# LINE 239 "src-ag/PrintCode.ag" #-} not (null comps_) {-# LINE 2562 "dist/build/PrintCode.hs"#-} {-# INLINE rule276 #-} {-# LINE 247 "src-ag/PrintCode.ag" #-} rule276 = \ ((_lhsIoptions) :: Options) -> {-# LINE 247 "src-ag/PrintCode.ag" #-} if bangpats _lhsIoptions then \p -> "!" >|< p else id {-# LINE 2570 "dist/build/PrintCode.hs"#-} {-# INLINE rule277 #-} {-# LINE 254 "src-ag/PrintCode.ag" #-} rule277 = \ _addBang _addStrictGuard ((_lhsInested) :: Bool) comps_ -> {-# LINE 254 "src-ag/PrintCode.ag" #-} _addStrictGuard $ ppUnboxedTuple _lhsInested (map (_addBang . text) comps_) {-# LINE 2576 "dist/build/PrintCode.hs"#-} {-# NOINLINE sem_Lhs_Fun #-} sem_Lhs_Fun :: (String) -> T_Exprs -> T_Lhs sem_Lhs_Fun !arg_name_ arg_args_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _argsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_args_)) (T_Exprs_vOut28 _argsIpps) = inv_Exprs_s29 _argsX29 (T_Exprs_vIn28 _argsOnested _argsOoptions _argsOoutputfile) _addStrictGuard = rule278 _hasStrictVars _lhsIoptions _strictGuard _hasStrictVars = rule279 _argsIpps _strictGuard = rule280 _argsIpps _addBang = rule281 _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule282 _addBang _addStrictGuard _argsIpps arg_name_ _argsOnested = rule283 _lhsInested _argsOoptions = rule284 _lhsIoptions _argsOoutputfile = rule285 _lhsIoutputfile !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule278 #-} {-# LINE 242 "src-ag/PrintCode.ag" #-} rule278 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> {-# LINE 242 "src-ag/PrintCode.ag" #-} if strictSems _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id {-# LINE 2603 "dist/build/PrintCode.hs"#-} {-# INLINE rule279 #-} {-# LINE 243 "src-ag/PrintCode.ag" #-} rule279 = \ ((_argsIpps) :: PP_Docs) -> {-# LINE 243 "src-ag/PrintCode.ag" #-} not (null _argsIpps) {-# LINE 2609 "dist/build/PrintCode.hs"#-} {-# INLINE rule280 #-} {-# LINE 244 "src-ag/PrintCode.ag" #-} rule280 = \ ((_argsIpps) :: PP_Docs) -> {-# LINE 244 "src-ag/PrintCode.ag" #-} _argsIpps `ppMultiSeqH` (pp "True") {-# LINE 2615 "dist/build/PrintCode.hs"#-} {-# INLINE rule281 #-} {-# LINE 247 "src-ag/PrintCode.ag" #-} rule281 = \ ((_lhsIoptions) :: Options) -> {-# LINE 247 "src-ag/PrintCode.ag" #-} if bangpats _lhsIoptions then \p -> "!" >|< p else id {-# LINE 2623 "dist/build/PrintCode.hs"#-} {-# INLINE rule282 #-} {-# LINE 255 "src-ag/PrintCode.ag" #-} rule282 = \ _addBang _addStrictGuard ((_argsIpps) :: PP_Docs) name_ -> {-# LINE 255 "src-ag/PrintCode.ag" #-} _addStrictGuard (name_ >#< hv_sp (map _addBang _argsIpps)) {-# LINE 2629 "dist/build/PrintCode.hs"#-} {-# INLINE rule283 #-} rule283 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule284 #-} rule284 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule285 #-} rule285 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Lhs_Unwrap #-} sem_Lhs_Unwrap :: (String) -> T_Lhs -> T_Lhs sem_Lhs_Unwrap !arg_name_ arg_sub_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _subX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_sub_)) (T_Lhs_vOut31 _subIpp) = inv_Lhs_s32 _subX32 (T_Lhs_vIn31 _subOisDeclOfLet _subOnested _subOoptions _subOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule286 _subIpp arg_name_ _subOisDeclOfLet = rule287 _lhsIisDeclOfLet _subOnested = rule288 _lhsInested _subOoptions = rule289 _lhsIoptions _subOoutputfile = rule290 _lhsIoutputfile !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule286 #-} {-# LINE 256 "src-ag/PrintCode.ag" #-} rule286 = \ ((_subIpp) :: PP_Doc) name_ -> {-# LINE 256 "src-ag/PrintCode.ag" #-} pp_parens (name_ >#< _subIpp) {-# LINE 2662 "dist/build/PrintCode.hs"#-} {-# INLINE rule287 #-} rule287 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule288 #-} rule288 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule289 #-} rule289 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule290 #-} rule290 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile -- NamedType --------------------------------------------------- -- wrapper data Inh_NamedType = Inh_NamedType { nested_Inh_NamedType :: !(Bool) } data Syn_NamedType = Syn_NamedType { pp_Syn_NamedType :: !(PP_Doc) } {-# INLINABLE wrap_NamedType #-} wrap_NamedType :: T_NamedType -> Inh_NamedType -> (Syn_NamedType ) wrap_NamedType !(T_NamedType act) !(Inh_NamedType _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg34 = T_NamedType_vIn34 _lhsInested !(T_NamedType_vOut34 _lhsOpp) <- return (inv_NamedType_s35 sem arg34) return (Syn_NamedType _lhsOpp) ) -- cata {-# INLINE sem_NamedType #-} sem_NamedType :: NamedType -> T_NamedType sem_NamedType ( Named !strict_ !name_ tp_ ) = sem_NamedType_Named strict_ name_ ( sem_Type tp_ ) -- semantic domain newtype T_NamedType = T_NamedType { attach_T_NamedType :: Identity (T_NamedType_s35 ) } newtype T_NamedType_s35 = C_NamedType_s35 { inv_NamedType_s35 :: (T_NamedType_v34 ) } data T_NamedType_s36 = C_NamedType_s36 type T_NamedType_v34 = (T_NamedType_vIn34 ) -> (T_NamedType_vOut34 ) data T_NamedType_vIn34 = T_NamedType_vIn34 (Bool) data T_NamedType_vOut34 = T_NamedType_vOut34 (PP_Doc) {-# NOINLINE sem_NamedType_Named #-} sem_NamedType_Named :: (Bool) -> (String) -> T_Type -> T_NamedType sem_NamedType_Named !arg_strict_ !arg_name_ arg_tp_ = T_NamedType (return st35) where {-# NOINLINE st35 #-} !st35 = let v34 :: T_NamedType_v34 v34 = \ !(T_NamedType_vIn34 _lhsInested) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOpp :: PP_Doc _lhsOpp = rule291 _tpIpp arg_name_ arg_strict_ _tpOnested = rule292 _lhsInested !__result_ = T_NamedType_vOut34 _lhsOpp in __result_ ) in C_NamedType_s35 v34 {-# INLINE rule291 #-} {-# LINE 225 "src-ag/PrintCode.ag" #-} rule291 = \ ((_tpIpp) :: PP_Doc) name_ strict_ -> {-# LINE 225 "src-ag/PrintCode.ag" #-} if strict_ then name_ >#< "::" >#< "!" >|< pp_parens _tpIpp else name_ >#< "::" >#< _tpIpp {-# LINE 2728 "dist/build/PrintCode.hs"#-} {-# INLINE rule292 #-} rule292 = \ ((_lhsInested) :: Bool) -> _lhsInested -- NamedTypes -------------------------------------------------- -- wrapper data Inh_NamedTypes = Inh_NamedTypes { nested_Inh_NamedTypes :: !(Bool) } data Syn_NamedTypes = Syn_NamedTypes { pps_Syn_NamedTypes :: !(PP_Docs) } {-# INLINABLE wrap_NamedTypes #-} wrap_NamedTypes :: T_NamedTypes -> Inh_NamedTypes -> (Syn_NamedTypes ) wrap_NamedTypes !(T_NamedTypes act) !(Inh_NamedTypes _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg37 = T_NamedTypes_vIn37 _lhsInested !(T_NamedTypes_vOut37 _lhsOpps) <- return (inv_NamedTypes_s38 sem arg37) return (Syn_NamedTypes _lhsOpps) ) -- cata {-# NOINLINE sem_NamedTypes #-} sem_NamedTypes :: NamedTypes -> T_NamedTypes sem_NamedTypes list = Prelude.foldr sem_NamedTypes_Cons sem_NamedTypes_Nil (Prelude.map sem_NamedType list) -- semantic domain newtype T_NamedTypes = T_NamedTypes { attach_T_NamedTypes :: Identity (T_NamedTypes_s38 ) } newtype T_NamedTypes_s38 = C_NamedTypes_s38 { inv_NamedTypes_s38 :: (T_NamedTypes_v37 ) } data T_NamedTypes_s39 = C_NamedTypes_s39 type T_NamedTypes_v37 = (T_NamedTypes_vIn37 ) -> (T_NamedTypes_vOut37 ) data T_NamedTypes_vIn37 = T_NamedTypes_vIn37 (Bool) data T_NamedTypes_vOut37 = T_NamedTypes_vOut37 (PP_Docs) {-# NOINLINE sem_NamedTypes_Cons #-} sem_NamedTypes_Cons :: T_NamedType -> T_NamedTypes -> T_NamedTypes sem_NamedTypes_Cons arg_hd_ arg_tl_ = T_NamedTypes (return st38) where {-# NOINLINE st38 #-} !st38 = let v37 :: T_NamedTypes_v37 v37 = \ !(T_NamedTypes_vIn37 _lhsInested) -> ( let _hdX35 = Control.Monad.Identity.runIdentity (attach_T_NamedType (arg_hd_)) _tlX38 = Control.Monad.Identity.runIdentity (attach_T_NamedTypes (arg_tl_)) (T_NamedType_vOut34 _hdIpp) = inv_NamedType_s35 _hdX35 (T_NamedType_vIn34 _hdOnested) (T_NamedTypes_vOut37 _tlIpps) = inv_NamedTypes_s38 _tlX38 (T_NamedTypes_vIn37 _tlOnested) _lhsOpps :: PP_Docs _lhsOpps = rule293 _hdIpp _tlIpps _hdOnested = rule294 _lhsInested _tlOnested = rule295 _lhsInested !__result_ = T_NamedTypes_vOut37 _lhsOpps in __result_ ) in C_NamedTypes_s38 v37 {-# INLINE rule293 #-} {-# LINE 80 "src-ag/PrintCode.ag" #-} rule293 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 80 "src-ag/PrintCode.ag" #-} _hdIpp : _tlIpps {-# LINE 2786 "dist/build/PrintCode.hs"#-} {-# INLINE rule294 #-} rule294 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule295 #-} rule295 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_NamedTypes_Nil #-} sem_NamedTypes_Nil :: T_NamedTypes sem_NamedTypes_Nil = T_NamedTypes (return st38) where {-# NOINLINE st38 #-} !st38 = let v37 :: T_NamedTypes_v37 v37 = \ !(T_NamedTypes_vIn37 _lhsInested) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule296 () !__result_ = T_NamedTypes_vOut37 _lhsOpps in __result_ ) in C_NamedTypes_s38 v37 {-# INLINE rule296 #-} {-# LINE 81 "src-ag/PrintCode.ag" #-} rule296 = \ (_ :: ()) -> {-# LINE 81 "src-ag/PrintCode.ag" #-} [] {-# LINE 2810 "dist/build/PrintCode.hs"#-} -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { belowIrrefutable_Inh_Pattern :: !(Bool), isDeclOfLet_Inh_Pattern :: !(Bool), options_Inh_Pattern :: !(Options) } data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: !(Pattern), isUnderscore_Syn_Pattern :: !(Bool), pp_Syn_Pattern :: !(PP_Doc), pp'_Syn_Pattern :: !(PP_Doc), strictVars_Syn_Pattern :: !([PP_Doc]) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern !(T_Pattern act) !(Inh_Pattern _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg40 = T_Pattern_vIn40 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions !(T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars) <- return (inv_Pattern_s41 sem arg40) return (Syn_Pattern _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr !name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product !pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias !field_ !attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore !pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s41 ) } newtype T_Pattern_s41 = C_Pattern_s41 { inv_Pattern_s41 :: (T_Pattern_v40 ) } data T_Pattern_s42 = C_Pattern_s42 type T_Pattern_v40 = (T_Pattern_vIn40 ) -> (T_Pattern_vOut40 ) data T_Pattern_vIn40 = T_Pattern_vIn40 (Bool) (Bool) (Options) data T_Pattern_vOut40 = T_Pattern_vOut40 (Pattern) (Bool) (PP_Doc) (PP_Doc) ([PP_Doc]) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr !arg_name_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} !st41 = let v40 :: T_Pattern_v40 v40 = \ !(T_Pattern_vIn40 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIcopy _patsIpps _patsIpps' _patsIstrictVars) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions) _addBang = rule297 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule298 _addBang _patsIpps arg_name_ _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule299 () _lhsOpp' :: PP_Doc _lhsOpp' = rule300 _patsIpps' arg_name_ _lhsOstrictVars :: [PP_Doc] _lhsOstrictVars = rule301 _patsIstrictVars _copy = rule302 _patsIcopy arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule303 _copy _patsObelowIrrefutable = rule304 _lhsIbelowIrrefutable _patsOisDeclOfLet = rule305 _lhsIisDeclOfLet _patsOoptions = rule306 _lhsIoptions !__result_ = T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule297 #-} {-# LINE 357 "src-ag/PrintCode.ag" #-} rule297 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) -> {-# LINE 357 "src-ag/PrintCode.ag" #-} if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable then \p -> "!" >|< p else id {-# LINE 2880 "dist/build/PrintCode.hs"#-} {-# INLINE rule298 #-} {-# LINE 362 "src-ag/PrintCode.ag" #-} rule298 = \ _addBang ((_patsIpps) :: [PP_Doc]) name_ -> {-# LINE 362 "src-ag/PrintCode.ag" #-} _addBang $ pp_parens $ name_ >#< hv_sp _patsIpps {-# LINE 2886 "dist/build/PrintCode.hs"#-} {-# INLINE rule299 #-} {-# LINE 373 "src-ag/PrintCode.ag" #-} rule299 = \ (_ :: ()) -> {-# LINE 373 "src-ag/PrintCode.ag" #-} False {-# LINE 2892 "dist/build/PrintCode.hs"#-} {-# INLINE rule300 #-} {-# LINE 396 "src-ag/PrintCode.ag" #-} rule300 = \ ((_patsIpps') :: [PP_Doc]) name_ -> {-# LINE 396 "src-ag/PrintCode.ag" #-} pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps') {-# LINE 2898 "dist/build/PrintCode.hs"#-} {-# INLINE rule301 #-} rule301 = \ ((_patsIstrictVars) :: [PP_Doc]) -> _patsIstrictVars {-# INLINE rule302 #-} rule302 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule303 #-} rule303 = \ _copy -> _copy {-# INLINE rule304 #-} rule304 = \ ((_lhsIbelowIrrefutable) :: Bool) -> _lhsIbelowIrrefutable {-# INLINE rule305 #-} rule305 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule306 #-} rule306 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product !arg_pos_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} !st41 = let v40 :: T_Pattern_v40 v40 = \ !(T_Pattern_vIn40 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIcopy _patsIpps _patsIpps' _patsIstrictVars) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions) _addBang = rule307 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule308 _addBang _patsIpps _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule309 () _lhsOpp' :: PP_Doc _lhsOpp' = rule310 _patsIpps' _lhsOstrictVars :: [PP_Doc] _lhsOstrictVars = rule311 _patsIstrictVars _copy = rule312 _patsIcopy arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule313 _copy _patsObelowIrrefutable = rule314 _lhsIbelowIrrefutable _patsOisDeclOfLet = rule315 _lhsIisDeclOfLet _patsOoptions = rule316 _lhsIoptions !__result_ = T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule307 #-} {-# LINE 357 "src-ag/PrintCode.ag" #-} rule307 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) -> {-# LINE 357 "src-ag/PrintCode.ag" #-} if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable then \p -> "!" >|< p else id {-# LINE 2951 "dist/build/PrintCode.hs"#-} {-# INLINE rule308 #-} {-# LINE 363 "src-ag/PrintCode.ag" #-} rule308 = \ _addBang ((_patsIpps) :: [PP_Doc]) -> {-# LINE 363 "src-ag/PrintCode.ag" #-} _addBang $ pp_block "(" ")" "," _patsIpps {-# LINE 2957 "dist/build/PrintCode.hs"#-} {-# INLINE rule309 #-} {-# LINE 374 "src-ag/PrintCode.ag" #-} rule309 = \ (_ :: ()) -> {-# LINE 374 "src-ag/PrintCode.ag" #-} False {-# LINE 2963 "dist/build/PrintCode.hs"#-} {-# INLINE rule310 #-} {-# LINE 397 "src-ag/PrintCode.ag" #-} rule310 = \ ((_patsIpps') :: [PP_Doc]) -> {-# LINE 397 "src-ag/PrintCode.ag" #-} pp_block "(" ")" "," _patsIpps' {-# LINE 2969 "dist/build/PrintCode.hs"#-} {-# INLINE rule311 #-} rule311 = \ ((_patsIstrictVars) :: [PP_Doc]) -> _patsIstrictVars {-# INLINE rule312 #-} rule312 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule313 #-} rule313 = \ _copy -> _copy {-# INLINE rule314 #-} rule314 = \ ((_lhsIbelowIrrefutable) :: Bool) -> _lhsIbelowIrrefutable {-# INLINE rule315 #-} rule315 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule316 #-} rule316 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias !arg_field_ !arg_attr_ arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} !st41 = let v40 :: T_Pattern_v40 v40 = \ !(T_Pattern_vIn40 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIcopy _patIisUnderscore _patIpp _patIpp' _patIstrictVars) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 _patObelowIrrefutable _patOisDeclOfLet _patOoptions) _strictVar = rule317 _lhsIisDeclOfLet _lhsIoptions _ppVar _strictPatVars = rule318 _lhsIisDeclOfLet _lhsIoptions _patIstrictVars _lhsOstrictVars :: [PP_Doc] _lhsOstrictVars = rule319 _strictPatVars _strictVar _addBang = rule320 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions _ppVar = rule321 _lhsIoptions arg_attr_ arg_field_ _ppVarBang = rule322 _addBang _ppVar _lhsOpp :: PP_Doc _lhsOpp = rule323 _patIisUnderscore _patIpp _ppVarBang _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule324 () _lhsOpp' :: PP_Doc _lhsOpp' = rule325 _lhsIoptions _patIpp' arg_attr_ arg_field_ _copy = rule326 _patIcopy arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule327 _copy _patObelowIrrefutable = rule328 _lhsIbelowIrrefutable _patOisDeclOfLet = rule329 _lhsIisDeclOfLet _patOoptions = rule330 _lhsIoptions !__result_ = T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule317 #-} {-# LINE 335 "src-ag/PrintCode.ag" #-} rule317 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) _ppVar -> {-# LINE 335 "src-ag/PrintCode.ag" #-} if strictCases _lhsIoptions && not _lhsIisDeclOfLet then [_ppVar ] else [] {-# LINE 3026 "dist/build/PrintCode.hs"#-} {-# INLINE rule318 #-} {-# LINE 339 "src-ag/PrintCode.ag" #-} rule318 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) ((_patIstrictVars) :: [PP_Doc]) -> {-# LINE 339 "src-ag/PrintCode.ag" #-} if stricterCases _lhsIoptions && not _lhsIisDeclOfLet then _patIstrictVars else [] {-# LINE 3034 "dist/build/PrintCode.hs"#-} {-# INLINE rule319 #-} {-# LINE 343 "src-ag/PrintCode.ag" #-} rule319 = \ _strictPatVars _strictVar -> {-# LINE 343 "src-ag/PrintCode.ag" #-} _strictVar ++ _strictPatVars {-# LINE 3040 "dist/build/PrintCode.hs"#-} {-# INLINE rule320 #-} {-# LINE 357 "src-ag/PrintCode.ag" #-} rule320 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) -> {-# LINE 357 "src-ag/PrintCode.ag" #-} if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable then \p -> "!" >|< p else id {-# LINE 3048 "dist/build/PrintCode.hs"#-} {-# INLINE rule321 #-} {-# LINE 364 "src-ag/PrintCode.ag" #-} rule321 = \ ((_lhsIoptions) :: Options) attr_ field_ -> {-# LINE 364 "src-ag/PrintCode.ag" #-} pp (attrname _lhsIoptions False field_ attr_) {-# LINE 3054 "dist/build/PrintCode.hs"#-} {-# INLINE rule322 #-} {-# LINE 365 "src-ag/PrintCode.ag" #-} rule322 = \ _addBang _ppVar -> {-# LINE 365 "src-ag/PrintCode.ag" #-} _addBang $ _ppVar {-# LINE 3060 "dist/build/PrintCode.hs"#-} {-# INLINE rule323 #-} {-# LINE 366 "src-ag/PrintCode.ag" #-} rule323 = \ ((_patIisUnderscore) :: Bool) ((_patIpp) :: PP_Doc) _ppVarBang -> {-# LINE 366 "src-ag/PrintCode.ag" #-} if _patIisUnderscore then _ppVarBang else _ppVarBang >|< "@" >|< _patIpp {-# LINE 3068 "dist/build/PrintCode.hs"#-} {-# INLINE rule324 #-} {-# LINE 375 "src-ag/PrintCode.ag" #-} rule324 = \ (_ :: ()) -> {-# LINE 375 "src-ag/PrintCode.ag" #-} False {-# LINE 3074 "dist/build/PrintCode.hs"#-} {-# INLINE rule325 #-} {-# LINE 398 "src-ag/PrintCode.ag" #-} rule325 = \ ((_lhsIoptions) :: Options) ((_patIpp') :: PP_Doc) attr_ field_ -> {-# LINE 398 "src-ag/PrintCode.ag" #-} let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_ | otherwise = attrname _lhsIoptions False field_ attr_ in attribute >|< "@" >|< _patIpp' {-# LINE 3082 "dist/build/PrintCode.hs"#-} {-# INLINE rule326 #-} rule326 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule327 #-} rule327 = \ _copy -> _copy {-# INLINE rule328 #-} rule328 = \ ((_lhsIbelowIrrefutable) :: Bool) -> _lhsIbelowIrrefutable {-# INLINE rule329 #-} rule329 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule330 #-} rule330 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} !st41 = let v40 :: T_Pattern_v40 v40 = \ !(T_Pattern_vIn40 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIcopy _patIisUnderscore _patIpp _patIpp' _patIstrictVars) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 _patObelowIrrefutable _patOisDeclOfLet _patOoptions) _lhsOstrictVars :: [PP_Doc] _lhsOstrictVars = rule331 () _lhsOpp :: PP_Doc _lhsOpp = rule332 _patIpp _patObelowIrrefutable = rule333 () _lhsOpp' :: PP_Doc _lhsOpp' = rule334 _patIpp _copy = rule335 _patIcopy _lhsOcopy :: Pattern _lhsOcopy = rule336 _copy _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule337 _patIisUnderscore _patOisDeclOfLet = rule338 _lhsIisDeclOfLet _patOoptions = rule339 _lhsIoptions !__result_ = T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule331 #-} {-# LINE 345 "src-ag/PrintCode.ag" #-} rule331 = \ (_ :: ()) -> {-# LINE 345 "src-ag/PrintCode.ag" #-} [] {-# LINE 3129 "dist/build/PrintCode.hs"#-} {-# INLINE rule332 #-} {-# LINE 369 "src-ag/PrintCode.ag" #-} rule332 = \ ((_patIpp) :: PP_Doc) -> {-# LINE 369 "src-ag/PrintCode.ag" #-} text "~" >|< pp_parens _patIpp {-# LINE 3135 "dist/build/PrintCode.hs"#-} {-# INLINE rule333 #-} {-# LINE 381 "src-ag/PrintCode.ag" #-} rule333 = \ (_ :: ()) -> {-# LINE 381 "src-ag/PrintCode.ag" #-} True {-# LINE 3141 "dist/build/PrintCode.hs"#-} {-# INLINE rule334 #-} {-# LINE 401 "src-ag/PrintCode.ag" #-} rule334 = \ ((_patIpp) :: PP_Doc) -> {-# LINE 401 "src-ag/PrintCode.ag" #-} text "~" >|< pp_parens _patIpp {-# LINE 3147 "dist/build/PrintCode.hs"#-} {-# INLINE rule335 #-} rule335 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule336 #-} rule336 = \ _copy -> _copy {-# INLINE rule337 #-} rule337 = \ ((_patIisUnderscore) :: Bool) -> _patIisUnderscore {-# INLINE rule338 #-} rule338 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule339 #-} rule339 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore !arg_pos_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} !st41 = let v40 :: T_Pattern_v40 v40 = \ !(T_Pattern_vIn40 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule340 () _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule341 () _lhsOpp' :: PP_Doc _lhsOpp' = rule342 () _lhsOstrictVars :: [PP_Doc] _lhsOstrictVars = rule343 () _copy = rule344 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule345 _copy !__result_ = T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule340 #-} {-# LINE 370 "src-ag/PrintCode.ag" #-} rule340 = \ (_ :: ()) -> {-# LINE 370 "src-ag/PrintCode.ag" #-} text "_" {-# LINE 3189 "dist/build/PrintCode.hs"#-} {-# INLINE rule341 #-} {-# LINE 376 "src-ag/PrintCode.ag" #-} rule341 = \ (_ :: ()) -> {-# LINE 376 "src-ag/PrintCode.ag" #-} True {-# LINE 3195 "dist/build/PrintCode.hs"#-} {-# INLINE rule342 #-} {-# LINE 402 "src-ag/PrintCode.ag" #-} rule342 = \ (_ :: ()) -> {-# LINE 402 "src-ag/PrintCode.ag" #-} text "_" {-# LINE 3201 "dist/build/PrintCode.hs"#-} {-# INLINE rule343 #-} rule343 = \ (_ :: ()) -> [] {-# INLINE rule344 #-} rule344 = \ pos_ -> Underscore pos_ {-# INLINE rule345 #-} rule345 = \ _copy -> _copy -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { belowIrrefutable_Inh_Patterns :: !(Bool), isDeclOfLet_Inh_Patterns :: !(Bool), options_Inh_Patterns :: !(Options) } data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: !(Patterns), pps_Syn_Patterns :: !([PP_Doc]), pps'_Syn_Patterns :: !([PP_Doc]), strictVars_Syn_Patterns :: !([PP_Doc]) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns !(T_Patterns act) !(Inh_Patterns _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg43 = T_Patterns_vIn43 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions !(T_Patterns_vOut43 _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars) <- return (inv_Patterns_s44 sem arg43) return (Syn_Patterns _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s44 ) } newtype T_Patterns_s44 = C_Patterns_s44 { inv_Patterns_s44 :: (T_Patterns_v43 ) } data T_Patterns_s45 = C_Patterns_s45 type T_Patterns_v43 = (T_Patterns_vIn43 ) -> (T_Patterns_vOut43 ) data T_Patterns_vIn43 = T_Patterns_vIn43 (Bool) (Bool) (Options) data T_Patterns_vOut43 = T_Patterns_vOut43 (Patterns) ([PP_Doc]) ([PP_Doc]) ([PP_Doc]) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st44) where {-# NOINLINE st44 #-} !st44 = let v43 :: T_Patterns_v43 v43 = \ !(T_Patterns_vIn43 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) -> ( let _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut40 _hdIcopy _hdIisUnderscore _hdIpp _hdIpp' _hdIstrictVars) = inv_Pattern_s41 _hdX41 (T_Pattern_vIn40 _hdObelowIrrefutable _hdOisDeclOfLet _hdOoptions) (T_Patterns_vOut43 _tlIcopy _tlIpps _tlIpps' _tlIstrictVars) = inv_Patterns_s44 _tlX44 (T_Patterns_vIn43 _tlObelowIrrefutable _tlOisDeclOfLet _tlOoptions) _lhsOpps :: [PP_Doc] _lhsOpps = rule346 _hdIpp _tlIpps _lhsOpps' :: [PP_Doc] _lhsOpps' = rule347 _hdIpp' _tlIpps' _lhsOstrictVars :: [PP_Doc] _lhsOstrictVars = rule348 _hdIstrictVars _tlIstrictVars _copy = rule349 _hdIcopy _tlIcopy _lhsOcopy :: Patterns _lhsOcopy = rule350 _copy _hdObelowIrrefutable = rule351 _lhsIbelowIrrefutable _hdOisDeclOfLet = rule352 _lhsIisDeclOfLet _hdOoptions = rule353 _lhsIoptions _tlObelowIrrefutable = rule354 _lhsIbelowIrrefutable _tlOisDeclOfLet = rule355 _lhsIisDeclOfLet _tlOoptions = rule356 _lhsIoptions !__result_ = T_Patterns_vOut43 _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule346 #-} {-# LINE 352 "src-ag/PrintCode.ag" #-} rule346 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: [PP_Doc]) -> {-# LINE 352 "src-ag/PrintCode.ag" #-} _hdIpp : _tlIpps {-# LINE 3276 "dist/build/PrintCode.hs"#-} {-# INLINE rule347 #-} {-# LINE 392 "src-ag/PrintCode.ag" #-} rule347 = \ ((_hdIpp') :: PP_Doc) ((_tlIpps') :: [PP_Doc]) -> {-# LINE 392 "src-ag/PrintCode.ag" #-} _hdIpp' : _tlIpps' {-# LINE 3282 "dist/build/PrintCode.hs"#-} {-# INLINE rule348 #-} rule348 = \ ((_hdIstrictVars) :: [PP_Doc]) ((_tlIstrictVars) :: [PP_Doc]) -> _hdIstrictVars ++ _tlIstrictVars {-# INLINE rule349 #-} rule349 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule350 #-} rule350 = \ _copy -> _copy {-# INLINE rule351 #-} rule351 = \ ((_lhsIbelowIrrefutable) :: Bool) -> _lhsIbelowIrrefutable {-# INLINE rule352 #-} rule352 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule353 #-} rule353 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule354 #-} rule354 = \ ((_lhsIbelowIrrefutable) :: Bool) -> _lhsIbelowIrrefutable {-# INLINE rule355 #-} rule355 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule356 #-} rule356 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st44) where {-# NOINLINE st44 #-} !st44 = let v43 :: T_Patterns_v43 v43 = \ !(T_Patterns_vIn43 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) -> ( let _lhsOpps :: [PP_Doc] _lhsOpps = rule357 () _lhsOpps' :: [PP_Doc] _lhsOpps' = rule358 () _lhsOstrictVars :: [PP_Doc] _lhsOstrictVars = rule359 () _copy = rule360 () _lhsOcopy :: Patterns _lhsOcopy = rule361 _copy !__result_ = T_Patterns_vOut43 _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule357 #-} {-# LINE 353 "src-ag/PrintCode.ag" #-} rule357 = \ (_ :: ()) -> {-# LINE 353 "src-ag/PrintCode.ag" #-} [] {-# LINE 3334 "dist/build/PrintCode.hs"#-} {-# INLINE rule358 #-} {-# LINE 393 "src-ag/PrintCode.ag" #-} rule358 = \ (_ :: ()) -> {-# LINE 393 "src-ag/PrintCode.ag" #-} [] {-# LINE 3340 "dist/build/PrintCode.hs"#-} {-# INLINE rule359 #-} rule359 = \ (_ :: ()) -> [] {-# INLINE rule360 #-} rule360 = \ (_ :: ()) -> [] {-# INLINE rule361 #-} rule361 = \ _copy -> _copy -- Program ----------------------------------------------------- -- wrapper data Inh_Program = Inh_Program { importBlocks_Inh_Program :: !(PP_Doc), mainBlocksDoc_Inh_Program :: !(PP_Doc), mainFile_Inh_Program :: !(String), mainName_Inh_Program :: !(String), moduleHeader_Inh_Program :: !(String -> String -> String -> Bool -> String), options_Inh_Program :: !(Options), optionsLine_Inh_Program :: !(String), pragmaBlocks_Inh_Program :: !(String), textBlockMap_Inh_Program :: !(Map BlockInfo PP_Doc), textBlocks_Inh_Program :: !(PP_Doc) } data Syn_Program = Syn_Program { genIO_Syn_Program :: !(IO ()), output_Syn_Program :: !(PP_Docs) } {-# INLINABLE wrap_Program #-} wrap_Program :: T_Program -> Inh_Program -> (Syn_Program ) wrap_Program !(T_Program act) !(Inh_Program _lhsIimportBlocks _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg46 = T_Program_vIn46 _lhsIimportBlocks _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks !(T_Program_vOut46 _lhsOgenIO _lhsOoutput) <- return (inv_Program_s47 sem arg46) return (Syn_Program _lhsOgenIO _lhsOoutput) ) -- cata {-# INLINE sem_Program #-} sem_Program :: Program -> T_Program sem_Program ( Program chunks_ !ordered_ ) = sem_Program_Program ( sem_Chunks chunks_ ) ordered_ -- semantic domain newtype T_Program = T_Program { attach_T_Program :: Identity (T_Program_s47 ) } newtype T_Program_s47 = C_Program_s47 { inv_Program_s47 :: (T_Program_v46 ) } data T_Program_s48 = C_Program_s48 type T_Program_v46 = (T_Program_vIn46 ) -> (T_Program_vOut46 ) data T_Program_vIn46 = T_Program_vIn46 (PP_Doc) (PP_Doc) (String) (String) (String -> String -> String -> Bool -> String) (Options) (String) (String) (Map BlockInfo PP_Doc) (PP_Doc) data T_Program_vOut46 = T_Program_vOut46 (IO ()) (PP_Docs) {-# NOINLINE sem_Program_Program #-} sem_Program_Program :: T_Chunks -> (Bool) -> T_Program sem_Program_Program arg_chunks_ !arg_ordered_ = T_Program (return st47) where {-# NOINLINE st47 #-} !st47 = let v46 :: T_Program_v46 v46 = \ !(T_Program_vIn46 _lhsIimportBlocks _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) -> ( let _chunksX11 = Control.Monad.Identity.runIdentity (attach_T_Chunks (arg_chunks_)) (T_Chunks_vOut10 _chunksIappendCommon _chunksIappendMain _chunksIgenSems _chunksIimports _chunksIpps) = inv_Chunks_s11 _chunksX11 (T_Chunks_vIn10 _chunksOimportBlocks _chunksOisDeclOfLet _chunksOmainFile _chunksOmainName _chunksOmoduleHeader _chunksOnested _chunksOoptions _chunksOoptionsLine _chunksOpragmaBlocks _chunksOtextBlockMap _chunksOtextBlocks) _options = rule362 _lhsIoptions arg_ordered_ _chunksOnested = rule363 _lhsIoptions _lhsOoutput :: PP_Docs _lhsOoutput = rule364 _chunksIpps _chunksOisDeclOfLet = rule365 () _mainModuleFile = rule366 _lhsImainFile _genMainModule = rule367 _chunksIappendMain _chunksIimports _lhsImainBlocksDoc _lhsImainName _lhsImoduleHeader _lhsIoptionsLine _lhsIpragmaBlocks _mainModuleFile _commonFile = rule368 _lhsImainFile _genCommonModule = rule369 _chunksIappendCommon _commonFile _lhsIimportBlocks _lhsImainName _lhsImoduleHeader _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks _lhsOgenIO :: IO () _lhsOgenIO = rule370 _chunksIgenSems _genCommonModule _genMainModule _chunksOimportBlocks = rule371 _lhsIimportBlocks _chunksOmainFile = rule372 _lhsImainFile _chunksOmainName = rule373 _lhsImainName _chunksOmoduleHeader = rule374 _lhsImoduleHeader _chunksOoptions = rule375 _options _chunksOoptionsLine = rule376 _lhsIoptionsLine _chunksOpragmaBlocks = rule377 _lhsIpragmaBlocks _chunksOtextBlockMap = rule378 _lhsItextBlockMap _chunksOtextBlocks = rule379 _lhsItextBlocks !__result_ = T_Program_vOut46 _lhsOgenIO _lhsOoutput in __result_ ) in C_Program_s47 v46 {-# INLINE rule362 #-} {-# LINE 58 "src-ag/PrintCode.ag" #-} rule362 = \ ((_lhsIoptions) :: Options) ordered_ -> {-# LINE 58 "src-ag/PrintCode.ag" #-} _lhsIoptions { breadthFirst = breadthFirst _lhsIoptions && visit _lhsIoptions && cases _lhsIoptions && ordered_ } {-# LINE 3418 "dist/build/PrintCode.hs"#-} {-# INLINE rule363 #-} {-# LINE 61 "src-ag/PrintCode.ag" #-} rule363 = \ ((_lhsIoptions) :: Options) -> {-# LINE 61 "src-ag/PrintCode.ag" #-} nest _lhsIoptions {-# LINE 3424 "dist/build/PrintCode.hs"#-} {-# INLINE rule364 #-} {-# LINE 93 "src-ag/PrintCode.ag" #-} rule364 = \ ((_chunksIpps) :: PP_Docs) -> {-# LINE 93 "src-ag/PrintCode.ag" #-} _chunksIpps {-# LINE 3430 "dist/build/PrintCode.hs"#-} {-# INLINE rule365 #-} {-# LINE 416 "src-ag/PrintCode.ag" #-} rule365 = \ (_ :: ()) -> {-# LINE 416 "src-ag/PrintCode.ag" #-} False {-# LINE 3436 "dist/build/PrintCode.hs"#-} {-# INLINE rule366 #-} {-# LINE 450 "src-ag/PrintCode.ag" #-} rule366 = \ ((_lhsImainFile) :: String) -> {-# LINE 450 "src-ag/PrintCode.ag" #-} _lhsImainFile {-# LINE 3442 "dist/build/PrintCode.hs"#-} {-# INLINE rule367 #-} {-# LINE 452 "src-ag/PrintCode.ag" #-} rule367 = \ ((_chunksIappendMain) :: [[PP_Doc]]) ((_chunksIimports) :: [String]) ((_lhsImainBlocksDoc) :: PP_Doc) ((_lhsImainName) :: String) ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIoptionsLine) :: String) ((_lhsIpragmaBlocks) :: String) _mainModuleFile -> {-# LINE 452 "src-ag/PrintCode.ag" #-} writeModule _mainModuleFile ( [ pp $ _lhsIpragmaBlocks , pp $ _lhsIoptionsLine , pp $ _lhsImoduleHeader _lhsImainName "" "" False , pp $ ("import " ++ _lhsImainName ++ "_common\n") ] ++ map pp _chunksIimports ++ map vlist _chunksIappendMain ++ [_lhsImainBlocksDoc] ) {-# LINE 3457 "dist/build/PrintCode.hs"#-} {-# INLINE rule368 #-} {-# LINE 463 "src-ag/PrintCode.ag" #-} rule368 = \ ((_lhsImainFile) :: String) -> {-# LINE 463 "src-ag/PrintCode.ag" #-} replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ "_common") {-# LINE 3463 "dist/build/PrintCode.hs"#-} {-# INLINE rule369 #-} {-# LINE 465 "src-ag/PrintCode.ag" #-} rule369 = \ ((_chunksIappendCommon) :: [[PP_Doc]]) _commonFile ((_lhsIimportBlocks) :: PP_Doc) ((_lhsImainName) :: String) ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIoptionsLine) :: String) ((_lhsIpragmaBlocks) :: String) ((_lhsItextBlocks) :: PP_Doc) -> {-# LINE 465 "src-ag/PrintCode.ag" #-} writeModule _commonFile ( [ pp $ _lhsIpragmaBlocks , pp $ _lhsIoptionsLine , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True , _lhsIimportBlocks , _lhsItextBlocks ] ++ map vlist _chunksIappendCommon ) {-# LINE 3477 "dist/build/PrintCode.hs"#-} {-# INLINE rule370 #-} {-# LINE 475 "src-ag/PrintCode.ag" #-} rule370 = \ ((_chunksIgenSems) :: IO ()) _genCommonModule _genMainModule -> {-# LINE 475 "src-ag/PrintCode.ag" #-} do _genMainModule _genCommonModule _chunksIgenSems {-# LINE 3485 "dist/build/PrintCode.hs"#-} {-# INLINE rule371 #-} rule371 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule372 #-} rule372 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule373 #-} rule373 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule374 #-} rule374 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule375 #-} rule375 = \ _options -> _options {-# INLINE rule376 #-} rule376 = \ ((_lhsIoptionsLine) :: String) -> _lhsIoptionsLine {-# INLINE rule377 #-} rule377 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule378 #-} rule378 = \ ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) -> _lhsItextBlockMap {-# INLINE rule379 #-} rule379 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks -- Type -------------------------------------------------------- -- wrapper data Inh_Type = Inh_Type { nested_Inh_Type :: !(Bool) } data Syn_Type = Syn_Type { pp_Syn_Type :: !(PP_Doc), prec_Syn_Type :: !(Int) } {-# INLINABLE wrap_Type #-} wrap_Type :: T_Type -> Inh_Type -> (Syn_Type ) wrap_Type !(T_Type act) !(Inh_Type _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg49 = T_Type_vIn49 _lhsInested !(T_Type_vOut49 _lhsOpp _lhsOprec) <- return (inv_Type_s50 sem arg49) return (Syn_Type _lhsOpp _lhsOprec) ) -- cata {-# NOINLINE sem_Type #-} sem_Type :: Type -> T_Type sem_Type ( Arr left_ right_ ) = sem_Type_Arr ( sem_Type left_ ) ( sem_Type right_ ) sem_Type ( CtxApp !left_ right_ ) = sem_Type_CtxApp left_ ( sem_Type right_ ) sem_Type ( QuantApp !left_ right_ ) = sem_Type_QuantApp left_ ( sem_Type right_ ) sem_Type ( TypeApp func_ args_ ) = sem_Type_TypeApp ( sem_Type func_ ) ( sem_Types args_ ) sem_Type ( TupleType tps_ ) = sem_Type_TupleType ( sem_Types tps_ ) sem_Type ( UnboxedTupleType tps_ ) = sem_Type_UnboxedTupleType ( sem_Types tps_ ) sem_Type ( List tp_ ) = sem_Type_List ( sem_Type tp_ ) sem_Type ( SimpleType !txt_ ) = sem_Type_SimpleType txt_ sem_Type ( NontermType !name_ !params_ !deforested_ ) = sem_Type_NontermType name_ params_ deforested_ sem_Type ( TMaybe tp_ ) = sem_Type_TMaybe ( sem_Type tp_ ) sem_Type ( TEither left_ right_ ) = sem_Type_TEither ( sem_Type left_ ) ( sem_Type right_ ) sem_Type ( TMap key_ value_ ) = sem_Type_TMap ( sem_Type key_ ) ( sem_Type value_ ) sem_Type ( TIntMap value_ ) = sem_Type_TIntMap ( sem_Type value_ ) sem_Type ( TSet tp_ ) = sem_Type_TSet ( sem_Type tp_ ) sem_Type ( TIntSet ) = sem_Type_TIntSet -- semantic domain newtype T_Type = T_Type { attach_T_Type :: Identity (T_Type_s50 ) } newtype T_Type_s50 = C_Type_s50 { inv_Type_s50 :: (T_Type_v49 ) } data T_Type_s51 = C_Type_s51 type T_Type_v49 = (T_Type_vIn49 ) -> (T_Type_vOut49 ) data T_Type_vIn49 = T_Type_vIn49 (Bool) data T_Type_vOut49 = T_Type_vOut49 (PP_Doc) (Int) {-# NOINLINE sem_Type_Arr #-} sem_Type_Arr :: T_Type -> T_Type -> T_Type sem_Type_Arr arg_left_ arg_right_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _leftX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_left_)) _rightX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_right_)) (T_Type_vOut49 _leftIpp _leftIprec) = inv_Type_s50 _leftX50 (T_Type_vIn49 _leftOnested) (T_Type_vOut49 _rightIpp _rightIprec) = inv_Type_s50 _rightX50 (T_Type_vIn49 _rightOnested) _lhsOprec :: Int _lhsOprec = rule380 () _lhsOpp :: PP_Doc _lhsOpp = rule381 _l _r _l = rule382 _leftIpp _leftIprec _r = rule383 _rightIpp _rightIprec _leftOnested = rule384 _lhsInested _rightOnested = rule385 _lhsInested !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule380 #-} {-# LINE 259 "src-ag/PrintCode.ag" #-} rule380 = \ (_ :: ()) -> {-# LINE 259 "src-ag/PrintCode.ag" #-} 2 {-# LINE 3585 "dist/build/PrintCode.hs"#-} {-# INLINE rule381 #-} {-# LINE 260 "src-ag/PrintCode.ag" #-} rule381 = \ _l _r -> {-# LINE 260 "src-ag/PrintCode.ag" #-} _l >#< "->" >-< _r {-# LINE 3591 "dist/build/PrintCode.hs"#-} {-# INLINE rule382 #-} {-# LINE 261 "src-ag/PrintCode.ag" #-} rule382 = \ ((_leftIpp) :: PP_Doc) ((_leftIprec) :: Int) -> {-# LINE 261 "src-ag/PrintCode.ag" #-} if _leftIprec <= 2 then pp_parens _leftIpp else _leftIpp {-# LINE 3597 "dist/build/PrintCode.hs"#-} {-# INLINE rule383 #-} {-# LINE 262 "src-ag/PrintCode.ag" #-} rule383 = \ ((_rightIpp) :: PP_Doc) ((_rightIprec) :: Int) -> {-# LINE 262 "src-ag/PrintCode.ag" #-} if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp {-# LINE 3603 "dist/build/PrintCode.hs"#-} {-# INLINE rule384 #-} rule384 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule385 #-} rule385 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_CtxApp #-} sem_Type_CtxApp :: ([(String, [String])]) -> T_Type -> T_Type sem_Type_CtxApp !arg_left_ arg_right_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _rightX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_right_)) (T_Type_vOut49 _rightIpp _rightIprec) = inv_Type_s50 _rightX50 (T_Type_vIn49 _rightOnested) _lhsOpp :: PP_Doc _lhsOpp = rule386 _rightIpp arg_left_ _lhsOprec :: Int _lhsOprec = rule387 _rightIprec _rightOnested = rule388 _lhsInested !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule386 #-} {-# LINE 268 "src-ag/PrintCode.ag" #-} rule386 = \ ((_rightIpp) :: PP_Doc) left_ -> {-# LINE 268 "src-ag/PrintCode.ag" #-} (pp_block "(" ")" "," $ map (\(n,ns) -> hv_sp $ map pp (n:ns)) left_) >#< "=>" >#< _rightIpp {-# LINE 3632 "dist/build/PrintCode.hs"#-} {-# INLINE rule387 #-} rule387 = \ ((_rightIprec) :: Int) -> _rightIprec {-# INLINE rule388 #-} rule388 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_QuantApp #-} sem_Type_QuantApp :: (String) -> T_Type -> T_Type sem_Type_QuantApp !arg_left_ arg_right_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _rightX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_right_)) (T_Type_vOut49 _rightIpp _rightIprec) = inv_Type_s50 _rightX50 (T_Type_vIn49 _rightOnested) _lhsOpp :: PP_Doc _lhsOpp = rule389 _rightIpp arg_left_ _lhsOprec :: Int _lhsOprec = rule390 _rightIprec _rightOnested = rule391 _lhsInested !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule389 #-} {-# LINE 270 "src-ag/PrintCode.ag" #-} rule389 = \ ((_rightIpp) :: PP_Doc) left_ -> {-# LINE 270 "src-ag/PrintCode.ag" #-} left_ >#< _rightIpp {-# LINE 3661 "dist/build/PrintCode.hs"#-} {-# INLINE rule390 #-} rule390 = \ ((_rightIprec) :: Int) -> _rightIprec {-# INLINE rule391 #-} rule391 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_TypeApp #-} sem_Type_TypeApp :: T_Type -> T_Types -> T_Type sem_Type_TypeApp arg_func_ arg_args_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _funcX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_func_)) _argsX53 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_args_)) (T_Type_vOut49 _funcIpp _funcIprec) = inv_Type_s50 _funcX50 (T_Type_vIn49 _funcOnested) (T_Types_vOut52 _argsIpps) = inv_Types_s53 _argsX53 (T_Types_vIn52 _argsOnested) _lhsOpp :: PP_Doc _lhsOpp = rule392 _argsIpps _funcIpp _lhsOprec :: Int _lhsOprec = rule393 _funcIprec _funcOnested = rule394 _lhsInested _argsOnested = rule395 _lhsInested !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule392 #-} {-# LINE 265 "src-ag/PrintCode.ag" #-} rule392 = \ ((_argsIpps) :: PP_Docs) ((_funcIpp) :: PP_Doc) -> {-# LINE 265 "src-ag/PrintCode.ag" #-} hv_sp (_funcIpp : _argsIpps) {-# LINE 3693 "dist/build/PrintCode.hs"#-} {-# INLINE rule393 #-} rule393 = \ ((_funcIprec) :: Int) -> _funcIprec {-# INLINE rule394 #-} rule394 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule395 #-} rule395 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_TupleType #-} sem_Type_TupleType :: T_Types -> T_Type sem_Type_TupleType arg_tps_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _tpsX53 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tps_)) (T_Types_vOut52 _tpsIpps) = inv_Types_s53 _tpsX53 (T_Types_vIn52 _tpsOnested) _lhsOprec :: Int _lhsOprec = rule396 () _lhsOpp :: PP_Doc _lhsOpp = rule397 _lhsInested _tpsIpps _tpsOnested = rule398 _lhsInested !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule396 #-} {-# LINE 272 "src-ag/PrintCode.ag" #-} rule396 = \ (_ :: ()) -> {-# LINE 272 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3725 "dist/build/PrintCode.hs"#-} {-# INLINE rule397 #-} {-# LINE 273 "src-ag/PrintCode.ag" #-} rule397 = \ ((_lhsInested) :: Bool) ((_tpsIpps) :: PP_Docs) -> {-# LINE 273 "src-ag/PrintCode.ag" #-} ppTuple _lhsInested _tpsIpps {-# LINE 3731 "dist/build/PrintCode.hs"#-} {-# INLINE rule398 #-} rule398 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_UnboxedTupleType #-} sem_Type_UnboxedTupleType :: T_Types -> T_Type sem_Type_UnboxedTupleType arg_tps_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _tpsX53 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tps_)) (T_Types_vOut52 _tpsIpps) = inv_Types_s53 _tpsX53 (T_Types_vIn52 _tpsOnested) _lhsOprec :: Int _lhsOprec = rule399 () _lhsOpp :: PP_Doc _lhsOpp = rule400 _lhsInested _tpsIpps _tpsOnested = rule401 _lhsInested !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule399 #-} {-# LINE 275 "src-ag/PrintCode.ag" #-} rule399 = \ (_ :: ()) -> {-# LINE 275 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3757 "dist/build/PrintCode.hs"#-} {-# INLINE rule400 #-} {-# LINE 276 "src-ag/PrintCode.ag" #-} rule400 = \ ((_lhsInested) :: Bool) ((_tpsIpps) :: PP_Docs) -> {-# LINE 276 "src-ag/PrintCode.ag" #-} ppUnboxedTuple _lhsInested _tpsIpps {-# LINE 3763 "dist/build/PrintCode.hs"#-} {-# INLINE rule401 #-} rule401 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_List #-} sem_Type_List :: T_Type -> T_Type sem_Type_List arg_tp_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOprec :: Int _lhsOprec = rule402 () _lhsOpp :: PP_Doc _lhsOpp = rule403 _tpIpp _tpOnested = rule404 _lhsInested !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule402 #-} {-# LINE 278 "src-ag/PrintCode.ag" #-} rule402 = \ (_ :: ()) -> {-# LINE 278 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3789 "dist/build/PrintCode.hs"#-} {-# INLINE rule403 #-} {-# LINE 279 "src-ag/PrintCode.ag" #-} rule403 = \ ((_tpIpp) :: PP_Doc) -> {-# LINE 279 "src-ag/PrintCode.ag" #-} "[" >|< _tpIpp >|< "]" {-# LINE 3795 "dist/build/PrintCode.hs"#-} {-# INLINE rule404 #-} rule404 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_SimpleType #-} sem_Type_SimpleType :: (String) -> T_Type sem_Type_SimpleType !arg_txt_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _lhsOprec :: Int _lhsOprec = rule405 () _lhsOpp :: PP_Doc _lhsOpp = rule406 arg_txt_ !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule405 #-} {-# LINE 281 "src-ag/PrintCode.ag" #-} rule405 = \ (_ :: ()) -> {-# LINE 281 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3818 "dist/build/PrintCode.hs"#-} {-# INLINE rule406 #-} {-# LINE 282 "src-ag/PrintCode.ag" #-} rule406 = \ txt_ -> {-# LINE 282 "src-ag/PrintCode.ag" #-} if reallySimple txt_ then text txt_ else pp_parens (text txt_) {-# LINE 3824 "dist/build/PrintCode.hs"#-} {-# NOINLINE sem_Type_NontermType #-} sem_Type_NontermType :: (String) -> ([String]) -> (Bool) -> T_Type sem_Type_NontermType !arg_name_ !arg_params_ !arg_deforested_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _lhsOprec :: Int _lhsOprec = rule407 () _lhsOpp :: PP_Doc _lhsOpp = rule408 _prefix arg_name_ arg_params_ _prefix = rule409 arg_deforested_ !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule407 #-} {-# LINE 284 "src-ag/PrintCode.ag" #-} rule407 = \ (_ :: ()) -> {-# LINE 284 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3845 "dist/build/PrintCode.hs"#-} {-# INLINE rule408 #-} {-# LINE 285 "src-ag/PrintCode.ag" #-} rule408 = \ _prefix name_ params_ -> {-# LINE 285 "src-ag/PrintCode.ag" #-} _prefix >|< text name_ >#< hv_sp params_ {-# LINE 3851 "dist/build/PrintCode.hs"#-} {-# INLINE rule409 #-} {-# LINE 286 "src-ag/PrintCode.ag" #-} rule409 = \ deforested_ -> {-# LINE 286 "src-ag/PrintCode.ag" #-} if deforested_ then text "T_" else empty {-# LINE 3859 "dist/build/PrintCode.hs"#-} {-# NOINLINE sem_Type_TMaybe #-} sem_Type_TMaybe :: T_Type -> T_Type sem_Type_TMaybe arg_tp_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOprec :: Int _lhsOprec = rule410 () _lhsOpp :: PP_Doc _lhsOpp = rule411 _tpIpp _tpOnested = rule412 _lhsInested !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule410 #-} {-# LINE 289 "src-ag/PrintCode.ag" #-} rule410 = \ (_ :: ()) -> {-# LINE 289 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3882 "dist/build/PrintCode.hs"#-} {-# INLINE rule411 #-} {-# LINE 290 "src-ag/PrintCode.ag" #-} rule411 = \ ((_tpIpp) :: PP_Doc) -> {-# LINE 290 "src-ag/PrintCode.ag" #-} text "Maybe" >#< pp_parens _tpIpp {-# LINE 3888 "dist/build/PrintCode.hs"#-} {-# INLINE rule412 #-} rule412 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_TEither #-} sem_Type_TEither :: T_Type -> T_Type -> T_Type sem_Type_TEither arg_left_ arg_right_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _leftX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_left_)) _rightX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_right_)) (T_Type_vOut49 _leftIpp _leftIprec) = inv_Type_s50 _leftX50 (T_Type_vIn49 _leftOnested) (T_Type_vOut49 _rightIpp _rightIprec) = inv_Type_s50 _rightX50 (T_Type_vIn49 _rightOnested) _lhsOprec :: Int _lhsOprec = rule413 () _lhsOpp :: PP_Doc _lhsOpp = rule414 _leftIpp _rightIpp _leftOnested = rule415 _lhsInested _rightOnested = rule416 _lhsInested !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule413 #-} {-# LINE 291 "src-ag/PrintCode.ag" #-} rule413 = \ (_ :: ()) -> {-# LINE 291 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3917 "dist/build/PrintCode.hs"#-} {-# INLINE rule414 #-} {-# LINE 292 "src-ag/PrintCode.ag" #-} rule414 = \ ((_leftIpp) :: PP_Doc) ((_rightIpp) :: PP_Doc) -> {-# LINE 292 "src-ag/PrintCode.ag" #-} text "Either" >#< pp_parens _leftIpp >#< pp_parens _rightIpp {-# LINE 3923 "dist/build/PrintCode.hs"#-} {-# INLINE rule415 #-} rule415 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule416 #-} rule416 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_TMap #-} sem_Type_TMap :: T_Type -> T_Type -> T_Type sem_Type_TMap arg_key_ arg_value_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _keyX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_key_)) _valueX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_value_)) (T_Type_vOut49 _keyIpp _keyIprec) = inv_Type_s50 _keyX50 (T_Type_vIn49 _keyOnested) (T_Type_vOut49 _valueIpp _valueIprec) = inv_Type_s50 _valueX50 (T_Type_vIn49 _valueOnested) _lhsOprec :: Int _lhsOprec = rule417 () _lhsOpp :: PP_Doc _lhsOpp = rule418 _keyIpp _valueIpp _keyOnested = rule419 _lhsInested _valueOnested = rule420 _lhsInested !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule417 #-} {-# LINE 293 "src-ag/PrintCode.ag" #-} rule417 = \ (_ :: ()) -> {-# LINE 293 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3955 "dist/build/PrintCode.hs"#-} {-# INLINE rule418 #-} {-# LINE 294 "src-ag/PrintCode.ag" #-} rule418 = \ ((_keyIpp) :: PP_Doc) ((_valueIpp) :: PP_Doc) -> {-# LINE 294 "src-ag/PrintCode.ag" #-} text "Data.Map.Map" >#< pp_parens _keyIpp >#< pp_parens _valueIpp {-# LINE 3961 "dist/build/PrintCode.hs"#-} {-# INLINE rule419 #-} rule419 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule420 #-} rule420 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_TIntMap #-} sem_Type_TIntMap :: T_Type -> T_Type sem_Type_TIntMap arg_value_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _valueX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_value_)) (T_Type_vOut49 _valueIpp _valueIprec) = inv_Type_s50 _valueX50 (T_Type_vIn49 _valueOnested) _lhsOprec :: Int _lhsOprec = rule421 () _lhsOpp :: PP_Doc _lhsOpp = rule422 _valueIpp _valueOnested = rule423 _lhsInested !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule421 #-} {-# LINE 295 "src-ag/PrintCode.ag" #-} rule421 = \ (_ :: ()) -> {-# LINE 295 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3990 "dist/build/PrintCode.hs"#-} {-# INLINE rule422 #-} {-# LINE 296 "src-ag/PrintCode.ag" #-} rule422 = \ ((_valueIpp) :: PP_Doc) -> {-# LINE 296 "src-ag/PrintCode.ag" #-} text "Data.IntMap.IntMap" >#< pp_parens _valueIpp {-# LINE 3996 "dist/build/PrintCode.hs"#-} {-# INLINE rule423 #-} rule423 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_TSet #-} sem_Type_TSet :: T_Type -> T_Type sem_Type_TSet arg_tp_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOprec :: Int _lhsOprec = rule424 () _lhsOpp :: PP_Doc _lhsOpp = rule425 _tpIpp _tpOnested = rule426 _lhsInested !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule424 #-} {-# LINE 297 "src-ag/PrintCode.ag" #-} rule424 = \ (_ :: ()) -> {-# LINE 297 "src-ag/PrintCode.ag" #-} 5 {-# LINE 4022 "dist/build/PrintCode.hs"#-} {-# INLINE rule425 #-} {-# LINE 298 "src-ag/PrintCode.ag" #-} rule425 = \ ((_tpIpp) :: PP_Doc) -> {-# LINE 298 "src-ag/PrintCode.ag" #-} text "Data.Set.Set" >#< pp_parens _tpIpp {-# LINE 4028 "dist/build/PrintCode.hs"#-} {-# INLINE rule426 #-} rule426 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_TIntSet #-} sem_Type_TIntSet :: T_Type sem_Type_TIntSet = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _lhsOprec :: Int _lhsOprec = rule427 () _lhsOpp :: PP_Doc _lhsOpp = rule428 () !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule427 #-} {-# LINE 299 "src-ag/PrintCode.ag" #-} rule427 = \ (_ :: ()) -> {-# LINE 299 "src-ag/PrintCode.ag" #-} 5 {-# LINE 4051 "dist/build/PrintCode.hs"#-} {-# INLINE rule428 #-} {-# LINE 300 "src-ag/PrintCode.ag" #-} rule428 = \ (_ :: ()) -> {-# LINE 300 "src-ag/PrintCode.ag" #-} text "Data.IntSet.IntSet" {-# LINE 4057 "dist/build/PrintCode.hs"#-} -- Types ------------------------------------------------------- -- wrapper data Inh_Types = Inh_Types { nested_Inh_Types :: !(Bool) } data Syn_Types = Syn_Types { pps_Syn_Types :: !(PP_Docs) } {-# INLINABLE wrap_Types #-} wrap_Types :: T_Types -> Inh_Types -> (Syn_Types ) wrap_Types !(T_Types act) !(Inh_Types _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg52 = T_Types_vIn52 _lhsInested !(T_Types_vOut52 _lhsOpps) <- return (inv_Types_s53 sem arg52) return (Syn_Types _lhsOpps) ) -- cata {-# NOINLINE sem_Types #-} sem_Types :: Types -> T_Types sem_Types list = Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list) -- semantic domain newtype T_Types = T_Types { attach_T_Types :: Identity (T_Types_s53 ) } newtype T_Types_s53 = C_Types_s53 { inv_Types_s53 :: (T_Types_v52 ) } data T_Types_s54 = C_Types_s54 type T_Types_v52 = (T_Types_vIn52 ) -> (T_Types_vOut52 ) data T_Types_vIn52 = T_Types_vIn52 (Bool) data T_Types_vOut52 = T_Types_vOut52 (PP_Docs) {-# NOINLINE sem_Types_Cons #-} sem_Types_Cons :: T_Type -> T_Types -> T_Types sem_Types_Cons arg_hd_ arg_tl_ = T_Types (return st53) where {-# NOINLINE st53 #-} !st53 = let v52 :: T_Types_v52 v52 = \ !(T_Types_vIn52 _lhsInested) -> ( let _hdX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_hd_)) _tlX53 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tl_)) (T_Type_vOut49 _hdIpp _hdIprec) = inv_Type_s50 _hdX50 (T_Type_vIn49 _hdOnested) (T_Types_vOut52 _tlIpps) = inv_Types_s53 _tlX53 (T_Types_vIn52 _tlOnested) _lhsOpps :: PP_Docs _lhsOpps = rule429 _hdIpp _tlIpps _hdOnested = rule430 _lhsInested _tlOnested = rule431 _lhsInested !__result_ = T_Types_vOut52 _lhsOpps in __result_ ) in C_Types_s53 v52 {-# INLINE rule429 #-} {-# LINE 76 "src-ag/PrintCode.ag" #-} rule429 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 76 "src-ag/PrintCode.ag" #-} _hdIpp : _tlIpps {-# LINE 4112 "dist/build/PrintCode.hs"#-} {-# INLINE rule430 #-} rule430 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule431 #-} rule431 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Types_Nil #-} sem_Types_Nil :: T_Types sem_Types_Nil = T_Types (return st53) where {-# NOINLINE st53 #-} !st53 = let v52 :: T_Types_v52 v52 = \ !(T_Types_vIn52 _lhsInested) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule432 () !__result_ = T_Types_vOut52 _lhsOpps in __result_ ) in C_Types_s53 v52 {-# INLINE rule432 #-} {-# LINE 77 "src-ag/PrintCode.ag" #-} rule432 = \ (_ :: ()) -> {-# LINE 77 "src-ag/PrintCode.ag" #-} [] {-# LINE 4136 "dist/build/PrintCode.hs"#-} uuagc-0.9.52.2/src-generated/Transform.hs0000644000000000000000000121054713433540502016304 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module Transform where {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 11 "dist/build/Transform.hs" #-} {-# LINE 2 "src-ag/ConcreteSyntax.ag" #-} import UU.Scanner.Position (Pos) import Patterns (Pattern) import Expression (Expression) import CommonTypes import Macro --marcos {-# LINE 20 "dist/build/Transform.hs" #-} {-# LINE 8 "src-ag/Transform.ag" #-} import Control.Monad(mplus,mzero) import Data.List (partition, nub,intersperse, union) import Data.Maybe import qualified Data.Map as Map import Data.Map (Map) import Data.Set as Set (Set, member, union, toList, fromList, empty, singleton, member, unions, size, fold, intersection, difference, insert, elems) import qualified Data.Sequence as Seq import Data.Sequence(Seq, (><)) import UU.Scanner.Position(noPos) import ConcreteSyntax import AbstractSyntax import ErrorMessages import Patterns (Patterns,Pattern(..)) import Expression (Expression(..)) import HsToken import RhsCheck import Debug.Trace {-# LINE 43 "dist/build/Transform.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 104 "src-ag/Transform.ag" #-} type DefinedSets = Map Identifier (Set NontermIdent) {-# LINE 48 "dist/build/Transform.hs" #-} {-# LINE 124 "src-ag/Transform.ag" #-} type FieldMap = [(Identifier, Type)] {-# LINE 52 "dist/build/Transform.hs" #-} {-# LINE 125 "src-ag/Transform.ag" #-} type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap) {-# LINE 56 "dist/build/Transform.hs" #-} {-# LINE 148 "src-ag/Transform.ag" #-} type AttrName = (Identifier,Identifier) {-# LINE 60 "dist/build/Transform.hs" #-} {-# LINE 149 "src-ag/Transform.ag" #-} type RuleInfo = (Maybe Identifier, [AttrName]->Pattern, Expression, [AttrName], Bool, String, Bool, Bool) {-# LINE 64 "dist/build/Transform.hs" #-} {-# LINE 150 "src-ag/Transform.ag" #-} type SigInfo = (Identifier,Type) {-# LINE 68 "dist/build/Transform.hs" #-} {-# LINE 151 "src-ag/Transform.ag" #-} type UniqueInfo = (Identifier,Identifier) {-# LINE 72 "dist/build/Transform.hs" #-} {-# LINE 152 "src-ag/Transform.ag" #-} type AugmentInfo = (Identifier,Expression) {-# LINE 76 "dist/build/Transform.hs" #-} {-# LINE 153 "src-ag/Transform.ag" #-} type AroundInfo = (Identifier,Expression) {-# LINE 80 "dist/build/Transform.hs" #-} {-# LINE 154 "src-ag/Transform.ag" #-} type MergeInfo = (Identifier, Identifier, [Identifier], Expression) {-# LINE 84 "dist/build/Transform.hs" #-} {-# LINE 203 "src-ag/Transform.ag" #-} checkDuplicate :: (Identifier -> Identifier -> Error) -> Identifier -> val -> Map Identifier val -> (Map Identifier val,Seq Error) checkDuplicate dupError key val m = case Map.lookupIndex key m of Just ix -> let (key',_) = Map.elemAt ix m in (m,Seq.singleton (dupError key key')) Nothing -> (Map.insert key val m,Seq.empty) checkDuplicates :: (Identifier -> Identifier -> Error) -> [(Identifier, val)] -> Map Identifier val -> (Map Identifier val,Seq Error) checkDuplicates dupError new m = foldErrors check m new where check = uncurry (checkDuplicate dupError) foldErrors :: (b -> t -> (t, Seq Error)) -> t -> [b] -> (t, Seq Error) foldErrors f n xs = foldl g (n,Seq.empty) xs where g ~(e,es) x = let (e',es') = f x e in (e', es >< es') checkForDuplicates :: (Identifier -> Identifier -> Error) -> [Identifier] -> [Error] checkForDuplicates _ [] = [] checkForDuplicates err (x:xs) = let (same,other) = partition (equalId x) xs in map (err x) same ++ checkForDuplicates err other equalId :: Identifier -> Identifier -> Bool equalId x y = getName x == getName y {-# LINE 116 "dist/build/Transform.hs" #-} {-# LINE 354 "src-ag/Transform.ag" #-} type RulesAndErrors = ([Rule], Seq Error) type SigsAndErrors = ([TypeSig], Seq Error) type InstsAndErrors = ([(Identifier, Type)], Seq Error) type UniquesAndErrors = (Map Identifier Identifier, Seq Error) type AugmentsAndErrors = (Map Identifier [Expression], Seq Error) type AroundsAndErrors = (Map Identifier [Expression], Seq Error) type MergesAndErrors = (Map Identifier (Identifier, [Identifier], Expression), Seq Error) type AttrOverwrite = Map AttrName Bool type AccumRuleCheck = (RulesAndErrors, AttrOverwrite) type AccumDefiCheck = (Seq Error, AttrOverwrite, [AttrName], [AttrName]) checkRules :: Map NontermIdent (Attributes, Attributes) -> DataTypes -> Map NontermIdent (Map ConstructorIdent [Identifier]) -> Map NontermIdent (Map ConstructorIdent [SigInfo]) -> Map NontermIdent (Map ConstructorIdent [MergeInfo]) -> NontermIdent -> ConstructorIdent -> [RuleInfo] -> RulesAndErrors checkRules attributes fields allinsts allsigs _ nt con rs = let fieldmap :: FieldMap fieldmap = (_LHS, NT nt [] False) : (_LOC, NT nullIdent [] False) : (_INST, NT nullIdent [] False) : (_FIRST, NT nullIdent [] False) : (_LAST, NT nullIdent [] False) : Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fields) ++ mapMaybe (\instNm -> lookup instNm sigs >>= \tp -> return (instNm, tp)) (Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allinsts)) -- merged children are not allowed to have any inherited attrs defined: do not include sigs = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allsigs) hasAttrib f tp attr = Map.member attr (f (Map.findWithDefault (Map.empty,Map.empty) tp attributes)) checkRule :: RuleInfo -> AccumRuleCheck -> AccumRuleCheck checkRule (mbNm, pat,ex,as,owrt,str, pur, eager) ((r1,e1),m1) = let (e2,m2,u2,_) = foldr (checkDefi owrt) (e1,m1,[],[]) as in ( (Rule mbNm (pat u2) ex owrt str True pur False Nothing eager : r1, e2), m2) checkDefi :: Bool -> AttrName -> AccumDefiCheck -> AccumDefiCheck checkDefi owrt fa@(field,attr) (e,m,u,bs) = case lookup field fieldmap of Just (NT tp _ _) -> let tp' = maybe tp id (deforestedNt tp) in if field == _LOC || field == _INST || field == _FIRST || field == _LAST || hasAttrib (if getName field==getName _LHS then snd else fst) tp' attr then case Map.lookupIndex fa m of Just ix -> let ((_,attr2),b) = Map.elemAt ix m in if b && not (fa `elem` bs) then ( e, Map.insert fa owrt m, fa:u, fa:bs) else (((Seq.<|)) (DupRule nt con field attr2 attr) e, m, fa:u, bs) Nothing -> ( e, Map.insert fa owrt m, u, fa:bs) else (((Seq.<|)) (SuperfluousRule nt con field attr) e, m, fa:u, bs) _ -> (((Seq.<|)) (UndefChild nt con field) e, m, fa:u, bs ) in fst (foldr checkRule (([],Seq.empty),Map.empty) rs) checkRuleNames :: NontermIdent -> ConstructorIdent -> [RuleInfo] -> Seq Error checkRuleNames nt con = fst . foldr checkRule (Seq.empty, Set.empty) where checkRule (Just nm,_,_,_,_,_,_,_) (errs, nms) | nm `Set.member` nms = (DupRuleName nt con nm Seq.<| errs, nms) | otherwise = (errs, Set.insert nm nms) checkRule (Nothing,_,_,_,_,_,_,_) inp = inp checkSigs :: NontermIdent -> ConstructorIdent -> [SigInfo] -> SigsAndErrors checkSigs nt con sis = let checkSig (ide,typ) (sigs,errs) = if ide `elem` map (\(TypeSig n _)-> n) sigs then (sigs, ((Seq.<|)) (DupSig nt con ide) errs) -- else if not (ide `elem` locattrdefs) -- then (sigs, ((Seq.<|)) (SupSig nt con ide) errs) else (TypeSig ide typ:sigs, errs) in foldr checkSig ([],Seq.empty) sis checkInsts :: Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [SigInfo]) -> DataTypes -> NontermIdent -> ConstructorIdent -> [Identifier] -> InstsAndErrors checkInsts allNts sigMap _ nt con = foldr (\inst (insts, errs) -> maybe (insts, Seq.singleton (MissingInstSig nt con inst) >< errs) (\info@(k, NT nm args _) -> case findInst k insts of Just k' -> (insts, Seq.singleton (DupChild nt con k k') >< errs) Nothing -> case nm `Set.member` allNts of True -> (info : insts, errs) False | take 2 (getName nm) == "T_" -> let nm' = Ident (drop 2 (getName nm)) (getPos nm) info' = (k, NT nm' args True) -- this should be the only place at which 'for' with value True can be generated in case nm' `Set.member` allNts of True -> (info' : insts, errs) False -> (insts, Seq.singleton (UndefNont nm') >< errs) | otherwise -> (insts, Seq.singleton (UndefNont nm) >< errs) ) $ findSig inst ) ([], Seq.empty) where sigs = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt sigMap) findSig name = do tp@(NT _ _ _) <- lookup name sigs return (name, tp) findInst _ [] = Nothing findInst k ((k', _): r) | k == k' = Just k' | otherwise = findInst k r checkUniques :: Map NontermIdent (Attributes, Attributes) -> NontermIdent -> ConstructorIdent -> [UniqueInfo] -> UniquesAndErrors checkUniques allAttrs nt con uniques = let checkUnique (ident,ref) (us,errs) = if ident `Map.member` us then (us, ((Seq.<|)) (DupUnique nt con ident) errs) else if Map.member ref inhs && Map.member ref syns then (Map.insert ident ref us, errs) else (us, ((Seq.<|)) (MissingUnique nt ref) errs) (inhs,syns) = Map.findWithDefault (Map.empty,Map.empty) nt allAttrs in foldr checkUnique (Map.empty, Seq.empty) uniques checkAugments :: Map NontermIdent (Attributes, Attributes) -> NontermIdent -> ConstructorIdent -> [AugmentInfo] -> AugmentsAndErrors checkAugments allAttrs nt _ augments = let checkAugment (ident,expr) (as,errs) = if ident `Map.member` as then (Map.update (\vs -> Just (vs ++ [expr])) ident as, errs) else if Map.member ident syns then (Map.insert ident [expr] as, errs) else (as, ((Seq.<|)) (MissingSyn nt ident) errs) (_,syns) = Map.findWithDefault (Map.empty,Map.empty) nt allAttrs in foldr checkAugment (Map.empty, Seq.empty) augments checkArounds :: DataTypes -> NontermIdent -> ConstructorIdent -> [AroundInfo] -> AroundsAndErrors checkArounds fieldMap nt con arounds = let checkAround (ident,expr) (as,errs) = if ident `Map.member` as then (Map.update (\vs -> Just (vs ++ [expr])) ident as, errs) else case lookup ident fields of Just (NT _ _ _) -> (Map.insert ident [expr] as, errs) _ -> (as, ((Seq.<|)) (UndefChild nt con ident) errs) fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fieldMap) in foldr checkAround (Map.empty, Seq.empty) arounds checkMerges :: Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [Identifier]) -> DataTypes -> NontermIdent -> ConstructorIdent -> [MergeInfo] -> MergesAndErrors checkMerges allNts allInsts fieldMap _ con merges = let checkMerge (target,nt,sources,expr) (m,errs) = let fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fieldMap) insts = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allInsts) allFields = insts ++ map fst fields -- note: sources of merge may not contain a target (for simplicity) in if target `Map.member` m -- check for duplicate with self then (m, DupChild nt con target (fst $ Map.elemAt (Map.findIndex target m) m) Seq.<| errs) else if target `elem` allFields then (m, DupChild nt con target (head $ filter (== target) allFields) Seq.<| errs) else let missing = filter (\s -> not (s `elem` allFields)) sources in if null missing then if nt `Set.member` allNts -- check if the nonterm is defined then (Map.insert target (nt, sources, expr) m, errs) -- all ok.. else (m, UndefNont nt Seq.<| errs) else (m, (Seq.fromList $ map (UndefChild nt con) missing) Seq.>< errs) in foldr checkMerge (Map.empty, Seq.empty) merges unionunionplusplus :: Map NontermIdent (Map ConstructorIdent [a]) -> Map NontermIdent (Map ConstructorIdent [a]) -> Map NontermIdent (Map ConstructorIdent [a]) unionunionplusplus = Map.unionWith (Map.unionWith (++)) {-# LINE 273 "dist/build/Transform.hs" #-} {-# LINE 511 "src-ag/Transform.ag" #-} mkUniqueRules :: Options -> Map NontermIdent (Map ConstructorIdent [RuleInfo]) -> DataTypes -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> Map NontermIdent (Attributes,Attributes) -> NontermIdent -> ConstructorIdent -> Map Identifier Identifier -> [Rule] mkUniqueRules opts allRules allFields allInsts allAttrDecls nt con usMap = map apply groups where fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allFields) ++ Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allInsts) -- may have duplicates attrDefs = let projectDefs (_,_,_,defs,_,_,_,_) = defs in concatMap projectDefs $ Map.findWithDefault [] con $ Map.findWithDefault Map.empty nt allRules groups = Map.assocs $ Map.foldrWithKey (\i r m -> Map.insertWith (++) r [i] m) Map.empty usMap apply (ref,us) = mkRule ref (findOutField ref) us findOutField ref = case [ chld | (chld, NT tp _ _) <- fields, tp `hasSyn` ref] of [] -> _LHS (x:_) -> x hasSyn tp ref = Map.member ref $ snd $ Map.findWithDefault (Map.empty,Map.empty) tp allAttrDecls mkRule ref outFld locAttrs = let locs = filter (not . existsLoc) locAttrs outAttr = attr outFld ref defs = (if hasOut then [] else [outAttr]) ++ [attr _LOC u | u <- locs ] pat = Product noPos defs rhs = Expression noPos $ wrap ref $ foldr gencase (finalout hasOut locs) locs -- [HsToken ("mkUniques" ++ show (length locAttrs) ++ " ") noPos, AGField _LHS ref noPos Nothing] rul = Rule Nothing pat rhs False "-- generated by the unique rule mechanism." False True False Nothing False hasOut = exists outAttr exists (Alias fld a _) = (fld,a) `elem` attrDefs exists _ = False existsLoc nm = exists (attr _LOC nm) in rul attr fld a = Alias fld a (Underscore noPos) gencase nm outp = h ("case " ++ uniqueDispenser opts ++ " __cont of { (__cont, " ++ getName nm ++ ") -> ") ++ outp ++ h "}" h s = [HsToken s noPos] finalout noGenCont us = h ("(" ++ concat (intersperse "," ( (if noGenCont then [] else ["__cont"]) ++ map getName us)) ++ ")") wrap ref inp = h "let __cont = " ++ [AGField _LHS ref noPos Nothing] ++ h " in seq __cont ( " ++ inp ++ h " )" {-# LINE 313 "dist/build/Transform.hs" #-} {-# LINE 747 "src-ag/Transform.ag" #-} flattenDatas :: DataTypes -> Map NontermIdent (Set NontermIdent) flattenDatas ds = Map.map flatten ds where flatten cs = Set.fromList [ nt | (_, NT nt _ _) <- concatMap snd (Map.toList cs)] reachableFrom :: Map NontermIdent (Set NontermIdent) -> Set NontermIdent -> Set NontermIdent reachableFrom table = reach where reach nts = let nts' = Set.unions (nts : [ ns | nt <- Set.toList nts , let ns = Map.findWithDefault Set.empty nt table ]) in if Set.size nts' > Set.size nts then reach nts' else nts invert :: Map NontermIdent (Set NontermIdent) -> Map NontermIdent (Set NontermIdent) invert = foldr inv Map.empty . Map.toList where inv (x,ns) m = fold (\n m' -> Map.insertWith Set.union n (Set.singleton x) m') m ns path :: Map NontermIdent (Set NontermIdent) -> NontermIdent -> NontermIdent -> Set NontermIdent path table from to = let children = Map.findWithDefault Set.empty from table forward = reachableFrom table children backward = reachableFrom (invert table) (Set.singleton to) in Set.intersection forward backward {-# LINE 338 "dist/build/Transform.hs" #-} {-# LINE 874 "src-ag/Transform.ag" #-} extract :: String -> [String] extract s = case dropWhile isSeparator s of "" -> [] s' -> w : extract s'' where (w, s'') = break isSeparator s' isSeparator :: Char -> Bool isSeparator x = x == '_' {-# LINE 349 "dist/build/Transform.hs" #-} {-# LINE 900 "src-ag/Transform.ag" #-} pragmaMapUnion :: PragmaMap -> PragmaMap -> PragmaMap pragmaMapUnion = Map.unionWith (Map.unionWith Set.union) pragmaMapSingle :: NontermIdent -> ConstructorIdent -> Set Identifier -> PragmaMap pragmaMapSingle nt con nms = Map.singleton nt (Map.singleton con nms) {-# LINE 358 "dist/build/Transform.hs" #-} {-# LINE 932 "src-ag/Transform.ag" #-} orderMapUnion :: AttrOrderMap -> AttrOrderMap -> AttrOrderMap orderMapUnion = Map.unionWith (Map.unionWith Set.union) orderMapSingle :: NontermIdent -> ConstructorIdent -> Set Dependency -> AttrOrderMap orderMapSingle nt con deps = Map.singleton nt (Map.singleton con deps) {-# LINE 367 "dist/build/Transform.hs" #-} {-# LINE 958 "src-ag/Transform.ag" #-} mergeParams :: ParamMap -> ParamMap -> ParamMap mergeParams = Map.unionWith (++) {-# LINE 373 "dist/build/Transform.hs" #-} {-# LINE 981 "src-ag/Transform.ag" #-} mergeCtx :: ContextMap -> ContextMap -> ContextMap mergeCtx = Map.unionWith nubconcat where nubconcat a b = nub (a ++ b) {-# LINE 381 "dist/build/Transform.hs" #-} {-# LINE 1000 "src-ag/Transform.ag" #-} mergeQuant :: QuantMap -> QuantMap -> QuantMap mergeQuant = Map.unionWith (++) {-# LINE 387 "dist/build/Transform.hs" #-} {-# LINE 1011 "src-ag/Transform.ag" #-} mergeDerivings :: Derivings -> Derivings -> Derivings mergeDerivings m1 m2 = foldr (\(n,cs) m -> Map.insertWith Set.union n cs m) m2 (Map.toList m1) {-# LINE 393 "dist/build/Transform.hs" #-} {-# LINE 1023 "src-ag/Transform.ag" #-} merge ::(Ord k, Ord k1) => Map k (Map k1 a) -> Map k (Map k1 a) -> Map k (Map k1 a) merge x y = foldr f y (Map.toList x) where f ~(k,v) m = Map.insertWith (Map.union) k v m {-# LINE 400 "dist/build/Transform.hs" #-} {-# LINE 1066 "src-ag/Transform.ag" #-} checkAttrs :: DataTypes -> [NontermIdent] -> [(Identifier, a)] -> [(Identifier, b)] -> Map NontermIdent (Map Identifier a, Map Identifier b) -> (Map NontermIdent (Map Identifier a, Map Identifier b), Seq Error) checkAttrs allFields nts inherited synthesized decls' = foldErrors check decls' nts where check nt decls | not (nt `Map.member` allFields) = (decls,Seq.singleton(UndefNont nt)) | otherwise = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt decls (inh',einh) = checkDuplicates (DupInhAttr nt) inherited inh (syn',esyn) = checkDuplicates (DupSynAttr nt) synthesized syn in (Map.insert nt (inh',syn') decls,einh >< esyn) {-# LINE 411 "dist/build/Transform.hs" #-} {-# LINE 1078 "src-ag/Transform.ag" #-} addSelf :: Ord k1 => k1 -> Map k1 (Map k a, Attributes) -> Map k1 (Map k a, Attributes) addSelf name atMap = let (eInh,eSyn) = Map.findWithDefault(Map.empty,Map.empty) name atMap in Map.insert name (eInh, Map.insert (Ident "self" noPos) Self eSyn)atMap {-# LINE 418 "dist/build/Transform.hs" #-} {-# LINE 1216 "src-ag/Transform.ag" #-} -- We want the last Just in the list flipmplus = flip mplus {-# LINE 424 "dist/build/Transform.hs" #-} {-# LINE 1224 "src-ag/Transform.ag" #-} makeType :: Set NontermIdent -> Type -> Type makeType nts tp@(NT x _ _) | Set.member x nts = tp | otherwise = Haskell (typeToHaskellString Nothing [] tp) makeType _ tp = tp {-# LINE 432 "dist/build/Transform.hs" #-} {-# LINE 1230 "src-ag/Transform.ag" #-} constructGrammar :: Set NontermIdent -> ParamMap -> Map NontermIdent (Map ConstructorIdent (Set Identifier)) -> DataTypes -> Map NontermIdent [ConstructorIdent] -> Map NontermIdent (Map ConstructorIdent [Type]) -> Map NontermIdent (Attributes, Attributes) -> Map NontermIdent (Map Identifier (String, String, String)) -> Derivings -> Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [Rule]) -> Map NontermIdent (Map ConstructorIdent [TypeSig]) -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> TypeSyns -> PragmaMap -> AttrOrderMap -> ContextMap -> QuantMap -> UniqueMap -> Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) -> Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) -> Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) -> Map NontermIdent (Map ConstructorIdent MaybeMacro) -> Grammar constructGrammar _ ntParams prodParams gram prodOrder constraints attrs uses derivings wrap allrules tsigs allinsts tsyns pragmaMap orderMap contextMap quantMap uniqueMap augmentsMap aroundsMap mergeMap macros = let gr = [ (nt,alts) | (nt,alts) <- Map.toList gram] nonts = map nont gr nont (nt,alts) = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt attrs rmap = Map.findWithDefault Map.empty nt allrules tsmap = Map.findWithDefault Map.empty nt tsigs instsmap = Map.findWithDefault Map.empty nt allinsts params = Map.findWithDefault [] nt ntParams mergemap = Map.findWithDefault Map.empty nt mergeMap macromap = Map.findWithDefault Map.empty nt macros csmap = Map.findWithDefault Map.empty nt constraints psmap = Map.findWithDefault Map.empty nt prodParams prs = Map.findWithDefault [] nt prodOrder alt con = let flds = Map.findWithDefault [] con alts rules = Map.findWithDefault [] con rmap tsigs' = Map.findWithDefault [] con tsmap insts = Map.findWithDefault [] con instsmap merges = [ (n, NT t [] False) | (n, (t, _, _)) <- Map.assocs $ maybe Map.empty id (Map.lookup con mergemap) ] cs = Map.findWithDefault [] con csmap ps = Set.elems $ Map.findWithDefault Set.empty con psmap mbMacro = Map.findWithDefault Nothing con macromap -- important: keep order of children cldrn = map child (flds ++ filter (not . existsAsField) insts ++ merges) child (nm, tp) = let tpI = if existsAsInst nm then fromJust $ lookup nm insts else tp virt = if existsAsInst nm then case lookup nm flds of Just tp' -> ChildReplace tp' Nothing -> ChildAttr else if existsAsMerge nm then ChildAttr else ChildSyntax in Child nm tpI virt existsAsInst nm = maybe False (const True) (lookup nm insts) existsAsField (nm,_) = maybe False (const True) (lookup nm flds) existsAsMerge nm = maybe False (const True) (lookup nm merges) in Production con ps cs cldrn rules tsigs' mbMacro in Nonterminal nt params inh syn (map alt prs) in Grammar tsyns uses derivings wrap nonts pragmaMap orderMap ntParams contextMap quantMap uniqueMap augmentsMap aroundsMap mergeMap {-# LINE 504 "dist/build/Transform.hs" #-} {-# LINE 1301 "src-ag/Transform.ag" #-} mapUnionWithSetUnion :: Map NontermIdent (Set ConstructorIdent) -> Map NontermIdent (Set ConstructorIdent) -> Map NontermIdent (Set ConstructorIdent) mapUnionWithSetUnion = Map.unionWith Set.union mapUnionWithPlusPlus :: Map BlockInfo [a] -> Map BlockInfo [a] -> Map BlockInfo [a] mapUnionWithPlusPlus = Map.unionWith (++) {-# LINE 512 "dist/build/Transform.hs" #-} -- AG ---------------------------------------------------------- -- wrapper data Inh_AG = Inh_AG { options_Inh_AG :: (Options) } data Syn_AG = Syn_AG { agi_Syn_AG :: ((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))), blocks_Syn_AG :: (Blocks), constructorTypeMap_Syn_AG :: (Map NontermIdent ConstructorType), errors_Syn_AG :: (Seq Error), moduleDecl_Syn_AG :: (Maybe (String,String,String)), output_Syn_AG :: (Grammar), pragmas_Syn_AG :: (Options -> Options) } {-# INLINABLE wrap_AG #-} wrap_AG :: T_AG -> Inh_AG -> (Syn_AG ) wrap_AG (T_AG act) (Inh_AG _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_AG_vIn1 _lhsIoptions (T_AG_vOut1 _lhsOagi _lhsOblocks _lhsOconstructorTypeMap _lhsOerrors _lhsOmoduleDecl _lhsOoutput _lhsOpragmas) <- return (inv_AG_s2 sem arg1) return (Syn_AG _lhsOagi _lhsOblocks _lhsOconstructorTypeMap _lhsOerrors _lhsOmoduleDecl _lhsOoutput _lhsOpragmas) ) -- cata {-# INLINE sem_AG #-} sem_AG :: AG -> T_AG sem_AG ( AG elems_ ) = sem_AG_AG ( sem_Elems elems_ ) -- semantic domain newtype T_AG = T_AG { attach_T_AG :: Identity (T_AG_s2 ) } newtype T_AG_s2 = C_AG_s2 { inv_AG_s2 :: (T_AG_v1 ) } data T_AG_s3 = C_AG_s3 type T_AG_v1 = (T_AG_vIn1 ) -> (T_AG_vOut1 ) data T_AG_vIn1 = T_AG_vIn1 (Options) data T_AG_vOut1 = T_AG_vOut1 ((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) (Blocks) (Map NontermIdent ConstructorType) (Seq Error) (Maybe (String,String,String)) (Grammar) (Options -> Options) {-# NOINLINE sem_AG_AG #-} sem_AG_AG :: T_Elems -> T_AG sem_AG_AG arg_elems_ = T_AG (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_AG_v1 v1 = \ (T_AG_vIn1 _lhsIoptions) -> ( let _elemsX20 = Control.Monad.Identity.runIdentity (attach_T_Elems (arg_elems_)) (T_Elems_vOut19 _elemsIattrDecls _elemsIattrOrderCollect _elemsIattrs _elemsIblocks _elemsIcollectedArounds _elemsIcollectedAugments _elemsIcollectedConParams _elemsIcollectedConstraints _elemsIcollectedConstructorsMap _elemsIcollectedFields _elemsIcollectedInsts _elemsIcollectedMacros _elemsIcollectedMerges _elemsIcollectedNames _elemsIcollectedRules _elemsIcollectedSetNames _elemsIcollectedSigs _elemsIcollectedUniques _elemsIconstructorTypeMap _elemsIctxCollect _elemsIdefSets _elemsIderivings _elemsIerrors _elemsImoduleDecl _elemsIparamsCollect _elemsIpragmas _elemsIquantCollect _elemsIsemPragmasCollect _elemsItypeSyns _elemsIuseMap _elemsIwrappers) = inv_Elems_s20 _elemsX20 (T_Elems_vIn19 _elemsOallAttrDecls _elemsOallAttrs _elemsOallConstructors _elemsOallFields _elemsOallNonterminals _elemsOattrDecls _elemsOattrs _elemsOdefSets _elemsOdefinedSets _elemsOoptions) _lhsOoutput :: Grammar _lhsOoutput = rule0 _allAttrDecls _allConParams _allConstraints _allFields _allMacros _allNonterminals _checkedArounds _checkedAugments _checkedInsts _checkedMerges _checkedRules _checkedSigs _checkedUniques _elemsIattrOrderCollect _elemsIctxCollect _elemsIderivings _elemsIparamsCollect _elemsIquantCollect _elemsIsemPragmasCollect _elemsItypeSyns _elemsIuseMap _elemsIwrappers _lhsIoptions _prodOrder _prodOrder = rule1 _elemsIcollectedFields _allFields = rule2 _elemsIcollectedFields _allConstraints = rule3 _elemsIcollectedConstraints _allConParams = rule4 _elemsIcollectedConParams _allConstrs = rule5 _elemsIcollectedFields _allRules = rule6 _elemsIcollectedRules _allSigs = rule7 _allAttrDecls _elemsIcollectedSigs _elemsIcollectedUniques _allInsts = rule8 _elemsIcollectedInsts _allUniques = rule9 _elemsIcollectedUniques _allAugments = rule10 _elemsIcollectedAugments _allArounds = rule11 _elemsIcollectedArounds _allMerges = rule12 _elemsIcollectedMerges _augmentSigs = rule13 _allAugments _allRulesErrs = rule14 _allAttrDecls _allFields _allInsts _allMerges _allRules _allSigs _allNamesErrs = rule15 _allRules _allSigsErrs = rule16 _allSigs _allInstsErrs = rule17 _allFields _allInsts _allNonterminals _allSigs _allUniquesErrs = rule18 _allAttrDecls _allUniques _allAugmentErrs = rule19 _allAttrDecls _allAugments _allAroundsErrs = rule20 _allArounds _allFields _allMergesErrs = rule21 _allFields _allInsts _allMerges _allNonterminals _checkedRulesPre = rule22 _allRulesErrs _checkedSigs = rule23 _allSigsErrs _augmentSigs _checkedInsts = rule24 _allInstsErrs _checkedUniques = rule25 _allUniquesErrs _checkedAugments = rule26 _allAugmentErrs _checkedArounds = rule27 _allAroundsErrs _checkedRules = rule28 _allAttrDecls _allFields _allRules _checkedInsts _checkedRulesPre _checkedUniques _lhsIoptions _checkedMerges = rule29 _allMergesErrs _errs1 = rule30 _elemsItypeSyns _errs2 = rule31 _allFields _errs3 = rule32 () _errs4 = rule33 _allRulesErrs _errs5 = rule34 _allSigsErrs _errs6 = rule35 _allInstsErrs _errs7 = rule36 _allUniquesErrs _errs8 = rule37 _allAugmentErrs _errs9 = rule38 _allAroundsErrs _errs10 = rule39 _allNamesErrs _errs11 = rule40 _allMergesErrs _lhsOerrors :: Seq Error _lhsOerrors = rule41 _elemsIerrors _errs1 _errs10 _errs11 _errs2 _errs3 _errs4 _errs5 _errs6 _errs7 _errs8 _errs9 _allNonterminals = rule42 _elemsIcollectedNames _elemsIcollectedSetNames _elemsOallConstructors = rule43 _elemsIcollectedConstructorsMap _elemsOdefSets = rule44 _allNonterminals _elemsOdefinedSets = rule45 _elemsIdefSets _elemsOattrDecls = rule46 () _allAttrDecls = rule47 _allNonterminals _elemsIattrDecls _lhsIoptions _allMacros = rule48 _elemsIcollectedMacros _lhsOagi :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes)) _lhsOagi = rule49 _allAttrs _allFields _allNonterminals _allAttrs = rule50 _allNonterminals _elemsIattrs _lhsIoptions _elemsOattrs = rule51 () _lhsOblocks :: Blocks _lhsOblocks = rule52 _elemsIblocks _lhsOconstructorTypeMap :: Map NontermIdent ConstructorType _lhsOconstructorTypeMap = rule53 _elemsIconstructorTypeMap _lhsOmoduleDecl :: Maybe (String,String,String) _lhsOmoduleDecl = rule54 _elemsImoduleDecl _lhsOpragmas :: Options -> Options _lhsOpragmas = rule55 _elemsIpragmas _elemsOallAttrDecls = rule56 _allAttrDecls _elemsOallAttrs = rule57 _allAttrs _elemsOallFields = rule58 _allFields _elemsOallNonterminals = rule59 _allNonterminals _elemsOoptions = rule60 _lhsIoptions __result_ = T_AG_vOut1 _lhsOagi _lhsOblocks _lhsOconstructorTypeMap _lhsOerrors _lhsOmoduleDecl _lhsOoutput _lhsOpragmas in __result_ ) in C_AG_s2 v1 {-# INLINE rule0 #-} {-# LINE 50 "src-ag/Transform.ag" #-} rule0 = \ _allAttrDecls _allConParams _allConstraints _allFields _allMacros _allNonterminals _checkedArounds _checkedAugments _checkedInsts _checkedMerges _checkedRules _checkedSigs _checkedUniques ((_elemsIattrOrderCollect) :: AttrOrderMap) ((_elemsIctxCollect) :: ContextMap) ((_elemsIderivings) :: Derivings) ((_elemsIparamsCollect) :: ParamMap) ((_elemsIquantCollect) :: QuantMap) ((_elemsIsemPragmasCollect) :: PragmaMap) ((_elemsItypeSyns) :: TypeSyns) ((_elemsIuseMap) :: Map NontermIdent (Map Identifier (String,String,String))) ((_elemsIwrappers) :: Set NontermIdent) ((_lhsIoptions) :: Options) _prodOrder -> {-# LINE 50 "src-ag/Transform.ag" #-} constructGrammar _allNonterminals _elemsIparamsCollect _allConParams _allFields _prodOrder _allConstraints _allAttrDecls _elemsIuseMap _elemsIderivings (if wrappers _lhsIoptions then _allNonterminals else _elemsIwrappers) _checkedRules _checkedSigs _checkedInsts _elemsItypeSyns _elemsIsemPragmasCollect _elemsIattrOrderCollect _elemsIctxCollect _elemsIquantCollect _checkedUniques _checkedAugments _checkedArounds _checkedMerges _allMacros {-# LINE 650 "dist/build/Transform.hs"#-} {-# INLINE rule1 #-} {-# LINE 258 "src-ag/Transform.ag" #-} rule1 = \ ((_elemsIcollectedFields) :: [(NontermIdent, ConstructorIdent, FieldMap)]) -> {-# LINE 258 "src-ag/Transform.ag" #-} let f (nt,con,_) = Map.insertWith g nt [con] g [con] lst | con `elem` lst = lst | otherwise = con : lst g _ _ = error "This is not possible" in foldr f Map.empty _elemsIcollectedFields {-# LINE 660 "dist/build/Transform.hs"#-} {-# INLINE rule2 #-} {-# LINE 263 "src-ag/Transform.ag" #-} rule2 = \ ((_elemsIcollectedFields) :: [(NontermIdent, ConstructorIdent, FieldMap)]) -> {-# LINE 263 "src-ag/Transform.ag" #-} let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm) in foldr f (Map.empty) _elemsIcollectedFields {-# LINE 667 "dist/build/Transform.hs"#-} {-# INLINE rule3 #-} {-# LINE 266 "src-ag/Transform.ag" #-} rule3 = \ ((_elemsIcollectedConstraints) :: [(NontermIdent, ConstructorIdent, [Type])]) -> {-# LINE 266 "src-ag/Transform.ag" #-} let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm) in foldr f (Map.empty) _elemsIcollectedConstraints {-# LINE 674 "dist/build/Transform.hs"#-} {-# INLINE rule4 #-} {-# LINE 269 "src-ag/Transform.ag" #-} rule4 = \ ((_elemsIcollectedConParams) :: [(NontermIdent, ConstructorIdent, Set Identifier)]) -> {-# LINE 269 "src-ag/Transform.ag" #-} let f (nt,con,fm) = Map.insertWith (Map.unionWith Set.union) nt (Map.singleton con fm) in foldr f (Map.empty) _elemsIcollectedConParams {-# LINE 681 "dist/build/Transform.hs"#-} {-# INLINE rule5 #-} {-# LINE 272 "src-ag/Transform.ag" #-} rule5 = \ ((_elemsIcollectedFields) :: [(NontermIdent, ConstructorIdent, FieldMap)]) -> {-# LINE 272 "src-ag/Transform.ag" #-} let f (nt,con,_) = Map.insertWith (++) nt [con] in foldr f (Map.empty) _elemsIcollectedFields {-# LINE 688 "dist/build/Transform.hs"#-} {-# INLINE rule6 #-} {-# LINE 275 "src-ag/Transform.ag" #-} rule6 = \ ((_elemsIcollectedRules) :: [ (NontermIdent, ConstructorIdent, RuleInfo)]) -> {-# LINE 275 "src-ag/Transform.ag" #-} let f (nt,con,r) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [r]) in foldr f (Map.empty) _elemsIcollectedRules {-# LINE 695 "dist/build/Transform.hs"#-} {-# INLINE rule7 #-} {-# LINE 278 "src-ag/Transform.ag" #-} rule7 = \ _allAttrDecls ((_elemsIcollectedSigs) :: [ (NontermIdent, ConstructorIdent, SigInfo) ]) ((_elemsIcollectedUniques) :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) -> {-# LINE 278 "src-ag/Transform.ag" #-} let f (nt,con,t) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [t]) typeof nt r = Map.findWithDefault (Haskell "") r $ fst $ Map.findWithDefault (Map.empty,Map.empty) nt _allAttrDecls in foldr f (Map.empty) ( _elemsIcollectedSigs ++ [ (nt, con, (ident,typeof nt ref)) | (nt, con, us) <- _elemsIcollectedUniques, (ident,ref) <- us ] ) {-# LINE 705 "dist/build/Transform.hs"#-} {-# INLINE rule8 #-} {-# LINE 284 "src-ag/Transform.ag" #-} rule8 = \ ((_elemsIcollectedInsts) :: [ (NontermIdent, ConstructorIdent, [Identifier]) ]) -> {-# LINE 284 "src-ag/Transform.ag" #-} let f (nt,con,is) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con is) in foldr f (Map.empty) _elemsIcollectedInsts {-# LINE 712 "dist/build/Transform.hs"#-} {-# INLINE rule9 #-} {-# LINE 287 "src-ag/Transform.ag" #-} rule9 = \ ((_elemsIcollectedUniques) :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) -> {-# LINE 287 "src-ag/Transform.ag" #-} let f (nt,con,us) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con us) in foldr f (Map.empty) _elemsIcollectedUniques {-# LINE 719 "dist/build/Transform.hs"#-} {-# INLINE rule10 #-} {-# LINE 289 "src-ag/Transform.ag" #-} rule10 = \ ((_elemsIcollectedAugments) :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) -> {-# LINE 289 "src-ag/Transform.ag" #-} let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as) in foldr f Map.empty _elemsIcollectedAugments {-# LINE 726 "dist/build/Transform.hs"#-} {-# INLINE rule11 #-} {-# LINE 291 "src-ag/Transform.ag" #-} rule11 = \ ((_elemsIcollectedArounds) :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) -> {-# LINE 291 "src-ag/Transform.ag" #-} let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as) in foldr f Map.empty _elemsIcollectedArounds {-# LINE 733 "dist/build/Transform.hs"#-} {-# INLINE rule12 #-} {-# LINE 293 "src-ag/Transform.ag" #-} rule12 = \ ((_elemsIcollectedMerges) :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) -> {-# LINE 293 "src-ag/Transform.ag" #-} let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as) in foldr f Map.empty _elemsIcollectedMerges {-# LINE 740 "dist/build/Transform.hs"#-} {-# INLINE rule13 #-} {-# LINE 296 "src-ag/Transform.ag" #-} rule13 = \ _allAugments -> {-# LINE 296 "src-ag/Transform.ag" #-} let gen _ = [] in Map.map (Map.map gen) _allAugments {-# LINE 747 "dist/build/Transform.hs"#-} {-# INLINE rule14 #-} {-# LINE 299 "src-ag/Transform.ag" #-} rule14 = \ _allAttrDecls _allFields _allInsts _allMerges _allRules _allSigs -> {-# LINE 299 "src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . (checkRules _allAttrDecls _allFields _allInsts _allSigs _allMerges )) _allRules {-# LINE 753 "dist/build/Transform.hs"#-} {-# INLINE rule15 #-} {-# LINE 300 "src-ag/Transform.ag" #-} rule15 = \ _allRules -> {-# LINE 300 "src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . checkRuleNames) _allRules {-# LINE 759 "dist/build/Transform.hs"#-} {-# INLINE rule16 #-} {-# LINE 301 "src-ag/Transform.ag" #-} rule16 = \ _allSigs -> {-# LINE 301 "src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . (checkSigs )) _allSigs {-# LINE 765 "dist/build/Transform.hs"#-} {-# INLINE rule17 #-} {-# LINE 302 "src-ag/Transform.ag" #-} rule17 = \ _allFields _allInsts _allNonterminals _allSigs -> {-# LINE 302 "src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . (checkInsts _allNonterminals _allSigs _allFields )) _allInsts {-# LINE 771 "dist/build/Transform.hs"#-} {-# INLINE rule18 #-} {-# LINE 303 "src-ag/Transform.ag" #-} rule18 = \ _allAttrDecls _allUniques -> {-# LINE 303 "src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . (checkUniques _allAttrDecls )) _allUniques {-# LINE 777 "dist/build/Transform.hs"#-} {-# INLINE rule19 #-} {-# LINE 304 "src-ag/Transform.ag" #-} rule19 = \ _allAttrDecls _allAugments -> {-# LINE 304 "src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . (checkAugments _allAttrDecls )) _allAugments {-# LINE 783 "dist/build/Transform.hs"#-} {-# INLINE rule20 #-} {-# LINE 305 "src-ag/Transform.ag" #-} rule20 = \ _allArounds _allFields -> {-# LINE 305 "src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . (checkArounds _allFields )) _allArounds {-# LINE 789 "dist/build/Transform.hs"#-} {-# INLINE rule21 #-} {-# LINE 306 "src-ag/Transform.ag" #-} rule21 = \ _allFields _allInsts _allMerges _allNonterminals -> {-# LINE 306 "src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . (checkMerges _allNonterminals _allInsts _allFields )) _allMerges {-# LINE 795 "dist/build/Transform.hs"#-} {-# INLINE rule22 #-} {-# LINE 308 "src-ag/Transform.ag" #-} rule22 = \ _allRulesErrs -> {-# LINE 308 "src-ag/Transform.ag" #-} Map.map (Map.map fst) _allRulesErrs {-# LINE 801 "dist/build/Transform.hs"#-} {-# INLINE rule23 #-} {-# LINE 309 "src-ag/Transform.ag" #-} rule23 = \ _allSigsErrs _augmentSigs -> {-# LINE 309 "src-ag/Transform.ag" #-} Map.map (Map.map fst) _allSigsErrs `unionunionplusplus` _augmentSigs {-# LINE 807 "dist/build/Transform.hs"#-} {-# INLINE rule24 #-} {-# LINE 310 "src-ag/Transform.ag" #-} rule24 = \ _allInstsErrs -> {-# LINE 310 "src-ag/Transform.ag" #-} Map.map (Map.map fst) _allInstsErrs {-# LINE 813 "dist/build/Transform.hs"#-} {-# INLINE rule25 #-} {-# LINE 311 "src-ag/Transform.ag" #-} rule25 = \ _allUniquesErrs -> {-# LINE 311 "src-ag/Transform.ag" #-} Map.map (Map.map fst) _allUniquesErrs {-# LINE 819 "dist/build/Transform.hs"#-} {-# INLINE rule26 #-} {-# LINE 312 "src-ag/Transform.ag" #-} rule26 = \ _allAugmentErrs -> {-# LINE 312 "src-ag/Transform.ag" #-} Map.map (Map.map fst) _allAugmentErrs {-# LINE 825 "dist/build/Transform.hs"#-} {-# INLINE rule27 #-} {-# LINE 313 "src-ag/Transform.ag" #-} rule27 = \ _allAroundsErrs -> {-# LINE 313 "src-ag/Transform.ag" #-} Map.map (Map.map fst) _allAroundsErrs {-# LINE 831 "dist/build/Transform.hs"#-} {-# INLINE rule28 #-} {-# LINE 314 "src-ag/Transform.ag" #-} rule28 = \ _allAttrDecls _allFields _allRules _checkedInsts _checkedRulesPre _checkedUniques ((_lhsIoptions) :: Options) -> {-# LINE 314 "src-ag/Transform.ag" #-} Map.unionWith (Map.unionWith (++)) _checkedRulesPre (Map.mapWithKey (Map.mapWithKey . (mkUniqueRules _lhsIoptions _allRules _allFields _checkedInsts _allAttrDecls )) _checkedUniques ) {-# LINE 837 "dist/build/Transform.hs"#-} {-# INLINE rule29 #-} {-# LINE 315 "src-ag/Transform.ag" #-} rule29 = \ _allMergesErrs -> {-# LINE 315 "src-ag/Transform.ag" #-} Map.map (Map.map fst) _allMergesErrs {-# LINE 843 "dist/build/Transform.hs"#-} {-# INLINE rule30 #-} {-# LINE 317 "src-ag/Transform.ag" #-} rule30 = \ ((_elemsItypeSyns) :: TypeSyns) -> {-# LINE 317 "src-ag/Transform.ag" #-} let f = checkForDuplicates (DupSynonym) in Seq.fromList . f . map fst $ _elemsItypeSyns {-# LINE 850 "dist/build/Transform.hs"#-} {-# INLINE rule31 #-} {-# LINE 320 "src-ag/Transform.ag" #-} rule31 = \ _allFields -> {-# LINE 320 "src-ag/Transform.ag" #-} let g nt (con,fm) = checkForDuplicates (DupChild nt con) (map fst fm) f (nt,cfm) = concat . map (g nt) . Map.toList $ cfm in Seq.fromList . concat . map f . Map.toList $ _allFields {-# LINE 858 "dist/build/Transform.hs"#-} {-# INLINE rule32 #-} {-# LINE 324 "src-ag/Transform.ag" #-} rule32 = \ (_ :: ()) -> {-# LINE 324 "src-ag/Transform.ag" #-} let in Seq.empty {-# LINE 865 "dist/build/Transform.hs"#-} {-# INLINE rule33 #-} {-# LINE 328 "src-ag/Transform.ag" #-} rule33 = \ _allRulesErrs -> {-# LINE 328 "src-ag/Transform.ag" #-} let f m s = Map.foldr ((><) . snd) s m in Map.foldr f Seq.empty _allRulesErrs {-# LINE 872 "dist/build/Transform.hs"#-} {-# INLINE rule34 #-} {-# LINE 331 "src-ag/Transform.ag" #-} rule34 = \ _allSigsErrs -> {-# LINE 331 "src-ag/Transform.ag" #-} let f m s = Map.foldr ((><) . snd) s m in Map.foldr f Seq.empty _allSigsErrs {-# LINE 879 "dist/build/Transform.hs"#-} {-# INLINE rule35 #-} {-# LINE 334 "src-ag/Transform.ag" #-} rule35 = \ _allInstsErrs -> {-# LINE 334 "src-ag/Transform.ag" #-} let f m s = Map.foldr ((><) . snd) s m in Map.foldr f Seq.empty _allInstsErrs {-# LINE 886 "dist/build/Transform.hs"#-} {-# INLINE rule36 #-} {-# LINE 337 "src-ag/Transform.ag" #-} rule36 = \ _allUniquesErrs -> {-# LINE 337 "src-ag/Transform.ag" #-} let f m s = Map.foldr ((><) . snd) s m in Map.foldr f Seq.empty _allUniquesErrs {-# LINE 893 "dist/build/Transform.hs"#-} {-# INLINE rule37 #-} {-# LINE 340 "src-ag/Transform.ag" #-} rule37 = \ _allAugmentErrs -> {-# LINE 340 "src-ag/Transform.ag" #-} let f m s = Map.foldr ((><) . snd) s m in Map.foldr f Seq.empty _allAugmentErrs {-# LINE 900 "dist/build/Transform.hs"#-} {-# INLINE rule38 #-} {-# LINE 343 "src-ag/Transform.ag" #-} rule38 = \ _allAroundsErrs -> {-# LINE 343 "src-ag/Transform.ag" #-} let f m s = Map.foldr ((><) . snd) s m in Map.foldr f Seq.empty _allAroundsErrs {-# LINE 907 "dist/build/Transform.hs"#-} {-# INLINE rule39 #-} {-# LINE 346 "src-ag/Transform.ag" #-} rule39 = \ _allNamesErrs -> {-# LINE 346 "src-ag/Transform.ag" #-} let f m s = Map.foldr ((><)) s m in Map.foldr f Seq.empty _allNamesErrs {-# LINE 914 "dist/build/Transform.hs"#-} {-# INLINE rule40 #-} {-# LINE 349 "src-ag/Transform.ag" #-} rule40 = \ _allMergesErrs -> {-# LINE 349 "src-ag/Transform.ag" #-} let f m s = Map.foldr ((><) . snd) s m in Map.foldr f Seq.empty _allMergesErrs {-# LINE 921 "dist/build/Transform.hs"#-} {-# INLINE rule41 #-} {-# LINE 352 "src-ag/Transform.ag" #-} rule41 = \ ((_elemsIerrors) :: Seq Error) _errs1 _errs10 _errs11 _errs2 _errs3 _errs4 _errs5 _errs6 _errs7 _errs8 _errs9 -> {-# LINE 352 "src-ag/Transform.ag" #-} _elemsIerrors >< _errs1 >< _errs2 >< _errs3 >< _errs4 >< _errs5 >< _errs6 >< _errs7 >< _errs8 >< _errs9 >< _errs10 >< _errs11 {-# LINE 927 "dist/build/Transform.hs"#-} {-# INLINE rule42 #-} {-# LINE 606 "src-ag/Transform.ag" #-} rule42 = \ ((_elemsIcollectedNames) :: Set Identifier) ((_elemsIcollectedSetNames) :: Set Identifier) -> {-# LINE 606 "src-ag/Transform.ag" #-} _elemsIcollectedNames `Set.difference` _elemsIcollectedSetNames {-# LINE 933 "dist/build/Transform.hs"#-} {-# INLINE rule43 #-} {-# LINE 626 "src-ag/Transform.ag" #-} rule43 = \ ((_elemsIcollectedConstructorsMap) :: Map NontermIdent (Set ConstructorIdent)) -> {-# LINE 626 "src-ag/Transform.ag" #-} _elemsIcollectedConstructorsMap {-# LINE 939 "dist/build/Transform.hs"#-} {-# INLINE rule44 #-} {-# LINE 709 "src-ag/Transform.ag" #-} rule44 = \ _allNonterminals -> {-# LINE 709 "src-ag/Transform.ag" #-} Map.fromList (map (\x->(x,(Set.singleton x, Set.empty))) (Set.toList _allNonterminals )) {-# LINE 945 "dist/build/Transform.hs"#-} {-# INLINE rule45 #-} {-# LINE 710 "src-ag/Transform.ag" #-} rule45 = \ ((_elemsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> {-# LINE 710 "src-ag/Transform.ag" #-} Map.map fst _elemsIdefSets {-# LINE 951 "dist/build/Transform.hs"#-} {-# INLINE rule46 #-} {-# LINE 1030 "src-ag/Transform.ag" #-} rule46 = \ (_ :: ()) -> {-# LINE 1030 "src-ag/Transform.ag" #-} Map.empty {-# LINE 957 "dist/build/Transform.hs"#-} {-# INLINE rule47 #-} {-# LINE 1086 "src-ag/Transform.ag" #-} rule47 = \ _allNonterminals ((_elemsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) ((_lhsIoptions) :: Options) -> {-# LINE 1086 "src-ag/Transform.ag" #-} if withSelf _lhsIoptions then foldr addSelf _elemsIattrDecls (Set.toList _allNonterminals ) else _elemsIattrDecls {-# LINE 965 "dist/build/Transform.hs"#-} {-# INLINE rule48 #-} {-# LINE 1328 "src-ag/Transform.ag" #-} rule48 = \ ((_elemsIcollectedMacros) :: [(NontermIdent, ConstructorIdent, MaybeMacro)]) -> {-# LINE 1328 "src-ag/Transform.ag" #-} let f (nt,con,m) = Map.insertWith (Map.union) nt (Map.singleton con m) in foldr f (Map.empty) _elemsIcollectedMacros {-# LINE 972 "dist/build/Transform.hs"#-} {-# INLINE rule49 #-} {-# LINE 1341 "src-ag/Transform.ag" #-} rule49 = \ _allAttrs _allFields _allNonterminals -> {-# LINE 1341 "src-ag/Transform.ag" #-} (_allNonterminals ,_allFields ,_allAttrs ) {-# LINE 978 "dist/build/Transform.hs"#-} {-# INLINE rule50 #-} {-# LINE 1343 "src-ag/Transform.ag" #-} rule50 = \ _allNonterminals ((_elemsIattrs) :: Map NontermIdent (Attributes, Attributes)) ((_lhsIoptions) :: Options) -> {-# LINE 1343 "src-ag/Transform.ag" #-} if withSelf _lhsIoptions then foldr addSelf _elemsIattrs (Set.toList _allNonterminals ) else _elemsIattrs {-# LINE 986 "dist/build/Transform.hs"#-} {-# INLINE rule51 #-} {-# LINE 1351 "src-ag/Transform.ag" #-} rule51 = \ (_ :: ()) -> {-# LINE 1351 "src-ag/Transform.ag" #-} Map.empty {-# LINE 992 "dist/build/Transform.hs"#-} {-# INLINE rule52 #-} rule52 = \ ((_elemsIblocks) :: Blocks) -> _elemsIblocks {-# INLINE rule53 #-} rule53 = \ ((_elemsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _elemsIconstructorTypeMap {-# INLINE rule54 #-} rule54 = \ ((_elemsImoduleDecl) :: Maybe (String,String,String)) -> _elemsImoduleDecl {-# INLINE rule55 #-} rule55 = \ ((_elemsIpragmas) :: Options -> Options) -> _elemsIpragmas {-# INLINE rule56 #-} rule56 = \ _allAttrDecls -> _allAttrDecls {-# INLINE rule57 #-} rule57 = \ _allAttrs -> _allAttrs {-# INLINE rule58 #-} rule58 = \ _allFields -> _allFields {-# INLINE rule59 #-} rule59 = \ _allNonterminals -> _allNonterminals {-# INLINE rule60 #-} rule60 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- Alt --------------------------------------------------------- -- wrapper data Inh_Alt = Inh_Alt { allConstructors_Inh_Alt :: (Map NontermIdent (Set ConstructorIdent)), allNonterminals_Inh_Alt :: (Set NontermIdent), nts_Inh_Alt :: (Set NontermIdent) } data Syn_Alt = Syn_Alt { collectedConParams_Syn_Alt :: ([(NontermIdent, ConstructorIdent, Set Identifier)]), collectedConstraints_Syn_Alt :: ([(NontermIdent, ConstructorIdent, [Type])]), collectedConstructorNames_Syn_Alt :: (Set ConstructorIdent), collectedFields_Syn_Alt :: ([(NontermIdent, ConstructorIdent, FieldMap)]), collectedMacros_Syn_Alt :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) } {-# INLINABLE wrap_Alt #-} wrap_Alt :: T_Alt -> Inh_Alt -> (Syn_Alt ) wrap_Alt (T_Alt act) (Inh_Alt _lhsIallConstructors _lhsIallNonterminals _lhsInts) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_Alt_vIn4 _lhsIallConstructors _lhsIallNonterminals _lhsInts (T_Alt_vOut4 _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorNames _lhsOcollectedFields _lhsOcollectedMacros) <- return (inv_Alt_s5 sem arg4) return (Syn_Alt _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorNames _lhsOcollectedFields _lhsOcollectedMacros) ) -- cata {-# INLINE sem_Alt #-} sem_Alt :: Alt -> T_Alt sem_Alt ( Alt pos_ names_ tyvars_ fields_ macro_ ) = sem_Alt_Alt pos_ ( sem_ConstructorSet names_ ) tyvars_ ( sem_Fields fields_ ) macro_ -- semantic domain newtype T_Alt = T_Alt { attach_T_Alt :: Identity (T_Alt_s5 ) } newtype T_Alt_s5 = C_Alt_s5 { inv_Alt_s5 :: (T_Alt_v4 ) } data T_Alt_s6 = C_Alt_s6 type T_Alt_v4 = (T_Alt_vIn4 ) -> (T_Alt_vOut4 ) data T_Alt_vIn4 = T_Alt_vIn4 (Map NontermIdent (Set ConstructorIdent)) (Set NontermIdent) (Set NontermIdent) data T_Alt_vOut4 = T_Alt_vOut4 ([(NontermIdent, ConstructorIdent, Set Identifier)]) ([(NontermIdent, ConstructorIdent, [Type])]) (Set ConstructorIdent) ([(NontermIdent, ConstructorIdent, FieldMap)]) ([(NontermIdent, ConstructorIdent, MaybeMacro)]) {-# NOINLINE sem_Alt_Alt #-} sem_Alt_Alt :: (Pos) -> T_ConstructorSet -> ([Identifier]) -> T_Fields -> (MaybeMacro) -> T_Alt sem_Alt_Alt _ arg_names_ arg_tyvars_ arg_fields_ arg_macro_ = T_Alt (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_Alt_v4 v4 = \ (T_Alt_vIn4 _lhsIallConstructors _lhsIallNonterminals _lhsInts) -> ( let _namesX14 = Control.Monad.Identity.runIdentity (attach_T_ConstructorSet (arg_names_)) _fieldsX26 = Control.Monad.Identity.runIdentity (attach_T_Fields (arg_fields_)) (T_ConstructorSet_vOut13 _namesIcollectedConstructorNames _namesIconstructors _namesIerrors) = inv_ConstructorSet_s14 _namesX14 (T_ConstructorSet_vIn13 ) (T_Fields_vOut25 _fieldsIcollectedConstraints _fieldsIcollectedFields) = inv_Fields_s26 _fieldsX26 (T_Fields_vIn25 _fieldsOallNonterminals) _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule61 _fieldsIcollectedFields _lhsIallConstructors _lhsInts _namesIconstructors _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule62 _fieldsIcollectedConstraints _lhsIallConstructors _lhsInts _namesIconstructors _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule63 _lhsIallConstructors _lhsInts _namesIconstructors arg_tyvars_ _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule64 _lhsIallConstructors _lhsInts _namesIconstructors arg_macro_ _lhsOcollectedConstructorNames :: Set ConstructorIdent _lhsOcollectedConstructorNames = rule65 _namesIcollectedConstructorNames _fieldsOallNonterminals = rule66 _lhsIallNonterminals __result_ = T_Alt_vOut4 _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorNames _lhsOcollectedFields _lhsOcollectedMacros in __result_ ) in C_Alt_s5 v4 {-# INLINE rule61 #-} {-# LINE 240 "src-ag/Transform.ag" #-} rule61 = \ ((_fieldsIcollectedFields) :: [(Identifier, Type)]) ((_lhsIallConstructors) :: Map NontermIdent (Set ConstructorIdent)) ((_lhsInts) :: Set NontermIdent) ((_namesIconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) -> {-# LINE 240 "src-ag/Transform.ag" #-} [ (nt, con, _fieldsIcollectedFields) | nt <- Set.toList _lhsInts , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) ] {-# LINE 1084 "dist/build/Transform.hs"#-} {-# INLINE rule62 #-} {-# LINE 244 "src-ag/Transform.ag" #-} rule62 = \ ((_fieldsIcollectedConstraints) :: [Type]) ((_lhsIallConstructors) :: Map NontermIdent (Set ConstructorIdent)) ((_lhsInts) :: Set NontermIdent) ((_namesIconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) -> {-# LINE 244 "src-ag/Transform.ag" #-} [ (nt, con, _fieldsIcollectedConstraints) | nt <- Set.toList _lhsInts , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) ] {-# LINE 1093 "dist/build/Transform.hs"#-} {-# INLINE rule63 #-} {-# LINE 248 "src-ag/Transform.ag" #-} rule63 = \ ((_lhsIallConstructors) :: Map NontermIdent (Set ConstructorIdent)) ((_lhsInts) :: Set NontermIdent) ((_namesIconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) tyvars_ -> {-# LINE 248 "src-ag/Transform.ag" #-} [ (nt, con, Set.fromList tyvars_) | nt <- Set.toList _lhsInts , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) ] {-# LINE 1102 "dist/build/Transform.hs"#-} {-# INLINE rule64 #-} {-# LINE 1319 "src-ag/Transform.ag" #-} rule64 = \ ((_lhsIallConstructors) :: Map NontermIdent (Set ConstructorIdent)) ((_lhsInts) :: Set NontermIdent) ((_namesIconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) macro_ -> {-# LINE 1319 "src-ag/Transform.ag" #-} [ (nt, con, macro_) | nt <- Set.toList _lhsInts , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) ] {-# LINE 1111 "dist/build/Transform.hs"#-} {-# INLINE rule65 #-} rule65 = \ ((_namesIcollectedConstructorNames) :: Set ConstructorIdent) -> _namesIcollectedConstructorNames {-# INLINE rule66 #-} rule66 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals -- Alts -------------------------------------------------------- -- wrapper data Inh_Alts = Inh_Alts { allConstructors_Inh_Alts :: (Map NontermIdent (Set ConstructorIdent)), allNonterminals_Inh_Alts :: (Set NontermIdent), nts_Inh_Alts :: (Set NontermIdent) } data Syn_Alts = Syn_Alts { collectedConParams_Syn_Alts :: ([(NontermIdent, ConstructorIdent, Set Identifier)]), collectedConstraints_Syn_Alts :: ([(NontermIdent, ConstructorIdent, [Type])]), collectedConstructorNames_Syn_Alts :: (Set ConstructorIdent), collectedFields_Syn_Alts :: ([(NontermIdent, ConstructorIdent, FieldMap)]), collectedMacros_Syn_Alts :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]) } {-# INLINABLE wrap_Alts #-} wrap_Alts :: T_Alts -> Inh_Alts -> (Syn_Alts ) wrap_Alts (T_Alts act) (Inh_Alts _lhsIallConstructors _lhsIallNonterminals _lhsInts) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_Alts_vIn7 _lhsIallConstructors _lhsIallNonterminals _lhsInts (T_Alts_vOut7 _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorNames _lhsOcollectedFields _lhsOcollectedMacros) <- return (inv_Alts_s8 sem arg7) return (Syn_Alts _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorNames _lhsOcollectedFields _lhsOcollectedMacros) ) -- cata {-# NOINLINE sem_Alts #-} sem_Alts :: Alts -> T_Alts sem_Alts list = Prelude.foldr sem_Alts_Cons sem_Alts_Nil (Prelude.map sem_Alt list) -- semantic domain newtype T_Alts = T_Alts { attach_T_Alts :: Identity (T_Alts_s8 ) } newtype T_Alts_s8 = C_Alts_s8 { inv_Alts_s8 :: (T_Alts_v7 ) } data T_Alts_s9 = C_Alts_s9 type T_Alts_v7 = (T_Alts_vIn7 ) -> (T_Alts_vOut7 ) data T_Alts_vIn7 = T_Alts_vIn7 (Map NontermIdent (Set ConstructorIdent)) (Set NontermIdent) (Set NontermIdent) data T_Alts_vOut7 = T_Alts_vOut7 ([(NontermIdent, ConstructorIdent, Set Identifier)]) ([(NontermIdent, ConstructorIdent, [Type])]) (Set ConstructorIdent) ([(NontermIdent, ConstructorIdent, FieldMap)]) ([(NontermIdent, ConstructorIdent, MaybeMacro)]) {-# NOINLINE sem_Alts_Cons #-} sem_Alts_Cons :: T_Alt -> T_Alts -> T_Alts sem_Alts_Cons arg_hd_ arg_tl_ = T_Alts (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_Alts_v7 v7 = \ (T_Alts_vIn7 _lhsIallConstructors _lhsIallNonterminals _lhsInts) -> ( let _hdX5 = Control.Monad.Identity.runIdentity (attach_T_Alt (arg_hd_)) _tlX8 = Control.Monad.Identity.runIdentity (attach_T_Alts (arg_tl_)) (T_Alt_vOut4 _hdIcollectedConParams _hdIcollectedConstraints _hdIcollectedConstructorNames _hdIcollectedFields _hdIcollectedMacros) = inv_Alt_s5 _hdX5 (T_Alt_vIn4 _hdOallConstructors _hdOallNonterminals _hdOnts) (T_Alts_vOut7 _tlIcollectedConParams _tlIcollectedConstraints _tlIcollectedConstructorNames _tlIcollectedFields _tlIcollectedMacros) = inv_Alts_s8 _tlX8 (T_Alts_vIn7 _tlOallConstructors _tlOallNonterminals _tlOnts) _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule67 _hdIcollectedConParams _tlIcollectedConParams _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule68 _hdIcollectedConstraints _tlIcollectedConstraints _lhsOcollectedConstructorNames :: Set ConstructorIdent _lhsOcollectedConstructorNames = rule69 _hdIcollectedConstructorNames _tlIcollectedConstructorNames _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule70 _hdIcollectedFields _tlIcollectedFields _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule71 _hdIcollectedMacros _tlIcollectedMacros _hdOallConstructors = rule72 _lhsIallConstructors _hdOallNonterminals = rule73 _lhsIallNonterminals _hdOnts = rule74 _lhsInts _tlOallConstructors = rule75 _lhsIallConstructors _tlOallNonterminals = rule76 _lhsIallNonterminals _tlOnts = rule77 _lhsInts __result_ = T_Alts_vOut7 _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorNames _lhsOcollectedFields _lhsOcollectedMacros in __result_ ) in C_Alts_s8 v7 {-# INLINE rule67 #-} rule67 = \ ((_hdIcollectedConParams) :: [(NontermIdent, ConstructorIdent, Set Identifier)]) ((_tlIcollectedConParams) :: [(NontermIdent, ConstructorIdent, Set Identifier)]) -> _hdIcollectedConParams ++ _tlIcollectedConParams {-# INLINE rule68 #-} rule68 = \ ((_hdIcollectedConstraints) :: [(NontermIdent, ConstructorIdent, [Type])]) ((_tlIcollectedConstraints) :: [(NontermIdent, ConstructorIdent, [Type])]) -> _hdIcollectedConstraints ++ _tlIcollectedConstraints {-# INLINE rule69 #-} rule69 = \ ((_hdIcollectedConstructorNames) :: Set ConstructorIdent) ((_tlIcollectedConstructorNames) :: Set ConstructorIdent) -> _hdIcollectedConstructorNames `Set.union` _tlIcollectedConstructorNames {-# INLINE rule70 #-} rule70 = \ ((_hdIcollectedFields) :: [(NontermIdent, ConstructorIdent, FieldMap)]) ((_tlIcollectedFields) :: [(NontermIdent, ConstructorIdent, FieldMap)]) -> _hdIcollectedFields ++ _tlIcollectedFields {-# INLINE rule71 #-} rule71 = \ ((_hdIcollectedMacros) :: [(NontermIdent, ConstructorIdent, MaybeMacro)]) ((_tlIcollectedMacros) :: [(NontermIdent, ConstructorIdent, MaybeMacro)]) -> _hdIcollectedMacros ++ _tlIcollectedMacros {-# INLINE rule72 #-} rule72 = \ ((_lhsIallConstructors) :: Map NontermIdent (Set ConstructorIdent)) -> _lhsIallConstructors {-# INLINE rule73 #-} rule73 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule74 #-} rule74 = \ ((_lhsInts) :: Set NontermIdent) -> _lhsInts {-# INLINE rule75 #-} rule75 = \ ((_lhsIallConstructors) :: Map NontermIdent (Set ConstructorIdent)) -> _lhsIallConstructors {-# INLINE rule76 #-} rule76 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule77 #-} rule77 = \ ((_lhsInts) :: Set NontermIdent) -> _lhsInts {-# NOINLINE sem_Alts_Nil #-} sem_Alts_Nil :: T_Alts sem_Alts_Nil = T_Alts (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_Alts_v7 v7 = \ (T_Alts_vIn7 _lhsIallConstructors _lhsIallNonterminals _lhsInts) -> ( let _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule78 () _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule79 () _lhsOcollectedConstructorNames :: Set ConstructorIdent _lhsOcollectedConstructorNames = rule80 () _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule81 () _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule82 () __result_ = T_Alts_vOut7 _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorNames _lhsOcollectedFields _lhsOcollectedMacros in __result_ ) in C_Alts_s8 v7 {-# INLINE rule78 #-} rule78 = \ (_ :: ()) -> [] {-# INLINE rule79 #-} rule79 = \ (_ :: ()) -> [] {-# INLINE rule80 #-} rule80 = \ (_ :: ()) -> Set.empty {-# INLINE rule81 #-} rule81 = \ (_ :: ()) -> [] {-# INLINE rule82 #-} rule82 = \ (_ :: ()) -> [] -- Attrs ------------------------------------------------------- -- wrapper data Inh_Attrs = Inh_Attrs { allFields_Inh_Attrs :: (DataTypes), allNonterminals_Inh_Attrs :: (Set NontermIdent), attrDecls_Inh_Attrs :: (Map NontermIdent (Attributes, Attributes)), attrs_Inh_Attrs :: (Map NontermIdent (Attributes, Attributes)), nts_Inh_Attrs :: (Set NontermIdent), options_Inh_Attrs :: (Options) } data Syn_Attrs = Syn_Attrs { attrDecls_Syn_Attrs :: (Map NontermIdent (Attributes, Attributes)), attrs_Syn_Attrs :: (Map NontermIdent (Attributes, Attributes)), errors_Syn_Attrs :: (Seq Error), useMap_Syn_Attrs :: (Map NontermIdent (Map Identifier (String,String,String))) } {-# INLINABLE wrap_Attrs #-} wrap_Attrs :: T_Attrs -> Inh_Attrs -> (Syn_Attrs ) wrap_Attrs (T_Attrs act) (Inh_Attrs _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsInts _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg10 = T_Attrs_vIn10 _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsInts _lhsIoptions (T_Attrs_vOut10 _lhsOattrDecls _lhsOattrs _lhsOerrors _lhsOuseMap) <- return (inv_Attrs_s11 sem arg10) return (Syn_Attrs _lhsOattrDecls _lhsOattrs _lhsOerrors _lhsOuseMap) ) -- cata {-# INLINE sem_Attrs #-} sem_Attrs :: Attrs -> T_Attrs sem_Attrs ( Attrs pos_ inh_ chn_ syn_ ) = sem_Attrs_Attrs pos_ inh_ chn_ syn_ -- semantic domain newtype T_Attrs = T_Attrs { attach_T_Attrs :: Identity (T_Attrs_s11 ) } newtype T_Attrs_s11 = C_Attrs_s11 { inv_Attrs_s11 :: (T_Attrs_v10 ) } data T_Attrs_s12 = C_Attrs_s12 type T_Attrs_v10 = (T_Attrs_vIn10 ) -> (T_Attrs_vOut10 ) data T_Attrs_vIn10 = T_Attrs_vIn10 (DataTypes) (Set NontermIdent) (Map NontermIdent (Attributes, Attributes)) (Map NontermIdent (Attributes, Attributes)) (Set NontermIdent) (Options) data T_Attrs_vOut10 = T_Attrs_vOut10 (Map NontermIdent (Attributes, Attributes)) (Map NontermIdent (Attributes, Attributes)) (Seq Error) (Map NontermIdent (Map Identifier (String,String,String))) {-# NOINLINE sem_Attrs_Attrs #-} sem_Attrs_Attrs :: (Pos) -> (AttrNames) -> (AttrNames) -> (AttrNames) -> T_Attrs sem_Attrs_Attrs _ arg_inh_ arg_chn_ arg_syn_ = T_Attrs (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_Attrs_v10 v10 = \ (T_Attrs_vIn10 _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsInts _lhsIoptions) -> ( let (_attrDecls,_errors) = rule83 _inherited _lhsIallFields _lhsIattrDecls _lhsInts _synthesized (_inherited,_synthesized,_useMap) = rule84 _lhsIallNonterminals arg_chn_ arg_inh_ arg_syn_ _lhsOuseMap :: Map NontermIdent (Map Identifier (String,String,String)) _lhsOuseMap = rule85 _lhsInts _useMap _errors1 = rule86 _lhsIoptions arg_chn_ arg_inh_ arg_syn_ _lhsOerrors :: Seq Error _lhsOerrors = rule87 _errors _errors1 _lhsOattrs :: Map NontermIdent (Attributes, Attributes) _lhsOattrs = rule88 _inherited _lhsIattrs _lhsInts _synthesized _lhsOattrDecls :: Map NontermIdent (Attributes, Attributes) _lhsOattrDecls = rule89 _attrDecls __result_ = T_Attrs_vOut10 _lhsOattrDecls _lhsOattrs _lhsOerrors _lhsOuseMap in __result_ ) in C_Attrs_s11 v10 {-# INLINE rule83 #-} {-# LINE 1039 "src-ag/Transform.ag" #-} rule83 = \ _inherited ((_lhsIallFields) :: DataTypes) ((_lhsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) ((_lhsInts) :: Set NontermIdent) _synthesized -> {-# LINE 1039 "src-ag/Transform.ag" #-} checkAttrs _lhsIallFields (Set.toList _lhsInts) _inherited _synthesized _lhsIattrDecls {-# LINE 1304 "dist/build/Transform.hs"#-} {-# INLINE rule84 #-} {-# LINE 1041 "src-ag/Transform.ag" #-} rule84 = \ ((_lhsIallNonterminals) :: Set NontermIdent) chn_ inh_ syn_ -> {-# LINE 1041 "src-ag/Transform.ag" #-} let splitAttrs xs = unzip [ ((n,makeType _lhsIallNonterminals t),(n,ud)) | (n,t,ud) <- xs ] (inh,_) = splitAttrs inh_ (chn,uses1) = splitAttrs chn_ (syn,uses2) = splitAttrs syn_ isUse (_,(e1,e2,_)) = not (null e1 || null e2) in (inh++chn,chn++syn, Map.fromList (Prelude.filter isUse (uses1++uses2))) {-# LINE 1317 "dist/build/Transform.hs"#-} {-# INLINE rule85 #-} {-# LINE 1049 "src-ag/Transform.ag" #-} rule85 = \ ((_lhsInts) :: Set NontermIdent) _useMap -> {-# LINE 1049 "src-ag/Transform.ag" #-} Map.fromList (zip (Set.toList _lhsInts) (repeat _useMap)) {-# LINE 1323 "dist/build/Transform.hs"#-} {-# INLINE rule86 #-} {-# LINE 1051 "src-ag/Transform.ag" #-} rule86 = \ ((_lhsIoptions) :: Options) chn_ inh_ syn_ -> {-# LINE 1051 "src-ag/Transform.ag" #-} if checkParseTy _lhsIoptions then let attrs = inh_ ++ syn_ ++ chn_ items = map (\(ident,tp,_) -> (getPos ident, tp)) attrs errs = map check items check (pos,Haskell s) = let ex = Expression pos tks tks = [tk] tk = HsToken s pos in Seq.fromList $ checkTy ex check _ = Seq.empty in foldr (Seq.><) Seq.empty errs else Seq.empty {-# LINE 1340 "dist/build/Transform.hs"#-} {-# INLINE rule87 #-} {-# LINE 1063 "src-ag/Transform.ag" #-} rule87 = \ _errors _errors1 -> {-# LINE 1063 "src-ag/Transform.ag" #-} _errors Seq.>< _errors1 {-# LINE 1346 "dist/build/Transform.hs"#-} {-# INLINE rule88 #-} {-# LINE 1355 "src-ag/Transform.ag" #-} rule88 = \ _inherited ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) ((_lhsInts) :: Set NontermIdent) _synthesized -> {-# LINE 1355 "src-ag/Transform.ag" #-} let ins decls nt = if Map.member nt decls then Map.update (\(inh,syn) -> Just ( Map.union inh $ Map.fromList _inherited , Map.union syn $ Map.fromList _synthesized)) nt decls else Map.insert nt (Map.fromList _inherited, Map.fromList _synthesized) decls in foldl ins _lhsIattrs (Set.toList _lhsInts) {-# LINE 1356 "dist/build/Transform.hs"#-} {-# INLINE rule89 #-} rule89 = \ _attrDecls -> _attrDecls -- ConstructorSet ---------------------------------------------- -- wrapper data Inh_ConstructorSet = Inh_ConstructorSet { } data Syn_ConstructorSet = Syn_ConstructorSet { collectedConstructorNames_Syn_ConstructorSet :: (Set ConstructorIdent), constructors_Syn_ConstructorSet :: ((Set ConstructorIdent->Set ConstructorIdent)), errors_Syn_ConstructorSet :: (Seq Error) } {-# INLINABLE wrap_ConstructorSet #-} wrap_ConstructorSet :: T_ConstructorSet -> Inh_ConstructorSet -> (Syn_ConstructorSet ) wrap_ConstructorSet (T_ConstructorSet act) (Inh_ConstructorSet ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg13 = T_ConstructorSet_vIn13 (T_ConstructorSet_vOut13 _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors) <- return (inv_ConstructorSet_s14 sem arg13) return (Syn_ConstructorSet _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors) ) -- cata {-# NOINLINE sem_ConstructorSet #-} sem_ConstructorSet :: ConstructorSet -> T_ConstructorSet sem_ConstructorSet ( CName name_ ) = sem_ConstructorSet_CName name_ sem_ConstructorSet ( CUnion set1_ set2_ ) = sem_ConstructorSet_CUnion ( sem_ConstructorSet set1_ ) ( sem_ConstructorSet set2_ ) sem_ConstructorSet ( CDifference set1_ set2_ ) = sem_ConstructorSet_CDifference ( sem_ConstructorSet set1_ ) ( sem_ConstructorSet set2_ ) sem_ConstructorSet ( CAll ) = sem_ConstructorSet_CAll -- semantic domain newtype T_ConstructorSet = T_ConstructorSet { attach_T_ConstructorSet :: Identity (T_ConstructorSet_s14 ) } newtype T_ConstructorSet_s14 = C_ConstructorSet_s14 { inv_ConstructorSet_s14 :: (T_ConstructorSet_v13 ) } data T_ConstructorSet_s15 = C_ConstructorSet_s15 type T_ConstructorSet_v13 = (T_ConstructorSet_vIn13 ) -> (T_ConstructorSet_vOut13 ) data T_ConstructorSet_vIn13 = T_ConstructorSet_vIn13 data T_ConstructorSet_vOut13 = T_ConstructorSet_vOut13 (Set ConstructorIdent) ((Set ConstructorIdent->Set ConstructorIdent)) (Seq Error) {-# NOINLINE sem_ConstructorSet_CName #-} sem_ConstructorSet_CName :: (ConstructorIdent) -> T_ConstructorSet sem_ConstructorSet_CName arg_name_ = T_ConstructorSet (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_ConstructorSet_v13 v13 = \ (T_ConstructorSet_vIn13 ) -> ( let _lhsOcollectedConstructorNames :: Set ConstructorIdent _lhsOcollectedConstructorNames = rule90 arg_name_ _lhsOconstructors :: (Set ConstructorIdent->Set ConstructorIdent) _lhsOconstructors = rule91 arg_name_ _lhsOerrors :: Seq Error _lhsOerrors = rule92 () __result_ = T_ConstructorSet_vOut13 _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors in __result_ ) in C_ConstructorSet_s14 v13 {-# INLINE rule90 #-} {-# LINE 614 "src-ag/Transform.ag" #-} rule90 = \ name_ -> {-# LINE 614 "src-ag/Transform.ag" #-} Set.singleton name_ {-# LINE 1415 "dist/build/Transform.hs"#-} {-# INLINE rule91 #-} {-# LINE 777 "src-ag/Transform.ag" #-} rule91 = \ name_ -> {-# LINE 777 "src-ag/Transform.ag" #-} \_ -> Set.singleton name_ {-# LINE 1421 "dist/build/Transform.hs"#-} {-# INLINE rule92 #-} rule92 = \ (_ :: ()) -> Seq.empty {-# NOINLINE sem_ConstructorSet_CUnion #-} sem_ConstructorSet_CUnion :: T_ConstructorSet -> T_ConstructorSet -> T_ConstructorSet sem_ConstructorSet_CUnion arg_set1_ arg_set2_ = T_ConstructorSet (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_ConstructorSet_v13 v13 = \ (T_ConstructorSet_vIn13 ) -> ( let _set1X14 = Control.Monad.Identity.runIdentity (attach_T_ConstructorSet (arg_set1_)) _set2X14 = Control.Monad.Identity.runIdentity (attach_T_ConstructorSet (arg_set2_)) (T_ConstructorSet_vOut13 _set1IcollectedConstructorNames _set1Iconstructors _set1Ierrors) = inv_ConstructorSet_s14 _set1X14 (T_ConstructorSet_vIn13 ) (T_ConstructorSet_vOut13 _set2IcollectedConstructorNames _set2Iconstructors _set2Ierrors) = inv_ConstructorSet_s14 _set2X14 (T_ConstructorSet_vIn13 ) _lhsOconstructors :: (Set ConstructorIdent->Set ConstructorIdent) _lhsOconstructors = rule93 _set1Iconstructors _set2Iconstructors _lhsOcollectedConstructorNames :: Set ConstructorIdent _lhsOcollectedConstructorNames = rule94 _set1IcollectedConstructorNames _set2IcollectedConstructorNames _lhsOerrors :: Seq Error _lhsOerrors = rule95 _set1Ierrors _set2Ierrors __result_ = T_ConstructorSet_vOut13 _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors in __result_ ) in C_ConstructorSet_s14 v13 {-# INLINE rule93 #-} {-# LINE 778 "src-ag/Transform.ag" #-} rule93 = \ ((_set1Iconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) ((_set2Iconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) -> {-# LINE 778 "src-ag/Transform.ag" #-} \ds -> _set1Iconstructors ds `Set.union` _set2Iconstructors ds {-# LINE 1450 "dist/build/Transform.hs"#-} {-# INLINE rule94 #-} rule94 = \ ((_set1IcollectedConstructorNames) :: Set ConstructorIdent) ((_set2IcollectedConstructorNames) :: Set ConstructorIdent) -> _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames {-# INLINE rule95 #-} rule95 = \ ((_set1Ierrors) :: Seq Error) ((_set2Ierrors) :: Seq Error) -> _set1Ierrors Seq.>< _set2Ierrors {-# NOINLINE sem_ConstructorSet_CDifference #-} sem_ConstructorSet_CDifference :: T_ConstructorSet -> T_ConstructorSet -> T_ConstructorSet sem_ConstructorSet_CDifference arg_set1_ arg_set2_ = T_ConstructorSet (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_ConstructorSet_v13 v13 = \ (T_ConstructorSet_vIn13 ) -> ( let _set1X14 = Control.Monad.Identity.runIdentity (attach_T_ConstructorSet (arg_set1_)) _set2X14 = Control.Monad.Identity.runIdentity (attach_T_ConstructorSet (arg_set2_)) (T_ConstructorSet_vOut13 _set1IcollectedConstructorNames _set1Iconstructors _set1Ierrors) = inv_ConstructorSet_s14 _set1X14 (T_ConstructorSet_vIn13 ) (T_ConstructorSet_vOut13 _set2IcollectedConstructorNames _set2Iconstructors _set2Ierrors) = inv_ConstructorSet_s14 _set2X14 (T_ConstructorSet_vIn13 ) _lhsOconstructors :: (Set ConstructorIdent->Set ConstructorIdent) _lhsOconstructors = rule96 _set1Iconstructors _set2Iconstructors _lhsOcollectedConstructorNames :: Set ConstructorIdent _lhsOcollectedConstructorNames = rule97 _set1IcollectedConstructorNames _set2IcollectedConstructorNames _lhsOerrors :: Seq Error _lhsOerrors = rule98 _set1Ierrors _set2Ierrors __result_ = T_ConstructorSet_vOut13 _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors in __result_ ) in C_ConstructorSet_s14 v13 {-# INLINE rule96 #-} {-# LINE 779 "src-ag/Transform.ag" #-} rule96 = \ ((_set1Iconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) ((_set2Iconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) -> {-# LINE 779 "src-ag/Transform.ag" #-} \ds -> _set1Iconstructors ds `Set.difference` _set2Iconstructors ds {-# LINE 1482 "dist/build/Transform.hs"#-} {-# INLINE rule97 #-} rule97 = \ ((_set1IcollectedConstructorNames) :: Set ConstructorIdent) ((_set2IcollectedConstructorNames) :: Set ConstructorIdent) -> _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames {-# INLINE rule98 #-} rule98 = \ ((_set1Ierrors) :: Seq Error) ((_set2Ierrors) :: Seq Error) -> _set1Ierrors Seq.>< _set2Ierrors {-# NOINLINE sem_ConstructorSet_CAll #-} sem_ConstructorSet_CAll :: T_ConstructorSet sem_ConstructorSet_CAll = T_ConstructorSet (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_ConstructorSet_v13 v13 = \ (T_ConstructorSet_vIn13 ) -> ( let _lhsOconstructors :: (Set ConstructorIdent->Set ConstructorIdent) _lhsOconstructors = rule99 () _lhsOcollectedConstructorNames :: Set ConstructorIdent _lhsOcollectedConstructorNames = rule100 () _lhsOerrors :: Seq Error _lhsOerrors = rule101 () __result_ = T_ConstructorSet_vOut13 _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors in __result_ ) in C_ConstructorSet_s14 v13 {-# INLINE rule99 #-} {-# LINE 780 "src-ag/Transform.ag" #-} rule99 = \ (_ :: ()) -> {-# LINE 780 "src-ag/Transform.ag" #-} \ds -> ds {-# LINE 1510 "dist/build/Transform.hs"#-} {-# INLINE rule100 #-} rule100 = \ (_ :: ()) -> Set.empty {-# INLINE rule101 #-} rule101 = \ (_ :: ()) -> Seq.empty -- Elem -------------------------------------------------------- -- wrapper data Inh_Elem = Inh_Elem { allAttrDecls_Inh_Elem :: (Map NontermIdent (Attributes, Attributes)), allAttrs_Inh_Elem :: (Map NontermIdent (Attributes, Attributes)), allConstructors_Inh_Elem :: (Map NontermIdent (Set ConstructorIdent)), allFields_Inh_Elem :: (DataTypes), allNonterminals_Inh_Elem :: (Set NontermIdent), attrDecls_Inh_Elem :: (Map NontermIdent (Attributes, Attributes)), attrs_Inh_Elem :: (Map NontermIdent (Attributes, Attributes)), defSets_Inh_Elem :: (Map Identifier (Set NontermIdent,Set Identifier)), definedSets_Inh_Elem :: (DefinedSets), options_Inh_Elem :: (Options) } data Syn_Elem = Syn_Elem { attrDecls_Syn_Elem :: (Map NontermIdent (Attributes, Attributes)), attrOrderCollect_Syn_Elem :: (AttrOrderMap), attrs_Syn_Elem :: (Map NontermIdent (Attributes, Attributes)), blocks_Syn_Elem :: (Blocks), collectedArounds_Syn_Elem :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]), collectedAugments_Syn_Elem :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]), collectedConParams_Syn_Elem :: ([(NontermIdent, ConstructorIdent, Set Identifier)]), collectedConstraints_Syn_Elem :: ([(NontermIdent, ConstructorIdent, [Type])]), collectedConstructorsMap_Syn_Elem :: (Map NontermIdent (Set ConstructorIdent)), collectedFields_Syn_Elem :: ([(NontermIdent, ConstructorIdent, FieldMap)]), collectedInsts_Syn_Elem :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]), collectedMacros_Syn_Elem :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]), collectedMerges_Syn_Elem :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]), collectedNames_Syn_Elem :: (Set Identifier), collectedRules_Syn_Elem :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]), collectedSetNames_Syn_Elem :: (Set Identifier), collectedSigs_Syn_Elem :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]), collectedUniques_Syn_Elem :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]), constructorTypeMap_Syn_Elem :: (Map NontermIdent ConstructorType), ctxCollect_Syn_Elem :: (ContextMap), defSets_Syn_Elem :: (Map Identifier (Set NontermIdent,Set Identifier)), derivings_Syn_Elem :: (Derivings), errors_Syn_Elem :: (Seq Error), moduleDecl_Syn_Elem :: (Maybe (String,String,String)), paramsCollect_Syn_Elem :: (ParamMap), pragmas_Syn_Elem :: (Options -> Options), quantCollect_Syn_Elem :: (QuantMap), semPragmasCollect_Syn_Elem :: (PragmaMap), typeSyns_Syn_Elem :: (TypeSyns), useMap_Syn_Elem :: (Map NontermIdent (Map Identifier (String,String,String))), wrappers_Syn_Elem :: (Set NontermIdent) } {-# INLINABLE wrap_Elem #-} wrap_Elem :: T_Elem -> Inh_Elem -> (Syn_Elem ) wrap_Elem (T_Elem act) (Inh_Elem _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg16 = T_Elem_vIn16 _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions (T_Elem_vOut16 _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers) <- return (inv_Elem_s17 sem arg16) return (Syn_Elem _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers) ) -- cata {-# NOINLINE sem_Elem #-} sem_Elem :: Elem -> T_Elem sem_Elem ( Data pos_ contype_ ctx_ names_ params_ attrs_ alts_ ext_ ) = sem_Elem_Data pos_ contype_ ctx_ ( sem_NontSet names_ ) params_ ( sem_Attrs attrs_ ) ( sem_Alts alts_ ) ext_ sem_Elem ( Type pos_ ctx_ name_ params_ type_ ) = sem_Elem_Type pos_ ctx_ name_ params_ type_ sem_Elem ( Attr pos_ ctx_ names_ quants_ attrs_ ) = sem_Elem_Attr pos_ ctx_ ( sem_NontSet names_ ) quants_ ( sem_Attrs attrs_ ) sem_Elem ( Sem pos_ ctx_ names_ attrs_ quants_ alts_ ) = sem_Elem_Sem pos_ ctx_ ( sem_NontSet names_ ) ( sem_Attrs attrs_ ) quants_ ( sem_SemAlts alts_ ) sem_Elem ( Txt pos_ kind_ mbNt_ lines_ ) = sem_Elem_Txt pos_ kind_ mbNt_ lines_ sem_Elem ( Set pos_ name_ merge_ set_ ) = sem_Elem_Set pos_ name_ merge_ ( sem_NontSet set_ ) sem_Elem ( Deriving pos_ set_ classes_ ) = sem_Elem_Deriving pos_ ( sem_NontSet set_ ) classes_ sem_Elem ( Wrapper pos_ set_ ) = sem_Elem_Wrapper pos_ ( sem_NontSet set_ ) sem_Elem ( Nocatas pos_ set_ ) = sem_Elem_Nocatas pos_ ( sem_NontSet set_ ) sem_Elem ( Pragma pos_ names_ ) = sem_Elem_Pragma pos_ names_ sem_Elem ( Module pos_ name_ exports_ imports_ ) = sem_Elem_Module pos_ name_ exports_ imports_ -- semantic domain newtype T_Elem = T_Elem { attach_T_Elem :: Identity (T_Elem_s17 ) } newtype T_Elem_s17 = C_Elem_s17 { inv_Elem_s17 :: (T_Elem_v16 ) } data T_Elem_s18 = C_Elem_s18 type T_Elem_v16 = (T_Elem_vIn16 ) -> (T_Elem_vOut16 ) data T_Elem_vIn16 = T_Elem_vIn16 (Map NontermIdent (Attributes, Attributes)) (Map NontermIdent (Attributes, Attributes)) (Map NontermIdent (Set ConstructorIdent)) (DataTypes) (Set NontermIdent) (Map NontermIdent (Attributes, Attributes)) (Map NontermIdent (Attributes, Attributes)) (Map Identifier (Set NontermIdent,Set Identifier)) (DefinedSets) (Options) data T_Elem_vOut16 = T_Elem_vOut16 (Map NontermIdent (Attributes, Attributes)) (AttrOrderMap) (Map NontermIdent (Attributes, Attributes)) (Blocks) ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) ([(NontermIdent, ConstructorIdent, Set Identifier)]) ([(NontermIdent, ConstructorIdent, [Type])]) (Map NontermIdent (Set ConstructorIdent)) ([(NontermIdent, ConstructorIdent, FieldMap)]) ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) ([(NontermIdent, ConstructorIdent, MaybeMacro)]) ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) (Set Identifier) ([ (NontermIdent, ConstructorIdent, RuleInfo)]) (Set Identifier) ([ (NontermIdent, ConstructorIdent, SigInfo) ]) ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) (Map NontermIdent ConstructorType) (ContextMap) (Map Identifier (Set NontermIdent,Set Identifier)) (Derivings) (Seq Error) (Maybe (String,String,String)) (ParamMap) (Options -> Options) (QuantMap) (PragmaMap) (TypeSyns) (Map NontermIdent (Map Identifier (String,String,String))) (Set NontermIdent) {-# NOINLINE sem_Elem_Data #-} sem_Elem_Data :: (Pos) -> (ConstructorType) -> (ClassContext) -> T_NontSet -> ([Identifier]) -> T_Attrs -> T_Alts -> (Bool) -> T_Elem sem_Elem_Data _ arg_contype_ arg_ctx_ arg_names_ arg_params_ arg_attrs_ arg_alts_ _ = T_Elem (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Elem_v16 v16 = \ (T_Elem_vIn16 _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) -> ( let _namesX29 = Control.Monad.Identity.runIdentity (attach_T_NontSet (arg_names_)) _attrsX11 = Control.Monad.Identity.runIdentity (attach_T_Attrs (arg_attrs_)) _altsX8 = Control.Monad.Identity.runIdentity (attach_T_Alts (arg_alts_)) (T_NontSet_vOut28 _namesIcollectedNames _namesIerrors _namesInontSet) = inv_NontSet_s29 _namesX29 (T_NontSet_vIn28 _namesOallFields _namesOallNonterminals _namesOdefinedSets) (T_Attrs_vOut10 _attrsIattrDecls _attrsIattrs _attrsIerrors _attrsIuseMap) = inv_Attrs_s11 _attrsX11 (T_Attrs_vIn10 _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOattrs _attrsOnts _attrsOoptions) (T_Alts_vOut7 _altsIcollectedConParams _altsIcollectedConstraints _altsIcollectedConstructorNames _altsIcollectedFields _altsIcollectedMacros) = inv_Alts_s8 _altsX8 (T_Alts_vIn7 _altsOallConstructors _altsOallNonterminals _altsOnts) _altsOnts = rule102 _namesInontSet _lhsOcollectedConstructorsMap :: Map NontermIdent (Set ConstructorIdent) _lhsOcollectedConstructorsMap = rule103 _altsIcollectedConstructorNames _namesInontSet _lhsOparamsCollect :: ParamMap _lhsOparamsCollect = rule104 _namesInontSet arg_params_ _lhsOctxCollect :: ContextMap _lhsOctxCollect = rule105 _namesInontSet arg_ctx_ _attrsOnts = rule106 _namesInontSet _lhsOconstructorTypeMap :: Map NontermIdent ConstructorType _lhsOconstructorTypeMap = rule107 _namesIcollectedNames arg_contype_ _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule108 () _lhsOblocks :: Blocks _lhsOblocks = rule109 () _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule110 () _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule111 () _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule112 _altsIcollectedConParams _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule113 _altsIcollectedConstraints _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule114 _altsIcollectedFields _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule115 () _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule116 _altsIcollectedMacros _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule117 () _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule118 _namesIcollectedNames _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule119 () _lhsOcollectedSetNames :: Set Identifier _lhsOcollectedSetNames = rule120 () _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule121 () _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule122 () _lhsOderivings :: Derivings _lhsOderivings = rule123 () _lhsOerrors :: Seq Error _lhsOerrors = rule124 _attrsIerrors _namesIerrors _lhsOmoduleDecl :: Maybe (String,String,String) _lhsOmoduleDecl = rule125 () _lhsOpragmas :: Options -> Options _lhsOpragmas = rule126 () _lhsOquantCollect :: QuantMap _lhsOquantCollect = rule127 () _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule128 () _lhsOtypeSyns :: TypeSyns _lhsOtypeSyns = rule129 () _lhsOuseMap :: Map NontermIdent (Map Identifier (String,String,String)) _lhsOuseMap = rule130 _attrsIuseMap _lhsOwrappers :: Set NontermIdent _lhsOwrappers = rule131 () _lhsOattrDecls :: Map NontermIdent (Attributes, Attributes) _lhsOattrDecls = rule132 _attrsIattrDecls _lhsOattrs :: Map NontermIdent (Attributes, Attributes) _lhsOattrs = rule133 _attrsIattrs _lhsOdefSets :: Map Identifier (Set NontermIdent,Set Identifier) _lhsOdefSets = rule134 _lhsIdefSets _namesOallFields = rule135 _lhsIallFields _namesOallNonterminals = rule136 _lhsIallNonterminals _namesOdefinedSets = rule137 _lhsIdefinedSets _attrsOallFields = rule138 _lhsIallFields _attrsOallNonterminals = rule139 _lhsIallNonterminals _attrsOattrDecls = rule140 _lhsIattrDecls _attrsOattrs = rule141 _lhsIattrs _attrsOoptions = rule142 _lhsIoptions _altsOallConstructors = rule143 _lhsIallConstructors _altsOallNonterminals = rule144 _lhsIallNonterminals __result_ = T_Elem_vOut16 _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers in __result_ ) in C_Elem_s17 v16 {-# INLINE rule102 #-} {-# LINE 176 "src-ag/Transform.ag" #-} rule102 = \ ((_namesInontSet) :: Set NontermIdent) -> {-# LINE 176 "src-ag/Transform.ag" #-} _namesInontSet {-# LINE 1653 "dist/build/Transform.hs"#-} {-# INLINE rule103 #-} {-# LINE 620 "src-ag/Transform.ag" #-} rule103 = \ ((_altsIcollectedConstructorNames) :: Set ConstructorIdent) ((_namesInontSet) :: Set NontermIdent) -> {-# LINE 620 "src-ag/Transform.ag" #-} Map.fromList [ (n, _altsIcollectedConstructorNames) | n <- Set.toList _namesInontSet ] {-# LINE 1662 "dist/build/Transform.hs"#-} {-# INLINE rule104 #-} {-# LINE 948 "src-ag/Transform.ag" #-} rule104 = \ ((_namesInontSet) :: Set NontermIdent) params_ -> {-# LINE 948 "src-ag/Transform.ag" #-} if null params_ then Map.empty else Map.fromList [(nt, params_) | nt <- Set.toList _namesInontSet] {-# LINE 1670 "dist/build/Transform.hs"#-} {-# INLINE rule105 #-} {-# LINE 971 "src-ag/Transform.ag" #-} rule105 = \ ((_namesInontSet) :: Set NontermIdent) ctx_ -> {-# LINE 971 "src-ag/Transform.ag" #-} if null ctx_ then Map.empty else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] {-# LINE 1678 "dist/build/Transform.hs"#-} {-# INLINE rule106 #-} {-# LINE 1033 "src-ag/Transform.ag" #-} rule106 = \ ((_namesInontSet) :: Set NontermIdent) -> {-# LINE 1033 "src-ag/Transform.ag" #-} _namesInontSet {-# LINE 1684 "dist/build/Transform.hs"#-} {-# INLINE rule107 #-} {-# LINE 1371 "src-ag/Transform.ag" #-} rule107 = \ ((_namesIcollectedNames) :: Set Identifier) contype_ -> {-# LINE 1371 "src-ag/Transform.ag" #-} Set.fold (\nm mp -> Map.insert nm contype_ mp) Map.empty _namesIcollectedNames {-# LINE 1690 "dist/build/Transform.hs"#-} {-# INLINE rule108 #-} rule108 = \ (_ :: ()) -> Map.empty {-# INLINE rule109 #-} rule109 = \ (_ :: ()) -> Map.empty {-# INLINE rule110 #-} rule110 = \ (_ :: ()) -> [] {-# INLINE rule111 #-} rule111 = \ (_ :: ()) -> [] {-# INLINE rule112 #-} rule112 = \ ((_altsIcollectedConParams) :: [(NontermIdent, ConstructorIdent, Set Identifier)]) -> _altsIcollectedConParams {-# INLINE rule113 #-} rule113 = \ ((_altsIcollectedConstraints) :: [(NontermIdent, ConstructorIdent, [Type])]) -> _altsIcollectedConstraints {-# INLINE rule114 #-} rule114 = \ ((_altsIcollectedFields) :: [(NontermIdent, ConstructorIdent, FieldMap)]) -> _altsIcollectedFields {-# INLINE rule115 #-} rule115 = \ (_ :: ()) -> [] {-# INLINE rule116 #-} rule116 = \ ((_altsIcollectedMacros) :: [(NontermIdent, ConstructorIdent, MaybeMacro)]) -> _altsIcollectedMacros {-# INLINE rule117 #-} rule117 = \ (_ :: ()) -> [] {-# INLINE rule118 #-} rule118 = \ ((_namesIcollectedNames) :: Set Identifier) -> _namesIcollectedNames {-# INLINE rule119 #-} rule119 = \ (_ :: ()) -> [] {-# INLINE rule120 #-} rule120 = \ (_ :: ()) -> Set.empty {-# INLINE rule121 #-} rule121 = \ (_ :: ()) -> [] {-# INLINE rule122 #-} rule122 = \ (_ :: ()) -> [] {-# INLINE rule123 #-} rule123 = \ (_ :: ()) -> Map.empty {-# INLINE rule124 #-} rule124 = \ ((_attrsIerrors) :: Seq Error) ((_namesIerrors) :: Seq Error) -> _namesIerrors Seq.>< _attrsIerrors {-# INLINE rule125 #-} rule125 = \ (_ :: ()) -> mzero {-# INLINE rule126 #-} rule126 = \ (_ :: ()) -> id {-# INLINE rule127 #-} rule127 = \ (_ :: ()) -> Map.empty {-# INLINE rule128 #-} rule128 = \ (_ :: ()) -> Map.empty {-# INLINE rule129 #-} rule129 = \ (_ :: ()) -> [] {-# INLINE rule130 #-} rule130 = \ ((_attrsIuseMap) :: Map NontermIdent (Map Identifier (String,String,String))) -> _attrsIuseMap {-# INLINE rule131 #-} rule131 = \ (_ :: ()) -> Set.empty {-# INLINE rule132 #-} rule132 = \ ((_attrsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _attrsIattrDecls {-# INLINE rule133 #-} rule133 = \ ((_attrsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _attrsIattrs {-# INLINE rule134 #-} rule134 = \ ((_lhsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> _lhsIdefSets {-# INLINE rule135 #-} rule135 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule136 #-} rule136 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule137 #-} rule137 = \ ((_lhsIdefinedSets) :: DefinedSets) -> _lhsIdefinedSets {-# INLINE rule138 #-} rule138 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule139 #-} rule139 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule140 #-} rule140 = \ ((_lhsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrDecls {-# INLINE rule141 #-} rule141 = \ ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrs {-# INLINE rule142 #-} rule142 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule143 #-} rule143 = \ ((_lhsIallConstructors) :: Map NontermIdent (Set ConstructorIdent)) -> _lhsIallConstructors {-# INLINE rule144 #-} rule144 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# NOINLINE sem_Elem_Type #-} sem_Elem_Type :: (Pos) -> (ClassContext) -> (NontermIdent) -> ([Identifier]) -> (ComplexType) -> T_Elem sem_Elem_Type arg_pos_ arg_ctx_ arg_name_ arg_params_ arg_type_ = T_Elem (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Elem_v16 v16 = \ (T_Elem_vIn16 _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) -> ( let _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule145 _expanded arg_name_ _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule146 arg_name_ _expanded = rule147 _argType arg_name_ arg_params_ arg_pos_ _argType = rule148 _lhsIallNonterminals arg_type_ _lhsOtypeSyns :: TypeSyns _lhsOtypeSyns = rule149 _argType arg_name_ _lhsOparamsCollect :: ParamMap _lhsOparamsCollect = rule150 arg_name_ arg_params_ _lhsOctxCollect :: ContextMap _lhsOctxCollect = rule151 arg_ctx_ arg_name_ _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule152 () _lhsOblocks :: Blocks _lhsOblocks = rule153 () _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule154 () _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule155 () _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule156 () _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule157 () _lhsOcollectedConstructorsMap :: Map NontermIdent (Set ConstructorIdent) _lhsOcollectedConstructorsMap = rule158 () _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule159 () _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule160 () _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule161 () _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule162 () _lhsOcollectedSetNames :: Set Identifier _lhsOcollectedSetNames = rule163 () _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule164 () _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule165 () _lhsOconstructorTypeMap :: Map NontermIdent ConstructorType _lhsOconstructorTypeMap = rule166 () _lhsOderivings :: Derivings _lhsOderivings = rule167 () _lhsOerrors :: Seq Error _lhsOerrors = rule168 () _lhsOmoduleDecl :: Maybe (String,String,String) _lhsOmoduleDecl = rule169 () _lhsOpragmas :: Options -> Options _lhsOpragmas = rule170 () _lhsOquantCollect :: QuantMap _lhsOquantCollect = rule171 () _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule172 () _lhsOuseMap :: Map NontermIdent (Map Identifier (String,String,String)) _lhsOuseMap = rule173 () _lhsOwrappers :: Set NontermIdent _lhsOwrappers = rule174 () _lhsOattrDecls :: Map NontermIdent (Attributes, Attributes) _lhsOattrDecls = rule175 _lhsIattrDecls _lhsOattrs :: Map NontermIdent (Attributes, Attributes) _lhsOattrs = rule176 _lhsIattrs _lhsOdefSets :: Map Identifier (Set NontermIdent,Set Identifier) _lhsOdefSets = rule177 _lhsIdefSets __result_ = T_Elem_vOut16 _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers in __result_ ) in C_Elem_s17 v16 {-# INLINE rule145 #-} {-# LINE 254 "src-ag/Transform.ag" #-} rule145 = \ _expanded name_ -> {-# LINE 254 "src-ag/Transform.ag" #-} map (\(x,y)->(name_, x, y)) _expanded {-# LINE 1881 "dist/build/Transform.hs"#-} {-# INLINE rule146 #-} {-# LINE 600 "src-ag/Transform.ag" #-} rule146 = \ name_ -> {-# LINE 600 "src-ag/Transform.ag" #-} Set.singleton name_ {-# LINE 1887 "dist/build/Transform.hs"#-} {-# INLINE rule147 #-} {-# LINE 654 "src-ag/Transform.ag" #-} rule147 = \ _argType name_ params_ pos_ -> {-# LINE 654 "src-ag/Transform.ag" #-} case _argType of List tp -> [(Ident "Cons" pos_, [(Ident "hd" pos_, tp) ,(Ident "tl" pos_, NT name_ (map getName params_) False) ] ) ,(Ident "Nil" pos_, []) ] Maybe tp -> [(Ident "Just" pos_, [(Ident "just" pos_, tp) ] ) ,(Ident "Nothing" pos_, []) ] Either tp1 tp2 -> [ (Ident "Left" pos_, [(Ident "left" pos_, tp1) ]) , (Ident "Right" pos_, [(Ident "right" pos_, tp2) ]) ] Map tp1 tp2 -> [ (Ident "Entry" pos_, [ (Ident "key" pos_, tp1) , (Ident "val" pos_, tp2) , (Ident "tl" pos_, NT name_ (map getName params_) False) ]) , (Ident "Nil" pos_, []) ] IntMap tp -> [ (Ident "Entry" pos_, [ (Ident "key" pos_, Haskell "Int") , (Ident "val" pos_, tp) , (Ident "tl" pos_, NT name_ (map getName params_) False) ]) , (Ident "Nil" pos_, []) ] OrdSet tp -> [ (Ident "Entry" pos_, [ (Ident "val" pos_, tp) , (Ident "tl" pos_, NT name_ (map getName params_) False) ]) , (Ident "Nil" pos_, []) ] IntSet -> [ (Ident "Entry" pos_, [ (Ident "val" pos_, Haskell "Int") , (Ident "tl" pos_, NT name_ (map getName params_) False) ]) , (Ident "Nil" pos_, []) ] Tuple xs -> [(Ident "Tuple" pos_, xs)] {-# LINE 1929 "dist/build/Transform.hs"#-} {-# INLINE rule148 #-} {-# LINE 691 "src-ag/Transform.ag" #-} rule148 = \ ((_lhsIallNonterminals) :: Set NontermIdent) type_ -> {-# LINE 691 "src-ag/Transform.ag" #-} case type_ of Maybe tp -> Maybe ( makeType _lhsIallNonterminals tp) Either tp1 tp2 -> Either ( makeType _lhsIallNonterminals tp1) (makeType _lhsIallNonterminals tp2) List tp -> List ( makeType _lhsIallNonterminals tp) Tuple xs -> Tuple [(f,makeType _lhsIallNonterminals tp) | (f,tp) <- xs] Map tp1 tp2 -> Map ( makeType _lhsIallNonterminals tp1) (makeType _lhsIallNonterminals tp2) IntMap tp -> IntMap ( makeType _lhsIallNonterminals tp) OrdSet tp -> OrdSet ( makeType _lhsIallNonterminals tp) IntSet -> IntSet {-# LINE 1943 "dist/build/Transform.hs"#-} {-# INLINE rule149 #-} {-# LINE 700 "src-ag/Transform.ag" #-} rule149 = \ _argType name_ -> {-# LINE 700 "src-ag/Transform.ag" #-} [(name_,_argType)] {-# LINE 1949 "dist/build/Transform.hs"#-} {-# INLINE rule150 #-} {-# LINE 954 "src-ag/Transform.ag" #-} rule150 = \ name_ params_ -> {-# LINE 954 "src-ag/Transform.ag" #-} if null params_ then Map.empty else Map.singleton name_ params_ {-# LINE 1957 "dist/build/Transform.hs"#-} {-# INLINE rule151 #-} {-# LINE 977 "src-ag/Transform.ag" #-} rule151 = \ ctx_ name_ -> {-# LINE 977 "src-ag/Transform.ag" #-} if null ctx_ then Map.empty else Map.singleton name_ ctx_ {-# LINE 1965 "dist/build/Transform.hs"#-} {-# INLINE rule152 #-} rule152 = \ (_ :: ()) -> Map.empty {-# INLINE rule153 #-} rule153 = \ (_ :: ()) -> Map.empty {-# INLINE rule154 #-} rule154 = \ (_ :: ()) -> [] {-# INLINE rule155 #-} rule155 = \ (_ :: ()) -> [] {-# INLINE rule156 #-} rule156 = \ (_ :: ()) -> [] {-# INLINE rule157 #-} rule157 = \ (_ :: ()) -> [] {-# INLINE rule158 #-} rule158 = \ (_ :: ()) -> Map.empty {-# INLINE rule159 #-} rule159 = \ (_ :: ()) -> [] {-# INLINE rule160 #-} rule160 = \ (_ :: ()) -> [] {-# INLINE rule161 #-} rule161 = \ (_ :: ()) -> [] {-# INLINE rule162 #-} rule162 = \ (_ :: ()) -> [] {-# INLINE rule163 #-} rule163 = \ (_ :: ()) -> Set.empty {-# INLINE rule164 #-} rule164 = \ (_ :: ()) -> [] {-# INLINE rule165 #-} rule165 = \ (_ :: ()) -> [] {-# INLINE rule166 #-} rule166 = \ (_ :: ()) -> Map.empty {-# INLINE rule167 #-} rule167 = \ (_ :: ()) -> Map.empty {-# INLINE rule168 #-} rule168 = \ (_ :: ()) -> Seq.empty {-# INLINE rule169 #-} rule169 = \ (_ :: ()) -> mzero {-# INLINE rule170 #-} rule170 = \ (_ :: ()) -> id {-# INLINE rule171 #-} rule171 = \ (_ :: ()) -> Map.empty {-# INLINE rule172 #-} rule172 = \ (_ :: ()) -> Map.empty {-# INLINE rule173 #-} rule173 = \ (_ :: ()) -> Map.empty {-# INLINE rule174 #-} rule174 = \ (_ :: ()) -> Set.empty {-# INLINE rule175 #-} rule175 = \ ((_lhsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrDecls {-# INLINE rule176 #-} rule176 = \ ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrs {-# INLINE rule177 #-} rule177 = \ ((_lhsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> _lhsIdefSets {-# NOINLINE sem_Elem_Attr #-} sem_Elem_Attr :: (Pos) -> (ClassContext) -> T_NontSet -> ([String]) -> T_Attrs -> T_Elem sem_Elem_Attr _ arg_ctx_ arg_names_ arg_quants_ arg_attrs_ = T_Elem (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Elem_v16 v16 = \ (T_Elem_vIn16 _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) -> ( let _namesX29 = Control.Monad.Identity.runIdentity (attach_T_NontSet (arg_names_)) _attrsX11 = Control.Monad.Identity.runIdentity (attach_T_Attrs (arg_attrs_)) (T_NontSet_vOut28 _namesIcollectedNames _namesIerrors _namesInontSet) = inv_NontSet_s29 _namesX29 (T_NontSet_vIn28 _namesOallFields _namesOallNonterminals _namesOdefinedSets) (T_Attrs_vOut10 _attrsIattrDecls _attrsIattrs _attrsIerrors _attrsIuseMap) = inv_Attrs_s11 _attrsX11 (T_Attrs_vIn10 _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOattrs _attrsOnts _attrsOoptions) _lhsOctxCollect :: ContextMap _lhsOctxCollect = rule178 _namesInontSet arg_ctx_ _lhsOquantCollect :: QuantMap _lhsOquantCollect = rule179 _namesInontSet arg_quants_ _attrsOnts = rule180 _namesInontSet _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule181 () _lhsOblocks :: Blocks _lhsOblocks = rule182 () _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule183 () _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule184 () _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule185 () _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule186 () _lhsOcollectedConstructorsMap :: Map NontermIdent (Set ConstructorIdent) _lhsOcollectedConstructorsMap = rule187 () _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule188 () _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule189 () _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule190 () _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule191 () _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule192 _namesIcollectedNames _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule193 () _lhsOcollectedSetNames :: Set Identifier _lhsOcollectedSetNames = rule194 () _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule195 () _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule196 () _lhsOconstructorTypeMap :: Map NontermIdent ConstructorType _lhsOconstructorTypeMap = rule197 () _lhsOderivings :: Derivings _lhsOderivings = rule198 () _lhsOerrors :: Seq Error _lhsOerrors = rule199 _attrsIerrors _namesIerrors _lhsOmoduleDecl :: Maybe (String,String,String) _lhsOmoduleDecl = rule200 () _lhsOparamsCollect :: ParamMap _lhsOparamsCollect = rule201 () _lhsOpragmas :: Options -> Options _lhsOpragmas = rule202 () _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule203 () _lhsOtypeSyns :: TypeSyns _lhsOtypeSyns = rule204 () _lhsOuseMap :: Map NontermIdent (Map Identifier (String,String,String)) _lhsOuseMap = rule205 _attrsIuseMap _lhsOwrappers :: Set NontermIdent _lhsOwrappers = rule206 () _lhsOattrDecls :: Map NontermIdent (Attributes, Attributes) _lhsOattrDecls = rule207 _attrsIattrDecls _lhsOattrs :: Map NontermIdent (Attributes, Attributes) _lhsOattrs = rule208 _attrsIattrs _lhsOdefSets :: Map Identifier (Set NontermIdent,Set Identifier) _lhsOdefSets = rule209 _lhsIdefSets _namesOallFields = rule210 _lhsIallFields _namesOallNonterminals = rule211 _lhsIallNonterminals _namesOdefinedSets = rule212 _lhsIdefinedSets _attrsOallFields = rule213 _lhsIallFields _attrsOallNonterminals = rule214 _lhsIallNonterminals _attrsOattrDecls = rule215 _lhsIattrDecls _attrsOattrs = rule216 _lhsIattrs _attrsOoptions = rule217 _lhsIoptions __result_ = T_Elem_vOut16 _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers in __result_ ) in C_Elem_s17 v16 {-# INLINE rule178 #-} {-# LINE 971 "src-ag/Transform.ag" #-} rule178 = \ ((_namesInontSet) :: Set NontermIdent) ctx_ -> {-# LINE 971 "src-ag/Transform.ag" #-} if null ctx_ then Map.empty else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] {-# LINE 2136 "dist/build/Transform.hs"#-} {-# INLINE rule179 #-} {-# LINE 996 "src-ag/Transform.ag" #-} rule179 = \ ((_namesInontSet) :: Set NontermIdent) quants_ -> {-# LINE 996 "src-ag/Transform.ag" #-} if null quants_ then Map.empty else Map.fromList [(nt, quants_) | nt <- Set.toList _namesInontSet] {-# LINE 2144 "dist/build/Transform.hs"#-} {-# INLINE rule180 #-} {-# LINE 1034 "src-ag/Transform.ag" #-} rule180 = \ ((_namesInontSet) :: Set NontermIdent) -> {-# LINE 1034 "src-ag/Transform.ag" #-} _namesInontSet {-# LINE 2150 "dist/build/Transform.hs"#-} {-# INLINE rule181 #-} rule181 = \ (_ :: ()) -> Map.empty {-# INLINE rule182 #-} rule182 = \ (_ :: ()) -> Map.empty {-# INLINE rule183 #-} rule183 = \ (_ :: ()) -> [] {-# INLINE rule184 #-} rule184 = \ (_ :: ()) -> [] {-# INLINE rule185 #-} rule185 = \ (_ :: ()) -> [] {-# INLINE rule186 #-} rule186 = \ (_ :: ()) -> [] {-# INLINE rule187 #-} rule187 = \ (_ :: ()) -> Map.empty {-# INLINE rule188 #-} rule188 = \ (_ :: ()) -> [] {-# INLINE rule189 #-} rule189 = \ (_ :: ()) -> [] {-# INLINE rule190 #-} rule190 = \ (_ :: ()) -> [] {-# INLINE rule191 #-} rule191 = \ (_ :: ()) -> [] {-# INLINE rule192 #-} rule192 = \ ((_namesIcollectedNames) :: Set Identifier) -> _namesIcollectedNames {-# INLINE rule193 #-} rule193 = \ (_ :: ()) -> [] {-# INLINE rule194 #-} rule194 = \ (_ :: ()) -> Set.empty {-# INLINE rule195 #-} rule195 = \ (_ :: ()) -> [] {-# INLINE rule196 #-} rule196 = \ (_ :: ()) -> [] {-# INLINE rule197 #-} rule197 = \ (_ :: ()) -> Map.empty {-# INLINE rule198 #-} rule198 = \ (_ :: ()) -> Map.empty {-# INLINE rule199 #-} rule199 = \ ((_attrsIerrors) :: Seq Error) ((_namesIerrors) :: Seq Error) -> _namesIerrors Seq.>< _attrsIerrors {-# INLINE rule200 #-} rule200 = \ (_ :: ()) -> mzero {-# INLINE rule201 #-} rule201 = \ (_ :: ()) -> Map.empty {-# INLINE rule202 #-} rule202 = \ (_ :: ()) -> id {-# INLINE rule203 #-} rule203 = \ (_ :: ()) -> Map.empty {-# INLINE rule204 #-} rule204 = \ (_ :: ()) -> [] {-# INLINE rule205 #-} rule205 = \ ((_attrsIuseMap) :: Map NontermIdent (Map Identifier (String,String,String))) -> _attrsIuseMap {-# INLINE rule206 #-} rule206 = \ (_ :: ()) -> Set.empty {-# INLINE rule207 #-} rule207 = \ ((_attrsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _attrsIattrDecls {-# INLINE rule208 #-} rule208 = \ ((_attrsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _attrsIattrs {-# INLINE rule209 #-} rule209 = \ ((_lhsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> _lhsIdefSets {-# INLINE rule210 #-} rule210 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule211 #-} rule211 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule212 #-} rule212 = \ ((_lhsIdefinedSets) :: DefinedSets) -> _lhsIdefinedSets {-# INLINE rule213 #-} rule213 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule214 #-} rule214 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule215 #-} rule215 = \ ((_lhsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrDecls {-# INLINE rule216 #-} rule216 = \ ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrs {-# INLINE rule217 #-} rule217 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Elem_Sem #-} sem_Elem_Sem :: (Pos) -> (ClassContext) -> T_NontSet -> T_Attrs -> ([String]) -> T_SemAlts -> T_Elem sem_Elem_Sem _ arg_ctx_ arg_names_ arg_attrs_ arg_quants_ arg_alts_ = T_Elem (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Elem_v16 v16 = \ (T_Elem_vIn16 _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) -> ( let _namesX29 = Control.Monad.Identity.runIdentity (attach_T_NontSet (arg_names_)) _attrsX11 = Control.Monad.Identity.runIdentity (attach_T_Attrs (arg_attrs_)) _altsX41 = Control.Monad.Identity.runIdentity (attach_T_SemAlts (arg_alts_)) (T_NontSet_vOut28 _namesIcollectedNames _namesIerrors _namesInontSet) = inv_NontSet_s29 _namesX29 (T_NontSet_vIn28 _namesOallFields _namesOallNonterminals _namesOdefinedSets) (T_Attrs_vOut10 _attrsIattrDecls _attrsIattrs _attrsIerrors _attrsIuseMap) = inv_Attrs_s11 _attrsX11 (T_Attrs_vIn10 _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOattrs _attrsOnts _attrsOoptions) (T_SemAlts_vOut40 _altsIattrOrderCollect _altsIcollectedArounds _altsIcollectedAugments _altsIcollectedInsts _altsIcollectedMerges _altsIcollectedRules _altsIcollectedSigs _altsIcollectedUniques _altsIerrors _altsIsemPragmasCollect) = inv_SemAlts_s41 _altsX41 (T_SemAlts_vIn40 _altsOallAttrDecls _altsOallAttrs _altsOallFields _altsOnts _altsOoptions) _altsOnts = rule218 _namesInontSet _lhsOctxCollect :: ContextMap _lhsOctxCollect = rule219 _namesInontSet arg_ctx_ _lhsOquantCollect :: QuantMap _lhsOquantCollect = rule220 _namesInontSet arg_quants_ _attrsOnts = rule221 _namesInontSet _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule222 _altsIattrOrderCollect _lhsOblocks :: Blocks _lhsOblocks = rule223 () _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule224 _altsIcollectedArounds _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule225 _altsIcollectedAugments _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule226 () _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule227 () _lhsOcollectedConstructorsMap :: Map NontermIdent (Set ConstructorIdent) _lhsOcollectedConstructorsMap = rule228 () _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule229 () _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule230 _altsIcollectedInsts _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule231 () _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule232 _altsIcollectedMerges _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule233 _namesIcollectedNames _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule234 _altsIcollectedRules _lhsOcollectedSetNames :: Set Identifier _lhsOcollectedSetNames = rule235 () _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule236 _altsIcollectedSigs _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule237 _altsIcollectedUniques _lhsOconstructorTypeMap :: Map NontermIdent ConstructorType _lhsOconstructorTypeMap = rule238 () _lhsOderivings :: Derivings _lhsOderivings = rule239 () _lhsOerrors :: Seq Error _lhsOerrors = rule240 _altsIerrors _attrsIerrors _namesIerrors _lhsOmoduleDecl :: Maybe (String,String,String) _lhsOmoduleDecl = rule241 () _lhsOparamsCollect :: ParamMap _lhsOparamsCollect = rule242 () _lhsOpragmas :: Options -> Options _lhsOpragmas = rule243 () _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule244 _altsIsemPragmasCollect _lhsOtypeSyns :: TypeSyns _lhsOtypeSyns = rule245 () _lhsOuseMap :: Map NontermIdent (Map Identifier (String,String,String)) _lhsOuseMap = rule246 _attrsIuseMap _lhsOwrappers :: Set NontermIdent _lhsOwrappers = rule247 () _lhsOattrDecls :: Map NontermIdent (Attributes, Attributes) _lhsOattrDecls = rule248 _attrsIattrDecls _lhsOattrs :: Map NontermIdent (Attributes, Attributes) _lhsOattrs = rule249 _attrsIattrs _lhsOdefSets :: Map Identifier (Set NontermIdent,Set Identifier) _lhsOdefSets = rule250 _lhsIdefSets _namesOallFields = rule251 _lhsIallFields _namesOallNonterminals = rule252 _lhsIallNonterminals _namesOdefinedSets = rule253 _lhsIdefinedSets _attrsOallFields = rule254 _lhsIallFields _attrsOallNonterminals = rule255 _lhsIallNonterminals _attrsOattrDecls = rule256 _lhsIattrDecls _attrsOattrs = rule257 _lhsIattrs _attrsOoptions = rule258 _lhsIoptions _altsOallAttrDecls = rule259 _lhsIallAttrDecls _altsOallAttrs = rule260 _lhsIallAttrs _altsOallFields = rule261 _lhsIallFields _altsOoptions = rule262 _lhsIoptions __result_ = T_Elem_vOut16 _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers in __result_ ) in C_Elem_s17 v16 {-# INLINE rule218 #-} {-# LINE 177 "src-ag/Transform.ag" #-} rule218 = \ ((_namesInontSet) :: Set NontermIdent) -> {-# LINE 177 "src-ag/Transform.ag" #-} _namesInontSet {-# LINE 2359 "dist/build/Transform.hs"#-} {-# INLINE rule219 #-} {-# LINE 971 "src-ag/Transform.ag" #-} rule219 = \ ((_namesInontSet) :: Set NontermIdent) ctx_ -> {-# LINE 971 "src-ag/Transform.ag" #-} if null ctx_ then Map.empty else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] {-# LINE 2367 "dist/build/Transform.hs"#-} {-# INLINE rule220 #-} {-# LINE 996 "src-ag/Transform.ag" #-} rule220 = \ ((_namesInontSet) :: Set NontermIdent) quants_ -> {-# LINE 996 "src-ag/Transform.ag" #-} if null quants_ then Map.empty else Map.fromList [(nt, quants_) | nt <- Set.toList _namesInontSet] {-# LINE 2375 "dist/build/Transform.hs"#-} {-# INLINE rule221 #-} {-# LINE 1035 "src-ag/Transform.ag" #-} rule221 = \ ((_namesInontSet) :: Set NontermIdent) -> {-# LINE 1035 "src-ag/Transform.ag" #-} _namesInontSet {-# LINE 2381 "dist/build/Transform.hs"#-} {-# INLINE rule222 #-} rule222 = \ ((_altsIattrOrderCollect) :: AttrOrderMap) -> _altsIattrOrderCollect {-# INLINE rule223 #-} rule223 = \ (_ :: ()) -> Map.empty {-# INLINE rule224 #-} rule224 = \ ((_altsIcollectedArounds) :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) -> _altsIcollectedArounds {-# INLINE rule225 #-} rule225 = \ ((_altsIcollectedAugments) :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) -> _altsIcollectedAugments {-# INLINE rule226 #-} rule226 = \ (_ :: ()) -> [] {-# INLINE rule227 #-} rule227 = \ (_ :: ()) -> [] {-# INLINE rule228 #-} rule228 = \ (_ :: ()) -> Map.empty {-# INLINE rule229 #-} rule229 = \ (_ :: ()) -> [] {-# INLINE rule230 #-} rule230 = \ ((_altsIcollectedInsts) :: [ (NontermIdent, ConstructorIdent, [Identifier]) ]) -> _altsIcollectedInsts {-# INLINE rule231 #-} rule231 = \ (_ :: ()) -> [] {-# INLINE rule232 #-} rule232 = \ ((_altsIcollectedMerges) :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) -> _altsIcollectedMerges {-# INLINE rule233 #-} rule233 = \ ((_namesIcollectedNames) :: Set Identifier) -> _namesIcollectedNames {-# INLINE rule234 #-} rule234 = \ ((_altsIcollectedRules) :: [ (NontermIdent, ConstructorIdent, RuleInfo)]) -> _altsIcollectedRules {-# INLINE rule235 #-} rule235 = \ (_ :: ()) -> Set.empty {-# INLINE rule236 #-} rule236 = \ ((_altsIcollectedSigs) :: [ (NontermIdent, ConstructorIdent, SigInfo) ]) -> _altsIcollectedSigs {-# INLINE rule237 #-} rule237 = \ ((_altsIcollectedUniques) :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) -> _altsIcollectedUniques {-# INLINE rule238 #-} rule238 = \ (_ :: ()) -> Map.empty {-# INLINE rule239 #-} rule239 = \ (_ :: ()) -> Map.empty {-# INLINE rule240 #-} rule240 = \ ((_altsIerrors) :: Seq Error) ((_attrsIerrors) :: Seq Error) ((_namesIerrors) :: Seq Error) -> _namesIerrors Seq.>< _attrsIerrors Seq.>< _altsIerrors {-# INLINE rule241 #-} rule241 = \ (_ :: ()) -> mzero {-# INLINE rule242 #-} rule242 = \ (_ :: ()) -> Map.empty {-# INLINE rule243 #-} rule243 = \ (_ :: ()) -> id {-# INLINE rule244 #-} rule244 = \ ((_altsIsemPragmasCollect) :: PragmaMap) -> _altsIsemPragmasCollect {-# INLINE rule245 #-} rule245 = \ (_ :: ()) -> [] {-# INLINE rule246 #-} rule246 = \ ((_attrsIuseMap) :: Map NontermIdent (Map Identifier (String,String,String))) -> _attrsIuseMap {-# INLINE rule247 #-} rule247 = \ (_ :: ()) -> Set.empty {-# INLINE rule248 #-} rule248 = \ ((_attrsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _attrsIattrDecls {-# INLINE rule249 #-} rule249 = \ ((_attrsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _attrsIattrs {-# INLINE rule250 #-} rule250 = \ ((_lhsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> _lhsIdefSets {-# INLINE rule251 #-} rule251 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule252 #-} rule252 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule253 #-} rule253 = \ ((_lhsIdefinedSets) :: DefinedSets) -> _lhsIdefinedSets {-# INLINE rule254 #-} rule254 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule255 #-} rule255 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule256 #-} rule256 = \ ((_lhsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrDecls {-# INLINE rule257 #-} rule257 = \ ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrs {-# INLINE rule258 #-} rule258 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule259 #-} rule259 = \ ((_lhsIallAttrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIallAttrDecls {-# INLINE rule260 #-} rule260 = \ ((_lhsIallAttrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIallAttrs {-# INLINE rule261 #-} rule261 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule262 #-} rule262 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Elem_Txt #-} sem_Elem_Txt :: (Pos) -> (BlockKind) -> (Maybe NontermIdent) -> ([String]) -> T_Elem sem_Elem_Txt arg_pos_ arg_kind_ arg_mbNt_ arg_lines_ = T_Elem (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Elem_v16 v16 = \ (T_Elem_vIn16 _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) -> ( let _blockInfo = rule263 arg_kind_ arg_mbNt_ _blockValue = rule264 arg_lines_ arg_pos_ _lhsOblocks :: Blocks _lhsOblocks = rule265 _blockInfo _blockValue _lhsOerrors :: Seq Error _lhsOerrors = rule266 _lhsIoptions arg_lines_ arg_pos_ _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule267 () _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule268 () _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule269 () _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule270 () _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule271 () _lhsOcollectedConstructorsMap :: Map NontermIdent (Set ConstructorIdent) _lhsOcollectedConstructorsMap = rule272 () _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule273 () _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule274 () _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule275 () _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule276 () _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule277 () _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule278 () _lhsOcollectedSetNames :: Set Identifier _lhsOcollectedSetNames = rule279 () _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule280 () _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule281 () _lhsOconstructorTypeMap :: Map NontermIdent ConstructorType _lhsOconstructorTypeMap = rule282 () _lhsOctxCollect :: ContextMap _lhsOctxCollect = rule283 () _lhsOderivings :: Derivings _lhsOderivings = rule284 () _lhsOmoduleDecl :: Maybe (String,String,String) _lhsOmoduleDecl = rule285 () _lhsOparamsCollect :: ParamMap _lhsOparamsCollect = rule286 () _lhsOpragmas :: Options -> Options _lhsOpragmas = rule287 () _lhsOquantCollect :: QuantMap _lhsOquantCollect = rule288 () _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule289 () _lhsOtypeSyns :: TypeSyns _lhsOtypeSyns = rule290 () _lhsOuseMap :: Map NontermIdent (Map Identifier (String,String,String)) _lhsOuseMap = rule291 () _lhsOwrappers :: Set NontermIdent _lhsOwrappers = rule292 () _lhsOattrDecls :: Map NontermIdent (Attributes, Attributes) _lhsOattrDecls = rule293 _lhsIattrDecls _lhsOattrs :: Map NontermIdent (Attributes, Attributes) _lhsOattrs = rule294 _lhsIattrs _lhsOdefSets :: Map Identifier (Set NontermIdent,Set Identifier) _lhsOdefSets = rule295 _lhsIdefSets __result_ = T_Elem_vOut16 _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers in __result_ ) in C_Elem_s17 v16 {-# INLINE rule263 #-} {-# LINE 186 "src-ag/Transform.ag" #-} rule263 = \ kind_ mbNt_ -> {-# LINE 186 "src-ag/Transform.ag" #-} ( kind_ , mbNt_ ) {-# LINE 2586 "dist/build/Transform.hs"#-} {-# INLINE rule264 #-} {-# LINE 189 "src-ag/Transform.ag" #-} rule264 = \ lines_ pos_ -> {-# LINE 189 "src-ag/Transform.ag" #-} [(lines_, pos_)] {-# LINE 2592 "dist/build/Transform.hs"#-} {-# INLINE rule265 #-} {-# LINE 190 "src-ag/Transform.ag" #-} rule265 = \ _blockInfo _blockValue -> {-# LINE 190 "src-ag/Transform.ag" #-} Map.singleton _blockInfo _blockValue {-# LINE 2598 "dist/build/Transform.hs"#-} {-# INLINE rule266 #-} {-# LINE 191 "src-ag/Transform.ag" #-} rule266 = \ ((_lhsIoptions) :: Options) lines_ pos_ -> {-# LINE 191 "src-ag/Transform.ag" #-} if checkParseBlock _lhsIoptions then let ex = Expression pos_ tks tks = [tk] tk = HsToken (unlines lines_) pos_ in Seq.fromList $ checkBlock $ ex else Seq.empty {-# LINE 2609 "dist/build/Transform.hs"#-} {-# INLINE rule267 #-} rule267 = \ (_ :: ()) -> Map.empty {-# INLINE rule268 #-} rule268 = \ (_ :: ()) -> [] {-# INLINE rule269 #-} rule269 = \ (_ :: ()) -> [] {-# INLINE rule270 #-} rule270 = \ (_ :: ()) -> [] {-# INLINE rule271 #-} rule271 = \ (_ :: ()) -> [] {-# INLINE rule272 #-} rule272 = \ (_ :: ()) -> Map.empty {-# INLINE rule273 #-} rule273 = \ (_ :: ()) -> [] {-# INLINE rule274 #-} rule274 = \ (_ :: ()) -> [] {-# INLINE rule275 #-} rule275 = \ (_ :: ()) -> [] {-# INLINE rule276 #-} rule276 = \ (_ :: ()) -> [] {-# INLINE rule277 #-} rule277 = \ (_ :: ()) -> Set.empty {-# INLINE rule278 #-} rule278 = \ (_ :: ()) -> [] {-# INLINE rule279 #-} rule279 = \ (_ :: ()) -> Set.empty {-# INLINE rule280 #-} rule280 = \ (_ :: ()) -> [] {-# INLINE rule281 #-} rule281 = \ (_ :: ()) -> [] {-# INLINE rule282 #-} rule282 = \ (_ :: ()) -> Map.empty {-# INLINE rule283 #-} rule283 = \ (_ :: ()) -> Map.empty {-# INLINE rule284 #-} rule284 = \ (_ :: ()) -> Map.empty {-# INLINE rule285 #-} rule285 = \ (_ :: ()) -> mzero {-# INLINE rule286 #-} rule286 = \ (_ :: ()) -> Map.empty {-# INLINE rule287 #-} rule287 = \ (_ :: ()) -> id {-# INLINE rule288 #-} rule288 = \ (_ :: ()) -> Map.empty {-# INLINE rule289 #-} rule289 = \ (_ :: ()) -> Map.empty {-# INLINE rule290 #-} rule290 = \ (_ :: ()) -> [] {-# INLINE rule291 #-} rule291 = \ (_ :: ()) -> Map.empty {-# INLINE rule292 #-} rule292 = \ (_ :: ()) -> Set.empty {-# INLINE rule293 #-} rule293 = \ ((_lhsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrDecls {-# INLINE rule294 #-} rule294 = \ ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrs {-# INLINE rule295 #-} rule295 = \ ((_lhsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> _lhsIdefSets {-# NOINLINE sem_Elem_Set #-} sem_Elem_Set :: (Pos) -> (NontermIdent) -> (Bool) -> T_NontSet -> T_Elem sem_Elem_Set _ arg_name_ arg_merge_ arg_set_ = T_Elem (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Elem_v16 v16 = \ (T_Elem_vIn16 _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) -> ( let _setX29 = Control.Monad.Identity.runIdentity (attach_T_NontSet (arg_set_)) (T_NontSet_vOut28 _setIcollectedNames _setIerrors _setInontSet) = inv_NontSet_s29 _setX29 (T_NontSet_vIn28 _setOallFields _setOallNonterminals _setOdefinedSets) _lhsOcollectedSetNames :: Set Identifier _lhsOcollectedSetNames = rule296 arg_name_ (_defSets2,_errs) = rule297 _lhsIallNonterminals _lhsIdefSets _setIcollectedNames _setInontSet arg_merge_ arg_name_ _lhsOdefSets :: Map Identifier (Set NontermIdent,Set Identifier) _lhsOdefSets = rule298 _defSets2 _lhsOerrors :: Seq Error _lhsOerrors = rule299 _errs _setIerrors _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule300 () _lhsOblocks :: Blocks _lhsOblocks = rule301 () _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule302 () _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule303 () _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule304 () _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule305 () _lhsOcollectedConstructorsMap :: Map NontermIdent (Set ConstructorIdent) _lhsOcollectedConstructorsMap = rule306 () _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule307 () _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule308 () _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule309 () _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule310 () _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule311 _setIcollectedNames _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule312 () _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule313 () _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule314 () _lhsOconstructorTypeMap :: Map NontermIdent ConstructorType _lhsOconstructorTypeMap = rule315 () _lhsOctxCollect :: ContextMap _lhsOctxCollect = rule316 () _lhsOderivings :: Derivings _lhsOderivings = rule317 () _lhsOmoduleDecl :: Maybe (String,String,String) _lhsOmoduleDecl = rule318 () _lhsOparamsCollect :: ParamMap _lhsOparamsCollect = rule319 () _lhsOpragmas :: Options -> Options _lhsOpragmas = rule320 () _lhsOquantCollect :: QuantMap _lhsOquantCollect = rule321 () _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule322 () _lhsOtypeSyns :: TypeSyns _lhsOtypeSyns = rule323 () _lhsOuseMap :: Map NontermIdent (Map Identifier (String,String,String)) _lhsOuseMap = rule324 () _lhsOwrappers :: Set NontermIdent _lhsOwrappers = rule325 () _lhsOattrDecls :: Map NontermIdent (Attributes, Attributes) _lhsOattrDecls = rule326 _lhsIattrDecls _lhsOattrs :: Map NontermIdent (Attributes, Attributes) _lhsOattrs = rule327 _lhsIattrs _setOallFields = rule328 _lhsIallFields _setOallNonterminals = rule329 _lhsIallNonterminals _setOdefinedSets = rule330 _lhsIdefinedSets __result_ = T_Elem_vOut16 _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers in __result_ ) in C_Elem_s17 v16 {-# INLINE rule296 #-} {-# LINE 597 "src-ag/Transform.ag" #-} rule296 = \ name_ -> {-# LINE 597 "src-ag/Transform.ag" #-} Set.singleton name_ {-# LINE 2780 "dist/build/Transform.hs"#-} {-# INLINE rule297 #-} {-# LINE 714 "src-ag/Transform.ag" #-} rule297 = \ ((_lhsIallNonterminals) :: Set NontermIdent) ((_lhsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) ((_setIcollectedNames) :: Set Identifier) ((_setInontSet) :: Set NontermIdent) merge_ name_ -> {-# LINE 714 "src-ag/Transform.ag" #-} let allUsedNames = Set.unions [ maybe (Set.singleton n) snd (Map.lookup n _lhsIdefSets) | n <- Set.toList _setIcollectedNames ] (nontSet,e1) | Set.member name_ allUsedNames = (Set.empty, Seq.singleton(CyclicSet name_)) | otherwise = (_setInontSet, Seq.empty) (res, e2) = let toAdd = (nontSet,Set.insert name_ allUsedNames) un (a,b) (c,d) = (a `Set.union` c, b `Set.union` d) in if Set.member name_ _lhsIallNonterminals || not merge_ then checkDuplicate DupSet name_ toAdd _lhsIdefSets else (Map.insertWith un name_ toAdd _lhsIdefSets, Seq.empty) in (res, e1 Seq.>< e2) {-# LINE 2799 "dist/build/Transform.hs"#-} {-# INLINE rule298 #-} {-# LINE 728 "src-ag/Transform.ag" #-} rule298 = \ _defSets2 -> {-# LINE 728 "src-ag/Transform.ag" #-} _defSets2 {-# LINE 2805 "dist/build/Transform.hs"#-} {-# INLINE rule299 #-} {-# LINE 729 "src-ag/Transform.ag" #-} rule299 = \ _errs ((_setIerrors) :: Seq Error) -> {-# LINE 729 "src-ag/Transform.ag" #-} _errs >< _setIerrors {-# LINE 2811 "dist/build/Transform.hs"#-} {-# INLINE rule300 #-} rule300 = \ (_ :: ()) -> Map.empty {-# INLINE rule301 #-} rule301 = \ (_ :: ()) -> Map.empty {-# INLINE rule302 #-} rule302 = \ (_ :: ()) -> [] {-# INLINE rule303 #-} rule303 = \ (_ :: ()) -> [] {-# INLINE rule304 #-} rule304 = \ (_ :: ()) -> [] {-# INLINE rule305 #-} rule305 = \ (_ :: ()) -> [] {-# INLINE rule306 #-} rule306 = \ (_ :: ()) -> Map.empty {-# INLINE rule307 #-} rule307 = \ (_ :: ()) -> [] {-# INLINE rule308 #-} rule308 = \ (_ :: ()) -> [] {-# INLINE rule309 #-} rule309 = \ (_ :: ()) -> [] {-# INLINE rule310 #-} rule310 = \ (_ :: ()) -> [] {-# INLINE rule311 #-} rule311 = \ ((_setIcollectedNames) :: Set Identifier) -> _setIcollectedNames {-# INLINE rule312 #-} rule312 = \ (_ :: ()) -> [] {-# INLINE rule313 #-} rule313 = \ (_ :: ()) -> [] {-# INLINE rule314 #-} rule314 = \ (_ :: ()) -> [] {-# INLINE rule315 #-} rule315 = \ (_ :: ()) -> Map.empty {-# INLINE rule316 #-} rule316 = \ (_ :: ()) -> Map.empty {-# INLINE rule317 #-} rule317 = \ (_ :: ()) -> Map.empty {-# INLINE rule318 #-} rule318 = \ (_ :: ()) -> mzero {-# INLINE rule319 #-} rule319 = \ (_ :: ()) -> Map.empty {-# INLINE rule320 #-} rule320 = \ (_ :: ()) -> id {-# INLINE rule321 #-} rule321 = \ (_ :: ()) -> Map.empty {-# INLINE rule322 #-} rule322 = \ (_ :: ()) -> Map.empty {-# INLINE rule323 #-} rule323 = \ (_ :: ()) -> [] {-# INLINE rule324 #-} rule324 = \ (_ :: ()) -> Map.empty {-# INLINE rule325 #-} rule325 = \ (_ :: ()) -> Set.empty {-# INLINE rule326 #-} rule326 = \ ((_lhsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrDecls {-# INLINE rule327 #-} rule327 = \ ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrs {-# INLINE rule328 #-} rule328 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule329 #-} rule329 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule330 #-} rule330 = \ ((_lhsIdefinedSets) :: DefinedSets) -> _lhsIdefinedSets {-# NOINLINE sem_Elem_Deriving #-} sem_Elem_Deriving :: (Pos) -> T_NontSet -> ([NontermIdent]) -> T_Elem sem_Elem_Deriving _ arg_set_ arg_classes_ = T_Elem (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Elem_v16 v16 = \ (T_Elem_vIn16 _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) -> ( let _setX29 = Control.Monad.Identity.runIdentity (attach_T_NontSet (arg_set_)) (T_NontSet_vOut28 _setIcollectedNames _setIerrors _setInontSet) = inv_NontSet_s29 _setX29 (T_NontSet_vIn28 _setOallFields _setOallNonterminals _setOdefinedSets) _lhsOderivings :: Derivings _lhsOderivings = rule331 _setInontSet arg_classes_ _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule332 () _lhsOblocks :: Blocks _lhsOblocks = rule333 () _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule334 () _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule335 () _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule336 () _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule337 () _lhsOcollectedConstructorsMap :: Map NontermIdent (Set ConstructorIdent) _lhsOcollectedConstructorsMap = rule338 () _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule339 () _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule340 () _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule341 () _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule342 () _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule343 _setIcollectedNames _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule344 () _lhsOcollectedSetNames :: Set Identifier _lhsOcollectedSetNames = rule345 () _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule346 () _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule347 () _lhsOconstructorTypeMap :: Map NontermIdent ConstructorType _lhsOconstructorTypeMap = rule348 () _lhsOctxCollect :: ContextMap _lhsOctxCollect = rule349 () _lhsOerrors :: Seq Error _lhsOerrors = rule350 _setIerrors _lhsOmoduleDecl :: Maybe (String,String,String) _lhsOmoduleDecl = rule351 () _lhsOparamsCollect :: ParamMap _lhsOparamsCollect = rule352 () _lhsOpragmas :: Options -> Options _lhsOpragmas = rule353 () _lhsOquantCollect :: QuantMap _lhsOquantCollect = rule354 () _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule355 () _lhsOtypeSyns :: TypeSyns _lhsOtypeSyns = rule356 () _lhsOuseMap :: Map NontermIdent (Map Identifier (String,String,String)) _lhsOuseMap = rule357 () _lhsOwrappers :: Set NontermIdent _lhsOwrappers = rule358 () _lhsOattrDecls :: Map NontermIdent (Attributes, Attributes) _lhsOattrDecls = rule359 _lhsIattrDecls _lhsOattrs :: Map NontermIdent (Attributes, Attributes) _lhsOattrs = rule360 _lhsIattrs _lhsOdefSets :: Map Identifier (Set NontermIdent,Set Identifier) _lhsOdefSets = rule361 _lhsIdefSets _setOallFields = rule362 _lhsIallFields _setOallNonterminals = rule363 _lhsIallNonterminals _setOdefinedSets = rule364 _lhsIdefinedSets __result_ = T_Elem_vOut16 _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers in __result_ ) in C_Elem_s17 v16 {-# INLINE rule331 #-} {-# LINE 1017 "src-ag/Transform.ag" #-} rule331 = \ ((_setInontSet) :: Set NontermIdent) classes_ -> {-# LINE 1017 "src-ag/Transform.ag" #-} Map.fromList [(nt,Set.fromList classes_) | nt <- Set.toList _setInontSet] {-# LINE 2987 "dist/build/Transform.hs"#-} {-# INLINE rule332 #-} rule332 = \ (_ :: ()) -> Map.empty {-# INLINE rule333 #-} rule333 = \ (_ :: ()) -> Map.empty {-# INLINE rule334 #-} rule334 = \ (_ :: ()) -> [] {-# INLINE rule335 #-} rule335 = \ (_ :: ()) -> [] {-# INLINE rule336 #-} rule336 = \ (_ :: ()) -> [] {-# INLINE rule337 #-} rule337 = \ (_ :: ()) -> [] {-# INLINE rule338 #-} rule338 = \ (_ :: ()) -> Map.empty {-# INLINE rule339 #-} rule339 = \ (_ :: ()) -> [] {-# INLINE rule340 #-} rule340 = \ (_ :: ()) -> [] {-# INLINE rule341 #-} rule341 = \ (_ :: ()) -> [] {-# INLINE rule342 #-} rule342 = \ (_ :: ()) -> [] {-# INLINE rule343 #-} rule343 = \ ((_setIcollectedNames) :: Set Identifier) -> _setIcollectedNames {-# INLINE rule344 #-} rule344 = \ (_ :: ()) -> [] {-# INLINE rule345 #-} rule345 = \ (_ :: ()) -> Set.empty {-# INLINE rule346 #-} rule346 = \ (_ :: ()) -> [] {-# INLINE rule347 #-} rule347 = \ (_ :: ()) -> [] {-# INLINE rule348 #-} rule348 = \ (_ :: ()) -> Map.empty {-# INLINE rule349 #-} rule349 = \ (_ :: ()) -> Map.empty {-# INLINE rule350 #-} rule350 = \ ((_setIerrors) :: Seq Error) -> _setIerrors {-# INLINE rule351 #-} rule351 = \ (_ :: ()) -> mzero {-# INLINE rule352 #-} rule352 = \ (_ :: ()) -> Map.empty {-# INLINE rule353 #-} rule353 = \ (_ :: ()) -> id {-# INLINE rule354 #-} rule354 = \ (_ :: ()) -> Map.empty {-# INLINE rule355 #-} rule355 = \ (_ :: ()) -> Map.empty {-# INLINE rule356 #-} rule356 = \ (_ :: ()) -> [] {-# INLINE rule357 #-} rule357 = \ (_ :: ()) -> Map.empty {-# INLINE rule358 #-} rule358 = \ (_ :: ()) -> Set.empty {-# INLINE rule359 #-} rule359 = \ ((_lhsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrDecls {-# INLINE rule360 #-} rule360 = \ ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrs {-# INLINE rule361 #-} rule361 = \ ((_lhsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> _lhsIdefSets {-# INLINE rule362 #-} rule362 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule363 #-} rule363 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule364 #-} rule364 = \ ((_lhsIdefinedSets) :: DefinedSets) -> _lhsIdefinedSets {-# NOINLINE sem_Elem_Wrapper #-} sem_Elem_Wrapper :: (Pos) -> T_NontSet -> T_Elem sem_Elem_Wrapper _ arg_set_ = T_Elem (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Elem_v16 v16 = \ (T_Elem_vIn16 _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) -> ( let _setX29 = Control.Monad.Identity.runIdentity (attach_T_NontSet (arg_set_)) (T_NontSet_vOut28 _setIcollectedNames _setIerrors _setInontSet) = inv_NontSet_s29 _setX29 (T_NontSet_vIn28 _setOallFields _setOallNonterminals _setOdefinedSets) _lhsOwrappers :: Set NontermIdent _lhsOwrappers = rule365 _setInontSet _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule366 () _lhsOblocks :: Blocks _lhsOblocks = rule367 () _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule368 () _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule369 () _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule370 () _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule371 () _lhsOcollectedConstructorsMap :: Map NontermIdent (Set ConstructorIdent) _lhsOcollectedConstructorsMap = rule372 () _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule373 () _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule374 () _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule375 () _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule376 () _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule377 _setIcollectedNames _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule378 () _lhsOcollectedSetNames :: Set Identifier _lhsOcollectedSetNames = rule379 () _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule380 () _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule381 () _lhsOconstructorTypeMap :: Map NontermIdent ConstructorType _lhsOconstructorTypeMap = rule382 () _lhsOctxCollect :: ContextMap _lhsOctxCollect = rule383 () _lhsOderivings :: Derivings _lhsOderivings = rule384 () _lhsOerrors :: Seq Error _lhsOerrors = rule385 _setIerrors _lhsOmoduleDecl :: Maybe (String,String,String) _lhsOmoduleDecl = rule386 () _lhsOparamsCollect :: ParamMap _lhsOparamsCollect = rule387 () _lhsOpragmas :: Options -> Options _lhsOpragmas = rule388 () _lhsOquantCollect :: QuantMap _lhsOquantCollect = rule389 () _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule390 () _lhsOtypeSyns :: TypeSyns _lhsOtypeSyns = rule391 () _lhsOuseMap :: Map NontermIdent (Map Identifier (String,String,String)) _lhsOuseMap = rule392 () _lhsOattrDecls :: Map NontermIdent (Attributes, Attributes) _lhsOattrDecls = rule393 _lhsIattrDecls _lhsOattrs :: Map NontermIdent (Attributes, Attributes) _lhsOattrs = rule394 _lhsIattrs _lhsOdefSets :: Map Identifier (Set NontermIdent,Set Identifier) _lhsOdefSets = rule395 _lhsIdefSets _setOallFields = rule396 _lhsIallFields _setOallNonterminals = rule397 _lhsIallNonterminals _setOdefinedSets = rule398 _lhsIdefinedSets __result_ = T_Elem_vOut16 _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers in __result_ ) in C_Elem_s17 v16 {-# INLINE rule365 #-} {-# LINE 789 "src-ag/Transform.ag" #-} rule365 = \ ((_setInontSet) :: Set NontermIdent) -> {-# LINE 789 "src-ag/Transform.ag" #-} _setInontSet {-# LINE 3169 "dist/build/Transform.hs"#-} {-# INLINE rule366 #-} rule366 = \ (_ :: ()) -> Map.empty {-# INLINE rule367 #-} rule367 = \ (_ :: ()) -> Map.empty {-# INLINE rule368 #-} rule368 = \ (_ :: ()) -> [] {-# INLINE rule369 #-} rule369 = \ (_ :: ()) -> [] {-# INLINE rule370 #-} rule370 = \ (_ :: ()) -> [] {-# INLINE rule371 #-} rule371 = \ (_ :: ()) -> [] {-# INLINE rule372 #-} rule372 = \ (_ :: ()) -> Map.empty {-# INLINE rule373 #-} rule373 = \ (_ :: ()) -> [] {-# INLINE rule374 #-} rule374 = \ (_ :: ()) -> [] {-# INLINE rule375 #-} rule375 = \ (_ :: ()) -> [] {-# INLINE rule376 #-} rule376 = \ (_ :: ()) -> [] {-# INLINE rule377 #-} rule377 = \ ((_setIcollectedNames) :: Set Identifier) -> _setIcollectedNames {-# INLINE rule378 #-} rule378 = \ (_ :: ()) -> [] {-# INLINE rule379 #-} rule379 = \ (_ :: ()) -> Set.empty {-# INLINE rule380 #-} rule380 = \ (_ :: ()) -> [] {-# INLINE rule381 #-} rule381 = \ (_ :: ()) -> [] {-# INLINE rule382 #-} rule382 = \ (_ :: ()) -> Map.empty {-# INLINE rule383 #-} rule383 = \ (_ :: ()) -> Map.empty {-# INLINE rule384 #-} rule384 = \ (_ :: ()) -> Map.empty {-# INLINE rule385 #-} rule385 = \ ((_setIerrors) :: Seq Error) -> _setIerrors {-# INLINE rule386 #-} rule386 = \ (_ :: ()) -> mzero {-# INLINE rule387 #-} rule387 = \ (_ :: ()) -> Map.empty {-# INLINE rule388 #-} rule388 = \ (_ :: ()) -> id {-# INLINE rule389 #-} rule389 = \ (_ :: ()) -> Map.empty {-# INLINE rule390 #-} rule390 = \ (_ :: ()) -> Map.empty {-# INLINE rule391 #-} rule391 = \ (_ :: ()) -> [] {-# INLINE rule392 #-} rule392 = \ (_ :: ()) -> Map.empty {-# INLINE rule393 #-} rule393 = \ ((_lhsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrDecls {-# INLINE rule394 #-} rule394 = \ ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrs {-# INLINE rule395 #-} rule395 = \ ((_lhsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> _lhsIdefSets {-# INLINE rule396 #-} rule396 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule397 #-} rule397 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule398 #-} rule398 = \ ((_lhsIdefinedSets) :: DefinedSets) -> _lhsIdefinedSets {-# NOINLINE sem_Elem_Nocatas #-} sem_Elem_Nocatas :: (Pos) -> T_NontSet -> T_Elem sem_Elem_Nocatas _ arg_set_ = T_Elem (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Elem_v16 v16 = \ (T_Elem_vIn16 _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) -> ( let _setX29 = Control.Monad.Identity.runIdentity (attach_T_NontSet (arg_set_)) (T_NontSet_vOut28 _setIcollectedNames _setIerrors _setInontSet) = inv_NontSet_s29 _setX29 (T_NontSet_vIn28 _setOallFields _setOallNonterminals _setOdefinedSets) _lhsOpragmas :: Options -> Options _lhsOpragmas = rule399 _setInontSet _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule400 () _lhsOblocks :: Blocks _lhsOblocks = rule401 () _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule402 () _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule403 () _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule404 () _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule405 () _lhsOcollectedConstructorsMap :: Map NontermIdent (Set ConstructorIdent) _lhsOcollectedConstructorsMap = rule406 () _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule407 () _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule408 () _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule409 () _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule410 () _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule411 _setIcollectedNames _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule412 () _lhsOcollectedSetNames :: Set Identifier _lhsOcollectedSetNames = rule413 () _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule414 () _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule415 () _lhsOconstructorTypeMap :: Map NontermIdent ConstructorType _lhsOconstructorTypeMap = rule416 () _lhsOctxCollect :: ContextMap _lhsOctxCollect = rule417 () _lhsOderivings :: Derivings _lhsOderivings = rule418 () _lhsOerrors :: Seq Error _lhsOerrors = rule419 _setIerrors _lhsOmoduleDecl :: Maybe (String,String,String) _lhsOmoduleDecl = rule420 () _lhsOparamsCollect :: ParamMap _lhsOparamsCollect = rule421 () _lhsOquantCollect :: QuantMap _lhsOquantCollect = rule422 () _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule423 () _lhsOtypeSyns :: TypeSyns _lhsOtypeSyns = rule424 () _lhsOuseMap :: Map NontermIdent (Map Identifier (String,String,String)) _lhsOuseMap = rule425 () _lhsOwrappers :: Set NontermIdent _lhsOwrappers = rule426 () _lhsOattrDecls :: Map NontermIdent (Attributes, Attributes) _lhsOattrDecls = rule427 _lhsIattrDecls _lhsOattrs :: Map NontermIdent (Attributes, Attributes) _lhsOattrs = rule428 _lhsIattrs _lhsOdefSets :: Map Identifier (Set NontermIdent,Set Identifier) _lhsOdefSets = rule429 _lhsIdefSets _setOallFields = rule430 _lhsIallFields _setOallNonterminals = rule431 _lhsIallNonterminals _setOdefinedSets = rule432 _lhsIdefinedSets __result_ = T_Elem_vOut16 _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers in __result_ ) in C_Elem_s17 v16 {-# INLINE rule399 #-} {-# LINE 796 "src-ag/Transform.ag" #-} rule399 = \ ((_setInontSet) :: Set NontermIdent) -> {-# LINE 796 "src-ag/Transform.ag" #-} \o -> o { nocatas = _setInontSet `Set.union` nocatas o } {-# LINE 3351 "dist/build/Transform.hs"#-} {-# INLINE rule400 #-} rule400 = \ (_ :: ()) -> Map.empty {-# INLINE rule401 #-} rule401 = \ (_ :: ()) -> Map.empty {-# INLINE rule402 #-} rule402 = \ (_ :: ()) -> [] {-# INLINE rule403 #-} rule403 = \ (_ :: ()) -> [] {-# INLINE rule404 #-} rule404 = \ (_ :: ()) -> [] {-# INLINE rule405 #-} rule405 = \ (_ :: ()) -> [] {-# INLINE rule406 #-} rule406 = \ (_ :: ()) -> Map.empty {-# INLINE rule407 #-} rule407 = \ (_ :: ()) -> [] {-# INLINE rule408 #-} rule408 = \ (_ :: ()) -> [] {-# INLINE rule409 #-} rule409 = \ (_ :: ()) -> [] {-# INLINE rule410 #-} rule410 = \ (_ :: ()) -> [] {-# INLINE rule411 #-} rule411 = \ ((_setIcollectedNames) :: Set Identifier) -> _setIcollectedNames {-# INLINE rule412 #-} rule412 = \ (_ :: ()) -> [] {-# INLINE rule413 #-} rule413 = \ (_ :: ()) -> Set.empty {-# INLINE rule414 #-} rule414 = \ (_ :: ()) -> [] {-# INLINE rule415 #-} rule415 = \ (_ :: ()) -> [] {-# INLINE rule416 #-} rule416 = \ (_ :: ()) -> Map.empty {-# INLINE rule417 #-} rule417 = \ (_ :: ()) -> Map.empty {-# INLINE rule418 #-} rule418 = \ (_ :: ()) -> Map.empty {-# INLINE rule419 #-} rule419 = \ ((_setIerrors) :: Seq Error) -> _setIerrors {-# INLINE rule420 #-} rule420 = \ (_ :: ()) -> mzero {-# INLINE rule421 #-} rule421 = \ (_ :: ()) -> Map.empty {-# INLINE rule422 #-} rule422 = \ (_ :: ()) -> Map.empty {-# INLINE rule423 #-} rule423 = \ (_ :: ()) -> Map.empty {-# INLINE rule424 #-} rule424 = \ (_ :: ()) -> [] {-# INLINE rule425 #-} rule425 = \ (_ :: ()) -> Map.empty {-# INLINE rule426 #-} rule426 = \ (_ :: ()) -> Set.empty {-# INLINE rule427 #-} rule427 = \ ((_lhsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrDecls {-# INLINE rule428 #-} rule428 = \ ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrs {-# INLINE rule429 #-} rule429 = \ ((_lhsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> _lhsIdefSets {-# INLINE rule430 #-} rule430 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule431 #-} rule431 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule432 #-} rule432 = \ ((_lhsIdefinedSets) :: DefinedSets) -> _lhsIdefinedSets {-# NOINLINE sem_Elem_Pragma #-} sem_Elem_Pragma :: (Pos) -> ([NontermIdent]) -> T_Elem sem_Elem_Pragma _ arg_names_ = T_Elem (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Elem_v16 v16 = \ (T_Elem_vIn16 _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) -> ( let _lhsOpragmas :: Options -> Options _lhsOpragmas = rule433 arg_names_ _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule434 () _lhsOblocks :: Blocks _lhsOblocks = rule435 () _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule436 () _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule437 () _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule438 () _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule439 () _lhsOcollectedConstructorsMap :: Map NontermIdent (Set ConstructorIdent) _lhsOcollectedConstructorsMap = rule440 () _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule441 () _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule442 () _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule443 () _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule444 () _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule445 () _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule446 () _lhsOcollectedSetNames :: Set Identifier _lhsOcollectedSetNames = rule447 () _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule448 () _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule449 () _lhsOconstructorTypeMap :: Map NontermIdent ConstructorType _lhsOconstructorTypeMap = rule450 () _lhsOctxCollect :: ContextMap _lhsOctxCollect = rule451 () _lhsOderivings :: Derivings _lhsOderivings = rule452 () _lhsOerrors :: Seq Error _lhsOerrors = rule453 () _lhsOmoduleDecl :: Maybe (String,String,String) _lhsOmoduleDecl = rule454 () _lhsOparamsCollect :: ParamMap _lhsOparamsCollect = rule455 () _lhsOquantCollect :: QuantMap _lhsOquantCollect = rule456 () _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule457 () _lhsOtypeSyns :: TypeSyns _lhsOtypeSyns = rule458 () _lhsOuseMap :: Map NontermIdent (Map Identifier (String,String,String)) _lhsOuseMap = rule459 () _lhsOwrappers :: Set NontermIdent _lhsOwrappers = rule460 () _lhsOattrDecls :: Map NontermIdent (Attributes, Attributes) _lhsOattrDecls = rule461 _lhsIattrDecls _lhsOattrs :: Map NontermIdent (Attributes, Attributes) _lhsOattrs = rule462 _lhsIattrs _lhsOdefSets :: Map Identifier (Set NontermIdent,Set Identifier) _lhsOdefSets = rule463 _lhsIdefSets __result_ = T_Elem_vOut16 _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers in __result_ ) in C_Elem_s17 v16 {-# INLINE rule433 #-} {-# LINE 805 "src-ag/Transform.ag" #-} rule433 = \ names_ -> {-# LINE 805 "src-ag/Transform.ag" #-} let mk n o = case getName n of "gencatas" -> o { folds = True } "nogencatas" -> o { folds = False } "gendatas" -> o { dataTypes = True } "datarecords" -> o { dataRecords = True } "nogendatas" -> o { dataTypes = False } "gensems" -> o { semfuns = True } "nogensems" -> o { semfuns = False } "gentypesigs" -> o { typeSigs = True } "nogentypesigs"-> o { typeSigs = False } "nocycle" -> o { withCycle = False, loag = False } "cycle" -> o { withCycle = True } "nostrictdata" -> o { strictData = False } "strictdata" -> o { strictData = True } "nostrictcase" -> o { strictCases = False } "strictcase" -> o { strictCases = True } "strictercase" -> o { strictCases = True, stricterCases = True } "nostrictwrap" -> o { strictWrap = False } "strictwrap" -> o { strictWrap = True } "novisit" -> o { visit = False, loag = False } "visit" -> o { visit = True } "nocase" -> o { cases = False } "case" -> o { cases = True } "noseq" -> o { withSeq = False } "seq" -> o { withSeq = True } "nounbox" -> o { unbox = False } "unbox" -> o { unbox = True } "bangpats" -> o { bangpats = True } "breadthfirst" -> o { breadthFirst = True } "breadthfirstStrict" -> o { breadthFirstStrict = True } "nooptimize" -> o { cases = False , visit = False } "optimize" -> o { cases = True , visit = True } "strictsem" -> o { strictSems = True } "gentraces" -> o { genTraces = True } "genusetraces" -> o { genUseTraces = True } "splitsems" -> o { splitSems = True } "gencostcentres" -> o { genCostCentres = True } "sepsemmods" -> sepSemModsOpt o "genlinepragmas" -> o { genLinePragmas = True } "newtypes" -> o { newtypes = True } "nonewtypes" -> o { newtypes = False } "nooptimizations" -> o { noOptimizations = True } "kennedywarren" -> o { kennedyWarren = True } "aspectag" -> o { genAspectAG = True } 'n':'o':'g':'r':'o':'u':'p':'_':atts -> o { noGroup = extract atts ++ noGroup o } "rename" -> o { rename = True } "parallel" -> o { parallelInvoke = True } "monadicwrappers" -> o { monadicWrappers = True } "dummytokenvisit" -> o { dummyTokenVisit = True } "tupleasdummytoken" -> o { tupleAsDummyToken = True } "stateasdummytoken" -> o { tupleAsDummyToken = False } "strictdummytoken" -> o { strictDummyToken = True } "noperruletypesigs" -> o { noPerRuleTypeSigs = True } "noperstatetypesigs" -> o { noPerStateTypeSigs = True } "noeagerblackholing" -> o { noEagerBlackholing = True } "noperrulecostcentres" -> o { noPerRuleCostCentres = True } "nopervisitcostcentres" -> o { noPerVisitCostCentres = True } "helpinlining" -> o { helpInlining = True } "noinlinepragmas" -> o { noInlinePragmas = True } "aggressiveinlinepragmas" -> o { aggressiveInlinePragmas = True } "latehigherorderbindings" -> o { lateHigherOrderBinding = True } "ocaml" -> ocamlOpt o "cleanlang" -> cleanOpt o s -> trace ("uuagc: ignoring unknown pragma: " ++ s) o in \o -> foldr mk o names_ {-# LINE 3593 "dist/build/Transform.hs"#-} {-# INLINE rule434 #-} rule434 = \ (_ :: ()) -> Map.empty {-# INLINE rule435 #-} rule435 = \ (_ :: ()) -> Map.empty {-# INLINE rule436 #-} rule436 = \ (_ :: ()) -> [] {-# INLINE rule437 #-} rule437 = \ (_ :: ()) -> [] {-# INLINE rule438 #-} rule438 = \ (_ :: ()) -> [] {-# INLINE rule439 #-} rule439 = \ (_ :: ()) -> [] {-# INLINE rule440 #-} rule440 = \ (_ :: ()) -> Map.empty {-# INLINE rule441 #-} rule441 = \ (_ :: ()) -> [] {-# INLINE rule442 #-} rule442 = \ (_ :: ()) -> [] {-# INLINE rule443 #-} rule443 = \ (_ :: ()) -> [] {-# INLINE rule444 #-} rule444 = \ (_ :: ()) -> [] {-# INLINE rule445 #-} rule445 = \ (_ :: ()) -> Set.empty {-# INLINE rule446 #-} rule446 = \ (_ :: ()) -> [] {-# INLINE rule447 #-} rule447 = \ (_ :: ()) -> Set.empty {-# INLINE rule448 #-} rule448 = \ (_ :: ()) -> [] {-# INLINE rule449 #-} rule449 = \ (_ :: ()) -> [] {-# INLINE rule450 #-} rule450 = \ (_ :: ()) -> Map.empty {-# INLINE rule451 #-} rule451 = \ (_ :: ()) -> Map.empty {-# INLINE rule452 #-} rule452 = \ (_ :: ()) -> Map.empty {-# INLINE rule453 #-} rule453 = \ (_ :: ()) -> Seq.empty {-# INLINE rule454 #-} rule454 = \ (_ :: ()) -> mzero {-# INLINE rule455 #-} rule455 = \ (_ :: ()) -> Map.empty {-# INLINE rule456 #-} rule456 = \ (_ :: ()) -> Map.empty {-# INLINE rule457 #-} rule457 = \ (_ :: ()) -> Map.empty {-# INLINE rule458 #-} rule458 = \ (_ :: ()) -> [] {-# INLINE rule459 #-} rule459 = \ (_ :: ()) -> Map.empty {-# INLINE rule460 #-} rule460 = \ (_ :: ()) -> Set.empty {-# INLINE rule461 #-} rule461 = \ ((_lhsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrDecls {-# INLINE rule462 #-} rule462 = \ ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrs {-# INLINE rule463 #-} rule463 = \ ((_lhsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> _lhsIdefSets {-# NOINLINE sem_Elem_Module #-} sem_Elem_Module :: (Pos) -> (String) -> (String) -> (String) -> T_Elem sem_Elem_Module _ arg_name_ arg_exports_ arg_imports_ = T_Elem (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Elem_v16 v16 = \ (T_Elem_vIn16 _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) -> ( let _lhsOmoduleDecl :: Maybe (String,String,String) _lhsOmoduleDecl = rule464 arg_exports_ arg_imports_ arg_name_ _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule465 () _lhsOblocks :: Blocks _lhsOblocks = rule466 () _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule467 () _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule468 () _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule469 () _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule470 () _lhsOcollectedConstructorsMap :: Map NontermIdent (Set ConstructorIdent) _lhsOcollectedConstructorsMap = rule471 () _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule472 () _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule473 () _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule474 () _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule475 () _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule476 () _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule477 () _lhsOcollectedSetNames :: Set Identifier _lhsOcollectedSetNames = rule478 () _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule479 () _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule480 () _lhsOconstructorTypeMap :: Map NontermIdent ConstructorType _lhsOconstructorTypeMap = rule481 () _lhsOctxCollect :: ContextMap _lhsOctxCollect = rule482 () _lhsOderivings :: Derivings _lhsOderivings = rule483 () _lhsOerrors :: Seq Error _lhsOerrors = rule484 () _lhsOparamsCollect :: ParamMap _lhsOparamsCollect = rule485 () _lhsOpragmas :: Options -> Options _lhsOpragmas = rule486 () _lhsOquantCollect :: QuantMap _lhsOquantCollect = rule487 () _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule488 () _lhsOtypeSyns :: TypeSyns _lhsOtypeSyns = rule489 () _lhsOuseMap :: Map NontermIdent (Map Identifier (String,String,String)) _lhsOuseMap = rule490 () _lhsOwrappers :: Set NontermIdent _lhsOwrappers = rule491 () _lhsOattrDecls :: Map NontermIdent (Attributes, Attributes) _lhsOattrDecls = rule492 _lhsIattrDecls _lhsOattrs :: Map NontermIdent (Attributes, Attributes) _lhsOattrs = rule493 _lhsIattrs _lhsOdefSets :: Map Identifier (Set NontermIdent,Set Identifier) _lhsOdefSets = rule494 _lhsIdefSets __result_ = T_Elem_vOut16 _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers in __result_ ) in C_Elem_s17 v16 {-# INLINE rule464 #-} {-# LINE 1214 "src-ag/Transform.ag" #-} rule464 = \ exports_ imports_ name_ -> {-# LINE 1214 "src-ag/Transform.ag" #-} Just (name_, exports_, imports_) {-# LINE 3761 "dist/build/Transform.hs"#-} {-# INLINE rule465 #-} rule465 = \ (_ :: ()) -> Map.empty {-# INLINE rule466 #-} rule466 = \ (_ :: ()) -> Map.empty {-# INLINE rule467 #-} rule467 = \ (_ :: ()) -> [] {-# INLINE rule468 #-} rule468 = \ (_ :: ()) -> [] {-# INLINE rule469 #-} rule469 = \ (_ :: ()) -> [] {-# INLINE rule470 #-} rule470 = \ (_ :: ()) -> [] {-# INLINE rule471 #-} rule471 = \ (_ :: ()) -> Map.empty {-# INLINE rule472 #-} rule472 = \ (_ :: ()) -> [] {-# INLINE rule473 #-} rule473 = \ (_ :: ()) -> [] {-# INLINE rule474 #-} rule474 = \ (_ :: ()) -> [] {-# INLINE rule475 #-} rule475 = \ (_ :: ()) -> [] {-# INLINE rule476 #-} rule476 = \ (_ :: ()) -> Set.empty {-# INLINE rule477 #-} rule477 = \ (_ :: ()) -> [] {-# INLINE rule478 #-} rule478 = \ (_ :: ()) -> Set.empty {-# INLINE rule479 #-} rule479 = \ (_ :: ()) -> [] {-# INLINE rule480 #-} rule480 = \ (_ :: ()) -> [] {-# INLINE rule481 #-} rule481 = \ (_ :: ()) -> Map.empty {-# INLINE rule482 #-} rule482 = \ (_ :: ()) -> Map.empty {-# INLINE rule483 #-} rule483 = \ (_ :: ()) -> Map.empty {-# INLINE rule484 #-} rule484 = \ (_ :: ()) -> Seq.empty {-# INLINE rule485 #-} rule485 = \ (_ :: ()) -> Map.empty {-# INLINE rule486 #-} rule486 = \ (_ :: ()) -> id {-# INLINE rule487 #-} rule487 = \ (_ :: ()) -> Map.empty {-# INLINE rule488 #-} rule488 = \ (_ :: ()) -> Map.empty {-# INLINE rule489 #-} rule489 = \ (_ :: ()) -> [] {-# INLINE rule490 #-} rule490 = \ (_ :: ()) -> Map.empty {-# INLINE rule491 #-} rule491 = \ (_ :: ()) -> Set.empty {-# INLINE rule492 #-} rule492 = \ ((_lhsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrDecls {-# INLINE rule493 #-} rule493 = \ ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrs {-# INLINE rule494 #-} rule494 = \ ((_lhsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> _lhsIdefSets -- Elems ------------------------------------------------------- -- wrapper data Inh_Elems = Inh_Elems { allAttrDecls_Inh_Elems :: (Map NontermIdent (Attributes, Attributes)), allAttrs_Inh_Elems :: (Map NontermIdent (Attributes, Attributes)), allConstructors_Inh_Elems :: (Map NontermIdent (Set ConstructorIdent)), allFields_Inh_Elems :: (DataTypes), allNonterminals_Inh_Elems :: (Set NontermIdent), attrDecls_Inh_Elems :: (Map NontermIdent (Attributes, Attributes)), attrs_Inh_Elems :: (Map NontermIdent (Attributes, Attributes)), defSets_Inh_Elems :: (Map Identifier (Set NontermIdent,Set Identifier)), definedSets_Inh_Elems :: (DefinedSets), options_Inh_Elems :: (Options) } data Syn_Elems = Syn_Elems { attrDecls_Syn_Elems :: (Map NontermIdent (Attributes, Attributes)), attrOrderCollect_Syn_Elems :: (AttrOrderMap), attrs_Syn_Elems :: (Map NontermIdent (Attributes, Attributes)), blocks_Syn_Elems :: (Blocks), collectedArounds_Syn_Elems :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]), collectedAugments_Syn_Elems :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]), collectedConParams_Syn_Elems :: ([(NontermIdent, ConstructorIdent, Set Identifier)]), collectedConstraints_Syn_Elems :: ([(NontermIdent, ConstructorIdent, [Type])]), collectedConstructorsMap_Syn_Elems :: (Map NontermIdent (Set ConstructorIdent)), collectedFields_Syn_Elems :: ([(NontermIdent, ConstructorIdent, FieldMap)]), collectedInsts_Syn_Elems :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]), collectedMacros_Syn_Elems :: ([(NontermIdent, ConstructorIdent, MaybeMacro)]), collectedMerges_Syn_Elems :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]), collectedNames_Syn_Elems :: (Set Identifier), collectedRules_Syn_Elems :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]), collectedSetNames_Syn_Elems :: (Set Identifier), collectedSigs_Syn_Elems :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]), collectedUniques_Syn_Elems :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]), constructorTypeMap_Syn_Elems :: (Map NontermIdent ConstructorType), ctxCollect_Syn_Elems :: (ContextMap), defSets_Syn_Elems :: (Map Identifier (Set NontermIdent,Set Identifier)), derivings_Syn_Elems :: (Derivings), errors_Syn_Elems :: (Seq Error), moduleDecl_Syn_Elems :: (Maybe (String,String,String)), paramsCollect_Syn_Elems :: (ParamMap), pragmas_Syn_Elems :: (Options -> Options), quantCollect_Syn_Elems :: (QuantMap), semPragmasCollect_Syn_Elems :: (PragmaMap), typeSyns_Syn_Elems :: (TypeSyns), useMap_Syn_Elems :: (Map NontermIdent (Map Identifier (String,String,String))), wrappers_Syn_Elems :: (Set NontermIdent) } {-# INLINABLE wrap_Elems #-} wrap_Elems :: T_Elems -> Inh_Elems -> (Syn_Elems ) wrap_Elems (T_Elems act) (Inh_Elems _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg19 = T_Elems_vIn19 _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions (T_Elems_vOut19 _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers) <- return (inv_Elems_s20 sem arg19) return (Syn_Elems _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers) ) -- cata {-# NOINLINE sem_Elems #-} sem_Elems :: Elems -> T_Elems sem_Elems list = Prelude.foldr sem_Elems_Cons sem_Elems_Nil (Prelude.map sem_Elem list) -- semantic domain newtype T_Elems = T_Elems { attach_T_Elems :: Identity (T_Elems_s20 ) } newtype T_Elems_s20 = C_Elems_s20 { inv_Elems_s20 :: (T_Elems_v19 ) } data T_Elems_s21 = C_Elems_s21 type T_Elems_v19 = (T_Elems_vIn19 ) -> (T_Elems_vOut19 ) data T_Elems_vIn19 = T_Elems_vIn19 (Map NontermIdent (Attributes, Attributes)) (Map NontermIdent (Attributes, Attributes)) (Map NontermIdent (Set ConstructorIdent)) (DataTypes) (Set NontermIdent) (Map NontermIdent (Attributes, Attributes)) (Map NontermIdent (Attributes, Attributes)) (Map Identifier (Set NontermIdent,Set Identifier)) (DefinedSets) (Options) data T_Elems_vOut19 = T_Elems_vOut19 (Map NontermIdent (Attributes, Attributes)) (AttrOrderMap) (Map NontermIdent (Attributes, Attributes)) (Blocks) ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) ([(NontermIdent, ConstructorIdent, Set Identifier)]) ([(NontermIdent, ConstructorIdent, [Type])]) (Map NontermIdent (Set ConstructorIdent)) ([(NontermIdent, ConstructorIdent, FieldMap)]) ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) ([(NontermIdent, ConstructorIdent, MaybeMacro)]) ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) (Set Identifier) ([ (NontermIdent, ConstructorIdent, RuleInfo)]) (Set Identifier) ([ (NontermIdent, ConstructorIdent, SigInfo) ]) ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) (Map NontermIdent ConstructorType) (ContextMap) (Map Identifier (Set NontermIdent,Set Identifier)) (Derivings) (Seq Error) (Maybe (String,String,String)) (ParamMap) (Options -> Options) (QuantMap) (PragmaMap) (TypeSyns) (Map NontermIdent (Map Identifier (String,String,String))) (Set NontermIdent) {-# NOINLINE sem_Elems_Cons #-} sem_Elems_Cons :: T_Elem -> T_Elems -> T_Elems sem_Elems_Cons arg_hd_ arg_tl_ = T_Elems (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Elems_v19 v19 = \ (T_Elems_vIn19 _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) -> ( let _hdX17 = Control.Monad.Identity.runIdentity (attach_T_Elem (arg_hd_)) _tlX20 = Control.Monad.Identity.runIdentity (attach_T_Elems (arg_tl_)) (T_Elem_vOut16 _hdIattrDecls _hdIattrOrderCollect _hdIattrs _hdIblocks _hdIcollectedArounds _hdIcollectedAugments _hdIcollectedConParams _hdIcollectedConstraints _hdIcollectedConstructorsMap _hdIcollectedFields _hdIcollectedInsts _hdIcollectedMacros _hdIcollectedMerges _hdIcollectedNames _hdIcollectedRules _hdIcollectedSetNames _hdIcollectedSigs _hdIcollectedUniques _hdIconstructorTypeMap _hdIctxCollect _hdIdefSets _hdIderivings _hdIerrors _hdImoduleDecl _hdIparamsCollect _hdIpragmas _hdIquantCollect _hdIsemPragmasCollect _hdItypeSyns _hdIuseMap _hdIwrappers) = inv_Elem_s17 _hdX17 (T_Elem_vIn16 _hdOallAttrDecls _hdOallAttrs _hdOallConstructors _hdOallFields _hdOallNonterminals _hdOattrDecls _hdOattrs _hdOdefSets _hdOdefinedSets _hdOoptions) (T_Elems_vOut19 _tlIattrDecls _tlIattrOrderCollect _tlIattrs _tlIblocks _tlIcollectedArounds _tlIcollectedAugments _tlIcollectedConParams _tlIcollectedConstraints _tlIcollectedConstructorsMap _tlIcollectedFields _tlIcollectedInsts _tlIcollectedMacros _tlIcollectedMerges _tlIcollectedNames _tlIcollectedRules _tlIcollectedSetNames _tlIcollectedSigs _tlIcollectedUniques _tlIconstructorTypeMap _tlIctxCollect _tlIdefSets _tlIderivings _tlIerrors _tlImoduleDecl _tlIparamsCollect _tlIpragmas _tlIquantCollect _tlIsemPragmasCollect _tlItypeSyns _tlIuseMap _tlIwrappers) = inv_Elems_s20 _tlX20 (T_Elems_vIn19 _tlOallAttrDecls _tlOallAttrs _tlOallConstructors _tlOallFields _tlOallNonterminals _tlOattrDecls _tlOattrs _tlOdefSets _tlOdefinedSets _tlOoptions) _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule495 _hdIattrOrderCollect _tlIattrOrderCollect _lhsOblocks :: Blocks _lhsOblocks = rule496 _hdIblocks _tlIblocks _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule497 _hdIcollectedArounds _tlIcollectedArounds _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule498 _hdIcollectedAugments _tlIcollectedAugments _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule499 _hdIcollectedConParams _tlIcollectedConParams _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule500 _hdIcollectedConstraints _tlIcollectedConstraints _lhsOcollectedConstructorsMap :: Map NontermIdent (Set ConstructorIdent) _lhsOcollectedConstructorsMap = rule501 _hdIcollectedConstructorsMap _tlIcollectedConstructorsMap _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule502 _hdIcollectedFields _tlIcollectedFields _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule503 _hdIcollectedInsts _tlIcollectedInsts _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule504 _hdIcollectedMacros _tlIcollectedMacros _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule505 _hdIcollectedMerges _tlIcollectedMerges _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule506 _hdIcollectedNames _tlIcollectedNames _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule507 _hdIcollectedRules _tlIcollectedRules _lhsOcollectedSetNames :: Set Identifier _lhsOcollectedSetNames = rule508 _hdIcollectedSetNames _tlIcollectedSetNames _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule509 _hdIcollectedSigs _tlIcollectedSigs _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule510 _hdIcollectedUniques _tlIcollectedUniques _lhsOconstructorTypeMap :: Map NontermIdent ConstructorType _lhsOconstructorTypeMap = rule511 _hdIconstructorTypeMap _tlIconstructorTypeMap _lhsOctxCollect :: ContextMap _lhsOctxCollect = rule512 _hdIctxCollect _tlIctxCollect _lhsOderivings :: Derivings _lhsOderivings = rule513 _hdIderivings _tlIderivings _lhsOerrors :: Seq Error _lhsOerrors = rule514 _hdIerrors _tlIerrors _lhsOmoduleDecl :: Maybe (String,String,String) _lhsOmoduleDecl = rule515 _hdImoduleDecl _tlImoduleDecl _lhsOparamsCollect :: ParamMap _lhsOparamsCollect = rule516 _hdIparamsCollect _tlIparamsCollect _lhsOpragmas :: Options -> Options _lhsOpragmas = rule517 _hdIpragmas _tlIpragmas _lhsOquantCollect :: QuantMap _lhsOquantCollect = rule518 _hdIquantCollect _tlIquantCollect _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule519 _hdIsemPragmasCollect _tlIsemPragmasCollect _lhsOtypeSyns :: TypeSyns _lhsOtypeSyns = rule520 _hdItypeSyns _tlItypeSyns _lhsOuseMap :: Map NontermIdent (Map Identifier (String,String,String)) _lhsOuseMap = rule521 _hdIuseMap _tlIuseMap _lhsOwrappers :: Set NontermIdent _lhsOwrappers = rule522 _hdIwrappers _tlIwrappers _lhsOattrDecls :: Map NontermIdent (Attributes, Attributes) _lhsOattrDecls = rule523 _tlIattrDecls _lhsOattrs :: Map NontermIdent (Attributes, Attributes) _lhsOattrs = rule524 _tlIattrs _lhsOdefSets :: Map Identifier (Set NontermIdent,Set Identifier) _lhsOdefSets = rule525 _tlIdefSets _hdOallAttrDecls = rule526 _lhsIallAttrDecls _hdOallAttrs = rule527 _lhsIallAttrs _hdOallConstructors = rule528 _lhsIallConstructors _hdOallFields = rule529 _lhsIallFields _hdOallNonterminals = rule530 _lhsIallNonterminals _hdOattrDecls = rule531 _lhsIattrDecls _hdOattrs = rule532 _lhsIattrs _hdOdefSets = rule533 _lhsIdefSets _hdOdefinedSets = rule534 _lhsIdefinedSets _hdOoptions = rule535 _lhsIoptions _tlOallAttrDecls = rule536 _lhsIallAttrDecls _tlOallAttrs = rule537 _lhsIallAttrs _tlOallConstructors = rule538 _lhsIallConstructors _tlOallFields = rule539 _lhsIallFields _tlOallNonterminals = rule540 _lhsIallNonterminals _tlOattrDecls = rule541 _hdIattrDecls _tlOattrs = rule542 _hdIattrs _tlOdefSets = rule543 _hdIdefSets _tlOdefinedSets = rule544 _lhsIdefinedSets _tlOoptions = rule545 _lhsIoptions __result_ = T_Elems_vOut19 _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers in __result_ ) in C_Elems_s20 v19 {-# INLINE rule495 #-} rule495 = \ ((_hdIattrOrderCollect) :: AttrOrderMap) ((_tlIattrOrderCollect) :: AttrOrderMap) -> _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect {-# INLINE rule496 #-} rule496 = \ ((_hdIblocks) :: Blocks) ((_tlIblocks) :: Blocks) -> _hdIblocks `mapUnionWithPlusPlus` _tlIblocks {-# INLINE rule497 #-} rule497 = \ ((_hdIcollectedArounds) :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) ((_tlIcollectedArounds) :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) -> _hdIcollectedArounds ++ _tlIcollectedArounds {-# INLINE rule498 #-} rule498 = \ ((_hdIcollectedAugments) :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) ((_tlIcollectedAugments) :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) -> _hdIcollectedAugments ++ _tlIcollectedAugments {-# INLINE rule499 #-} rule499 = \ ((_hdIcollectedConParams) :: [(NontermIdent, ConstructorIdent, Set Identifier)]) ((_tlIcollectedConParams) :: [(NontermIdent, ConstructorIdent, Set Identifier)]) -> _hdIcollectedConParams ++ _tlIcollectedConParams {-# INLINE rule500 #-} rule500 = \ ((_hdIcollectedConstraints) :: [(NontermIdent, ConstructorIdent, [Type])]) ((_tlIcollectedConstraints) :: [(NontermIdent, ConstructorIdent, [Type])]) -> _hdIcollectedConstraints ++ _tlIcollectedConstraints {-# INLINE rule501 #-} rule501 = \ ((_hdIcollectedConstructorsMap) :: Map NontermIdent (Set ConstructorIdent)) ((_tlIcollectedConstructorsMap) :: Map NontermIdent (Set ConstructorIdent)) -> _hdIcollectedConstructorsMap `mapUnionWithSetUnion` _tlIcollectedConstructorsMap {-# INLINE rule502 #-} rule502 = \ ((_hdIcollectedFields) :: [(NontermIdent, ConstructorIdent, FieldMap)]) ((_tlIcollectedFields) :: [(NontermIdent, ConstructorIdent, FieldMap)]) -> _hdIcollectedFields ++ _tlIcollectedFields {-# INLINE rule503 #-} rule503 = \ ((_hdIcollectedInsts) :: [ (NontermIdent, ConstructorIdent, [Identifier]) ]) ((_tlIcollectedInsts) :: [ (NontermIdent, ConstructorIdent, [Identifier]) ]) -> _hdIcollectedInsts ++ _tlIcollectedInsts {-# INLINE rule504 #-} rule504 = \ ((_hdIcollectedMacros) :: [(NontermIdent, ConstructorIdent, MaybeMacro)]) ((_tlIcollectedMacros) :: [(NontermIdent, ConstructorIdent, MaybeMacro)]) -> _hdIcollectedMacros ++ _tlIcollectedMacros {-# INLINE rule505 #-} rule505 = \ ((_hdIcollectedMerges) :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) ((_tlIcollectedMerges) :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) -> _hdIcollectedMerges ++ _tlIcollectedMerges {-# INLINE rule506 #-} rule506 = \ ((_hdIcollectedNames) :: Set Identifier) ((_tlIcollectedNames) :: Set Identifier) -> _hdIcollectedNames `Set.union` _tlIcollectedNames {-# INLINE rule507 #-} rule507 = \ ((_hdIcollectedRules) :: [ (NontermIdent, ConstructorIdent, RuleInfo)]) ((_tlIcollectedRules) :: [ (NontermIdent, ConstructorIdent, RuleInfo)]) -> _hdIcollectedRules ++ _tlIcollectedRules {-# INLINE rule508 #-} rule508 = \ ((_hdIcollectedSetNames) :: Set Identifier) ((_tlIcollectedSetNames) :: Set Identifier) -> _hdIcollectedSetNames `Set.union` _tlIcollectedSetNames {-# INLINE rule509 #-} rule509 = \ ((_hdIcollectedSigs) :: [ (NontermIdent, ConstructorIdent, SigInfo) ]) ((_tlIcollectedSigs) :: [ (NontermIdent, ConstructorIdent, SigInfo) ]) -> _hdIcollectedSigs ++ _tlIcollectedSigs {-# INLINE rule510 #-} rule510 = \ ((_hdIcollectedUniques) :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) ((_tlIcollectedUniques) :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) -> _hdIcollectedUniques ++ _tlIcollectedUniques {-# INLINE rule511 #-} rule511 = \ ((_hdIconstructorTypeMap) :: Map NontermIdent ConstructorType) ((_tlIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _hdIconstructorTypeMap `Map.union` _tlIconstructorTypeMap {-# INLINE rule512 #-} rule512 = \ ((_hdIctxCollect) :: ContextMap) ((_tlIctxCollect) :: ContextMap) -> _hdIctxCollect `mergeCtx` _tlIctxCollect {-# INLINE rule513 #-} rule513 = \ ((_hdIderivings) :: Derivings) ((_tlIderivings) :: Derivings) -> _hdIderivings `mergeDerivings` _tlIderivings {-# INLINE rule514 #-} rule514 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule515 #-} rule515 = \ ((_hdImoduleDecl) :: Maybe (String,String,String)) ((_tlImoduleDecl) :: Maybe (String,String,String)) -> _hdImoduleDecl `flipmplus` _tlImoduleDecl {-# INLINE rule516 #-} rule516 = \ ((_hdIparamsCollect) :: ParamMap) ((_tlIparamsCollect) :: ParamMap) -> _hdIparamsCollect `mergeParams` _tlIparamsCollect {-# INLINE rule517 #-} rule517 = \ ((_hdIpragmas) :: Options -> Options) ((_tlIpragmas) :: Options -> Options) -> _hdIpragmas . _tlIpragmas {-# INLINE rule518 #-} rule518 = \ ((_hdIquantCollect) :: QuantMap) ((_tlIquantCollect) :: QuantMap) -> _hdIquantCollect `mergeQuant` _tlIquantCollect {-# INLINE rule519 #-} rule519 = \ ((_hdIsemPragmasCollect) :: PragmaMap) ((_tlIsemPragmasCollect) :: PragmaMap) -> _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect {-# INLINE rule520 #-} rule520 = \ ((_hdItypeSyns) :: TypeSyns) ((_tlItypeSyns) :: TypeSyns) -> _hdItypeSyns ++ _tlItypeSyns {-# INLINE rule521 #-} rule521 = \ ((_hdIuseMap) :: Map NontermIdent (Map Identifier (String,String,String))) ((_tlIuseMap) :: Map NontermIdent (Map Identifier (String,String,String))) -> _hdIuseMap `merge` _tlIuseMap {-# INLINE rule522 #-} rule522 = \ ((_hdIwrappers) :: Set NontermIdent) ((_tlIwrappers) :: Set NontermIdent) -> _hdIwrappers `Set.union` _tlIwrappers {-# INLINE rule523 #-} rule523 = \ ((_tlIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _tlIattrDecls {-# INLINE rule524 #-} rule524 = \ ((_tlIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _tlIattrs {-# INLINE rule525 #-} rule525 = \ ((_tlIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> _tlIdefSets {-# INLINE rule526 #-} rule526 = \ ((_lhsIallAttrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIallAttrDecls {-# INLINE rule527 #-} rule527 = \ ((_lhsIallAttrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIallAttrs {-# INLINE rule528 #-} rule528 = \ ((_lhsIallConstructors) :: Map NontermIdent (Set ConstructorIdent)) -> _lhsIallConstructors {-# INLINE rule529 #-} rule529 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule530 #-} rule530 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule531 #-} rule531 = \ ((_lhsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrDecls {-# INLINE rule532 #-} rule532 = \ ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrs {-# INLINE rule533 #-} rule533 = \ ((_lhsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> _lhsIdefSets {-# INLINE rule534 #-} rule534 = \ ((_lhsIdefinedSets) :: DefinedSets) -> _lhsIdefinedSets {-# INLINE rule535 #-} rule535 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule536 #-} rule536 = \ ((_lhsIallAttrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIallAttrDecls {-# INLINE rule537 #-} rule537 = \ ((_lhsIallAttrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIallAttrs {-# INLINE rule538 #-} rule538 = \ ((_lhsIallConstructors) :: Map NontermIdent (Set ConstructorIdent)) -> _lhsIallConstructors {-# INLINE rule539 #-} rule539 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule540 #-} rule540 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule541 #-} rule541 = \ ((_hdIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _hdIattrDecls {-# INLINE rule542 #-} rule542 = \ ((_hdIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _hdIattrs {-# INLINE rule543 #-} rule543 = \ ((_hdIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> _hdIdefSets {-# INLINE rule544 #-} rule544 = \ ((_lhsIdefinedSets) :: DefinedSets) -> _lhsIdefinedSets {-# INLINE rule545 #-} rule545 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Elems_Nil #-} sem_Elems_Nil :: T_Elems sem_Elems_Nil = T_Elems (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Elems_v19 v19 = \ (T_Elems_vIn19 _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) -> ( let _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule546 () _lhsOblocks :: Blocks _lhsOblocks = rule547 () _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule548 () _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule549 () _lhsOcollectedConParams :: [(NontermIdent, ConstructorIdent, Set Identifier)] _lhsOcollectedConParams = rule550 () _lhsOcollectedConstraints :: [(NontermIdent, ConstructorIdent, [Type])] _lhsOcollectedConstraints = rule551 () _lhsOcollectedConstructorsMap :: Map NontermIdent (Set ConstructorIdent) _lhsOcollectedConstructorsMap = rule552 () _lhsOcollectedFields :: [(NontermIdent, ConstructorIdent, FieldMap)] _lhsOcollectedFields = rule553 () _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule554 () _lhsOcollectedMacros :: [(NontermIdent, ConstructorIdent, MaybeMacro)] _lhsOcollectedMacros = rule555 () _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule556 () _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule557 () _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule558 () _lhsOcollectedSetNames :: Set Identifier _lhsOcollectedSetNames = rule559 () _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule560 () _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule561 () _lhsOconstructorTypeMap :: Map NontermIdent ConstructorType _lhsOconstructorTypeMap = rule562 () _lhsOctxCollect :: ContextMap _lhsOctxCollect = rule563 () _lhsOderivings :: Derivings _lhsOderivings = rule564 () _lhsOerrors :: Seq Error _lhsOerrors = rule565 () _lhsOmoduleDecl :: Maybe (String,String,String) _lhsOmoduleDecl = rule566 () _lhsOparamsCollect :: ParamMap _lhsOparamsCollect = rule567 () _lhsOpragmas :: Options -> Options _lhsOpragmas = rule568 () _lhsOquantCollect :: QuantMap _lhsOquantCollect = rule569 () _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule570 () _lhsOtypeSyns :: TypeSyns _lhsOtypeSyns = rule571 () _lhsOuseMap :: Map NontermIdent (Map Identifier (String,String,String)) _lhsOuseMap = rule572 () _lhsOwrappers :: Set NontermIdent _lhsOwrappers = rule573 () _lhsOattrDecls :: Map NontermIdent (Attributes, Attributes) _lhsOattrDecls = rule574 _lhsIattrDecls _lhsOattrs :: Map NontermIdent (Attributes, Attributes) _lhsOattrs = rule575 _lhsIattrs _lhsOdefSets :: Map Identifier (Set NontermIdent,Set Identifier) _lhsOdefSets = rule576 _lhsIdefSets __result_ = T_Elems_vOut19 _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOconstructorTypeMap _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers in __result_ ) in C_Elems_s20 v19 {-# INLINE rule546 #-} rule546 = \ (_ :: ()) -> Map.empty {-# INLINE rule547 #-} rule547 = \ (_ :: ()) -> Map.empty {-# INLINE rule548 #-} rule548 = \ (_ :: ()) -> [] {-# INLINE rule549 #-} rule549 = \ (_ :: ()) -> [] {-# INLINE rule550 #-} rule550 = \ (_ :: ()) -> [] {-# INLINE rule551 #-} rule551 = \ (_ :: ()) -> [] {-# INLINE rule552 #-} rule552 = \ (_ :: ()) -> Map.empty {-# INLINE rule553 #-} rule553 = \ (_ :: ()) -> [] {-# INLINE rule554 #-} rule554 = \ (_ :: ()) -> [] {-# INLINE rule555 #-} rule555 = \ (_ :: ()) -> [] {-# INLINE rule556 #-} rule556 = \ (_ :: ()) -> [] {-# INLINE rule557 #-} rule557 = \ (_ :: ()) -> Set.empty {-# INLINE rule558 #-} rule558 = \ (_ :: ()) -> [] {-# INLINE rule559 #-} rule559 = \ (_ :: ()) -> Set.empty {-# INLINE rule560 #-} rule560 = \ (_ :: ()) -> [] {-# INLINE rule561 #-} rule561 = \ (_ :: ()) -> [] {-# INLINE rule562 #-} rule562 = \ (_ :: ()) -> Map.empty {-# INLINE rule563 #-} rule563 = \ (_ :: ()) -> Map.empty {-# INLINE rule564 #-} rule564 = \ (_ :: ()) -> Map.empty {-# INLINE rule565 #-} rule565 = \ (_ :: ()) -> Seq.empty {-# INLINE rule566 #-} rule566 = \ (_ :: ()) -> mzero {-# INLINE rule567 #-} rule567 = \ (_ :: ()) -> Map.empty {-# INLINE rule568 #-} rule568 = \ (_ :: ()) -> id {-# INLINE rule569 #-} rule569 = \ (_ :: ()) -> Map.empty {-# INLINE rule570 #-} rule570 = \ (_ :: ()) -> Map.empty {-# INLINE rule571 #-} rule571 = \ (_ :: ()) -> [] {-# INLINE rule572 #-} rule572 = \ (_ :: ()) -> Map.empty {-# INLINE rule573 #-} rule573 = \ (_ :: ()) -> Set.empty {-# INLINE rule574 #-} rule574 = \ ((_lhsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrDecls {-# INLINE rule575 #-} rule575 = \ ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIattrs {-# INLINE rule576 #-} rule576 = \ ((_lhsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> _lhsIdefSets -- Field ------------------------------------------------------- -- wrapper data Inh_Field = Inh_Field { allNonterminals_Inh_Field :: (Set NontermIdent) } data Syn_Field = Syn_Field { collectedConstraints_Syn_Field :: ([Type]), collectedFields_Syn_Field :: ([(Identifier, Type)]) } {-# INLINABLE wrap_Field #-} wrap_Field :: T_Field -> Inh_Field -> (Syn_Field ) wrap_Field (T_Field act) (Inh_Field _lhsIallNonterminals) = Control.Monad.Identity.runIdentity ( do sem <- act let arg22 = T_Field_vIn22 _lhsIallNonterminals (T_Field_vOut22 _lhsOcollectedConstraints _lhsOcollectedFields) <- return (inv_Field_s23 sem arg22) return (Syn_Field _lhsOcollectedConstraints _lhsOcollectedFields) ) -- cata {-# NOINLINE sem_Field #-} sem_Field :: Field -> T_Field sem_Field ( FChild name_ tp_ ) = sem_Field_FChild name_ tp_ sem_Field ( FCtx tps_ ) = sem_Field_FCtx tps_ -- semantic domain newtype T_Field = T_Field { attach_T_Field :: Identity (T_Field_s23 ) } newtype T_Field_s23 = C_Field_s23 { inv_Field_s23 :: (T_Field_v22 ) } data T_Field_s24 = C_Field_s24 type T_Field_v22 = (T_Field_vIn22 ) -> (T_Field_vOut22 ) data T_Field_vIn22 = T_Field_vIn22 (Set NontermIdent) data T_Field_vOut22 = T_Field_vOut22 ([Type]) ([(Identifier, Type)]) {-# NOINLINE sem_Field_FChild #-} sem_Field_FChild :: (Identifier) -> (Type) -> T_Field sem_Field_FChild arg_name_ arg_tp_ = T_Field (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_Field_v22 v22 = \ (T_Field_vIn22 _lhsIallNonterminals) -> ( let _lhsOcollectedFields :: [(Identifier, Type)] _lhsOcollectedFields = rule577 _lhsIallNonterminals arg_name_ arg_tp_ _lhsOcollectedConstraints :: [Type] _lhsOcollectedConstraints = rule578 () __result_ = T_Field_vOut22 _lhsOcollectedConstraints _lhsOcollectedFields in __result_ ) in C_Field_s23 v22 {-# INLINE rule577 #-} {-# LINE 579 "src-ag/Transform.ag" #-} rule577 = \ ((_lhsIallNonterminals) :: Set NontermIdent) name_ tp_ -> {-# LINE 579 "src-ag/Transform.ag" #-} [(name_, makeType _lhsIallNonterminals tp_)] {-# LINE 4348 "dist/build/Transform.hs"#-} {-# INLINE rule578 #-} rule578 = \ (_ :: ()) -> [] {-# NOINLINE sem_Field_FCtx #-} sem_Field_FCtx :: ([Type]) -> T_Field sem_Field_FCtx arg_tps_ = T_Field (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_Field_v22 v22 = \ (T_Field_vIn22 _lhsIallNonterminals) -> ( let _lhsOcollectedConstraints :: [Type] _lhsOcollectedConstraints = rule579 arg_tps_ _lhsOcollectedFields :: [(Identifier, Type)] _lhsOcollectedFields = rule580 () __result_ = T_Field_vOut22 _lhsOcollectedConstraints _lhsOcollectedFields in __result_ ) in C_Field_s23 v22 {-# INLINE rule579 #-} {-# LINE 588 "src-ag/Transform.ag" #-} rule579 = \ tps_ -> {-# LINE 588 "src-ag/Transform.ag" #-} tps_ {-# LINE 4371 "dist/build/Transform.hs"#-} {-# INLINE rule580 #-} rule580 = \ (_ :: ()) -> [] -- Fields ------------------------------------------------------ -- wrapper data Inh_Fields = Inh_Fields { allNonterminals_Inh_Fields :: (Set NontermIdent) } data Syn_Fields = Syn_Fields { collectedConstraints_Syn_Fields :: ([Type]), collectedFields_Syn_Fields :: ([(Identifier, Type)]) } {-# INLINABLE wrap_Fields #-} wrap_Fields :: T_Fields -> Inh_Fields -> (Syn_Fields ) wrap_Fields (T_Fields act) (Inh_Fields _lhsIallNonterminals) = Control.Monad.Identity.runIdentity ( do sem <- act let arg25 = T_Fields_vIn25 _lhsIallNonterminals (T_Fields_vOut25 _lhsOcollectedConstraints _lhsOcollectedFields) <- return (inv_Fields_s26 sem arg25) return (Syn_Fields _lhsOcollectedConstraints _lhsOcollectedFields) ) -- cata {-# NOINLINE sem_Fields #-} sem_Fields :: Fields -> T_Fields sem_Fields list = Prelude.foldr sem_Fields_Cons sem_Fields_Nil (Prelude.map sem_Field list) -- semantic domain newtype T_Fields = T_Fields { attach_T_Fields :: Identity (T_Fields_s26 ) } newtype T_Fields_s26 = C_Fields_s26 { inv_Fields_s26 :: (T_Fields_v25 ) } data T_Fields_s27 = C_Fields_s27 type T_Fields_v25 = (T_Fields_vIn25 ) -> (T_Fields_vOut25 ) data T_Fields_vIn25 = T_Fields_vIn25 (Set NontermIdent) data T_Fields_vOut25 = T_Fields_vOut25 ([Type]) ([(Identifier, Type)]) {-# NOINLINE sem_Fields_Cons #-} sem_Fields_Cons :: T_Field -> T_Fields -> T_Fields sem_Fields_Cons arg_hd_ arg_tl_ = T_Fields (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_Fields_v25 v25 = \ (T_Fields_vIn25 _lhsIallNonterminals) -> ( let _hdX23 = Control.Monad.Identity.runIdentity (attach_T_Field (arg_hd_)) _tlX26 = Control.Monad.Identity.runIdentity (attach_T_Fields (arg_tl_)) (T_Field_vOut22 _hdIcollectedConstraints _hdIcollectedFields) = inv_Field_s23 _hdX23 (T_Field_vIn22 _hdOallNonterminals) (T_Fields_vOut25 _tlIcollectedConstraints _tlIcollectedFields) = inv_Fields_s26 _tlX26 (T_Fields_vIn25 _tlOallNonterminals) _lhsOcollectedConstraints :: [Type] _lhsOcollectedConstraints = rule581 _hdIcollectedConstraints _tlIcollectedConstraints _lhsOcollectedFields :: [(Identifier, Type)] _lhsOcollectedFields = rule582 _hdIcollectedFields _tlIcollectedFields _hdOallNonterminals = rule583 _lhsIallNonterminals _tlOallNonterminals = rule584 _lhsIallNonterminals __result_ = T_Fields_vOut25 _lhsOcollectedConstraints _lhsOcollectedFields in __result_ ) in C_Fields_s26 v25 {-# INLINE rule581 #-} rule581 = \ ((_hdIcollectedConstraints) :: [Type]) ((_tlIcollectedConstraints) :: [Type]) -> _hdIcollectedConstraints ++ _tlIcollectedConstraints {-# INLINE rule582 #-} rule582 = \ ((_hdIcollectedFields) :: [(Identifier, Type)]) ((_tlIcollectedFields) :: [(Identifier, Type)]) -> _hdIcollectedFields ++ _tlIcollectedFields {-# INLINE rule583 #-} rule583 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule584 #-} rule584 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# NOINLINE sem_Fields_Nil #-} sem_Fields_Nil :: T_Fields sem_Fields_Nil = T_Fields (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_Fields_v25 v25 = \ (T_Fields_vIn25 _lhsIallNonterminals) -> ( let _lhsOcollectedConstraints :: [Type] _lhsOcollectedConstraints = rule585 () _lhsOcollectedFields :: [(Identifier, Type)] _lhsOcollectedFields = rule586 () __result_ = T_Fields_vOut25 _lhsOcollectedConstraints _lhsOcollectedFields in __result_ ) in C_Fields_s26 v25 {-# INLINE rule585 #-} rule585 = \ (_ :: ()) -> [] {-# INLINE rule586 #-} rule586 = \ (_ :: ()) -> [] -- NontSet ----------------------------------------------------- -- wrapper data Inh_NontSet = Inh_NontSet { allFields_Inh_NontSet :: (DataTypes), allNonterminals_Inh_NontSet :: (Set NontermIdent), definedSets_Inh_NontSet :: (DefinedSets) } data Syn_NontSet = Syn_NontSet { collectedNames_Syn_NontSet :: (Set Identifier), errors_Syn_NontSet :: (Seq Error), nontSet_Syn_NontSet :: (Set NontermIdent) } {-# INLINABLE wrap_NontSet #-} wrap_NontSet :: T_NontSet -> Inh_NontSet -> (Syn_NontSet ) wrap_NontSet (T_NontSet act) (Inh_NontSet _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets) = Control.Monad.Identity.runIdentity ( do sem <- act let arg28 = T_NontSet_vIn28 _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets (T_NontSet_vOut28 _lhsOcollectedNames _lhsOerrors _lhsOnontSet) <- return (inv_NontSet_s29 sem arg28) return (Syn_NontSet _lhsOcollectedNames _lhsOerrors _lhsOnontSet) ) -- cata {-# NOINLINE sem_NontSet #-} sem_NontSet :: NontSet -> T_NontSet sem_NontSet ( NamedSet name_ ) = sem_NontSet_NamedSet name_ sem_NontSet ( All ) = sem_NontSet_All sem_NontSet ( Union set1_ set2_ ) = sem_NontSet_Union ( sem_NontSet set1_ ) ( sem_NontSet set2_ ) sem_NontSet ( Intersect set1_ set2_ ) = sem_NontSet_Intersect ( sem_NontSet set1_ ) ( sem_NontSet set2_ ) sem_NontSet ( Difference set1_ set2_ ) = sem_NontSet_Difference ( sem_NontSet set1_ ) ( sem_NontSet set2_ ) sem_NontSet ( Path from_ to_ ) = sem_NontSet_Path from_ to_ -- semantic domain newtype T_NontSet = T_NontSet { attach_T_NontSet :: Identity (T_NontSet_s29 ) } newtype T_NontSet_s29 = C_NontSet_s29 { inv_NontSet_s29 :: (T_NontSet_v28 ) } data T_NontSet_s30 = C_NontSet_s30 type T_NontSet_v28 = (T_NontSet_vIn28 ) -> (T_NontSet_vOut28 ) data T_NontSet_vIn28 = T_NontSet_vIn28 (DataTypes) (Set NontermIdent) (DefinedSets) data T_NontSet_vOut28 = T_NontSet_vOut28 (Set Identifier) (Seq Error) (Set NontermIdent) {-# NOINLINE sem_NontSet_NamedSet #-} sem_NontSet_NamedSet :: (NontermIdent) -> T_NontSet sem_NontSet_NamedSet arg_name_ = T_NontSet (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_NontSet_v28 v28 = \ (T_NontSet_vIn28 _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets) -> ( let _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule587 arg_name_ (_nontSet,_errors) = rule588 _lhsIdefinedSets arg_name_ _lhsOerrors :: Seq Error _lhsOerrors = rule589 _errors _lhsOnontSet :: Set NontermIdent _lhsOnontSet = rule590 _nontSet __result_ = T_NontSet_vOut28 _lhsOcollectedNames _lhsOerrors _lhsOnontSet in __result_ ) in C_NontSet_s29 v28 {-# INLINE rule587 #-} {-# LINE 603 "src-ag/Transform.ag" #-} rule587 = \ name_ -> {-# LINE 603 "src-ag/Transform.ag" #-} Set.singleton name_ {-# LINE 4516 "dist/build/Transform.hs"#-} {-# INLINE rule588 #-} {-# LINE 733 "src-ag/Transform.ag" #-} rule588 = \ ((_lhsIdefinedSets) :: DefinedSets) name_ -> {-# LINE 733 "src-ag/Transform.ag" #-} case Map.lookup name_ _lhsIdefinedSets of Nothing -> (Set.empty, Seq.singleton (UndefNont name_)) Just set -> (set, Seq.empty) {-# LINE 4524 "dist/build/Transform.hs"#-} {-# INLINE rule589 #-} rule589 = \ _errors -> _errors {-# INLINE rule590 #-} rule590 = \ _nontSet -> _nontSet {-# NOINLINE sem_NontSet_All #-} sem_NontSet_All :: T_NontSet sem_NontSet_All = T_NontSet (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_NontSet_v28 v28 = \ (T_NontSet_vIn28 _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets) -> ( let _lhsOnontSet :: Set NontermIdent _lhsOnontSet = rule591 _lhsIallNonterminals _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule592 () _lhsOerrors :: Seq Error _lhsOerrors = rule593 () __result_ = T_NontSet_vOut28 _lhsOcollectedNames _lhsOerrors _lhsOnontSet in __result_ ) in C_NontSet_s29 v28 {-# INLINE rule591 #-} {-# LINE 732 "src-ag/Transform.ag" #-} rule591 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> {-# LINE 732 "src-ag/Transform.ag" #-} _lhsIallNonterminals {-# LINE 4552 "dist/build/Transform.hs"#-} {-# INLINE rule592 #-} rule592 = \ (_ :: ()) -> Set.empty {-# INLINE rule593 #-} rule593 = \ (_ :: ()) -> Seq.empty {-# NOINLINE sem_NontSet_Union #-} sem_NontSet_Union :: T_NontSet -> T_NontSet -> T_NontSet sem_NontSet_Union arg_set1_ arg_set2_ = T_NontSet (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_NontSet_v28 v28 = \ (T_NontSet_vIn28 _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets) -> ( let _set1X29 = Control.Monad.Identity.runIdentity (attach_T_NontSet (arg_set1_)) _set2X29 = Control.Monad.Identity.runIdentity (attach_T_NontSet (arg_set2_)) (T_NontSet_vOut28 _set1IcollectedNames _set1Ierrors _set1InontSet) = inv_NontSet_s29 _set1X29 (T_NontSet_vIn28 _set1OallFields _set1OallNonterminals _set1OdefinedSets) (T_NontSet_vOut28 _set2IcollectedNames _set2Ierrors _set2InontSet) = inv_NontSet_s29 _set2X29 (T_NontSet_vIn28 _set2OallFields _set2OallNonterminals _set2OdefinedSets) _lhsOnontSet :: Set NontermIdent _lhsOnontSet = rule594 _set1InontSet _set2InontSet _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule595 _set1IcollectedNames _set2IcollectedNames _lhsOerrors :: Seq Error _lhsOerrors = rule596 _set1Ierrors _set2Ierrors _set1OallFields = rule597 _lhsIallFields _set1OallNonterminals = rule598 _lhsIallNonterminals _set1OdefinedSets = rule599 _lhsIdefinedSets _set2OallFields = rule600 _lhsIallFields _set2OallNonterminals = rule601 _lhsIallNonterminals _set2OdefinedSets = rule602 _lhsIdefinedSets __result_ = T_NontSet_vOut28 _lhsOcollectedNames _lhsOerrors _lhsOnontSet in __result_ ) in C_NontSet_s29 v28 {-# INLINE rule594 #-} {-# LINE 736 "src-ag/Transform.ag" #-} rule594 = \ ((_set1InontSet) :: Set NontermIdent) ((_set2InontSet) :: Set NontermIdent) -> {-# LINE 736 "src-ag/Transform.ag" #-} Set.union _set1InontSet _set2InontSet {-# LINE 4590 "dist/build/Transform.hs"#-} {-# INLINE rule595 #-} rule595 = \ ((_set1IcollectedNames) :: Set Identifier) ((_set2IcollectedNames) :: Set Identifier) -> _set1IcollectedNames `Set.union` _set2IcollectedNames {-# INLINE rule596 #-} rule596 = \ ((_set1Ierrors) :: Seq Error) ((_set2Ierrors) :: Seq Error) -> _set1Ierrors Seq.>< _set2Ierrors {-# INLINE rule597 #-} rule597 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule598 #-} rule598 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule599 #-} rule599 = \ ((_lhsIdefinedSets) :: DefinedSets) -> _lhsIdefinedSets {-# INLINE rule600 #-} rule600 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule601 #-} rule601 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule602 #-} rule602 = \ ((_lhsIdefinedSets) :: DefinedSets) -> _lhsIdefinedSets {-# NOINLINE sem_NontSet_Intersect #-} sem_NontSet_Intersect :: T_NontSet -> T_NontSet -> T_NontSet sem_NontSet_Intersect arg_set1_ arg_set2_ = T_NontSet (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_NontSet_v28 v28 = \ (T_NontSet_vIn28 _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets) -> ( let _set1X29 = Control.Monad.Identity.runIdentity (attach_T_NontSet (arg_set1_)) _set2X29 = Control.Monad.Identity.runIdentity (attach_T_NontSet (arg_set2_)) (T_NontSet_vOut28 _set1IcollectedNames _set1Ierrors _set1InontSet) = inv_NontSet_s29 _set1X29 (T_NontSet_vIn28 _set1OallFields _set1OallNonterminals _set1OdefinedSets) (T_NontSet_vOut28 _set2IcollectedNames _set2Ierrors _set2InontSet) = inv_NontSet_s29 _set2X29 (T_NontSet_vIn28 _set2OallFields _set2OallNonterminals _set2OdefinedSets) _lhsOnontSet :: Set NontermIdent _lhsOnontSet = rule603 _set1InontSet _set2InontSet _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule604 _set1IcollectedNames _set2IcollectedNames _lhsOerrors :: Seq Error _lhsOerrors = rule605 _set1Ierrors _set2Ierrors _set1OallFields = rule606 _lhsIallFields _set1OallNonterminals = rule607 _lhsIallNonterminals _set1OdefinedSets = rule608 _lhsIdefinedSets _set2OallFields = rule609 _lhsIallFields _set2OallNonterminals = rule610 _lhsIallNonterminals _set2OdefinedSets = rule611 _lhsIdefinedSets __result_ = T_NontSet_vOut28 _lhsOcollectedNames _lhsOerrors _lhsOnontSet in __result_ ) in C_NontSet_s29 v28 {-# INLINE rule603 #-} {-# LINE 737 "src-ag/Transform.ag" #-} rule603 = \ ((_set1InontSet) :: Set NontermIdent) ((_set2InontSet) :: Set NontermIdent) -> {-# LINE 737 "src-ag/Transform.ag" #-} Set.intersection _set1InontSet _set2InontSet {-# LINE 4646 "dist/build/Transform.hs"#-} {-# INLINE rule604 #-} rule604 = \ ((_set1IcollectedNames) :: Set Identifier) ((_set2IcollectedNames) :: Set Identifier) -> _set1IcollectedNames `Set.union` _set2IcollectedNames {-# INLINE rule605 #-} rule605 = \ ((_set1Ierrors) :: Seq Error) ((_set2Ierrors) :: Seq Error) -> _set1Ierrors Seq.>< _set2Ierrors {-# INLINE rule606 #-} rule606 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule607 #-} rule607 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule608 #-} rule608 = \ ((_lhsIdefinedSets) :: DefinedSets) -> _lhsIdefinedSets {-# INLINE rule609 #-} rule609 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule610 #-} rule610 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule611 #-} rule611 = \ ((_lhsIdefinedSets) :: DefinedSets) -> _lhsIdefinedSets {-# NOINLINE sem_NontSet_Difference #-} sem_NontSet_Difference :: T_NontSet -> T_NontSet -> T_NontSet sem_NontSet_Difference arg_set1_ arg_set2_ = T_NontSet (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_NontSet_v28 v28 = \ (T_NontSet_vIn28 _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets) -> ( let _set1X29 = Control.Monad.Identity.runIdentity (attach_T_NontSet (arg_set1_)) _set2X29 = Control.Monad.Identity.runIdentity (attach_T_NontSet (arg_set2_)) (T_NontSet_vOut28 _set1IcollectedNames _set1Ierrors _set1InontSet) = inv_NontSet_s29 _set1X29 (T_NontSet_vIn28 _set1OallFields _set1OallNonterminals _set1OdefinedSets) (T_NontSet_vOut28 _set2IcollectedNames _set2Ierrors _set2InontSet) = inv_NontSet_s29 _set2X29 (T_NontSet_vIn28 _set2OallFields _set2OallNonterminals _set2OdefinedSets) _lhsOnontSet :: Set NontermIdent _lhsOnontSet = rule612 _set1InontSet _set2InontSet _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule613 _set1IcollectedNames _set2IcollectedNames _lhsOerrors :: Seq Error _lhsOerrors = rule614 _set1Ierrors _set2Ierrors _set1OallFields = rule615 _lhsIallFields _set1OallNonterminals = rule616 _lhsIallNonterminals _set1OdefinedSets = rule617 _lhsIdefinedSets _set2OallFields = rule618 _lhsIallFields _set2OallNonterminals = rule619 _lhsIallNonterminals _set2OdefinedSets = rule620 _lhsIdefinedSets __result_ = T_NontSet_vOut28 _lhsOcollectedNames _lhsOerrors _lhsOnontSet in __result_ ) in C_NontSet_s29 v28 {-# INLINE rule612 #-} {-# LINE 738 "src-ag/Transform.ag" #-} rule612 = \ ((_set1InontSet) :: Set NontermIdent) ((_set2InontSet) :: Set NontermIdent) -> {-# LINE 738 "src-ag/Transform.ag" #-} Set.difference _set1InontSet _set2InontSet {-# LINE 4702 "dist/build/Transform.hs"#-} {-# INLINE rule613 #-} rule613 = \ ((_set1IcollectedNames) :: Set Identifier) ((_set2IcollectedNames) :: Set Identifier) -> _set1IcollectedNames `Set.union` _set2IcollectedNames {-# INLINE rule614 #-} rule614 = \ ((_set1Ierrors) :: Seq Error) ((_set2Ierrors) :: Seq Error) -> _set1Ierrors Seq.>< _set2Ierrors {-# INLINE rule615 #-} rule615 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule616 #-} rule616 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule617 #-} rule617 = \ ((_lhsIdefinedSets) :: DefinedSets) -> _lhsIdefinedSets {-# INLINE rule618 #-} rule618 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule619 #-} rule619 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> _lhsIallNonterminals {-# INLINE rule620 #-} rule620 = \ ((_lhsIdefinedSets) :: DefinedSets) -> _lhsIdefinedSets {-# NOINLINE sem_NontSet_Path #-} sem_NontSet_Path :: (NontermIdent) -> (NontermIdent) -> T_NontSet sem_NontSet_Path arg_from_ arg_to_ = T_NontSet (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_NontSet_v28 v28 = \ (T_NontSet_vIn28 _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets) -> ( let _lhsOnontSet :: Set NontermIdent _lhsOnontSet = rule621 _lhsIallFields arg_from_ arg_to_ _lhsOerrors :: Seq Error _lhsOerrors = rule622 _lhsIallNonterminals arg_from_ arg_to_ _lhsOcollectedNames :: Set Identifier _lhsOcollectedNames = rule623 () __result_ = T_NontSet_vOut28 _lhsOcollectedNames _lhsOerrors _lhsOnontSet in __result_ ) in C_NontSet_s29 v28 {-# INLINE rule621 #-} {-# LINE 739 "src-ag/Transform.ag" #-} rule621 = \ ((_lhsIallFields) :: DataTypes) from_ to_ -> {-# LINE 739 "src-ag/Transform.ag" #-} let table = flattenDatas _lhsIallFields in path table from_ to_ {-# LINE 4749 "dist/build/Transform.hs"#-} {-# INLINE rule622 #-} {-# LINE 741 "src-ag/Transform.ag" #-} rule622 = \ ((_lhsIallNonterminals) :: Set NontermIdent) from_ to_ -> {-# LINE 741 "src-ag/Transform.ag" #-} let check name | Set.member name _lhsIallNonterminals = Seq.empty | otherwise = Seq.singleton (UndefNont name) in check from_ >< check to_ {-# LINE 4758 "dist/build/Transform.hs"#-} {-# INLINE rule623 #-} rule623 = \ (_ :: ()) -> Set.empty -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { } data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), definedAttrs_Syn_Pattern :: ([AttrName]), definedInsts_Syn_Pattern :: ([Identifier]), patunder_Syn_Pattern :: ([AttrName]->Pattern), stpos_Syn_Pattern :: (Pos) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg31 = T_Pattern_vIn31 (T_Pattern_vOut31 _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder _lhsOstpos) <- return (inv_Pattern_s32 sem arg31) return (Syn_Pattern _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder _lhsOstpos) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s32 ) } newtype T_Pattern_s32 = C_Pattern_s32 { inv_Pattern_s32 :: (T_Pattern_v31 ) } data T_Pattern_s33 = C_Pattern_s33 type T_Pattern_v31 = (T_Pattern_vIn31 ) -> (T_Pattern_vOut31 ) data T_Pattern_vIn31 = T_Pattern_vIn31 data T_Pattern_vOut31 = T_Pattern_vOut31 (Pattern) ([AttrName]) ([Identifier]) ([AttrName]->Pattern) (Pos) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_Pattern_v31 v31 = \ (T_Pattern_vIn31 ) -> ( let _patsX35 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut34 _patsIcopy _patsIdefinedAttrs _patsIdefinedInsts _patsIpatunder) = inv_Patterns_s35 _patsX35 (T_Patterns_vIn34 ) _lhsOpatunder :: [AttrName]->Pattern _lhsOpatunder = rule624 _patsIpatunder arg_name_ _lhsOstpos :: Pos _lhsOstpos = rule625 arg_name_ _lhsOdefinedAttrs :: [AttrName] _lhsOdefinedAttrs = rule626 _patsIdefinedAttrs _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule627 _patsIdefinedInsts _copy = rule628 _patsIcopy arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule629 _copy __result_ = T_Pattern_vOut31 _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder _lhsOstpos in __result_ ) in C_Pattern_s32 v31 {-# INLINE rule624 #-} {-# LINE 1190 "src-ag/Transform.ag" #-} rule624 = \ ((_patsIpatunder) :: [AttrName]->Patterns) name_ -> {-# LINE 1190 "src-ag/Transform.ag" #-} \us -> Constr name_ (_patsIpatunder us) {-# LINE 4825 "dist/build/Transform.hs"#-} {-# INLINE rule625 #-} {-# LINE 1201 "src-ag/Transform.ag" #-} rule625 = \ name_ -> {-# LINE 1201 "src-ag/Transform.ag" #-} getPos name_ {-# LINE 4831 "dist/build/Transform.hs"#-} {-# INLINE rule626 #-} rule626 = \ ((_patsIdefinedAttrs) :: [AttrName]) -> _patsIdefinedAttrs {-# INLINE rule627 #-} rule627 = \ ((_patsIdefinedInsts) :: [Identifier]) -> _patsIdefinedInsts {-# INLINE rule628 #-} rule628 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule629 #-} rule629 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_Pattern_v31 v31 = \ (T_Pattern_vIn31 ) -> ( let _patsX35 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut34 _patsIcopy _patsIdefinedAttrs _patsIdefinedInsts _patsIpatunder) = inv_Patterns_s35 _patsX35 (T_Patterns_vIn34 ) _lhsOpatunder :: [AttrName]->Pattern _lhsOpatunder = rule630 _patsIpatunder arg_pos_ _lhsOstpos :: Pos _lhsOstpos = rule631 arg_pos_ _lhsOdefinedAttrs :: [AttrName] _lhsOdefinedAttrs = rule632 _patsIdefinedAttrs _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule633 _patsIdefinedInsts _copy = rule634 _patsIcopy arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule635 _copy __result_ = T_Pattern_vOut31 _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder _lhsOstpos in __result_ ) in C_Pattern_s32 v31 {-# INLINE rule630 #-} {-# LINE 1191 "src-ag/Transform.ag" #-} rule630 = \ ((_patsIpatunder) :: [AttrName]->Patterns) pos_ -> {-# LINE 1191 "src-ag/Transform.ag" #-} \us -> Product pos_ (_patsIpatunder us) {-# LINE 4872 "dist/build/Transform.hs"#-} {-# INLINE rule631 #-} {-# LINE 1202 "src-ag/Transform.ag" #-} rule631 = \ pos_ -> {-# LINE 1202 "src-ag/Transform.ag" #-} pos_ {-# LINE 4878 "dist/build/Transform.hs"#-} {-# INLINE rule632 #-} rule632 = \ ((_patsIdefinedAttrs) :: [AttrName]) -> _patsIdefinedAttrs {-# INLINE rule633 #-} rule633 = \ ((_patsIdefinedInsts) :: [Identifier]) -> _patsIdefinedInsts {-# INLINE rule634 #-} rule634 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule635 #-} rule635 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_Pattern_v31 v31 = \ (T_Pattern_vIn31 ) -> ( let _patX32 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut31 _patIcopy _patIdefinedAttrs _patIdefinedInsts _patIpatunder _patIstpos) = inv_Pattern_s32 _patX32 (T_Pattern_vIn31 ) _lhsOdefinedAttrs :: [AttrName] _lhsOdefinedAttrs = rule636 _patIdefinedAttrs arg_attr_ arg_field_ _lhsOpatunder :: [AttrName]->Pattern _lhsOpatunder = rule637 _copy arg_attr_ arg_field_ _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule638 _patIdefinedInsts arg_attr_ arg_field_ _lhsOstpos :: Pos _lhsOstpos = rule639 arg_field_ _copy = rule640 _patIcopy arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule641 _copy __result_ = T_Pattern_vOut31 _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder _lhsOstpos in __result_ ) in C_Pattern_s32 v31 {-# INLINE rule636 #-} {-# LINE 1186 "src-ag/Transform.ag" #-} rule636 = \ ((_patIdefinedAttrs) :: [AttrName]) attr_ field_ -> {-# LINE 1186 "src-ag/Transform.ag" #-} (field_, attr_) : _patIdefinedAttrs {-# LINE 4919 "dist/build/Transform.hs"#-} {-# INLINE rule637 #-} {-# LINE 1187 "src-ag/Transform.ag" #-} rule637 = \ _copy attr_ field_ -> {-# LINE 1187 "src-ag/Transform.ag" #-} \us -> if ((field_,attr_) `elem` us) then Underscore noPos else _copy {-# LINE 4925 "dist/build/Transform.hs"#-} {-# INLINE rule638 #-} {-# LINE 1188 "src-ag/Transform.ag" #-} rule638 = \ ((_patIdefinedInsts) :: [Identifier]) attr_ field_ -> {-# LINE 1188 "src-ag/Transform.ag" #-} (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts {-# LINE 4931 "dist/build/Transform.hs"#-} {-# INLINE rule639 #-} {-# LINE 1203 "src-ag/Transform.ag" #-} rule639 = \ field_ -> {-# LINE 1203 "src-ag/Transform.ag" #-} getPos field_ {-# LINE 4937 "dist/build/Transform.hs"#-} {-# INLINE rule640 #-} rule640 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule641 #-} rule641 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_Pattern_v31 v31 = \ (T_Pattern_vIn31 ) -> ( let _patX32 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut31 _patIcopy _patIdefinedAttrs _patIdefinedInsts _patIpatunder _patIstpos) = inv_Pattern_s32 _patX32 (T_Pattern_vIn31 ) _lhsOpatunder :: [AttrName]->Pattern _lhsOpatunder = rule642 _patIpatunder _lhsOdefinedAttrs :: [AttrName] _lhsOdefinedAttrs = rule643 _patIdefinedAttrs _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule644 _patIdefinedInsts _copy = rule645 _patIcopy _lhsOcopy :: Pattern _lhsOcopy = rule646 _copy _lhsOstpos :: Pos _lhsOstpos = rule647 _patIstpos __result_ = T_Pattern_vOut31 _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder _lhsOstpos in __result_ ) in C_Pattern_s32 v31 {-# INLINE rule642 #-} {-# LINE 1192 "src-ag/Transform.ag" #-} rule642 = \ ((_patIpatunder) :: [AttrName]->Pattern) -> {-# LINE 1192 "src-ag/Transform.ag" #-} \us -> Irrefutable (_patIpatunder us) {-# LINE 4972 "dist/build/Transform.hs"#-} {-# INLINE rule643 #-} rule643 = \ ((_patIdefinedAttrs) :: [AttrName]) -> _patIdefinedAttrs {-# INLINE rule644 #-} rule644 = \ ((_patIdefinedInsts) :: [Identifier]) -> _patIdefinedInsts {-# INLINE rule645 #-} rule645 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule646 #-} rule646 = \ _copy -> _copy {-# INLINE rule647 #-} rule647 = \ ((_patIstpos) :: Pos) -> _patIstpos {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore arg_pos_ = T_Pattern (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_Pattern_v31 v31 = \ (T_Pattern_vIn31 ) -> ( let _lhsOpatunder :: [AttrName]->Pattern _lhsOpatunder = rule648 _copy _lhsOstpos :: Pos _lhsOstpos = rule649 arg_pos_ _lhsOdefinedAttrs :: [AttrName] _lhsOdefinedAttrs = rule650 () _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule651 () _copy = rule652 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule653 _copy __result_ = T_Pattern_vOut31 _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder _lhsOstpos in __result_ ) in C_Pattern_s32 v31 {-# INLINE rule648 #-} {-# LINE 1189 "src-ag/Transform.ag" #-} rule648 = \ _copy -> {-# LINE 1189 "src-ag/Transform.ag" #-} \_ -> _copy {-# LINE 5014 "dist/build/Transform.hs"#-} {-# INLINE rule649 #-} {-# LINE 1204 "src-ag/Transform.ag" #-} rule649 = \ pos_ -> {-# LINE 1204 "src-ag/Transform.ag" #-} pos_ {-# LINE 5020 "dist/build/Transform.hs"#-} {-# INLINE rule650 #-} rule650 = \ (_ :: ()) -> [] {-# INLINE rule651 #-} rule651 = \ (_ :: ()) -> [] {-# INLINE rule652 #-} rule652 = \ pos_ -> Underscore pos_ {-# INLINE rule653 #-} rule653 = \ _copy -> _copy -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { } data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns), definedAttrs_Syn_Patterns :: ([AttrName]), definedInsts_Syn_Patterns :: ([Identifier]), patunder_Syn_Patterns :: ([AttrName]->Patterns) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg34 = T_Patterns_vIn34 (T_Patterns_vOut34 _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder) <- return (inv_Patterns_s35 sem arg34) return (Syn_Patterns _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s35 ) } newtype T_Patterns_s35 = C_Patterns_s35 { inv_Patterns_s35 :: (T_Patterns_v34 ) } data T_Patterns_s36 = C_Patterns_s36 type T_Patterns_v34 = (T_Patterns_vIn34 ) -> (T_Patterns_vOut34 ) data T_Patterns_vIn34 = T_Patterns_vIn34 data T_Patterns_vOut34 = T_Patterns_vOut34 (Patterns) ([AttrName]) ([Identifier]) ([AttrName]->Patterns) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Patterns_v34 v34 = \ (T_Patterns_vIn34 ) -> ( let _hdX32 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX35 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut31 _hdIcopy _hdIdefinedAttrs _hdIdefinedInsts _hdIpatunder _hdIstpos) = inv_Pattern_s32 _hdX32 (T_Pattern_vIn31 ) (T_Patterns_vOut34 _tlIcopy _tlIdefinedAttrs _tlIdefinedInsts _tlIpatunder) = inv_Patterns_s35 _tlX35 (T_Patterns_vIn34 ) _lhsOpatunder :: [AttrName]->Patterns _lhsOpatunder = rule654 _hdIpatunder _tlIpatunder _lhsOdefinedAttrs :: [AttrName] _lhsOdefinedAttrs = rule655 _hdIdefinedAttrs _tlIdefinedAttrs _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule656 _hdIdefinedInsts _tlIdefinedInsts _copy = rule657 _hdIcopy _tlIcopy _lhsOcopy :: Patterns _lhsOcopy = rule658 _copy __result_ = T_Patterns_vOut34 _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder in __result_ ) in C_Patterns_s35 v34 {-# INLINE rule654 #-} {-# LINE 1196 "src-ag/Transform.ag" #-} rule654 = \ ((_hdIpatunder) :: [AttrName]->Pattern) ((_tlIpatunder) :: [AttrName]->Patterns) -> {-# LINE 1196 "src-ag/Transform.ag" #-} \us -> (_hdIpatunder us) : (_tlIpatunder us) {-# LINE 5092 "dist/build/Transform.hs"#-} {-# INLINE rule655 #-} rule655 = \ ((_hdIdefinedAttrs) :: [AttrName]) ((_tlIdefinedAttrs) :: [AttrName]) -> _hdIdefinedAttrs ++ _tlIdefinedAttrs {-# INLINE rule656 #-} rule656 = \ ((_hdIdefinedInsts) :: [Identifier]) ((_tlIdefinedInsts) :: [Identifier]) -> _hdIdefinedInsts ++ _tlIdefinedInsts {-# INLINE rule657 #-} rule657 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule658 #-} rule658 = \ _copy -> _copy {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Patterns_v34 v34 = \ (T_Patterns_vIn34 ) -> ( let _lhsOpatunder :: [AttrName]->Patterns _lhsOpatunder = rule659 () _lhsOdefinedAttrs :: [AttrName] _lhsOdefinedAttrs = rule660 () _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule661 () _copy = rule662 () _lhsOcopy :: Patterns _lhsOcopy = rule663 _copy __result_ = T_Patterns_vOut34 _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder in __result_ ) in C_Patterns_s35 v34 {-# INLINE rule659 #-} {-# LINE 1195 "src-ag/Transform.ag" #-} rule659 = \ (_ :: ()) -> {-# LINE 1195 "src-ag/Transform.ag" #-} \_ -> [] {-# LINE 5129 "dist/build/Transform.hs"#-} {-# INLINE rule660 #-} rule660 = \ (_ :: ()) -> [] {-# INLINE rule661 #-} rule661 = \ (_ :: ()) -> [] {-# INLINE rule662 #-} rule662 = \ (_ :: ()) -> [] {-# INLINE rule663 #-} rule663 = \ _copy -> _copy -- SemAlt ------------------------------------------------------ -- wrapper data Inh_SemAlt = Inh_SemAlt { allAttrDecls_Inh_SemAlt :: (Map NontermIdent (Attributes, Attributes)), allAttrs_Inh_SemAlt :: (Map NontermIdent (Attributes, Attributes)), allFields_Inh_SemAlt :: (DataTypes), nts_Inh_SemAlt :: (Set NontermIdent), options_Inh_SemAlt :: (Options) } data Syn_SemAlt = Syn_SemAlt { attrOrderCollect_Syn_SemAlt :: (AttrOrderMap), collectedArounds_Syn_SemAlt :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]), collectedAugments_Syn_SemAlt :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]), collectedInsts_Syn_SemAlt :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]), collectedMerges_Syn_SemAlt :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]), collectedRules_Syn_SemAlt :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]), collectedSigs_Syn_SemAlt :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]), collectedUniques_Syn_SemAlt :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]), errors_Syn_SemAlt :: (Seq Error), semPragmasCollect_Syn_SemAlt :: (PragmaMap) } {-# INLINABLE wrap_SemAlt #-} wrap_SemAlt :: T_SemAlt -> Inh_SemAlt -> (Syn_SemAlt ) wrap_SemAlt (T_SemAlt act) (Inh_SemAlt _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg37 = T_SemAlt_vIn37 _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions (T_SemAlt_vOut37 _lhsOattrOrderCollect _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedInsts _lhsOcollectedMerges _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _lhsOerrors _lhsOsemPragmasCollect) <- return (inv_SemAlt_s38 sem arg37) return (Syn_SemAlt _lhsOattrOrderCollect _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedInsts _lhsOcollectedMerges _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _lhsOerrors _lhsOsemPragmasCollect) ) -- cata {-# INLINE sem_SemAlt #-} sem_SemAlt :: SemAlt -> T_SemAlt sem_SemAlt ( SemAlt pos_ constructorSet_ rules_ ) = sem_SemAlt_SemAlt pos_ ( sem_ConstructorSet constructorSet_ ) ( sem_SemDefs rules_ ) -- semantic domain newtype T_SemAlt = T_SemAlt { attach_T_SemAlt :: Identity (T_SemAlt_s38 ) } newtype T_SemAlt_s38 = C_SemAlt_s38 { inv_SemAlt_s38 :: (T_SemAlt_v37 ) } data T_SemAlt_s39 = C_SemAlt_s39 type T_SemAlt_v37 = (T_SemAlt_vIn37 ) -> (T_SemAlt_vOut37 ) data T_SemAlt_vIn37 = T_SemAlt_vIn37 (Map NontermIdent (Attributes, Attributes)) (Map NontermIdent (Attributes, Attributes)) (DataTypes) (Set NontermIdent) (Options) data T_SemAlt_vOut37 = T_SemAlt_vOut37 (AttrOrderMap) ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) ([ (NontermIdent, ConstructorIdent, RuleInfo)]) ([ (NontermIdent, ConstructorIdent, SigInfo) ]) ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) (Seq Error) (PragmaMap) {-# NOINLINE sem_SemAlt_SemAlt #-} sem_SemAlt_SemAlt :: (Pos) -> T_ConstructorSet -> T_SemDefs -> T_SemAlt sem_SemAlt_SemAlt _ arg_constructorSet_ arg_rules_ = T_SemAlt (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_SemAlt_v37 v37 = \ (T_SemAlt_vIn37 _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions) -> ( let _constructorSetX14 = Control.Monad.Identity.runIdentity (attach_T_ConstructorSet (arg_constructorSet_)) _rulesX47 = Control.Monad.Identity.runIdentity (attach_T_SemDefs (arg_rules_)) (T_ConstructorSet_vOut13 _constructorSetIcollectedConstructorNames _constructorSetIconstructors _constructorSetIerrors) = inv_ConstructorSet_s14 _constructorSetX14 (T_ConstructorSet_vIn13 ) (T_SemDefs_vOut46 _rulesIaroundInfos _rulesIaugmentInfos _rulesIdefinedInsts _rulesIerrors _rulesImergeInfos _rulesIorderDepsCollect _rulesIpragmaNamesCollect _rulesIruleInfos _rulesIsigInfos _rulesIuniqueInfos) = inv_SemDefs_s47 _rulesX47 (T_SemDefs_vIn46 _rulesOoptions) _pragmaNames = rule664 _rulesIpragmaNamesCollect _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule665 _coninfo _pragmaNames _attrOrders = rule666 _coninfo _rulesIorderDepsCollect _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule667 _attrOrders _coninfo = rule668 _constructorSetIconstructors _lhsIallFields _lhsInts _lhsOerrors :: Seq Error _lhsOerrors = rule669 _coninfo _rulesIerrors _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule670 _coninfo _rulesIruleInfos _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule671 _coninfo _rulesIsigInfos _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule672 _coninfo _rulesIdefinedInsts _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule673 _coninfo _rulesIuniqueInfos _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule674 _coninfo _rulesIaugmentInfos _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule675 _coninfo _rulesIaroundInfos _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule676 _coninfo _rulesImergeInfos _rulesOoptions = rule677 _lhsIoptions __result_ = T_SemAlt_vOut37 _lhsOattrOrderCollect _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedInsts _lhsOcollectedMerges _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _lhsOerrors _lhsOsemPragmasCollect in __result_ ) in C_SemAlt_s38 v37 {-# INLINE rule664 #-} {-# LINE 888 "src-ag/Transform.ag" #-} rule664 = \ ((_rulesIpragmaNamesCollect) :: [Identifier]) -> {-# LINE 888 "src-ag/Transform.ag" #-} Set.fromList _rulesIpragmaNamesCollect {-# LINE 5216 "dist/build/Transform.hs"#-} {-# INLINE rule665 #-} {-# LINE 889 "src-ag/Transform.ag" #-} rule665 = \ _coninfo _pragmaNames -> {-# LINE 889 "src-ag/Transform.ag" #-} foldr pragmaMapUnion Map.empty [ pragmaMapSingle nt con _pragmaNames | (nt, conset, _) <- _coninfo , con <- Set.toList conset ] {-# LINE 5225 "dist/build/Transform.hs"#-} {-# INLINE rule666 #-} {-# LINE 918 "src-ag/Transform.ag" #-} rule666 = \ _coninfo ((_rulesIorderDepsCollect) :: Set Dependency) -> {-# LINE 918 "src-ag/Transform.ag" #-} [ orderMapSingle nt con _rulesIorderDepsCollect | (nt, conset, _) <- _coninfo , con <- Set.toList conset ] {-# LINE 5234 "dist/build/Transform.hs"#-} {-# INLINE rule667 #-} {-# LINE 923 "src-ag/Transform.ag" #-} rule667 = \ _attrOrders -> {-# LINE 923 "src-ag/Transform.ag" #-} foldr orderMapUnion Map.empty _attrOrders {-# LINE 5240 "dist/build/Transform.hs"#-} {-# INLINE rule668 #-} {-# LINE 1105 "src-ag/Transform.ag" #-} rule668 = \ ((_constructorSetIconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) ((_lhsIallFields) :: DataTypes) ((_lhsInts) :: Set NontermIdent) -> {-# LINE 1105 "src-ag/Transform.ag" #-} [ (nt, conset, conkeys) | nt <- Set.toList _lhsInts , let conmap = Map.findWithDefault Map.empty nt _lhsIallFields , let conkeys = Set.fromList (Map.keys conmap) , let conset = _constructorSetIconstructors conkeys ] {-# LINE 5251 "dist/build/Transform.hs"#-} {-# INLINE rule669 #-} {-# LINE 1112 "src-ag/Transform.ag" #-} rule669 = \ _coninfo ((_rulesIerrors) :: Seq Error) -> {-# LINE 1112 "src-ag/Transform.ag" #-} Seq.fromList [ UndefAlt nt con | (nt, conset, conkeys) <- _coninfo , con <- Set.toList (Set.difference conset conkeys) ] Seq.>< _rulesIerrors {-# LINE 5262 "dist/build/Transform.hs"#-} {-# INLINE rule670 #-} {-# LINE 1119 "src-ag/Transform.ag" #-} rule670 = \ _coninfo ((_rulesIruleInfos) :: [RuleInfo]) -> {-# LINE 1119 "src-ag/Transform.ag" #-} [ (nt,con,r) | (nt, conset, _) <- _coninfo , con <- Set.toList conset , r <- _rulesIruleInfos ] {-# LINE 5272 "dist/build/Transform.hs"#-} {-# INLINE rule671 #-} {-# LINE 1125 "src-ag/Transform.ag" #-} rule671 = \ _coninfo ((_rulesIsigInfos) :: [SigInfo]) -> {-# LINE 1125 "src-ag/Transform.ag" #-} [ (nt,con,ts) | (nt, conset, _) <- _coninfo , con <- Set.toList conset , ts <- _rulesIsigInfos ] {-# LINE 5282 "dist/build/Transform.hs"#-} {-# INLINE rule672 #-} {-# LINE 1132 "src-ag/Transform.ag" #-} rule672 = \ _coninfo ((_rulesIdefinedInsts) :: [Identifier]) -> {-# LINE 1132 "src-ag/Transform.ag" #-} [ (nt,con,_rulesIdefinedInsts) | (nt, conset, _) <- _coninfo , con <- Set.toList conset ] {-# LINE 5291 "dist/build/Transform.hs"#-} {-# INLINE rule673 #-} {-# LINE 1138 "src-ag/Transform.ag" #-} rule673 = \ _coninfo ((_rulesIuniqueInfos) :: [UniqueInfo]) -> {-# LINE 1138 "src-ag/Transform.ag" #-} [ (nt,con,_rulesIuniqueInfos) | (nt, conset, _) <- _coninfo , con <- Set.toList conset ] {-# LINE 5300 "dist/build/Transform.hs"#-} {-# INLINE rule674 #-} {-# LINE 1144 "src-ag/Transform.ag" #-} rule674 = \ _coninfo ((_rulesIaugmentInfos) :: [AugmentInfo]) -> {-# LINE 1144 "src-ag/Transform.ag" #-} [ (nt, con, _rulesIaugmentInfos) | (nt, conset, _) <- _coninfo , con <- Set.toList conset ] {-# LINE 5309 "dist/build/Transform.hs"#-} {-# INLINE rule675 #-} {-# LINE 1150 "src-ag/Transform.ag" #-} rule675 = \ _coninfo ((_rulesIaroundInfos) :: [AroundInfo]) -> {-# LINE 1150 "src-ag/Transform.ag" #-} [ (nt, con, _rulesIaroundInfos) | (nt, conset, _) <- _coninfo , con <- Set.toList conset ] {-# LINE 5318 "dist/build/Transform.hs"#-} {-# INLINE rule676 #-} {-# LINE 1156 "src-ag/Transform.ag" #-} rule676 = \ _coninfo ((_rulesImergeInfos) :: [MergeInfo]) -> {-# LINE 1156 "src-ag/Transform.ag" #-} [ (nt, con, _rulesImergeInfos) | (nt, conset, _) <- _coninfo , con <- Set.toList conset ] {-# LINE 5327 "dist/build/Transform.hs"#-} {-# INLINE rule677 #-} rule677 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- SemAlts ----------------------------------------------------- -- wrapper data Inh_SemAlts = Inh_SemAlts { allAttrDecls_Inh_SemAlts :: (Map NontermIdent (Attributes, Attributes)), allAttrs_Inh_SemAlts :: (Map NontermIdent (Attributes, Attributes)), allFields_Inh_SemAlts :: (DataTypes), nts_Inh_SemAlts :: (Set NontermIdent), options_Inh_SemAlts :: (Options) } data Syn_SemAlts = Syn_SemAlts { attrOrderCollect_Syn_SemAlts :: (AttrOrderMap), collectedArounds_Syn_SemAlts :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]), collectedAugments_Syn_SemAlts :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]), collectedInsts_Syn_SemAlts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ]), collectedMerges_Syn_SemAlts :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]), collectedRules_Syn_SemAlts :: ([ (NontermIdent, ConstructorIdent, RuleInfo)]), collectedSigs_Syn_SemAlts :: ([ (NontermIdent, ConstructorIdent, SigInfo) ]), collectedUniques_Syn_SemAlts :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]), errors_Syn_SemAlts :: (Seq Error), semPragmasCollect_Syn_SemAlts :: (PragmaMap) } {-# INLINABLE wrap_SemAlts #-} wrap_SemAlts :: T_SemAlts -> Inh_SemAlts -> (Syn_SemAlts ) wrap_SemAlts (T_SemAlts act) (Inh_SemAlts _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg40 = T_SemAlts_vIn40 _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions (T_SemAlts_vOut40 _lhsOattrOrderCollect _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedInsts _lhsOcollectedMerges _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _lhsOerrors _lhsOsemPragmasCollect) <- return (inv_SemAlts_s41 sem arg40) return (Syn_SemAlts _lhsOattrOrderCollect _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedInsts _lhsOcollectedMerges _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _lhsOerrors _lhsOsemPragmasCollect) ) -- cata {-# NOINLINE sem_SemAlts #-} sem_SemAlts :: SemAlts -> T_SemAlts sem_SemAlts list = Prelude.foldr sem_SemAlts_Cons sem_SemAlts_Nil (Prelude.map sem_SemAlt list) -- semantic domain newtype T_SemAlts = T_SemAlts { attach_T_SemAlts :: Identity (T_SemAlts_s41 ) } newtype T_SemAlts_s41 = C_SemAlts_s41 { inv_SemAlts_s41 :: (T_SemAlts_v40 ) } data T_SemAlts_s42 = C_SemAlts_s42 type T_SemAlts_v40 = (T_SemAlts_vIn40 ) -> (T_SemAlts_vOut40 ) data T_SemAlts_vIn40 = T_SemAlts_vIn40 (Map NontermIdent (Attributes, Attributes)) (Map NontermIdent (Attributes, Attributes)) (DataTypes) (Set NontermIdent) (Options) data T_SemAlts_vOut40 = T_SemAlts_vOut40 (AttrOrderMap) ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) ([ (NontermIdent, ConstructorIdent, [Identifier]) ]) ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) ([ (NontermIdent, ConstructorIdent, RuleInfo)]) ([ (NontermIdent, ConstructorIdent, SigInfo) ]) ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) (Seq Error) (PragmaMap) {-# NOINLINE sem_SemAlts_Cons #-} sem_SemAlts_Cons :: T_SemAlt -> T_SemAlts -> T_SemAlts sem_SemAlts_Cons arg_hd_ arg_tl_ = T_SemAlts (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_SemAlts_v40 v40 = \ (T_SemAlts_vIn40 _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions) -> ( let _hdX38 = Control.Monad.Identity.runIdentity (attach_T_SemAlt (arg_hd_)) _tlX41 = Control.Monad.Identity.runIdentity (attach_T_SemAlts (arg_tl_)) (T_SemAlt_vOut37 _hdIattrOrderCollect _hdIcollectedArounds _hdIcollectedAugments _hdIcollectedInsts _hdIcollectedMerges _hdIcollectedRules _hdIcollectedSigs _hdIcollectedUniques _hdIerrors _hdIsemPragmasCollect) = inv_SemAlt_s38 _hdX38 (T_SemAlt_vIn37 _hdOallAttrDecls _hdOallAttrs _hdOallFields _hdOnts _hdOoptions) (T_SemAlts_vOut40 _tlIattrOrderCollect _tlIcollectedArounds _tlIcollectedAugments _tlIcollectedInsts _tlIcollectedMerges _tlIcollectedRules _tlIcollectedSigs _tlIcollectedUniques _tlIerrors _tlIsemPragmasCollect) = inv_SemAlts_s41 _tlX41 (T_SemAlts_vIn40 _tlOallAttrDecls _tlOallAttrs _tlOallFields _tlOnts _tlOoptions) _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule678 _hdIattrOrderCollect _tlIattrOrderCollect _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule679 _hdIcollectedArounds _tlIcollectedArounds _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule680 _hdIcollectedAugments _tlIcollectedAugments _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule681 _hdIcollectedInsts _tlIcollectedInsts _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule682 _hdIcollectedMerges _tlIcollectedMerges _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule683 _hdIcollectedRules _tlIcollectedRules _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule684 _hdIcollectedSigs _tlIcollectedSigs _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule685 _hdIcollectedUniques _tlIcollectedUniques _lhsOerrors :: Seq Error _lhsOerrors = rule686 _hdIerrors _tlIerrors _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule687 _hdIsemPragmasCollect _tlIsemPragmasCollect _hdOallAttrDecls = rule688 _lhsIallAttrDecls _hdOallAttrs = rule689 _lhsIallAttrs _hdOallFields = rule690 _lhsIallFields _hdOnts = rule691 _lhsInts _hdOoptions = rule692 _lhsIoptions _tlOallAttrDecls = rule693 _lhsIallAttrDecls _tlOallAttrs = rule694 _lhsIallAttrs _tlOallFields = rule695 _lhsIallFields _tlOnts = rule696 _lhsInts _tlOoptions = rule697 _lhsIoptions __result_ = T_SemAlts_vOut40 _lhsOattrOrderCollect _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedInsts _lhsOcollectedMerges _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _lhsOerrors _lhsOsemPragmasCollect in __result_ ) in C_SemAlts_s41 v40 {-# INLINE rule678 #-} rule678 = \ ((_hdIattrOrderCollect) :: AttrOrderMap) ((_tlIattrOrderCollect) :: AttrOrderMap) -> _hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect {-# INLINE rule679 #-} rule679 = \ ((_hdIcollectedArounds) :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) ((_tlIcollectedArounds) :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) -> _hdIcollectedArounds ++ _tlIcollectedArounds {-# INLINE rule680 #-} rule680 = \ ((_hdIcollectedAugments) :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) ((_tlIcollectedAugments) :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) -> _hdIcollectedAugments ++ _tlIcollectedAugments {-# INLINE rule681 #-} rule681 = \ ((_hdIcollectedInsts) :: [ (NontermIdent, ConstructorIdent, [Identifier]) ]) ((_tlIcollectedInsts) :: [ (NontermIdent, ConstructorIdent, [Identifier]) ]) -> _hdIcollectedInsts ++ _tlIcollectedInsts {-# INLINE rule682 #-} rule682 = \ ((_hdIcollectedMerges) :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) ((_tlIcollectedMerges) :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) -> _hdIcollectedMerges ++ _tlIcollectedMerges {-# INLINE rule683 #-} rule683 = \ ((_hdIcollectedRules) :: [ (NontermIdent, ConstructorIdent, RuleInfo)]) ((_tlIcollectedRules) :: [ (NontermIdent, ConstructorIdent, RuleInfo)]) -> _hdIcollectedRules ++ _tlIcollectedRules {-# INLINE rule684 #-} rule684 = \ ((_hdIcollectedSigs) :: [ (NontermIdent, ConstructorIdent, SigInfo) ]) ((_tlIcollectedSigs) :: [ (NontermIdent, ConstructorIdent, SigInfo) ]) -> _hdIcollectedSigs ++ _tlIcollectedSigs {-# INLINE rule685 #-} rule685 = \ ((_hdIcollectedUniques) :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) ((_tlIcollectedUniques) :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) -> _hdIcollectedUniques ++ _tlIcollectedUniques {-# INLINE rule686 #-} rule686 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule687 #-} rule687 = \ ((_hdIsemPragmasCollect) :: PragmaMap) ((_tlIsemPragmasCollect) :: PragmaMap) -> _hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect {-# INLINE rule688 #-} rule688 = \ ((_lhsIallAttrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIallAttrDecls {-# INLINE rule689 #-} rule689 = \ ((_lhsIallAttrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIallAttrs {-# INLINE rule690 #-} rule690 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule691 #-} rule691 = \ ((_lhsInts) :: Set NontermIdent) -> _lhsInts {-# INLINE rule692 #-} rule692 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule693 #-} rule693 = \ ((_lhsIallAttrDecls) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIallAttrDecls {-# INLINE rule694 #-} rule694 = \ ((_lhsIallAttrs) :: Map NontermIdent (Attributes, Attributes)) -> _lhsIallAttrs {-# INLINE rule695 #-} rule695 = \ ((_lhsIallFields) :: DataTypes) -> _lhsIallFields {-# INLINE rule696 #-} rule696 = \ ((_lhsInts) :: Set NontermIdent) -> _lhsInts {-# INLINE rule697 #-} rule697 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_SemAlts_Nil #-} sem_SemAlts_Nil :: T_SemAlts sem_SemAlts_Nil = T_SemAlts (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_SemAlts_v40 v40 = \ (T_SemAlts_vIn40 _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions) -> ( let _lhsOattrOrderCollect :: AttrOrderMap _lhsOattrOrderCollect = rule698 () _lhsOcollectedArounds :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ] _lhsOcollectedArounds = rule699 () _lhsOcollectedAugments :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ] _lhsOcollectedAugments = rule700 () _lhsOcollectedInsts :: [ (NontermIdent, ConstructorIdent, [Identifier]) ] _lhsOcollectedInsts = rule701 () _lhsOcollectedMerges :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ] _lhsOcollectedMerges = rule702 () _lhsOcollectedRules :: [ (NontermIdent, ConstructorIdent, RuleInfo)] _lhsOcollectedRules = rule703 () _lhsOcollectedSigs :: [ (NontermIdent, ConstructorIdent, SigInfo) ] _lhsOcollectedSigs = rule704 () _lhsOcollectedUniques :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ] _lhsOcollectedUniques = rule705 () _lhsOerrors :: Seq Error _lhsOerrors = rule706 () _lhsOsemPragmasCollect :: PragmaMap _lhsOsemPragmasCollect = rule707 () __result_ = T_SemAlts_vOut40 _lhsOattrOrderCollect _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedInsts _lhsOcollectedMerges _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _lhsOerrors _lhsOsemPragmasCollect in __result_ ) in C_SemAlts_s41 v40 {-# INLINE rule698 #-} rule698 = \ (_ :: ()) -> Map.empty {-# INLINE rule699 #-} rule699 = \ (_ :: ()) -> [] {-# INLINE rule700 #-} rule700 = \ (_ :: ()) -> [] {-# INLINE rule701 #-} rule701 = \ (_ :: ()) -> [] {-# INLINE rule702 #-} rule702 = \ (_ :: ()) -> [] {-# INLINE rule703 #-} rule703 = \ (_ :: ()) -> [] {-# INLINE rule704 #-} rule704 = \ (_ :: ()) -> [] {-# INLINE rule705 #-} rule705 = \ (_ :: ()) -> [] {-# INLINE rule706 #-} rule706 = \ (_ :: ()) -> Seq.empty {-# INLINE rule707 #-} rule707 = \ (_ :: ()) -> Map.empty -- SemDef ------------------------------------------------------ -- wrapper data Inh_SemDef = Inh_SemDef { options_Inh_SemDef :: (Options) } data Syn_SemDef = Syn_SemDef { aroundInfos_Syn_SemDef :: ([AroundInfo]), augmentInfos_Syn_SemDef :: ([AugmentInfo]), definedInsts_Syn_SemDef :: ([Identifier]), errors_Syn_SemDef :: (Seq Error), mergeInfos_Syn_SemDef :: ([MergeInfo]), orderDepsCollect_Syn_SemDef :: (Set Dependency), pragmaNamesCollect_Syn_SemDef :: ([Identifier]), ruleInfos_Syn_SemDef :: ([RuleInfo]), sigInfos_Syn_SemDef :: ([SigInfo]), uniqueInfos_Syn_SemDef :: ([UniqueInfo]) } {-# INLINABLE wrap_SemDef #-} wrap_SemDef :: T_SemDef -> Inh_SemDef -> (Syn_SemDef ) wrap_SemDef (T_SemDef act) (Inh_SemDef _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg43 = T_SemDef_vIn43 _lhsIoptions (T_SemDef_vOut43 _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos) <- return (inv_SemDef_s44 sem arg43) return (Syn_SemDef _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos) ) -- cata {-# NOINLINE sem_SemDef #-} sem_SemDef :: SemDef -> T_SemDef sem_SemDef ( Def pos_ mbName_ pattern_ rhs_ owrt_ pure_ eager_ ) = sem_SemDef_Def pos_ mbName_ ( sem_Pattern pattern_ ) rhs_ owrt_ pure_ eager_ sem_SemDef ( TypeDef pos_ ident_ tp_ ) = sem_SemDef_TypeDef pos_ ident_ tp_ sem_SemDef ( UniqueDef ident_ ref_ ) = sem_SemDef_UniqueDef ident_ ref_ sem_SemDef ( AugmentDef ident_ rhs_ ) = sem_SemDef_AugmentDef ident_ rhs_ sem_SemDef ( AroundDef ident_ rhs_ ) = sem_SemDef_AroundDef ident_ rhs_ sem_SemDef ( MergeDef target_ nt_ sources_ rhs_ ) = sem_SemDef_MergeDef target_ nt_ sources_ rhs_ sem_SemDef ( SemPragma names_ ) = sem_SemDef_SemPragma names_ sem_SemDef ( AttrOrderBefore before_ after_ ) = sem_SemDef_AttrOrderBefore before_ after_ -- semantic domain newtype T_SemDef = T_SemDef { attach_T_SemDef :: Identity (T_SemDef_s44 ) } newtype T_SemDef_s44 = C_SemDef_s44 { inv_SemDef_s44 :: (T_SemDef_v43 ) } data T_SemDef_s45 = C_SemDef_s45 type T_SemDef_v43 = (T_SemDef_vIn43 ) -> (T_SemDef_vOut43 ) data T_SemDef_vIn43 = T_SemDef_vIn43 (Options) data T_SemDef_vOut43 = T_SemDef_vOut43 ([AroundInfo]) ([AugmentInfo]) ([Identifier]) (Seq Error) ([MergeInfo]) (Set Dependency) ([Identifier]) ([RuleInfo]) ([SigInfo]) ([UniqueInfo]) {-# NOINLINE sem_SemDef_Def #-} sem_SemDef_Def :: (Pos) -> (Maybe Identifier) -> T_Pattern -> (Expression) -> (Bool) -> (Bool) -> (Bool) -> T_SemDef sem_SemDef_Def _ arg_mbName_ arg_pattern_ arg_rhs_ arg_owrt_ arg_pure_ arg_eager_ = T_SemDef (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_SemDef_v43 v43 = \ (T_SemDef_vIn43 _lhsIoptions) -> ( let _patternX32 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) (T_Pattern_vOut31 _patternIcopy _patternIdefinedAttrs _patternIdefinedInsts _patternIpatunder _patternIstpos) = inv_Pattern_s32 _patternX32 (T_Pattern_vIn31 ) _lhsOerrors :: Seq Error _lhsOerrors = rule708 _lhsIoptions arg_rhs_ _lhsOruleInfos :: [RuleInfo] _lhsOruleInfos = rule709 _patternIdefinedAttrs _patternIpatunder _patternIstpos arg_eager_ arg_mbName_ arg_owrt_ arg_pure_ arg_rhs_ _lhsOaroundInfos :: [AroundInfo] _lhsOaroundInfos = rule710 () _lhsOaugmentInfos :: [AugmentInfo] _lhsOaugmentInfos = rule711 () _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule712 _patternIdefinedInsts _lhsOmergeInfos :: [MergeInfo] _lhsOmergeInfos = rule713 () _lhsOorderDepsCollect :: Set Dependency _lhsOorderDepsCollect = rule714 () _lhsOpragmaNamesCollect :: [Identifier] _lhsOpragmaNamesCollect = rule715 () _lhsOsigInfos :: [SigInfo] _lhsOsigInfos = rule716 () _lhsOuniqueInfos :: [UniqueInfo] _lhsOuniqueInfos = rule717 () __result_ = T_SemDef_vOut43 _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule708 #-} {-# LINE 556 "src-ag/Transform.ag" #-} rule708 = \ ((_lhsIoptions) :: Options) rhs_ -> {-# LINE 556 "src-ag/Transform.ag" #-} if checkParseRhs _lhsIoptions then Seq.fromList $ checkRhs rhs_ else Seq.empty {-# LINE 5603 "dist/build/Transform.hs"#-} {-# INLINE rule709 #-} {-# LINE 1162 "src-ag/Transform.ag" #-} rule709 = \ ((_patternIdefinedAttrs) :: [AttrName]) ((_patternIpatunder) :: [AttrName]->Pattern) ((_patternIstpos) :: Pos) eager_ mbName_ owrt_ pure_ rhs_ -> {-# LINE 1162 "src-ag/Transform.ag" #-} [ (mbName_, _patternIpatunder, rhs_, _patternIdefinedAttrs, owrt_, show _patternIstpos, pure_, eager_) ] {-# LINE 5609 "dist/build/Transform.hs"#-} {-# INLINE rule710 #-} rule710 = \ (_ :: ()) -> [] {-# INLINE rule711 #-} rule711 = \ (_ :: ()) -> [] {-# INLINE rule712 #-} rule712 = \ ((_patternIdefinedInsts) :: [Identifier]) -> _patternIdefinedInsts {-# INLINE rule713 #-} rule713 = \ (_ :: ()) -> [] {-# INLINE rule714 #-} rule714 = \ (_ :: ()) -> Set.empty {-# INLINE rule715 #-} rule715 = \ (_ :: ()) -> [] {-# INLINE rule716 #-} rule716 = \ (_ :: ()) -> [] {-# INLINE rule717 #-} rule717 = \ (_ :: ()) -> [] {-# NOINLINE sem_SemDef_TypeDef #-} sem_SemDef_TypeDef :: (Pos) -> (Identifier) -> (Type) -> T_SemDef sem_SemDef_TypeDef arg_pos_ arg_ident_ arg_tp_ = T_SemDef (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_SemDef_v43 v43 = \ (T_SemDef_vIn43 _lhsIoptions) -> ( let _lhsOerrors :: Seq Error _lhsOerrors = rule718 _lhsIoptions arg_pos_ arg_tp_ _lhsOsigInfos :: [SigInfo] _lhsOsigInfos = rule719 arg_ident_ arg_tp_ _lhsOaroundInfos :: [AroundInfo] _lhsOaroundInfos = rule720 () _lhsOaugmentInfos :: [AugmentInfo] _lhsOaugmentInfos = rule721 () _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule722 () _lhsOmergeInfos :: [MergeInfo] _lhsOmergeInfos = rule723 () _lhsOorderDepsCollect :: Set Dependency _lhsOorderDepsCollect = rule724 () _lhsOpragmaNamesCollect :: [Identifier] _lhsOpragmaNamesCollect = rule725 () _lhsOruleInfos :: [RuleInfo] _lhsOruleInfos = rule726 () _lhsOuniqueInfos :: [UniqueInfo] _lhsOuniqueInfos = rule727 () __result_ = T_SemDef_vOut43 _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule718 #-} {-# LINE 563 "src-ag/Transform.ag" #-} rule718 = \ ((_lhsIoptions) :: Options) pos_ tp_ -> {-# LINE 563 "src-ag/Transform.ag" #-} if checkParseTy _lhsIoptions then case tp_ of Haskell s -> let ex = Expression pos_ tks tks = [tk] tk = HsToken s pos_ in Seq.fromList $ checkTy ex _ -> Seq.empty else Seq.empty {-# LINE 5676 "dist/build/Transform.hs"#-} {-# INLINE rule719 #-} {-# LINE 1165 "src-ag/Transform.ag" #-} rule719 = \ ident_ tp_ -> {-# LINE 1165 "src-ag/Transform.ag" #-} [ (ident_, tp_) ] {-# LINE 5682 "dist/build/Transform.hs"#-} {-# INLINE rule720 #-} rule720 = \ (_ :: ()) -> [] {-# INLINE rule721 #-} rule721 = \ (_ :: ()) -> [] {-# INLINE rule722 #-} rule722 = \ (_ :: ()) -> [] {-# INLINE rule723 #-} rule723 = \ (_ :: ()) -> [] {-# INLINE rule724 #-} rule724 = \ (_ :: ()) -> Set.empty {-# INLINE rule725 #-} rule725 = \ (_ :: ()) -> [] {-# INLINE rule726 #-} rule726 = \ (_ :: ()) -> [] {-# INLINE rule727 #-} rule727 = \ (_ :: ()) -> [] {-# NOINLINE sem_SemDef_UniqueDef #-} sem_SemDef_UniqueDef :: (Identifier) -> (Identifier) -> T_SemDef sem_SemDef_UniqueDef arg_ident_ arg_ref_ = T_SemDef (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_SemDef_v43 v43 = \ (T_SemDef_vIn43 _lhsIoptions) -> ( let _lhsOuniqueInfos :: [UniqueInfo] _lhsOuniqueInfos = rule728 arg_ident_ arg_ref_ _lhsOaroundInfos :: [AroundInfo] _lhsOaroundInfos = rule729 () _lhsOaugmentInfos :: [AugmentInfo] _lhsOaugmentInfos = rule730 () _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule731 () _lhsOerrors :: Seq Error _lhsOerrors = rule732 () _lhsOmergeInfos :: [MergeInfo] _lhsOmergeInfos = rule733 () _lhsOorderDepsCollect :: Set Dependency _lhsOorderDepsCollect = rule734 () _lhsOpragmaNamesCollect :: [Identifier] _lhsOpragmaNamesCollect = rule735 () _lhsOruleInfos :: [RuleInfo] _lhsOruleInfos = rule736 () _lhsOsigInfos :: [SigInfo] _lhsOsigInfos = rule737 () __result_ = T_SemDef_vOut43 _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule728 #-} {-# LINE 1168 "src-ag/Transform.ag" #-} rule728 = \ ident_ ref_ -> {-# LINE 1168 "src-ag/Transform.ag" #-} [ (ident_, ref_) ] {-# LINE 5742 "dist/build/Transform.hs"#-} {-# INLINE rule729 #-} rule729 = \ (_ :: ()) -> [] {-# INLINE rule730 #-} rule730 = \ (_ :: ()) -> [] {-# INLINE rule731 #-} rule731 = \ (_ :: ()) -> [] {-# INLINE rule732 #-} rule732 = \ (_ :: ()) -> Seq.empty {-# INLINE rule733 #-} rule733 = \ (_ :: ()) -> [] {-# INLINE rule734 #-} rule734 = \ (_ :: ()) -> Set.empty {-# INLINE rule735 #-} rule735 = \ (_ :: ()) -> [] {-# INLINE rule736 #-} rule736 = \ (_ :: ()) -> [] {-# INLINE rule737 #-} rule737 = \ (_ :: ()) -> [] {-# NOINLINE sem_SemDef_AugmentDef #-} sem_SemDef_AugmentDef :: (Identifier) -> (Expression) -> T_SemDef sem_SemDef_AugmentDef arg_ident_ arg_rhs_ = T_SemDef (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_SemDef_v43 v43 = \ (T_SemDef_vIn43 _lhsIoptions) -> ( let _lhsOaugmentInfos :: [AugmentInfo] _lhsOaugmentInfos = rule738 arg_ident_ arg_rhs_ _lhsOaroundInfos :: [AroundInfo] _lhsOaroundInfos = rule739 () _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule740 () _lhsOerrors :: Seq Error _lhsOerrors = rule741 () _lhsOmergeInfos :: [MergeInfo] _lhsOmergeInfos = rule742 () _lhsOorderDepsCollect :: Set Dependency _lhsOorderDepsCollect = rule743 () _lhsOpragmaNamesCollect :: [Identifier] _lhsOpragmaNamesCollect = rule744 () _lhsOruleInfos :: [RuleInfo] _lhsOruleInfos = rule745 () _lhsOsigInfos :: [SigInfo] _lhsOsigInfos = rule746 () _lhsOuniqueInfos :: [UniqueInfo] _lhsOuniqueInfos = rule747 () __result_ = T_SemDef_vOut43 _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule738 #-} {-# LINE 1171 "src-ag/Transform.ag" #-} rule738 = \ ident_ rhs_ -> {-# LINE 1171 "src-ag/Transform.ag" #-} [ (ident_, rhs_) ] {-# LINE 5805 "dist/build/Transform.hs"#-} {-# INLINE rule739 #-} rule739 = \ (_ :: ()) -> [] {-# INLINE rule740 #-} rule740 = \ (_ :: ()) -> [] {-# INLINE rule741 #-} rule741 = \ (_ :: ()) -> Seq.empty {-# INLINE rule742 #-} rule742 = \ (_ :: ()) -> [] {-# INLINE rule743 #-} rule743 = \ (_ :: ()) -> Set.empty {-# INLINE rule744 #-} rule744 = \ (_ :: ()) -> [] {-# INLINE rule745 #-} rule745 = \ (_ :: ()) -> [] {-# INLINE rule746 #-} rule746 = \ (_ :: ()) -> [] {-# INLINE rule747 #-} rule747 = \ (_ :: ()) -> [] {-# NOINLINE sem_SemDef_AroundDef #-} sem_SemDef_AroundDef :: (Identifier) -> (Expression) -> T_SemDef sem_SemDef_AroundDef arg_ident_ arg_rhs_ = T_SemDef (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_SemDef_v43 v43 = \ (T_SemDef_vIn43 _lhsIoptions) -> ( let _lhsOaroundInfos :: [AroundInfo] _lhsOaroundInfos = rule748 arg_ident_ arg_rhs_ _lhsOaugmentInfos :: [AugmentInfo] _lhsOaugmentInfos = rule749 () _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule750 () _lhsOerrors :: Seq Error _lhsOerrors = rule751 () _lhsOmergeInfos :: [MergeInfo] _lhsOmergeInfos = rule752 () _lhsOorderDepsCollect :: Set Dependency _lhsOorderDepsCollect = rule753 () _lhsOpragmaNamesCollect :: [Identifier] _lhsOpragmaNamesCollect = rule754 () _lhsOruleInfos :: [RuleInfo] _lhsOruleInfos = rule755 () _lhsOsigInfos :: [SigInfo] _lhsOsigInfos = rule756 () _lhsOuniqueInfos :: [UniqueInfo] _lhsOuniqueInfos = rule757 () __result_ = T_SemDef_vOut43 _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule748 #-} {-# LINE 1174 "src-ag/Transform.ag" #-} rule748 = \ ident_ rhs_ -> {-# LINE 1174 "src-ag/Transform.ag" #-} [ (ident_, rhs_) ] {-# LINE 5868 "dist/build/Transform.hs"#-} {-# INLINE rule749 #-} rule749 = \ (_ :: ()) -> [] {-# INLINE rule750 #-} rule750 = \ (_ :: ()) -> [] {-# INLINE rule751 #-} rule751 = \ (_ :: ()) -> Seq.empty {-# INLINE rule752 #-} rule752 = \ (_ :: ()) -> [] {-# INLINE rule753 #-} rule753 = \ (_ :: ()) -> Set.empty {-# INLINE rule754 #-} rule754 = \ (_ :: ()) -> [] {-# INLINE rule755 #-} rule755 = \ (_ :: ()) -> [] {-# INLINE rule756 #-} rule756 = \ (_ :: ()) -> [] {-# INLINE rule757 #-} rule757 = \ (_ :: ()) -> [] {-# NOINLINE sem_SemDef_MergeDef #-} sem_SemDef_MergeDef :: (Identifier) -> (Identifier) -> ([Identifier]) -> (Expression) -> T_SemDef sem_SemDef_MergeDef arg_target_ arg_nt_ arg_sources_ arg_rhs_ = T_SemDef (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_SemDef_v43 v43 = \ (T_SemDef_vIn43 _lhsIoptions) -> ( let _lhsOerrors :: Seq Error _lhsOerrors = rule758 _lhsIoptions arg_rhs_ _lhsOmergeInfos :: [MergeInfo] _lhsOmergeInfos = rule759 arg_nt_ arg_rhs_ arg_sources_ arg_target_ _lhsOaroundInfos :: [AroundInfo] _lhsOaroundInfos = rule760 () _lhsOaugmentInfos :: [AugmentInfo] _lhsOaugmentInfos = rule761 () _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule762 () _lhsOorderDepsCollect :: Set Dependency _lhsOorderDepsCollect = rule763 () _lhsOpragmaNamesCollect :: [Identifier] _lhsOpragmaNamesCollect = rule764 () _lhsOruleInfos :: [RuleInfo] _lhsOruleInfos = rule765 () _lhsOsigInfos :: [SigInfo] _lhsOsigInfos = rule766 () _lhsOuniqueInfos :: [UniqueInfo] _lhsOuniqueInfos = rule767 () __result_ = T_SemDef_vOut43 _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule758 #-} {-# LINE 556 "src-ag/Transform.ag" #-} rule758 = \ ((_lhsIoptions) :: Options) rhs_ -> {-# LINE 556 "src-ag/Transform.ag" #-} if checkParseRhs _lhsIoptions then Seq.fromList $ checkRhs rhs_ else Seq.empty {-# LINE 5933 "dist/build/Transform.hs"#-} {-# INLINE rule759 #-} {-# LINE 1177 "src-ag/Transform.ag" #-} rule759 = \ nt_ rhs_ sources_ target_ -> {-# LINE 1177 "src-ag/Transform.ag" #-} [ (target_, nt_, sources_, rhs_) ] {-# LINE 5939 "dist/build/Transform.hs"#-} {-# INLINE rule760 #-} rule760 = \ (_ :: ()) -> [] {-# INLINE rule761 #-} rule761 = \ (_ :: ()) -> [] {-# INLINE rule762 #-} rule762 = \ (_ :: ()) -> [] {-# INLINE rule763 #-} rule763 = \ (_ :: ()) -> Set.empty {-# INLINE rule764 #-} rule764 = \ (_ :: ()) -> [] {-# INLINE rule765 #-} rule765 = \ (_ :: ()) -> [] {-# INLINE rule766 #-} rule766 = \ (_ :: ()) -> [] {-# INLINE rule767 #-} rule767 = \ (_ :: ()) -> [] {-# NOINLINE sem_SemDef_SemPragma #-} sem_SemDef_SemPragma :: ([NontermIdent]) -> T_SemDef sem_SemDef_SemPragma arg_names_ = T_SemDef (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_SemDef_v43 v43 = \ (T_SemDef_vIn43 _lhsIoptions) -> ( let _lhsOpragmaNamesCollect :: [Identifier] _lhsOpragmaNamesCollect = rule768 arg_names_ _lhsOaroundInfos :: [AroundInfo] _lhsOaroundInfos = rule769 () _lhsOaugmentInfos :: [AugmentInfo] _lhsOaugmentInfos = rule770 () _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule771 () _lhsOerrors :: Seq Error _lhsOerrors = rule772 () _lhsOmergeInfos :: [MergeInfo] _lhsOmergeInfos = rule773 () _lhsOorderDepsCollect :: Set Dependency _lhsOorderDepsCollect = rule774 () _lhsOruleInfos :: [RuleInfo] _lhsOruleInfos = rule775 () _lhsOsigInfos :: [SigInfo] _lhsOsigInfos = rule776 () _lhsOuniqueInfos :: [UniqueInfo] _lhsOuniqueInfos = rule777 () __result_ = T_SemDef_vOut43 _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule768 #-} {-# LINE 898 "src-ag/Transform.ag" #-} rule768 = \ names_ -> {-# LINE 898 "src-ag/Transform.ag" #-} names_ {-# LINE 5999 "dist/build/Transform.hs"#-} {-# INLINE rule769 #-} rule769 = \ (_ :: ()) -> [] {-# INLINE rule770 #-} rule770 = \ (_ :: ()) -> [] {-# INLINE rule771 #-} rule771 = \ (_ :: ()) -> [] {-# INLINE rule772 #-} rule772 = \ (_ :: ()) -> Seq.empty {-# INLINE rule773 #-} rule773 = \ (_ :: ()) -> [] {-# INLINE rule774 #-} rule774 = \ (_ :: ()) -> Set.empty {-# INLINE rule775 #-} rule775 = \ (_ :: ()) -> [] {-# INLINE rule776 #-} rule776 = \ (_ :: ()) -> [] {-# INLINE rule777 #-} rule777 = \ (_ :: ()) -> [] {-# NOINLINE sem_SemDef_AttrOrderBefore #-} sem_SemDef_AttrOrderBefore :: ([Occurrence]) -> ([Occurrence]) -> T_SemDef sem_SemDef_AttrOrderBefore arg_before_ arg_after_ = T_SemDef (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_SemDef_v43 v43 = \ (T_SemDef_vIn43 _lhsIoptions) -> ( let _dependency = rule778 arg_after_ arg_before_ _lhsOorderDepsCollect :: Set Dependency _lhsOorderDepsCollect = rule779 _dependency _lhsOaroundInfos :: [AroundInfo] _lhsOaroundInfos = rule780 () _lhsOaugmentInfos :: [AugmentInfo] _lhsOaugmentInfos = rule781 () _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule782 () _lhsOerrors :: Seq Error _lhsOerrors = rule783 () _lhsOmergeInfos :: [MergeInfo] _lhsOmergeInfos = rule784 () _lhsOpragmaNamesCollect :: [Identifier] _lhsOpragmaNamesCollect = rule785 () _lhsOruleInfos :: [RuleInfo] _lhsOruleInfos = rule786 () _lhsOsigInfos :: [SigInfo] _lhsOsigInfos = rule787 () _lhsOuniqueInfos :: [UniqueInfo] _lhsOuniqueInfos = rule788 () __result_ = T_SemDef_vOut43 _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule778 #-} {-# LINE 929 "src-ag/Transform.ag" #-} rule778 = \ after_ before_ -> {-# LINE 929 "src-ag/Transform.ag" #-} [ Dependency b a | b <- before_, a <- after_ ] {-# LINE 6063 "dist/build/Transform.hs"#-} {-# INLINE rule779 #-} {-# LINE 930 "src-ag/Transform.ag" #-} rule779 = \ _dependency -> {-# LINE 930 "src-ag/Transform.ag" #-} Set.fromList _dependency {-# LINE 6069 "dist/build/Transform.hs"#-} {-# INLINE rule780 #-} rule780 = \ (_ :: ()) -> [] {-# INLINE rule781 #-} rule781 = \ (_ :: ()) -> [] {-# INLINE rule782 #-} rule782 = \ (_ :: ()) -> [] {-# INLINE rule783 #-} rule783 = \ (_ :: ()) -> Seq.empty {-# INLINE rule784 #-} rule784 = \ (_ :: ()) -> [] {-# INLINE rule785 #-} rule785 = \ (_ :: ()) -> [] {-# INLINE rule786 #-} rule786 = \ (_ :: ()) -> [] {-# INLINE rule787 #-} rule787 = \ (_ :: ()) -> [] {-# INLINE rule788 #-} rule788 = \ (_ :: ()) -> [] -- SemDefs ----------------------------------------------------- -- wrapper data Inh_SemDefs = Inh_SemDefs { options_Inh_SemDefs :: (Options) } data Syn_SemDefs = Syn_SemDefs { aroundInfos_Syn_SemDefs :: ([AroundInfo]), augmentInfos_Syn_SemDefs :: ([AugmentInfo]), definedInsts_Syn_SemDefs :: ([Identifier]), errors_Syn_SemDefs :: (Seq Error), mergeInfos_Syn_SemDefs :: ([MergeInfo]), orderDepsCollect_Syn_SemDefs :: (Set Dependency), pragmaNamesCollect_Syn_SemDefs :: ([Identifier]), ruleInfos_Syn_SemDefs :: ([RuleInfo]), sigInfos_Syn_SemDefs :: ([SigInfo]), uniqueInfos_Syn_SemDefs :: ([UniqueInfo]) } {-# INLINABLE wrap_SemDefs #-} wrap_SemDefs :: T_SemDefs -> Inh_SemDefs -> (Syn_SemDefs ) wrap_SemDefs (T_SemDefs act) (Inh_SemDefs _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg46 = T_SemDefs_vIn46 _lhsIoptions (T_SemDefs_vOut46 _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos) <- return (inv_SemDefs_s47 sem arg46) return (Syn_SemDefs _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos) ) -- cata {-# NOINLINE sem_SemDefs #-} sem_SemDefs :: SemDefs -> T_SemDefs sem_SemDefs list = Prelude.foldr sem_SemDefs_Cons sem_SemDefs_Nil (Prelude.map sem_SemDef list) -- semantic domain newtype T_SemDefs = T_SemDefs { attach_T_SemDefs :: Identity (T_SemDefs_s47 ) } newtype T_SemDefs_s47 = C_SemDefs_s47 { inv_SemDefs_s47 :: (T_SemDefs_v46 ) } data T_SemDefs_s48 = C_SemDefs_s48 type T_SemDefs_v46 = (T_SemDefs_vIn46 ) -> (T_SemDefs_vOut46 ) data T_SemDefs_vIn46 = T_SemDefs_vIn46 (Options) data T_SemDefs_vOut46 = T_SemDefs_vOut46 ([AroundInfo]) ([AugmentInfo]) ([Identifier]) (Seq Error) ([MergeInfo]) (Set Dependency) ([Identifier]) ([RuleInfo]) ([SigInfo]) ([UniqueInfo]) {-# NOINLINE sem_SemDefs_Cons #-} sem_SemDefs_Cons :: T_SemDef -> T_SemDefs -> T_SemDefs sem_SemDefs_Cons arg_hd_ arg_tl_ = T_SemDefs (return st47) where {-# NOINLINE st47 #-} st47 = let v46 :: T_SemDefs_v46 v46 = \ (T_SemDefs_vIn46 _lhsIoptions) -> ( let _hdX44 = Control.Monad.Identity.runIdentity (attach_T_SemDef (arg_hd_)) _tlX47 = Control.Monad.Identity.runIdentity (attach_T_SemDefs (arg_tl_)) (T_SemDef_vOut43 _hdIaroundInfos _hdIaugmentInfos _hdIdefinedInsts _hdIerrors _hdImergeInfos _hdIorderDepsCollect _hdIpragmaNamesCollect _hdIruleInfos _hdIsigInfos _hdIuniqueInfos) = inv_SemDef_s44 _hdX44 (T_SemDef_vIn43 _hdOoptions) (T_SemDefs_vOut46 _tlIaroundInfos _tlIaugmentInfos _tlIdefinedInsts _tlIerrors _tlImergeInfos _tlIorderDepsCollect _tlIpragmaNamesCollect _tlIruleInfos _tlIsigInfos _tlIuniqueInfos) = inv_SemDefs_s47 _tlX47 (T_SemDefs_vIn46 _tlOoptions) _lhsOaroundInfos :: [AroundInfo] _lhsOaroundInfos = rule789 _hdIaroundInfos _tlIaroundInfos _lhsOaugmentInfos :: [AugmentInfo] _lhsOaugmentInfos = rule790 _hdIaugmentInfos _tlIaugmentInfos _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule791 _hdIdefinedInsts _tlIdefinedInsts _lhsOerrors :: Seq Error _lhsOerrors = rule792 _hdIerrors _tlIerrors _lhsOmergeInfos :: [MergeInfo] _lhsOmergeInfos = rule793 _hdImergeInfos _tlImergeInfos _lhsOorderDepsCollect :: Set Dependency _lhsOorderDepsCollect = rule794 _hdIorderDepsCollect _tlIorderDepsCollect _lhsOpragmaNamesCollect :: [Identifier] _lhsOpragmaNamesCollect = rule795 _hdIpragmaNamesCollect _tlIpragmaNamesCollect _lhsOruleInfos :: [RuleInfo] _lhsOruleInfos = rule796 _hdIruleInfos _tlIruleInfos _lhsOsigInfos :: [SigInfo] _lhsOsigInfos = rule797 _hdIsigInfos _tlIsigInfos _lhsOuniqueInfos :: [UniqueInfo] _lhsOuniqueInfos = rule798 _hdIuniqueInfos _tlIuniqueInfos _hdOoptions = rule799 _lhsIoptions _tlOoptions = rule800 _lhsIoptions __result_ = T_SemDefs_vOut46 _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos in __result_ ) in C_SemDefs_s47 v46 {-# INLINE rule789 #-} rule789 = \ ((_hdIaroundInfos) :: [AroundInfo]) ((_tlIaroundInfos) :: [AroundInfo]) -> _hdIaroundInfos ++ _tlIaroundInfos {-# INLINE rule790 #-} rule790 = \ ((_hdIaugmentInfos) :: [AugmentInfo]) ((_tlIaugmentInfos) :: [AugmentInfo]) -> _hdIaugmentInfos ++ _tlIaugmentInfos {-# INLINE rule791 #-} rule791 = \ ((_hdIdefinedInsts) :: [Identifier]) ((_tlIdefinedInsts) :: [Identifier]) -> _hdIdefinedInsts ++ _tlIdefinedInsts {-# INLINE rule792 #-} rule792 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule793 #-} rule793 = \ ((_hdImergeInfos) :: [MergeInfo]) ((_tlImergeInfos) :: [MergeInfo]) -> _hdImergeInfos ++ _tlImergeInfos {-# INLINE rule794 #-} rule794 = \ ((_hdIorderDepsCollect) :: Set Dependency) ((_tlIorderDepsCollect) :: Set Dependency) -> _hdIorderDepsCollect `Set.union` _tlIorderDepsCollect {-# INLINE rule795 #-} rule795 = \ ((_hdIpragmaNamesCollect) :: [Identifier]) ((_tlIpragmaNamesCollect) :: [Identifier]) -> _hdIpragmaNamesCollect ++ _tlIpragmaNamesCollect {-# INLINE rule796 #-} rule796 = \ ((_hdIruleInfos) :: [RuleInfo]) ((_tlIruleInfos) :: [RuleInfo]) -> _hdIruleInfos ++ _tlIruleInfos {-# INLINE rule797 #-} rule797 = \ ((_hdIsigInfos) :: [SigInfo]) ((_tlIsigInfos) :: [SigInfo]) -> _hdIsigInfos ++ _tlIsigInfos {-# INLINE rule798 #-} rule798 = \ ((_hdIuniqueInfos) :: [UniqueInfo]) ((_tlIuniqueInfos) :: [UniqueInfo]) -> _hdIuniqueInfos ++ _tlIuniqueInfos {-# INLINE rule799 #-} rule799 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule800 #-} rule800 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_SemDefs_Nil #-} sem_SemDefs_Nil :: T_SemDefs sem_SemDefs_Nil = T_SemDefs (return st47) where {-# NOINLINE st47 #-} st47 = let v46 :: T_SemDefs_v46 v46 = \ (T_SemDefs_vIn46 _lhsIoptions) -> ( let _lhsOaroundInfos :: [AroundInfo] _lhsOaroundInfos = rule801 () _lhsOaugmentInfos :: [AugmentInfo] _lhsOaugmentInfos = rule802 () _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule803 () _lhsOerrors :: Seq Error _lhsOerrors = rule804 () _lhsOmergeInfos :: [MergeInfo] _lhsOmergeInfos = rule805 () _lhsOorderDepsCollect :: Set Dependency _lhsOorderDepsCollect = rule806 () _lhsOpragmaNamesCollect :: [Identifier] _lhsOpragmaNamesCollect = rule807 () _lhsOruleInfos :: [RuleInfo] _lhsOruleInfos = rule808 () _lhsOsigInfos :: [SigInfo] _lhsOsigInfos = rule809 () _lhsOuniqueInfos :: [UniqueInfo] _lhsOuniqueInfos = rule810 () __result_ = T_SemDefs_vOut46 _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos in __result_ ) in C_SemDefs_s47 v46 {-# INLINE rule801 #-} rule801 = \ (_ :: ()) -> [] {-# INLINE rule802 #-} rule802 = \ (_ :: ()) -> [] {-# INLINE rule803 #-} rule803 = \ (_ :: ()) -> [] {-# INLINE rule804 #-} rule804 = \ (_ :: ()) -> Seq.empty {-# INLINE rule805 #-} rule805 = \ (_ :: ()) -> [] {-# INLINE rule806 #-} rule806 = \ (_ :: ()) -> Set.empty {-# INLINE rule807 #-} rule807 = \ (_ :: ()) -> [] {-# INLINE rule808 #-} rule808 = \ (_ :: ()) -> [] {-# INLINE rule809 #-} rule809 = \ (_ :: ()) -> [] {-# INLINE rule810 #-} rule810 = \ (_ :: ()) -> [] uuagc-0.9.52.2/src-generated/CodeSyntaxDump.hs0000644000000000000000000015007713433540502017240 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module CodeSyntaxDump where {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 11 "dist/build/CodeSyntaxDump.hs" #-} {-# LINE 2 "src-ag/CodeSyntax.ag" #-} import Patterns import CommonTypes import Data.Map(Map) import Data.Set(Set) {-# LINE 19 "dist/build/CodeSyntaxDump.hs" #-} {-# LINE 5 "src-ag/CodeSyntaxDump.ag" #-} import Data.List import qualified Data.Map as Map import Pretty import PPUtil import CodeSyntax {-# LINE 30 "dist/build/CodeSyntaxDump.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 15 "src-ag/CodeSyntaxDump.ag" #-} ppChild :: (Identifier,Type,ChildKind) -> PP_Doc ppChild (nm,tp,_) = pp nm >#< "::" >#< pp (show tp) ppVertexMap :: Map Int (Identifier,Identifier,Maybe Type) -> PP_Doc ppVertexMap m = ppVList [ ppF (show k) $ ppAttr v | (k,v) <- Map.toList m ] ppAttr :: (Identifier,Identifier,Maybe Type) -> PP_Doc ppAttr (fld,nm,mTp) = pp fld >|< "." >|< pp nm >#< case mTp of Just tp -> pp "::" >#< show tp Nothing -> empty ppBool :: Bool -> PP_Doc ppBool True = pp "T" ppBool False = pp "F" ppMaybeShow :: Show a => Maybe a -> PP_Doc ppMaybeShow (Just x) = pp (show x) ppMaybeShow Nothing = pp "_" ppStrings :: [String] -> PP_Doc ppStrings = vlist {-# LINE 60 "dist/build/CodeSyntaxDump.hs" #-} -- CGrammar ---------------------------------------------------- -- wrapper data Inh_CGrammar = Inh_CGrammar { } data Syn_CGrammar = Syn_CGrammar { pp_Syn_CGrammar :: (PP_Doc) } {-# INLINABLE wrap_CGrammar #-} wrap_CGrammar :: T_CGrammar -> Inh_CGrammar -> (Syn_CGrammar ) wrap_CGrammar (T_CGrammar act) (Inh_CGrammar ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_CGrammar_vIn1 (T_CGrammar_vOut1 _lhsOpp) <- return (inv_CGrammar_s2 sem arg1) return (Syn_CGrammar _lhsOpp) ) -- cata {-# INLINE sem_CGrammar #-} sem_CGrammar :: CGrammar -> T_CGrammar sem_CGrammar ( CGrammar typeSyns_ derivings_ wrappers_ nonts_ pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ ) = sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ ( sem_CNonterminals nonts_ ) pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ -- semantic domain newtype T_CGrammar = T_CGrammar { attach_T_CGrammar :: Identity (T_CGrammar_s2 ) } newtype T_CGrammar_s2 = C_CGrammar_s2 { inv_CGrammar_s2 :: (T_CGrammar_v1 ) } data T_CGrammar_s3 = C_CGrammar_s3 type T_CGrammar_v1 = (T_CGrammar_vIn1 ) -> (T_CGrammar_vOut1 ) data T_CGrammar_vIn1 = T_CGrammar_vIn1 data T_CGrammar_vOut1 = T_CGrammar_vOut1 (PP_Doc) {-# NOINLINE sem_CGrammar_CGrammar #-} sem_CGrammar_CGrammar :: (TypeSyns) -> (Derivings) -> (Set NontermIdent) -> T_CNonterminals -> (PragmaMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> (Bool) -> T_CGrammar sem_CGrammar_CGrammar arg_typeSyns_ arg_derivings_ _ arg_nonts_ _ _ _ _ _ _ _ = T_CGrammar (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_CGrammar_v1 v1 = \ (T_CGrammar_vIn1 ) -> ( let _nontsX11 = Control.Monad.Identity.runIdentity (attach_T_CNonterminals (arg_nonts_)) (T_CNonterminals_vOut10 _nontsIpp _nontsIppL) = inv_CNonterminals_s11 _nontsX11 (T_CNonterminals_vIn10 ) _lhsOpp :: PP_Doc _lhsOpp = rule0 _nontsIppL arg_derivings_ arg_typeSyns_ __result_ = T_CGrammar_vOut1 _lhsOpp in __result_ ) in C_CGrammar_s2 v1 {-# INLINE rule0 #-} {-# LINE 47 "src-ag/CodeSyntaxDump.ag" #-} rule0 = \ ((_nontsIppL) :: [PP_Doc]) derivings_ typeSyns_ -> {-# LINE 47 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["CGrammar","CGrammar"] [] [ ppF "typeSyns" $ ppAssocL typeSyns_ , ppF "derivings" $ ppMap $ derivings_ , ppF "nonts" $ ppVList _nontsIppL ] [] {-# LINE 114 "dist/build/CodeSyntaxDump.hs"#-} -- CInterface -------------------------------------------------- -- wrapper data Inh_CInterface = Inh_CInterface { } data Syn_CInterface = Syn_CInterface { pp_Syn_CInterface :: (PP_Doc) } {-# INLINABLE wrap_CInterface #-} wrap_CInterface :: T_CInterface -> Inh_CInterface -> (Syn_CInterface ) wrap_CInterface (T_CInterface act) (Inh_CInterface ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_CInterface_vIn4 (T_CInterface_vOut4 _lhsOpp) <- return (inv_CInterface_s5 sem arg4) return (Syn_CInterface _lhsOpp) ) -- cata {-# INLINE sem_CInterface #-} sem_CInterface :: CInterface -> T_CInterface sem_CInterface ( CInterface seg_ ) = sem_CInterface_CInterface ( sem_CSegments seg_ ) -- semantic domain newtype T_CInterface = T_CInterface { attach_T_CInterface :: Identity (T_CInterface_s5 ) } newtype T_CInterface_s5 = C_CInterface_s5 { inv_CInterface_s5 :: (T_CInterface_v4 ) } data T_CInterface_s6 = C_CInterface_s6 type T_CInterface_v4 = (T_CInterface_vIn4 ) -> (T_CInterface_vOut4 ) data T_CInterface_vIn4 = T_CInterface_vIn4 data T_CInterface_vOut4 = T_CInterface_vOut4 (PP_Doc) {-# NOINLINE sem_CInterface_CInterface #-} sem_CInterface_CInterface :: T_CSegments -> T_CInterface sem_CInterface_CInterface arg_seg_ = T_CInterface (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_CInterface_v4 v4 = \ (T_CInterface_vIn4 ) -> ( let _segX26 = Control.Monad.Identity.runIdentity (attach_T_CSegments (arg_seg_)) (T_CSegments_vOut25 _segIpp _segIppL) = inv_CSegments_s26 _segX26 (T_CSegments_vIn25 ) _lhsOpp :: PP_Doc _lhsOpp = rule1 _segIppL __result_ = T_CInterface_vOut4 _lhsOpp in __result_ ) in C_CInterface_s5 v4 {-# INLINE rule1 #-} {-# LINE 57 "src-ag/CodeSyntaxDump.ag" #-} rule1 = \ ((_segIppL) :: [PP_Doc]) -> {-# LINE 57 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["CInterface","CInterface"] [] [ppF "seg" $ ppVList _segIppL] [] {-# LINE 165 "dist/build/CodeSyntaxDump.hs"#-} -- CNonterminal ------------------------------------------------ -- wrapper data Inh_CNonterminal = Inh_CNonterminal { } data Syn_CNonterminal = Syn_CNonterminal { pp_Syn_CNonterminal :: (PP_Doc) } {-# INLINABLE wrap_CNonterminal #-} wrap_CNonterminal :: T_CNonterminal -> Inh_CNonterminal -> (Syn_CNonterminal ) wrap_CNonterminal (T_CNonterminal act) (Inh_CNonterminal ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_CNonterminal_vIn7 (T_CNonterminal_vOut7 _lhsOpp) <- return (inv_CNonterminal_s8 sem arg7) return (Syn_CNonterminal _lhsOpp) ) -- cata {-# INLINE sem_CNonterminal #-} sem_CNonterminal :: CNonterminal -> T_CNonterminal sem_CNonterminal ( CNonterminal nt_ params_ inh_ syn_ prods_ inter_ ) = sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ ( sem_CProductions prods_ ) ( sem_CInterface inter_ ) -- semantic domain newtype T_CNonterminal = T_CNonterminal { attach_T_CNonterminal :: Identity (T_CNonterminal_s8 ) } newtype T_CNonterminal_s8 = C_CNonterminal_s8 { inv_CNonterminal_s8 :: (T_CNonterminal_v7 ) } data T_CNonterminal_s9 = C_CNonterminal_s9 type T_CNonterminal_v7 = (T_CNonterminal_vIn7 ) -> (T_CNonterminal_vOut7 ) data T_CNonterminal_vIn7 = T_CNonterminal_vIn7 data T_CNonterminal_vOut7 = T_CNonterminal_vOut7 (PP_Doc) {-# NOINLINE sem_CNonterminal_CNonterminal #-} sem_CNonterminal_CNonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_CProductions -> T_CInterface -> T_CNonterminal sem_CNonterminal_CNonterminal arg_nt_ arg_params_ arg_inh_ arg_syn_ arg_prods_ arg_inter_ = T_CNonterminal (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_CNonterminal_v7 v7 = \ (T_CNonterminal_vIn7 ) -> ( let _prodsX17 = Control.Monad.Identity.runIdentity (attach_T_CProductions (arg_prods_)) _interX5 = Control.Monad.Identity.runIdentity (attach_T_CInterface (arg_inter_)) (T_CProductions_vOut16 _prodsIpp _prodsIppL) = inv_CProductions_s17 _prodsX17 (T_CProductions_vIn16 ) (T_CInterface_vOut4 _interIpp) = inv_CInterface_s5 _interX5 (T_CInterface_vIn4 ) _lhsOpp :: PP_Doc _lhsOpp = rule2 _interIpp _prodsIppL arg_inh_ arg_nt_ arg_params_ arg_syn_ __result_ = T_CNonterminal_vOut7 _lhsOpp in __result_ ) in C_CNonterminal_s8 v7 {-# INLINE rule2 #-} {-# LINE 54 "src-ag/CodeSyntaxDump.ag" #-} rule2 = \ ((_interIpp) :: PP_Doc) ((_prodsIppL) :: [PP_Doc]) inh_ nt_ params_ syn_ -> {-# LINE 54 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["CNonterminal","CNonterminal"] (pp nt_ : map pp params_) [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "prods" $ ppVList _prodsIppL, ppF "inter" _interIpp] [] {-# LINE 218 "dist/build/CodeSyntaxDump.hs"#-} -- CNonterminals ----------------------------------------------- -- wrapper data Inh_CNonterminals = Inh_CNonterminals { } data Syn_CNonterminals = Syn_CNonterminals { pp_Syn_CNonterminals :: (PP_Doc), ppL_Syn_CNonterminals :: ([PP_Doc]) } {-# INLINABLE wrap_CNonterminals #-} wrap_CNonterminals :: T_CNonterminals -> Inh_CNonterminals -> (Syn_CNonterminals ) wrap_CNonterminals (T_CNonterminals act) (Inh_CNonterminals ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg10 = T_CNonterminals_vIn10 (T_CNonterminals_vOut10 _lhsOpp _lhsOppL) <- return (inv_CNonterminals_s11 sem arg10) return (Syn_CNonterminals _lhsOpp _lhsOppL) ) -- cata {-# NOINLINE sem_CNonterminals #-} sem_CNonterminals :: CNonterminals -> T_CNonterminals sem_CNonterminals list = Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list) -- semantic domain newtype T_CNonterminals = T_CNonterminals { attach_T_CNonterminals :: Identity (T_CNonterminals_s11 ) } newtype T_CNonterminals_s11 = C_CNonterminals_s11 { inv_CNonterminals_s11 :: (T_CNonterminals_v10 ) } data T_CNonterminals_s12 = C_CNonterminals_s12 type T_CNonterminals_v10 = (T_CNonterminals_vIn10 ) -> (T_CNonterminals_vOut10 ) data T_CNonterminals_vIn10 = T_CNonterminals_vIn10 data T_CNonterminals_vOut10 = T_CNonterminals_vOut10 (PP_Doc) ([PP_Doc]) {-# NOINLINE sem_CNonterminals_Cons #-} sem_CNonterminals_Cons :: T_CNonterminal -> T_CNonterminals -> T_CNonterminals sem_CNonterminals_Cons arg_hd_ arg_tl_ = T_CNonterminals (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_CNonterminals_v10 v10 = \ (T_CNonterminals_vIn10 ) -> ( let _hdX8 = Control.Monad.Identity.runIdentity (attach_T_CNonterminal (arg_hd_)) _tlX11 = Control.Monad.Identity.runIdentity (attach_T_CNonterminals (arg_tl_)) (T_CNonterminal_vOut7 _hdIpp) = inv_CNonterminal_s8 _hdX8 (T_CNonterminal_vIn7 ) (T_CNonterminals_vOut10 _tlIpp _tlIppL) = inv_CNonterminals_s11 _tlX11 (T_CNonterminals_vIn10 ) _lhsOppL :: [PP_Doc] _lhsOppL = rule3 _hdIpp _tlIppL _lhsOpp :: PP_Doc _lhsOpp = rule4 _hdIpp _tlIpp __result_ = T_CNonterminals_vOut10 _lhsOpp _lhsOppL in __result_ ) in C_CNonterminals_s11 v10 {-# INLINE rule3 #-} {-# LINE 102 "src-ag/CodeSyntaxDump.ag" #-} rule3 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> {-# LINE 102 "src-ag/CodeSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 273 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule4 #-} rule4 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) -> _hdIpp >-< _tlIpp {-# NOINLINE sem_CNonterminals_Nil #-} sem_CNonterminals_Nil :: T_CNonterminals sem_CNonterminals_Nil = T_CNonterminals (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_CNonterminals_v10 v10 = \ (T_CNonterminals_vIn10 ) -> ( let _lhsOppL :: [PP_Doc] _lhsOppL = rule5 () _lhsOpp :: PP_Doc _lhsOpp = rule6 () __result_ = T_CNonterminals_vOut10 _lhsOpp _lhsOppL in __result_ ) in C_CNonterminals_s11 v10 {-# INLINE rule5 #-} {-# LINE 103 "src-ag/CodeSyntaxDump.ag" #-} rule5 = \ (_ :: ()) -> {-# LINE 103 "src-ag/CodeSyntaxDump.ag" #-} [] {-# LINE 296 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule6 #-} rule6 = \ (_ :: ()) -> empty -- CProduction ------------------------------------------------- -- wrapper data Inh_CProduction = Inh_CProduction { } data Syn_CProduction = Syn_CProduction { pp_Syn_CProduction :: (PP_Doc) } {-# INLINABLE wrap_CProduction #-} wrap_CProduction :: T_CProduction -> Inh_CProduction -> (Syn_CProduction ) wrap_CProduction (T_CProduction act) (Inh_CProduction ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg13 = T_CProduction_vIn13 (T_CProduction_vOut13 _lhsOpp) <- return (inv_CProduction_s14 sem arg13) return (Syn_CProduction _lhsOpp) ) -- cata {-# INLINE sem_CProduction #-} sem_CProduction :: CProduction -> T_CProduction sem_CProduction ( CProduction con_ visits_ children_ terminals_ ) = sem_CProduction_CProduction con_ ( sem_CVisits visits_ ) children_ terminals_ -- semantic domain newtype T_CProduction = T_CProduction { attach_T_CProduction :: Identity (T_CProduction_s14 ) } newtype T_CProduction_s14 = C_CProduction_s14 { inv_CProduction_s14 :: (T_CProduction_v13 ) } data T_CProduction_s15 = C_CProduction_s15 type T_CProduction_v13 = (T_CProduction_vIn13 ) -> (T_CProduction_vOut13 ) data T_CProduction_vIn13 = T_CProduction_vIn13 data T_CProduction_vOut13 = T_CProduction_vOut13 (PP_Doc) {-# NOINLINE sem_CProduction_CProduction #-} sem_CProduction_CProduction :: (ConstructorIdent) -> T_CVisits -> ([(Identifier,Type,ChildKind)]) -> ([Identifier]) -> T_CProduction sem_CProduction_CProduction arg_con_ arg_visits_ arg_children_ arg_terminals_ = T_CProduction (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_CProduction_v13 v13 = \ (T_CProduction_vIn13 ) -> ( let _visitsX32 = Control.Monad.Identity.runIdentity (attach_T_CVisits (arg_visits_)) (T_CVisits_vOut31 _visitsIpp _visitsIppL) = inv_CVisits_s32 _visitsX32 (T_CVisits_vIn31 ) _lhsOpp :: PP_Doc _lhsOpp = rule7 _visitsIppL arg_children_ arg_con_ arg_terminals_ __result_ = T_CProduction_vOut13 _lhsOpp in __result_ ) in C_CProduction_s14 v13 {-# INLINE rule7 #-} {-# LINE 63 "src-ag/CodeSyntaxDump.ag" #-} rule7 = \ ((_visitsIppL) :: [PP_Doc]) children_ con_ terminals_ -> {-# LINE 63 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["CProduction","CProduction"] [pp con_] [ppF "visits" $ ppVList _visitsIppL, ppF "children" $ ppVList (map ppChild children_),ppF "terminals" $ ppVList (map ppShow terminals_)] [] {-# LINE 350 "dist/build/CodeSyntaxDump.hs"#-} -- CProductions ------------------------------------------------ -- wrapper data Inh_CProductions = Inh_CProductions { } data Syn_CProductions = Syn_CProductions { pp_Syn_CProductions :: (PP_Doc), ppL_Syn_CProductions :: ([PP_Doc]) } {-# INLINABLE wrap_CProductions #-} wrap_CProductions :: T_CProductions -> Inh_CProductions -> (Syn_CProductions ) wrap_CProductions (T_CProductions act) (Inh_CProductions ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg16 = T_CProductions_vIn16 (T_CProductions_vOut16 _lhsOpp _lhsOppL) <- return (inv_CProductions_s17 sem arg16) return (Syn_CProductions _lhsOpp _lhsOppL) ) -- cata {-# NOINLINE sem_CProductions #-} sem_CProductions :: CProductions -> T_CProductions sem_CProductions list = Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list) -- semantic domain newtype T_CProductions = T_CProductions { attach_T_CProductions :: Identity (T_CProductions_s17 ) } newtype T_CProductions_s17 = C_CProductions_s17 { inv_CProductions_s17 :: (T_CProductions_v16 ) } data T_CProductions_s18 = C_CProductions_s18 type T_CProductions_v16 = (T_CProductions_vIn16 ) -> (T_CProductions_vOut16 ) data T_CProductions_vIn16 = T_CProductions_vIn16 data T_CProductions_vOut16 = T_CProductions_vOut16 (PP_Doc) ([PP_Doc]) {-# NOINLINE sem_CProductions_Cons #-} sem_CProductions_Cons :: T_CProduction -> T_CProductions -> T_CProductions sem_CProductions_Cons arg_hd_ arg_tl_ = T_CProductions (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_CProductions_v16 v16 = \ (T_CProductions_vIn16 ) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_CProduction (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_CProductions (arg_tl_)) (T_CProduction_vOut13 _hdIpp) = inv_CProduction_s14 _hdX14 (T_CProduction_vIn13 ) (T_CProductions_vOut16 _tlIpp _tlIppL) = inv_CProductions_s17 _tlX17 (T_CProductions_vIn16 ) _lhsOppL :: [PP_Doc] _lhsOppL = rule8 _hdIpp _tlIppL _lhsOpp :: PP_Doc _lhsOpp = rule9 _hdIpp _tlIpp __result_ = T_CProductions_vOut16 _lhsOpp _lhsOppL in __result_ ) in C_CProductions_s17 v16 {-# INLINE rule8 #-} {-# LINE 94 "src-ag/CodeSyntaxDump.ag" #-} rule8 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> {-# LINE 94 "src-ag/CodeSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 405 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule9 #-} rule9 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) -> _hdIpp >-< _tlIpp {-# NOINLINE sem_CProductions_Nil #-} sem_CProductions_Nil :: T_CProductions sem_CProductions_Nil = T_CProductions (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_CProductions_v16 v16 = \ (T_CProductions_vIn16 ) -> ( let _lhsOppL :: [PP_Doc] _lhsOppL = rule10 () _lhsOpp :: PP_Doc _lhsOpp = rule11 () __result_ = T_CProductions_vOut16 _lhsOpp _lhsOppL in __result_ ) in C_CProductions_s17 v16 {-# INLINE rule10 #-} {-# LINE 95 "src-ag/CodeSyntaxDump.ag" #-} rule10 = \ (_ :: ()) -> {-# LINE 95 "src-ag/CodeSyntaxDump.ag" #-} [] {-# LINE 428 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule11 #-} rule11 = \ (_ :: ()) -> empty -- CRule ------------------------------------------------------- -- wrapper data Inh_CRule = Inh_CRule { } data Syn_CRule = Syn_CRule { pp_Syn_CRule :: (PP_Doc) } {-# INLINABLE wrap_CRule #-} wrap_CRule :: T_CRule -> Inh_CRule -> (Syn_CRule ) wrap_CRule (T_CRule act) (Inh_CRule ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg19 = T_CRule_vIn19 (T_CRule_vOut19 _lhsOpp) <- return (inv_CRule_s20 sem arg19) return (Syn_CRule _lhsOpp) ) -- cata {-# NOINLINE sem_CRule #-} sem_CRule :: CRule -> T_CRule sem_CRule ( CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ pattern_ rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ ) = sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ ( sem_Pattern pattern_ ) rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ sem_CRule ( CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ ) = sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ -- semantic domain newtype T_CRule = T_CRule { attach_T_CRule :: Identity (T_CRule_s20 ) } newtype T_CRule_s20 = C_CRule_s20 { inv_CRule_s20 :: (T_CRule_v19 ) } data T_CRule_s21 = C_CRule_s21 type T_CRule_v19 = (T_CRule_vIn19 ) -> (T_CRule_vOut19 ) data T_CRule_vIn19 = T_CRule_vIn19 data T_CRule_vOut19 = T_CRule_vOut19 (PP_Doc) {-# NOINLINE sem_CRule_CRule #-} sem_CRule_CRule :: (Identifier) -> (Bool) -> (Bool) -> (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> (Maybe NontermIdent) -> (Maybe Type) -> T_Pattern -> ([String]) -> (Map Int (Identifier,Identifier,Maybe Type)) -> (Bool) -> (String) -> (Set (Identifier, Identifier)) -> (Bool) -> (Maybe Identifier) -> T_CRule sem_CRule_CRule arg_name_ arg_isIn_ arg_hasCode_ arg_nt_ arg_con_ arg_field_ arg_childnt_ arg_tp_ arg_pattern_ arg_rhs_ arg_defines_ arg_owrt_ arg_origin_ _ _ _ = T_CRule (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_CRule_v19 v19 = \ (T_CRule_vIn19 ) -> ( let _patternX35 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) (T_Pattern_vOut34 _patternIcopy _patternIpp) = inv_Pattern_s35 _patternX35 (T_Pattern_vIn34 ) _lhsOpp :: PP_Doc _lhsOpp = rule12 _patternIpp arg_childnt_ arg_con_ arg_defines_ arg_field_ arg_hasCode_ arg_isIn_ arg_name_ arg_nt_ arg_origin_ arg_owrt_ arg_rhs_ arg_tp_ __result_ = T_CRule_vOut19 _lhsOpp in __result_ ) in C_CRule_s20 v19 {-# INLINE rule12 #-} {-# LINE 69 "src-ag/CodeSyntaxDump.ag" #-} rule12 = \ ((_patternIpp) :: PP_Doc) childnt_ con_ defines_ field_ hasCode_ isIn_ name_ nt_ origin_ owrt_ rhs_ tp_ -> {-# LINE 69 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["CRule","CRule"] [pp name_] [ppF "isIn" $ ppBool isIn_, ppF "hasCode" $ ppBool hasCode_, ppF "nt" $ pp nt_, ppF "con" $ pp con_, ppF "field" $ pp field_, ppF "childnt" $ ppMaybeShow childnt_, ppF "tp" $ ppMaybeShow tp_, ppF "pattern" $ if isIn_ then pp "" else _patternIpp, ppF "rhs" $ ppStrings rhs_, ppF "defines" $ ppVertexMap defines_, ppF "owrt" $ ppBool owrt_, ppF "origin" $ pp origin_] [] {-# LINE 483 "dist/build/CodeSyntaxDump.hs"#-} {-# NOINLINE sem_CRule_CChildVisit #-} sem_CRule_CChildVisit :: (Identifier) -> (NontermIdent) -> (Int) -> (Attributes) -> (Attributes) -> (Bool) -> T_CRule sem_CRule_CChildVisit arg_name_ arg_nt_ arg_nr_ arg_inh_ arg_syn_ arg_isLast_ = T_CRule (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_CRule_v19 v19 = \ (T_CRule_vIn19 ) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule13 arg_inh_ arg_isLast_ arg_name_ arg_nr_ arg_nt_ arg_syn_ __result_ = T_CRule_vOut19 _lhsOpp in __result_ ) in C_CRule_s20 v19 {-# INLINE rule13 #-} {-# LINE 70 "src-ag/CodeSyntaxDump.ag" #-} rule13 = \ inh_ isLast_ name_ nr_ nt_ syn_ -> {-# LINE 70 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["CRule","CChildVisit"] [pp name_] [ppF "nt" $ pp nt_, ppF "nr" $ ppShow nr_, ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "last" $ ppBool isLast_] [] {-# LINE 501 "dist/build/CodeSyntaxDump.hs"#-} -- CSegment ---------------------------------------------------- -- wrapper data Inh_CSegment = Inh_CSegment { } data Syn_CSegment = Syn_CSegment { pp_Syn_CSegment :: (PP_Doc) } {-# INLINABLE wrap_CSegment #-} wrap_CSegment :: T_CSegment -> Inh_CSegment -> (Syn_CSegment ) wrap_CSegment (T_CSegment act) (Inh_CSegment ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg22 = T_CSegment_vIn22 (T_CSegment_vOut22 _lhsOpp) <- return (inv_CSegment_s23 sem arg22) return (Syn_CSegment _lhsOpp) ) -- cata {-# INLINE sem_CSegment #-} sem_CSegment :: CSegment -> T_CSegment sem_CSegment ( CSegment inh_ syn_ ) = sem_CSegment_CSegment inh_ syn_ -- semantic domain newtype T_CSegment = T_CSegment { attach_T_CSegment :: Identity (T_CSegment_s23 ) } newtype T_CSegment_s23 = C_CSegment_s23 { inv_CSegment_s23 :: (T_CSegment_v22 ) } data T_CSegment_s24 = C_CSegment_s24 type T_CSegment_v22 = (T_CSegment_vIn22 ) -> (T_CSegment_vOut22 ) data T_CSegment_vIn22 = T_CSegment_vIn22 data T_CSegment_vOut22 = T_CSegment_vOut22 (PP_Doc) {-# NOINLINE sem_CSegment_CSegment #-} sem_CSegment_CSegment :: (Attributes) -> (Attributes) -> T_CSegment sem_CSegment_CSegment arg_inh_ arg_syn_ = T_CSegment (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_CSegment_v22 v22 = \ (T_CSegment_vIn22 ) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule14 arg_inh_ arg_syn_ __result_ = T_CSegment_vOut22 _lhsOpp in __result_ ) in C_CSegment_s23 v22 {-# INLINE rule14 #-} {-# LINE 60 "src-ag/CodeSyntaxDump.ag" #-} rule14 = \ inh_ syn_ -> {-# LINE 60 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["CSegment","CSegment"] [] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_] [] {-# LINE 550 "dist/build/CodeSyntaxDump.hs"#-} -- CSegments --------------------------------------------------- -- wrapper data Inh_CSegments = Inh_CSegments { } data Syn_CSegments = Syn_CSegments { pp_Syn_CSegments :: (PP_Doc), ppL_Syn_CSegments :: ([PP_Doc]) } {-# INLINABLE wrap_CSegments #-} wrap_CSegments :: T_CSegments -> Inh_CSegments -> (Syn_CSegments ) wrap_CSegments (T_CSegments act) (Inh_CSegments ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg25 = T_CSegments_vIn25 (T_CSegments_vOut25 _lhsOpp _lhsOppL) <- return (inv_CSegments_s26 sem arg25) return (Syn_CSegments _lhsOpp _lhsOppL) ) -- cata {-# NOINLINE sem_CSegments #-} sem_CSegments :: CSegments -> T_CSegments sem_CSegments list = Prelude.foldr sem_CSegments_Cons sem_CSegments_Nil (Prelude.map sem_CSegment list) -- semantic domain newtype T_CSegments = T_CSegments { attach_T_CSegments :: Identity (T_CSegments_s26 ) } newtype T_CSegments_s26 = C_CSegments_s26 { inv_CSegments_s26 :: (T_CSegments_v25 ) } data T_CSegments_s27 = C_CSegments_s27 type T_CSegments_v25 = (T_CSegments_vIn25 ) -> (T_CSegments_vOut25 ) data T_CSegments_vIn25 = T_CSegments_vIn25 data T_CSegments_vOut25 = T_CSegments_vOut25 (PP_Doc) ([PP_Doc]) {-# NOINLINE sem_CSegments_Cons #-} sem_CSegments_Cons :: T_CSegment -> T_CSegments -> T_CSegments sem_CSegments_Cons arg_hd_ arg_tl_ = T_CSegments (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_CSegments_v25 v25 = \ (T_CSegments_vIn25 ) -> ( let _hdX23 = Control.Monad.Identity.runIdentity (attach_T_CSegment (arg_hd_)) _tlX26 = Control.Monad.Identity.runIdentity (attach_T_CSegments (arg_tl_)) (T_CSegment_vOut22 _hdIpp) = inv_CSegment_s23 _hdX23 (T_CSegment_vIn22 ) (T_CSegments_vOut25 _tlIpp _tlIppL) = inv_CSegments_s26 _tlX26 (T_CSegments_vIn25 ) _lhsOppL :: [PP_Doc] _lhsOppL = rule15 _hdIpp _tlIppL _lhsOpp :: PP_Doc _lhsOpp = rule16 _hdIpp _tlIpp __result_ = T_CSegments_vOut25 _lhsOpp _lhsOppL in __result_ ) in C_CSegments_s26 v25 {-# INLINE rule15 #-} {-# LINE 98 "src-ag/CodeSyntaxDump.ag" #-} rule15 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> {-# LINE 98 "src-ag/CodeSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 605 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule16 #-} rule16 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) -> _hdIpp >-< _tlIpp {-# NOINLINE sem_CSegments_Nil #-} sem_CSegments_Nil :: T_CSegments sem_CSegments_Nil = T_CSegments (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_CSegments_v25 v25 = \ (T_CSegments_vIn25 ) -> ( let _lhsOppL :: [PP_Doc] _lhsOppL = rule17 () _lhsOpp :: PP_Doc _lhsOpp = rule18 () __result_ = T_CSegments_vOut25 _lhsOpp _lhsOppL in __result_ ) in C_CSegments_s26 v25 {-# INLINE rule17 #-} {-# LINE 99 "src-ag/CodeSyntaxDump.ag" #-} rule17 = \ (_ :: ()) -> {-# LINE 99 "src-ag/CodeSyntaxDump.ag" #-} [] {-# LINE 628 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule18 #-} rule18 = \ (_ :: ()) -> empty -- CVisit ------------------------------------------------------ -- wrapper data Inh_CVisit = Inh_CVisit { } data Syn_CVisit = Syn_CVisit { pp_Syn_CVisit :: (PP_Doc) } {-# INLINABLE wrap_CVisit #-} wrap_CVisit :: T_CVisit -> Inh_CVisit -> (Syn_CVisit ) wrap_CVisit (T_CVisit act) (Inh_CVisit ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg28 = T_CVisit_vIn28 (T_CVisit_vOut28 _lhsOpp) <- return (inv_CVisit_s29 sem arg28) return (Syn_CVisit _lhsOpp) ) -- cata {-# INLINE sem_CVisit #-} sem_CVisit :: CVisit -> T_CVisit sem_CVisit ( CVisit inh_ syn_ vss_ intra_ ordered_ ) = sem_CVisit_CVisit inh_ syn_ ( sem_Sequence vss_ ) ( sem_Sequence intra_ ) ordered_ -- semantic domain newtype T_CVisit = T_CVisit { attach_T_CVisit :: Identity (T_CVisit_s29 ) } newtype T_CVisit_s29 = C_CVisit_s29 { inv_CVisit_s29 :: (T_CVisit_v28 ) } data T_CVisit_s30 = C_CVisit_s30 type T_CVisit_v28 = (T_CVisit_vIn28 ) -> (T_CVisit_vOut28 ) data T_CVisit_vIn28 = T_CVisit_vIn28 data T_CVisit_vOut28 = T_CVisit_vOut28 (PP_Doc) {-# NOINLINE sem_CVisit_CVisit #-} sem_CVisit_CVisit :: (Attributes) -> (Attributes) -> T_Sequence -> T_Sequence -> (Bool) -> T_CVisit sem_CVisit_CVisit arg_inh_ arg_syn_ arg_vss_ arg_intra_ arg_ordered_ = T_CVisit (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_CVisit_v28 v28 = \ (T_CVisit_vIn28 ) -> ( let _vssX41 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_vss_)) _intraX41 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_intra_)) (T_Sequence_vOut40 _vssIppL) = inv_Sequence_s41 _vssX41 (T_Sequence_vIn40 ) (T_Sequence_vOut40 _intraIppL) = inv_Sequence_s41 _intraX41 (T_Sequence_vIn40 ) _lhsOpp :: PP_Doc _lhsOpp = rule19 _intraIppL _vssIppL arg_inh_ arg_ordered_ arg_syn_ __result_ = T_CVisit_vOut28 _lhsOpp in __result_ ) in C_CVisit_s29 v28 {-# INLINE rule19 #-} {-# LINE 66 "src-ag/CodeSyntaxDump.ag" #-} rule19 = \ ((_intraIppL) :: [PP_Doc]) ((_vssIppL) :: [PP_Doc]) inh_ ordered_ syn_ -> {-# LINE 66 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["CVisit","CVisit"] [] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "sequence" $ ppVList _vssIppL, ppF "intra" $ ppVList _intraIppL, ppF "ordered" $ ppBool ordered_] [] {-# LINE 684 "dist/build/CodeSyntaxDump.hs"#-} -- CVisits ----------------------------------------------------- -- wrapper data Inh_CVisits = Inh_CVisits { } data Syn_CVisits = Syn_CVisits { pp_Syn_CVisits :: (PP_Doc), ppL_Syn_CVisits :: ([PP_Doc]) } {-# INLINABLE wrap_CVisits #-} wrap_CVisits :: T_CVisits -> Inh_CVisits -> (Syn_CVisits ) wrap_CVisits (T_CVisits act) (Inh_CVisits ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg31 = T_CVisits_vIn31 (T_CVisits_vOut31 _lhsOpp _lhsOppL) <- return (inv_CVisits_s32 sem arg31) return (Syn_CVisits _lhsOpp _lhsOppL) ) -- cata {-# NOINLINE sem_CVisits #-} sem_CVisits :: CVisits -> T_CVisits sem_CVisits list = Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list) -- semantic domain newtype T_CVisits = T_CVisits { attach_T_CVisits :: Identity (T_CVisits_s32 ) } newtype T_CVisits_s32 = C_CVisits_s32 { inv_CVisits_s32 :: (T_CVisits_v31 ) } data T_CVisits_s33 = C_CVisits_s33 type T_CVisits_v31 = (T_CVisits_vIn31 ) -> (T_CVisits_vOut31 ) data T_CVisits_vIn31 = T_CVisits_vIn31 data T_CVisits_vOut31 = T_CVisits_vOut31 (PP_Doc) ([PP_Doc]) {-# NOINLINE sem_CVisits_Cons #-} sem_CVisits_Cons :: T_CVisit -> T_CVisits -> T_CVisits sem_CVisits_Cons arg_hd_ arg_tl_ = T_CVisits (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_CVisits_v31 v31 = \ (T_CVisits_vIn31 ) -> ( let _hdX29 = Control.Monad.Identity.runIdentity (attach_T_CVisit (arg_hd_)) _tlX32 = Control.Monad.Identity.runIdentity (attach_T_CVisits (arg_tl_)) (T_CVisit_vOut28 _hdIpp) = inv_CVisit_s29 _hdX29 (T_CVisit_vIn28 ) (T_CVisits_vOut31 _tlIpp _tlIppL) = inv_CVisits_s32 _tlX32 (T_CVisits_vIn31 ) _lhsOppL :: [PP_Doc] _lhsOppL = rule20 _hdIpp _tlIppL _lhsOpp :: PP_Doc _lhsOpp = rule21 _hdIpp _tlIpp __result_ = T_CVisits_vOut31 _lhsOpp _lhsOppL in __result_ ) in C_CVisits_s32 v31 {-# INLINE rule20 #-} {-# LINE 90 "src-ag/CodeSyntaxDump.ag" #-} rule20 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> {-# LINE 90 "src-ag/CodeSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 739 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule21 #-} rule21 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) -> _hdIpp >-< _tlIpp {-# NOINLINE sem_CVisits_Nil #-} sem_CVisits_Nil :: T_CVisits sem_CVisits_Nil = T_CVisits (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_CVisits_v31 v31 = \ (T_CVisits_vIn31 ) -> ( let _lhsOppL :: [PP_Doc] _lhsOppL = rule22 () _lhsOpp :: PP_Doc _lhsOpp = rule23 () __result_ = T_CVisits_vOut31 _lhsOpp _lhsOppL in __result_ ) in C_CVisits_s32 v31 {-# INLINE rule22 #-} {-# LINE 91 "src-ag/CodeSyntaxDump.ag" #-} rule22 = \ (_ :: ()) -> {-# LINE 91 "src-ag/CodeSyntaxDump.ag" #-} [] {-# LINE 762 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule23 #-} rule23 = \ (_ :: ()) -> empty -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { } data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), pp_Syn_Pattern :: (PP_Doc) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg34 = T_Pattern_vIn34 (T_Pattern_vOut34 _lhsOcopy _lhsOpp) <- return (inv_Pattern_s35 sem arg34) return (Syn_Pattern _lhsOcopy _lhsOpp) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s35 ) } newtype T_Pattern_s35 = C_Pattern_s35 { inv_Pattern_s35 :: (T_Pattern_v34 ) } data T_Pattern_s36 = C_Pattern_s36 type T_Pattern_v34 = (T_Pattern_vIn34 ) -> (T_Pattern_vOut34 ) data T_Pattern_vIn34 = T_Pattern_vIn34 data T_Pattern_vOut34 = T_Pattern_vOut34 (Pattern) (PP_Doc) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Pattern_v34 v34 = \ (T_Pattern_vIn34 ) -> ( let _patsX38 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut37 _patsIcopy _patsIpp _patsIppL) = inv_Patterns_s38 _patsX38 (T_Patterns_vIn37 ) _lhsOpp :: PP_Doc _lhsOpp = rule24 _patsIppL arg_name_ _copy = rule25 _patsIcopy arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule26 _copy __result_ = T_Pattern_vOut34 _lhsOcopy _lhsOpp in __result_ ) in C_Pattern_s35 v34 {-# INLINE rule24 #-} {-# LINE 73 "src-ag/CodeSyntaxDump.ag" #-} rule24 = \ ((_patsIppL) :: [PP_Doc]) name_ -> {-# LINE 73 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] [] {-# LINE 823 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule25 #-} rule25 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule26 #-} rule26 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Pattern_v34 v34 = \ (T_Pattern_vIn34 ) -> ( let _patsX38 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut37 _patsIcopy _patsIpp _patsIppL) = inv_Patterns_s38 _patsX38 (T_Patterns_vIn37 ) _lhsOpp :: PP_Doc _lhsOpp = rule27 _patsIppL arg_pos_ _copy = rule28 _patsIcopy arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule29 _copy __result_ = T_Pattern_vOut34 _lhsOcopy _lhsOpp in __result_ ) in C_Pattern_s35 v34 {-# INLINE rule27 #-} {-# LINE 74 "src-ag/CodeSyntaxDump.ag" #-} rule27 = \ ((_patsIppL) :: [PP_Doc]) pos_ -> {-# LINE 74 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] [] {-# LINE 852 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule28 #-} rule28 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule29 #-} rule29 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Pattern_v34 v34 = \ (T_Pattern_vIn34 ) -> ( let _patX35 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut34 _patIcopy _patIpp) = inv_Pattern_s35 _patX35 (T_Pattern_vIn34 ) _lhsOpp :: PP_Doc _lhsOpp = rule30 _patIpp arg_attr_ arg_field_ _copy = rule31 _patIcopy arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule32 _copy __result_ = T_Pattern_vOut34 _lhsOcopy _lhsOpp in __result_ ) in C_Pattern_s35 v34 {-# INLINE rule30 #-} {-# LINE 75 "src-ag/CodeSyntaxDump.ag" #-} rule30 = \ ((_patIpp) :: PP_Doc) attr_ field_ -> {-# LINE 75 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] [] {-# LINE 881 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule31 #-} rule31 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule32 #-} rule32 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Pattern_v34 v34 = \ (T_Pattern_vIn34 ) -> ( let _patX35 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut34 _patIcopy _patIpp) = inv_Pattern_s35 _patX35 (T_Pattern_vIn34 ) _lhsOpp :: PP_Doc _lhsOpp = rule33 _patIpp _copy = rule34 _patIcopy _lhsOcopy :: Pattern _lhsOcopy = rule35 _copy __result_ = T_Pattern_vOut34 _lhsOcopy _lhsOpp in __result_ ) in C_Pattern_s35 v34 {-# INLINE rule33 #-} rule33 = \ ((_patIpp) :: PP_Doc) -> _patIpp {-# INLINE rule34 #-} rule34 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule35 #-} rule35 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore arg_pos_ = T_Pattern (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Pattern_v34 v34 = \ (T_Pattern_vIn34 ) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule36 arg_pos_ _copy = rule37 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule38 _copy __result_ = T_Pattern_vOut34 _lhsOcopy _lhsOpp in __result_ ) in C_Pattern_s35 v34 {-# INLINE rule36 #-} {-# LINE 76 "src-ag/CodeSyntaxDump.ag" #-} rule36 = \ pos_ -> {-# LINE 76 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] [] {-# LINE 934 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule37 #-} rule37 = \ pos_ -> Underscore pos_ {-# INLINE rule38 #-} rule38 = \ _copy -> _copy -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { } data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns), pp_Syn_Patterns :: (PP_Doc), ppL_Syn_Patterns :: ([PP_Doc]) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg37 = T_Patterns_vIn37 (T_Patterns_vOut37 _lhsOcopy _lhsOpp _lhsOppL) <- return (inv_Patterns_s38 sem arg37) return (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s38 ) } newtype T_Patterns_s38 = C_Patterns_s38 { inv_Patterns_s38 :: (T_Patterns_v37 ) } data T_Patterns_s39 = C_Patterns_s39 type T_Patterns_v37 = (T_Patterns_vIn37 ) -> (T_Patterns_vOut37 ) data T_Patterns_vIn37 = T_Patterns_vIn37 data T_Patterns_vOut37 = T_Patterns_vOut37 (Patterns) (PP_Doc) ([PP_Doc]) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_Patterns_v37 v37 = \ (T_Patterns_vIn37 ) -> ( let _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut34 _hdIcopy _hdIpp) = inv_Pattern_s35 _hdX35 (T_Pattern_vIn34 ) (T_Patterns_vOut37 _tlIcopy _tlIpp _tlIppL) = inv_Patterns_s38 _tlX38 (T_Patterns_vIn37 ) _lhsOppL :: [PP_Doc] _lhsOppL = rule39 _hdIpp _tlIppL _lhsOpp :: PP_Doc _lhsOpp = rule40 _hdIpp _tlIpp _copy = rule41 _hdIcopy _tlIcopy _lhsOcopy :: Patterns _lhsOcopy = rule42 _copy __result_ = T_Patterns_vOut37 _lhsOcopy _lhsOpp _lhsOppL in __result_ ) in C_Patterns_s38 v37 {-# INLINE rule39 #-} {-# LINE 82 "src-ag/CodeSyntaxDump.ag" #-} rule39 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> {-# LINE 82 "src-ag/CodeSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 998 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule40 #-} rule40 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) -> _hdIpp >-< _tlIpp {-# INLINE rule41 #-} rule41 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule42 #-} rule42 = \ _copy -> _copy {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_Patterns_v37 v37 = \ (T_Patterns_vIn37 ) -> ( let _lhsOppL :: [PP_Doc] _lhsOppL = rule43 () _lhsOpp :: PP_Doc _lhsOpp = rule44 () _copy = rule45 () _lhsOcopy :: Patterns _lhsOcopy = rule46 _copy __result_ = T_Patterns_vOut37 _lhsOcopy _lhsOpp _lhsOppL in __result_ ) in C_Patterns_s38 v37 {-# INLINE rule43 #-} {-# LINE 83 "src-ag/CodeSyntaxDump.ag" #-} rule43 = \ (_ :: ()) -> {-# LINE 83 "src-ag/CodeSyntaxDump.ag" #-} [] {-# LINE 1030 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule44 #-} rule44 = \ (_ :: ()) -> empty {-# INLINE rule45 #-} rule45 = \ (_ :: ()) -> [] {-# INLINE rule46 #-} rule46 = \ _copy -> _copy -- Sequence ---------------------------------------------------- -- wrapper data Inh_Sequence = Inh_Sequence { } data Syn_Sequence = Syn_Sequence { ppL_Syn_Sequence :: ([PP_Doc]) } {-# INLINABLE wrap_Sequence #-} wrap_Sequence :: T_Sequence -> Inh_Sequence -> (Syn_Sequence ) wrap_Sequence (T_Sequence act) (Inh_Sequence ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg40 = T_Sequence_vIn40 (T_Sequence_vOut40 _lhsOppL) <- return (inv_Sequence_s41 sem arg40) return (Syn_Sequence _lhsOppL) ) -- cata {-# NOINLINE sem_Sequence #-} sem_Sequence :: Sequence -> T_Sequence sem_Sequence list = Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list) -- semantic domain newtype T_Sequence = T_Sequence { attach_T_Sequence :: Identity (T_Sequence_s41 ) } newtype T_Sequence_s41 = C_Sequence_s41 { inv_Sequence_s41 :: (T_Sequence_v40 ) } data T_Sequence_s42 = C_Sequence_s42 type T_Sequence_v40 = (T_Sequence_vIn40 ) -> (T_Sequence_vOut40 ) data T_Sequence_vIn40 = T_Sequence_vIn40 data T_Sequence_vOut40 = T_Sequence_vOut40 ([PP_Doc]) {-# NOINLINE sem_Sequence_Cons #-} sem_Sequence_Cons :: T_CRule -> T_Sequence -> T_Sequence sem_Sequence_Cons arg_hd_ arg_tl_ = T_Sequence (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Sequence_v40 v40 = \ (T_Sequence_vIn40 ) -> ( let _hdX20 = Control.Monad.Identity.runIdentity (attach_T_CRule (arg_hd_)) _tlX41 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_tl_)) (T_CRule_vOut19 _hdIpp) = inv_CRule_s20 _hdX20 (T_CRule_vIn19 ) (T_Sequence_vOut40 _tlIppL) = inv_Sequence_s41 _tlX41 (T_Sequence_vIn40 ) _lhsOppL :: [PP_Doc] _lhsOppL = rule47 _hdIpp _tlIppL __result_ = T_Sequence_vOut40 _lhsOppL in __result_ ) in C_Sequence_s41 v40 {-# INLINE rule47 #-} {-# LINE 86 "src-ag/CodeSyntaxDump.ag" #-} rule47 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> {-# LINE 86 "src-ag/CodeSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 1092 "dist/build/CodeSyntaxDump.hs"#-} {-# NOINLINE sem_Sequence_Nil #-} sem_Sequence_Nil :: T_Sequence sem_Sequence_Nil = T_Sequence (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Sequence_v40 v40 = \ (T_Sequence_vIn40 ) -> ( let _lhsOppL :: [PP_Doc] _lhsOppL = rule48 () __result_ = T_Sequence_vOut40 _lhsOppL in __result_ ) in C_Sequence_s41 v40 {-# INLINE rule48 #-} {-# LINE 87 "src-ag/CodeSyntaxDump.ag" #-} rule48 = \ (_ :: ()) -> {-# LINE 87 "src-ag/CodeSyntaxDump.ag" #-} [] {-# LINE 1110 "dist/build/CodeSyntaxDump.hs"#-} uuagc-0.9.52.2/src-generated/DefaultRules.hs0000644000000000000000000101620313433540502016721 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} module DefaultRules where {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 12 "dist/build/DefaultRules.hs" #-} {-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) import Data.Map(Map) import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import Macro --marcos import CommonTypes import ErrorMessages {-# LINE 24 "dist/build/DefaultRules.hs" #-} {-# LINE 15 "src-ag/DefaultRules.ag" #-} import qualified Data.List import qualified Data.Set as Set import qualified Data.Map as Map import Data.Map(Map) import qualified Data.Sequence as Seq import Data.Sequence(Seq,(><)) import UU.Scanner.Position(noPos) import Pretty import Data.Maybe import HsToken import HsTokenScanner import Data.List(intersperse) import Data.Char import AbstractSyntax import ErrorMessages import Options {-# LINE 46 "dist/build/DefaultRules.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 80 "src-ag/DefaultRules.ag" #-} fieldName n = '@' : getName n locName n = "@loc." ++ getName n attrName fld attr | fld == _LOC = locName attr | fld == _FIELD = fieldName attr | otherwise = '@' : getName fld ++ "." ++ getName attr _ACHILD = Ident "(" noPos -- hack mkLocVar = AGField _LOC isRecordConstructor :: NontermIdent -> Map NontermIdent ConstructorType -> Bool isRecordConstructor nt ctm = Map.lookup nt ctm == Just RecordConstructor buildConExpr ocaml clean conmap typeSyns rename nt con1 fs' | nt `elem` map fst typeSyns = if ocaml then synonymMl else if clean then synonymClean else synonymHs | otherwise = normalExpr where fs = map fst fs' con = getName con1 tup = " " ++ buildTuple fs args = " " ++ unwords fs normalExpr = if clean && isRecordConstructor nt conmap then "{" ++ con ++ "|" ++ unwords (intersperse "," $ map (\(new, old) -> getName old ++ " = " ++ new) fs') ++ "}" else conname' ++ args conname' | rename = getName nt ++ "_" ++ getName con1 | otherwise = getName con1 synonymHs | con == "Tuple" = buildTuple fs | con == "Cons" = "(:)" ++ args | con == "Nil" = case lookup nt typeSyns of Just (Map _ _) -> "Data.Map.empty" Just (IntMap _) -> "Data.IntMap.empty" Just (OrdSet _) -> "Data.Set.empty" Just IntSet -> "Data.IntSet.empty" _ -> "[]" | con == "Just" = "Just" ++ args | con == "Nothing" = "Nothing" | con == "Entry" = ( case lookup nt typeSyns of Just (Map _ _) -> "Data.Map.insert" Just (IntMap _) -> "Data.IntMap.insert" Just (OrdSet _) -> "Data.Set.insert" Just IntSet -> "Data.IntSet.insert" ) ++ args | otherwise = normalExpr synonymMl | con == "Tuple" = buildTuple fs | con == "Cons" = "(::)" ++ tup | con == "Nil" = case lookup nt typeSyns of Just (Map _ _) -> prefixMod nt "empty" Just (IntMap _) -> prefixMod nt "empty" Just (OrdSet _) -> prefixMod nt "empty" Just IntSet -> prefixMod nt "empty" _ -> "[]" | con == "Just" = "Some" ++ tup | con == "Nothing" = "None" | con == "Entry" = ( case lookup nt typeSyns of Just (Map _ _) -> prefixMod nt "add" Just (IntMap _) -> prefixMod nt "add" Just (OrdSet _) -> prefixMod nt "add" Just IntSet -> prefixMod nt "add" ) ++ args | otherwise = normalExpr synonymClean | con == "Tuple" = buildTuple fs | con == "Cons" = "(\\x xs -> [x:xs])" ++ args | con == "Nil" = case lookup nt typeSyns of Just (Map _ _) -> "Data.Map.empty" Just (IntMap _) -> "Data.IntMap.empty" Just (OrdSet _) -> "Data.Set.empty" Just IntSet -> "Data.IntSet.empty" _ -> "[]" | con == "Just" = "Just" ++ args | con == "Nothing" = "Nothing" | con == "Entry" = ( case lookup nt typeSyns of Just (Map _ _) -> "Data.Map.insert" Just (IntMap _) -> "Data.IntMap.insert" Just (OrdSet _) -> "Data.Set.insert" Just IntSet -> "Data.IntSet.insert" ) ++ args | otherwise = normalExpr prefixMod nt nm = "M_" ++ getName nt ++ "." ++ nm concatSeq = foldr (Seq.><) Seq.empty splitAttrs :: Map Identifier a -> [Identifier] -> ([(Identifier,a)],[Identifier]) -- a used as (String,String) splitAttrs _ [] = ([],[]) splitAttrs useMap (n:rest) = let (uses,normals) = splitAttrs useMap rest in case Map.lookup n useMap of Just x -> ((n,x):uses , normals ) Nothing -> ( uses , n:normals ) removeDefined :: Set (Identifier,Identifier) -> (Identifier,Attributes) -> (Identifier,[Identifier]) removeDefined defined (fld,as) = ( fld , [ a | a <- Map.keys as , not (Set.member (fld,a) defined) ] ) {-# LINE 159 "dist/build/DefaultRules.hs" #-} {-# LINE 255 "src-ag/DefaultRules.ag" #-} deprecatedCopyRuleError nt con fld a = let mesg = "In the definitions for alternative" >#< getName con >#< "of nonterminal" >#< getName nt >|< "," >-< "the value of field" >#< getName a >#< "is copied by a copy-rule." >-< "Copying the value of a field using a copy-rule is deprecated" >-< "Please add the following lines to your code:" >-< ( "SEM" >#< getName nt >-< indent 2 ( "|" >#< getName con >#< getName fld >#< "." >#< a >#< "=" >#< "@" >|< a ) ) in CustomError True (getPos a) mesg missingRuleErrorExpr clean nt con fld a = (if clean then "abort" else "error") ++ " \"missing rule: " ++ show nt ++ "." ++ show con ++ "." ++ show fld ++ "." ++ show a ++ "\"" makeRule :: (Identifier,Identifier) -> Expression -> String -> Bool -> Maybe Error -> Rule makeRule (f1,a1) expr origin identity mbDelayedError = Rule Nothing (Alias f1 a1 (Underscore noPos)) expr False origin False True identity mbDelayedError False useRule :: Options -> Set Identifier -> [(Identifier,Attributes)] -> (Identifier,(String,String,String)) -> Rule useRule opts locals ch_outs (n,(op,e,pos)) = let elems = [ fld | (fld,as) <- ch_outs , Map.member n as ] isOp [] = False isOp (c:cs) | isSpace c = isOp cs | isAlpha c = case dropWhile isAlpha cs of ('.':cs2) -> isOp cs2 -- fully qualified name, drop prefix _ -> False | c == '(' = False | otherwise = True tks | Set.member n locals = [mkLocVar n noPos Nothing] | null elems = lexTokens opts noPos e | otherwise = lexTokens opts noPos str where opExpr l r | isOp op = l ++ " " ++ op ++ " " ++ r -- takes the associativity of the operator | otherwise = "(" ++ op ++ " " ++ l ++ " " ++ r ++ ")" -- associates to the right str = foldr1 opExpr (map (flip attrName n) elems) in makeRule (_LHS,n) (Expression noPos tks) ("use rule " ++ pos) False Nothing selfRule :: Bool -> Identifier -> [HsToken] -> Rule selfRule lhsNecLoc attr tks = makeRule (if lhsNecLoc then _LHS else _LOC,attr) (Expression noPos tks) "self rule" False Nothing concatRE rsess = let (rss,ess) = unzip rsess in (concat rss, concatSeq ess) copyRule :: Options -> Set NontermIdent -> Identifier -> Identifier -> Bool -> Set Identifier -> (Map Identifier Identifier, (Identifier,[Identifier])) -> ([Rule], Seq Error) copyRule options wrappers nt con modcopy locals (env,(fld,as)) = concatRE (map copyRu as) where copyRu a = ( [ makeRule (fld,a) (Expression noPos tks) (cruletxt sel) True mbDelayedErr ] , err ) where sel | not modcopy && Set.member a locals = Just _LOC | otherwise = Map.lookup a env (tks,err,mbDelayedErr) = case sel of Nothing -> let tks = [HsToken (missingRuleErrorExpr (clean options) nt con fld a) noPos] err = MissingRule nt con fld a in if nt `Set.member` wrappers && kennedyWarren options then (tks, Seq.empty, Just err) -- yield error only if the rule is actually scheduled; for kennedyWarren code gen only else (tks, Seq.singleton err, Nothing) Just f | f == _ACHILD -> ( [AGLocal a noPos Nothing] , Seq.singleton (deprecatedCopyRuleError nt con fld a) , Nothing ) | otherwise -> ( [AGField f a noPos Nothing] , Seq.empty , Nothing ) cruletxt sel | local = "copy rule (from local)" | deprChild = "deprecated child copy" | Set.member a locals && nonlocal = "modified copy rule" | incoming && outgoing = "copy rule (chain)" | incoming = "copy rule (down)" | outgoing = "copy rule (up)" | otherwise = "copy rule (chain)" where outgoing = fld == _LHS incoming = maybe False (== _LHS) sel nonlocal = maybe False (/= _LOC) sel local = maybe False (== _LOC) sel deprChild = maybe False (== _ACHILD) sel {-# LINE 311 "dist/build/DefaultRules.hs" #-} {-# LINE 488 "src-ag/DefaultRules.ag" #-} buildTuple fs = "(" ++ concat (intersperse "," fs) ++ ")" addAugments :: (Identifier, [Expression]) -> [Rule] -> [Rule] addAugments (_, exprs) rules | null exprs = rules addAugments (syn, exprs) rules = [rule] ++ funRules ++ map modify rules where rule = Rule Nothing (Alias _LHS syn (Underscore noPos)) rhs False "augmented rule" False True False Nothing False rhs = Expression noPos tks tks = [ HsToken "foldr ($) " noPos, mkLocVar substSyn noPos Nothing, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] funs = intersperse (HsToken ", " noPos) (map (\n -> mkLocVar n noPos Nothing) funNames) substSyn = Ident (show syn ++ "_augmented_syn") (getPos syn) funNames = zipWith (\i _ -> Ident (show syn ++ "_augmented_f" ++ show i) (getPos syn)) [1..] exprs funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos)) expr False "augment function" False True False Nothing False) funNames exprs modify (Rule mbNm pat rhs owrt origin expl pure identity mbErr eager) | containsSyn pat = Rule mbNm (modifyPat pat) rhs owrt origin expl pure identity mbErr eager modify r = r containsSyn (Constr _ pats) = any containsSyn pats containsSyn (Product _ pats) = any containsSyn pats containsSyn (Irrefutable pat) = containsSyn pat containsSyn (Alias field attr pat) = (field == _LHS && attr == syn) || containsSyn pat containsSyn _ = False modifyPat (Constr name pats) = Constr name (map modifyPat pats) modifyPat (Product pos pats) = Product pos (map modifyPat pats) modifyPat (Irrefutable pat) = Irrefutable (modifyPat pat) modifyPat (Alias field attr pat) | field == _LHS && attr == syn = Alias _LOC substSyn (modifyPat pat) | otherwise = Alias field attr (modifyPat pat) modifyPat p = p -- adds the additional rules needed for around, which creates a sequence of -- rules that form a function that each transforms the semantics of a child -- before attaching the child. -- The rule defines a local attribute "_around" and is dependent -- on this attribute. addArounds :: (Identifier, [Expression]) -> [Rule] -> [Rule] addArounds (_, exprs) rules | null exprs = rules addArounds (child, exprs) rules = [rule] ++ funRules ++ rules where rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos)) rhs False "around rule" False True False Nothing False rhs = Expression noPos tks tks = [ HsToken "\\s -> foldr ($) s " noPos, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] funs = intersperse (HsToken ", " noPos) (map (\n -> mkLocVar n noPos Nothing) funNames) childLoc = Ident (show child ++ "_around") (getPos child) funNames = zipWith (\i _ -> Ident (show child ++ "_around_f" ++ show i) (getPos child)) [1..] exprs funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos)) expr False "around function" False True False Nothing False) funNames exprs -- adds the additional rules needed for merging. -- It produces for each merging child a rule with local attribute: "_merged". -- this rules takes the semantics of the first children and feeds it to the function -- represented by this attribute. This attribute then defines the semantics for -- the merging child. addMerges :: (Identifier, (Identifier,[Identifier],Expression)) -> [Rule] -> [Rule] addMerges (target,(_,_,expr)) rules = rule : rules where rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos)) expr False "merge rule" False True False Nothing False childLoc = Ident (show target ++ "_merge") (getPos target) {-# LINE 380 "dist/build/DefaultRules.hs" #-} {-# LINE 606 "src-ag/DefaultRules.ag" #-} elimSelfId :: NontermIdent -> [Identifier] -> Type -> Type elimSelfId nt args Self = NT nt (map getName args) False elimSelfId _ _ tp = tp elimSelfStr :: NontermIdent -> [String] -> Type -> Type elimSelfStr nt args Self = NT nt args False elimSelfStr _ _ tp = tp {-# LINE 391 "dist/build/DefaultRules.hs" #-} {-# LINE 658 "src-ag/DefaultRules.ag" #-} -- When a rule has a name, create an alias for a rule -- and a modified rule that refers to the alias -- Thus it removes rule names from rules mkRuleAlias :: Rule -> (Rule, Maybe Rule) mkRuleAlias r@(Rule Nothing _ _ _ _ _ _ _ _ _) = (r, Nothing) mkRuleAlias (Rule (Just nm) pat expr owrt origin expl pure identity mbErr eager) = (r', Just alias) where alias = Rule Nothing (Alias _LOC (Ident ("_rule_" ++ show nm) pos) (Underscore pos)) expr owrt origin expl pure identity mbErr eager pos = getPos nm expr' = Expression pos tks tks = [mkLocVar (Ident ("_rule_" ++ show nm) pos) pos (Just ("Indirection to rule " ++ show nm))] r' = Rule Nothing pat expr' owrt origin False True identity Nothing False {-# LINE 406 "dist/build/DefaultRules.hs" #-} {-# LINE 675 "src-ag/DefaultRules.ag" #-} needsMultiRules :: Options -> Bool needsMultiRules opts = (visit opts || withCycle opts) && not (kennedyWarren opts) {-# LINE 412 "dist/build/DefaultRules.hs" #-} {-# LINE 680 "src-ag/DefaultRules.ag" #-} {- multiRule replaces loc.(a,b) = e by loc.tup1 = e loc.(a,_) = @loc.tup1 loc.(_,b) = @loc.tup1 It needs to thread a unique number for inventing names for the tuples. It also works for nested tuples: loc.(a,(b,c)) = e becomes loc.tup1 = e loc.(a,_) = @loc.tup1 loc.(_,tup2) = @loc.tup1 loc.(b,_) = @loc.tup2 loc.(_,c) = @loc.tup2 -} multiRule :: Rule -> Int -> ([Rule], Int) multiRule (Rule _ pat expr owrt origin expl pure identity mbErr eager) uniq = let f :: Bool -> (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int)) f expl' w e (Product pos pats) n = let freshName = Ident ("_tup" ++ show n) pos freshExpr = Expression pos freshTks freshTks = [AGField _LOC freshName pos Nothing] freshPat = Alias _LOC freshName (Underscore pos) a = length pats - 1 us b p = Product pos (replicate (a-b) (Underscore pos) ++ [p] ++ replicate b (Underscore pos)) g :: Pattern -> ([Pattern],[Rule],Int) -> ([Pattern],[Rule],Int) g p (xs1,rs1,n1) = let (x2,(rs2,n2)) = f False (us (length xs1)) freshExpr p n1 in (x2:xs1, rs2++rs1, n2) (xs9,rs9,n9) = foldr g ([], [], n+1) pats in ( freshPat , ( Rule Nothing (w freshPat) e owrt origin expl' True False mbErr eager : rs9 , n9 ) ) f expl' w e p n = ( p , ( [Rule Nothing (w p) e owrt origin expl' True False mbErr eager] , n ) ) in snd (f expl id expr pat uniq) {-# LINE 462 "dist/build/DefaultRules.hs" #-} -- Child ------------------------------------------------------- -- wrapper data Inh_Child = Inh_Child { con_Inh_Child :: !(ConstructorIdent), cr_Inh_Child :: !(Bool), inhMap_Inh_Child :: !(Map Identifier Attributes), merged_Inh_Child :: !(Set Identifier), nt_Inh_Child :: !(NontermIdent), params_Inh_Child :: !([Identifier]), synMap_Inh_Child :: !(Map Identifier Attributes) } data Syn_Child = Syn_Child { errors_Syn_Child :: !(Seq Error), field_Syn_Child :: !( (Identifier,Type,ChildKind) ), inherited_Syn_Child :: !(Attributes), name_Syn_Child :: !(Identifier), output_Syn_Child :: !(Child), synthesized_Syn_Child :: !(Attributes) } {-# INLINABLE wrap_Child #-} wrap_Child :: T_Child -> Inh_Child -> (Syn_Child ) wrap_Child !(T_Child act) !(Inh_Child _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg0 = T_Child_vIn0 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap !(T_Child_vOut0 _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized) <- return (inv_Child_s0 sem K_Child_v0 arg0) return (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized) ) -- cata {-# INLINE sem_Child #-} sem_Child :: Child -> T_Child sem_Child ( Child !name_ !tp_ !kind_ ) = sem_Child_Child name_ tp_ kind_ -- semantic domain newtype T_Child = T_Child { attach_T_Child :: Identity (T_Child_s0 ) } data T_Child_s0 where C_Child_s0 :: { inv_Child_s0 :: !(forall t. K_Child_s0 t -> t) } -> T_Child_s0 data T_Child_s1 = C_Child_s1 data T_Child_s26 = C_Child_s26 newtype T_Child_s56 = C_Child_s56 { inv_Child_s56 :: (T_Child_v53 ) } data K_Child_s0 k where K_Child_v0 :: K_Child_s0 (T_Child_v0 ) K_Child_v13 :: K_Child_s0 (T_Child_v13 ) K_Child_v52 :: K_Child_s0 (T_Child_v52 ) type T_Child_v0 = (T_Child_vIn0 ) -> (T_Child_vOut0 ) data T_Child_vIn0 = T_Child_vIn0 !(ConstructorIdent) !(Bool) !(Map Identifier Attributes) !(Set Identifier) !(NontermIdent) !([Identifier]) !(Map Identifier Attributes) data T_Child_vOut0 = T_Child_vOut0 !(Seq Error) !( (Identifier,Type,ChildKind) ) !(Attributes) !(Identifier) !(Child) !(Attributes) type T_Child_v13 = (T_Child_vIn13 ) -> (T_Child_vOut13 ) data T_Child_vIn13 = T_Child_vIn13 !(Map Identifier Attributes) !(Set Identifier) !(Map Identifier Attributes) data T_Child_vOut13 = T_Child_vOut13 !(Seq Error) !( (Identifier,Type,ChildKind) ) !(Attributes) !(Identifier) !(Child) !(Attributes) type T_Child_v52 = (T_Child_vIn52 ) -> (T_Child_vOut52 ) data T_Child_vIn52 = T_Child_vIn52 !(Map Identifier Attributes) !(Set Identifier) !(Map Identifier Attributes) data T_Child_vOut52 = T_Child_vOut52 !(Seq Error) !( (Identifier,Type,ChildKind) ) !(Attributes) !(Identifier) !(Attributes) !(T_Child_s56 ) type T_Child_v53 = (T_Child_vIn53 ) -> (T_Child_vOut53 ) data T_Child_vIn53 = T_Child_vIn53 data T_Child_vOut53 = T_Child_vOut53 !(Child) {-# NOINLINE sem_Child_Child #-} sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child sem_Child_Child !arg_name_ !arg_tp_ !arg_kind_ = T_Child (return st0) where {-# NOINLINE st0 #-} !st0 = let k0 :: K_Child_s0 t -> t k0 K_Child_v0 = v0 k0 K_Child_v13 = v13 k0 K_Child_v52 = v52 v0 :: T_Child_v0 v0 = \ !(T_Child_vIn0 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule11 () in let _lhsOfield :: (Identifier,Type,ChildKind) !_lhsOfield = rule6 arg_kind_ arg_name_ arg_tp_ in let !_chnt = rule0 arg_name_ arg_tp_ in let !_inh = rule1 _chnt _lhsIinhMap in let !(!_nt,!_params) = rule7 arg_name_ arg_tp_ in let !_inh1 = rule8 _inh _nt _params in let _lhsOinherited :: Attributes !_lhsOinherited = rule4 _inh1 in let _lhsOname :: Identifier !_lhsOname = rule3 arg_name_ in let _lhsOoutput :: Child !_lhsOoutput = rule10 arg_kind_ arg_name_ arg_tp_ in let !_syn = rule2 _chnt _lhsIsynMap in let !_syn1 = rule9 _nt _params _syn in let _lhsOsynthesized :: Attributes !_lhsOsynthesized = rule5 _lhsImerged _syn1 arg_name_ in let !__result_ = T_Child_vOut0 _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized in __result_ ) v13 :: T_Child_v13 v13 = \ !(T_Child_vIn13 _lhsIinhMap _lhsImerged _lhsIsynMap) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule11 () in let _lhsOfield :: (Identifier,Type,ChildKind) !_lhsOfield = rule6 arg_kind_ arg_name_ arg_tp_ in let !_chnt = rule0 arg_name_ arg_tp_ in let !_inh = rule1 _chnt _lhsIinhMap in let !(!_nt,!_params) = rule7 arg_name_ arg_tp_ in let !_inh1 = rule8 _inh _nt _params in let _lhsOinherited :: Attributes !_lhsOinherited = rule4 _inh1 in let _lhsOname :: Identifier !_lhsOname = rule3 arg_name_ in let _lhsOoutput :: Child !_lhsOoutput = rule10 arg_kind_ arg_name_ arg_tp_ in let !_syn = rule2 _chnt _lhsIsynMap in let !_syn1 = rule9 _nt _params _syn in let _lhsOsynthesized :: Attributes !_lhsOsynthesized = rule5 _lhsImerged _syn1 arg_name_ in let !__result_ = T_Child_vOut13 _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized in __result_ ) v52 :: T_Child_v52 v52 = \ !(T_Child_vIn52 _lhsIinhMap _lhsImerged _lhsIsynMap) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule11 () in let _lhsOfield :: (Identifier,Type,ChildKind) !_lhsOfield = rule6 arg_kind_ arg_name_ arg_tp_ in let !_chnt = rule0 arg_name_ arg_tp_ in let !_inh = rule1 _chnt _lhsIinhMap in let !(!_nt,!_params) = rule7 arg_name_ arg_tp_ in let !_inh1 = rule8 _inh _nt _params in let _lhsOinherited :: Attributes !_lhsOinherited = rule4 _inh1 in let _lhsOname :: Identifier !_lhsOname = rule3 arg_name_ in let !_syn = rule2 _chnt _lhsIsynMap in let !_syn1 = rule9 _nt _params _syn in let _lhsOsynthesized :: Attributes !_lhsOsynthesized = rule5 _lhsImerged _syn1 arg_name_ in let !__st_ = st56 () !__result_ = T_Child_vOut52 _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOsynthesized __st_ in __result_ ) in C_Child_s0 k0 {-# NOINLINE st56 #-} st56 = \ (_ :: ()) -> let v53 :: T_Child_v53 v53 = \ !(T_Child_vIn53 ) -> ( let _lhsOoutput :: Child !_lhsOoutput = rule10 arg_kind_ arg_name_ arg_tp_ in let !__result_ = T_Child_vOut53 _lhsOoutput in __result_ ) in C_Child_s56 v53 {-# NOINLINE[1] rule0 #-} {-# LINE 19 "src-ag/DistChildAttr.ag" #-} rule0 = \ !name_ !tp_ -> {-# LINE 19 "src-ag/DistChildAttr.ag" #-} case tp_ of NT nt _ _ -> nt Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") Haskell t -> identifier "" {-# LINE 602 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule1 #-} {-# LINE 23 "src-ag/DistChildAttr.ag" #-} rule1 = \ !_chnt ((!_lhsIinhMap) :: Map Identifier Attributes) -> {-# LINE 23 "src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIinhMap {-# LINE 608 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule2 #-} {-# LINE 24 "src-ag/DistChildAttr.ag" #-} rule2 = \ !_chnt ((!_lhsIsynMap) :: Map Identifier Attributes) -> {-# LINE 24 "src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIsynMap {-# LINE 614 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule3 #-} {-# LINE 229 "src-ag/DefaultRules.ag" #-} rule3 = \ !name_ -> {-# LINE 229 "src-ag/DefaultRules.ag" #-} name_ {-# LINE 620 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule4 #-} {-# LINE 238 "src-ag/DefaultRules.ag" #-} rule4 = \ !_inh1 -> {-# LINE 238 "src-ag/DefaultRules.ag" #-} _inh1 {-# LINE 626 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule5 #-} {-# LINE 239 "src-ag/DefaultRules.ag" #-} rule5 = \ ((!_lhsImerged) :: Set Identifier) !_syn1 !name_ -> {-# LINE 239 "src-ag/DefaultRules.ag" #-} if name_ `Set.member` _lhsImerged then Map.empty else _syn1 {-# LINE 634 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule6 #-} {-# LINE 574 "src-ag/DefaultRules.ag" #-} rule6 = \ !kind_ !name_ !tp_ -> {-# LINE 574 "src-ag/DefaultRules.ag" #-} (name_,tp_,kind_) {-# LINE 640 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule7 #-} {-# LINE 596 "src-ag/DefaultRules.ag" #-} rule7 = \ !name_ !tp_ -> {-# LINE 596 "src-ag/DefaultRules.ag" #-} case tp_ of NT nt params _ -> (nt, params) Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") Haskell t -> (identifier t, []) {-# LINE 649 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule8 #-} {-# LINE 600 "src-ag/DefaultRules.ag" #-} rule8 = \ !_inh !_nt !_params -> {-# LINE 600 "src-ag/DefaultRules.ag" #-} Map.map (elimSelfStr _nt _params ) _inh {-# LINE 655 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule9 #-} {-# LINE 601 "src-ag/DefaultRules.ag" #-} rule9 = \ !_nt !_params !_syn -> {-# LINE 601 "src-ag/DefaultRules.ag" #-} Map.map (elimSelfStr _nt _params ) _syn {-# LINE 661 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule10 #-} {-# LINE 642 "src-ag/DefaultRules.ag" #-} rule10 = \ !kind_ !name_ !tp_ -> {-# LINE 642 "src-ag/DefaultRules.ag" #-} Child name_ tp_ kind_ {-# LINE 667 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule11 #-} rule11 = \ (_ :: ()) -> Seq.empty -- Children ---------------------------------------------------- -- wrapper data Inh_Children = Inh_Children { con_Inh_Children :: !(ConstructorIdent), cr_Inh_Children :: !(Bool), inhMap_Inh_Children :: !(Map Identifier Attributes), merged_Inh_Children :: !(Set Identifier), nt_Inh_Children :: !(NontermIdent), params_Inh_Children :: !([Identifier]), synMap_Inh_Children :: !(Map Identifier Attributes) } data Syn_Children = Syn_Children { errors_Syn_Children :: !(Seq Error), fields_Syn_Children :: !([(Identifier,Type,ChildKind)]), inputs_Syn_Children :: !([(Identifier, Attributes)]), output_Syn_Children :: !(Children), outputs_Syn_Children :: !([(Identifier, Attributes)]) } {-# INLINABLE wrap_Children #-} wrap_Children :: T_Children -> Inh_Children -> (Syn_Children ) wrap_Children !(T_Children act) !(Inh_Children _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg1 = T_Children_vIn1 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap !(T_Children_vOut1 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs) <- return (inv_Children_s2 sem K_Children_v1 arg1) return (Syn_Children _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs) ) -- cata {-# NOINLINE sem_Children #-} sem_Children :: Children -> T_Children sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) -- semantic domain newtype T_Children = T_Children { attach_T_Children :: Identity (T_Children_s2 ) } data T_Children_s2 where C_Children_s2 :: { inv_Children_s2 :: !(forall t. K_Children_s2 t -> t) } -> T_Children_s2 data T_Children_s3 = C_Children_s3 data T_Children_s27 = C_Children_s27 newtype T_Children_s53 = C_Children_s53 { inv_Children_s53 :: (T_Children_v48 ) } data K_Children_s2 k where K_Children_v1 :: K_Children_s2 (T_Children_v1 ) K_Children_v14 :: K_Children_s2 (T_Children_v14 ) K_Children_v47 :: K_Children_s2 (T_Children_v47 ) type T_Children_v1 = (T_Children_vIn1 ) -> (T_Children_vOut1 ) data T_Children_vIn1 = T_Children_vIn1 !(ConstructorIdent) !(Bool) !(Map Identifier Attributes) !(Set Identifier) !(NontermIdent) !([Identifier]) !(Map Identifier Attributes) data T_Children_vOut1 = T_Children_vOut1 !(Seq Error) !([(Identifier,Type,ChildKind)]) !([(Identifier, Attributes)]) !(Children) !([(Identifier, Attributes)]) type T_Children_v14 = (T_Children_vIn14 ) -> (T_Children_vOut14 ) data T_Children_vIn14 = T_Children_vIn14 !(Map Identifier Attributes) !(Set Identifier) !(Map Identifier Attributes) data T_Children_vOut14 = T_Children_vOut14 !(Seq Error) !([(Identifier,Type,ChildKind)]) !([(Identifier, Attributes)]) !(Children) !([(Identifier, Attributes)]) type T_Children_v47 = (T_Children_vIn47 ) -> (T_Children_vOut47 ) data T_Children_vIn47 = T_Children_vIn47 !(Map Identifier Attributes) !(Set Identifier) !(Map Identifier Attributes) data T_Children_vOut47 = T_Children_vOut47 !(Seq Error) !([(Identifier,Type,ChildKind)]) !([(Identifier, Attributes)]) !([(Identifier, Attributes)]) !(T_Children_s53 ) type T_Children_v48 = (T_Children_vIn48 ) -> (T_Children_vOut48 ) data T_Children_vIn48 = T_Children_vIn48 data T_Children_vOut48 = T_Children_vOut48 !(Children) {-# NOINLINE sem_Children_Cons #-} sem_Children_Cons :: T_Child -> T_Children -> T_Children sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st2) where {-# NOINLINE st2 #-} !st2 = let k2 :: K_Children_s2 t -> t k2 K_Children_v1 = v1 k2 K_Children_v14 = v14 k2 K_Children_v47 = v47 v1 :: T_Children_v1 v1 = \ !(T_Children_vIn1 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) -> ( let !_hdX0 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) in let !_tlX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) in let !_hdOinhMap = rule21 _lhsIinhMap in let !_tlOinhMap = rule28 _lhsIinhMap in let !_hdOmerged = rule22 _lhsImerged in let !_hdOsynMap = rule25 _lhsIsynMap in let !_tlOmerged = rule29 _lhsImerged in let !_tlOsynMap = rule32 _lhsIsynMap in let !(T_Child_vOut13 _hdIerrors _hdIfield _hdIinherited _hdIname _hdIoutput _hdIsynthesized) = inv_Child_s0 _hdX0 K_Child_v13 (T_Child_vIn13 _hdOinhMap _hdOmerged _hdOsynMap) in let !(T_Children_vOut14 _tlIerrors _tlIfields _tlIinputs _tlIoutput _tlIoutputs) = inv_Children_s2 _tlX2 K_Children_v14 (T_Children_vIn14 _tlOinhMap _tlOmerged _tlOsynMap) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule16 _hdIerrors _tlIerrors in let _lhsOfields :: [(Identifier,Type,ChildKind)] !_lhsOfields = rule15 _hdIfield _tlIfields in let _lhsOinputs :: [(Identifier, Attributes)] !_lhsOinputs = rule13 _hdIinherited _hdIname _tlIinputs in let !_output = rule17 _hdIoutput _tlIoutput in let _lhsOoutput :: Children !_lhsOoutput = rule18 _output in let _lhsOoutputs :: [(Identifier, Attributes)] !_lhsOoutputs = rule14 _hdIname _hdIsynthesized _tlIoutputs in let !__result_ = T_Children_vOut1 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs in __result_ ) v14 :: T_Children_v14 v14 = \ !(T_Children_vIn14 _lhsIinhMap _lhsImerged _lhsIsynMap) -> ( let !_hdX0 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) in let !_tlX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) in let !_hdOinhMap = rule21 _lhsIinhMap in let !_tlOinhMap = rule28 _lhsIinhMap in let !_hdOmerged = rule22 _lhsImerged in let !_hdOsynMap = rule25 _lhsIsynMap in let !_tlOmerged = rule29 _lhsImerged in let !_tlOsynMap = rule32 _lhsIsynMap in let !(T_Child_vOut13 _hdIerrors _hdIfield _hdIinherited _hdIname _hdIoutput _hdIsynthesized) = inv_Child_s0 _hdX0 K_Child_v13 (T_Child_vIn13 _hdOinhMap _hdOmerged _hdOsynMap) in let !(T_Children_vOut14 _tlIerrors _tlIfields _tlIinputs _tlIoutput _tlIoutputs) = inv_Children_s2 _tlX2 K_Children_v14 (T_Children_vIn14 _tlOinhMap _tlOmerged _tlOsynMap) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule16 _hdIerrors _tlIerrors in let _lhsOfields :: [(Identifier,Type,ChildKind)] !_lhsOfields = rule15 _hdIfield _tlIfields in let _lhsOinputs :: [(Identifier, Attributes)] !_lhsOinputs = rule13 _hdIinherited _hdIname _tlIinputs in let !_output = rule17 _hdIoutput _tlIoutput in let _lhsOoutput :: Children !_lhsOoutput = rule18 _output in let _lhsOoutputs :: [(Identifier, Attributes)] !_lhsOoutputs = rule14 _hdIname _hdIsynthesized _tlIoutputs in let !__result_ = T_Children_vOut14 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs in __result_ ) v47 :: T_Children_v47 v47 = \ !(T_Children_vIn47 _lhsIinhMap _lhsImerged _lhsIsynMap) -> ( let !_hdX0 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) in let !_tlX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) in let !_hdOinhMap = rule21 _lhsIinhMap in let !_tlOinhMap = rule28 _lhsIinhMap in let !_hdOmerged = rule22 _lhsImerged in let !_hdOsynMap = rule25 _lhsIsynMap in let !_tlOmerged = rule29 _lhsImerged in let !_tlOsynMap = rule32 _lhsIsynMap in let !(T_Child_vOut52 _hdIerrors _hdIfield _hdIinherited _hdIname _hdIsynthesized _hdX56) = inv_Child_s0 _hdX0 K_Child_v52 (T_Child_vIn52 _hdOinhMap _hdOmerged _hdOsynMap) in let !(T_Children_vOut47 _tlIerrors _tlIfields _tlIinputs _tlIoutputs _tlX53) = inv_Children_s2 _tlX2 K_Children_v47 (T_Children_vIn47 _tlOinhMap _tlOmerged _tlOsynMap) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule16 _hdIerrors _tlIerrors in let _lhsOfields :: [(Identifier,Type,ChildKind)] !_lhsOfields = rule15 _hdIfield _tlIfields in let _lhsOinputs :: [(Identifier, Attributes)] !_lhsOinputs = rule13 _hdIinherited _hdIname _tlIinputs in let _lhsOoutputs :: [(Identifier, Attributes)] !_lhsOoutputs = rule14 _hdIname _hdIsynthesized _tlIoutputs in let !__st_ = st53 _hdX56 _tlX53 !__result_ = T_Children_vOut47 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutputs __st_ in __result_ ) in C_Children_s2 k2 {-# NOINLINE st53 #-} st53 = \ !_hdX56 !_tlX53 -> let v48 :: T_Children_v48 v48 = \ !(T_Children_vIn48 ) -> ( let !(T_Child_vOut53 _hdIoutput) = inv_Child_s56 _hdX56 (T_Child_vIn53 ) in let !(T_Children_vOut48 _tlIoutput) = inv_Children_s53 _tlX53 (T_Children_vIn48 ) in let !_output = rule17 _hdIoutput _tlIoutput in let _lhsOoutput :: Children !_lhsOoutput = rule18 _output in let !__result_ = T_Children_vOut48 _lhsOoutput in __result_ ) in C_Children_s53 v48 {-# NOINLINE[1] rule13 #-} {-# LINE 244 "src-ag/DefaultRules.ag" #-} rule13 = \ ((!_hdIinherited) :: Attributes) ((!_hdIname) :: Identifier) ((!_tlIinputs) :: [(Identifier, Attributes)]) -> {-# LINE 244 "src-ag/DefaultRules.ag" #-} (_hdIname, _hdIinherited) : _tlIinputs {-# LINE 819 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule14 #-} {-# LINE 245 "src-ag/DefaultRules.ag" #-} rule14 = \ ((!_hdIname) :: Identifier) ((!_hdIsynthesized) :: Attributes) ((!_tlIoutputs) :: [(Identifier, Attributes)]) -> {-# LINE 245 "src-ag/DefaultRules.ag" #-} (_hdIname, _hdIsynthesized) : _tlIoutputs {-# LINE 825 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule15 #-} {-# LINE 570 "src-ag/DefaultRules.ag" #-} rule15 = \ ((!_hdIfield) :: (Identifier,Type,ChildKind) ) ((!_tlIfields) :: [(Identifier,Type,ChildKind)]) -> {-# LINE 570 "src-ag/DefaultRules.ag" #-} _hdIfield : _tlIfields {-# LINE 831 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule16 #-} rule16 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# NOINLINE[1] rule17 #-} rule17 = \ ((!_hdIoutput) :: Child) ((!_tlIoutput) :: Children) -> (:) _hdIoutput _tlIoutput {-# NOINLINE[1] rule18 #-} rule18 = \ !_output -> _output {-# NOINLINE[1] rule21 #-} rule21 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule22 #-} rule22 = \ ((!_lhsImerged) :: Set Identifier) -> _lhsImerged {-# NOINLINE[1] rule25 #-} rule25 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE[1] rule28 #-} rule28 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule29 #-} rule29 = \ ((!_lhsImerged) :: Set Identifier) -> _lhsImerged {-# NOINLINE[1] rule32 #-} rule32 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE sem_Children_Nil #-} sem_Children_Nil :: T_Children sem_Children_Nil = T_Children (return st2) where {-# NOINLINE st2 #-} !st2 = let k2 :: K_Children_s2 t -> t k2 K_Children_v1 = v1 k2 K_Children_v14 = v14 k2 K_Children_v47 = v47 v1 :: T_Children_v1 v1 = \ !(T_Children_vIn1 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule36 () in let _lhsOfields :: [(Identifier,Type,ChildKind)] !_lhsOfields = rule35 () in let _lhsOinputs :: [(Identifier, Attributes)] !_lhsOinputs = rule33 () in let !_output = rule37 () in let _lhsOoutputs :: [(Identifier, Attributes)] !_lhsOoutputs = rule34 () in let _lhsOoutput :: Children !_lhsOoutput = rule38 _output in let !__result_ = T_Children_vOut1 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs in __result_ ) v14 :: T_Children_v14 v14 = \ !(T_Children_vIn14 _lhsIinhMap _lhsImerged _lhsIsynMap) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule36 () in let _lhsOfields :: [(Identifier,Type,ChildKind)] !_lhsOfields = rule35 () in let _lhsOinputs :: [(Identifier, Attributes)] !_lhsOinputs = rule33 () in let !_output = rule37 () in let _lhsOoutputs :: [(Identifier, Attributes)] !_lhsOoutputs = rule34 () in let _lhsOoutput :: Children !_lhsOoutput = rule38 _output in let !__result_ = T_Children_vOut14 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs in __result_ ) v47 :: T_Children_v47 v47 = \ !(T_Children_vIn47 _lhsIinhMap _lhsImerged _lhsIsynMap) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule36 () in let _lhsOfields :: [(Identifier,Type,ChildKind)] !_lhsOfields = rule35 () in let _lhsOinputs :: [(Identifier, Attributes)] !_lhsOinputs = rule33 () in let _lhsOoutputs :: [(Identifier, Attributes)] !_lhsOoutputs = rule34 () in let !__st_ = st53 () !__result_ = T_Children_vOut47 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutputs __st_ in __result_ ) in C_Children_s2 k2 {-# NOINLINE st53 #-} st53 = \ (_ :: ()) -> let v48 :: T_Children_v48 v48 = \ !(T_Children_vIn48 ) -> ( let !_output = rule37 () in let _lhsOoutput :: Children !_lhsOoutput = rule38 _output in let !__result_ = T_Children_vOut48 _lhsOoutput in __result_ ) in C_Children_s53 v48 {-# NOINLINE[1] rule33 #-} {-# LINE 246 "src-ag/DefaultRules.ag" #-} rule33 = \ (_ :: ()) -> {-# LINE 246 "src-ag/DefaultRules.ag" #-} [] {-# LINE 927 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule34 #-} {-# LINE 247 "src-ag/DefaultRules.ag" #-} rule34 = \ (_ :: ()) -> {-# LINE 247 "src-ag/DefaultRules.ag" #-} [] {-# LINE 933 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule35 #-} {-# LINE 571 "src-ag/DefaultRules.ag" #-} rule35 = \ (_ :: ()) -> {-# LINE 571 "src-ag/DefaultRules.ag" #-} [] {-# LINE 939 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule36 #-} rule36 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule37 #-} rule37 = \ (_ :: ()) -> [] {-# NOINLINE[1] rule38 #-} rule38 = \ !_output -> _output -- Grammar ----------------------------------------------------- -- wrapper data Inh_Grammar = Inh_Grammar { constructorTypeMap_Inh_Grammar :: !(Map NontermIdent ConstructorType), options_Inh_Grammar :: !(Options) } data Syn_Grammar = Syn_Grammar { errors_Syn_Grammar :: !(Seq Error), output_Syn_Grammar :: !(Grammar) } {-# INLINABLE wrap_Grammar #-} wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar ) wrap_Grammar !(T_Grammar act) !(Inh_Grammar _lhsIconstructorTypeMap _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg2 = T_Grammar_vIn2 _lhsIconstructorTypeMap _lhsIoptions !(T_Grammar_vOut2 _lhsOerrors _lhsOoutput) <- return (inv_Grammar_s4 sem arg2) return (Syn_Grammar _lhsOerrors _lhsOoutput) ) -- cata {-# INLINE sem_Grammar #-} sem_Grammar :: Grammar -> T_Grammar sem_Grammar ( Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ nonts_ !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !quantMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ !mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ -- semantic domain newtype T_Grammar = T_Grammar { attach_T_Grammar :: Identity (T_Grammar_s4 ) } newtype T_Grammar_s4 = C_Grammar_s4 { inv_Grammar_s4 :: (T_Grammar_v2 ) } data T_Grammar_s5 = C_Grammar_s5 type T_Grammar_v2 = (T_Grammar_vIn2 ) -> (T_Grammar_vOut2 ) data T_Grammar_vIn2 = T_Grammar_vIn2 !(Map NontermIdent ConstructorType) !(Options) data T_Grammar_vOut2 = T_Grammar_vOut2 !(Seq Error) !(Grammar) {-# NOINLINE sem_Grammar_Grammar #-} sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar sem_Grammar_Grammar !arg_typeSyns_ !arg_useMap_ !arg_derivings_ !arg_wrappers_ arg_nonts_ !arg_pragmas_ !arg_manualAttrOrderMap_ !arg_paramMap_ !arg_contextMap_ !arg_quantMap_ !arg_uniqueMap_ !arg_augmentsMap_ !arg_aroundsMap_ !arg_mergeMap_ = T_Grammar (return st4) where {-# NOINLINE st4 #-} !st4 = let v2 :: T_Grammar_v2 v2 = \ !(T_Grammar_vIn2 _lhsIconstructorTypeMap _lhsIoptions) -> ( let !_nontsX8 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) in let !_nontsOuniq = rule47 () in let !_nontsOconstructorTypeMap = rule55 _lhsIconstructorTypeMap in let !_nontsOcr = rule42 _lhsIoptions in let !_nontsOmanualAttrOrderMap = rule48 arg_manualAttrOrderMap_ in let !_nontsOmergesIn = rule51 arg_mergeMap_ in let !_nontsOo_rename = rule41 _lhsIoptions in let !_nontsOoptions = rule56 _lhsIoptions in let !_nontsOtypeSyns = rule46 arg_typeSyns_ in let !_nontsOuseMap = rule45 arg_useMap_ in let !_nontsOwrappers = rule43 arg_wrappers_ in let !_nontsOaroundsIn = rule50 arg_aroundsMap_ in let !_nontsOaugmentsIn = rule49 arg_augmentsMap_ in let !(T_Nonterminals_vOut15 _nontsIinhMap' _nontsIsynMap' _nontsX28) = inv_Nonterminals_s8 _nontsX8 K_Nonterminals_v15 (T_Nonterminals_vIn15 ) in let !_nontsOinhMap = rule39 _nontsIinhMap' in let !_nontsOsynMap = rule40 _nontsIsynMap' in let !(T_Nonterminals_vOut16 _nontsIerrors _nontsIoutput _nontsIuniq) = inv_Nonterminals_s28 _nontsX28 K_Nonterminals_v16 (T_Nonterminals_vIn16 _nontsOaroundsIn _nontsOaugmentsIn _nontsOconstructorTypeMap _nontsOcr _nontsOinhMap _nontsOmanualAttrOrderMap _nontsOmergesIn _nontsOo_rename _nontsOoptions _nontsOsynMap _nontsOtypeSyns _nontsOuniq _nontsOuseMap _nontsOwrappers) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule52 _nontsIerrors in let !_output = rule53 _nontsIoutput arg_aroundsMap_ arg_augmentsMap_ arg_contextMap_ arg_derivings_ arg_manualAttrOrderMap_ arg_mergeMap_ arg_paramMap_ arg_pragmas_ arg_quantMap_ arg_typeSyns_ arg_uniqueMap_ arg_useMap_ arg_wrappers_ in let _lhsOoutput :: Grammar !_lhsOoutput = rule54 _output in let !__result_ = T_Grammar_vOut2 _lhsOerrors _lhsOoutput in __result_ ) in C_Grammar_s4 v2 {-# INLINE rule39 #-} {-# LINE 15 "src-ag/DistChildAttr.ag" #-} rule39 = \ ((!_nontsIinhMap') :: Map Identifier Attributes) -> {-# LINE 15 "src-ag/DistChildAttr.ag" #-} _nontsIinhMap' {-# LINE 1017 "dist/build/DefaultRules.hs"#-} {-# INLINE rule40 #-} {-# LINE 16 "src-ag/DistChildAttr.ag" #-} rule40 = \ ((!_nontsIsynMap') :: Map Identifier Attributes) -> {-# LINE 16 "src-ag/DistChildAttr.ag" #-} _nontsIsynMap' {-# LINE 1023 "dist/build/DefaultRules.hs"#-} {-# INLINE rule41 #-} {-# LINE 60 "src-ag/DefaultRules.ag" #-} rule41 = \ ((!_lhsIoptions) :: Options) -> {-# LINE 60 "src-ag/DefaultRules.ag" #-} rename _lhsIoptions {-# LINE 1029 "dist/build/DefaultRules.hs"#-} {-# INLINE rule42 #-} {-# LINE 61 "src-ag/DefaultRules.ag" #-} rule42 = \ ((!_lhsIoptions) :: Options) -> {-# LINE 61 "src-ag/DefaultRules.ag" #-} modcopy _lhsIoptions {-# LINE 1035 "dist/build/DefaultRules.hs"#-} {-# INLINE rule43 #-} {-# LINE 69 "src-ag/DefaultRules.ag" #-} rule43 = \ !wrappers_ -> {-# LINE 69 "src-ag/DefaultRules.ag" #-} wrappers_ {-# LINE 1041 "dist/build/DefaultRules.hs"#-} {-# INLINE rule45 #-} {-# LINE 231 "src-ag/DefaultRules.ag" #-} rule45 = \ !useMap_ -> {-# LINE 231 "src-ag/DefaultRules.ag" #-} useMap_ {-# LINE 1047 "dist/build/DefaultRules.hs"#-} {-# INLINE rule46 #-} {-# LINE 233 "src-ag/DefaultRules.ag" #-} rule46 = \ !typeSyns_ -> {-# LINE 233 "src-ag/DefaultRules.ag" #-} typeSyns_ {-# LINE 1053 "dist/build/DefaultRules.hs"#-} {-# INLINE rule47 #-} {-# LINE 623 "src-ag/DefaultRules.ag" #-} rule47 = \ (_ :: ()) -> {-# LINE 623 "src-ag/DefaultRules.ag" #-} 1 {-# LINE 1059 "dist/build/DefaultRules.hs"#-} {-# INLINE rule48 #-} {-# LINE 737 "src-ag/DefaultRules.ag" #-} rule48 = \ !manualAttrOrderMap_ -> {-# LINE 737 "src-ag/DefaultRules.ag" #-} manualAttrOrderMap_ {-# LINE 1065 "dist/build/DefaultRules.hs"#-} {-# INLINE rule49 #-} {-# LINE 803 "src-ag/DefaultRules.ag" #-} rule49 = \ !augmentsMap_ -> {-# LINE 803 "src-ag/DefaultRules.ag" #-} augmentsMap_ {-# LINE 1071 "dist/build/DefaultRules.hs"#-} {-# INLINE rule50 #-} {-# LINE 810 "src-ag/DefaultRules.ag" #-} rule50 = \ !aroundsMap_ -> {-# LINE 810 "src-ag/DefaultRules.ag" #-} aroundsMap_ {-# LINE 1077 "dist/build/DefaultRules.hs"#-} {-# INLINE rule51 #-} {-# LINE 818 "src-ag/DefaultRules.ag" #-} rule51 = \ !mergeMap_ -> {-# LINE 818 "src-ag/DefaultRules.ag" #-} mergeMap_ {-# LINE 1083 "dist/build/DefaultRules.hs"#-} {-# INLINE rule52 #-} rule52 = \ ((!_nontsIerrors) :: Seq Error) -> _nontsIerrors {-# INLINE rule53 #-} rule53 = \ ((!_nontsIoutput) :: Nonterminals) !aroundsMap_ !augmentsMap_ !contextMap_ !derivings_ !manualAttrOrderMap_ !mergeMap_ !paramMap_ !pragmas_ !quantMap_ !typeSyns_ !uniqueMap_ !useMap_ !wrappers_ -> Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ {-# INLINE rule54 #-} rule54 = \ !_output -> _output {-# INLINE rule55 #-} rule55 = \ ((!_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# INLINE rule56 #-} rule56 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions -- Nonterminal ------------------------------------------------- -- wrapper data Inh_Nonterminal = Inh_Nonterminal { aroundsIn_Inh_Nonterminal :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), augmentsIn_Inh_Nonterminal :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), constructorTypeMap_Inh_Nonterminal :: !(Map NontermIdent ConstructorType), cr_Inh_Nonterminal :: !(Bool), inhMap_Inh_Nonterminal :: !(Map Identifier Attributes), manualAttrOrderMap_Inh_Nonterminal :: !(AttrOrderMap), mergesIn_Inh_Nonterminal :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))), nonterminals_Inh_Nonterminal :: !(Set NontermIdent), o_rename_Inh_Nonterminal :: !(Bool), options_Inh_Nonterminal :: !(Options), synMap_Inh_Nonterminal :: !(Map Identifier Attributes), typeSyns_Inh_Nonterminal :: !(TypeSyns), uniq_Inh_Nonterminal :: !(Int), useMap_Inh_Nonterminal :: !(UseMap), wrappers_Inh_Nonterminal :: !(Set NontermIdent) } data Syn_Nonterminal = Syn_Nonterminal { collect_nts_Syn_Nonterminal :: !(Set NontermIdent), errors_Syn_Nonterminal :: !(Seq Error), inhMap'_Syn_Nonterminal :: !(Map Identifier Attributes), output_Syn_Nonterminal :: !(Nonterminal), synMap'_Syn_Nonterminal :: !(Map Identifier Attributes), uniq_Syn_Nonterminal :: !(Int) } {-# INLINABLE wrap_Nonterminal #-} wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal ) wrap_Nonterminal !(T_Nonterminal act) !(Inh_Nonterminal _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg3 = T_Nonterminal_vIn3 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers !(T_Nonterminal_vOut3 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq) <- return (inv_Nonterminal_s6 sem K_Nonterminal_v3 arg3) return (Syn_Nonterminal _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq) ) -- cata {-# INLINE sem_Nonterminal #-} sem_Nonterminal :: Nonterminal -> T_Nonterminal sem_Nonterminal ( Nonterminal !nt_ !params_ !inh_ !syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ ) -- semantic domain newtype T_Nonterminal = T_Nonterminal { attach_T_Nonterminal :: Identity (T_Nonterminal_s6 ) } data T_Nonterminal_s6 where C_Nonterminal_s6 :: { inv_Nonterminal_s6 :: !(forall t. K_Nonterminal_s6 t -> t) } -> T_Nonterminal_s6 data T_Nonterminal_s7 = C_Nonterminal_s7 data T_Nonterminal_s31 = C_Nonterminal_s31 data T_Nonterminal_s43 where C_Nonterminal_s43 :: { inv_Nonterminal_s43 :: !(forall t. K_Nonterminal_s43 t -> t) } -> T_Nonterminal_s43 data T_Nonterminal_s44 = C_Nonterminal_s44 newtype T_Nonterminal_s46 = C_Nonterminal_s46 { inv_Nonterminal_s46 :: (T_Nonterminal_v37 ) } newtype T_Nonterminal_s52 = C_Nonterminal_s52 { inv_Nonterminal_s52 :: (T_Nonterminal_v46 ) } data K_Nonterminal_s6 k where K_Nonterminal_v3 :: K_Nonterminal_s6 (T_Nonterminal_v3 ) K_Nonterminal_v18 :: K_Nonterminal_s6 (T_Nonterminal_v18 ) K_Nonterminal_v32 :: K_Nonterminal_s6 (T_Nonterminal_v32 ) K_Nonterminal_v36 :: K_Nonterminal_s6 (T_Nonterminal_v36 ) data K_Nonterminal_s43 k where K_Nonterminal_v33 :: K_Nonterminal_s43 (T_Nonterminal_v33 ) K_Nonterminal_v45 :: K_Nonterminal_s43 (T_Nonterminal_v45 ) type T_Nonterminal_v3 = (T_Nonterminal_vIn3 ) -> (T_Nonterminal_vOut3 ) data T_Nonterminal_vIn3 = T_Nonterminal_vIn3 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent ConstructorType) !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Set NontermIdent) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(Int) !(UseMap) !(Set NontermIdent) data T_Nonterminal_vOut3 = T_Nonterminal_vOut3 !(Set NontermIdent) !(Seq Error) !(Map Identifier Attributes) !(Nonterminal) !(Map Identifier Attributes) !(Int) type T_Nonterminal_v18 = (T_Nonterminal_vIn18 ) -> (T_Nonterminal_vOut18 ) data T_Nonterminal_vIn18 = T_Nonterminal_vIn18 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent ConstructorType) !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(Int) !(UseMap) !(Set NontermIdent) data T_Nonterminal_vOut18 = T_Nonterminal_vOut18 !(Set NontermIdent) !(Seq Error) !(Map Identifier Attributes) !(Nonterminal) !(Map Identifier Attributes) !(Int) type T_Nonterminal_v32 = (T_Nonterminal_vIn32 ) -> (T_Nonterminal_vOut32 ) data T_Nonterminal_vIn32 = T_Nonterminal_vIn32 data T_Nonterminal_vOut32 = T_Nonterminal_vOut32 !(Map Identifier Attributes) !(Map Identifier Attributes) !(T_Nonterminal_s43 ) type T_Nonterminal_v33 = (T_Nonterminal_vIn33 ) -> (T_Nonterminal_vOut33 ) data T_Nonterminal_vIn33 = T_Nonterminal_vIn33 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent ConstructorType) !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(Int) !(UseMap) !(Set NontermIdent) data T_Nonterminal_vOut33 = T_Nonterminal_vOut33 !(Seq Error) !(Nonterminal) !(Int) type T_Nonterminal_v36 = (T_Nonterminal_vIn36 ) -> (T_Nonterminal_vOut36 ) data T_Nonterminal_vIn36 = T_Nonterminal_vIn36 !(Map NontermIdent ConstructorType) !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(UseMap) !(Set NontermIdent) data T_Nonterminal_vOut36 = T_Nonterminal_vOut36 !(Set NontermIdent) !(Seq Error) !(Map Identifier Attributes) !(Map Identifier Attributes) !(T_Nonterminal_s46 ) type T_Nonterminal_v37 = (T_Nonterminal_vIn37 ) -> (T_Nonterminal_vOut37 ) data T_Nonterminal_vIn37 = T_Nonterminal_vIn37 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Int) data T_Nonterminal_vOut37 = T_Nonterminal_vOut37 !(Nonterminal) !(Int) type T_Nonterminal_v45 = (T_Nonterminal_vIn45 ) -> (T_Nonterminal_vOut45 ) data T_Nonterminal_vIn45 = T_Nonterminal_vIn45 !(Map NontermIdent ConstructorType) !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(UseMap) !(Set NontermIdent) data T_Nonterminal_vOut45 = T_Nonterminal_vOut45 !(Seq Error) !(T_Nonterminal_s52 ) type T_Nonterminal_v46 = (T_Nonterminal_vIn46 ) -> (T_Nonterminal_vOut46 ) data T_Nonterminal_vIn46 = T_Nonterminal_vIn46 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Int) data T_Nonterminal_vOut46 = T_Nonterminal_vOut46 !(Nonterminal) !(Int) {-# NOINLINE sem_Nonterminal_Nonterminal #-} sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal sem_Nonterminal_Nonterminal !arg_nt_ !arg_params_ !arg_inh_ !arg_syn_ arg_prods_ = T_Nonterminal (return st6) where {-# NOINLINE st6 #-} !st6 = let k6 :: K_Nonterminal_s6 t -> t k6 K_Nonterminal_v3 = v3 k6 K_Nonterminal_v18 = v18 k6 K_Nonterminal_v32 = v32 k6 K_Nonterminal_v36 = v36 v3 :: T_Nonterminal_v3 v3 = \ !(T_Nonterminal_vIn3 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let !_prodsX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) in let _lhsOcollect_nts :: Set NontermIdent !_lhsOcollect_nts = rule60 arg_nt_ in let !_prodsOconstructorTypeMap = rule78 _lhsIconstructorTypeMap in let !_prodsOcr = rule79 _lhsIcr in let !_inh1 = rule67 arg_inh_ arg_nt_ arg_params_ in let !_prodsOinh = rule61 _inh1 in let !_prodsOinhMap = rule80 _lhsIinhMap in let !_prodsOmanualAttrOrderMap = rule81 _lhsImanualAttrOrderMap in let !_mergesIn = rule72 _lhsImergesIn arg_nt_ in let !_prodsOmergesIn = rule82 _mergesIn in let !_prodsOnt = rule66 arg_nt_ in let !_prodsOo_rename = rule84 _lhsIo_rename in let !_prodsOoptions = rule85 _lhsIoptions in let !_syn1 = rule68 arg_nt_ arg_params_ arg_syn_ in let !_prodsOsyn = rule62 _syn1 in let !_prodsOsynMap = rule86 _lhsIsynMap in let !_prodsOsynOrig = rule64 arg_syn_ in let !_prodsOtypeSyns = rule87 _lhsItypeSyns in let !_prodsOuseMap = rule65 _lhsIuseMap arg_nt_ in let !_prodsOwrappers = rule89 _lhsIwrappers in let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule57 arg_inh_ arg_nt_ in let !_aroundsIn = rule71 _lhsIaroundsIn arg_nt_ in let !_prodsOaroundsIn = rule76 _aroundsIn in let !_augmentsIn = rule70 _lhsIaugmentsIn arg_nt_ in let !_prodsOaugmentsIn = rule77 _augmentsIn in let !_prodsOparams = rule59 arg_params_ in let !_prodsOuniq = rule88 _lhsIuniq in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule58 arg_nt_ arg_syn_ in let !(T_Productions_vOut17 _prodsIerrors _prodsIoutput _prodsIuniq) = inv_Productions_s16 _prodsX16 K_Productions_v17 (T_Productions_vIn17 _prodsOaroundsIn _prodsOaugmentsIn _prodsOconstructorTypeMap _prodsOcr _prodsOinh _prodsOinhMap _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnt _prodsOo_rename _prodsOoptions _prodsOparams _prodsOsyn _prodsOsynMap _prodsOsynOrig _prodsOtypeSyns _prodsOuniq _prodsOuseMap _prodsOwrappers) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule73 _prodsIerrors in let _lhsOoutput :: Nonterminal !_lhsOoutput = rule69 _inh1 _prodsIoutput _syn1 arg_nt_ arg_params_ in let _lhsOuniq :: Int !_lhsOuniq = rule75 _prodsIuniq in let !__result_ = T_Nonterminal_vOut3 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq in __result_ ) v18 :: T_Nonterminal_v18 v18 = \ !(T_Nonterminal_vIn18 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let !_prodsX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) in let _lhsOcollect_nts :: Set NontermIdent !_lhsOcollect_nts = rule60 arg_nt_ in let !_prodsOconstructorTypeMap = rule78 _lhsIconstructorTypeMap in let !_prodsOcr = rule79 _lhsIcr in let !_inh1 = rule67 arg_inh_ arg_nt_ arg_params_ in let !_prodsOinh = rule61 _inh1 in let !_prodsOinhMap = rule80 _lhsIinhMap in let !_prodsOmanualAttrOrderMap = rule81 _lhsImanualAttrOrderMap in let !_mergesIn = rule72 _lhsImergesIn arg_nt_ in let !_prodsOmergesIn = rule82 _mergesIn in let !_prodsOnt = rule66 arg_nt_ in let !_prodsOo_rename = rule84 _lhsIo_rename in let !_prodsOoptions = rule85 _lhsIoptions in let !_syn1 = rule68 arg_nt_ arg_params_ arg_syn_ in let !_prodsOsyn = rule62 _syn1 in let !_prodsOsynMap = rule86 _lhsIsynMap in let !_prodsOsynOrig = rule64 arg_syn_ in let !_prodsOtypeSyns = rule87 _lhsItypeSyns in let !_prodsOuseMap = rule65 _lhsIuseMap arg_nt_ in let !_prodsOwrappers = rule89 _lhsIwrappers in let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule57 arg_inh_ arg_nt_ in let !_aroundsIn = rule71 _lhsIaroundsIn arg_nt_ in let !_prodsOaroundsIn = rule76 _aroundsIn in let !_augmentsIn = rule70 _lhsIaugmentsIn arg_nt_ in let !_prodsOaugmentsIn = rule77 _augmentsIn in let !_prodsOparams = rule59 arg_params_ in let !_prodsOuniq = rule88 _lhsIuniq in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule58 arg_nt_ arg_syn_ in let !(T_Productions_vOut17 _prodsIerrors _prodsIoutput _prodsIuniq) = inv_Productions_s16 _prodsX16 K_Productions_v17 (T_Productions_vIn17 _prodsOaroundsIn _prodsOaugmentsIn _prodsOconstructorTypeMap _prodsOcr _prodsOinh _prodsOinhMap _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnt _prodsOo_rename _prodsOoptions _prodsOparams _prodsOsyn _prodsOsynMap _prodsOsynOrig _prodsOtypeSyns _prodsOuniq _prodsOuseMap _prodsOwrappers) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule73 _prodsIerrors in let _lhsOoutput :: Nonterminal !_lhsOoutput = rule69 _inh1 _prodsIoutput _syn1 arg_nt_ arg_params_ in let _lhsOuniq :: Int !_lhsOuniq = rule75 _prodsIuniq in let !__result_ = T_Nonterminal_vOut18 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq in __result_ ) v32 :: T_Nonterminal_v32 v32 = \ !(T_Nonterminal_vIn32 ) -> ( let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule57 arg_inh_ arg_nt_ in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule58 arg_nt_ arg_syn_ in let !__st_ = st43 () !__result_ = T_Nonterminal_vOut32 _lhsOinhMap' _lhsOsynMap' __st_ in __result_ ) v36 :: T_Nonterminal_v36 v36 = \ !(T_Nonterminal_vIn36 _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( let !_prodsX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) in let _lhsOcollect_nts :: Set NontermIdent !_lhsOcollect_nts = rule60 arg_nt_ in let !_prodsOconstructorTypeMap = rule78 _lhsIconstructorTypeMap in let !_prodsOcr = rule79 _lhsIcr in let !_inh1 = rule67 arg_inh_ arg_nt_ arg_params_ in let !_prodsOinh = rule61 _inh1 in let !_prodsOinhMap = rule80 _lhsIinhMap in let !_prodsOmanualAttrOrderMap = rule81 _lhsImanualAttrOrderMap in let !_mergesIn = rule72 _lhsImergesIn arg_nt_ in let !_prodsOmergesIn = rule82 _mergesIn in let !_prodsOnt = rule66 arg_nt_ in let !_prodsOo_rename = rule84 _lhsIo_rename in let !_prodsOoptions = rule85 _lhsIoptions in let !_syn1 = rule68 arg_nt_ arg_params_ arg_syn_ in let !_prodsOsyn = rule62 _syn1 in let !_prodsOsynMap = rule86 _lhsIsynMap in let !_prodsOsynOrig = rule64 arg_syn_ in let !_prodsOtypeSyns = rule87 _lhsItypeSyns in let !_prodsOuseMap = rule65 _lhsIuseMap arg_nt_ in let !_prodsOwrappers = rule89 _lhsIwrappers in let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule57 arg_inh_ arg_nt_ in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule58 arg_nt_ arg_syn_ in let !(T_Productions_vOut26 _prodsIerrors _prodsX39) = inv_Productions_s16 _prodsX16 K_Productions_v26 (T_Productions_vIn26 _prodsOconstructorTypeMap _prodsOcr _prodsOinh _prodsOinhMap _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnt _prodsOo_rename _prodsOoptions _prodsOsyn _prodsOsynMap _prodsOsynOrig _prodsOtypeSyns _prodsOuseMap _prodsOwrappers) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule73 _prodsIerrors in let !__st_ = st46 _inh1 _prodsX39 _syn1 !__result_ = T_Nonterminal_vOut36 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOsynMap' __st_ in __result_ ) in C_Nonterminal_s6 k6 {-# NOINLINE st43 #-} st43 = \ (_ :: ()) -> let k43 :: K_Nonterminal_s43 t -> t k43 K_Nonterminal_v33 = v33 k43 K_Nonterminal_v45 = v45 v33 :: T_Nonterminal_v33 v33 = \ !(T_Nonterminal_vIn33 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let !_prodsOnt = rule66 arg_nt_ in let !_prodsOsynOrig = rule64 arg_syn_ in let !_prodsX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) in let !_prodsOconstructorTypeMap = rule78 _lhsIconstructorTypeMap in let !_prodsOcr = rule79 _lhsIcr in let !_inh1 = rule67 arg_inh_ arg_nt_ arg_params_ in let !_prodsOinh = rule61 _inh1 in let !_prodsOinhMap = rule80 _lhsIinhMap in let !_prodsOmanualAttrOrderMap = rule81 _lhsImanualAttrOrderMap in let !_mergesIn = rule72 _lhsImergesIn arg_nt_ in let !_prodsOmergesIn = rule82 _mergesIn in let !_prodsOo_rename = rule84 _lhsIo_rename in let !_prodsOoptions = rule85 _lhsIoptions in let !_syn1 = rule68 arg_nt_ arg_params_ arg_syn_ in let !_prodsOsyn = rule62 _syn1 in let !_prodsOsynMap = rule86 _lhsIsynMap in let !_prodsOtypeSyns = rule87 _lhsItypeSyns in let !_prodsOuseMap = rule65 _lhsIuseMap arg_nt_ in let !_prodsOwrappers = rule89 _lhsIwrappers in let !_aroundsIn = rule71 _lhsIaroundsIn arg_nt_ in let !_prodsOaroundsIn = rule76 _aroundsIn in let !_augmentsIn = rule70 _lhsIaugmentsIn arg_nt_ in let !_prodsOaugmentsIn = rule77 _augmentsIn in let !_prodsOparams = rule59 arg_params_ in let !_prodsOuniq = rule88 _lhsIuniq in let !(T_Productions_vOut17 _prodsIerrors _prodsIoutput _prodsIuniq) = inv_Productions_s16 _prodsX16 K_Productions_v17 (T_Productions_vIn17 _prodsOaroundsIn _prodsOaugmentsIn _prodsOconstructorTypeMap _prodsOcr _prodsOinh _prodsOinhMap _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnt _prodsOo_rename _prodsOoptions _prodsOparams _prodsOsyn _prodsOsynMap _prodsOsynOrig _prodsOtypeSyns _prodsOuniq _prodsOuseMap _prodsOwrappers) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule73 _prodsIerrors in let _lhsOoutput :: Nonterminal !_lhsOoutput = rule69 _inh1 _prodsIoutput _syn1 arg_nt_ arg_params_ in let _lhsOuniq :: Int !_lhsOuniq = rule75 _prodsIuniq in let !__result_ = T_Nonterminal_vOut33 _lhsOerrors _lhsOoutput _lhsOuniq in __result_ ) v45 :: T_Nonterminal_v45 v45 = \ !(T_Nonterminal_vIn45 _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( let !_prodsOnt = rule66 arg_nt_ in let !_prodsOsynOrig = rule64 arg_syn_ in let !_prodsX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) in let !_prodsOconstructorTypeMap = rule78 _lhsIconstructorTypeMap in let !_prodsOcr = rule79 _lhsIcr in let !_inh1 = rule67 arg_inh_ arg_nt_ arg_params_ in let !_prodsOinh = rule61 _inh1 in let !_prodsOinhMap = rule80 _lhsIinhMap in let !_prodsOmanualAttrOrderMap = rule81 _lhsImanualAttrOrderMap in let !_mergesIn = rule72 _lhsImergesIn arg_nt_ in let !_prodsOmergesIn = rule82 _mergesIn in let !_prodsOo_rename = rule84 _lhsIo_rename in let !_prodsOoptions = rule85 _lhsIoptions in let !_syn1 = rule68 arg_nt_ arg_params_ arg_syn_ in let !_prodsOsyn = rule62 _syn1 in let !_prodsOsynMap = rule86 _lhsIsynMap in let !_prodsOtypeSyns = rule87 _lhsItypeSyns in let !_prodsOuseMap = rule65 _lhsIuseMap arg_nt_ in let !_prodsOwrappers = rule89 _lhsIwrappers in let !(T_Productions_vOut26 _prodsIerrors _prodsX39) = inv_Productions_s16 _prodsX16 K_Productions_v26 (T_Productions_vIn26 _prodsOconstructorTypeMap _prodsOcr _prodsOinh _prodsOinhMap _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnt _prodsOo_rename _prodsOoptions _prodsOsyn _prodsOsynMap _prodsOsynOrig _prodsOtypeSyns _prodsOuseMap _prodsOwrappers) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule73 _prodsIerrors in let !__st_ = st52 _inh1 _prodsX39 _syn1 !__result_ = T_Nonterminal_vOut45 _lhsOerrors __st_ in __result_ ) in C_Nonterminal_s43 k43 {-# NOINLINE st46 #-} st46 = \ !_inh1 !_prodsX39 !_syn1 -> let v37 :: T_Nonterminal_v37 v37 = \ !(T_Nonterminal_vIn37 _lhsIaroundsIn _lhsIaugmentsIn _lhsIuniq) -> ( let !_prodsOparams = rule59 arg_params_ in let !_aroundsIn = rule71 _lhsIaroundsIn arg_nt_ in let !_prodsOaroundsIn = rule76 _aroundsIn in let !_augmentsIn = rule70 _lhsIaugmentsIn arg_nt_ in let !_prodsOaugmentsIn = rule77 _augmentsIn in let !_prodsOuniq = rule88 _lhsIuniq in let !(T_Productions_vOut27 _prodsIoutput _prodsIuniq) = inv_Productions_s39 _prodsX39 (T_Productions_vIn27 _prodsOaroundsIn _prodsOaugmentsIn _prodsOparams _prodsOuniq) in let _lhsOoutput :: Nonterminal !_lhsOoutput = rule69 _inh1 _prodsIoutput _syn1 arg_nt_ arg_params_ in let _lhsOuniq :: Int !_lhsOuniq = rule75 _prodsIuniq in let !__result_ = T_Nonterminal_vOut37 _lhsOoutput _lhsOuniq in __result_ ) in C_Nonterminal_s46 v37 {-# NOINLINE st52 #-} st52 = \ !_inh1 !_prodsX39 !_syn1 -> let v46 :: T_Nonterminal_v46 v46 = \ !(T_Nonterminal_vIn46 _lhsIaroundsIn _lhsIaugmentsIn _lhsIuniq) -> ( let !_prodsOparams = rule59 arg_params_ in let !_aroundsIn = rule71 _lhsIaroundsIn arg_nt_ in let !_prodsOaroundsIn = rule76 _aroundsIn in let !_augmentsIn = rule70 _lhsIaugmentsIn arg_nt_ in let !_prodsOaugmentsIn = rule77 _augmentsIn in let !_prodsOuniq = rule88 _lhsIuniq in let !(T_Productions_vOut27 _prodsIoutput _prodsIuniq) = inv_Productions_s39 _prodsX39 (T_Productions_vIn27 _prodsOaroundsIn _prodsOaugmentsIn _prodsOparams _prodsOuniq) in let _lhsOoutput :: Nonterminal !_lhsOoutput = rule69 _inh1 _prodsIoutput _syn1 arg_nt_ arg_params_ in let _lhsOuniq :: Int !_lhsOuniq = rule75 _prodsIuniq in let !__result_ = T_Nonterminal_vOut46 _lhsOoutput _lhsOuniq in __result_ ) in C_Nonterminal_s52 v46 {-# NOINLINE rule57 #-} {-# LINE 7 "src-ag/DistChildAttr.ag" #-} rule57 = \ !inh_ !nt_ -> {-# LINE 7 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ inh_ {-# LINE 1417 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule58 #-} {-# LINE 8 "src-ag/DistChildAttr.ag" #-} rule58 = \ !nt_ !syn_ -> {-# LINE 8 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ syn_ {-# LINE 1423 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule59 #-} {-# LINE 44 "src-ag/DefaultRules.ag" #-} rule59 = \ !params_ -> {-# LINE 44 "src-ag/DefaultRules.ag" #-} params_ {-# LINE 1429 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule60 #-} {-# LINE 205 "src-ag/DefaultRules.ag" #-} rule60 = \ !nt_ -> {-# LINE 205 "src-ag/DefaultRules.ag" #-} Set.singleton nt_ {-# LINE 1435 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule61 #-} {-# LINE 219 "src-ag/DefaultRules.ag" #-} rule61 = \ !_inh1 -> {-# LINE 219 "src-ag/DefaultRules.ag" #-} _inh1 {-# LINE 1441 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule62 #-} {-# LINE 220 "src-ag/DefaultRules.ag" #-} rule62 = \ !_syn1 -> {-# LINE 220 "src-ag/DefaultRules.ag" #-} _syn1 {-# LINE 1447 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule64 #-} {-# LINE 222 "src-ag/DefaultRules.ag" #-} rule64 = \ !syn_ -> {-# LINE 222 "src-ag/DefaultRules.ag" #-} syn_ {-# LINE 1453 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule65 #-} {-# LINE 223 "src-ag/DefaultRules.ag" #-} rule65 = \ ((!_lhsIuseMap) :: UseMap) !nt_ -> {-# LINE 223 "src-ag/DefaultRules.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIuseMap {-# LINE 1459 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule66 #-} {-# LINE 235 "src-ag/DefaultRules.ag" #-} rule66 = \ !nt_ -> {-# LINE 235 "src-ag/DefaultRules.ag" #-} nt_ {-# LINE 1465 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule67 #-} {-# LINE 592 "src-ag/DefaultRules.ag" #-} rule67 = \ !inh_ !nt_ !params_ -> {-# LINE 592 "src-ag/DefaultRules.ag" #-} Map.map (elimSelfId nt_ params_) inh_ {-# LINE 1471 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule68 #-} {-# LINE 593 "src-ag/DefaultRules.ag" #-} rule68 = \ !nt_ !params_ !syn_ -> {-# LINE 593 "src-ag/DefaultRules.ag" #-} Map.map (elimSelfId nt_ params_) syn_ {-# LINE 1477 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule69 #-} {-# LINE 632 "src-ag/DefaultRules.ag" #-} rule69 = \ !_inh1 ((!_prodsIoutput) :: Productions) !_syn1 !nt_ !params_ -> {-# LINE 632 "src-ag/DefaultRules.ag" #-} Nonterminal nt_ params_ _inh1 _syn1 _prodsIoutput {-# LINE 1483 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule70 #-} {-# LINE 804 "src-ag/DefaultRules.ag" #-} rule70 = \ ((!_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !nt_ -> {-# LINE 804 "src-ag/DefaultRules.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn {-# LINE 1489 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule71 #-} {-# LINE 811 "src-ag/DefaultRules.ag" #-} rule71 = \ ((!_lhsIaroundsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !nt_ -> {-# LINE 811 "src-ag/DefaultRules.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIaroundsIn {-# LINE 1495 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule72 #-} {-# LINE 819 "src-ag/DefaultRules.ag" #-} rule72 = \ ((!_lhsImergesIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !nt_ -> {-# LINE 819 "src-ag/DefaultRules.ag" #-} Map.findWithDefault Map.empty nt_ _lhsImergesIn {-# LINE 1501 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule73 #-} rule73 = \ ((!_prodsIerrors) :: Seq Error) -> _prodsIerrors {-# NOINLINE[1] rule75 #-} rule75 = \ ((!_prodsIuniq) :: Int) -> _prodsIuniq {-# NOINLINE[1] rule76 #-} rule76 = \ !_aroundsIn -> _aroundsIn {-# NOINLINE[1] rule77 #-} rule77 = \ !_augmentsIn -> _augmentsIn {-# NOINLINE[1] rule78 #-} rule78 = \ ((!_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# NOINLINE[1] rule79 #-} rule79 = \ ((!_lhsIcr) :: Bool) -> _lhsIcr {-# NOINLINE[1] rule80 #-} rule80 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule81 #-} rule81 = \ ((!_lhsImanualAttrOrderMap) :: AttrOrderMap) -> _lhsImanualAttrOrderMap {-# NOINLINE[1] rule82 #-} rule82 = \ !_mergesIn -> _mergesIn {-# NOINLINE[1] rule84 #-} rule84 = \ ((!_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# NOINLINE[1] rule85 #-} rule85 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE[1] rule86 #-} rule86 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE[1] rule87 #-} rule87 = \ ((!_lhsItypeSyns) :: TypeSyns) -> _lhsItypeSyns {-# NOINLINE[1] rule88 #-} rule88 = \ ((!_lhsIuniq) :: Int) -> _lhsIuniq {-# NOINLINE[1] rule89 #-} rule89 = \ ((!_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers -- Nonterminals ------------------------------------------------ -- wrapper data Inh_Nonterminals = Inh_Nonterminals { aroundsIn_Inh_Nonterminals :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), augmentsIn_Inh_Nonterminals :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), constructorTypeMap_Inh_Nonterminals :: !(Map NontermIdent ConstructorType), cr_Inh_Nonterminals :: !(Bool), inhMap_Inh_Nonterminals :: !(Map Identifier Attributes), manualAttrOrderMap_Inh_Nonterminals :: !(AttrOrderMap), mergesIn_Inh_Nonterminals :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))), nonterminals_Inh_Nonterminals :: !(Set NontermIdent), o_rename_Inh_Nonterminals :: !(Bool), options_Inh_Nonterminals :: !(Options), synMap_Inh_Nonterminals :: !(Map Identifier Attributes), typeSyns_Inh_Nonterminals :: !(TypeSyns), uniq_Inh_Nonterminals :: !(Int), useMap_Inh_Nonterminals :: !(UseMap), wrappers_Inh_Nonterminals :: !(Set NontermIdent) } data Syn_Nonterminals = Syn_Nonterminals { collect_nts_Syn_Nonterminals :: !(Set NontermIdent), errors_Syn_Nonterminals :: !(Seq Error), inhMap'_Syn_Nonterminals :: !(Map Identifier Attributes), output_Syn_Nonterminals :: !(Nonterminals), synMap'_Syn_Nonterminals :: !(Map Identifier Attributes), uniq_Syn_Nonterminals :: !(Int) } {-# INLINABLE wrap_Nonterminals #-} wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals ) wrap_Nonterminals !(T_Nonterminals act) !(Inh_Nonterminals _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg4 = T_Nonterminals_vIn4 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers !(T_Nonterminals_vOut4 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq) <- return (inv_Nonterminals_s8 sem K_Nonterminals_v4 arg4) return (Syn_Nonterminals _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq) ) -- cata {-# NOINLINE sem_Nonterminals #-} sem_Nonterminals :: Nonterminals -> T_Nonterminals sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) -- semantic domain newtype T_Nonterminals = T_Nonterminals { attach_T_Nonterminals :: Identity (T_Nonterminals_s8 ) } data T_Nonterminals_s8 where C_Nonterminals_s8 :: { inv_Nonterminals_s8 :: !(forall t. K_Nonterminals_s8 t -> t) } -> T_Nonterminals_s8 data T_Nonterminals_s9 = C_Nonterminals_s9 data T_Nonterminals_s28 where C_Nonterminals_s28 :: { inv_Nonterminals_s28 :: !(forall t. K_Nonterminals_s28 t -> t) } -> T_Nonterminals_s28 data T_Nonterminals_s29 = C_Nonterminals_s29 newtype T_Nonterminals_s32 = C_Nonterminals_s32 { inv_Nonterminals_s32 :: (T_Nonterminals_v20 ) } data T_Nonterminals_s33 = C_Nonterminals_s33 newtype T_Nonterminals_s45 = C_Nonterminals_s45 { inv_Nonterminals_s45 :: (T_Nonterminals_v35 ) } data K_Nonterminals_s8 k where K_Nonterminals_v4 :: K_Nonterminals_s8 (T_Nonterminals_v4 ) K_Nonterminals_v15 :: K_Nonterminals_s8 (T_Nonterminals_v15 ) K_Nonterminals_v19 :: K_Nonterminals_s8 (T_Nonterminals_v19 ) data K_Nonterminals_s28 k where K_Nonterminals_v16 :: K_Nonterminals_s28 (T_Nonterminals_v16 ) K_Nonterminals_v34 :: K_Nonterminals_s28 (T_Nonterminals_v34 ) type T_Nonterminals_v4 = (T_Nonterminals_vIn4 ) -> (T_Nonterminals_vOut4 ) data T_Nonterminals_vIn4 = T_Nonterminals_vIn4 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent ConstructorType) !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Set NontermIdent) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(Int) !(UseMap) !(Set NontermIdent) data T_Nonterminals_vOut4 = T_Nonterminals_vOut4 !(Set NontermIdent) !(Seq Error) !(Map Identifier Attributes) !(Nonterminals) !(Map Identifier Attributes) !(Int) type T_Nonterminals_v15 = (T_Nonterminals_vIn15 ) -> (T_Nonterminals_vOut15 ) data T_Nonterminals_vIn15 = T_Nonterminals_vIn15 data T_Nonterminals_vOut15 = T_Nonterminals_vOut15 !(Map Identifier Attributes) !(Map Identifier Attributes) !(T_Nonterminals_s28 ) type T_Nonterminals_v16 = (T_Nonterminals_vIn16 ) -> (T_Nonterminals_vOut16 ) data T_Nonterminals_vIn16 = T_Nonterminals_vIn16 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent ConstructorType) !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(Int) !(UseMap) !(Set NontermIdent) data T_Nonterminals_vOut16 = T_Nonterminals_vOut16 !(Seq Error) !(Nonterminals) !(Int) type T_Nonterminals_v19 = (T_Nonterminals_vIn19 ) -> (T_Nonterminals_vOut19 ) data T_Nonterminals_vIn19 = T_Nonterminals_vIn19 !(Map NontermIdent ConstructorType) !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(UseMap) !(Set NontermIdent) data T_Nonterminals_vOut19 = T_Nonterminals_vOut19 !(Set NontermIdent) !(Seq Error) !(Map Identifier Attributes) !(Map Identifier Attributes) !(T_Nonterminals_s32 ) type T_Nonterminals_v20 = (T_Nonterminals_vIn20 ) -> (T_Nonterminals_vOut20 ) data T_Nonterminals_vIn20 = T_Nonterminals_vIn20 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Int) data T_Nonterminals_vOut20 = T_Nonterminals_vOut20 !(Nonterminals) !(Int) type T_Nonterminals_v34 = (T_Nonterminals_vIn34 ) -> (T_Nonterminals_vOut34 ) data T_Nonterminals_vIn34 = T_Nonterminals_vIn34 !(Map NontermIdent ConstructorType) !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(UseMap) !(Set NontermIdent) data T_Nonterminals_vOut34 = T_Nonterminals_vOut34 !(Seq Error) !(T_Nonterminals_s45 ) type T_Nonterminals_v35 = (T_Nonterminals_vIn35 ) -> (T_Nonterminals_vOut35 ) data T_Nonterminals_vIn35 = T_Nonterminals_vIn35 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Int) data T_Nonterminals_vOut35 = T_Nonterminals_vOut35 !(Nonterminals) !(Int) {-# NOINLINE sem_Nonterminals_Cons #-} sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st8) where {-# NOINLINE st8 #-} !st8 = let k8 :: K_Nonterminals_s8 t -> t k8 K_Nonterminals_v4 = v4 k8 K_Nonterminals_v15 = v15 k8 K_Nonterminals_v19 = v19 v4 :: T_Nonterminals_v4 v4 = \ !(T_Nonterminals_vIn4 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let !_hdX6 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) in let !_tlX8 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) in let !_hdOconstructorTypeMap = rule99 _lhsIconstructorTypeMap in let !_hdOcr = rule100 _lhsIcr in let !_hdOinhMap = rule101 _lhsIinhMap in let !_hdOmanualAttrOrderMap = rule102 _lhsImanualAttrOrderMap in let !_hdOmergesIn = rule103 _lhsImergesIn in let !_hdOo_rename = rule105 _lhsIo_rename in let !_hdOoptions = rule106 _lhsIoptions in let !_hdOsynMap = rule107 _lhsIsynMap in let !_hdOtypeSyns = rule108 _lhsItypeSyns in let !_hdOuseMap = rule110 _lhsIuseMap in let !_hdOwrappers = rule111 _lhsIwrappers in let !_tlOconstructorTypeMap = rule114 _lhsIconstructorTypeMap in let !_tlOcr = rule115 _lhsIcr in let !_tlOinhMap = rule116 _lhsIinhMap in let !_tlOmanualAttrOrderMap = rule117 _lhsImanualAttrOrderMap in let !_tlOmergesIn = rule118 _lhsImergesIn in let !_tlOo_rename = rule120 _lhsIo_rename in let !_tlOoptions = rule121 _lhsIoptions in let !_tlOsynMap = rule122 _lhsIsynMap in let !_tlOtypeSyns = rule123 _lhsItypeSyns in let !_tlOuseMap = rule125 _lhsIuseMap in let !_tlOwrappers = rule126 _lhsIwrappers in let !_hdOaroundsIn = rule97 _lhsIaroundsIn in let !_hdOaugmentsIn = rule98 _lhsIaugmentsIn in let !_hdOuniq = rule109 _lhsIuniq in let !_tlOaroundsIn = rule112 _lhsIaroundsIn in let !_tlOaugmentsIn = rule113 _lhsIaugmentsIn in let !(T_Nonterminal_vOut18 _hdIcollect_nts _hdIerrors _hdIinhMap' _hdIoutput _hdIsynMap' _hdIuniq) = inv_Nonterminal_s6 _hdX6 K_Nonterminal_v18 (T_Nonterminal_vIn18 _hdOaroundsIn _hdOaugmentsIn _hdOconstructorTypeMap _hdOcr _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOo_rename _hdOoptions _hdOsynMap _hdOtypeSyns _hdOuniq _hdOuseMap _hdOwrappers) in let !(T_Nonterminals_vOut19 _tlIcollect_nts _tlIerrors _tlIinhMap' _tlIsynMap' _tlX32) = inv_Nonterminals_s8 _tlX8 K_Nonterminals_v19 (T_Nonterminals_vIn19 _tlOconstructorTypeMap _tlOcr _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOo_rename _tlOoptions _tlOsynMap _tlOtypeSyns _tlOuseMap _tlOwrappers) in let _lhsOcollect_nts :: Set NontermIdent !_lhsOcollect_nts = rule90 _hdIcollect_nts _tlIcollect_nts in let _lhsOerrors :: Seq Error !_lhsOerrors = rule91 _hdIerrors _tlIerrors in let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule92 _hdIinhMap' _tlIinhMap' in let !_tlOuniq = rule124 _hdIuniq in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule93 _hdIsynMap' _tlIsynMap' in let !(T_Nonterminals_vOut20 _tlIoutput _tlIuniq) = inv_Nonterminals_s32 _tlX32 (T_Nonterminals_vIn20 _tlOaroundsIn _tlOaugmentsIn _tlOuniq) in let !_output = rule94 _hdIoutput _tlIoutput in let _lhsOoutput :: Nonterminals !_lhsOoutput = rule95 _output in let _lhsOuniq :: Int !_lhsOuniq = rule96 _tlIuniq in let !__result_ = T_Nonterminals_vOut4 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq in __result_ ) v15 :: T_Nonterminals_v15 v15 = \ !(T_Nonterminals_vIn15 ) -> ( let !_hdX6 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) in let !_tlX8 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) in let !(T_Nonterminal_vOut32 _hdIinhMap' _hdIsynMap' _hdX43) = inv_Nonterminal_s6 _hdX6 K_Nonterminal_v32 (T_Nonterminal_vIn32 ) in let !(T_Nonterminals_vOut15 _tlIinhMap' _tlIsynMap' _tlX28) = inv_Nonterminals_s8 _tlX8 K_Nonterminals_v15 (T_Nonterminals_vIn15 ) in let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule92 _hdIinhMap' _tlIinhMap' in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule93 _hdIsynMap' _tlIsynMap' in let !__st_ = st28 _hdX43 _tlX28 !__result_ = T_Nonterminals_vOut15 _lhsOinhMap' _lhsOsynMap' __st_ in __result_ ) v19 :: T_Nonterminals_v19 v19 = \ !(T_Nonterminals_vIn19 _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( let !_hdX6 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) in let !_tlX8 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) in let !_hdOconstructorTypeMap = rule99 _lhsIconstructorTypeMap in let !_hdOcr = rule100 _lhsIcr in let !_hdOinhMap = rule101 _lhsIinhMap in let !_hdOmanualAttrOrderMap = rule102 _lhsImanualAttrOrderMap in let !_hdOmergesIn = rule103 _lhsImergesIn in let !_hdOo_rename = rule105 _lhsIo_rename in let !_hdOoptions = rule106 _lhsIoptions in let !_hdOsynMap = rule107 _lhsIsynMap in let !_hdOtypeSyns = rule108 _lhsItypeSyns in let !_hdOuseMap = rule110 _lhsIuseMap in let !_hdOwrappers = rule111 _lhsIwrappers in let !_tlOconstructorTypeMap = rule114 _lhsIconstructorTypeMap in let !_tlOcr = rule115 _lhsIcr in let !_tlOinhMap = rule116 _lhsIinhMap in let !_tlOmanualAttrOrderMap = rule117 _lhsImanualAttrOrderMap in let !_tlOmergesIn = rule118 _lhsImergesIn in let !_tlOo_rename = rule120 _lhsIo_rename in let !_tlOoptions = rule121 _lhsIoptions in let !_tlOsynMap = rule122 _lhsIsynMap in let !_tlOtypeSyns = rule123 _lhsItypeSyns in let !_tlOuseMap = rule125 _lhsIuseMap in let !_tlOwrappers = rule126 _lhsIwrappers in let !(T_Nonterminal_vOut36 _hdIcollect_nts _hdIerrors _hdIinhMap' _hdIsynMap' _hdX46) = inv_Nonterminal_s6 _hdX6 K_Nonterminal_v36 (T_Nonterminal_vIn36 _hdOconstructorTypeMap _hdOcr _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOo_rename _hdOoptions _hdOsynMap _hdOtypeSyns _hdOuseMap _hdOwrappers) in let !(T_Nonterminals_vOut19 _tlIcollect_nts _tlIerrors _tlIinhMap' _tlIsynMap' _tlX32) = inv_Nonterminals_s8 _tlX8 K_Nonterminals_v19 (T_Nonterminals_vIn19 _tlOconstructorTypeMap _tlOcr _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOo_rename _tlOoptions _tlOsynMap _tlOtypeSyns _tlOuseMap _tlOwrappers) in let _lhsOcollect_nts :: Set NontermIdent !_lhsOcollect_nts = rule90 _hdIcollect_nts _tlIcollect_nts in let _lhsOerrors :: Seq Error !_lhsOerrors = rule91 _hdIerrors _tlIerrors in let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule92 _hdIinhMap' _tlIinhMap' in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule93 _hdIsynMap' _tlIsynMap' in let !__st_ = st32 _hdX46 _tlX32 !__result_ = T_Nonterminals_vOut19 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOsynMap' __st_ in __result_ ) in C_Nonterminals_s8 k8 {-# NOINLINE st28 #-} st28 = \ !_hdX43 !_tlX28 -> let k28 :: K_Nonterminals_s28 t -> t k28 K_Nonterminals_v16 = v16 k28 K_Nonterminals_v34 = v34 v16 :: T_Nonterminals_v16 v16 = \ !(T_Nonterminals_vIn16 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let !_hdOconstructorTypeMap = rule99 _lhsIconstructorTypeMap in let !_hdOcr = rule100 _lhsIcr in let !_hdOinhMap = rule101 _lhsIinhMap in let !_hdOmanualAttrOrderMap = rule102 _lhsImanualAttrOrderMap in let !_hdOmergesIn = rule103 _lhsImergesIn in let !_hdOo_rename = rule105 _lhsIo_rename in let !_hdOoptions = rule106 _lhsIoptions in let !_hdOsynMap = rule107 _lhsIsynMap in let !_hdOtypeSyns = rule108 _lhsItypeSyns in let !_hdOuseMap = rule110 _lhsIuseMap in let !_hdOwrappers = rule111 _lhsIwrappers in let !_tlOconstructorTypeMap = rule114 _lhsIconstructorTypeMap in let !_tlOcr = rule115 _lhsIcr in let !_tlOinhMap = rule116 _lhsIinhMap in let !_tlOmanualAttrOrderMap = rule117 _lhsImanualAttrOrderMap in let !_tlOmergesIn = rule118 _lhsImergesIn in let !_tlOo_rename = rule120 _lhsIo_rename in let !_tlOoptions = rule121 _lhsIoptions in let !_tlOsynMap = rule122 _lhsIsynMap in let !_tlOtypeSyns = rule123 _lhsItypeSyns in let !_tlOuseMap = rule125 _lhsIuseMap in let !_tlOwrappers = rule126 _lhsIwrappers in let !_hdOaroundsIn = rule97 _lhsIaroundsIn in let !_hdOaugmentsIn = rule98 _lhsIaugmentsIn in let !_hdOuniq = rule109 _lhsIuniq in let !_tlOaroundsIn = rule112 _lhsIaroundsIn in let !_tlOaugmentsIn = rule113 _lhsIaugmentsIn in let !(T_Nonterminal_vOut33 _hdIerrors _hdIoutput _hdIuniq) = inv_Nonterminal_s43 _hdX43 K_Nonterminal_v33 (T_Nonterminal_vIn33 _hdOaroundsIn _hdOaugmentsIn _hdOconstructorTypeMap _hdOcr _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOo_rename _hdOoptions _hdOsynMap _hdOtypeSyns _hdOuniq _hdOuseMap _hdOwrappers) in let !(T_Nonterminals_vOut34 _tlIerrors _tlX45) = inv_Nonterminals_s28 _tlX28 K_Nonterminals_v34 (T_Nonterminals_vIn34 _tlOconstructorTypeMap _tlOcr _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOo_rename _tlOoptions _tlOsynMap _tlOtypeSyns _tlOuseMap _tlOwrappers) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule91 _hdIerrors _tlIerrors in let !_tlOuniq = rule124 _hdIuniq in let !(T_Nonterminals_vOut35 _tlIoutput _tlIuniq) = inv_Nonterminals_s45 _tlX45 (T_Nonterminals_vIn35 _tlOaroundsIn _tlOaugmentsIn _tlOuniq) in let !_output = rule94 _hdIoutput _tlIoutput in let _lhsOoutput :: Nonterminals !_lhsOoutput = rule95 _output in let _lhsOuniq :: Int !_lhsOuniq = rule96 _tlIuniq in let !__result_ = T_Nonterminals_vOut16 _lhsOerrors _lhsOoutput _lhsOuniq in __result_ ) v34 :: T_Nonterminals_v34 v34 = \ !(T_Nonterminals_vIn34 _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( let !_hdOconstructorTypeMap = rule99 _lhsIconstructorTypeMap in let !_hdOcr = rule100 _lhsIcr in let !_hdOinhMap = rule101 _lhsIinhMap in let !_hdOmanualAttrOrderMap = rule102 _lhsImanualAttrOrderMap in let !_hdOmergesIn = rule103 _lhsImergesIn in let !_hdOo_rename = rule105 _lhsIo_rename in let !_hdOoptions = rule106 _lhsIoptions in let !_hdOsynMap = rule107 _lhsIsynMap in let !_hdOtypeSyns = rule108 _lhsItypeSyns in let !_hdOuseMap = rule110 _lhsIuseMap in let !_hdOwrappers = rule111 _lhsIwrappers in let !_tlOconstructorTypeMap = rule114 _lhsIconstructorTypeMap in let !_tlOcr = rule115 _lhsIcr in let !_tlOinhMap = rule116 _lhsIinhMap in let !_tlOmanualAttrOrderMap = rule117 _lhsImanualAttrOrderMap in let !_tlOmergesIn = rule118 _lhsImergesIn in let !_tlOo_rename = rule120 _lhsIo_rename in let !_tlOoptions = rule121 _lhsIoptions in let !_tlOsynMap = rule122 _lhsIsynMap in let !_tlOtypeSyns = rule123 _lhsItypeSyns in let !_tlOuseMap = rule125 _lhsIuseMap in let !_tlOwrappers = rule126 _lhsIwrappers in let !(T_Nonterminal_vOut45 _hdIerrors _hdX52) = inv_Nonterminal_s43 _hdX43 K_Nonterminal_v45 (T_Nonterminal_vIn45 _hdOconstructorTypeMap _hdOcr _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOo_rename _hdOoptions _hdOsynMap _hdOtypeSyns _hdOuseMap _hdOwrappers) in let !(T_Nonterminals_vOut34 _tlIerrors _tlX45) = inv_Nonterminals_s28 _tlX28 K_Nonterminals_v34 (T_Nonterminals_vIn34 _tlOconstructorTypeMap _tlOcr _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOo_rename _tlOoptions _tlOsynMap _tlOtypeSyns _tlOuseMap _tlOwrappers) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule91 _hdIerrors _tlIerrors in let !__st_ = st45 _hdX52 _tlX45 !__result_ = T_Nonterminals_vOut34 _lhsOerrors __st_ in __result_ ) in C_Nonterminals_s28 k28 {-# NOINLINE st32 #-} st32 = \ !_hdX46 !_tlX32 -> let v20 :: T_Nonterminals_v20 v20 = \ !(T_Nonterminals_vIn20 _lhsIaroundsIn _lhsIaugmentsIn _lhsIuniq) -> ( let !_hdOaroundsIn = rule97 _lhsIaroundsIn in let !_hdOaugmentsIn = rule98 _lhsIaugmentsIn in let !_hdOuniq = rule109 _lhsIuniq in let !_tlOaroundsIn = rule112 _lhsIaroundsIn in let !_tlOaugmentsIn = rule113 _lhsIaugmentsIn in let !(T_Nonterminal_vOut37 _hdIoutput _hdIuniq) = inv_Nonterminal_s46 _hdX46 (T_Nonterminal_vIn37 _hdOaroundsIn _hdOaugmentsIn _hdOuniq) in let !_tlOuniq = rule124 _hdIuniq in let !(T_Nonterminals_vOut20 _tlIoutput _tlIuniq) = inv_Nonterminals_s32 _tlX32 (T_Nonterminals_vIn20 _tlOaroundsIn _tlOaugmentsIn _tlOuniq) in let !_output = rule94 _hdIoutput _tlIoutput in let _lhsOoutput :: Nonterminals !_lhsOoutput = rule95 _output in let _lhsOuniq :: Int !_lhsOuniq = rule96 _tlIuniq in let !__result_ = T_Nonterminals_vOut20 _lhsOoutput _lhsOuniq in __result_ ) in C_Nonterminals_s32 v20 {-# NOINLINE st45 #-} st45 = \ !_hdX52 !_tlX45 -> let v35 :: T_Nonterminals_v35 v35 = \ !(T_Nonterminals_vIn35 _lhsIaroundsIn _lhsIaugmentsIn _lhsIuniq) -> ( let !_hdOaroundsIn = rule97 _lhsIaroundsIn in let !_hdOaugmentsIn = rule98 _lhsIaugmentsIn in let !_hdOuniq = rule109 _lhsIuniq in let !_tlOaroundsIn = rule112 _lhsIaroundsIn in let !_tlOaugmentsIn = rule113 _lhsIaugmentsIn in let !(T_Nonterminal_vOut46 _hdIoutput _hdIuniq) = inv_Nonterminal_s52 _hdX52 (T_Nonterminal_vIn46 _hdOaroundsIn _hdOaugmentsIn _hdOuniq) in let !_tlOuniq = rule124 _hdIuniq in let !(T_Nonterminals_vOut35 _tlIoutput _tlIuniq) = inv_Nonterminals_s45 _tlX45 (T_Nonterminals_vIn35 _tlOaroundsIn _tlOaugmentsIn _tlOuniq) in let !_output = rule94 _hdIoutput _tlIoutput in let _lhsOoutput :: Nonterminals !_lhsOoutput = rule95 _output in let _lhsOuniq :: Int !_lhsOuniq = rule96 _tlIuniq in let !__result_ = T_Nonterminals_vOut35 _lhsOoutput _lhsOuniq in __result_ ) in C_Nonterminals_s45 v35 {-# NOINLINE[1] rule90 #-} rule90 = \ ((!_hdIcollect_nts) :: Set NontermIdent) ((!_tlIcollect_nts) :: Set NontermIdent) -> _hdIcollect_nts `Set.union` _tlIcollect_nts {-# NOINLINE[1] rule91 #-} rule91 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# NOINLINE[1] rule92 #-} rule92 = \ ((!_hdIinhMap') :: Map Identifier Attributes) ((!_tlIinhMap') :: Map Identifier Attributes) -> _hdIinhMap' `Map.union` _tlIinhMap' {-# NOINLINE[1] rule93 #-} rule93 = \ ((!_hdIsynMap') :: Map Identifier Attributes) ((!_tlIsynMap') :: Map Identifier Attributes) -> _hdIsynMap' `Map.union` _tlIsynMap' {-# NOINLINE[1] rule94 #-} rule94 = \ ((!_hdIoutput) :: Nonterminal) ((!_tlIoutput) :: Nonterminals) -> (:) _hdIoutput _tlIoutput {-# NOINLINE[1] rule95 #-} rule95 = \ !_output -> _output {-# NOINLINE[1] rule96 #-} rule96 = \ ((!_tlIuniq) :: Int) -> _tlIuniq {-# NOINLINE[1] rule97 #-} rule97 = \ ((!_lhsIaroundsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> _lhsIaroundsIn {-# NOINLINE[1] rule98 #-} rule98 = \ ((!_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> _lhsIaugmentsIn {-# NOINLINE[1] rule99 #-} rule99 = \ ((!_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# NOINLINE[1] rule100 #-} rule100 = \ ((!_lhsIcr) :: Bool) -> _lhsIcr {-# NOINLINE[1] rule101 #-} rule101 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule102 #-} rule102 = \ ((!_lhsImanualAttrOrderMap) :: AttrOrderMap) -> _lhsImanualAttrOrderMap {-# NOINLINE[1] rule103 #-} rule103 = \ ((!_lhsImergesIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> _lhsImergesIn {-# NOINLINE[1] rule105 #-} rule105 = \ ((!_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# NOINLINE[1] rule106 #-} rule106 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE[1] rule107 #-} rule107 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE[1] rule108 #-} rule108 = \ ((!_lhsItypeSyns) :: TypeSyns) -> _lhsItypeSyns {-# NOINLINE[1] rule109 #-} rule109 = \ ((!_lhsIuniq) :: Int) -> _lhsIuniq {-# NOINLINE[1] rule110 #-} rule110 = \ ((!_lhsIuseMap) :: UseMap) -> _lhsIuseMap {-# NOINLINE[1] rule111 #-} rule111 = \ ((!_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# NOINLINE[1] rule112 #-} rule112 = \ ((!_lhsIaroundsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> _lhsIaroundsIn {-# NOINLINE[1] rule113 #-} rule113 = \ ((!_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> _lhsIaugmentsIn {-# NOINLINE[1] rule114 #-} rule114 = \ ((!_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# NOINLINE[1] rule115 #-} rule115 = \ ((!_lhsIcr) :: Bool) -> _lhsIcr {-# NOINLINE[1] rule116 #-} rule116 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule117 #-} rule117 = \ ((!_lhsImanualAttrOrderMap) :: AttrOrderMap) -> _lhsImanualAttrOrderMap {-# NOINLINE[1] rule118 #-} rule118 = \ ((!_lhsImergesIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> _lhsImergesIn {-# NOINLINE[1] rule120 #-} rule120 = \ ((!_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# NOINLINE[1] rule121 #-} rule121 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE[1] rule122 #-} rule122 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE[1] rule123 #-} rule123 = \ ((!_lhsItypeSyns) :: TypeSyns) -> _lhsItypeSyns {-# NOINLINE[1] rule124 #-} rule124 = \ ((!_hdIuniq) :: Int) -> _hdIuniq {-# NOINLINE[1] rule125 #-} rule125 = \ ((!_lhsIuseMap) :: UseMap) -> _lhsIuseMap {-# NOINLINE[1] rule126 #-} rule126 = \ ((!_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# NOINLINE sem_Nonterminals_Nil #-} sem_Nonterminals_Nil :: T_Nonterminals sem_Nonterminals_Nil = T_Nonterminals (return st8) where {-# NOINLINE st8 #-} !st8 = let k8 :: K_Nonterminals_s8 t -> t k8 K_Nonterminals_v4 = v4 k8 K_Nonterminals_v15 = v15 k8 K_Nonterminals_v19 = v19 v4 :: T_Nonterminals_v4 v4 = \ !(T_Nonterminals_vIn4 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let _lhsOcollect_nts :: Set NontermIdent !_lhsOcollect_nts = rule127 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule128 () in let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule129 () in let !_output = rule131 () in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule130 () in let _lhsOoutput :: Nonterminals !_lhsOoutput = rule132 _output in let _lhsOuniq :: Int !_lhsOuniq = rule133 _lhsIuniq in let !__result_ = T_Nonterminals_vOut4 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq in __result_ ) v15 :: T_Nonterminals_v15 v15 = \ !(T_Nonterminals_vIn15 ) -> ( let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule129 () in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule130 () in let !__st_ = st28 () !__result_ = T_Nonterminals_vOut15 _lhsOinhMap' _lhsOsynMap' __st_ in __result_ ) v19 :: T_Nonterminals_v19 v19 = \ !(T_Nonterminals_vIn19 _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( let _lhsOcollect_nts :: Set NontermIdent !_lhsOcollect_nts = rule127 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule128 () in let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule129 () in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule130 () in let !__st_ = st32 () !__result_ = T_Nonterminals_vOut19 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOsynMap' __st_ in __result_ ) in C_Nonterminals_s8 k8 {-# NOINLINE st28 #-} st28 = \ (_ :: ()) -> let k28 :: K_Nonterminals_s28 t -> t k28 K_Nonterminals_v16 = v16 k28 K_Nonterminals_v34 = v34 v16 :: T_Nonterminals_v16 v16 = \ !(T_Nonterminals_vIn16 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule128 () in let !_output = rule131 () in let _lhsOoutput :: Nonterminals !_lhsOoutput = rule132 _output in let _lhsOuniq :: Int !_lhsOuniq = rule133 _lhsIuniq in let !__result_ = T_Nonterminals_vOut16 _lhsOerrors _lhsOoutput _lhsOuniq in __result_ ) v34 :: T_Nonterminals_v34 v34 = \ !(T_Nonterminals_vIn34 _lhsIconstructorTypeMap _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule128 () in let !__st_ = st45 () !__result_ = T_Nonterminals_vOut34 _lhsOerrors __st_ in __result_ ) in C_Nonterminals_s28 k28 {-# NOINLINE st32 #-} st32 = \ (_ :: ()) -> let v20 :: T_Nonterminals_v20 v20 = \ !(T_Nonterminals_vIn20 _lhsIaroundsIn _lhsIaugmentsIn _lhsIuniq) -> ( let !_output = rule131 () in let _lhsOoutput :: Nonterminals !_lhsOoutput = rule132 _output in let _lhsOuniq :: Int !_lhsOuniq = rule133 _lhsIuniq in let !__result_ = T_Nonterminals_vOut20 _lhsOoutput _lhsOuniq in __result_ ) in C_Nonterminals_s32 v20 {-# NOINLINE st45 #-} st45 = \ (_ :: ()) -> let v35 :: T_Nonterminals_v35 v35 = \ !(T_Nonterminals_vIn35 _lhsIaroundsIn _lhsIaugmentsIn _lhsIuniq) -> ( let !_output = rule131 () in let _lhsOoutput :: Nonterminals !_lhsOoutput = rule132 _output in let _lhsOuniq :: Int !_lhsOuniq = rule133 _lhsIuniq in let !__result_ = T_Nonterminals_vOut35 _lhsOoutput _lhsOuniq in __result_ ) in C_Nonterminals_s45 v35 {-# NOINLINE[1] rule127 #-} rule127 = \ (_ :: ()) -> Set.empty {-# NOINLINE[1] rule128 #-} rule128 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule129 #-} rule129 = \ (_ :: ()) -> Map.empty {-# NOINLINE[1] rule130 #-} rule130 = \ (_ :: ()) -> Map.empty {-# NOINLINE[1] rule131 #-} rule131 = \ (_ :: ()) -> [] {-# NOINLINE[1] rule132 #-} rule132 = \ !_output -> _output {-# NOINLINE[1] rule133 #-} rule133 = \ ((!_lhsIuniq) :: Int) -> _lhsIuniq -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { con_Inh_Pattern :: !(ConstructorIdent), nt_Inh_Pattern :: !(NontermIdent) } data Syn_Pattern = Syn_Pattern { containsVars_Syn_Pattern :: !(Bool), copy_Syn_Pattern :: !(Pattern), definedAttrs_Syn_Pattern :: !(Set (Identifier,Identifier)), errors_Syn_Pattern :: !(Seq Error), locals_Syn_Pattern :: !(Set Identifier), output_Syn_Pattern :: !(Pattern) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern !(T_Pattern act) !(Inh_Pattern _lhsIcon _lhsInt) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg5 = T_Pattern_vIn5 _lhsIcon _lhsInt !(T_Pattern_vOut5 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput) <- return (inv_Pattern_s10 sem K_Pattern_v5 arg5) return (Syn_Pattern _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr !name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product !pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias !field_ !attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore !pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s10 ) } data T_Pattern_s10 where C_Pattern_s10 :: { inv_Pattern_s10 :: !(forall t. K_Pattern_s10 t -> t) } -> T_Pattern_s10 data T_Pattern_s11 = C_Pattern_s11 data T_Pattern_s35 = C_Pattern_s35 data T_Pattern_s36 = C_Pattern_s36 data T_Pattern_s40 = C_Pattern_s40 data T_Pattern_s50 = C_Pattern_s50 data T_Pattern_s55 where C_Pattern_s55 :: { inv_Pattern_s55 :: !(forall t. K_Pattern_s55 t -> t) } -> T_Pattern_s55 data K_Pattern_s10 k where K_Pattern_v5 :: K_Pattern_s10 (T_Pattern_v5 ) K_Pattern_v22 :: K_Pattern_s10 (T_Pattern_v22 ) K_Pattern_v23 :: K_Pattern_s10 (T_Pattern_v23 ) K_Pattern_v28 :: K_Pattern_s10 (T_Pattern_v28 ) K_Pattern_v42 :: K_Pattern_s10 (T_Pattern_v42 ) K_Pattern_v50 :: K_Pattern_s10 (T_Pattern_v50 ) data K_Pattern_s55 k where K_Pattern_v51 :: K_Pattern_s55 (T_Pattern_v51 ) K_Pattern_v56 :: K_Pattern_s55 (T_Pattern_v56 ) type T_Pattern_v5 = (T_Pattern_vIn5 ) -> (T_Pattern_vOut5 ) data T_Pattern_vIn5 = T_Pattern_vIn5 !(ConstructorIdent) !(NontermIdent) data T_Pattern_vOut5 = T_Pattern_vOut5 !(Bool) !(Pattern) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Pattern) type T_Pattern_v22 = (T_Pattern_vIn22 ) -> (T_Pattern_vOut22 ) data T_Pattern_vIn22 = T_Pattern_vIn22 data T_Pattern_vOut22 = T_Pattern_vOut22 !(Pattern) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Pattern) type T_Pattern_v23 = (T_Pattern_vIn23 ) -> (T_Pattern_vOut23 ) data T_Pattern_vIn23 = T_Pattern_vIn23 data T_Pattern_vOut23 = T_Pattern_vOut23 !(Bool) !(Pattern) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Pattern) type T_Pattern_v28 = (T_Pattern_vIn28 ) -> (T_Pattern_vOut28 ) data T_Pattern_vIn28 = T_Pattern_vIn28 data T_Pattern_vOut28 = T_Pattern_vOut28 !(Bool) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Pattern) type T_Pattern_v42 = (T_Pattern_vIn42 ) -> (T_Pattern_vOut42 ) data T_Pattern_vIn42 = T_Pattern_vIn42 data T_Pattern_vOut42 = T_Pattern_vOut42 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Pattern) type T_Pattern_v50 = (T_Pattern_vIn50 ) -> (T_Pattern_vOut50 ) data T_Pattern_vIn50 = T_Pattern_vIn50 data T_Pattern_vOut50 = T_Pattern_vOut50 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(T_Pattern_s55 ) type T_Pattern_v51 = (T_Pattern_vIn51 ) -> (T_Pattern_vOut51 ) data T_Pattern_vIn51 = T_Pattern_vIn51 data T_Pattern_vOut51 = T_Pattern_vOut51 !(Bool) !(Pattern) type T_Pattern_v56 = (T_Pattern_vIn56 ) -> (T_Pattern_vOut56 ) data T_Pattern_vIn56 = T_Pattern_vIn56 data T_Pattern_vOut56 = T_Pattern_vOut56 !(Pattern) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr !arg_name_ arg_pats_ = T_Pattern (return st10) where {-# NOINLINE st10 #-} !st10 = let k10 :: K_Pattern_s10 t -> t k10 K_Pattern_v5 = v5 k10 K_Pattern_v22 = v22 k10 K_Pattern_v23 = v23 k10 K_Pattern_v28 = v28 k10 K_Pattern_v42 = v42 k10 K_Pattern_v50 = v50 v5 :: T_Pattern_v5 v5 = \ !(T_Pattern_vIn5 _lhsIcon _lhsInt) -> ( let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !(T_Patterns_vOut21 _patsIcontainsVars _patsIcopy _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v21 (T_Patterns_vIn21 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule134 _patsIcontainsVars in let !_copy = rule138 _patsIcopy arg_name_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule140 _copy in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule135 _patsIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule136 _patsIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule137 _patsIlocals in let !_output = rule139 _patsIoutput arg_name_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule141 _output in let !__result_ = T_Pattern_vOut5 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v22 :: T_Pattern_v22 v22 = \ !(T_Pattern_vIn22 ) -> ( let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !(T_Patterns_vOut38 _patsIcopy _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v38 (T_Patterns_vIn38 ) in let !_copy = rule138 _patsIcopy arg_name_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule140 _copy in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule135 _patsIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule136 _patsIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule137 _patsIlocals in let !_output = rule139 _patsIoutput arg_name_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule141 _output in let !__result_ = T_Pattern_vOut22 _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v23 :: T_Pattern_v23 v23 = \ !(T_Pattern_vIn23 ) -> ( let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !(T_Patterns_vOut21 _patsIcontainsVars _patsIcopy _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v21 (T_Patterns_vIn21 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule134 _patsIcontainsVars in let !_copy = rule138 _patsIcopy arg_name_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule140 _copy in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule135 _patsIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule136 _patsIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule137 _patsIlocals in let !_output = rule139 _patsIoutput arg_name_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule141 _output in let !__result_ = T_Pattern_vOut23 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v28 :: T_Pattern_v28 v28 = \ !(T_Pattern_vIn28 ) -> ( let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !(T_Patterns_vOut41 _patsIcontainsVars _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v41 (T_Patterns_vIn41 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule134 _patsIcontainsVars in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule135 _patsIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule136 _patsIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule137 _patsIlocals in let !_output = rule139 _patsIoutput arg_name_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule141 _output in let !__result_ = T_Pattern_vOut28 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v42 :: T_Pattern_v42 v42 = \ !(T_Pattern_vIn42 ) -> ( let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !(T_Patterns_vOut49 _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v49 (T_Patterns_vIn49 ) in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule135 _patsIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule136 _patsIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule137 _patsIlocals in let !_output = rule139 _patsIoutput arg_name_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule141 _output in let !__result_ = T_Pattern_vOut42 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v50 :: T_Pattern_v50 v50 = \ !(T_Pattern_vIn50 ) -> ( let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !(T_Patterns_vOut54 _patsIdefinedAttrs _patsIerrors _patsIlocals _patsX57) = inv_Patterns_s12 _patsX12 K_Patterns_v54 (T_Patterns_vIn54 ) in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule135 _patsIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule136 _patsIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule137 _patsIlocals in let !__st_ = st55 _patsX57 !__result_ = T_Pattern_vOut50 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals __st_ in __result_ ) in C_Pattern_s10 k10 {-# NOINLINE st55 #-} st55 = \ !_patsX57 -> let k55 :: K_Pattern_s55 t -> t k55 K_Pattern_v51 = v51 k55 K_Pattern_v56 = v56 v51 :: T_Pattern_v51 v51 = \ !(T_Pattern_vIn51 ) -> ( let !(T_Patterns_vOut55 _patsIcontainsVars _patsIoutput) = inv_Patterns_s57 _patsX57 K_Patterns_v55 (T_Patterns_vIn55 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule134 _patsIcontainsVars in let !_output = rule139 _patsIoutput arg_name_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule141 _output in let !__result_ = T_Pattern_vOut51 _lhsOcontainsVars _lhsOoutput in __result_ ) v56 :: T_Pattern_v56 v56 = \ !(T_Pattern_vIn56 ) -> ( let !(T_Patterns_vOut57 _patsIoutput) = inv_Patterns_s57 _patsX57 K_Patterns_v57 (T_Patterns_vIn57 ) in let !_output = rule139 _patsIoutput arg_name_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule141 _output in let !__result_ = T_Pattern_vOut56 _lhsOoutput in __result_ ) in C_Pattern_s55 k55 {-# NOINLINE[1] rule134 #-} rule134 = \ ((!_patsIcontainsVars) :: Bool) -> _patsIcontainsVars {-# NOINLINE[1] rule135 #-} rule135 = \ ((!_patsIdefinedAttrs) :: Set (Identifier,Identifier)) -> _patsIdefinedAttrs {-# NOINLINE[1] rule136 #-} rule136 = \ ((!_patsIerrors) :: Seq Error) -> _patsIerrors {-# NOINLINE[1] rule137 #-} rule137 = \ ((!_patsIlocals) :: Set Identifier) -> _patsIlocals {-# NOINLINE[1] rule138 #-} rule138 = \ ((!_patsIcopy) :: Patterns) !name_ -> Constr name_ _patsIcopy {-# NOINLINE[1] rule139 #-} rule139 = \ ((!_patsIoutput) :: Patterns) !name_ -> Constr name_ _patsIoutput {-# NOINLINE[1] rule140 #-} rule140 = \ !_copy -> _copy {-# NOINLINE[1] rule141 #-} rule141 = \ !_output -> _output {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product !arg_pos_ arg_pats_ = T_Pattern (return st10) where {-# NOINLINE st10 #-} !st10 = let k10 :: K_Pattern_s10 t -> t k10 K_Pattern_v5 = v5 k10 K_Pattern_v22 = v22 k10 K_Pattern_v23 = v23 k10 K_Pattern_v28 = v28 k10 K_Pattern_v42 = v42 k10 K_Pattern_v50 = v50 v5 :: T_Pattern_v5 v5 = \ !(T_Pattern_vIn5 _lhsIcon _lhsInt) -> ( let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !(T_Patterns_vOut21 _patsIcontainsVars _patsIcopy _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v21 (T_Patterns_vIn21 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule144 _patsIcontainsVars in let !_copy = rule148 _patsIcopy arg_pos_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule150 _copy in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule145 _patsIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule146 _patsIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule147 _patsIlocals in let !_output = rule149 _patsIoutput arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule151 _output in let !__result_ = T_Pattern_vOut5 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v22 :: T_Pattern_v22 v22 = \ !(T_Pattern_vIn22 ) -> ( let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !(T_Patterns_vOut38 _patsIcopy _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v38 (T_Patterns_vIn38 ) in let !_copy = rule148 _patsIcopy arg_pos_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule150 _copy in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule145 _patsIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule146 _patsIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule147 _patsIlocals in let !_output = rule149 _patsIoutput arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule151 _output in let !__result_ = T_Pattern_vOut22 _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v23 :: T_Pattern_v23 v23 = \ !(T_Pattern_vIn23 ) -> ( let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !(T_Patterns_vOut21 _patsIcontainsVars _patsIcopy _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v21 (T_Patterns_vIn21 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule144 _patsIcontainsVars in let !_copy = rule148 _patsIcopy arg_pos_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule150 _copy in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule145 _patsIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule146 _patsIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule147 _patsIlocals in let !_output = rule149 _patsIoutput arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule151 _output in let !__result_ = T_Pattern_vOut23 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v28 :: T_Pattern_v28 v28 = \ !(T_Pattern_vIn28 ) -> ( let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !(T_Patterns_vOut41 _patsIcontainsVars _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v41 (T_Patterns_vIn41 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule144 _patsIcontainsVars in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule145 _patsIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule146 _patsIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule147 _patsIlocals in let !_output = rule149 _patsIoutput arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule151 _output in let !__result_ = T_Pattern_vOut28 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v42 :: T_Pattern_v42 v42 = \ !(T_Pattern_vIn42 ) -> ( let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !(T_Patterns_vOut49 _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v49 (T_Patterns_vIn49 ) in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule145 _patsIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule146 _patsIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule147 _patsIlocals in let !_output = rule149 _patsIoutput arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule151 _output in let !__result_ = T_Pattern_vOut42 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v50 :: T_Pattern_v50 v50 = \ !(T_Pattern_vIn50 ) -> ( let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !(T_Patterns_vOut54 _patsIdefinedAttrs _patsIerrors _patsIlocals _patsX57) = inv_Patterns_s12 _patsX12 K_Patterns_v54 (T_Patterns_vIn54 ) in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule145 _patsIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule146 _patsIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule147 _patsIlocals in let !__st_ = st55 _patsX57 !__result_ = T_Pattern_vOut50 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals __st_ in __result_ ) in C_Pattern_s10 k10 {-# NOINLINE st55 #-} st55 = \ !_patsX57 -> let k55 :: K_Pattern_s55 t -> t k55 K_Pattern_v51 = v51 k55 K_Pattern_v56 = v56 v51 :: T_Pattern_v51 v51 = \ !(T_Pattern_vIn51 ) -> ( let !(T_Patterns_vOut55 _patsIcontainsVars _patsIoutput) = inv_Patterns_s57 _patsX57 K_Patterns_v55 (T_Patterns_vIn55 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule144 _patsIcontainsVars in let !_output = rule149 _patsIoutput arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule151 _output in let !__result_ = T_Pattern_vOut51 _lhsOcontainsVars _lhsOoutput in __result_ ) v56 :: T_Pattern_v56 v56 = \ !(T_Pattern_vIn56 ) -> ( let !(T_Patterns_vOut57 _patsIoutput) = inv_Patterns_s57 _patsX57 K_Patterns_v57 (T_Patterns_vIn57 ) in let !_output = rule149 _patsIoutput arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule151 _output in let !__result_ = T_Pattern_vOut56 _lhsOoutput in __result_ ) in C_Pattern_s55 k55 {-# NOINLINE[1] rule144 #-} rule144 = \ ((!_patsIcontainsVars) :: Bool) -> _patsIcontainsVars {-# NOINLINE[1] rule145 #-} rule145 = \ ((!_patsIdefinedAttrs) :: Set (Identifier,Identifier)) -> _patsIdefinedAttrs {-# NOINLINE[1] rule146 #-} rule146 = \ ((!_patsIerrors) :: Seq Error) -> _patsIerrors {-# NOINLINE[1] rule147 #-} rule147 = \ ((!_patsIlocals) :: Set Identifier) -> _patsIlocals {-# NOINLINE[1] rule148 #-} rule148 = \ ((!_patsIcopy) :: Patterns) !pos_ -> Product pos_ _patsIcopy {-# NOINLINE[1] rule149 #-} rule149 = \ ((!_patsIoutput) :: Patterns) !pos_ -> Product pos_ _patsIoutput {-# NOINLINE[1] rule150 #-} rule150 = \ !_copy -> _copy {-# NOINLINE[1] rule151 #-} rule151 = \ !_output -> _output {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias !arg_field_ !arg_attr_ arg_pat_ = T_Pattern (return st10) where {-# NOINLINE st10 #-} !st10 = let k10 :: K_Pattern_s10 t -> t k10 K_Pattern_v5 = v5 k10 K_Pattern_v22 = v22 k10 K_Pattern_v23 = v23 k10 K_Pattern_v28 = v28 k10 K_Pattern_v42 = v42 k10 K_Pattern_v50 = v50 v5 :: T_Pattern_v5 v5 = \ !(T_Pattern_vIn5 _lhsIcon _lhsInt) -> ( let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule156 () in let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !(T_Pattern_vOut22 _patIcopy _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v22 (T_Pattern_vIn22 ) in let !_copy = rule158 _patIcopy arg_attr_ arg_field_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule160 _copy in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule154 _patIdefinedAttrs arg_attr_ arg_field_ in let _lhsOerrors :: Seq Error !_lhsOerrors = rule157 _patIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule155 _patIlocals arg_attr_ arg_field_ in let !_output = rule159 _patIoutput arg_attr_ arg_field_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule161 _output in let !__result_ = T_Pattern_vOut5 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v22 :: T_Pattern_v22 v22 = \ !(T_Pattern_vIn22 ) -> ( let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !(T_Pattern_vOut22 _patIcopy _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v22 (T_Pattern_vIn22 ) in let !_copy = rule158 _patIcopy arg_attr_ arg_field_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule160 _copy in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule154 _patIdefinedAttrs arg_attr_ arg_field_ in let _lhsOerrors :: Seq Error !_lhsOerrors = rule157 _patIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule155 _patIlocals arg_attr_ arg_field_ in let !_output = rule159 _patIoutput arg_attr_ arg_field_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule161 _output in let !__result_ = T_Pattern_vOut22 _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v23 :: T_Pattern_v23 v23 = \ !(T_Pattern_vIn23 ) -> ( let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule156 () in let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !(T_Pattern_vOut22 _patIcopy _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v22 (T_Pattern_vIn22 ) in let !_copy = rule158 _patIcopy arg_attr_ arg_field_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule160 _copy in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule154 _patIdefinedAttrs arg_attr_ arg_field_ in let _lhsOerrors :: Seq Error !_lhsOerrors = rule157 _patIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule155 _patIlocals arg_attr_ arg_field_ in let !_output = rule159 _patIoutput arg_attr_ arg_field_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule161 _output in let !__result_ = T_Pattern_vOut23 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v28 :: T_Pattern_v28 v28 = \ !(T_Pattern_vIn28 ) -> ( let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule156 () in let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !(T_Pattern_vOut42 _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v42 (T_Pattern_vIn42 ) in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule154 _patIdefinedAttrs arg_attr_ arg_field_ in let _lhsOerrors :: Seq Error !_lhsOerrors = rule157 _patIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule155 _patIlocals arg_attr_ arg_field_ in let !_output = rule159 _patIoutput arg_attr_ arg_field_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule161 _output in let !__result_ = T_Pattern_vOut28 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v42 :: T_Pattern_v42 v42 = \ !(T_Pattern_vIn42 ) -> ( let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !(T_Pattern_vOut42 _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v42 (T_Pattern_vIn42 ) in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule154 _patIdefinedAttrs arg_attr_ arg_field_ in let _lhsOerrors :: Seq Error !_lhsOerrors = rule157 _patIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule155 _patIlocals arg_attr_ arg_field_ in let !_output = rule159 _patIoutput arg_attr_ arg_field_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule161 _output in let !__result_ = T_Pattern_vOut42 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v50 :: T_Pattern_v50 v50 = \ !(T_Pattern_vIn50 ) -> ( let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !(T_Pattern_vOut50 _patIdefinedAttrs _patIerrors _patIlocals _patX55) = inv_Pattern_s10 _patX10 K_Pattern_v50 (T_Pattern_vIn50 ) in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule154 _patIdefinedAttrs arg_attr_ arg_field_ in let _lhsOerrors :: Seq Error !_lhsOerrors = rule157 _patIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule155 _patIlocals arg_attr_ arg_field_ in let !__st_ = st55 _patX55 !__result_ = T_Pattern_vOut50 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals __st_ in __result_ ) in C_Pattern_s10 k10 {-# NOINLINE st55 #-} st55 = \ !_patX55 -> let k55 :: K_Pattern_s55 t -> t k55 K_Pattern_v51 = v51 k55 K_Pattern_v56 = v56 v51 :: T_Pattern_v51 v51 = \ !(T_Pattern_vIn51 ) -> ( let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule156 () in let !(T_Pattern_vOut56 _patIoutput) = inv_Pattern_s55 _patX55 K_Pattern_v56 (T_Pattern_vIn56 ) in let !_output = rule159 _patIoutput arg_attr_ arg_field_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule161 _output in let !__result_ = T_Pattern_vOut51 _lhsOcontainsVars _lhsOoutput in __result_ ) v56 :: T_Pattern_v56 v56 = \ !(T_Pattern_vIn56 ) -> ( let !(T_Pattern_vOut56 _patIoutput) = inv_Pattern_s55 _patX55 K_Pattern_v56 (T_Pattern_vIn56 ) in let !_output = rule159 _patIoutput arg_attr_ arg_field_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule161 _output in let !__result_ = T_Pattern_vOut56 _lhsOoutput in __result_ ) in C_Pattern_s55 k55 {-# NOINLINE rule154 #-} {-# LINE 564 "src-ag/DefaultRules.ag" #-} rule154 = \ ((!_patIdefinedAttrs) :: Set (Identifier,Identifier)) !attr_ !field_ -> {-# LINE 564 "src-ag/DefaultRules.ag" #-} Set.insert (field_,attr_) _patIdefinedAttrs {-# LINE 2614 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule155 #-} {-# LINE 565 "src-ag/DefaultRules.ag" #-} rule155 = \ ((!_patIlocals) :: Set Identifier) !attr_ !field_ -> {-# LINE 565 "src-ag/DefaultRules.ag" #-} if field_ == _LOC then Set.insert attr_ _patIlocals else _patIlocals {-# LINE 2622 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule156 #-} {-# LINE 582 "src-ag/DefaultRules.ag" #-} rule156 = \ (_ :: ()) -> {-# LINE 582 "src-ag/DefaultRules.ag" #-} True {-# LINE 2628 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule157 #-} rule157 = \ ((!_patIerrors) :: Seq Error) -> _patIerrors {-# NOINLINE[1] rule158 #-} rule158 = \ ((!_patIcopy) :: Pattern) !attr_ !field_ -> Alias field_ attr_ _patIcopy {-# NOINLINE[1] rule159 #-} rule159 = \ ((!_patIoutput) :: Pattern) !attr_ !field_ -> Alias field_ attr_ _patIoutput {-# NOINLINE[1] rule160 #-} rule160 = \ !_copy -> _copy {-# NOINLINE[1] rule161 #-} rule161 = \ !_output -> _output {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st10) where {-# NOINLINE st10 #-} !st10 = let k10 :: K_Pattern_s10 t -> t k10 K_Pattern_v5 = v5 k10 K_Pattern_v22 = v22 k10 K_Pattern_v23 = v23 k10 K_Pattern_v28 = v28 k10 K_Pattern_v42 = v42 k10 K_Pattern_v50 = v50 v5 :: T_Pattern_v5 v5 = \ !(T_Pattern_vIn5 _lhsIcon _lhsInt) -> ( let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !(T_Pattern_vOut23 _patIcontainsVars _patIcopy _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v23 (T_Pattern_vIn23 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule164 _patIcontainsVars in let !_copy = rule168 _patIcopy in let _lhsOcopy :: Pattern !_lhsOcopy = rule170 _copy in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule165 _patIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule166 _patIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule167 _patIlocals in let !_output = rule169 _patIoutput in let _lhsOoutput :: Pattern !_lhsOoutput = rule171 _output in let !__result_ = T_Pattern_vOut5 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v22 :: T_Pattern_v22 v22 = \ !(T_Pattern_vIn22 ) -> ( let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !(T_Pattern_vOut22 _patIcopy _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v22 (T_Pattern_vIn22 ) in let !_copy = rule168 _patIcopy in let _lhsOcopy :: Pattern !_lhsOcopy = rule170 _copy in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule165 _patIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule166 _patIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule167 _patIlocals in let !_output = rule169 _patIoutput in let _lhsOoutput :: Pattern !_lhsOoutput = rule171 _output in let !__result_ = T_Pattern_vOut22 _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v23 :: T_Pattern_v23 v23 = \ !(T_Pattern_vIn23 ) -> ( let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !(T_Pattern_vOut23 _patIcontainsVars _patIcopy _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v23 (T_Pattern_vIn23 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule164 _patIcontainsVars in let !_copy = rule168 _patIcopy in let _lhsOcopy :: Pattern !_lhsOcopy = rule170 _copy in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule165 _patIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule166 _patIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule167 _patIlocals in let !_output = rule169 _patIoutput in let _lhsOoutput :: Pattern !_lhsOoutput = rule171 _output in let !__result_ = T_Pattern_vOut23 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v28 :: T_Pattern_v28 v28 = \ !(T_Pattern_vIn28 ) -> ( let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !(T_Pattern_vOut28 _patIcontainsVars _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v28 (T_Pattern_vIn28 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule164 _patIcontainsVars in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule165 _patIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule166 _patIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule167 _patIlocals in let !_output = rule169 _patIoutput in let _lhsOoutput :: Pattern !_lhsOoutput = rule171 _output in let !__result_ = T_Pattern_vOut28 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v42 :: T_Pattern_v42 v42 = \ !(T_Pattern_vIn42 ) -> ( let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !(T_Pattern_vOut42 _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v42 (T_Pattern_vIn42 ) in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule165 _patIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule166 _patIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule167 _patIlocals in let !_output = rule169 _patIoutput in let _lhsOoutput :: Pattern !_lhsOoutput = rule171 _output in let !__result_ = T_Pattern_vOut42 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v50 :: T_Pattern_v50 v50 = \ !(T_Pattern_vIn50 ) -> ( let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !(T_Pattern_vOut50 _patIdefinedAttrs _patIerrors _patIlocals _patX55) = inv_Pattern_s10 _patX10 K_Pattern_v50 (T_Pattern_vIn50 ) in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule165 _patIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule166 _patIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule167 _patIlocals in let !__st_ = st55 _patX55 !__result_ = T_Pattern_vOut50 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals __st_ in __result_ ) in C_Pattern_s10 k10 {-# NOINLINE st55 #-} st55 = \ !_patX55 -> let k55 :: K_Pattern_s55 t -> t k55 K_Pattern_v51 = v51 k55 K_Pattern_v56 = v56 v51 :: T_Pattern_v51 v51 = \ !(T_Pattern_vIn51 ) -> ( let !(T_Pattern_vOut51 _patIcontainsVars _patIoutput) = inv_Pattern_s55 _patX55 K_Pattern_v51 (T_Pattern_vIn51 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule164 _patIcontainsVars in let !_output = rule169 _patIoutput in let _lhsOoutput :: Pattern !_lhsOoutput = rule171 _output in let !__result_ = T_Pattern_vOut51 _lhsOcontainsVars _lhsOoutput in __result_ ) v56 :: T_Pattern_v56 v56 = \ !(T_Pattern_vIn56 ) -> ( let !(T_Pattern_vOut56 _patIoutput) = inv_Pattern_s55 _patX55 K_Pattern_v56 (T_Pattern_vIn56 ) in let !_output = rule169 _patIoutput in let _lhsOoutput :: Pattern !_lhsOoutput = rule171 _output in let !__result_ = T_Pattern_vOut56 _lhsOoutput in __result_ ) in C_Pattern_s55 k55 {-# NOINLINE[1] rule164 #-} rule164 = \ ((!_patIcontainsVars) :: Bool) -> _patIcontainsVars {-# NOINLINE[1] rule165 #-} rule165 = \ ((!_patIdefinedAttrs) :: Set (Identifier,Identifier)) -> _patIdefinedAttrs {-# NOINLINE[1] rule166 #-} rule166 = \ ((!_patIerrors) :: Seq Error) -> _patIerrors {-# NOINLINE[1] rule167 #-} rule167 = \ ((!_patIlocals) :: Set Identifier) -> _patIlocals {-# NOINLINE[1] rule168 #-} rule168 = \ ((!_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# NOINLINE[1] rule169 #-} rule169 = \ ((!_patIoutput) :: Pattern) -> Irrefutable _patIoutput {-# NOINLINE[1] rule170 #-} rule170 = \ !_copy -> _copy {-# NOINLINE[1] rule171 #-} rule171 = \ !_output -> _output {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore !arg_pos_ = T_Pattern (return st10) where {-# NOINLINE st10 #-} !st10 = let k10 :: K_Pattern_s10 t -> t k10 K_Pattern_v5 = v5 k10 K_Pattern_v22 = v22 k10 K_Pattern_v23 = v23 k10 K_Pattern_v28 = v28 k10 K_Pattern_v42 = v42 k10 K_Pattern_v50 = v50 v5 :: T_Pattern_v5 v5 = \ !(T_Pattern_vIn5 _lhsIcon _lhsInt) -> ( let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule174 () in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule175 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule176 () in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule177 () in let !_copy = rule178 arg_pos_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule180 _copy in let !_output = rule179 arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule181 _output in let !__result_ = T_Pattern_vOut5 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v22 :: T_Pattern_v22 v22 = \ !(T_Pattern_vIn22 ) -> ( let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule175 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule176 () in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule177 () in let !_copy = rule178 arg_pos_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule180 _copy in let !_output = rule179 arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule181 _output in let !__result_ = T_Pattern_vOut22 _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v23 :: T_Pattern_v23 v23 = \ !(T_Pattern_vIn23 ) -> ( let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule174 () in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule175 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule176 () in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule177 () in let !_copy = rule178 arg_pos_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule180 _copy in let !_output = rule179 arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule181 _output in let !__result_ = T_Pattern_vOut23 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v28 :: T_Pattern_v28 v28 = \ !(T_Pattern_vIn28 ) -> ( let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule174 () in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule175 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule176 () in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule177 () in let !_output = rule179 arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule181 _output in let !__result_ = T_Pattern_vOut28 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v42 :: T_Pattern_v42 v42 = \ !(T_Pattern_vIn42 ) -> ( let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule175 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule176 () in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule177 () in let !_output = rule179 arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule181 _output in let !__result_ = T_Pattern_vOut42 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v50 :: T_Pattern_v50 v50 = \ !(T_Pattern_vIn50 ) -> ( let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule175 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule176 () in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule177 () in let !__st_ = st55 () !__result_ = T_Pattern_vOut50 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals __st_ in __result_ ) in C_Pattern_s10 k10 {-# NOINLINE st55 #-} st55 = \ (_ :: ()) -> let k55 :: K_Pattern_s55 t -> t k55 K_Pattern_v51 = v51 k55 K_Pattern_v56 = v56 v51 :: T_Pattern_v51 v51 = \ !(T_Pattern_vIn51 ) -> ( let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule174 () in let !_output = rule179 arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule181 _output in let !__result_ = T_Pattern_vOut51 _lhsOcontainsVars _lhsOoutput in __result_ ) v56 :: T_Pattern_v56 v56 = \ !(T_Pattern_vIn56 ) -> ( let !_output = rule179 arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule181 _output in let !__result_ = T_Pattern_vOut56 _lhsOoutput in __result_ ) in C_Pattern_s55 k55 {-# NOINLINE[1] rule174 #-} rule174 = \ (_ :: ()) -> False {-# NOINLINE[1] rule175 #-} rule175 = \ (_ :: ()) -> Set.empty {-# NOINLINE[1] rule176 #-} rule176 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule177 #-} rule177 = \ (_ :: ()) -> Set.empty {-# NOINLINE[1] rule178 #-} rule178 = \ !pos_ -> Underscore pos_ {-# NOINLINE[1] rule179 #-} rule179 = \ !pos_ -> Underscore pos_ {-# NOINLINE[1] rule180 #-} rule180 = \ !_copy -> _copy {-# NOINLINE[1] rule181 #-} rule181 = \ !_output -> _output -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { con_Inh_Patterns :: !(ConstructorIdent), nt_Inh_Patterns :: !(NontermIdent) } data Syn_Patterns = Syn_Patterns { containsVars_Syn_Patterns :: !(Bool), copy_Syn_Patterns :: !(Patterns), definedAttrs_Syn_Patterns :: !(Set (Identifier,Identifier)), errors_Syn_Patterns :: !(Seq Error), locals_Syn_Patterns :: !(Set Identifier), output_Syn_Patterns :: !(Patterns) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns !(T_Patterns act) !(Inh_Patterns _lhsIcon _lhsInt) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg6 = T_Patterns_vIn6 _lhsIcon _lhsInt !(T_Patterns_vOut6 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput) <- return (inv_Patterns_s12 sem K_Patterns_v6 arg6) return (Syn_Patterns _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s12 ) } data T_Patterns_s12 where C_Patterns_s12 :: { inv_Patterns_s12 :: !(forall t. K_Patterns_s12 t -> t) } -> T_Patterns_s12 data T_Patterns_s13 = C_Patterns_s13 data T_Patterns_s34 = C_Patterns_s34 data T_Patterns_s47 = C_Patterns_s47 data T_Patterns_s49 = C_Patterns_s49 data T_Patterns_s54 = C_Patterns_s54 data T_Patterns_s57 where C_Patterns_s57 :: { inv_Patterns_s57 :: !(forall t. K_Patterns_s57 t -> t) } -> T_Patterns_s57 data K_Patterns_s12 k where K_Patterns_v6 :: K_Patterns_s12 (T_Patterns_v6 ) K_Patterns_v21 :: K_Patterns_s12 (T_Patterns_v21 ) K_Patterns_v38 :: K_Patterns_s12 (T_Patterns_v38 ) K_Patterns_v41 :: K_Patterns_s12 (T_Patterns_v41 ) K_Patterns_v49 :: K_Patterns_s12 (T_Patterns_v49 ) K_Patterns_v54 :: K_Patterns_s12 (T_Patterns_v54 ) data K_Patterns_s57 k where K_Patterns_v55 :: K_Patterns_s57 (T_Patterns_v55 ) K_Patterns_v57 :: K_Patterns_s57 (T_Patterns_v57 ) type T_Patterns_v6 = (T_Patterns_vIn6 ) -> (T_Patterns_vOut6 ) data T_Patterns_vIn6 = T_Patterns_vIn6 !(ConstructorIdent) !(NontermIdent) data T_Patterns_vOut6 = T_Patterns_vOut6 !(Bool) !(Patterns) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Patterns) type T_Patterns_v21 = (T_Patterns_vIn21 ) -> (T_Patterns_vOut21 ) data T_Patterns_vIn21 = T_Patterns_vIn21 data T_Patterns_vOut21 = T_Patterns_vOut21 !(Bool) !(Patterns) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Patterns) type T_Patterns_v38 = (T_Patterns_vIn38 ) -> (T_Patterns_vOut38 ) data T_Patterns_vIn38 = T_Patterns_vIn38 data T_Patterns_vOut38 = T_Patterns_vOut38 !(Patterns) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Patterns) type T_Patterns_v41 = (T_Patterns_vIn41 ) -> (T_Patterns_vOut41 ) data T_Patterns_vIn41 = T_Patterns_vIn41 data T_Patterns_vOut41 = T_Patterns_vOut41 !(Bool) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Patterns) type T_Patterns_v49 = (T_Patterns_vIn49 ) -> (T_Patterns_vOut49 ) data T_Patterns_vIn49 = T_Patterns_vIn49 data T_Patterns_vOut49 = T_Patterns_vOut49 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Patterns) type T_Patterns_v54 = (T_Patterns_vIn54 ) -> (T_Patterns_vOut54 ) data T_Patterns_vIn54 = T_Patterns_vIn54 data T_Patterns_vOut54 = T_Patterns_vOut54 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(T_Patterns_s57 ) type T_Patterns_v55 = (T_Patterns_vIn55 ) -> (T_Patterns_vOut55 ) data T_Patterns_vIn55 = T_Patterns_vIn55 data T_Patterns_vOut55 = T_Patterns_vOut55 !(Bool) !(Patterns) type T_Patterns_v57 = (T_Patterns_vIn57 ) -> (T_Patterns_vOut57 ) data T_Patterns_vIn57 = T_Patterns_vIn57 data T_Patterns_vOut57 = T_Patterns_vOut57 !(Patterns) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st12) where {-# NOINLINE st12 #-} !st12 = let k12 :: K_Patterns_s12 t -> t k12 K_Patterns_v6 = v6 k12 K_Patterns_v21 = v21 k12 K_Patterns_v38 = v38 k12 K_Patterns_v41 = v41 k12 K_Patterns_v49 = v49 k12 K_Patterns_v54 = v54 v6 :: T_Patterns_v6 v6 = \ !(T_Patterns_vIn6 _lhsIcon _lhsInt) -> ( let !_hdX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in let !_tlX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in let !(T_Pattern_vOut23 _hdIcontainsVars _hdIcopy _hdIdefinedAttrs _hdIerrors _hdIlocals _hdIoutput) = inv_Pattern_s10 _hdX10 K_Pattern_v23 (T_Pattern_vIn23 ) in let !(T_Patterns_vOut21 _tlIcontainsVars _tlIcopy _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIoutput) = inv_Patterns_s12 _tlX12 K_Patterns_v21 (T_Patterns_vIn21 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule182 _hdIcontainsVars _tlIcontainsVars in let !_copy = rule186 _hdIcopy _tlIcopy in let _lhsOcopy :: Patterns !_lhsOcopy = rule188 _copy in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule183 _hdIdefinedAttrs _tlIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule184 _hdIerrors _tlIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule185 _hdIlocals _tlIlocals in let !_output = rule187 _hdIoutput _tlIoutput in let _lhsOoutput :: Patterns !_lhsOoutput = rule189 _output in let !__result_ = T_Patterns_vOut6 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v21 :: T_Patterns_v21 v21 = \ !(T_Patterns_vIn21 ) -> ( let !_hdX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in let !_tlX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in let !(T_Pattern_vOut23 _hdIcontainsVars _hdIcopy _hdIdefinedAttrs _hdIerrors _hdIlocals _hdIoutput) = inv_Pattern_s10 _hdX10 K_Pattern_v23 (T_Pattern_vIn23 ) in let !(T_Patterns_vOut21 _tlIcontainsVars _tlIcopy _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIoutput) = inv_Patterns_s12 _tlX12 K_Patterns_v21 (T_Patterns_vIn21 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule182 _hdIcontainsVars _tlIcontainsVars in let !_copy = rule186 _hdIcopy _tlIcopy in let _lhsOcopy :: Patterns !_lhsOcopy = rule188 _copy in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule183 _hdIdefinedAttrs _tlIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule184 _hdIerrors _tlIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule185 _hdIlocals _tlIlocals in let !_output = rule187 _hdIoutput _tlIoutput in let _lhsOoutput :: Patterns !_lhsOoutput = rule189 _output in let !__result_ = T_Patterns_vOut21 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v38 :: T_Patterns_v38 v38 = \ !(T_Patterns_vIn38 ) -> ( let !_hdX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in let !_tlX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in let !(T_Pattern_vOut22 _hdIcopy _hdIdefinedAttrs _hdIerrors _hdIlocals _hdIoutput) = inv_Pattern_s10 _hdX10 K_Pattern_v22 (T_Pattern_vIn22 ) in let !(T_Patterns_vOut38 _tlIcopy _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIoutput) = inv_Patterns_s12 _tlX12 K_Patterns_v38 (T_Patterns_vIn38 ) in let !_copy = rule186 _hdIcopy _tlIcopy in let _lhsOcopy :: Patterns !_lhsOcopy = rule188 _copy in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule183 _hdIdefinedAttrs _tlIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule184 _hdIerrors _tlIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule185 _hdIlocals _tlIlocals in let !_output = rule187 _hdIoutput _tlIoutput in let _lhsOoutput :: Patterns !_lhsOoutput = rule189 _output in let !__result_ = T_Patterns_vOut38 _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v41 :: T_Patterns_v41 v41 = \ !(T_Patterns_vIn41 ) -> ( let !_hdX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in let !_tlX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in let !(T_Pattern_vOut28 _hdIcontainsVars _hdIdefinedAttrs _hdIerrors _hdIlocals _hdIoutput) = inv_Pattern_s10 _hdX10 K_Pattern_v28 (T_Pattern_vIn28 ) in let !(T_Patterns_vOut41 _tlIcontainsVars _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIoutput) = inv_Patterns_s12 _tlX12 K_Patterns_v41 (T_Patterns_vIn41 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule182 _hdIcontainsVars _tlIcontainsVars in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule183 _hdIdefinedAttrs _tlIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule184 _hdIerrors _tlIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule185 _hdIlocals _tlIlocals in let !_output = rule187 _hdIoutput _tlIoutput in let _lhsOoutput :: Patterns !_lhsOoutput = rule189 _output in let !__result_ = T_Patterns_vOut41 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v49 :: T_Patterns_v49 v49 = \ !(T_Patterns_vIn49 ) -> ( let !_hdX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in let !_tlX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in let !(T_Pattern_vOut42 _hdIdefinedAttrs _hdIerrors _hdIlocals _hdIoutput) = inv_Pattern_s10 _hdX10 K_Pattern_v42 (T_Pattern_vIn42 ) in let !(T_Patterns_vOut49 _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIoutput) = inv_Patterns_s12 _tlX12 K_Patterns_v49 (T_Patterns_vIn49 ) in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule183 _hdIdefinedAttrs _tlIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule184 _hdIerrors _tlIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule185 _hdIlocals _tlIlocals in let !_output = rule187 _hdIoutput _tlIoutput in let _lhsOoutput :: Patterns !_lhsOoutput = rule189 _output in let !__result_ = T_Patterns_vOut49 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v54 :: T_Patterns_v54 v54 = \ !(T_Patterns_vIn54 ) -> ( let !_hdX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in let !_tlX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in let !(T_Pattern_vOut50 _hdIdefinedAttrs _hdIerrors _hdIlocals _hdX55) = inv_Pattern_s10 _hdX10 K_Pattern_v50 (T_Pattern_vIn50 ) in let !(T_Patterns_vOut54 _tlIdefinedAttrs _tlIerrors _tlIlocals _tlX57) = inv_Patterns_s12 _tlX12 K_Patterns_v54 (T_Patterns_vIn54 ) in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule183 _hdIdefinedAttrs _tlIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule184 _hdIerrors _tlIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule185 _hdIlocals _tlIlocals in let !__st_ = st57 _hdX55 _tlX57 !__result_ = T_Patterns_vOut54 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals __st_ in __result_ ) in C_Patterns_s12 k12 {-# NOINLINE st57 #-} st57 = \ !_hdX55 !_tlX57 -> let k57 :: K_Patterns_s57 t -> t k57 K_Patterns_v55 = v55 k57 K_Patterns_v57 = v57 v55 :: T_Patterns_v55 v55 = \ !(T_Patterns_vIn55 ) -> ( let !(T_Pattern_vOut51 _hdIcontainsVars _hdIoutput) = inv_Pattern_s55 _hdX55 K_Pattern_v51 (T_Pattern_vIn51 ) in let !(T_Patterns_vOut55 _tlIcontainsVars _tlIoutput) = inv_Patterns_s57 _tlX57 K_Patterns_v55 (T_Patterns_vIn55 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule182 _hdIcontainsVars _tlIcontainsVars in let !_output = rule187 _hdIoutput _tlIoutput in let _lhsOoutput :: Patterns !_lhsOoutput = rule189 _output in let !__result_ = T_Patterns_vOut55 _lhsOcontainsVars _lhsOoutput in __result_ ) v57 :: T_Patterns_v57 v57 = \ !(T_Patterns_vIn57 ) -> ( let !(T_Pattern_vOut56 _hdIoutput) = inv_Pattern_s55 _hdX55 K_Pattern_v56 (T_Pattern_vIn56 ) in let !(T_Patterns_vOut57 _tlIoutput) = inv_Patterns_s57 _tlX57 K_Patterns_v57 (T_Patterns_vIn57 ) in let !_output = rule187 _hdIoutput _tlIoutput in let _lhsOoutput :: Patterns !_lhsOoutput = rule189 _output in let !__result_ = T_Patterns_vOut57 _lhsOoutput in __result_ ) in C_Patterns_s57 k57 {-# NOINLINE[1] rule182 #-} rule182 = \ ((!_hdIcontainsVars) :: Bool) ((!_tlIcontainsVars) :: Bool) -> _hdIcontainsVars || _tlIcontainsVars {-# NOINLINE[1] rule183 #-} rule183 = \ ((!_hdIdefinedAttrs) :: Set (Identifier,Identifier)) ((!_tlIdefinedAttrs) :: Set (Identifier,Identifier)) -> _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs {-# NOINLINE[1] rule184 #-} rule184 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# NOINLINE[1] rule185 #-} rule185 = \ ((!_hdIlocals) :: Set Identifier) ((!_tlIlocals) :: Set Identifier) -> _hdIlocals `Set.union` _tlIlocals {-# NOINLINE[1] rule186 #-} rule186 = \ ((!_hdIcopy) :: Pattern) ((!_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# NOINLINE[1] rule187 #-} rule187 = \ ((!_hdIoutput) :: Pattern) ((!_tlIoutput) :: Patterns) -> (:) _hdIoutput _tlIoutput {-# NOINLINE[1] rule188 #-} rule188 = \ !_copy -> _copy {-# NOINLINE[1] rule189 #-} rule189 = \ !_output -> _output {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st12) where {-# NOINLINE st12 #-} !st12 = let k12 :: K_Patterns_s12 t -> t k12 K_Patterns_v6 = v6 k12 K_Patterns_v21 = v21 k12 K_Patterns_v38 = v38 k12 K_Patterns_v41 = v41 k12 K_Patterns_v49 = v49 k12 K_Patterns_v54 = v54 v6 :: T_Patterns_v6 v6 = \ !(T_Patterns_vIn6 _lhsIcon _lhsInt) -> ( let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule194 () in let !_copy = rule198 () in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule195 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule196 () in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule197 () in let !_output = rule199 () in let _lhsOcopy :: Patterns !_lhsOcopy = rule200 _copy in let _lhsOoutput :: Patterns !_lhsOoutput = rule201 _output in let !__result_ = T_Patterns_vOut6 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v21 :: T_Patterns_v21 v21 = \ !(T_Patterns_vIn21 ) -> ( let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule194 () in let !_copy = rule198 () in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule195 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule196 () in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule197 () in let !_output = rule199 () in let _lhsOcopy :: Patterns !_lhsOcopy = rule200 _copy in let _lhsOoutput :: Patterns !_lhsOoutput = rule201 _output in let !__result_ = T_Patterns_vOut21 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v38 :: T_Patterns_v38 v38 = \ !(T_Patterns_vIn38 ) -> ( let !_copy = rule198 () in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule195 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule196 () in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule197 () in let !_output = rule199 () in let _lhsOcopy :: Patterns !_lhsOcopy = rule200 _copy in let _lhsOoutput :: Patterns !_lhsOoutput = rule201 _output in let !__result_ = T_Patterns_vOut38 _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v41 :: T_Patterns_v41 v41 = \ !(T_Patterns_vIn41 ) -> ( let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule194 () in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule195 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule196 () in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule197 () in let !_output = rule199 () in let _lhsOoutput :: Patterns !_lhsOoutput = rule201 _output in let !__result_ = T_Patterns_vOut41 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v49 :: T_Patterns_v49 v49 = \ !(T_Patterns_vIn49 ) -> ( let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule195 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule196 () in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule197 () in let !_output = rule199 () in let _lhsOoutput :: Patterns !_lhsOoutput = rule201 _output in let !__result_ = T_Patterns_vOut49 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput in __result_ ) v54 :: T_Patterns_v54 v54 = \ !(T_Patterns_vIn54 ) -> ( let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule195 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule196 () in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule197 () in let !__st_ = st57 () !__result_ = T_Patterns_vOut54 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals __st_ in __result_ ) in C_Patterns_s12 k12 {-# NOINLINE st57 #-} st57 = \ (_ :: ()) -> let k57 :: K_Patterns_s57 t -> t k57 K_Patterns_v55 = v55 k57 K_Patterns_v57 = v57 v55 :: T_Patterns_v55 v55 = \ !(T_Patterns_vIn55 ) -> ( let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule194 () in let !_output = rule199 () in let _lhsOoutput :: Patterns !_lhsOoutput = rule201 _output in let !__result_ = T_Patterns_vOut55 _lhsOcontainsVars _lhsOoutput in __result_ ) v57 :: T_Patterns_v57 v57 = \ !(T_Patterns_vIn57 ) -> ( let !_output = rule199 () in let _lhsOoutput :: Patterns !_lhsOoutput = rule201 _output in let !__result_ = T_Patterns_vOut57 _lhsOoutput in __result_ ) in C_Patterns_s57 k57 {-# NOINLINE[1] rule194 #-} rule194 = \ (_ :: ()) -> False {-# NOINLINE[1] rule195 #-} rule195 = \ (_ :: ()) -> Set.empty {-# NOINLINE[1] rule196 #-} rule196 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule197 #-} rule197 = \ (_ :: ()) -> Set.empty {-# NOINLINE[1] rule198 #-} rule198 = \ (_ :: ()) -> [] {-# NOINLINE[1] rule199 #-} rule199 = \ (_ :: ()) -> [] {-# NOINLINE[1] rule200 #-} rule200 = \ !_copy -> _copy {-# NOINLINE[1] rule201 #-} rule201 = \ !_output -> _output -- Production -------------------------------------------------- -- wrapper data Inh_Production = Inh_Production { aroundsIn_Inh_Production :: !(Map ConstructorIdent (Map Identifier [Expression])), augmentsIn_Inh_Production :: !(Map ConstructorIdent (Map Identifier [Expression])), constructorTypeMap_Inh_Production :: !(Map NontermIdent ConstructorType), cr_Inh_Production :: !(Bool), inh_Inh_Production :: !(Attributes), inhMap_Inh_Production :: !(Map Identifier Attributes), inhOrig_Inh_Production :: !(Attributes), manualAttrOrderMap_Inh_Production :: !(AttrOrderMap), mergesIn_Inh_Production :: !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))), nonterminals_Inh_Production :: !(Set NontermIdent), nt_Inh_Production :: !(NontermIdent), o_rename_Inh_Production :: !(Bool), options_Inh_Production :: !(Options), params_Inh_Production :: !([Identifier]), syn_Inh_Production :: !(Attributes), synMap_Inh_Production :: !(Map Identifier Attributes), synOrig_Inh_Production :: !(Attributes), typeSyns_Inh_Production :: !(TypeSyns), uniq_Inh_Production :: !(Int), useMap_Inh_Production :: !(Map Identifier (String,String,String)), wrappers_Inh_Production :: !(Set NontermIdent) } data Syn_Production = Syn_Production { errors_Syn_Production :: !(Seq Error), output_Syn_Production :: !(Production), uniq_Syn_Production :: !(Int) } {-# INLINABLE wrap_Production #-} wrap_Production :: T_Production -> Inh_Production -> (Syn_Production ) wrap_Production !(T_Production act) !(Inh_Production _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg7 = T_Production_vIn7 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers !(T_Production_vOut7 _lhsOerrors _lhsOoutput _lhsOuniq) <- return (inv_Production_s14 sem K_Production_v7 arg7) return (Syn_Production _lhsOerrors _lhsOoutput _lhsOuniq) ) -- cata {-# INLINE sem_Production #-} sem_Production :: Production -> T_Production sem_Production ( Production !con_ !params_ !constraints_ children_ rules_ typeSigs_ !macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_ -- semantic domain newtype T_Production = T_Production { attach_T_Production :: Identity (T_Production_s14 ) } data T_Production_s14 where C_Production_s14 :: { inv_Production_s14 :: !(forall t. K_Production_s14 t -> t) } -> T_Production_s14 data T_Production_s15 = C_Production_s15 data T_Production_s38 = C_Production_s38 newtype T_Production_s48 = C_Production_s48 { inv_Production_s48 :: (T_Production_v40 ) } data K_Production_s14 k where K_Production_v7 :: K_Production_s14 (T_Production_v7 ) K_Production_v25 :: K_Production_s14 (T_Production_v25 ) K_Production_v39 :: K_Production_s14 (T_Production_v39 ) type T_Production_v7 = (T_Production_vIn7 ) -> (T_Production_vOut7 ) data T_Production_vIn7 = T_Production_vIn7 !(Map ConstructorIdent (Map Identifier [Expression])) !(Map ConstructorIdent (Map Identifier [Expression])) !(Map NontermIdent ConstructorType) !(Bool) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(AttrOrderMap) !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !(Set NontermIdent) !(NontermIdent) !(Bool) !(Options) !([Identifier]) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(TypeSyns) !(Int) !(Map Identifier (String,String,String)) !(Set NontermIdent) data T_Production_vOut7 = T_Production_vOut7 !(Seq Error) !(Production) !(Int) type T_Production_v25 = (T_Production_vIn25 ) -> (T_Production_vOut25 ) data T_Production_vIn25 = T_Production_vIn25 !(Map ConstructorIdent (Map Identifier [Expression])) !(Map ConstructorIdent (Map Identifier [Expression])) !(Map NontermIdent ConstructorType) !(Bool) !(Attributes) !(Map Identifier Attributes) !(AttrOrderMap) !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !(NontermIdent) !(Bool) !(Options) !([Identifier]) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(TypeSyns) !(Int) !(Map Identifier (String,String,String)) !(Set NontermIdent) data T_Production_vOut25 = T_Production_vOut25 !(Seq Error) !(Production) !(Int) type T_Production_v39 = (T_Production_vIn39 ) -> (T_Production_vOut39 ) data T_Production_vIn39 = T_Production_vIn39 !(Map NontermIdent ConstructorType) !(Bool) !(Attributes) !(Map Identifier Attributes) !(AttrOrderMap) !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !(NontermIdent) !(Bool) !(Options) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(TypeSyns) !(Map Identifier (String,String,String)) !(Set NontermIdent) data T_Production_vOut39 = T_Production_vOut39 !(Seq Error) !(T_Production_s48 ) type T_Production_v40 = (T_Production_vIn40 ) -> (T_Production_vOut40 ) data T_Production_vIn40 = T_Production_vIn40 !(Map ConstructorIdent (Map Identifier [Expression])) !(Map ConstructorIdent (Map Identifier [Expression])) !([Identifier]) !(Int) data T_Production_vOut40 = T_Production_vOut40 !(Production) !(Int) {-# NOINLINE sem_Production_Production #-} sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production sem_Production_Production !arg_con_ !arg_params_ !arg_constraints_ arg_children_ arg_rules_ arg_typeSigs_ !arg_macro_ = T_Production (return st14) where {-# NOINLINE st14 #-} !st14 = let k14 :: K_Production_s14 t -> t k14 K_Production_v7 = v7 k14 K_Production_v25 = v25 k14 K_Production_v39 = v39 v7 :: T_Production_v7 v7 = \ !(T_Production_vIn7 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let !_childrenX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) in let !_rulesX20 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) in let !_typeSigsX24 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) in let !_childrenOinhMap = rule219 _lhsIinhMap in let !_mergesIn = rule214 _lhsImergesIn arg_con_ in let !_merged = rule215 _mergesIn in let !_childrenOmerged = rule220 _merged in let !_childrenOsynMap = rule223 _lhsIsynMap in let !_orderDeps = rule210 _lhsImanualAttrOrderMap _lhsInt arg_con_ in let !_typeSigsOnt = rule228 _lhsInt in let !_typeSigsOparams = rule229 _lhsIparams in let !_aroundsIn = rule213 _lhsIaroundsIn arg_con_ in let !_rulesOoptions = rule226 _lhsIoptions in let !_rulesOuniq = rule227 _lhsIuniq in let !_augmentsIn = rule212 _lhsIaugmentsIn arg_con_ in let !(T_Children_vOut14 _childrenIerrors _childrenIfields _childrenIinputs _childrenIoutput _childrenIoutputs) = inv_Children_s2 _childrenX2 K_Children_v14 (T_Children_vIn14 _childrenOinhMap _childrenOmerged _childrenOsynMap) in let !(T_Rules_vOut24 _rulesIdefinedAttrs _rulesIerrors _rulesIlocals _rulesIoutput _rulesIruleNames _rulesIuniq) = inv_Rules_s20 _rulesX20 K_Rules_v24 (T_Rules_vIn24 _rulesOoptions _rulesOuniq) in let !(T_TypeSigs_vOut12 _typeSigsIoutput) = inv_TypeSigs_s24 _typeSigsX24 (T_TypeSigs_vIn12 _typeSigsOnt _typeSigsOparams) in let !(!_newRls,!_errs) = rule205 _childrenIfields _childrenIinputs _childrenIoutputs _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsInt _lhsIo_rename _lhsIoptions _lhsIsyn _lhsIsynOrig _lhsItypeSyns _lhsIuseMap _lhsIwrappers _rulesIdefinedAttrs _rulesIlocals arg_con_ in let !_orderErrs = rule211 _childrenIinputs _childrenIoutputs _lhsIinh _lhsInt _lhsIsyn _orderDeps _rulesIlocals _rulesIruleNames arg_con_ in let _lhsOerrors :: Seq Error !_lhsOerrors = rule204 _childrenIerrors _errs _orderErrs _rulesIerrors in let !_extra1 = rule206 _augmentsIn _newRls _rulesIoutput in let !_extra2 = rule207 _aroundsIn _extra1 in let !_extra3 = rule208 _extra2 _mergesIn in let _lhsOoutput :: Production !_lhsOoutput = rule209 _childrenIoutput _extra3 _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ in let _lhsOuniq :: Int !_lhsOuniq = rule217 _rulesIuniq in let !__result_ = T_Production_vOut7 _lhsOerrors _lhsOoutput _lhsOuniq in __result_ ) v25 :: T_Production_v25 v25 = \ !(T_Production_vIn25 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let !_childrenX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) in let !_rulesX20 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) in let !_typeSigsX24 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) in let !_childrenOinhMap = rule219 _lhsIinhMap in let !_mergesIn = rule214 _lhsImergesIn arg_con_ in let !_merged = rule215 _mergesIn in let !_childrenOmerged = rule220 _merged in let !_childrenOsynMap = rule223 _lhsIsynMap in let !_orderDeps = rule210 _lhsImanualAttrOrderMap _lhsInt arg_con_ in let !_typeSigsOnt = rule228 _lhsInt in let !_typeSigsOparams = rule229 _lhsIparams in let !_aroundsIn = rule213 _lhsIaroundsIn arg_con_ in let !_rulesOoptions = rule226 _lhsIoptions in let !_rulesOuniq = rule227 _lhsIuniq in let !_augmentsIn = rule212 _lhsIaugmentsIn arg_con_ in let !(T_Children_vOut14 _childrenIerrors _childrenIfields _childrenIinputs _childrenIoutput _childrenIoutputs) = inv_Children_s2 _childrenX2 K_Children_v14 (T_Children_vIn14 _childrenOinhMap _childrenOmerged _childrenOsynMap) in let !(T_Rules_vOut24 _rulesIdefinedAttrs _rulesIerrors _rulesIlocals _rulesIoutput _rulesIruleNames _rulesIuniq) = inv_Rules_s20 _rulesX20 K_Rules_v24 (T_Rules_vIn24 _rulesOoptions _rulesOuniq) in let !(T_TypeSigs_vOut12 _typeSigsIoutput) = inv_TypeSigs_s24 _typeSigsX24 (T_TypeSigs_vIn12 _typeSigsOnt _typeSigsOparams) in let !(!_newRls,!_errs) = rule205 _childrenIfields _childrenIinputs _childrenIoutputs _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsInt _lhsIo_rename _lhsIoptions _lhsIsyn _lhsIsynOrig _lhsItypeSyns _lhsIuseMap _lhsIwrappers _rulesIdefinedAttrs _rulesIlocals arg_con_ in let !_orderErrs = rule211 _childrenIinputs _childrenIoutputs _lhsIinh _lhsInt _lhsIsyn _orderDeps _rulesIlocals _rulesIruleNames arg_con_ in let _lhsOerrors :: Seq Error !_lhsOerrors = rule204 _childrenIerrors _errs _orderErrs _rulesIerrors in let !_extra1 = rule206 _augmentsIn _newRls _rulesIoutput in let !_extra2 = rule207 _aroundsIn _extra1 in let !_extra3 = rule208 _extra2 _mergesIn in let _lhsOoutput :: Production !_lhsOoutput = rule209 _childrenIoutput _extra3 _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ in let _lhsOuniq :: Int !_lhsOuniq = rule217 _rulesIuniq in let !__result_ = T_Production_vOut25 _lhsOerrors _lhsOoutput _lhsOuniq in __result_ ) v39 :: T_Production_v39 v39 = \ !(T_Production_vIn39 _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInt _lhsIo_rename _lhsIoptions _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( let !_childrenX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) in let !_rulesX20 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) in let !_childrenOinhMap = rule219 _lhsIinhMap in let !_mergesIn = rule214 _lhsImergesIn arg_con_ in let !_merged = rule215 _mergesIn in let !_childrenOmerged = rule220 _merged in let !_childrenOsynMap = rule223 _lhsIsynMap in let !_orderDeps = rule210 _lhsImanualAttrOrderMap _lhsInt arg_con_ in let !(T_Children_vOut47 _childrenIerrors _childrenIfields _childrenIinputs _childrenIoutputs _childrenX53) = inv_Children_s2 _childrenX2 K_Children_v47 (T_Children_vIn47 _childrenOinhMap _childrenOmerged _childrenOsynMap) in let !(T_Rules_vOut30 _rulesIdefinedAttrs _rulesIerrors _rulesIlocals _rulesIruleNames _rulesX42) = inv_Rules_s20 _rulesX20 K_Rules_v30 (T_Rules_vIn30 ) in let !(!_newRls,!_errs) = rule205 _childrenIfields _childrenIinputs _childrenIoutputs _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsInt _lhsIo_rename _lhsIoptions _lhsIsyn _lhsIsynOrig _lhsItypeSyns _lhsIuseMap _lhsIwrappers _rulesIdefinedAttrs _rulesIlocals arg_con_ in let !_orderErrs = rule211 _childrenIinputs _childrenIoutputs _lhsIinh _lhsInt _lhsIsyn _orderDeps _rulesIlocals _rulesIruleNames arg_con_ in let _lhsOerrors :: Seq Error !_lhsOerrors = rule204 _childrenIerrors _errs _orderErrs _rulesIerrors in let !__st_ = st48 _childrenX53 _lhsInt _lhsIoptions _mergesIn _newRls _rulesX42 !__result_ = T_Production_vOut39 _lhsOerrors __st_ in __result_ ) in C_Production_s14 k14 {-# NOINLINE st48 #-} st48 = \ !_childrenX53 ((!_lhsInt) :: NontermIdent) ((!_lhsIoptions) :: Options) !_mergesIn !_newRls !_rulesX42 -> let v40 :: T_Production_v40 v40 = \ !(T_Production_vIn40 _lhsIaroundsIn _lhsIaugmentsIn _lhsIparams _lhsIuniq) -> ( let !_typeSigsOnt = rule228 _lhsInt in let !_typeSigsX24 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) in let !_rulesOoptions = rule226 _lhsIoptions in let !_typeSigsOparams = rule229 _lhsIparams in let !_aroundsIn = rule213 _lhsIaroundsIn arg_con_ in let !_rulesOuniq = rule227 _lhsIuniq in let !_augmentsIn = rule212 _lhsIaugmentsIn arg_con_ in let !(T_Children_vOut48 _childrenIoutput) = inv_Children_s53 _childrenX53 (T_Children_vIn48 ) in let !(T_Rules_vOut31 _rulesIoutput _rulesIuniq) = inv_Rules_s42 _rulesX42 (T_Rules_vIn31 _rulesOoptions _rulesOuniq) in let !(T_TypeSigs_vOut12 _typeSigsIoutput) = inv_TypeSigs_s24 _typeSigsX24 (T_TypeSigs_vIn12 _typeSigsOnt _typeSigsOparams) in let !_extra1 = rule206 _augmentsIn _newRls _rulesIoutput in let !_extra2 = rule207 _aroundsIn _extra1 in let !_extra3 = rule208 _extra2 _mergesIn in let _lhsOoutput :: Production !_lhsOoutput = rule209 _childrenIoutput _extra3 _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ in let _lhsOuniq :: Int !_lhsOuniq = rule217 _rulesIuniq in let !__result_ = T_Production_vOut40 _lhsOoutput _lhsOuniq in __result_ ) in C_Production_s48 v40 {-# NOINLINE[1] rule204 #-} {-# LINE 412 "src-ag/DefaultRules.ag" #-} rule204 = \ ((!_childrenIerrors) :: Seq Error) !_errs !_orderErrs ((!_rulesIerrors) :: Seq Error) -> {-# LINE 412 "src-ag/DefaultRules.ag" #-} _childrenIerrors >< _errs >< _rulesIerrors >< _orderErrs {-# LINE 3527 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule205 #-} {-# LINE 416 "src-ag/DefaultRules.ag" #-} rule205 = \ ((!_childrenIfields) :: [(Identifier,Type,ChildKind)]) ((!_childrenIinputs) :: [(Identifier, Attributes)]) ((!_childrenIoutputs) :: [(Identifier, Attributes)]) ((!_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) ((!_lhsIcr) :: Bool) ((!_lhsIinh) :: Attributes) ((!_lhsInt) :: NontermIdent) ((!_lhsIo_rename) :: Bool) ((!_lhsIoptions) :: Options) ((!_lhsIsyn) :: Attributes) ((!_lhsIsynOrig) :: Attributes) ((!_lhsItypeSyns) :: TypeSyns) ((!_lhsIuseMap) :: Map Identifier (String,String,String)) ((!_lhsIwrappers) :: Set NontermIdent) ((!_rulesIdefinedAttrs) :: Set (Identifier,Identifier)) ((!_rulesIlocals) :: Set Identifier) !con_ -> {-# LINE 416 "src-ag/DefaultRules.ag" #-} let locals = _rulesIlocals initenv = Map.fromList ( [ (a,_ACHILD) | (a,_,_) <- _childrenIfields ] ++ attrs(_LHS, _lhsIinh) ++ [ (a,_LOC) | a <- Set.toList locals ] ) attrs (n,as) = [ (a,n) | a <- Map.keys as ] envs = scanl (flip Map.union) initenv (map (Map.fromList . attrs ) _childrenIoutputs) child_envs = init envs lhs_env = last envs (selfAttrs, normalAttrs) = Map.partitionWithKey (\k _ -> maybe False isSELFNonterminal $ Map.lookup k _lhsIsynOrig) _lhsIsyn (_,undefAttrs) = removeDefined _rulesIdefinedAttrs (_LHS, normalAttrs) (useAttrs,others) = splitAttrs _lhsIuseMap undefAttrs (rules1, errors1) = concatRE $ map (copyRule _lhsIoptions _lhsIwrappers _lhsInt con_ _lhsIcr locals) (zip envs (map (removeDefined _rulesIdefinedAttrs) _childrenIinputs)) uRules = map (useRule _lhsIoptions locals _childrenIoutputs) useAttrs selfLocRules = [ selfRule False attr $ lexTokens _lhsIoptions noPos $ constructor [(childSelf attr nm tp, nm) | (nm,tp,virt) <- _childrenIfields, childExists virt] | attr <- Map.keys selfAttrs , not (Set.member attr locals) ] where childSelf self nm tp = case tp of NT nt _ _ -> attrName nm self _ | nm `Set.member` locals -> locName nm | otherwise -> fieldName nm constructor fs = buildConExpr (ocaml _lhsIoptions) (clean _lhsIoptions) _lhsIconstructorTypeMap _lhsItypeSyns _lhsIo_rename _lhsInt con_ fs childExists ChildAttr = False childExists _ = True selfRules = [ selfRule True attr [mkLocVar attr noPos Nothing] | attr <- Map.keys selfAttrs , not (Set.member (_LHS,attr) _rulesIdefinedAttrs) ] (rules5, errs5) = copyRule _lhsIoptions _lhsIwrappers _lhsInt con_ _lhsIcr locals (lhs_env, (_LHS, others)) in (uRules++selfLocRules++selfRules++rules5++rules1, errors1> {-# LINE 636 "src-ag/DefaultRules.ag" #-} foldr addAugments (_rulesIoutput ++ _newRls) (Map.assocs _augmentsIn ) {-# LINE 3594 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule207 #-} {-# LINE 637 "src-ag/DefaultRules.ag" #-} rule207 = \ !_aroundsIn !_extra1 -> {-# LINE 637 "src-ag/DefaultRules.ag" #-} foldr addArounds _extra1 (Map.assocs _aroundsIn ) {-# LINE 3600 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule208 #-} {-# LINE 638 "src-ag/DefaultRules.ag" #-} rule208 = \ !_extra2 !_mergesIn -> {-# LINE 638 "src-ag/DefaultRules.ag" #-} foldr addMerges _extra2 (Map.assocs _mergesIn ) {-# LINE 3606 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule209 #-} {-# LINE 639 "src-ag/DefaultRules.ag" #-} rule209 = \ ((!_childrenIoutput) :: Children) !_extra3 ((!_typeSigsIoutput) :: TypeSigs) !con_ !constraints_ !macro_ !params_ -> {-# LINE 639 "src-ag/DefaultRules.ag" #-} Production con_ params_ constraints_ _childrenIoutput _extra3 _typeSigsIoutput macro_ {-# LINE 3612 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule210 #-} {-# LINE 747 "src-ag/DefaultRules.ag" #-} rule210 = \ ((!_lhsImanualAttrOrderMap) :: AttrOrderMap) ((!_lhsInt) :: NontermIdent) !con_ -> {-# LINE 747 "src-ag/DefaultRules.ag" #-} Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap {-# LINE 3618 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule211 #-} {-# LINE 750 "src-ag/DefaultRules.ag" #-} rule211 = \ ((!_childrenIinputs) :: [(Identifier, Attributes)]) ((!_childrenIoutputs) :: [(Identifier, Attributes)]) ((!_lhsIinh) :: Attributes) ((!_lhsInt) :: NontermIdent) ((!_lhsIsyn) :: Attributes) !_orderDeps ((!_rulesIlocals) :: Set Identifier) ((!_rulesIruleNames) :: Set Identifier) !con_ -> {-# LINE 750 "src-ag/DefaultRules.ag" #-} let chldOutMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIoutputs ] chldInMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIinputs ] isInAttribute :: Identifier -> Identifier -> [Error] isInAttribute fld nm | fld == _LOC = if nm `Set.member` _rulesIlocals then [] else [UndefAttr _lhsInt con_ fld nm False] | fld == _LHS = if nm `Map.member` _lhsIinh then [] else [UndefAttr _lhsInt con_ fld nm False] | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldOutMap) then [] else [UndefAttr _lhsInt con_ fld nm False] isOutAttribute :: Identifier -> Identifier -> [Error] isOutAttribute fld nm | fld == _LOC = if nm `Set.member` _rulesIlocals then [] else [UndefAttr _lhsInt con_ fld nm True] | fld == _LHS = if nm `Map.member` _lhsIsyn then [] else [UndefAttr _lhsInt con_ fld nm True] | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldInMap) then [] else [UndefAttr _lhsInt con_ fld nm True] existsRule nm = if nm `Set.member` _rulesIruleNames then [] else [MissingNamedRule _lhsInt con_ nm] checkIn (OccAttr fld nm) = isInAttribute fld nm checkIn (OccRule nm) = existsRule nm checkOut (OccAttr fld nm) = isOutAttribute fld nm checkOut (OccRule nm) = existsRule nm in Seq.fromList . concat $ [ checkIn occA ++ checkOut occB | (Dependency occA occB) <- _orderDeps ] {-# LINE 3658 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule212 #-} {-# LINE 805 "src-ag/DefaultRules.ag" #-} rule212 = \ ((!_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) !con_ -> {-# LINE 805 "src-ag/DefaultRules.ag" #-} Map.findWithDefault Map.empty con_ _lhsIaugmentsIn {-# LINE 3664 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule213 #-} {-# LINE 812 "src-ag/DefaultRules.ag" #-} rule213 = \ ((!_lhsIaroundsIn) :: Map ConstructorIdent (Map Identifier [Expression])) !con_ -> {-# LINE 812 "src-ag/DefaultRules.ag" #-} Map.findWithDefault Map.empty con_ _lhsIaroundsIn {-# LINE 3670 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule214 #-} {-# LINE 820 "src-ag/DefaultRules.ag" #-} rule214 = \ ((!_lhsImergesIn) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !con_ -> {-# LINE 820 "src-ag/DefaultRules.ag" #-} Map.findWithDefault Map.empty con_ _lhsImergesIn {-# LINE 3676 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule215 #-} {-# LINE 821 "src-ag/DefaultRules.ag" #-} rule215 = \ !_mergesIn -> {-# LINE 821 "src-ag/DefaultRules.ag" #-} Set.fromList [ c | (_,cs,_) <- Map.elems _mergesIn , c <- cs ] {-# LINE 3682 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule217 #-} rule217 = \ ((!_rulesIuniq) :: Int) -> _rulesIuniq {-# NOINLINE[1] rule219 #-} rule219 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule220 #-} rule220 = \ !_merged -> _merged {-# NOINLINE[1] rule223 #-} rule223 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE[1] rule226 #-} rule226 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE[1] rule227 #-} rule227 = \ ((!_lhsIuniq) :: Int) -> _lhsIuniq {-# NOINLINE[1] rule228 #-} rule228 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE[1] rule229 #-} rule229 = \ ((!_lhsIparams) :: [Identifier]) -> _lhsIparams -- Productions ------------------------------------------------- -- wrapper data Inh_Productions = Inh_Productions { aroundsIn_Inh_Productions :: !(Map ConstructorIdent (Map Identifier [Expression])), augmentsIn_Inh_Productions :: !(Map ConstructorIdent (Map Identifier [Expression])), constructorTypeMap_Inh_Productions :: !(Map NontermIdent ConstructorType), cr_Inh_Productions :: !(Bool), inh_Inh_Productions :: !(Attributes), inhMap_Inh_Productions :: !(Map Identifier Attributes), inhOrig_Inh_Productions :: !(Attributes), manualAttrOrderMap_Inh_Productions :: !(AttrOrderMap), mergesIn_Inh_Productions :: !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))), nonterminals_Inh_Productions :: !(Set NontermIdent), nt_Inh_Productions :: !(NontermIdent), o_rename_Inh_Productions :: !(Bool), options_Inh_Productions :: !(Options), params_Inh_Productions :: !([Identifier]), syn_Inh_Productions :: !(Attributes), synMap_Inh_Productions :: !(Map Identifier Attributes), synOrig_Inh_Productions :: !(Attributes), typeSyns_Inh_Productions :: !(TypeSyns), uniq_Inh_Productions :: !(Int), useMap_Inh_Productions :: !(Map Identifier (String,String,String)), wrappers_Inh_Productions :: !(Set NontermIdent) } data Syn_Productions = Syn_Productions { errors_Syn_Productions :: !(Seq Error), output_Syn_Productions :: !(Productions), uniq_Syn_Productions :: !(Int) } {-# INLINABLE wrap_Productions #-} wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions ) wrap_Productions !(T_Productions act) !(Inh_Productions _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg8 = T_Productions_vIn8 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers !(T_Productions_vOut8 _lhsOerrors _lhsOoutput _lhsOuniq) <- return (inv_Productions_s16 sem K_Productions_v8 arg8) return (Syn_Productions _lhsOerrors _lhsOoutput _lhsOuniq) ) -- cata {-# NOINLINE sem_Productions #-} sem_Productions :: Productions -> T_Productions sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) -- semantic domain newtype T_Productions = T_Productions { attach_T_Productions :: Identity (T_Productions_s16 ) } data T_Productions_s16 where C_Productions_s16 :: { inv_Productions_s16 :: !(forall t. K_Productions_s16 t -> t) } -> T_Productions_s16 data T_Productions_s17 = C_Productions_s17 data T_Productions_s30 = C_Productions_s30 newtype T_Productions_s39 = C_Productions_s39 { inv_Productions_s39 :: (T_Productions_v27 ) } data K_Productions_s16 k where K_Productions_v8 :: K_Productions_s16 (T_Productions_v8 ) K_Productions_v17 :: K_Productions_s16 (T_Productions_v17 ) K_Productions_v26 :: K_Productions_s16 (T_Productions_v26 ) type T_Productions_v8 = (T_Productions_vIn8 ) -> (T_Productions_vOut8 ) data T_Productions_vIn8 = T_Productions_vIn8 !(Map ConstructorIdent (Map Identifier [Expression])) !(Map ConstructorIdent (Map Identifier [Expression])) !(Map NontermIdent ConstructorType) !(Bool) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(AttrOrderMap) !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !(Set NontermIdent) !(NontermIdent) !(Bool) !(Options) !([Identifier]) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(TypeSyns) !(Int) !(Map Identifier (String,String,String)) !(Set NontermIdent) data T_Productions_vOut8 = T_Productions_vOut8 !(Seq Error) !(Productions) !(Int) type T_Productions_v17 = (T_Productions_vIn17 ) -> (T_Productions_vOut17 ) data T_Productions_vIn17 = T_Productions_vIn17 !(Map ConstructorIdent (Map Identifier [Expression])) !(Map ConstructorIdent (Map Identifier [Expression])) !(Map NontermIdent ConstructorType) !(Bool) !(Attributes) !(Map Identifier Attributes) !(AttrOrderMap) !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !(NontermIdent) !(Bool) !(Options) !([Identifier]) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(TypeSyns) !(Int) !(Map Identifier (String,String,String)) !(Set NontermIdent) data T_Productions_vOut17 = T_Productions_vOut17 !(Seq Error) !(Productions) !(Int) type T_Productions_v26 = (T_Productions_vIn26 ) -> (T_Productions_vOut26 ) data T_Productions_vIn26 = T_Productions_vIn26 !(Map NontermIdent ConstructorType) !(Bool) !(Attributes) !(Map Identifier Attributes) !(AttrOrderMap) !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !(NontermIdent) !(Bool) !(Options) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(TypeSyns) !(Map Identifier (String,String,String)) !(Set NontermIdent) data T_Productions_vOut26 = T_Productions_vOut26 !(Seq Error) !(T_Productions_s39 ) type T_Productions_v27 = (T_Productions_vIn27 ) -> (T_Productions_vOut27 ) data T_Productions_vIn27 = T_Productions_vIn27 !(Map ConstructorIdent (Map Identifier [Expression])) !(Map ConstructorIdent (Map Identifier [Expression])) !([Identifier]) !(Int) data T_Productions_vOut27 = T_Productions_vOut27 !(Productions) !(Int) {-# NOINLINE sem_Productions_Cons #-} sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st16) where {-# NOINLINE st16 #-} !st16 = let k16 :: K_Productions_s16 t -> t k16 K_Productions_v8 = v8 k16 K_Productions_v17 = v17 k16 K_Productions_v26 = v26 v8 :: T_Productions_v8 v8 = \ !(T_Productions_vIn8 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let !_hdX14 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) in let !_tlX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) in let !_hdOconstructorTypeMap = rule236 _lhsIconstructorTypeMap in let !_hdOcr = rule237 _lhsIcr in let !_hdOinh = rule238 _lhsIinh in let !_hdOinhMap = rule239 _lhsIinhMap in let !_hdOmanualAttrOrderMap = rule241 _lhsImanualAttrOrderMap in let !_hdOmergesIn = rule242 _lhsImergesIn in let !_hdOnt = rule244 _lhsInt in let !_hdOo_rename = rule245 _lhsIo_rename in let !_hdOoptions = rule246 _lhsIoptions in let !_hdOsyn = rule248 _lhsIsyn in let !_hdOsynMap = rule249 _lhsIsynMap in let !_hdOsynOrig = rule250 _lhsIsynOrig in let !_hdOtypeSyns = rule251 _lhsItypeSyns in let !_hdOuseMap = rule253 _lhsIuseMap in let !_hdOwrappers = rule254 _lhsIwrappers in let !_tlOconstructorTypeMap = rule257 _lhsIconstructorTypeMap in let !_tlOcr = rule258 _lhsIcr in let !_tlOinh = rule259 _lhsIinh in let !_tlOinhMap = rule260 _lhsIinhMap in let !_tlOmanualAttrOrderMap = rule262 _lhsImanualAttrOrderMap in let !_tlOmergesIn = rule263 _lhsImergesIn in let !_tlOnt = rule265 _lhsInt in let !_tlOo_rename = rule266 _lhsIo_rename in let !_tlOoptions = rule267 _lhsIoptions in let !_tlOsyn = rule269 _lhsIsyn in let !_tlOsynMap = rule270 _lhsIsynMap in let !_tlOsynOrig = rule271 _lhsIsynOrig in let !_tlOtypeSyns = rule272 _lhsItypeSyns in let !_tlOuseMap = rule274 _lhsIuseMap in let !_tlOwrappers = rule275 _lhsIwrappers in let !_hdOaroundsIn = rule234 _lhsIaroundsIn in let !_hdOaugmentsIn = rule235 _lhsIaugmentsIn in let !_hdOparams = rule247 _lhsIparams in let !_hdOuniq = rule252 _lhsIuniq in let !_tlOaroundsIn = rule255 _lhsIaroundsIn in let !_tlOaugmentsIn = rule256 _lhsIaugmentsIn in let !_tlOparams = rule268 _lhsIparams in let !(T_Production_vOut25 _hdIerrors _hdIoutput _hdIuniq) = inv_Production_s14 _hdX14 K_Production_v25 (T_Production_vIn25 _hdOaroundsIn _hdOaugmentsIn _hdOconstructorTypeMap _hdOcr _hdOinh _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOnt _hdOo_rename _hdOoptions _hdOparams _hdOsyn _hdOsynMap _hdOsynOrig _hdOtypeSyns _hdOuniq _hdOuseMap _hdOwrappers) in let !(T_Productions_vOut26 _tlIerrors _tlX39) = inv_Productions_s16 _tlX16 K_Productions_v26 (T_Productions_vIn26 _tlOconstructorTypeMap _tlOcr _tlOinh _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOnt _tlOo_rename _tlOoptions _tlOsyn _tlOsynMap _tlOsynOrig _tlOtypeSyns _tlOuseMap _tlOwrappers) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule230 _hdIerrors _tlIerrors in let !_tlOuniq = rule273 _hdIuniq in let !(T_Productions_vOut27 _tlIoutput _tlIuniq) = inv_Productions_s39 _tlX39 (T_Productions_vIn27 _tlOaroundsIn _tlOaugmentsIn _tlOparams _tlOuniq) in let !_output = rule231 _hdIoutput _tlIoutput in let _lhsOoutput :: Productions !_lhsOoutput = rule232 _output in let _lhsOuniq :: Int !_lhsOuniq = rule233 _tlIuniq in let !__result_ = T_Productions_vOut8 _lhsOerrors _lhsOoutput _lhsOuniq in __result_ ) v17 :: T_Productions_v17 v17 = \ !(T_Productions_vIn17 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let !_hdX14 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) in let !_tlX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) in let !_hdOconstructorTypeMap = rule236 _lhsIconstructorTypeMap in let !_hdOcr = rule237 _lhsIcr in let !_hdOinh = rule238 _lhsIinh in let !_hdOinhMap = rule239 _lhsIinhMap in let !_hdOmanualAttrOrderMap = rule241 _lhsImanualAttrOrderMap in let !_hdOmergesIn = rule242 _lhsImergesIn in let !_hdOnt = rule244 _lhsInt in let !_hdOo_rename = rule245 _lhsIo_rename in let !_hdOoptions = rule246 _lhsIoptions in let !_hdOsyn = rule248 _lhsIsyn in let !_hdOsynMap = rule249 _lhsIsynMap in let !_hdOsynOrig = rule250 _lhsIsynOrig in let !_hdOtypeSyns = rule251 _lhsItypeSyns in let !_hdOuseMap = rule253 _lhsIuseMap in let !_hdOwrappers = rule254 _lhsIwrappers in let !_tlOconstructorTypeMap = rule257 _lhsIconstructorTypeMap in let !_tlOcr = rule258 _lhsIcr in let !_tlOinh = rule259 _lhsIinh in let !_tlOinhMap = rule260 _lhsIinhMap in let !_tlOmanualAttrOrderMap = rule262 _lhsImanualAttrOrderMap in let !_tlOmergesIn = rule263 _lhsImergesIn in let !_tlOnt = rule265 _lhsInt in let !_tlOo_rename = rule266 _lhsIo_rename in let !_tlOoptions = rule267 _lhsIoptions in let !_tlOsyn = rule269 _lhsIsyn in let !_tlOsynMap = rule270 _lhsIsynMap in let !_tlOsynOrig = rule271 _lhsIsynOrig in let !_tlOtypeSyns = rule272 _lhsItypeSyns in let !_tlOuseMap = rule274 _lhsIuseMap in let !_tlOwrappers = rule275 _lhsIwrappers in let !_hdOaroundsIn = rule234 _lhsIaroundsIn in let !_hdOaugmentsIn = rule235 _lhsIaugmentsIn in let !_hdOparams = rule247 _lhsIparams in let !_hdOuniq = rule252 _lhsIuniq in let !_tlOaroundsIn = rule255 _lhsIaroundsIn in let !_tlOaugmentsIn = rule256 _lhsIaugmentsIn in let !_tlOparams = rule268 _lhsIparams in let !(T_Production_vOut25 _hdIerrors _hdIoutput _hdIuniq) = inv_Production_s14 _hdX14 K_Production_v25 (T_Production_vIn25 _hdOaroundsIn _hdOaugmentsIn _hdOconstructorTypeMap _hdOcr _hdOinh _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOnt _hdOo_rename _hdOoptions _hdOparams _hdOsyn _hdOsynMap _hdOsynOrig _hdOtypeSyns _hdOuniq _hdOuseMap _hdOwrappers) in let !(T_Productions_vOut26 _tlIerrors _tlX39) = inv_Productions_s16 _tlX16 K_Productions_v26 (T_Productions_vIn26 _tlOconstructorTypeMap _tlOcr _tlOinh _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOnt _tlOo_rename _tlOoptions _tlOsyn _tlOsynMap _tlOsynOrig _tlOtypeSyns _tlOuseMap _tlOwrappers) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule230 _hdIerrors _tlIerrors in let !_tlOuniq = rule273 _hdIuniq in let !(T_Productions_vOut27 _tlIoutput _tlIuniq) = inv_Productions_s39 _tlX39 (T_Productions_vIn27 _tlOaroundsIn _tlOaugmentsIn _tlOparams _tlOuniq) in let !_output = rule231 _hdIoutput _tlIoutput in let _lhsOoutput :: Productions !_lhsOoutput = rule232 _output in let _lhsOuniq :: Int !_lhsOuniq = rule233 _tlIuniq in let !__result_ = T_Productions_vOut17 _lhsOerrors _lhsOoutput _lhsOuniq in __result_ ) v26 :: T_Productions_v26 v26 = \ !(T_Productions_vIn26 _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInt _lhsIo_rename _lhsIoptions _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( let !_hdX14 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) in let !_tlX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) in let !_hdOconstructorTypeMap = rule236 _lhsIconstructorTypeMap in let !_hdOcr = rule237 _lhsIcr in let !_hdOinh = rule238 _lhsIinh in let !_hdOinhMap = rule239 _lhsIinhMap in let !_hdOmanualAttrOrderMap = rule241 _lhsImanualAttrOrderMap in let !_hdOmergesIn = rule242 _lhsImergesIn in let !_hdOnt = rule244 _lhsInt in let !_hdOo_rename = rule245 _lhsIo_rename in let !_hdOoptions = rule246 _lhsIoptions in let !_hdOsyn = rule248 _lhsIsyn in let !_hdOsynMap = rule249 _lhsIsynMap in let !_hdOsynOrig = rule250 _lhsIsynOrig in let !_hdOtypeSyns = rule251 _lhsItypeSyns in let !_hdOuseMap = rule253 _lhsIuseMap in let !_hdOwrappers = rule254 _lhsIwrappers in let !_tlOconstructorTypeMap = rule257 _lhsIconstructorTypeMap in let !_tlOcr = rule258 _lhsIcr in let !_tlOinh = rule259 _lhsIinh in let !_tlOinhMap = rule260 _lhsIinhMap in let !_tlOmanualAttrOrderMap = rule262 _lhsImanualAttrOrderMap in let !_tlOmergesIn = rule263 _lhsImergesIn in let !_tlOnt = rule265 _lhsInt in let !_tlOo_rename = rule266 _lhsIo_rename in let !_tlOoptions = rule267 _lhsIoptions in let !_tlOsyn = rule269 _lhsIsyn in let !_tlOsynMap = rule270 _lhsIsynMap in let !_tlOsynOrig = rule271 _lhsIsynOrig in let !_tlOtypeSyns = rule272 _lhsItypeSyns in let !_tlOuseMap = rule274 _lhsIuseMap in let !_tlOwrappers = rule275 _lhsIwrappers in let !(T_Production_vOut39 _hdIerrors _hdX48) = inv_Production_s14 _hdX14 K_Production_v39 (T_Production_vIn39 _hdOconstructorTypeMap _hdOcr _hdOinh _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOnt _hdOo_rename _hdOoptions _hdOsyn _hdOsynMap _hdOsynOrig _hdOtypeSyns _hdOuseMap _hdOwrappers) in let !(T_Productions_vOut26 _tlIerrors _tlX39) = inv_Productions_s16 _tlX16 K_Productions_v26 (T_Productions_vIn26 _tlOconstructorTypeMap _tlOcr _tlOinh _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOnt _tlOo_rename _tlOoptions _tlOsyn _tlOsynMap _tlOsynOrig _tlOtypeSyns _tlOuseMap _tlOwrappers) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule230 _hdIerrors _tlIerrors in let !__st_ = st39 _hdX48 _tlX39 !__result_ = T_Productions_vOut26 _lhsOerrors __st_ in __result_ ) in C_Productions_s16 k16 {-# NOINLINE st39 #-} st39 = \ !_hdX48 !_tlX39 -> let v27 :: T_Productions_v27 v27 = \ !(T_Productions_vIn27 _lhsIaroundsIn _lhsIaugmentsIn _lhsIparams _lhsIuniq) -> ( let !_hdOaroundsIn = rule234 _lhsIaroundsIn in let !_hdOaugmentsIn = rule235 _lhsIaugmentsIn in let !_hdOparams = rule247 _lhsIparams in let !_hdOuniq = rule252 _lhsIuniq in let !_tlOaroundsIn = rule255 _lhsIaroundsIn in let !_tlOaugmentsIn = rule256 _lhsIaugmentsIn in let !_tlOparams = rule268 _lhsIparams in let !(T_Production_vOut40 _hdIoutput _hdIuniq) = inv_Production_s48 _hdX48 (T_Production_vIn40 _hdOaroundsIn _hdOaugmentsIn _hdOparams _hdOuniq) in let !_tlOuniq = rule273 _hdIuniq in let !(T_Productions_vOut27 _tlIoutput _tlIuniq) = inv_Productions_s39 _tlX39 (T_Productions_vIn27 _tlOaroundsIn _tlOaugmentsIn _tlOparams _tlOuniq) in let !_output = rule231 _hdIoutput _tlIoutput in let _lhsOoutput :: Productions !_lhsOoutput = rule232 _output in let _lhsOuniq :: Int !_lhsOuniq = rule233 _tlIuniq in let !__result_ = T_Productions_vOut27 _lhsOoutput _lhsOuniq in __result_ ) in C_Productions_s39 v27 {-# NOINLINE[1] rule230 #-} rule230 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# NOINLINE[1] rule231 #-} rule231 = \ ((!_hdIoutput) :: Production) ((!_tlIoutput) :: Productions) -> (:) _hdIoutput _tlIoutput {-# NOINLINE[1] rule232 #-} rule232 = \ !_output -> _output {-# NOINLINE[1] rule233 #-} rule233 = \ ((!_tlIuniq) :: Int) -> _tlIuniq {-# NOINLINE[1] rule234 #-} rule234 = \ ((!_lhsIaroundsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> _lhsIaroundsIn {-# NOINLINE[1] rule235 #-} rule235 = \ ((!_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> _lhsIaugmentsIn {-# NOINLINE[1] rule236 #-} rule236 = \ ((!_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# NOINLINE[1] rule237 #-} rule237 = \ ((!_lhsIcr) :: Bool) -> _lhsIcr {-# NOINLINE[1] rule238 #-} rule238 = \ ((!_lhsIinh) :: Attributes) -> _lhsIinh {-# NOINLINE[1] rule239 #-} rule239 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule241 #-} rule241 = \ ((!_lhsImanualAttrOrderMap) :: AttrOrderMap) -> _lhsImanualAttrOrderMap {-# NOINLINE[1] rule242 #-} rule242 = \ ((!_lhsImergesIn) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> _lhsImergesIn {-# NOINLINE[1] rule244 #-} rule244 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE[1] rule245 #-} rule245 = \ ((!_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# NOINLINE[1] rule246 #-} rule246 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE[1] rule247 #-} rule247 = \ ((!_lhsIparams) :: [Identifier]) -> _lhsIparams {-# NOINLINE[1] rule248 #-} rule248 = \ ((!_lhsIsyn) :: Attributes) -> _lhsIsyn {-# NOINLINE[1] rule249 #-} rule249 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE[1] rule250 #-} rule250 = \ ((!_lhsIsynOrig) :: Attributes) -> _lhsIsynOrig {-# NOINLINE[1] rule251 #-} rule251 = \ ((!_lhsItypeSyns) :: TypeSyns) -> _lhsItypeSyns {-# NOINLINE[1] rule252 #-} rule252 = \ ((!_lhsIuniq) :: Int) -> _lhsIuniq {-# NOINLINE[1] rule253 #-} rule253 = \ ((!_lhsIuseMap) :: Map Identifier (String,String,String)) -> _lhsIuseMap {-# NOINLINE[1] rule254 #-} rule254 = \ ((!_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# NOINLINE[1] rule255 #-} rule255 = \ ((!_lhsIaroundsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> _lhsIaroundsIn {-# NOINLINE[1] rule256 #-} rule256 = \ ((!_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> _lhsIaugmentsIn {-# NOINLINE[1] rule257 #-} rule257 = \ ((!_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# NOINLINE[1] rule258 #-} rule258 = \ ((!_lhsIcr) :: Bool) -> _lhsIcr {-# NOINLINE[1] rule259 #-} rule259 = \ ((!_lhsIinh) :: Attributes) -> _lhsIinh {-# NOINLINE[1] rule260 #-} rule260 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule262 #-} rule262 = \ ((!_lhsImanualAttrOrderMap) :: AttrOrderMap) -> _lhsImanualAttrOrderMap {-# NOINLINE[1] rule263 #-} rule263 = \ ((!_lhsImergesIn) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> _lhsImergesIn {-# NOINLINE[1] rule265 #-} rule265 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE[1] rule266 #-} rule266 = \ ((!_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# NOINLINE[1] rule267 #-} rule267 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE[1] rule268 #-} rule268 = \ ((!_lhsIparams) :: [Identifier]) -> _lhsIparams {-# NOINLINE[1] rule269 #-} rule269 = \ ((!_lhsIsyn) :: Attributes) -> _lhsIsyn {-# NOINLINE[1] rule270 #-} rule270 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE[1] rule271 #-} rule271 = \ ((!_lhsIsynOrig) :: Attributes) -> _lhsIsynOrig {-# NOINLINE[1] rule272 #-} rule272 = \ ((!_lhsItypeSyns) :: TypeSyns) -> _lhsItypeSyns {-# NOINLINE[1] rule273 #-} rule273 = \ ((!_hdIuniq) :: Int) -> _hdIuniq {-# NOINLINE[1] rule274 #-} rule274 = \ ((!_lhsIuseMap) :: Map Identifier (String,String,String)) -> _lhsIuseMap {-# NOINLINE[1] rule275 #-} rule275 = \ ((!_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# NOINLINE sem_Productions_Nil #-} sem_Productions_Nil :: T_Productions sem_Productions_Nil = T_Productions (return st16) where {-# NOINLINE st16 #-} !st16 = let k16 :: K_Productions_s16 t -> t k16 K_Productions_v8 = v8 k16 K_Productions_v17 = v17 k16 K_Productions_v26 = v26 v8 :: T_Productions_v8 v8 = \ !(T_Productions_vIn8 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule276 () in let !_output = rule277 () in let _lhsOoutput :: Productions !_lhsOoutput = rule278 _output in let _lhsOuniq :: Int !_lhsOuniq = rule279 _lhsIuniq in let !__result_ = T_Productions_vOut8 _lhsOerrors _lhsOoutput _lhsOuniq in __result_ ) v17 :: T_Productions_v17 v17 = \ !(T_Productions_vIn17 _lhsIaroundsIn _lhsIaugmentsIn _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule276 () in let !_output = rule277 () in let _lhsOoutput :: Productions !_lhsOoutput = rule278 _output in let _lhsOuniq :: Int !_lhsOuniq = rule279 _lhsIuniq in let !__result_ = T_Productions_vOut17 _lhsOerrors _lhsOoutput _lhsOuniq in __result_ ) v26 :: T_Productions_v26 v26 = \ !(T_Productions_vIn26 _lhsIconstructorTypeMap _lhsIcr _lhsIinh _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInt _lhsIo_rename _lhsIoptions _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule276 () in let !__st_ = st39 () !__result_ = T_Productions_vOut26 _lhsOerrors __st_ in __result_ ) in C_Productions_s16 k16 {-# NOINLINE st39 #-} st39 = \ (_ :: ()) -> let v27 :: T_Productions_v27 v27 = \ !(T_Productions_vIn27 _lhsIaroundsIn _lhsIaugmentsIn _lhsIparams _lhsIuniq) -> ( let !_output = rule277 () in let _lhsOoutput :: Productions !_lhsOoutput = rule278 _output in let _lhsOuniq :: Int !_lhsOuniq = rule279 _lhsIuniq in let !__result_ = T_Productions_vOut27 _lhsOoutput _lhsOuniq in __result_ ) in C_Productions_s39 v27 {-# NOINLINE[1] rule276 #-} rule276 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule277 #-} rule277 = \ (_ :: ()) -> [] {-# NOINLINE[1] rule278 #-} rule278 = \ !_output -> _output {-# NOINLINE[1] rule279 #-} rule279 = \ ((!_lhsIuniq) :: Int) -> _lhsIuniq -- Rule -------------------------------------------------------- -- wrapper data Inh_Rule = Inh_Rule { con_Inh_Rule :: !(ConstructorIdent), constructorTypeMap_Inh_Rule :: !(Map NontermIdent ConstructorType), nt_Inh_Rule :: !(NontermIdent), options_Inh_Rule :: !(Options), uniq_Inh_Rule :: !(Int) } data Syn_Rule = Syn_Rule { containsVars_Syn_Rule :: !(Bool), definedAttrs_Syn_Rule :: !(Set (Identifier,Identifier)), errors_Syn_Rule :: !(Seq Error), isPure_Syn_Rule :: !(Bool), locals_Syn_Rule :: !(Set Identifier), output_Syn_Rule :: !(Rule), outputs_Syn_Rule :: !(Rules), ruleNames_Syn_Rule :: !(Set Identifier), uniq_Syn_Rule :: !(Int) } {-# INLINABLE wrap_Rule #-} wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule ) wrap_Rule !(T_Rule act) !(Inh_Rule _lhsIcon _lhsIconstructorTypeMap _lhsInt _lhsIoptions _lhsIuniq) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg9 = T_Rule_vIn9 _lhsIcon _lhsIconstructorTypeMap _lhsInt _lhsIoptions _lhsIuniq !(T_Rule_vOut9 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOisPure _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOruleNames _lhsOuniq) <- return (inv_Rule_s18 sem K_Rule_v9 arg9) return (Syn_Rule _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOisPure _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOruleNames _lhsOuniq) ) -- cata {-# INLINE sem_Rule #-} sem_Rule :: Rule -> T_Rule sem_Rule ( Rule !mbName_ pattern_ !rhs_ !owrt_ !origin_ !explicit_ !pure_ !identity_ !mbError_ !eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ -- semantic domain newtype T_Rule = T_Rule { attach_T_Rule :: Identity (T_Rule_s18 ) } data T_Rule_s18 where C_Rule_s18 :: { inv_Rule_s18 :: !(forall t. K_Rule_s18 t -> t) } -> T_Rule_s18 data T_Rule_s19 = C_Rule_s19 data T_Rule_s41 = C_Rule_s41 newtype T_Rule_s51 = C_Rule_s51 { inv_Rule_s51 :: (T_Rule_v44 ) } data K_Rule_s18 k where K_Rule_v9 :: K_Rule_s18 (T_Rule_v9 ) K_Rule_v29 :: K_Rule_s18 (T_Rule_v29 ) K_Rule_v43 :: K_Rule_s18 (T_Rule_v43 ) type T_Rule_v9 = (T_Rule_vIn9 ) -> (T_Rule_vOut9 ) data T_Rule_vIn9 = T_Rule_vIn9 !(ConstructorIdent) !(Map NontermIdent ConstructorType) !(NontermIdent) !(Options) !(Int) data T_Rule_vOut9 = T_Rule_vOut9 !(Bool) !(Set (Identifier,Identifier)) !(Seq Error) !(Bool) !(Set Identifier) !(Rule) !(Rules) !(Set Identifier) !(Int) type T_Rule_v29 = (T_Rule_vIn29 ) -> (T_Rule_vOut29 ) data T_Rule_vIn29 = T_Rule_vIn29 !(Options) !(Int) data T_Rule_vOut29 = T_Rule_vOut29 !(Bool) !(Set (Identifier,Identifier)) !(Seq Error) !(Bool) !(Set Identifier) !(Rules) !(Set Identifier) !(Int) type T_Rule_v43 = (T_Rule_vIn43 ) -> (T_Rule_vOut43 ) data T_Rule_vIn43 = T_Rule_vIn43 data T_Rule_vOut43 = T_Rule_vOut43 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Set Identifier) !(T_Rule_s51 ) type T_Rule_v44 = (T_Rule_vIn44 ) -> (T_Rule_vOut44 ) data T_Rule_vIn44 = T_Rule_vIn44 !(Options) !(Int) data T_Rule_vOut44 = T_Rule_vOut44 !(Bool) !(Bool) !(Rules) !(Int) {-# NOINLINE sem_Rule_Rule #-} sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> (Expression) -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule sem_Rule_Rule !arg_mbName_ arg_pattern_ !arg_rhs_ !arg_owrt_ !arg_origin_ !arg_explicit_ !arg_pure_ !arg_identity_ !arg_mbError_ !arg_eager_ = T_Rule (return st18) where {-# NOINLINE st18 #-} !st18 = let k18 :: K_Rule_s18 t -> t k18 K_Rule_v9 = v9 k18 K_Rule_v29 = v29 k18 K_Rule_v43 = v43 v9 :: T_Rule_v9 v9 = \ !(T_Rule_vIn9 _lhsIcon _lhsIconstructorTypeMap _lhsInt _lhsIoptions _lhsIuniq) -> ( let !_patternX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) in let _lhsOisPure :: Bool !_lhsOisPure = rule280 arg_pure_ in let _lhsOruleNames :: Set Identifier !_lhsOruleNames = rule284 arg_mbName_ in let !(T_Pattern_vOut28 _patternIcontainsVars _patternIdefinedAttrs _patternIerrors _patternIlocals _patternIoutput) = inv_Pattern_s10 _patternX10 K_Pattern_v28 (T_Pattern_vIn28 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule285 _patternIcontainsVars in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule286 _patternIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule287 _patternIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule288 _patternIlocals in let !_output = rule289 _patternIoutput arg_eager_ arg_explicit_ arg_identity_ arg_mbError_ arg_mbName_ arg_origin_ arg_owrt_ arg_pure_ arg_rhs_ in let _lhsOoutput :: Rule !_lhsOoutput = rule290 _output in let !(!_output1,!_mbAlias) = rule281 _output in let _lhsOuniq :: Int !(!_outputs,!_lhsOuniq) = rule282 _lhsIoptions _lhsIuniq _output1 in let _lhsOoutputs :: Rules !_lhsOoutputs = rule283 _mbAlias _outputs in let !__result_ = T_Rule_vOut9 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOisPure _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOruleNames _lhsOuniq in __result_ ) v29 :: T_Rule_v29 v29 = \ !(T_Rule_vIn29 _lhsIoptions _lhsIuniq) -> ( let !_patternX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) in let _lhsOisPure :: Bool !_lhsOisPure = rule280 arg_pure_ in let _lhsOruleNames :: Set Identifier !_lhsOruleNames = rule284 arg_mbName_ in let !(T_Pattern_vOut28 _patternIcontainsVars _patternIdefinedAttrs _patternIerrors _patternIlocals _patternIoutput) = inv_Pattern_s10 _patternX10 K_Pattern_v28 (T_Pattern_vIn28 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule285 _patternIcontainsVars in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule286 _patternIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule287 _patternIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule288 _patternIlocals in let !_output = rule289 _patternIoutput arg_eager_ arg_explicit_ arg_identity_ arg_mbError_ arg_mbName_ arg_origin_ arg_owrt_ arg_pure_ arg_rhs_ in let !(!_output1,!_mbAlias) = rule281 _output in let _lhsOuniq :: Int !(!_outputs,!_lhsOuniq) = rule282 _lhsIoptions _lhsIuniq _output1 in let _lhsOoutputs :: Rules !_lhsOoutputs = rule283 _mbAlias _outputs in let !__result_ = T_Rule_vOut29 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOisPure _lhsOlocals _lhsOoutputs _lhsOruleNames _lhsOuniq in __result_ ) v43 :: T_Rule_v43 v43 = \ !(T_Rule_vIn43 ) -> ( let !_patternX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) in let _lhsOruleNames :: Set Identifier !_lhsOruleNames = rule284 arg_mbName_ in let !(T_Pattern_vOut50 _patternIdefinedAttrs _patternIerrors _patternIlocals _patternX55) = inv_Pattern_s10 _patternX10 K_Pattern_v50 (T_Pattern_vIn50 ) in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule286 _patternIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule287 _patternIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule288 _patternIlocals in let !__st_ = st51 _patternX55 !__result_ = T_Rule_vOut43 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOruleNames __st_ in __result_ ) in C_Rule_s18 k18 {-# NOINLINE st51 #-} st51 = \ !_patternX55 -> let v44 :: T_Rule_v44 v44 = \ !(T_Rule_vIn44 _lhsIoptions _lhsIuniq) -> ( let _lhsOisPure :: Bool !_lhsOisPure = rule280 arg_pure_ in let !(T_Pattern_vOut51 _patternIcontainsVars _patternIoutput) = inv_Pattern_s55 _patternX55 K_Pattern_v51 (T_Pattern_vIn51 ) in let _lhsOcontainsVars :: Bool !_lhsOcontainsVars = rule285 _patternIcontainsVars in let !_output = rule289 _patternIoutput arg_eager_ arg_explicit_ arg_identity_ arg_mbError_ arg_mbName_ arg_origin_ arg_owrt_ arg_pure_ arg_rhs_ in let !(!_output1,!_mbAlias) = rule281 _output in let _lhsOuniq :: Int !(!_outputs,!_lhsOuniq) = rule282 _lhsIoptions _lhsIuniq _output1 in let _lhsOoutputs :: Rules !_lhsOoutputs = rule283 _mbAlias _outputs in let !__result_ = T_Rule_vOut44 _lhsOcontainsVars _lhsOisPure _lhsOoutputs _lhsOuniq in __result_ ) in C_Rule_s51 v44 {-# NOINLINE[1] rule280 #-} {-# LINE 585 "src-ag/DefaultRules.ag" #-} rule280 = \ !pure_ -> {-# LINE 585 "src-ag/DefaultRules.ag" #-} pure_ {-# LINE 4271 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule281 #-} {-# LINE 652 "src-ag/DefaultRules.ag" #-} rule281 = \ !_output -> {-# LINE 652 "src-ag/DefaultRules.ag" #-} mkRuleAlias _output {-# LINE 4277 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule282 #-} {-# LINE 653 "src-ag/DefaultRules.ag" #-} rule282 = \ ((!_lhsIoptions) :: Options) ((!_lhsIuniq) :: Int) !_output1 -> {-# LINE 653 "src-ag/DefaultRules.ag" #-} if needsMultiRules _lhsIoptions then multiRule _output1 _lhsIuniq else ([_output1 ], _lhsIuniq) {-# LINE 4285 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule283 #-} {-# LINE 656 "src-ag/DefaultRules.ag" #-} rule283 = \ !_mbAlias !_outputs -> {-# LINE 656 "src-ag/DefaultRules.ag" #-} maybe [] return _mbAlias ++ _outputs {-# LINE 4291 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule284 #-} {-# LINE 741 "src-ag/DefaultRules.ag" #-} rule284 = \ !mbName_ -> {-# LINE 741 "src-ag/DefaultRules.ag" #-} case mbName_ of Nothing -> Set.empty Just nm -> Set.singleton nm {-# LINE 4299 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule285 #-} rule285 = \ ((!_patternIcontainsVars) :: Bool) -> _patternIcontainsVars {-# NOINLINE[1] rule286 #-} rule286 = \ ((!_patternIdefinedAttrs) :: Set (Identifier,Identifier)) -> _patternIdefinedAttrs {-# NOINLINE[1] rule287 #-} rule287 = \ ((!_patternIerrors) :: Seq Error) -> _patternIerrors {-# NOINLINE[1] rule288 #-} rule288 = \ ((!_patternIlocals) :: Set Identifier) -> _patternIlocals {-# NOINLINE[1] rule289 #-} rule289 = \ ((!_patternIoutput) :: Pattern) !eager_ !explicit_ !identity_ !mbError_ !mbName_ !origin_ !owrt_ !pure_ !rhs_ -> Rule mbName_ _patternIoutput rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ {-# INLINE rule290 #-} rule290 = \ !_output -> _output -- Rules ------------------------------------------------------- -- wrapper data Inh_Rules = Inh_Rules { con_Inh_Rules :: !(ConstructorIdent), constructorTypeMap_Inh_Rules :: !(Map NontermIdent ConstructorType), nt_Inh_Rules :: !(NontermIdent), options_Inh_Rules :: !(Options), uniq_Inh_Rules :: !(Int) } data Syn_Rules = Syn_Rules { definedAttrs_Syn_Rules :: !(Set (Identifier,Identifier)), errors_Syn_Rules :: !(Seq Error), locals_Syn_Rules :: !(Set Identifier), output_Syn_Rules :: !(Rules), ruleNames_Syn_Rules :: !(Set Identifier), uniq_Syn_Rules :: !(Int) } {-# INLINABLE wrap_Rules #-} wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules ) wrap_Rules !(T_Rules act) !(Inh_Rules _lhsIcon _lhsIconstructorTypeMap _lhsInt _lhsIoptions _lhsIuniq) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg10 = T_Rules_vIn10 _lhsIcon _lhsIconstructorTypeMap _lhsInt _lhsIoptions _lhsIuniq !(T_Rules_vOut10 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq) <- return (inv_Rules_s20 sem K_Rules_v10 arg10) return (Syn_Rules _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq) ) -- cata {-# NOINLINE sem_Rules #-} sem_Rules :: Rules -> T_Rules sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) -- semantic domain newtype T_Rules = T_Rules { attach_T_Rules :: Identity (T_Rules_s20 ) } data T_Rules_s20 where C_Rules_s20 :: { inv_Rules_s20 :: !(forall t. K_Rules_s20 t -> t) } -> T_Rules_s20 data T_Rules_s21 = C_Rules_s21 data T_Rules_s37 = C_Rules_s37 newtype T_Rules_s42 = C_Rules_s42 { inv_Rules_s42 :: (T_Rules_v31 ) } data K_Rules_s20 k where K_Rules_v10 :: K_Rules_s20 (T_Rules_v10 ) K_Rules_v24 :: K_Rules_s20 (T_Rules_v24 ) K_Rules_v30 :: K_Rules_s20 (T_Rules_v30 ) type T_Rules_v10 = (T_Rules_vIn10 ) -> (T_Rules_vOut10 ) data T_Rules_vIn10 = T_Rules_vIn10 !(ConstructorIdent) !(Map NontermIdent ConstructorType) !(NontermIdent) !(Options) !(Int) data T_Rules_vOut10 = T_Rules_vOut10 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Rules) !(Set Identifier) !(Int) type T_Rules_v24 = (T_Rules_vIn24 ) -> (T_Rules_vOut24 ) data T_Rules_vIn24 = T_Rules_vIn24 !(Options) !(Int) data T_Rules_vOut24 = T_Rules_vOut24 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Rules) !(Set Identifier) !(Int) type T_Rules_v30 = (T_Rules_vIn30 ) -> (T_Rules_vOut30 ) data T_Rules_vIn30 = T_Rules_vIn30 data T_Rules_vOut30 = T_Rules_vOut30 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Set Identifier) !(T_Rules_s42 ) type T_Rules_v31 = (T_Rules_vIn31 ) -> (T_Rules_vOut31 ) data T_Rules_vIn31 = T_Rules_vIn31 !(Options) !(Int) data T_Rules_vOut31 = T_Rules_vOut31 !(Rules) !(Int) {-# NOINLINE sem_Rules_Cons #-} sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st20) where {-# NOINLINE st20 #-} !st20 = let k20 :: K_Rules_s20 t -> t k20 K_Rules_v10 = v10 k20 K_Rules_v24 = v24 k20 K_Rules_v30 = v30 v10 :: T_Rules_v10 v10 = \ !(T_Rules_vIn10 _lhsIcon _lhsIconstructorTypeMap _lhsInt _lhsIoptions _lhsIuniq) -> ( let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) in let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) in let !_hdOoptions = rule303 _lhsIoptions in let !_hdOuniq = rule304 _lhsIuniq in let !_tlOoptions = rule308 _lhsIoptions in let !(T_Rule_vOut29 _hdIcontainsVars _hdIdefinedAttrs _hdIerrors _hdIisPure _hdIlocals _hdIoutputs _hdIruleNames _hdIuniq) = inv_Rule_s18 _hdX18 K_Rule_v29 (T_Rule_vIn29 _hdOoptions _hdOuniq) in let !(T_Rules_vOut30 _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIruleNames _tlX42) = inv_Rules_s20 _tlX20 K_Rules_v30 (T_Rules_vIn30 ) in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule294 _hdIdefinedAttrs _tlIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule295 _hdIerrors _tlIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule296 _hdIlocals _tlIlocals in let !_tlOuniq = rule309 _hdIuniq in let _lhsOruleNames :: Set Identifier !_lhsOruleNames = rule297 _hdIruleNames _tlIruleNames in let !(T_Rules_vOut31 _tlIoutput _tlIuniq) = inv_Rules_s42 _tlX42 (T_Rules_vIn31 _tlOoptions _tlOuniq) in let _lhsOoutput :: Rules !_lhsOoutput = rule293 _hdIcontainsVars _hdIisPure _hdIoutputs _tlIoutput in let _lhsOuniq :: Int !_lhsOuniq = rule299 _tlIuniq in let !__result_ = T_Rules_vOut10 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq in __result_ ) v24 :: T_Rules_v24 v24 = \ !(T_Rules_vIn24 _lhsIoptions _lhsIuniq) -> ( let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) in let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) in let !_hdOoptions = rule303 _lhsIoptions in let !_hdOuniq = rule304 _lhsIuniq in let !_tlOoptions = rule308 _lhsIoptions in let !(T_Rule_vOut29 _hdIcontainsVars _hdIdefinedAttrs _hdIerrors _hdIisPure _hdIlocals _hdIoutputs _hdIruleNames _hdIuniq) = inv_Rule_s18 _hdX18 K_Rule_v29 (T_Rule_vIn29 _hdOoptions _hdOuniq) in let !(T_Rules_vOut30 _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIruleNames _tlX42) = inv_Rules_s20 _tlX20 K_Rules_v30 (T_Rules_vIn30 ) in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule294 _hdIdefinedAttrs _tlIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule295 _hdIerrors _tlIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule296 _hdIlocals _tlIlocals in let !_tlOuniq = rule309 _hdIuniq in let _lhsOruleNames :: Set Identifier !_lhsOruleNames = rule297 _hdIruleNames _tlIruleNames in let !(T_Rules_vOut31 _tlIoutput _tlIuniq) = inv_Rules_s42 _tlX42 (T_Rules_vIn31 _tlOoptions _tlOuniq) in let _lhsOoutput :: Rules !_lhsOoutput = rule293 _hdIcontainsVars _hdIisPure _hdIoutputs _tlIoutput in let _lhsOuniq :: Int !_lhsOuniq = rule299 _tlIuniq in let !__result_ = T_Rules_vOut24 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq in __result_ ) v30 :: T_Rules_v30 v30 = \ !(T_Rules_vIn30 ) -> ( let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) in let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) in let !(T_Rule_vOut43 _hdIdefinedAttrs _hdIerrors _hdIlocals _hdIruleNames _hdX51) = inv_Rule_s18 _hdX18 K_Rule_v43 (T_Rule_vIn43 ) in let !(T_Rules_vOut30 _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIruleNames _tlX42) = inv_Rules_s20 _tlX20 K_Rules_v30 (T_Rules_vIn30 ) in let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule294 _hdIdefinedAttrs _tlIdefinedAttrs in let _lhsOerrors :: Seq Error !_lhsOerrors = rule295 _hdIerrors _tlIerrors in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule296 _hdIlocals _tlIlocals in let _lhsOruleNames :: Set Identifier !_lhsOruleNames = rule297 _hdIruleNames _tlIruleNames in let !__st_ = st42 _hdX51 _tlX42 !__result_ = T_Rules_vOut30 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOruleNames __st_ in __result_ ) in C_Rules_s20 k20 {-# NOINLINE st42 #-} st42 = \ !_hdX51 !_tlX42 -> let v31 :: T_Rules_v31 v31 = \ !(T_Rules_vIn31 _lhsIoptions _lhsIuniq) -> ( let !_hdOoptions = rule303 _lhsIoptions in let !_hdOuniq = rule304 _lhsIuniq in let !_tlOoptions = rule308 _lhsIoptions in let !(T_Rule_vOut44 _hdIcontainsVars _hdIisPure _hdIoutputs _hdIuniq) = inv_Rule_s51 _hdX51 (T_Rule_vIn44 _hdOoptions _hdOuniq) in let !_tlOuniq = rule309 _hdIuniq in let !(T_Rules_vOut31 _tlIoutput _tlIuniq) = inv_Rules_s42 _tlX42 (T_Rules_vIn31 _tlOoptions _tlOuniq) in let _lhsOoutput :: Rules !_lhsOoutput = rule293 _hdIcontainsVars _hdIisPure _hdIoutputs _tlIoutput in let _lhsOuniq :: Int !_lhsOuniq = rule299 _tlIuniq in let !__result_ = T_Rules_vOut31 _lhsOoutput _lhsOuniq in __result_ ) in C_Rules_s42 v31 {-# NOINLINE[1] rule293 #-} {-# LINE 648 "src-ag/DefaultRules.ag" #-} rule293 = \ ((!_hdIcontainsVars) :: Bool) ((!_hdIisPure) :: Bool) ((!_hdIoutputs) :: Rules) ((!_tlIoutput) :: Rules) -> {-# LINE 648 "src-ag/DefaultRules.ag" #-} if _hdIcontainsVars && _hdIisPure then _hdIoutputs ++ _tlIoutput else _tlIoutput {-# LINE 4465 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule294 #-} rule294 = \ ((!_hdIdefinedAttrs) :: Set (Identifier,Identifier)) ((!_tlIdefinedAttrs) :: Set (Identifier,Identifier)) -> _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs {-# NOINLINE[1] rule295 #-} rule295 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# NOINLINE[1] rule296 #-} rule296 = \ ((!_hdIlocals) :: Set Identifier) ((!_tlIlocals) :: Set Identifier) -> _hdIlocals `Set.union` _tlIlocals {-# NOINLINE[1] rule297 #-} rule297 = \ ((!_hdIruleNames) :: Set Identifier) ((!_tlIruleNames) :: Set Identifier) -> _hdIruleNames `Set.union` _tlIruleNames {-# NOINLINE[1] rule299 #-} rule299 = \ ((!_tlIuniq) :: Int) -> _tlIuniq {-# NOINLINE[1] rule303 #-} rule303 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE[1] rule304 #-} rule304 = \ ((!_lhsIuniq) :: Int) -> _lhsIuniq {-# NOINLINE[1] rule308 #-} rule308 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE[1] rule309 #-} rule309 = \ ((!_hdIuniq) :: Int) -> _hdIuniq {-# NOINLINE sem_Rules_Nil #-} sem_Rules_Nil :: T_Rules sem_Rules_Nil = T_Rules (return st20) where {-# NOINLINE st20 #-} !st20 = let k20 :: K_Rules_s20 t -> t k20 K_Rules_v10 = v10 k20 K_Rules_v24 = v24 k20 K_Rules_v30 = v30 v10 :: T_Rules_v10 v10 = \ !(T_Rules_vIn10 _lhsIcon _lhsIconstructorTypeMap _lhsInt _lhsIoptions _lhsIuniq) -> ( let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule310 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule311 () in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule312 () in let !_output = rule314 () in let _lhsOruleNames :: Set Identifier !_lhsOruleNames = rule313 () in let _lhsOoutput :: Rules !_lhsOoutput = rule315 _output in let _lhsOuniq :: Int !_lhsOuniq = rule316 _lhsIuniq in let !__result_ = T_Rules_vOut10 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq in __result_ ) v24 :: T_Rules_v24 v24 = \ !(T_Rules_vIn24 _lhsIoptions _lhsIuniq) -> ( let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule310 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule311 () in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule312 () in let !_output = rule314 () in let _lhsOruleNames :: Set Identifier !_lhsOruleNames = rule313 () in let _lhsOoutput :: Rules !_lhsOoutput = rule315 _output in let _lhsOuniq :: Int !_lhsOuniq = rule316 _lhsIuniq in let !__result_ = T_Rules_vOut24 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq in __result_ ) v30 :: T_Rules_v30 v30 = \ !(T_Rules_vIn30 ) -> ( let _lhsOdefinedAttrs :: Set (Identifier,Identifier) !_lhsOdefinedAttrs = rule310 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule311 () in let _lhsOlocals :: Set Identifier !_lhsOlocals = rule312 () in let _lhsOruleNames :: Set Identifier !_lhsOruleNames = rule313 () in let !__st_ = st42 () !__result_ = T_Rules_vOut30 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOruleNames __st_ in __result_ ) in C_Rules_s20 k20 {-# NOINLINE st42 #-} st42 = \ (_ :: ()) -> let v31 :: T_Rules_v31 v31 = \ !(T_Rules_vIn31 _lhsIoptions _lhsIuniq) -> ( let !_output = rule314 () in let _lhsOoutput :: Rules !_lhsOoutput = rule315 _output in let _lhsOuniq :: Int !_lhsOuniq = rule316 _lhsIuniq in let !__result_ = T_Rules_vOut31 _lhsOoutput _lhsOuniq in __result_ ) in C_Rules_s42 v31 {-# NOINLINE[1] rule310 #-} rule310 = \ (_ :: ()) -> Set.empty {-# NOINLINE[1] rule311 #-} rule311 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule312 #-} rule312 = \ (_ :: ()) -> Set.empty {-# NOINLINE[1] rule313 #-} rule313 = \ (_ :: ()) -> Set.empty {-# NOINLINE[1] rule314 #-} rule314 = \ (_ :: ()) -> [] {-# NOINLINE[1] rule315 #-} rule315 = \ !_output -> _output {-# NOINLINE[1] rule316 #-} rule316 = \ ((!_lhsIuniq) :: Int) -> _lhsIuniq -- TypeSig ----------------------------------------------------- -- wrapper data Inh_TypeSig = Inh_TypeSig { nt_Inh_TypeSig :: !(NontermIdent), params_Inh_TypeSig :: !([Identifier]) } data Syn_TypeSig = Syn_TypeSig { output_Syn_TypeSig :: !(TypeSig) } {-# INLINABLE wrap_TypeSig #-} wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig ) wrap_TypeSig !(T_TypeSig act) !(Inh_TypeSig _lhsInt _lhsIparams) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg11 = T_TypeSig_vIn11 _lhsInt _lhsIparams !(T_TypeSig_vOut11 _lhsOoutput) <- return (inv_TypeSig_s22 sem arg11) return (Syn_TypeSig _lhsOoutput) ) -- cata {-# INLINE sem_TypeSig #-} sem_TypeSig :: TypeSig -> T_TypeSig sem_TypeSig ( TypeSig !name_ !tp_ ) = sem_TypeSig_TypeSig name_ tp_ -- semantic domain newtype T_TypeSig = T_TypeSig { attach_T_TypeSig :: Identity (T_TypeSig_s22 ) } newtype T_TypeSig_s22 = C_TypeSig_s22 { inv_TypeSig_s22 :: (T_TypeSig_v11 ) } data T_TypeSig_s23 = C_TypeSig_s23 type T_TypeSig_v11 = (T_TypeSig_vIn11 ) -> (T_TypeSig_vOut11 ) data T_TypeSig_vIn11 = T_TypeSig_vIn11 !(NontermIdent) !([Identifier]) data T_TypeSig_vOut11 = T_TypeSig_vOut11 !(TypeSig) {-# NOINLINE sem_TypeSig_TypeSig #-} sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig sem_TypeSig_TypeSig !arg_name_ !arg_tp_ = T_TypeSig (return st22) where {-# NOINLINE st22 #-} !st22 = let v11 :: T_TypeSig_v11 v11 = \ !(T_TypeSig_vIn11 _lhsInt _lhsIparams) -> ( let !_tp1 = rule317 _lhsInt _lhsIparams arg_tp_ in let _lhsOoutput :: TypeSig !_lhsOoutput = rule318 _tp1 arg_name_ in let !__result_ = T_TypeSig_vOut11 _lhsOoutput in __result_ ) in C_TypeSig_s22 v11 {-# INLINE rule317 #-} {-# LINE 604 "src-ag/DefaultRules.ag" #-} rule317 = \ ((!_lhsInt) :: NontermIdent) ((!_lhsIparams) :: [Identifier]) !tp_ -> {-# LINE 604 "src-ag/DefaultRules.ag" #-} elimSelfId _lhsInt _lhsIparams tp_ {-# LINE 4632 "dist/build/DefaultRules.hs"#-} {-# INLINE rule318 #-} {-# LINE 645 "src-ag/DefaultRules.ag" #-} rule318 = \ !_tp1 !name_ -> {-# LINE 645 "src-ag/DefaultRules.ag" #-} TypeSig name_ _tp1 {-# LINE 4638 "dist/build/DefaultRules.hs"#-} -- TypeSigs ---------------------------------------------------- -- wrapper data Inh_TypeSigs = Inh_TypeSigs { nt_Inh_TypeSigs :: !(NontermIdent), params_Inh_TypeSigs :: !([Identifier]) } data Syn_TypeSigs = Syn_TypeSigs { output_Syn_TypeSigs :: !(TypeSigs) } {-# INLINABLE wrap_TypeSigs #-} wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs ) wrap_TypeSigs !(T_TypeSigs act) !(Inh_TypeSigs _lhsInt _lhsIparams) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg12 = T_TypeSigs_vIn12 _lhsInt _lhsIparams !(T_TypeSigs_vOut12 _lhsOoutput) <- return (inv_TypeSigs_s24 sem arg12) return (Syn_TypeSigs _lhsOoutput) ) -- cata {-# NOINLINE sem_TypeSigs #-} sem_TypeSigs :: TypeSigs -> T_TypeSigs sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) -- semantic domain newtype T_TypeSigs = T_TypeSigs { attach_T_TypeSigs :: Identity (T_TypeSigs_s24 ) } newtype T_TypeSigs_s24 = C_TypeSigs_s24 { inv_TypeSigs_s24 :: (T_TypeSigs_v12 ) } data T_TypeSigs_s25 = C_TypeSigs_s25 type T_TypeSigs_v12 = (T_TypeSigs_vIn12 ) -> (T_TypeSigs_vOut12 ) data T_TypeSigs_vIn12 = T_TypeSigs_vIn12 !(NontermIdent) !([Identifier]) data T_TypeSigs_vOut12 = T_TypeSigs_vOut12 !(TypeSigs) {-# NOINLINE sem_TypeSigs_Cons #-} sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st24) where {-# NOINLINE st24 #-} !st24 = let v12 :: T_TypeSigs_v12 v12 = \ !(T_TypeSigs_vIn12 _lhsInt _lhsIparams) -> ( let !_hdX22 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_)) in let !_tlX24 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_)) in let !_hdOnt = rule322 _lhsInt in let !_hdOparams = rule323 _lhsIparams in let !_tlOnt = rule324 _lhsInt in let !_tlOparams = rule325 _lhsIparams in let !(T_TypeSig_vOut11 _hdIoutput) = inv_TypeSig_s22 _hdX22 (T_TypeSig_vIn11 _hdOnt _hdOparams) in let !(T_TypeSigs_vOut12 _tlIoutput) = inv_TypeSigs_s24 _tlX24 (T_TypeSigs_vIn12 _tlOnt _tlOparams) in let !_output = rule320 _hdIoutput _tlIoutput in let _lhsOoutput :: TypeSigs !_lhsOoutput = rule321 _output in let !__result_ = T_TypeSigs_vOut12 _lhsOoutput in __result_ ) in C_TypeSigs_s24 v12 {-# INLINE rule320 #-} rule320 = \ ((!_hdIoutput) :: TypeSig) ((!_tlIoutput) :: TypeSigs) -> (:) _hdIoutput _tlIoutput {-# INLINE rule321 #-} rule321 = \ !_output -> _output {-# INLINE rule322 #-} rule322 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule323 #-} rule323 = \ ((!_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule324 #-} rule324 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule325 #-} rule325 = \ ((!_lhsIparams) :: [Identifier]) -> _lhsIparams {-# NOINLINE sem_TypeSigs_Nil #-} sem_TypeSigs_Nil :: T_TypeSigs sem_TypeSigs_Nil = T_TypeSigs (return st24) where {-# NOINLINE st24 #-} !st24 = let v12 :: T_TypeSigs_v12 v12 = \ !(T_TypeSigs_vIn12 _lhsInt _lhsIparams) -> ( let !_output = rule326 () in let _lhsOoutput :: TypeSigs !_lhsOoutput = rule327 _output in let !__result_ = T_TypeSigs_vOut12 _lhsOoutput in __result_ ) in C_TypeSigs_s24 v12 {-# INLINE rule326 #-} rule326 = \ (_ :: ()) -> [] {-# INLINE rule327 #-} rule327 = \ !_output -> _output uuagc-0.9.52.2/src-generated/ExecutionPlan.hs0000644000000000000000000001407213433540502017101 0ustar0000000000000000 -- UUAGC 0.9.51 (src-ag/ExecutionPlan.ag) module ExecutionPlan where {-# LINE 2 "src-ag/ExecutionPlan.ag" #-} -- VisitSyntax.ag imports import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import CommonTypes import ErrorMessages import qualified Data.Set as Set import Data.Set(Set) import qualified Data.Map as Map import Data.Map(Map) {-# LINE 18 "dist/build/ExecutionPlan.hs" #-} -- EChild ------------------------------------------------------ {- alternatives: alternative EChild: child name : {Identifier} child tp : {Type} child kind : {ChildKind} child hasAround : {Bool} child merges : {Maybe [Identifier]} child isMerged : {Bool} alternative ETerm: child name : {Identifier} child tp : {Type} -} data EChild = EChild (Identifier) (Type) (ChildKind) (Bool) ((Maybe [Identifier])) (Bool) | ETerm (Identifier) (Type) -- EChildren --------------------------------------------------- {- alternatives: alternative Cons: child hd : EChild child tl : EChildren alternative Nil: -} type EChildren = [EChild] -- ENonterminal ------------------------------------------------ {- alternatives: alternative ENonterminal: child nt : {NontermIdent} child params : {[Identifier]} child classCtxs : {ClassContext} child initial : {StateIdentifier} child initialv : {[VisitIdentifier]} child nextVisits : {Map StateIdentifier StateCtx} child prevVisits : {Map StateIdentifier StateCtx} child prods : EProductions child recursive : {Bool} child hoInfo : {HigherOrderInfo} -} data ENonterminal = ENonterminal (NontermIdent) (([Identifier])) (ClassContext) (StateIdentifier) (([VisitIdentifier])) ((Map StateIdentifier StateCtx)) ((Map StateIdentifier StateCtx)) (EProductions) (Bool) (HigherOrderInfo) -- ENonterminals ----------------------------------------------- {- alternatives: alternative Cons: child hd : ENonterminal child tl : ENonterminals alternative Nil: -} type ENonterminals = [ENonterminal] -- EProduction ------------------------------------------------- {- alternatives: alternative EProduction: child con : {ConstructorIdent} child params : {[Identifier]} child constraints : {[Type]} child rules : ERules child children : EChildren child visits : Visits -} data EProduction = EProduction (ConstructorIdent) (([Identifier])) (([Type])) (ERules) (EChildren) (Visits) -- EProductions ------------------------------------------------ {- alternatives: alternative Cons: child hd : EProduction child tl : EProductions alternative Nil: -} type EProductions = [EProduction] -- ERule ------------------------------------------------------- {- alternatives: alternative ERule: child name : {Identifier} child pattern : {Pattern} child rhs : {Expression} child owrt : {Bool} child origin : {String} child explicit : {Bool} child pure : {Bool} child mbError : {Maybe Error} -} data ERule = ERule (Identifier) (Pattern) (Expression) (Bool) (String) (Bool) (Bool) ((Maybe Error)) -- ERules ------------------------------------------------------ {- alternatives: alternative Cons: child hd : ERule child tl : ERules alternative Nil: -} type ERules = [ERule] -- ExecutionPlan ----------------------------------------------- {- alternatives: alternative ExecutionPlan: child nonts : ENonterminals child typeSyns : {TypeSyns} child wrappers : {Set NontermIdent} child derivings : {Derivings} -} data ExecutionPlan = ExecutionPlan (ENonterminals) (TypeSyns) ((Set NontermIdent)) (Derivings) -- Visit ------------------------------------------------------- {- alternatives: alternative Visit: child ident : {VisitIdentifier} child from : {StateIdentifier} child to : {StateIdentifier} child inh : {Set Identifier} child syn : {Set Identifier} child steps : VisitSteps child kind : {VisitKind} -} data Visit = Visit (VisitIdentifier) (StateIdentifier) (StateIdentifier) ((Set Identifier)) ((Set Identifier)) (VisitSteps) (VisitKind) -- VisitStep --------------------------------------------------- {- alternatives: alternative Sem: child name : {Identifier} alternative ChildVisit: child child : {Identifier} child nonterm : {NontermIdent} child visit : {VisitIdentifier} alternative PureGroup: child steps : VisitSteps child ordered : {Bool} alternative Sim: child steps : VisitSteps alternative ChildIntro: child child : {Identifier} -} data VisitStep = Sem (Identifier) | ChildVisit (Identifier) (NontermIdent) (VisitIdentifier) | PureGroup (VisitSteps) (Bool) | Sim (VisitSteps) | ChildIntro (Identifier) -- VisitSteps -------------------------------------------------- {- alternatives: alternative Cons: child hd : VisitStep child tl : VisitSteps alternative Nil: -} type VisitSteps = [VisitStep] -- Visits ------------------------------------------------------ {- alternatives: alternative Cons: child hd : Visit child tl : Visits alternative Nil: -} type Visits = [Visit]uuagc-0.9.52.2/src-generated/AbstractSyntax.hs0000644000000000000000000001203413433540502017271 0ustar0000000000000000 -- UUAGC 0.9.51 (src-ag/AbstractSyntax.ag) module AbstractSyntax where {-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) import Data.Map(Map) import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import Macro --marcos import CommonTypes import ErrorMessages {-# LINE 16 "dist/build/AbstractSyntax.hs" #-} -- Child ------------------------------------------------------- {- alternatives: alternative Child: child name : {Identifier} child tp : {Type} child kind : {ChildKind} -} data Child = Child (Identifier) (Type) (ChildKind) -- Children ---------------------------------------------------- {- alternatives: alternative Cons: child hd : Child child tl : Children alternative Nil: -} type Children = [Child] -- Grammar ----------------------------------------------------- {- alternatives: alternative Grammar: child typeSyns : {TypeSyns} child useMap : {UseMap} child derivings : {Derivings} child wrappers : {Set NontermIdent} child nonts : Nonterminals child pragmas : {PragmaMap} child manualAttrOrderMap : {AttrOrderMap} child paramMap : {ParamMap} child contextMap : {ContextMap} child quantMap : {QuantMap} child uniqueMap : {UniqueMap} child augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} -} data Grammar = Grammar (TypeSyns) (UseMap) (Derivings) ((Set NontermIdent)) (Nonterminals) (PragmaMap) (AttrOrderMap) (ParamMap) (ContextMap) (QuantMap) (UniqueMap) ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))) ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))) ((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))))) -- Nonterminal ------------------------------------------------- {- alternatives: alternative Nonterminal: child nt : {NontermIdent} child params : {[Identifier]} child inh : {Attributes} child syn : {Attributes} child prods : Productions -} data Nonterminal = Nonterminal (NontermIdent) (([Identifier])) (Attributes) (Attributes) (Productions) -- Nonterminals ------------------------------------------------ {- alternatives: alternative Cons: child hd : Nonterminal child tl : Nonterminals alternative Nil: -} type Nonterminals = [Nonterminal] -- Production -------------------------------------------------- {- alternatives: alternative Production: child con : {ConstructorIdent} child params : {[Identifier]} child constraints : {[Type]} child children : Children child rules : Rules child typeSigs : TypeSigs child macro : {MaybeMacro} -} data Production = Production (ConstructorIdent) (([Identifier])) (([Type])) (Children) (Rules) (TypeSigs) (MaybeMacro) -- Productions ------------------------------------------------- {- alternatives: alternative Cons: child hd : Production child tl : Productions alternative Nil: -} type Productions = [Production] -- Rule -------------------------------------------------------- {- alternatives: alternative Rule: child mbName : {Maybe Identifier} child pattern : {Pattern} child rhs : {Expression} child owrt : {Bool} child origin : {String} child explicit : {Bool} child pure : {Bool} child identity : {Bool} child mbError : {Maybe Error} child eager : {Bool} -} data Rule = Rule ((Maybe Identifier)) (Pattern) (Expression) (Bool) (String) (Bool) (Bool) (Bool) ((Maybe Error)) (Bool) -- Rules ------------------------------------------------------- {- alternatives: alternative Cons: child hd : Rule child tl : Rules alternative Nil: -} type Rules = [Rule] -- TypeSig ----------------------------------------------------- {- alternatives: alternative TypeSig: child name : {Identifier} child tp : {Type} -} data TypeSig = TypeSig (Identifier) (Type) -- TypeSigs ---------------------------------------------------- {- alternatives: alternative Cons: child hd : TypeSig child tl : TypeSigs alternative Nil: -} type TypeSigs = [TypeSig]uuagc-0.9.52.2/src-generated/Desugar.hs0000644000000000000000000073773213433540502015734 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} module Desugar where {-# LINE 2 "src-ag/HsToken.ag" #-} import CommonTypes import UU.Scanner.Position(Pos) {-# LINE 11 "dist/build/Desugar.hs" #-} {-# LINE 2 "src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken {-# LINE 17 "dist/build/Desugar.hs" #-} {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 24 "dist/build/Desugar.hs" #-} {-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) import Data.Map(Map) import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import Macro --marcos import CommonTypes import ErrorMessages {-# LINE 36 "dist/build/Desugar.hs" #-} {-# LINE 14 "src-ag/Desugar.ag" #-} import qualified Data.Set as Set import qualified Data.Map as Map import Data.Map(Map) import qualified Data.Sequence as Seq import Data.Sequence(Seq,(><)) import UU.Scanner.Position(Pos(..)) import Data.Maybe import Data.List(intersperse) import AbstractSyntax import ErrorMessages import Options import HsToken import HsTokenScanner import TokenDef import CommonTypes {-# LINE 56 "dist/build/Desugar.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 98 "src-ag/Desugar.ag" #-} addl :: Int -> Pos -> Pos addl n (Pos l c f) = Pos (l+n) c f {-# LINE 63 "dist/build/Desugar.hs" #-} {-# LINE 133 "src-ag/Desugar.ag" #-} maybeError :: a -> Error -> Maybe a -> (a, Seq Error) maybeError def err mb = maybe (def, Seq.singleton err) (\r -> (r, Seq.empty)) mb findField :: Identifier -> Identifier -> [(Identifier,Identifier)] -> Maybe Identifier findField fld attr list | fld == _FIRST = f list | fld == _LAST = f (reverse list) | otherwise = Just fld where f = lookup attr {-# LINE 78 "dist/build/Desugar.hs" #-} {-# LINE 204 "src-ag/Desugar.ag" #-} mergeAttributes :: AttrMap -> AttrMap -> AttrMap mergeAttributes = Map.unionWith $ Map.unionWith $ Set.union {-# LINE 84 "dist/build/Desugar.hs" #-} {-# LINE 251 "src-ag/Desugar.ag" #-} desugarExprs :: Options -> NontermIdent -> ConstructorIdent -> [(Identifier, Identifier)] -> [(Identifier, Identifier)] -> Seq Error -> [Expression] -> (Seq Error, [Expression]) desugarExprs options nt con childInhs childSyns = mapAccum (desugarExpr options nt con childInhs childSyns) where mapAccum f e = foldr (\x (e0,xs) -> let (e1,x') = f e0 x in (e1, x:xs)) (e, []) desugarExpr :: Options -> NontermIdent -> ConstructorIdent -> [(Identifier, Identifier)] -> [(Identifier, Identifier)] -> Seq Error -> Expression -> (Seq Error, Expression) desugarExpr options nt con childInhs childSyns errs expr = (errs Seq.>< errors_Syn_Expression syn, output_Syn_Expression syn) where inh = Inh_Expression { childInhs_Inh_Expression = childInhs , childSyns_Inh_Expression = childSyns , con_Inh_Expression = con , nt_Inh_Expression = nt , options_Inh_Expression = options , ruleDescr_Inh_Expression = "augment-rule" } sem = sem_Expression expr syn = wrap_Expression sem inh {-# LINE 110 "dist/build/Desugar.hs" #-} {-# LINE 294 "src-ag/Desugar.ag" #-} addLateAttr :: Options -> String -> Attributes addLateAttr options mainName | kennedyWarren options && lateHigherOrderBinding options = let tp = lateBindingType mainName in Map.singleton idLateBindingAttr tp | otherwise = Map.empty {-# LINE 120 "dist/build/Desugar.hs" #-} -- Child ------------------------------------------------------- -- wrapper data Inh_Child = Inh_Child { inhMap_Inh_Child :: !(Map Identifier Attributes), mainName_Inh_Child :: !(String), options_Inh_Child :: !(Options), synMap_Inh_Child :: !(Map Identifier Attributes) } data Syn_Child = Syn_Child { childInhs_Syn_Child :: !([(Identifier, Identifier)]), childSyns_Syn_Child :: !([(Identifier, Identifier)]), output_Syn_Child :: !(Child) } {-# INLINABLE wrap_Child #-} wrap_Child :: T_Child -> Inh_Child -> (Syn_Child ) wrap_Child !(T_Child act) !(Inh_Child _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg0 = T_Child_vIn0 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap !(T_Child_vOut0 _lhsOchildInhs _lhsOchildSyns _lhsOoutput) <- return (inv_Child_s0 sem K_Child_v0 arg0) return (Syn_Child _lhsOchildInhs _lhsOchildSyns _lhsOoutput) ) -- cata {-# INLINE sem_Child #-} sem_Child :: Child -> T_Child sem_Child ( Child !name_ !tp_ !kind_ ) = sem_Child_Child name_ tp_ kind_ -- semantic domain newtype T_Child = T_Child { attach_T_Child :: Identity (T_Child_s0 ) } data T_Child_s0 where C_Child_s0 :: { inv_Child_s0 :: !(forall t. K_Child_s0 t -> t) } -> T_Child_s0 data T_Child_s1 = C_Child_s1 data T_Child_s34 = C_Child_s34 data K_Child_s0 k where K_Child_v0 :: K_Child_s0 (T_Child_v0 ) K_Child_v17 :: K_Child_s0 (T_Child_v17 ) type T_Child_v0 = (T_Child_vIn0 ) -> (T_Child_vOut0 ) data T_Child_vIn0 = T_Child_vIn0 !(Map Identifier Attributes) !(String) !(Options) !(Map Identifier Attributes) data T_Child_vOut0 = T_Child_vOut0 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(Child) type T_Child_v17 = (T_Child_vIn17 ) -> (T_Child_vOut17 ) data T_Child_vIn17 = T_Child_vIn17 !(Map Identifier Attributes) !(Map Identifier Attributes) data T_Child_vOut17 = T_Child_vOut17 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(Child) {-# NOINLINE sem_Child_Child #-} sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child sem_Child_Child !arg_name_ !arg_tp_ !arg_kind_ = T_Child (return st0) where {-# NOINLINE st0 #-} !st0 = let k0 :: K_Child_s0 t -> t k0 K_Child_v0 = v0 k0 K_Child_v17 = v17 v0 :: T_Child_v0 v0 = \ !(T_Child_vIn0 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( let !_chnt = rule0 arg_name_ arg_tp_ in let !_inh = rule1 _chnt _lhsIinhMap in let _lhsOchildInhs :: [(Identifier, Identifier)] !_lhsOchildInhs = rule3 _inh arg_name_ in let !_syn = rule2 _chnt _lhsIsynMap in let _lhsOchildSyns :: [(Identifier, Identifier)] !_lhsOchildSyns = rule4 _syn arg_name_ in let _lhsOoutput :: Child !_lhsOoutput = rule5 arg_kind_ arg_name_ arg_tp_ in let !__result_ = T_Child_vOut0 _lhsOchildInhs _lhsOchildSyns _lhsOoutput in __result_ ) v17 :: T_Child_v17 v17 = \ !(T_Child_vIn17 _lhsIinhMap _lhsIsynMap) -> ( let !_chnt = rule0 arg_name_ arg_tp_ in let !_inh = rule1 _chnt _lhsIinhMap in let _lhsOchildInhs :: [(Identifier, Identifier)] !_lhsOchildInhs = rule3 _inh arg_name_ in let !_syn = rule2 _chnt _lhsIsynMap in let _lhsOchildSyns :: [(Identifier, Identifier)] !_lhsOchildSyns = rule4 _syn arg_name_ in let _lhsOoutput :: Child !_lhsOoutput = rule5 arg_kind_ arg_name_ arg_tp_ in let !__result_ = T_Child_vOut17 _lhsOchildInhs _lhsOchildSyns _lhsOoutput in __result_ ) in C_Child_s0 k0 {-# NOINLINE[1] rule0 #-} {-# LINE 19 "src-ag/DistChildAttr.ag" #-} rule0 = \ !name_ !tp_ -> {-# LINE 19 "src-ag/DistChildAttr.ag" #-} case tp_ of NT nt _ _ -> nt Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") Haskell t -> identifier "" {-# LINE 201 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule1 #-} {-# LINE 23 "src-ag/DistChildAttr.ag" #-} rule1 = \ !_chnt ((!_lhsIinhMap) :: Map Identifier Attributes) -> {-# LINE 23 "src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIinhMap {-# LINE 207 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule2 #-} {-# LINE 24 "src-ag/DistChildAttr.ag" #-} rule2 = \ !_chnt ((!_lhsIsynMap) :: Map Identifier Attributes) -> {-# LINE 24 "src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIsynMap {-# LINE 213 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule3 #-} {-# LINE 130 "src-ag/Desugar.ag" #-} rule3 = \ !_inh !name_ -> {-# LINE 130 "src-ag/Desugar.ag" #-} [(i, name_) | i <- Map.keys _inh ] {-# LINE 219 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule4 #-} {-# LINE 131 "src-ag/Desugar.ag" #-} rule4 = \ !_syn !name_ -> {-# LINE 131 "src-ag/Desugar.ag" #-} [(s, name_) | s <- Map.keys _syn ] {-# LINE 225 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule5 #-} {-# LINE 315 "src-ag/Desugar.ag" #-} rule5 = \ !kind_ !name_ !tp_ -> {-# LINE 315 "src-ag/Desugar.ag" #-} Child name_ tp_ kind_ {-# LINE 231 "dist/build/Desugar.hs"#-} -- Children ---------------------------------------------------- -- wrapper data Inh_Children = Inh_Children { inhMap_Inh_Children :: !(Map Identifier Attributes), mainName_Inh_Children :: !(String), options_Inh_Children :: !(Options), synMap_Inh_Children :: !(Map Identifier Attributes) } data Syn_Children = Syn_Children { childInhs_Syn_Children :: !([(Identifier, Identifier)]), childSyns_Syn_Children :: !([(Identifier, Identifier)]), output_Syn_Children :: !(Children) } {-# INLINABLE wrap_Children #-} wrap_Children :: T_Children -> Inh_Children -> (Syn_Children ) wrap_Children !(T_Children act) !(Inh_Children _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg1 = T_Children_vIn1 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap !(T_Children_vOut1 _lhsOchildInhs _lhsOchildSyns _lhsOoutput) <- return (inv_Children_s2 sem K_Children_v1 arg1) return (Syn_Children _lhsOchildInhs _lhsOchildSyns _lhsOoutput) ) -- cata {-# NOINLINE sem_Children #-} sem_Children :: Children -> T_Children sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) -- semantic domain newtype T_Children = T_Children { attach_T_Children :: Identity (T_Children_s2 ) } data T_Children_s2 where C_Children_s2 :: { inv_Children_s2 :: !(forall t. K_Children_s2 t -> t) } -> T_Children_s2 data T_Children_s3 = C_Children_s3 data T_Children_s35 = C_Children_s35 data K_Children_s2 k where K_Children_v1 :: K_Children_s2 (T_Children_v1 ) K_Children_v18 :: K_Children_s2 (T_Children_v18 ) type T_Children_v1 = (T_Children_vIn1 ) -> (T_Children_vOut1 ) data T_Children_vIn1 = T_Children_vIn1 !(Map Identifier Attributes) !(String) !(Options) !(Map Identifier Attributes) data T_Children_vOut1 = T_Children_vOut1 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(Children) type T_Children_v18 = (T_Children_vIn18 ) -> (T_Children_vOut18 ) data T_Children_vIn18 = T_Children_vIn18 !(Map Identifier Attributes) !(Map Identifier Attributes) data T_Children_vOut18 = T_Children_vOut18 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(Children) {-# NOINLINE sem_Children_Cons #-} sem_Children_Cons :: T_Child -> T_Children -> T_Children sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st2) where {-# NOINLINE st2 #-} !st2 = let k2 :: K_Children_s2 t -> t k2 K_Children_v1 = v1 k2 K_Children_v18 = v18 v1 :: T_Children_v1 v1 = \ !(T_Children_vIn1 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( let !_hdX0 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) in let !_tlX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) in let !_hdOinhMap = rule11 _lhsIinhMap in let !_tlOinhMap = rule15 _lhsIinhMap in let !_hdOsynMap = rule14 _lhsIsynMap in let !_tlOsynMap = rule18 _lhsIsynMap in let !(T_Child_vOut17 _hdIchildInhs _hdIchildSyns _hdIoutput) = inv_Child_s0 _hdX0 K_Child_v17 (T_Child_vIn17 _hdOinhMap _hdOsynMap) in let !(T_Children_vOut18 _tlIchildInhs _tlIchildSyns _tlIoutput) = inv_Children_s2 _tlX2 K_Children_v18 (T_Children_vIn18 _tlOinhMap _tlOsynMap) in let _lhsOchildInhs :: [(Identifier, Identifier)] !_lhsOchildInhs = rule7 _hdIchildInhs _tlIchildInhs in let _lhsOchildSyns :: [(Identifier, Identifier)] !_lhsOchildSyns = rule8 _hdIchildSyns _tlIchildSyns in let !_output = rule9 _hdIoutput _tlIoutput in let _lhsOoutput :: Children !_lhsOoutput = rule10 _output in let !__result_ = T_Children_vOut1 _lhsOchildInhs _lhsOchildSyns _lhsOoutput in __result_ ) v18 :: T_Children_v18 v18 = \ !(T_Children_vIn18 _lhsIinhMap _lhsIsynMap) -> ( let !_hdX0 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) in let !_tlX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) in let !_hdOinhMap = rule11 _lhsIinhMap in let !_tlOinhMap = rule15 _lhsIinhMap in let !_hdOsynMap = rule14 _lhsIsynMap in let !_tlOsynMap = rule18 _lhsIsynMap in let !(T_Child_vOut17 _hdIchildInhs _hdIchildSyns _hdIoutput) = inv_Child_s0 _hdX0 K_Child_v17 (T_Child_vIn17 _hdOinhMap _hdOsynMap) in let !(T_Children_vOut18 _tlIchildInhs _tlIchildSyns _tlIoutput) = inv_Children_s2 _tlX2 K_Children_v18 (T_Children_vIn18 _tlOinhMap _tlOsynMap) in let _lhsOchildInhs :: [(Identifier, Identifier)] !_lhsOchildInhs = rule7 _hdIchildInhs _tlIchildInhs in let _lhsOchildSyns :: [(Identifier, Identifier)] !_lhsOchildSyns = rule8 _hdIchildSyns _tlIchildSyns in let !_output = rule9 _hdIoutput _tlIoutput in let _lhsOoutput :: Children !_lhsOoutput = rule10 _output in let !__result_ = T_Children_vOut18 _lhsOchildInhs _lhsOchildSyns _lhsOoutput in __result_ ) in C_Children_s2 k2 {-# NOINLINE[1] rule7 #-} rule7 = \ ((!_hdIchildInhs) :: [(Identifier, Identifier)]) ((!_tlIchildInhs) :: [(Identifier, Identifier)]) -> _hdIchildInhs ++ _tlIchildInhs {-# NOINLINE[1] rule8 #-} rule8 = \ ((!_hdIchildSyns) :: [(Identifier, Identifier)]) ((!_tlIchildSyns) :: [(Identifier, Identifier)]) -> _hdIchildSyns ++ _tlIchildSyns {-# NOINLINE[1] rule9 #-} rule9 = \ ((!_hdIoutput) :: Child) ((!_tlIoutput) :: Children) -> (:) _hdIoutput _tlIoutput {-# NOINLINE[1] rule10 #-} rule10 = \ !_output -> _output {-# NOINLINE[1] rule11 #-} rule11 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule14 #-} rule14 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE[1] rule15 #-} rule15 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule18 #-} rule18 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE sem_Children_Nil #-} sem_Children_Nil :: T_Children sem_Children_Nil = T_Children (return st2) where {-# NOINLINE st2 #-} !st2 = let k2 :: K_Children_s2 t -> t k2 K_Children_v1 = v1 k2 K_Children_v18 = v18 v1 :: T_Children_v1 v1 = \ !(T_Children_vIn1 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( let _lhsOchildInhs :: [(Identifier, Identifier)] !_lhsOchildInhs = rule19 () in let _lhsOchildSyns :: [(Identifier, Identifier)] !_lhsOchildSyns = rule20 () in let !_output = rule21 () in let _lhsOoutput :: Children !_lhsOoutput = rule22 _output in let !__result_ = T_Children_vOut1 _lhsOchildInhs _lhsOchildSyns _lhsOoutput in __result_ ) v18 :: T_Children_v18 v18 = \ !(T_Children_vIn18 _lhsIinhMap _lhsIsynMap) -> ( let _lhsOchildInhs :: [(Identifier, Identifier)] !_lhsOchildInhs = rule19 () in let _lhsOchildSyns :: [(Identifier, Identifier)] !_lhsOchildSyns = rule20 () in let !_output = rule21 () in let _lhsOoutput :: Children !_lhsOoutput = rule22 _output in let !__result_ = T_Children_vOut18 _lhsOchildInhs _lhsOchildSyns _lhsOoutput in __result_ ) in C_Children_s2 k2 {-# NOINLINE[1] rule19 #-} rule19 = \ (_ :: ()) -> [] {-# NOINLINE[1] rule20 #-} rule20 = \ (_ :: ()) -> [] {-# NOINLINE[1] rule21 #-} rule21 = \ (_ :: ()) -> [] {-# NOINLINE[1] rule22 #-} rule22 = \ !_output -> _output -- Expression -------------------------------------------------- -- wrapper data Inh_Expression = Inh_Expression { childInhs_Inh_Expression :: !([(Identifier, Identifier)]), childSyns_Inh_Expression :: !([(Identifier, Identifier)]), con_Inh_Expression :: !(ConstructorIdent), nt_Inh_Expression :: !(NontermIdent), options_Inh_Expression :: !(Options), ruleDescr_Inh_Expression :: !(String) } data Syn_Expression = Syn_Expression { errors_Syn_Expression :: !(Seq Error), output_Syn_Expression :: !(Expression) } {-# INLINABLE wrap_Expression #-} wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) wrap_Expression !(T_Expression act) !(Inh_Expression _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg2 = T_Expression_vIn2 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr !(T_Expression_vOut2 _lhsOerrors _lhsOoutput) <- return (inv_Expression_s4 sem arg2) return (Syn_Expression _lhsOerrors _lhsOoutput) ) -- cata {-# INLINE sem_Expression #-} sem_Expression :: Expression -> T_Expression sem_Expression ( Expression !pos_ !tks_ ) = sem_Expression_Expression pos_ tks_ -- semantic domain newtype T_Expression = T_Expression { attach_T_Expression :: Identity (T_Expression_s4 ) } newtype T_Expression_s4 = C_Expression_s4 { inv_Expression_s4 :: (T_Expression_v2 ) } data T_Expression_s5 = C_Expression_s5 type T_Expression_v2 = (T_Expression_vIn2 ) -> (T_Expression_vOut2 ) data T_Expression_vIn2 = T_Expression_vIn2 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) !(Options) !(String) data T_Expression_vOut2 = T_Expression_vOut2 !(Seq Error) !(Expression) {-# NOINLINE sem_Expression_Expression #-} sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression sem_Expression_Expression !arg_pos_ !arg_tks_ = T_Expression (return st4) where {-# NOINLINE st4 #-} !st4 = let v2 :: T_Expression_v2 v2 = \ !(T_Expression_vIn2 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr) -> ( let _lhsOerrors :: Seq Error !(!_tks',!_lhsOerrors) = rule23 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr arg_tks_ in let _lhsOoutput :: Expression !_lhsOoutput = rule24 _tks' arg_pos_ in let !__result_ = T_Expression_vOut2 _lhsOerrors _lhsOoutput in __result_ ) in C_Expression_s4 v2 {-# INLINE rule23 #-} {-# LINE 49 "src-ag/Desugar.ag" #-} rule23 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) ((!_lhsIoptions) :: Options) ((!_lhsIruleDescr) :: String) !tks_ -> {-# LINE 49 "src-ag/Desugar.ag" #-} let inh = Inh_HsTokensRoot { childInhs_Inh_HsTokensRoot = _lhsIchildInhs , childSyns_Inh_HsTokensRoot = _lhsIchildSyns , nt_Inh_HsTokensRoot = _lhsInt , con_Inh_HsTokensRoot = _lhsIcon , ruleDescr_Inh_HsTokensRoot = _lhsIruleDescr , useFieldIdent_Inh_HsTokensRoot = genUseTraces _lhsIoptions } sem = sem_HsTokensRoot (HsTokensRoot tks_) syn = wrap_HsTokensRoot sem inh in (tks_Syn_HsTokensRoot syn, errors_Syn_HsTokensRoot syn) {-# LINE 443 "dist/build/Desugar.hs"#-} {-# INLINE rule24 #-} {-# LINE 59 "src-ag/Desugar.ag" #-} rule24 = \ !_tks' !pos_ -> {-# LINE 59 "src-ag/Desugar.ag" #-} Expression pos_ _tks' {-# LINE 449 "dist/build/Desugar.hs"#-} -- Grammar ----------------------------------------------------- -- wrapper data Inh_Grammar = Inh_Grammar { forcedIrrefutables_Inh_Grammar :: !(AttrMap), mainName_Inh_Grammar :: !(String), options_Inh_Grammar :: !(Options) } data Syn_Grammar = Syn_Grammar { allAttributes_Syn_Grammar :: !(AttrMap), errors_Syn_Grammar :: !(Seq Error), output_Syn_Grammar :: !(Grammar) } {-# INLINABLE wrap_Grammar #-} wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar ) wrap_Grammar !(T_Grammar act) !(Inh_Grammar _lhsIforcedIrrefutables _lhsImainName _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg3 = T_Grammar_vIn3 _lhsIforcedIrrefutables _lhsImainName _lhsIoptions !(T_Grammar_vOut3 _lhsOallAttributes _lhsOerrors _lhsOoutput) <- return (inv_Grammar_s6 sem arg3) return (Syn_Grammar _lhsOallAttributes _lhsOerrors _lhsOoutput) ) -- cata {-# INLINE sem_Grammar #-} sem_Grammar :: Grammar -> T_Grammar sem_Grammar ( Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ nonts_ !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !quantMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ !mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ -- semantic domain newtype T_Grammar = T_Grammar { attach_T_Grammar :: Identity (T_Grammar_s6 ) } newtype T_Grammar_s6 = C_Grammar_s6 { inv_Grammar_s6 :: (T_Grammar_v3 ) } data T_Grammar_s7 = C_Grammar_s7 type T_Grammar_v3 = (T_Grammar_vIn3 ) -> (T_Grammar_vOut3 ) data T_Grammar_vIn3 = T_Grammar_vIn3 !(AttrMap) !(String) !(Options) data T_Grammar_vOut3 = T_Grammar_vOut3 !(AttrMap) !(Seq Error) !(Grammar) {-# NOINLINE sem_Grammar_Grammar #-} sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar sem_Grammar_Grammar !arg_typeSyns_ !arg_useMap_ !arg_derivings_ !arg_wrappers_ arg_nonts_ !arg_pragmas_ !arg_manualAttrOrderMap_ !arg_paramMap_ !arg_contextMap_ !arg_quantMap_ !arg_uniqueMap_ !arg_augmentsMap_ !arg_aroundsMap_ !arg_mergeMap_ = T_Grammar (return st6) where {-# NOINLINE st6 #-} !st6 = let v3 :: T_Grammar_v3 v3 = \ !(T_Grammar_vIn3 _lhsIforcedIrrefutables _lhsImainName _lhsIoptions) -> ( let !_nontsX16 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) in let !_nontsOaugmentsIn = rule28 arg_augmentsMap_ in let !_nontsOoptions = rule35 _lhsIoptions in let !_nontsOforcedIrrefutables = rule33 _lhsIforcedIrrefutables in let !_nontsOmainName = rule34 _lhsImainName in let !(T_Nonterminals_vOut19 _nontsIallAttributes _nontsIinhMap' _nontsIsynMap' _nontsX36) = inv_Nonterminals_s16 _nontsX16 K_Nonterminals_v19 (T_Nonterminals_vIn19 ) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule30 _nontsIallAttributes in let !_nontsOinhMap = rule26 _nontsIinhMap' in let !_nontsOsynMap = rule27 _nontsIsynMap' in let !(T_Nonterminals_vOut20 _nontsIaugmentsOut _nontsIerrors _nontsIoutput) = inv_Nonterminals_s36 _nontsX36 (T_Nonterminals_vIn20 _nontsOaugmentsIn _nontsOforcedIrrefutables _nontsOinhMap _nontsOmainName _nontsOoptions _nontsOsynMap) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule31 _nontsIerrors in let _lhsOoutput :: Grammar !_lhsOoutput = rule29 _nontsIaugmentsOut _nontsIoutput arg_aroundsMap_ arg_contextMap_ arg_derivings_ arg_manualAttrOrderMap_ arg_mergeMap_ arg_paramMap_ arg_pragmas_ arg_quantMap_ arg_typeSyns_ arg_uniqueMap_ arg_useMap_ arg_wrappers_ in let !__result_ = T_Grammar_vOut3 _lhsOallAttributes _lhsOerrors _lhsOoutput in __result_ ) in C_Grammar_s6 v3 {-# INLINE rule26 #-} {-# LINE 15 "src-ag/DistChildAttr.ag" #-} rule26 = \ ((!_nontsIinhMap') :: Map Identifier Attributes) -> {-# LINE 15 "src-ag/DistChildAttr.ag" #-} _nontsIinhMap' {-# LINE 511 "dist/build/Desugar.hs"#-} {-# INLINE rule27 #-} {-# LINE 16 "src-ag/DistChildAttr.ag" #-} rule27 = \ ((!_nontsIsynMap') :: Map Identifier Attributes) -> {-# LINE 16 "src-ag/DistChildAttr.ag" #-} _nontsIsynMap' {-# LINE 517 "dist/build/Desugar.hs"#-} {-# INLINE rule28 #-} {-# LINE 235 "src-ag/Desugar.ag" #-} rule28 = \ !augmentsMap_ -> {-# LINE 235 "src-ag/Desugar.ag" #-} augmentsMap_ {-# LINE 523 "dist/build/Desugar.hs"#-} {-# INLINE rule29 #-} {-# LINE 319 "src-ag/Desugar.ag" #-} rule29 = \ ((!_nontsIaugmentsOut) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ((!_nontsIoutput) :: Nonterminals) !aroundsMap_ !contextMap_ !derivings_ !manualAttrOrderMap_ !mergeMap_ !paramMap_ !pragmas_ !quantMap_ !typeSyns_ !uniqueMap_ !useMap_ !wrappers_ -> {-# LINE 319 "src-ag/Desugar.ag" #-} Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ _nontsIaugmentsOut aroundsMap_ mergeMap_ {-# LINE 542 "dist/build/Desugar.hs"#-} {-# INLINE rule30 #-} rule30 = \ ((!_nontsIallAttributes) :: AttrMap) -> _nontsIallAttributes {-# INLINE rule31 #-} rule31 = \ ((!_nontsIerrors) :: Seq Error) -> _nontsIerrors {-# INLINE rule33 #-} rule33 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# INLINE rule34 #-} rule34 = \ ((!_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule35 #-} rule35 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions -- HsToken ----------------------------------------------------- -- wrapper data Inh_HsToken = Inh_HsToken { addLines_Inh_HsToken :: !(Int), childInhs_Inh_HsToken :: !([(Identifier, Identifier)]), childSyns_Inh_HsToken :: !([(Identifier, Identifier)]), con_Inh_HsToken :: !(ConstructorIdent), nt_Inh_HsToken :: !(NontermIdent), ruleDescr_Inh_HsToken :: !(String), useFieldIdent_Inh_HsToken :: !(Bool) } data Syn_HsToken = Syn_HsToken { addLines_Syn_HsToken :: !(Int), errors_Syn_HsToken :: !(Seq Error), tks_Syn_HsToken :: !(HsToken) } {-# INLINABLE wrap_HsToken #-} wrap_HsToken :: T_HsToken -> Inh_HsToken -> (Syn_HsToken ) wrap_HsToken !(T_HsToken act) !(Inh_HsToken _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg4 = T_HsToken_vIn4 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent !(T_HsToken_vOut4 _lhsOaddLines _lhsOerrors _lhsOtks) <- return (inv_HsToken_s8 sem K_HsToken_v4 arg4) return (Syn_HsToken _lhsOaddLines _lhsOerrors _lhsOtks) ) -- cata {-# NOINLINE sem_HsToken #-} sem_HsToken :: HsToken -> T_HsToken sem_HsToken ( AGLocal !var_ !pos_ !rdesc_ ) = sem_HsToken_AGLocal var_ pos_ rdesc_ sem_HsToken ( AGField !field_ !attr_ !pos_ !rdesc_ ) = sem_HsToken_AGField field_ attr_ pos_ rdesc_ sem_HsToken ( HsToken !value_ !pos_ ) = sem_HsToken_HsToken value_ pos_ sem_HsToken ( CharToken !value_ !pos_ ) = sem_HsToken_CharToken value_ pos_ sem_HsToken ( StrToken !value_ !pos_ ) = sem_HsToken_StrToken value_ pos_ sem_HsToken ( Err !mesg_ !pos_ ) = sem_HsToken_Err mesg_ pos_ -- semantic domain newtype T_HsToken = T_HsToken { attach_T_HsToken :: Identity (T_HsToken_s8 ) } data T_HsToken_s8 where C_HsToken_s8 :: { inv_HsToken_s8 :: !(forall t. K_HsToken_s8 t -> t) } -> T_HsToken_s8 data T_HsToken_s9 = C_HsToken_s9 data T_HsToken_s37 = C_HsToken_s37 newtype T_HsToken_s47 = C_HsToken_s47 { inv_HsToken_s47 :: (T_HsToken_v35 ) } data K_HsToken_s8 k where K_HsToken_v4 :: K_HsToken_s8 (T_HsToken_v4 ) K_HsToken_v21 :: K_HsToken_s8 (T_HsToken_v21 ) K_HsToken_v34 :: K_HsToken_s8 (T_HsToken_v34 ) type T_HsToken_v4 = (T_HsToken_vIn4 ) -> (T_HsToken_vOut4 ) data T_HsToken_vIn4 = T_HsToken_vIn4 !(Int) !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) !(String) !(Bool) data T_HsToken_vOut4 = T_HsToken_vOut4 !(Int) !(Seq Error) !(HsToken) type T_HsToken_v21 = (T_HsToken_vIn21 ) -> (T_HsToken_vOut21 ) data T_HsToken_vIn21 = T_HsToken_vIn21 !(Int) !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) !(String) !(Bool) data T_HsToken_vOut21 = T_HsToken_vOut21 !(Int) !(Seq Error) !(HsToken) type T_HsToken_v34 = (T_HsToken_vIn34 ) -> (T_HsToken_vOut34 ) data T_HsToken_vIn34 = T_HsToken_vIn34 !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) data T_HsToken_vOut34 = T_HsToken_vOut34 !(Seq Error) !(T_HsToken_s47 ) type T_HsToken_v35 = (T_HsToken_vIn35 ) -> (T_HsToken_vOut35 ) data T_HsToken_vIn35 = T_HsToken_vIn35 !(Int) !(String) !(Bool) data T_HsToken_vOut35 = T_HsToken_vOut35 !(Int) !(HsToken) {-# NOINLINE sem_HsToken_AGLocal #-} sem_HsToken_AGLocal :: (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGLocal !arg_var_ !arg_pos_ _ = T_HsToken (return st8) where {-# NOINLINE st8 #-} !st8 = let k8 :: K_HsToken_s8 t -> t k8 K_HsToken_v4 = v4 k8 K_HsToken_v21 = v21 k8 K_HsToken_v34 = v34 v4 :: T_HsToken_v4 v4 = \ !(T_HsToken_vIn4 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule38 () in let _lhsOaddLines :: Int !_lhsOaddLines = rule36 _lhsIaddLines _lhsIuseFieldIdent in let !_tks = rule37 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent arg_pos_ arg_var_ in let _lhsOtks :: HsToken !_lhsOtks = rule39 _tks in let !__result_ = T_HsToken_vOut4 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) v21 :: T_HsToken_v21 v21 = \ !(T_HsToken_vIn21 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule38 () in let _lhsOaddLines :: Int !_lhsOaddLines = rule36 _lhsIaddLines _lhsIuseFieldIdent in let !_tks = rule37 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent arg_pos_ arg_var_ in let _lhsOtks :: HsToken !_lhsOtks = rule39 _tks in let !__result_ = T_HsToken_vOut21 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) v34 :: T_HsToken_v34 v34 = \ !(T_HsToken_vIn34 _lhsIchildSyns _lhsIcon _lhsInt) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule38 () in let !__st_ = st47 () !__result_ = T_HsToken_vOut34 _lhsOerrors __st_ in __result_ ) in C_HsToken_s8 k8 {-# NOINLINE st47 #-} st47 = \ (_ :: ()) -> let v35 :: T_HsToken_v35 v35 = \ !(T_HsToken_vIn35 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOaddLines :: Int !_lhsOaddLines = rule36 _lhsIaddLines _lhsIuseFieldIdent in let !_tks = rule37 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent arg_pos_ arg_var_ in let _lhsOtks :: HsToken !_lhsOtks = rule39 _tks in let !__result_ = T_HsToken_vOut35 _lhsOaddLines _lhsOtks in __result_ ) in C_HsToken_s47 v35 {-# NOINLINE[1] rule36 #-} {-# LINE 74 "src-ag/Desugar.ag" #-} rule36 = \ ((!_lhsIaddLines) :: Int) ((!_lhsIuseFieldIdent) :: Bool) -> {-# LINE 74 "src-ag/Desugar.ag" #-} if _lhsIuseFieldIdent then _lhsIaddLines + 1 else _lhsIaddLines {-# LINE 669 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule37 #-} {-# LINE 77 "src-ag/Desugar.ag" #-} rule37 = \ ((!_lhsIaddLines) :: Int) ((!_lhsIruleDescr) :: String) ((!_lhsIuseFieldIdent) :: Bool) !pos_ !var_ -> {-# LINE 77 "src-ag/Desugar.ag" #-} AGLocal var_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing) {-# LINE 675 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule38 #-} rule38 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule39 #-} rule39 = \ !_tks -> _tks {-# NOINLINE sem_HsToken_AGField #-} sem_HsToken_AGField :: (Identifier) -> (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGField !arg_field_ !arg_attr_ !arg_pos_ _ = T_HsToken (return st8) where {-# NOINLINE st8 #-} !st8 = let k8 :: K_HsToken_s8 t -> t k8 K_HsToken_v4 = v4 k8 K_HsToken_v21 = v21 k8 K_HsToken_v34 = v34 v4 :: T_HsToken_v4 v4 = \ !(T_HsToken_vIn4 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let !_mField = rule40 _lhsIchildSyns arg_attr_ arg_field_ in let !_field' = rule41 _mField arg_field_ in let _lhsOaddLines :: Int !_lhsOaddLines = rule43 _field' _lhsIaddLines _lhsIuseFieldIdent arg_field_ in let _lhsOerrors :: Seq Error !_lhsOerrors = rule42 _lhsIcon _lhsInt _mField arg_field_ in let !_tks = rule44 _field' _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent arg_attr_ arg_pos_ in let _lhsOtks :: HsToken !_lhsOtks = rule45 _tks in let !__result_ = T_HsToken_vOut4 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) v21 :: T_HsToken_v21 v21 = \ !(T_HsToken_vIn21 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let !_mField = rule40 _lhsIchildSyns arg_attr_ arg_field_ in let !_field' = rule41 _mField arg_field_ in let _lhsOaddLines :: Int !_lhsOaddLines = rule43 _field' _lhsIaddLines _lhsIuseFieldIdent arg_field_ in let _lhsOerrors :: Seq Error !_lhsOerrors = rule42 _lhsIcon _lhsInt _mField arg_field_ in let !_tks = rule44 _field' _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent arg_attr_ arg_pos_ in let _lhsOtks :: HsToken !_lhsOtks = rule45 _tks in let !__result_ = T_HsToken_vOut21 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) v34 :: T_HsToken_v34 v34 = \ !(T_HsToken_vIn34 _lhsIchildSyns _lhsIcon _lhsInt) -> ( let !_mField = rule40 _lhsIchildSyns arg_attr_ arg_field_ in let _lhsOerrors :: Seq Error !_lhsOerrors = rule42 _lhsIcon _lhsInt _mField arg_field_ in let !__st_ = st47 _mField !__result_ = T_HsToken_vOut34 _lhsOerrors __st_ in __result_ ) in C_HsToken_s8 k8 {-# NOINLINE st47 #-} st47 = \ !_mField -> let v35 :: T_HsToken_v35 v35 = \ !(T_HsToken_vIn35 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( let !_field' = rule41 _mField arg_field_ in let _lhsOaddLines :: Int !_lhsOaddLines = rule43 _field' _lhsIaddLines _lhsIuseFieldIdent arg_field_ in let !_tks = rule44 _field' _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent arg_attr_ arg_pos_ in let _lhsOtks :: HsToken !_lhsOtks = rule45 _tks in let !__result_ = T_HsToken_vOut35 _lhsOaddLines _lhsOtks in __result_ ) in C_HsToken_s47 v35 {-# NOINLINE[1] rule40 #-} {-# LINE 79 "src-ag/Desugar.ag" #-} rule40 = \ ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) !attr_ !field_ -> {-# LINE 79 "src-ag/Desugar.ag" #-} findField field_ attr_ _lhsIchildSyns {-# LINE 744 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule41 #-} {-# LINE 81 "src-ag/Desugar.ag" #-} rule41 = \ !_mField !field_ -> {-# LINE 81 "src-ag/Desugar.ag" #-} maybe field_ id _mField {-# LINE 750 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule42 #-} {-# LINE 82 "src-ag/Desugar.ag" #-} rule42 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) !_mField !field_ -> {-# LINE 82 "src-ag/Desugar.ag" #-} maybe (Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ (Ident "" (getPos field_)) False)) (const Seq.empty) _mField {-# LINE 756 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule43 #-} {-# LINE 84 "src-ag/Desugar.ag" #-} rule43 = \ !_field' ((!_lhsIaddLines) :: Int) ((!_lhsIuseFieldIdent) :: Bool) !field_ -> {-# LINE 84 "src-ag/Desugar.ag" #-} if _lhsIuseFieldIdent || length (getName field_) < length (getName _field' ) then _lhsIaddLines + 1 else _lhsIaddLines {-# LINE 764 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule44 #-} {-# LINE 88 "src-ag/Desugar.ag" #-} rule44 = \ !_field' ((!_lhsIaddLines) :: Int) ((!_lhsIruleDescr) :: String) ((!_lhsIuseFieldIdent) :: Bool) !attr_ !pos_ -> {-# LINE 88 "src-ag/Desugar.ag" #-} AGField _field' attr_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing) {-# LINE 770 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule45 #-} rule45 = \ !_tks -> _tks {-# NOINLINE sem_HsToken_HsToken #-} sem_HsToken_HsToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_HsToken !arg_value_ !arg_pos_ = T_HsToken (return st8) where {-# NOINLINE st8 #-} !st8 = let k8 :: K_HsToken_s8 t -> t k8 K_HsToken_v4 = v4 k8 K_HsToken_v21 = v21 k8 K_HsToken_v34 = v34 v4 :: T_HsToken_v4 v4 = \ !(T_HsToken_vIn4 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule47 () in let _lhsOaddLines :: Int !_lhsOaddLines = rule49 _lhsIaddLines in let !_tks = rule46 _lhsIaddLines arg_pos_ arg_value_ in let _lhsOtks :: HsToken !_lhsOtks = rule48 _tks in let !__result_ = T_HsToken_vOut4 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) v21 :: T_HsToken_v21 v21 = \ !(T_HsToken_vIn21 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule47 () in let _lhsOaddLines :: Int !_lhsOaddLines = rule49 _lhsIaddLines in let !_tks = rule46 _lhsIaddLines arg_pos_ arg_value_ in let _lhsOtks :: HsToken !_lhsOtks = rule48 _tks in let !__result_ = T_HsToken_vOut21 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) v34 :: T_HsToken_v34 v34 = \ !(T_HsToken_vIn34 _lhsIchildSyns _lhsIcon _lhsInt) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule47 () in let !__st_ = st47 () !__result_ = T_HsToken_vOut34 _lhsOerrors __st_ in __result_ ) in C_HsToken_s8 k8 {-# NOINLINE st47 #-} st47 = \ (_ :: ()) -> let v35 :: T_HsToken_v35 v35 = \ !(T_HsToken_vIn35 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOaddLines :: Int !_lhsOaddLines = rule49 _lhsIaddLines in let !_tks = rule46 _lhsIaddLines arg_pos_ arg_value_ in let _lhsOtks :: HsToken !_lhsOtks = rule48 _tks in let !__result_ = T_HsToken_vOut35 _lhsOaddLines _lhsOtks in __result_ ) in C_HsToken_s47 v35 {-# NOINLINE[1] rule46 #-} {-# LINE 90 "src-ag/Desugar.ag" #-} rule46 = \ ((!_lhsIaddLines) :: Int) !pos_ !value_ -> {-# LINE 90 "src-ag/Desugar.ag" #-} HsToken value_ (addl _lhsIaddLines pos_) {-# LINE 830 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule47 #-} rule47 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule48 #-} rule48 = \ !_tks -> _tks {-# NOINLINE[1] rule49 #-} rule49 = \ ((!_lhsIaddLines) :: Int) -> _lhsIaddLines {-# NOINLINE sem_HsToken_CharToken #-} sem_HsToken_CharToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_CharToken !arg_value_ !arg_pos_ = T_HsToken (return st8) where {-# NOINLINE st8 #-} !st8 = let k8 :: K_HsToken_s8 t -> t k8 K_HsToken_v4 = v4 k8 K_HsToken_v21 = v21 k8 K_HsToken_v34 = v34 v4 :: T_HsToken_v4 v4 = \ !(T_HsToken_vIn4 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule51 () in let _lhsOaddLines :: Int !_lhsOaddLines = rule53 _lhsIaddLines in let !_tks = rule50 _lhsIaddLines arg_pos_ arg_value_ in let _lhsOtks :: HsToken !_lhsOtks = rule52 _tks in let !__result_ = T_HsToken_vOut4 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) v21 :: T_HsToken_v21 v21 = \ !(T_HsToken_vIn21 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule51 () in let _lhsOaddLines :: Int !_lhsOaddLines = rule53 _lhsIaddLines in let !_tks = rule50 _lhsIaddLines arg_pos_ arg_value_ in let _lhsOtks :: HsToken !_lhsOtks = rule52 _tks in let !__result_ = T_HsToken_vOut21 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) v34 :: T_HsToken_v34 v34 = \ !(T_HsToken_vIn34 _lhsIchildSyns _lhsIcon _lhsInt) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule51 () in let !__st_ = st47 () !__result_ = T_HsToken_vOut34 _lhsOerrors __st_ in __result_ ) in C_HsToken_s8 k8 {-# NOINLINE st47 #-} st47 = \ (_ :: ()) -> let v35 :: T_HsToken_v35 v35 = \ !(T_HsToken_vIn35 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOaddLines :: Int !_lhsOaddLines = rule53 _lhsIaddLines in let !_tks = rule50 _lhsIaddLines arg_pos_ arg_value_ in let _lhsOtks :: HsToken !_lhsOtks = rule52 _tks in let !__result_ = T_HsToken_vOut35 _lhsOaddLines _lhsOtks in __result_ ) in C_HsToken_s47 v35 {-# NOINLINE[1] rule50 #-} {-# LINE 92 "src-ag/Desugar.ag" #-} rule50 = \ ((!_lhsIaddLines) :: Int) !pos_ !value_ -> {-# LINE 92 "src-ag/Desugar.ag" #-} CharToken value_ (addl _lhsIaddLines pos_) {-# LINE 896 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule51 #-} rule51 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule52 #-} rule52 = \ !_tks -> _tks {-# NOINLINE[1] rule53 #-} rule53 = \ ((!_lhsIaddLines) :: Int) -> _lhsIaddLines {-# NOINLINE sem_HsToken_StrToken #-} sem_HsToken_StrToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_StrToken !arg_value_ !arg_pos_ = T_HsToken (return st8) where {-# NOINLINE st8 #-} !st8 = let k8 :: K_HsToken_s8 t -> t k8 K_HsToken_v4 = v4 k8 K_HsToken_v21 = v21 k8 K_HsToken_v34 = v34 v4 :: T_HsToken_v4 v4 = \ !(T_HsToken_vIn4 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule55 () in let _lhsOaddLines :: Int !_lhsOaddLines = rule57 _lhsIaddLines in let !_tks = rule54 _lhsIaddLines arg_pos_ arg_value_ in let _lhsOtks :: HsToken !_lhsOtks = rule56 _tks in let !__result_ = T_HsToken_vOut4 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) v21 :: T_HsToken_v21 v21 = \ !(T_HsToken_vIn21 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule55 () in let _lhsOaddLines :: Int !_lhsOaddLines = rule57 _lhsIaddLines in let !_tks = rule54 _lhsIaddLines arg_pos_ arg_value_ in let _lhsOtks :: HsToken !_lhsOtks = rule56 _tks in let !__result_ = T_HsToken_vOut21 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) v34 :: T_HsToken_v34 v34 = \ !(T_HsToken_vIn34 _lhsIchildSyns _lhsIcon _lhsInt) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule55 () in let !__st_ = st47 () !__result_ = T_HsToken_vOut34 _lhsOerrors __st_ in __result_ ) in C_HsToken_s8 k8 {-# NOINLINE st47 #-} st47 = \ (_ :: ()) -> let v35 :: T_HsToken_v35 v35 = \ !(T_HsToken_vIn35 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOaddLines :: Int !_lhsOaddLines = rule57 _lhsIaddLines in let !_tks = rule54 _lhsIaddLines arg_pos_ arg_value_ in let _lhsOtks :: HsToken !_lhsOtks = rule56 _tks in let !__result_ = T_HsToken_vOut35 _lhsOaddLines _lhsOtks in __result_ ) in C_HsToken_s47 v35 {-# NOINLINE[1] rule54 #-} {-# LINE 94 "src-ag/Desugar.ag" #-} rule54 = \ ((!_lhsIaddLines) :: Int) !pos_ !value_ -> {-# LINE 94 "src-ag/Desugar.ag" #-} StrToken value_ (addl _lhsIaddLines pos_) {-# LINE 962 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule55 #-} rule55 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule56 #-} rule56 = \ !_tks -> _tks {-# NOINLINE[1] rule57 #-} rule57 = \ ((!_lhsIaddLines) :: Int) -> _lhsIaddLines {-# NOINLINE sem_HsToken_Err #-} sem_HsToken_Err :: (String) -> (Pos) -> T_HsToken sem_HsToken_Err !arg_mesg_ !arg_pos_ = T_HsToken (return st8) where {-# NOINLINE st8 #-} !st8 = let k8 :: K_HsToken_s8 t -> t k8 K_HsToken_v4 = v4 k8 K_HsToken_v21 = v21 k8 K_HsToken_v34 = v34 v4 :: T_HsToken_v4 v4 = \ !(T_HsToken_vIn4 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule59 () in let _lhsOaddLines :: Int !_lhsOaddLines = rule61 _lhsIaddLines in let !_tks = rule58 _lhsIaddLines arg_mesg_ arg_pos_ in let _lhsOtks :: HsToken !_lhsOtks = rule60 _tks in let !__result_ = T_HsToken_vOut4 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) v21 :: T_HsToken_v21 v21 = \ !(T_HsToken_vIn21 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule59 () in let _lhsOaddLines :: Int !_lhsOaddLines = rule61 _lhsIaddLines in let !_tks = rule58 _lhsIaddLines arg_mesg_ arg_pos_ in let _lhsOtks :: HsToken !_lhsOtks = rule60 _tks in let !__result_ = T_HsToken_vOut21 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) v34 :: T_HsToken_v34 v34 = \ !(T_HsToken_vIn34 _lhsIchildSyns _lhsIcon _lhsInt) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule59 () in let !__st_ = st47 () !__result_ = T_HsToken_vOut34 _lhsOerrors __st_ in __result_ ) in C_HsToken_s8 k8 {-# NOINLINE st47 #-} st47 = \ (_ :: ()) -> let v35 :: T_HsToken_v35 v35 = \ !(T_HsToken_vIn35 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOaddLines :: Int !_lhsOaddLines = rule61 _lhsIaddLines in let !_tks = rule58 _lhsIaddLines arg_mesg_ arg_pos_ in let _lhsOtks :: HsToken !_lhsOtks = rule60 _tks in let !__result_ = T_HsToken_vOut35 _lhsOaddLines _lhsOtks in __result_ ) in C_HsToken_s47 v35 {-# NOINLINE[1] rule58 #-} {-# LINE 96 "src-ag/Desugar.ag" #-} rule58 = \ ((!_lhsIaddLines) :: Int) !mesg_ !pos_ -> {-# LINE 96 "src-ag/Desugar.ag" #-} Err mesg_ (addl _lhsIaddLines pos_) {-# LINE 1028 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule59 #-} rule59 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule60 #-} rule60 = \ !_tks -> _tks {-# NOINLINE[1] rule61 #-} rule61 = \ ((!_lhsIaddLines) :: Int) -> _lhsIaddLines -- HsTokens ---------------------------------------------------- -- wrapper data Inh_HsTokens = Inh_HsTokens { addLines_Inh_HsTokens :: !(Int), childInhs_Inh_HsTokens :: !([(Identifier, Identifier)]), childSyns_Inh_HsTokens :: !([(Identifier, Identifier)]), con_Inh_HsTokens :: !(ConstructorIdent), nt_Inh_HsTokens :: !(NontermIdent), ruleDescr_Inh_HsTokens :: !(String), useFieldIdent_Inh_HsTokens :: !(Bool) } data Syn_HsTokens = Syn_HsTokens { addLines_Syn_HsTokens :: !(Int), errors_Syn_HsTokens :: !(Seq Error), tks_Syn_HsTokens :: !(HsTokens) } {-# INLINABLE wrap_HsTokens #-} wrap_HsTokens :: T_HsTokens -> Inh_HsTokens -> (Syn_HsTokens ) wrap_HsTokens !(T_HsTokens act) !(Inh_HsTokens _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg5 = T_HsTokens_vIn5 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent !(T_HsTokens_vOut5 _lhsOaddLines _lhsOerrors _lhsOtks) <- return (inv_HsTokens_s10 sem K_HsTokens_v5 arg5) return (Syn_HsTokens _lhsOaddLines _lhsOerrors _lhsOtks) ) -- cata {-# NOINLINE sem_HsTokens #-} sem_HsTokens :: HsTokens -> T_HsTokens sem_HsTokens list = Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) -- semantic domain newtype T_HsTokens = T_HsTokens { attach_T_HsTokens :: Identity (T_HsTokens_s10 ) } data T_HsTokens_s10 where C_HsTokens_s10 :: { inv_HsTokens_s10 :: !(forall t. K_HsTokens_s10 t -> t) } -> T_HsTokens_s10 data T_HsTokens_s11 = C_HsTokens_s11 newtype T_HsTokens_s38 = C_HsTokens_s38 { inv_HsTokens_s38 :: (T_HsTokens_v23 ) } data T_HsTokens_s39 = C_HsTokens_s39 data K_HsTokens_s10 k where K_HsTokens_v5 :: K_HsTokens_s10 (T_HsTokens_v5 ) K_HsTokens_v22 :: K_HsTokens_s10 (T_HsTokens_v22 ) K_HsTokens_v24 :: K_HsTokens_s10 (T_HsTokens_v24 ) type T_HsTokens_v5 = (T_HsTokens_vIn5 ) -> (T_HsTokens_vOut5 ) data T_HsTokens_vIn5 = T_HsTokens_vIn5 !(Int) !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) !(String) !(Bool) data T_HsTokens_vOut5 = T_HsTokens_vOut5 !(Int) !(Seq Error) !(HsTokens) type T_HsTokens_v22 = (T_HsTokens_vIn22 ) -> (T_HsTokens_vOut22 ) data T_HsTokens_vIn22 = T_HsTokens_vIn22 !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) data T_HsTokens_vOut22 = T_HsTokens_vOut22 !(Seq Error) !(T_HsTokens_s38 ) type T_HsTokens_v23 = (T_HsTokens_vIn23 ) -> (T_HsTokens_vOut23 ) data T_HsTokens_vIn23 = T_HsTokens_vIn23 !(Int) !(String) !(Bool) data T_HsTokens_vOut23 = T_HsTokens_vOut23 !(Int) !(HsTokens) type T_HsTokens_v24 = (T_HsTokens_vIn24 ) -> (T_HsTokens_vOut24 ) data T_HsTokens_vIn24 = T_HsTokens_vIn24 !(Int) !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) !(String) !(Bool) data T_HsTokens_vOut24 = T_HsTokens_vOut24 !(Int) !(Seq Error) !(HsTokens) {-# NOINLINE sem_HsTokens_Cons #-} sem_HsTokens_Cons :: T_HsToken -> T_HsTokens -> T_HsTokens sem_HsTokens_Cons arg_hd_ arg_tl_ = T_HsTokens (return st10) where {-# NOINLINE st10 #-} !st10 = let k10 :: K_HsTokens_s10 t -> t k10 K_HsTokens_v5 = v5 k10 K_HsTokens_v22 = v22 k10 K_HsTokens_v24 = v24 v5 :: T_HsTokens_v5 v5 = \ !(T_HsTokens_vIn5 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let !_hdX8 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_)) in let !_tlX10 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_)) in let !_hdOaddLines = rule66 _lhsIaddLines in let !_hdOchildSyns = rule68 _lhsIchildSyns in let !_hdOuseFieldIdent = rule72 _lhsIuseFieldIdent in let !_tlOchildSyns = rule75 _lhsIchildSyns in let !_tlOuseFieldIdent = rule79 _lhsIuseFieldIdent in let !_hdOcon = rule69 _lhsIcon in let !_hdOnt = rule70 _lhsInt in let !_tlOcon = rule76 _lhsIcon in let !_tlOnt = rule77 _lhsInt in let !_hdOruleDescr = rule71 _lhsIruleDescr in let !_tlOruleDescr = rule78 _lhsIruleDescr in let !(T_HsToken_vOut21 _hdIaddLines _hdIerrors _hdItks) = inv_HsToken_s8 _hdX8 K_HsToken_v21 (T_HsToken_vIn21 _hdOaddLines _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent) in let !(T_HsTokens_vOut22 _tlIerrors _tlX38) = inv_HsTokens_s10 _tlX10 K_HsTokens_v22 (T_HsTokens_vIn22 _tlOchildSyns _tlOcon _tlOnt) in let !_tlOaddLines = rule73 _hdIaddLines in let _lhsOerrors :: Seq Error !_lhsOerrors = rule62 _hdIerrors _tlIerrors in let !(T_HsTokens_vOut23 _tlIaddLines _tlItks) = inv_HsTokens_s38 _tlX38 (T_HsTokens_vIn23 _tlOaddLines _tlOruleDescr _tlOuseFieldIdent) in let _lhsOaddLines :: Int !_lhsOaddLines = rule65 _tlIaddLines in let !_tks = rule63 _hdItks _tlItks in let _lhsOtks :: HsTokens !_lhsOtks = rule64 _tks in let !__result_ = T_HsTokens_vOut5 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) v22 :: T_HsTokens_v22 v22 = \ !(T_HsTokens_vIn22 _lhsIchildSyns _lhsIcon _lhsInt) -> ( let !_hdX8 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_)) in let !_tlX10 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_)) in let !_hdOchildSyns = rule68 _lhsIchildSyns in let !_hdOcon = rule69 _lhsIcon in let !_hdOnt = rule70 _lhsInt in let !_tlOchildSyns = rule75 _lhsIchildSyns in let !_tlOcon = rule76 _lhsIcon in let !_tlOnt = rule77 _lhsInt in let !(T_HsToken_vOut34 _hdIerrors _hdX47) = inv_HsToken_s8 _hdX8 K_HsToken_v34 (T_HsToken_vIn34 _hdOchildSyns _hdOcon _hdOnt) in let !(T_HsTokens_vOut22 _tlIerrors _tlX38) = inv_HsTokens_s10 _tlX10 K_HsTokens_v22 (T_HsTokens_vIn22 _tlOchildSyns _tlOcon _tlOnt) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule62 _hdIerrors _tlIerrors in let !__st_ = st38 _hdX47 _tlX38 !__result_ = T_HsTokens_vOut22 _lhsOerrors __st_ in __result_ ) v24 :: T_HsTokens_v24 v24 = \ !(T_HsTokens_vIn24 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let !_hdX8 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_)) in let !_tlX10 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_)) in let !_hdOaddLines = rule66 _lhsIaddLines in let !_hdOchildSyns = rule68 _lhsIchildSyns in let !_hdOuseFieldIdent = rule72 _lhsIuseFieldIdent in let !_tlOchildSyns = rule75 _lhsIchildSyns in let !_tlOuseFieldIdent = rule79 _lhsIuseFieldIdent in let !_hdOcon = rule69 _lhsIcon in let !_hdOnt = rule70 _lhsInt in let !_tlOcon = rule76 _lhsIcon in let !_tlOnt = rule77 _lhsInt in let !_hdOruleDescr = rule71 _lhsIruleDescr in let !_tlOruleDescr = rule78 _lhsIruleDescr in let !(T_HsToken_vOut21 _hdIaddLines _hdIerrors _hdItks) = inv_HsToken_s8 _hdX8 K_HsToken_v21 (T_HsToken_vIn21 _hdOaddLines _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent) in let !(T_HsTokens_vOut22 _tlIerrors _tlX38) = inv_HsTokens_s10 _tlX10 K_HsTokens_v22 (T_HsTokens_vIn22 _tlOchildSyns _tlOcon _tlOnt) in let !_tlOaddLines = rule73 _hdIaddLines in let _lhsOerrors :: Seq Error !_lhsOerrors = rule62 _hdIerrors _tlIerrors in let !(T_HsTokens_vOut23 _tlIaddLines _tlItks) = inv_HsTokens_s38 _tlX38 (T_HsTokens_vIn23 _tlOaddLines _tlOruleDescr _tlOuseFieldIdent) in let _lhsOaddLines :: Int !_lhsOaddLines = rule65 _tlIaddLines in let !_tks = rule63 _hdItks _tlItks in let _lhsOtks :: HsTokens !_lhsOtks = rule64 _tks in let !__result_ = T_HsTokens_vOut24 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) in C_HsTokens_s10 k10 {-# NOINLINE st38 #-} st38 = \ !_hdX47 !_tlX38 -> let v23 :: T_HsTokens_v23 v23 = \ !(T_HsTokens_vIn23 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( let !_hdOaddLines = rule66 _lhsIaddLines in let !_hdOuseFieldIdent = rule72 _lhsIuseFieldIdent in let !_tlOuseFieldIdent = rule79 _lhsIuseFieldIdent in let !_hdOruleDescr = rule71 _lhsIruleDescr in let !_tlOruleDescr = rule78 _lhsIruleDescr in let !(T_HsToken_vOut35 _hdIaddLines _hdItks) = inv_HsToken_s47 _hdX47 (T_HsToken_vIn35 _hdOaddLines _hdOruleDescr _hdOuseFieldIdent) in let !_tlOaddLines = rule73 _hdIaddLines in let !(T_HsTokens_vOut23 _tlIaddLines _tlItks) = inv_HsTokens_s38 _tlX38 (T_HsTokens_vIn23 _tlOaddLines _tlOruleDescr _tlOuseFieldIdent) in let _lhsOaddLines :: Int !_lhsOaddLines = rule65 _tlIaddLines in let !_tks = rule63 _hdItks _tlItks in let _lhsOtks :: HsTokens !_lhsOtks = rule64 _tks in let !__result_ = T_HsTokens_vOut23 _lhsOaddLines _lhsOtks in __result_ ) in C_HsTokens_s38 v23 {-# NOINLINE[1] rule62 #-} rule62 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# NOINLINE[1] rule63 #-} rule63 = \ ((!_hdItks) :: HsToken) ((!_tlItks) :: HsTokens) -> (:) _hdItks _tlItks {-# NOINLINE[1] rule64 #-} rule64 = \ !_tks -> _tks {-# NOINLINE[1] rule65 #-} rule65 = \ ((!_tlIaddLines) :: Int) -> _tlIaddLines {-# NOINLINE[1] rule66 #-} rule66 = \ ((!_lhsIaddLines) :: Int) -> _lhsIaddLines {-# NOINLINE[1] rule68 #-} rule68 = \ ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) -> _lhsIchildSyns {-# NOINLINE[1] rule69 #-} rule69 = \ ((!_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# NOINLINE[1] rule70 #-} rule70 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE[1] rule71 #-} rule71 = \ ((!_lhsIruleDescr) :: String) -> _lhsIruleDescr {-# NOINLINE[1] rule72 #-} rule72 = \ ((!_lhsIuseFieldIdent) :: Bool) -> _lhsIuseFieldIdent {-# NOINLINE[1] rule73 #-} rule73 = \ ((!_hdIaddLines) :: Int) -> _hdIaddLines {-# NOINLINE[1] rule75 #-} rule75 = \ ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) -> _lhsIchildSyns {-# NOINLINE[1] rule76 #-} rule76 = \ ((!_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# NOINLINE[1] rule77 #-} rule77 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE[1] rule78 #-} rule78 = \ ((!_lhsIruleDescr) :: String) -> _lhsIruleDescr {-# NOINLINE[1] rule79 #-} rule79 = \ ((!_lhsIuseFieldIdent) :: Bool) -> _lhsIuseFieldIdent {-# NOINLINE sem_HsTokens_Nil #-} sem_HsTokens_Nil :: T_HsTokens sem_HsTokens_Nil = T_HsTokens (return st10) where {-# NOINLINE st10 #-} !st10 = let k10 :: K_HsTokens_s10 t -> t k10 K_HsTokens_v5 = v5 k10 K_HsTokens_v22 = v22 k10 K_HsTokens_v24 = v24 v5 :: T_HsTokens_v5 v5 = \ !(T_HsTokens_vIn5 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule80 () in let !_tks = rule81 () in let _lhsOaddLines :: Int !_lhsOaddLines = rule83 _lhsIaddLines in let _lhsOtks :: HsTokens !_lhsOtks = rule82 _tks in let !__result_ = T_HsTokens_vOut5 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) v22 :: T_HsTokens_v22 v22 = \ !(T_HsTokens_vIn22 _lhsIchildSyns _lhsIcon _lhsInt) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule80 () in let !__st_ = st38 () !__result_ = T_HsTokens_vOut22 _lhsOerrors __st_ in __result_ ) v24 :: T_HsTokens_v24 v24 = \ !(T_HsTokens_vIn24 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule80 () in let !_tks = rule81 () in let _lhsOaddLines :: Int !_lhsOaddLines = rule83 _lhsIaddLines in let _lhsOtks :: HsTokens !_lhsOtks = rule82 _tks in let !__result_ = T_HsTokens_vOut24 _lhsOaddLines _lhsOerrors _lhsOtks in __result_ ) in C_HsTokens_s10 k10 {-# NOINLINE st38 #-} st38 = \ (_ :: ()) -> let v23 :: T_HsTokens_v23 v23 = \ !(T_HsTokens_vIn23 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( let !_tks = rule81 () in let _lhsOaddLines :: Int !_lhsOaddLines = rule83 _lhsIaddLines in let _lhsOtks :: HsTokens !_lhsOtks = rule82 _tks in let !__result_ = T_HsTokens_vOut23 _lhsOaddLines _lhsOtks in __result_ ) in C_HsTokens_s38 v23 {-# NOINLINE[1] rule80 #-} rule80 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule81 #-} rule81 = \ (_ :: ()) -> [] {-# NOINLINE[1] rule82 #-} rule82 = \ !_tks -> _tks {-# NOINLINE[1] rule83 #-} rule83 = \ ((!_lhsIaddLines) :: Int) -> _lhsIaddLines -- HsTokensRoot ------------------------------------------------ -- wrapper data Inh_HsTokensRoot = Inh_HsTokensRoot { childInhs_Inh_HsTokensRoot :: !([(Identifier, Identifier)]), childSyns_Inh_HsTokensRoot :: !([(Identifier, Identifier)]), con_Inh_HsTokensRoot :: !(ConstructorIdent), nt_Inh_HsTokensRoot :: !(NontermIdent), ruleDescr_Inh_HsTokensRoot :: !(String), useFieldIdent_Inh_HsTokensRoot :: !(Bool) } data Syn_HsTokensRoot = Syn_HsTokensRoot { errors_Syn_HsTokensRoot :: !(Seq Error), tks_Syn_HsTokensRoot :: !([HsToken]) } {-# INLINABLE wrap_HsTokensRoot #-} wrap_HsTokensRoot :: T_HsTokensRoot -> Inh_HsTokensRoot -> (Syn_HsTokensRoot ) wrap_HsTokensRoot !(T_HsTokensRoot act) !(Inh_HsTokensRoot _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg6 = T_HsTokensRoot_vIn6 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent !(T_HsTokensRoot_vOut6 _lhsOerrors _lhsOtks) <- return (inv_HsTokensRoot_s12 sem arg6) return (Syn_HsTokensRoot _lhsOerrors _lhsOtks) ) -- cata {-# INLINE sem_HsTokensRoot #-} sem_HsTokensRoot :: HsTokensRoot -> T_HsTokensRoot sem_HsTokensRoot ( HsTokensRoot tokens_ ) = sem_HsTokensRoot_HsTokensRoot ( sem_HsTokens tokens_ ) -- semantic domain newtype T_HsTokensRoot = T_HsTokensRoot { attach_T_HsTokensRoot :: Identity (T_HsTokensRoot_s12 ) } newtype T_HsTokensRoot_s12 = C_HsTokensRoot_s12 { inv_HsTokensRoot_s12 :: (T_HsTokensRoot_v6 ) } data T_HsTokensRoot_s13 = C_HsTokensRoot_s13 type T_HsTokensRoot_v6 = (T_HsTokensRoot_vIn6 ) -> (T_HsTokensRoot_vOut6 ) data T_HsTokensRoot_vIn6 = T_HsTokensRoot_vIn6 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) !(String) !(Bool) data T_HsTokensRoot_vOut6 = T_HsTokensRoot_vOut6 !(Seq Error) !([HsToken]) {-# NOINLINE sem_HsTokensRoot_HsTokensRoot #-} sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> T_HsTokensRoot sem_HsTokensRoot_HsTokensRoot arg_tokens_ = T_HsTokensRoot (return st12) where {-# NOINLINE st12 #-} !st12 = let v6 :: T_HsTokensRoot_v6 v6 = \ !(T_HsTokensRoot_vIn6 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let !_tokensX10 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tokens_)) in let !_tokensOaddLines = rule84 () in let !_tokensOchildSyns = rule88 _lhsIchildSyns in let !_tokensOcon = rule89 _lhsIcon in let !_tokensOnt = rule90 _lhsInt in let !_tokensOruleDescr = rule91 _lhsIruleDescr in let !_tokensOuseFieldIdent = rule92 _lhsIuseFieldIdent in let !(T_HsTokens_vOut24 _tokensIaddLines _tokensIerrors _tokensItks) = inv_HsTokens_s10 _tokensX10 K_HsTokens_v24 (T_HsTokens_vIn24 _tokensOaddLines _tokensOchildSyns _tokensOcon _tokensOnt _tokensOruleDescr _tokensOuseFieldIdent) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule85 _tokensIerrors in let _lhsOtks :: [HsToken] !_lhsOtks = rule86 _tokensItks in let !__result_ = T_HsTokensRoot_vOut6 _lhsOerrors _lhsOtks in __result_ ) in C_HsTokensRoot_s12 v6 {-# INLINE rule84 #-} {-# LINE 67 "src-ag/Desugar.ag" #-} rule84 = \ (_ :: ()) -> {-# LINE 67 "src-ag/Desugar.ag" #-} 0 {-# LINE 1358 "dist/build/Desugar.hs"#-} {-# INLINE rule85 #-} rule85 = \ ((!_tokensIerrors) :: Seq Error) -> _tokensIerrors {-# INLINE rule86 #-} rule86 = \ ((!_tokensItks) :: HsTokens) -> _tokensItks {-# INLINE rule88 #-} rule88 = \ ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) -> _lhsIchildSyns {-# INLINE rule89 #-} rule89 = \ ((!_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule90 #-} rule90 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule91 #-} rule91 = \ ((!_lhsIruleDescr) :: String) -> _lhsIruleDescr {-# INLINE rule92 #-} rule92 = \ ((!_lhsIuseFieldIdent) :: Bool) -> _lhsIuseFieldIdent -- Nonterminal ------------------------------------------------- -- wrapper data Inh_Nonterminal = Inh_Nonterminal { augmentsIn_Inh_Nonterminal :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), forcedIrrefutables_Inh_Nonterminal :: !(AttrMap), inhMap_Inh_Nonterminal :: !(Map Identifier Attributes), mainName_Inh_Nonterminal :: !(String), options_Inh_Nonterminal :: !(Options), synMap_Inh_Nonterminal :: !(Map Identifier Attributes) } data Syn_Nonterminal = Syn_Nonterminal { allAttributes_Syn_Nonterminal :: !(AttrMap), augmentsOut_Syn_Nonterminal :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), errors_Syn_Nonterminal :: !(Seq Error), inhMap'_Syn_Nonterminal :: !(Map Identifier Attributes), output_Syn_Nonterminal :: !(Nonterminal), synMap'_Syn_Nonterminal :: !(Map Identifier Attributes) } {-# INLINABLE wrap_Nonterminal #-} wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal ) wrap_Nonterminal !(T_Nonterminal act) !(Inh_Nonterminal _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg7 = T_Nonterminal_vIn7 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap !(T_Nonterminal_vOut7 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap') <- return (inv_Nonterminal_s14 sem K_Nonterminal_v7 arg7) return (Syn_Nonterminal _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap') ) -- cata {-# INLINE sem_Nonterminal #-} sem_Nonterminal :: Nonterminal -> T_Nonterminal sem_Nonterminal ( Nonterminal !nt_ !params_ !inh_ !syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ ) -- semantic domain newtype T_Nonterminal = T_Nonterminal { attach_T_Nonterminal :: Identity (T_Nonterminal_s14 ) } data T_Nonterminal_s14 where C_Nonterminal_s14 :: { inv_Nonterminal_s14 :: !(forall t. K_Nonterminal_s14 t -> t) } -> T_Nonterminal_s14 data T_Nonterminal_s15 = C_Nonterminal_s15 newtype T_Nonterminal_s46 = C_Nonterminal_s46 { inv_Nonterminal_s46 :: (T_Nonterminal_v33 ) } data K_Nonterminal_s14 k where K_Nonterminal_v7 :: K_Nonterminal_s14 (T_Nonterminal_v7 ) K_Nonterminal_v32 :: K_Nonterminal_s14 (T_Nonterminal_v32 ) type T_Nonterminal_v7 = (T_Nonterminal_vIn7 ) -> (T_Nonterminal_vOut7 ) data T_Nonterminal_vIn7 = T_Nonterminal_vIn7 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(AttrMap) !(Map Identifier Attributes) !(String) !(Options) !(Map Identifier Attributes) data T_Nonterminal_vOut7 = T_Nonterminal_vOut7 !(AttrMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Seq Error) !(Map Identifier Attributes) !(Nonterminal) !(Map Identifier Attributes) type T_Nonterminal_v32 = (T_Nonterminal_vIn32 ) -> (T_Nonterminal_vOut32 ) data T_Nonterminal_vIn32 = T_Nonterminal_vIn32 data T_Nonterminal_vOut32 = T_Nonterminal_vOut32 !(AttrMap) !(Map Identifier Attributes) !(Map Identifier Attributes) !(T_Nonterminal_s46 ) type T_Nonterminal_v33 = (T_Nonterminal_vIn33 ) -> (T_Nonterminal_vOut33 ) data T_Nonterminal_vIn33 = T_Nonterminal_vIn33 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(AttrMap) !(Map Identifier Attributes) !(String) !(Options) !(Map Identifier Attributes) data T_Nonterminal_vOut33 = T_Nonterminal_vOut33 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Seq Error) !(Nonterminal) {-# NOINLINE sem_Nonterminal_Nonterminal #-} sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal sem_Nonterminal_Nonterminal !arg_nt_ !arg_params_ !arg_inh_ !arg_syn_ arg_prods_ = T_Nonterminal (return st14) where {-# NOINLINE st14 #-} !st14 = let k14 :: K_Nonterminal_s14 t -> t k14 K_Nonterminal_v7 = v7 k14 K_Nonterminal_v32 = v32 v7 :: T_Nonterminal_v7 v7 = \ !(T_Nonterminal_vIn7 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( let !_prodsX24 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) in let !_prodsOnt = rule95 arg_nt_ in let !_augmentsIn = rule96 _lhsIaugmentsIn arg_nt_ in let !_prodsOaugmentsIn = rule104 _augmentsIn in let !_prodsOinhMap = rule106 _lhsIinhMap in let !_prodsOoptions = rule108 _lhsIoptions in let !_prodsOsynMap = rule109 _lhsIsynMap in let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule93 arg_inh_ arg_nt_ in let !_prodsOforcedIrrefutables = rule105 _lhsIforcedIrrefutables in let !_extraInh = rule98 _lhsImainName _lhsIoptions in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule94 arg_nt_ arg_syn_ in let !(T_Productions_vOut25 _prodsIallAttributes _prodsIaugmentsOut _prodsIerrors _prodsIoutput) = inv_Productions_s24 _prodsX24 K_Productions_v25 (T_Productions_vIn25 _prodsOaugmentsIn _prodsOforcedIrrefutables _prodsOinhMap _prodsOnt _prodsOoptions _prodsOsynMap) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule100 _prodsIallAttributes in let !_augmentsOut = rule97 _prodsIaugmentsOut arg_nt_ in let _lhsOaugmentsOut :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) !_lhsOaugmentsOut = rule101 _augmentsOut in let _lhsOerrors :: Seq Error !_lhsOerrors = rule102 _prodsIerrors in let _lhsOoutput :: Nonterminal !_lhsOoutput = rule99 _extraInh _prodsIoutput arg_inh_ arg_nt_ arg_params_ arg_syn_ in let !__result_ = T_Nonterminal_vOut7 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' in __result_ ) v32 :: T_Nonterminal_v32 v32 = \ !(T_Nonterminal_vIn32 ) -> ( let !_prodsX24 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) in let !_prodsOnt = rule95 arg_nt_ in let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule93 arg_inh_ arg_nt_ in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule94 arg_nt_ arg_syn_ in let !(T_Productions_vOut39 _prodsIallAttributes _prodsX50) = inv_Productions_s24 _prodsX24 K_Productions_v39 (T_Productions_vIn39 _prodsOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule100 _prodsIallAttributes in let !__st_ = st46 _prodsX50 !__result_ = T_Nonterminal_vOut32 _lhsOallAttributes _lhsOinhMap' _lhsOsynMap' __st_ in __result_ ) in C_Nonterminal_s14 k14 {-# NOINLINE st46 #-} st46 = \ !_prodsX50 -> let v33 :: T_Nonterminal_v33 v33 = \ !(T_Nonterminal_vIn33 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( let !_augmentsIn = rule96 _lhsIaugmentsIn arg_nt_ in let !_prodsOaugmentsIn = rule104 _augmentsIn in let !_prodsOinhMap = rule106 _lhsIinhMap in let !_prodsOoptions = rule108 _lhsIoptions in let !_prodsOsynMap = rule109 _lhsIsynMap in let !_prodsOforcedIrrefutables = rule105 _lhsIforcedIrrefutables in let !_extraInh = rule98 _lhsImainName _lhsIoptions in let !(T_Productions_vOut40 _prodsIaugmentsOut _prodsIerrors _prodsIoutput) = inv_Productions_s50 _prodsX50 (T_Productions_vIn40 _prodsOaugmentsIn _prodsOforcedIrrefutables _prodsOinhMap _prodsOoptions _prodsOsynMap) in let !_augmentsOut = rule97 _prodsIaugmentsOut arg_nt_ in let _lhsOaugmentsOut :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) !_lhsOaugmentsOut = rule101 _augmentsOut in let _lhsOerrors :: Seq Error !_lhsOerrors = rule102 _prodsIerrors in let _lhsOoutput :: Nonterminal !_lhsOoutput = rule99 _extraInh _prodsIoutput arg_inh_ arg_nt_ arg_params_ arg_syn_ in let !__result_ = T_Nonterminal_vOut33 _lhsOaugmentsOut _lhsOerrors _lhsOoutput in __result_ ) in C_Nonterminal_s46 v33 {-# NOINLINE[1] rule93 #-} {-# LINE 7 "src-ag/DistChildAttr.ag" #-} rule93 = \ !inh_ !nt_ -> {-# LINE 7 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ inh_ {-# LINE 1500 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule94 #-} {-# LINE 8 "src-ag/DistChildAttr.ag" #-} rule94 = \ !nt_ !syn_ -> {-# LINE 8 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ syn_ {-# LINE 1506 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule95 #-} {-# LINE 157 "src-ag/Desugar.ag" #-} rule95 = \ !nt_ -> {-# LINE 157 "src-ag/Desugar.ag" #-} nt_ {-# LINE 1512 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule96 #-} {-# LINE 239 "src-ag/Desugar.ag" #-} rule96 = \ ((!_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !nt_ -> {-# LINE 239 "src-ag/Desugar.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn {-# LINE 1518 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule97 #-} {-# LINE 240 "src-ag/Desugar.ag" #-} rule97 = \ ((!_prodsIaugmentsOut) :: Map ConstructorIdent (Map Identifier [Expression])) !nt_ -> {-# LINE 240 "src-ag/Desugar.ag" #-} Map.singleton nt_ _prodsIaugmentsOut {-# LINE 1524 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule98 #-} {-# LINE 292 "src-ag/Desugar.ag" #-} rule98 = \ ((!_lhsImainName) :: String) ((!_lhsIoptions) :: Options) -> {-# LINE 292 "src-ag/Desugar.ag" #-} addLateAttr _lhsIoptions _lhsImainName {-# LINE 1530 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule99 #-} {-# LINE 308 "src-ag/Desugar.ag" #-} rule99 = \ !_extraInh ((!_prodsIoutput) :: Productions) !inh_ !nt_ !params_ !syn_ -> {-# LINE 308 "src-ag/Desugar.ag" #-} Nonterminal nt_ params_ (_extraInh `Map.union` inh_) syn_ _prodsIoutput {-# LINE 1540 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule100 #-} rule100 = \ ((!_prodsIallAttributes) :: AttrMap) -> _prodsIallAttributes {-# NOINLINE[1] rule101 #-} rule101 = \ !_augmentsOut -> _augmentsOut {-# NOINLINE[1] rule102 #-} rule102 = \ ((!_prodsIerrors) :: Seq Error) -> _prodsIerrors {-# NOINLINE[1] rule104 #-} rule104 = \ !_augmentsIn -> _augmentsIn {-# NOINLINE[1] rule105 #-} rule105 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# NOINLINE[1] rule106 #-} rule106 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule108 #-} rule108 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE[1] rule109 #-} rule109 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap -- Nonterminals ------------------------------------------------ -- wrapper data Inh_Nonterminals = Inh_Nonterminals { augmentsIn_Inh_Nonterminals :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), forcedIrrefutables_Inh_Nonterminals :: !(AttrMap), inhMap_Inh_Nonterminals :: !(Map Identifier Attributes), mainName_Inh_Nonterminals :: !(String), options_Inh_Nonterminals :: !(Options), synMap_Inh_Nonterminals :: !(Map Identifier Attributes) } data Syn_Nonterminals = Syn_Nonterminals { allAttributes_Syn_Nonterminals :: !(AttrMap), augmentsOut_Syn_Nonterminals :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), errors_Syn_Nonterminals :: !(Seq Error), inhMap'_Syn_Nonterminals :: !(Map Identifier Attributes), output_Syn_Nonterminals :: !(Nonterminals), synMap'_Syn_Nonterminals :: !(Map Identifier Attributes) } {-# INLINABLE wrap_Nonterminals #-} wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals ) wrap_Nonterminals !(T_Nonterminals act) !(Inh_Nonterminals _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg8 = T_Nonterminals_vIn8 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap !(T_Nonterminals_vOut8 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap') <- return (inv_Nonterminals_s16 sem K_Nonterminals_v8 arg8) return (Syn_Nonterminals _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap') ) -- cata {-# NOINLINE sem_Nonterminals #-} sem_Nonterminals :: Nonterminals -> T_Nonterminals sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) -- semantic domain newtype T_Nonterminals = T_Nonterminals { attach_T_Nonterminals :: Identity (T_Nonterminals_s16 ) } data T_Nonterminals_s16 where C_Nonterminals_s16 :: { inv_Nonterminals_s16 :: !(forall t. K_Nonterminals_s16 t -> t) } -> T_Nonterminals_s16 data T_Nonterminals_s17 = C_Nonterminals_s17 newtype T_Nonterminals_s36 = C_Nonterminals_s36 { inv_Nonterminals_s36 :: (T_Nonterminals_v20 ) } data K_Nonterminals_s16 k where K_Nonterminals_v8 :: K_Nonterminals_s16 (T_Nonterminals_v8 ) K_Nonterminals_v19 :: K_Nonterminals_s16 (T_Nonterminals_v19 ) type T_Nonterminals_v8 = (T_Nonterminals_vIn8 ) -> (T_Nonterminals_vOut8 ) data T_Nonterminals_vIn8 = T_Nonterminals_vIn8 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(AttrMap) !(Map Identifier Attributes) !(String) !(Options) !(Map Identifier Attributes) data T_Nonterminals_vOut8 = T_Nonterminals_vOut8 !(AttrMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Seq Error) !(Map Identifier Attributes) !(Nonterminals) !(Map Identifier Attributes) type T_Nonterminals_v19 = (T_Nonterminals_vIn19 ) -> (T_Nonterminals_vOut19 ) data T_Nonterminals_vIn19 = T_Nonterminals_vIn19 data T_Nonterminals_vOut19 = T_Nonterminals_vOut19 !(AttrMap) !(Map Identifier Attributes) !(Map Identifier Attributes) !(T_Nonterminals_s36 ) type T_Nonterminals_v20 = (T_Nonterminals_vIn20 ) -> (T_Nonterminals_vOut20 ) data T_Nonterminals_vIn20 = T_Nonterminals_vIn20 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(AttrMap) !(Map Identifier Attributes) !(String) !(Options) !(Map Identifier Attributes) data T_Nonterminals_vOut20 = T_Nonterminals_vOut20 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Seq Error) !(Nonterminals) {-# NOINLINE sem_Nonterminals_Cons #-} sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st16) where {-# NOINLINE st16 #-} !st16 = let k16 :: K_Nonterminals_s16 t -> t k16 K_Nonterminals_v8 = v8 k16 K_Nonterminals_v19 = v19 v8 :: T_Nonterminals_v8 v8 = \ !(T_Nonterminals_vIn8 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( let !_hdX14 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) in let !_tlX16 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) in let !_hdOaugmentsIn = rule117 _lhsIaugmentsIn in let !_hdOinhMap = rule119 _lhsIinhMap in let !_hdOoptions = rule121 _lhsIoptions in let !_hdOsynMap = rule122 _lhsIsynMap in let !_tlOaugmentsIn = rule123 _lhsIaugmentsIn in let !_tlOinhMap = rule125 _lhsIinhMap in let !_tlOoptions = rule127 _lhsIoptions in let !_tlOsynMap = rule128 _lhsIsynMap in let !_hdOforcedIrrefutables = rule118 _lhsIforcedIrrefutables in let !_hdOmainName = rule120 _lhsImainName in let !_tlOforcedIrrefutables = rule124 _lhsIforcedIrrefutables in let !_tlOmainName = rule126 _lhsImainName in let !(T_Nonterminal_vOut7 _hdIallAttributes _hdIaugmentsOut _hdIerrors _hdIinhMap' _hdIoutput _hdIsynMap') = inv_Nonterminal_s14 _hdX14 K_Nonterminal_v7 (T_Nonterminal_vIn7 _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOmainName _hdOoptions _hdOsynMap) in let !(T_Nonterminals_vOut8 _tlIallAttributes _tlIaugmentsOut _tlIerrors _tlIinhMap' _tlIoutput _tlIsynMap') = inv_Nonterminals_s16 _tlX16 K_Nonterminals_v8 (T_Nonterminals_vIn8 _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOmainName _tlOoptions _tlOsynMap) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule110 _hdIallAttributes _tlIallAttributes in let _lhsOaugmentsOut :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) !_lhsOaugmentsOut = rule111 _hdIaugmentsOut _tlIaugmentsOut in let _lhsOerrors :: Seq Error !_lhsOerrors = rule112 _hdIerrors _tlIerrors in let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule113 _hdIinhMap' _tlIinhMap' in let !_output = rule115 _hdIoutput _tlIoutput in let _lhsOoutput :: Nonterminals !_lhsOoutput = rule116 _output in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule114 _hdIsynMap' _tlIsynMap' in let !__result_ = T_Nonterminals_vOut8 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' in __result_ ) v19 :: T_Nonterminals_v19 v19 = \ !(T_Nonterminals_vIn19 ) -> ( let !_hdX14 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) in let !_tlX16 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) in let !(T_Nonterminal_vOut32 _hdIallAttributes _hdIinhMap' _hdIsynMap' _hdX46) = inv_Nonterminal_s14 _hdX14 K_Nonterminal_v32 (T_Nonterminal_vIn32 ) in let !(T_Nonterminals_vOut19 _tlIallAttributes _tlIinhMap' _tlIsynMap' _tlX36) = inv_Nonterminals_s16 _tlX16 K_Nonterminals_v19 (T_Nonterminals_vIn19 ) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule110 _hdIallAttributes _tlIallAttributes in let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule113 _hdIinhMap' _tlIinhMap' in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule114 _hdIsynMap' _tlIsynMap' in let !__st_ = st36 _hdX46 _tlX36 !__result_ = T_Nonterminals_vOut19 _lhsOallAttributes _lhsOinhMap' _lhsOsynMap' __st_ in __result_ ) in C_Nonterminals_s16 k16 {-# NOINLINE st36 #-} st36 = \ !_hdX46 !_tlX36 -> let v20 :: T_Nonterminals_v20 v20 = \ !(T_Nonterminals_vIn20 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( let !_hdOaugmentsIn = rule117 _lhsIaugmentsIn in let !_hdOinhMap = rule119 _lhsIinhMap in let !_hdOoptions = rule121 _lhsIoptions in let !_hdOsynMap = rule122 _lhsIsynMap in let !_tlOaugmentsIn = rule123 _lhsIaugmentsIn in let !_tlOinhMap = rule125 _lhsIinhMap in let !_tlOoptions = rule127 _lhsIoptions in let !_tlOsynMap = rule128 _lhsIsynMap in let !_hdOforcedIrrefutables = rule118 _lhsIforcedIrrefutables in let !_hdOmainName = rule120 _lhsImainName in let !_tlOforcedIrrefutables = rule124 _lhsIforcedIrrefutables in let !_tlOmainName = rule126 _lhsImainName in let !(T_Nonterminal_vOut33 _hdIaugmentsOut _hdIerrors _hdIoutput) = inv_Nonterminal_s46 _hdX46 (T_Nonterminal_vIn33 _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOmainName _hdOoptions _hdOsynMap) in let !(T_Nonterminals_vOut20 _tlIaugmentsOut _tlIerrors _tlIoutput) = inv_Nonterminals_s36 _tlX36 (T_Nonterminals_vIn20 _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOmainName _tlOoptions _tlOsynMap) in let _lhsOaugmentsOut :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) !_lhsOaugmentsOut = rule111 _hdIaugmentsOut _tlIaugmentsOut in let _lhsOerrors :: Seq Error !_lhsOerrors = rule112 _hdIerrors _tlIerrors in let !_output = rule115 _hdIoutput _tlIoutput in let _lhsOoutput :: Nonterminals !_lhsOoutput = rule116 _output in let !__result_ = T_Nonterminals_vOut20 _lhsOaugmentsOut _lhsOerrors _lhsOoutput in __result_ ) in C_Nonterminals_s36 v20 {-# NOINLINE[1] rule110 #-} rule110 = \ ((!_hdIallAttributes) :: AttrMap) ((!_tlIallAttributes) :: AttrMap) -> _hdIallAttributes `mergeAttributes` _tlIallAttributes {-# NOINLINE[1] rule111 #-} rule111 = \ ((!_hdIaugmentsOut) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ((!_tlIaugmentsOut) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> _hdIaugmentsOut `Map.union` _tlIaugmentsOut {-# NOINLINE[1] rule112 #-} rule112 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# NOINLINE[1] rule113 #-} rule113 = \ ((!_hdIinhMap') :: Map Identifier Attributes) ((!_tlIinhMap') :: Map Identifier Attributes) -> _hdIinhMap' `Map.union` _tlIinhMap' {-# NOINLINE[1] rule114 #-} rule114 = \ ((!_hdIsynMap') :: Map Identifier Attributes) ((!_tlIsynMap') :: Map Identifier Attributes) -> _hdIsynMap' `Map.union` _tlIsynMap' {-# NOINLINE[1] rule115 #-} rule115 = \ ((!_hdIoutput) :: Nonterminal) ((!_tlIoutput) :: Nonterminals) -> (:) _hdIoutput _tlIoutput {-# NOINLINE[1] rule116 #-} rule116 = \ !_output -> _output {-# NOINLINE[1] rule117 #-} rule117 = \ ((!_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> _lhsIaugmentsIn {-# NOINLINE[1] rule118 #-} rule118 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# NOINLINE[1] rule119 #-} rule119 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule120 #-} rule120 = \ ((!_lhsImainName) :: String) -> _lhsImainName {-# NOINLINE[1] rule121 #-} rule121 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE[1] rule122 #-} rule122 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE[1] rule123 #-} rule123 = \ ((!_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> _lhsIaugmentsIn {-# NOINLINE[1] rule124 #-} rule124 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# NOINLINE[1] rule125 #-} rule125 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule126 #-} rule126 = \ ((!_lhsImainName) :: String) -> _lhsImainName {-# NOINLINE[1] rule127 #-} rule127 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE[1] rule128 #-} rule128 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE sem_Nonterminals_Nil #-} sem_Nonterminals_Nil :: T_Nonterminals sem_Nonterminals_Nil = T_Nonterminals (return st16) where {-# NOINLINE st16 #-} !st16 = let k16 :: K_Nonterminals_s16 t -> t k16 K_Nonterminals_v8 = v8 k16 K_Nonterminals_v19 = v19 v8 :: T_Nonterminals_v8 v8 = \ !(T_Nonterminals_vIn8 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule129 () in let _lhsOaugmentsOut :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) !_lhsOaugmentsOut = rule130 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule131 () in let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule132 () in let !_output = rule134 () in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule133 () in let _lhsOoutput :: Nonterminals !_lhsOoutput = rule135 _output in let !__result_ = T_Nonterminals_vOut8 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' in __result_ ) v19 :: T_Nonterminals_v19 v19 = \ !(T_Nonterminals_vIn19 ) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule129 () in let _lhsOinhMap' :: Map Identifier Attributes !_lhsOinhMap' = rule132 () in let _lhsOsynMap' :: Map Identifier Attributes !_lhsOsynMap' = rule133 () in let !__st_ = st36 () !__result_ = T_Nonterminals_vOut19 _lhsOallAttributes _lhsOinhMap' _lhsOsynMap' __st_ in __result_ ) in C_Nonterminals_s16 k16 {-# NOINLINE st36 #-} st36 = \ (_ :: ()) -> let v20 :: T_Nonterminals_v20 v20 = \ !(T_Nonterminals_vIn20 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( let _lhsOaugmentsOut :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) !_lhsOaugmentsOut = rule130 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule131 () in let !_output = rule134 () in let _lhsOoutput :: Nonterminals !_lhsOoutput = rule135 _output in let !__result_ = T_Nonterminals_vOut20 _lhsOaugmentsOut _lhsOerrors _lhsOoutput in __result_ ) in C_Nonterminals_s36 v20 {-# NOINLINE[1] rule129 #-} rule129 = \ (_ :: ()) -> Map.empty {-# NOINLINE[1] rule130 #-} rule130 = \ (_ :: ()) -> Map.empty {-# NOINLINE[1] rule131 #-} rule131 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule132 #-} rule132 = \ (_ :: ()) -> Map.empty {-# NOINLINE[1] rule133 #-} rule133 = \ (_ :: ()) -> Map.empty {-# NOINLINE[1] rule134 #-} rule134 = \ (_ :: ()) -> [] {-# NOINLINE[1] rule135 #-} rule135 = \ !_output -> _output -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { childInhs_Inh_Pattern :: !([(Identifier, Identifier)]), childSyns_Inh_Pattern :: !([(Identifier, Identifier)]), con_Inh_Pattern :: !(ConstructorIdent), defs_Inh_Pattern :: !(Set (Identifier, Identifier)), forcedIrrefutables_Inh_Pattern :: !(AttrMap), nt_Inh_Pattern :: !(NontermIdent) } data Syn_Pattern = Syn_Pattern { allAttributes_Syn_Pattern :: !(AttrMap), copy_Syn_Pattern :: !(Pattern), defsCollect_Syn_Pattern :: !(Set (Identifier, Identifier)), errors_Syn_Pattern :: !(Seq Error), output_Syn_Pattern :: !(Pattern) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern !(T_Pattern act) !(Inh_Pattern _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg9 = T_Pattern_vIn9 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt !(T_Pattern_vOut9 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput) <- return (inv_Pattern_s18 sem K_Pattern_v9 arg9) return (Syn_Pattern _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr !name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product !pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias !field_ !attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore !pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s18 ) } data T_Pattern_s18 where C_Pattern_s18 :: { inv_Pattern_s18 :: !(forall t. K_Pattern_s18 t -> t) } -> T_Pattern_s18 data T_Pattern_s19 = C_Pattern_s19 data T_Pattern_s42 = C_Pattern_s42 data T_Pattern_s45 = C_Pattern_s45 newtype T_Pattern_s51 = C_Pattern_s51 { inv_Pattern_s51 :: (T_Pattern_v42 ) } newtype T_Pattern_s54 = C_Pattern_s54 { inv_Pattern_s54 :: (T_Pattern_v48 ) } newtype T_Pattern_s58 = C_Pattern_s58 { inv_Pattern_s58 :: (T_Pattern_v56 ) } data K_Pattern_s18 k where K_Pattern_v9 :: K_Pattern_s18 (T_Pattern_v9 ) K_Pattern_v27 :: K_Pattern_s18 (T_Pattern_v27 ) K_Pattern_v31 :: K_Pattern_s18 (T_Pattern_v31 ) K_Pattern_v41 :: K_Pattern_s18 (T_Pattern_v41 ) K_Pattern_v46 :: K_Pattern_s18 (T_Pattern_v46 ) K_Pattern_v55 :: K_Pattern_s18 (T_Pattern_v55 ) type T_Pattern_v9 = (T_Pattern_vIn9 ) -> (T_Pattern_vOut9 ) data T_Pattern_vIn9 = T_Pattern_vIn9 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) data T_Pattern_vOut9 = T_Pattern_vOut9 !(AttrMap) !(Pattern) !(Set (Identifier, Identifier)) !(Seq Error) !(Pattern) type T_Pattern_v27 = (T_Pattern_vIn27 ) -> (T_Pattern_vOut27 ) data T_Pattern_vIn27 = T_Pattern_vIn27 !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) data T_Pattern_vOut27 = T_Pattern_vOut27 !(AttrMap) !(Pattern) !(Set (Identifier, Identifier)) !(Seq Error) !(Pattern) type T_Pattern_v31 = (T_Pattern_vIn31 ) -> (T_Pattern_vOut31 ) data T_Pattern_vIn31 = T_Pattern_vIn31 !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) data T_Pattern_vOut31 = T_Pattern_vOut31 !(AttrMap) !(Set (Identifier, Identifier)) !(Seq Error) !(Pattern) type T_Pattern_v41 = (T_Pattern_vIn41 ) -> (T_Pattern_vOut41 ) data T_Pattern_vIn41 = T_Pattern_vIn41 !(ConstructorIdent) !(NontermIdent) data T_Pattern_vOut41 = T_Pattern_vOut41 !(AttrMap) !(Set (Identifier, Identifier)) !(T_Pattern_s51 ) type T_Pattern_v42 = (T_Pattern_vIn42 ) -> (T_Pattern_vOut42 ) data T_Pattern_vIn42 = T_Pattern_vIn42 !([(Identifier, Identifier)]) !(Set (Identifier, Identifier)) !(AttrMap) data T_Pattern_vOut42 = T_Pattern_vOut42 !(Seq Error) !(Pattern) type T_Pattern_v46 = (T_Pattern_vIn46 ) -> (T_Pattern_vOut46 ) data T_Pattern_vIn46 = T_Pattern_vIn46 data T_Pattern_vOut46 = T_Pattern_vOut46 !(Set (Identifier, Identifier)) !(T_Pattern_s54 ) type T_Pattern_v48 = (T_Pattern_vIn48 ) -> (T_Pattern_vOut48 ) data T_Pattern_vIn48 = T_Pattern_vIn48 !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) data T_Pattern_vOut48 = T_Pattern_vOut48 !(AttrMap) !(Seq Error) !(Pattern) type T_Pattern_v55 = (T_Pattern_vIn55 ) -> (T_Pattern_vOut55 ) data T_Pattern_vIn55 = T_Pattern_vIn55 !(ConstructorIdent) !(NontermIdent) data T_Pattern_vOut55 = T_Pattern_vOut55 !(AttrMap) !(T_Pattern_s58 ) type T_Pattern_v56 = (T_Pattern_vIn56 ) -> (T_Pattern_vOut56 ) data T_Pattern_vIn56 = T_Pattern_vIn56 data T_Pattern_vOut56 = T_Pattern_vOut56 !(Set (Identifier, Identifier)) !(T_Pattern_s51 ) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr !arg_name_ arg_pats_ = T_Pattern (return st18) where {-# NOINLINE st18 #-} !st18 = let k18 :: K_Pattern_s18 t -> t k18 K_Pattern_v9 = v9 k18 K_Pattern_v27 = v27 k18 K_Pattern_v31 = v31 k18 K_Pattern_v41 = v41 k18 K_Pattern_v46 = v46 k18 K_Pattern_v55 = v55 v9 :: T_Pattern_v9 v9 = \ !(T_Pattern_vIn9 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !_patsOcon = rule145 _lhsIcon in let !_patsOnt = rule148 _lhsInt in let !_patsOchildInhs = rule143 _lhsIchildInhs in let !_patsOdefs = rule146 _lhsIdefs in let !_patsOforcedIrrefutables = rule147 _lhsIforcedIrrefutables in let !(T_Patterns_vOut26 _patsIallAttributes _patsIcopy _patsIdefsCollect _patsIerrors _patsIoutput) = inv_Patterns_s20 _patsX20 K_Patterns_v26 (T_Patterns_vIn26 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule136 _patsIallAttributes in let !_copy = rule139 _patsIcopy arg_name_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule141 _copy in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule137 _patsIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule138 _patsIerrors in let !_output = rule140 _patsIoutput arg_name_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule142 _output in let !__result_ = T_Pattern_vOut9 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v27 :: T_Pattern_v27 v27 = \ !(T_Pattern_vIn27 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !_patsOcon = rule145 _lhsIcon in let !_patsOnt = rule148 _lhsInt in let !_patsOchildInhs = rule143 _lhsIchildInhs in let !_patsOdefs = rule146 _lhsIdefs in let !_patsOforcedIrrefutables = rule147 _lhsIforcedIrrefutables in let !(T_Patterns_vOut26 _patsIallAttributes _patsIcopy _patsIdefsCollect _patsIerrors _patsIoutput) = inv_Patterns_s20 _patsX20 K_Patterns_v26 (T_Patterns_vIn26 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule136 _patsIallAttributes in let !_copy = rule139 _patsIcopy arg_name_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule141 _copy in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule137 _patsIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule138 _patsIerrors in let !_output = rule140 _patsIoutput arg_name_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule142 _output in let !__result_ = T_Pattern_vOut27 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v31 :: T_Pattern_v31 v31 = \ !(T_Pattern_vIn31 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !_patsOcon = rule145 _lhsIcon in let !_patsOnt = rule148 _lhsInt in let !_patsOchildInhs = rule143 _lhsIchildInhs in let !_patsOdefs = rule146 _lhsIdefs in let !_patsOforcedIrrefutables = rule147 _lhsIforcedIrrefutables in let !(T_Patterns_vOut38 _patsIallAttributes _patsIdefsCollect _patsIerrors _patsIoutput) = inv_Patterns_s20 _patsX20 K_Patterns_v38 (T_Patterns_vIn38 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule136 _patsIallAttributes in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule137 _patsIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule138 _patsIerrors in let !_output = rule140 _patsIoutput arg_name_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule142 _output in let !__result_ = T_Pattern_vOut31 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v41 :: T_Pattern_v41 v41 = \ !(T_Pattern_vIn41 _lhsIcon _lhsInt) -> ( let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !_patsOcon = rule145 _lhsIcon in let !_patsOnt = rule148 _lhsInt in let !(T_Patterns_vOut45 _patsIallAttributes _patsIdefsCollect _patsX53) = inv_Patterns_s20 _patsX20 K_Patterns_v45 (T_Patterns_vIn45 _patsOcon _patsOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule136 _patsIallAttributes in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule137 _patsIdefsCollect in let !__st_ = st51 _patsX53 !__result_ = T_Pattern_vOut41 _lhsOallAttributes _lhsOdefsCollect __st_ in __result_ ) v46 :: T_Pattern_v46 v46 = \ !(T_Pattern_vIn46 ) -> ( let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !(T_Patterns_vOut51 _patsIdefsCollect _patsX56) = inv_Patterns_s20 _patsX20 K_Patterns_v51 (T_Patterns_vIn51 ) in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule137 _patsIdefsCollect in let !__st_ = st54 _patsX56 !__result_ = T_Pattern_vOut46 _lhsOdefsCollect __st_ in __result_ ) v55 :: T_Pattern_v55 v55 = \ !(T_Pattern_vIn55 _lhsIcon _lhsInt) -> ( let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !_patsOcon = rule145 _lhsIcon in let !_patsOnt = rule148 _lhsInt in let !(T_Patterns_vOut57 _patsIallAttributes _patsX59) = inv_Patterns_s20 _patsX20 K_Patterns_v57 (T_Patterns_vIn57 _patsOcon _patsOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule136 _patsIallAttributes in let !__st_ = st58 _patsX59 !__result_ = T_Pattern_vOut55 _lhsOallAttributes __st_ in __result_ ) in C_Pattern_s18 k18 {-# NOINLINE st51 #-} st51 = \ !_patsX53 -> let v42 :: T_Pattern_v42 v42 = \ !(T_Pattern_vIn42 _lhsIchildInhs _lhsIdefs _lhsIforcedIrrefutables) -> ( let !_patsOchildInhs = rule143 _lhsIchildInhs in let !_patsOdefs = rule146 _lhsIdefs in let !_patsOforcedIrrefutables = rule147 _lhsIforcedIrrefutables in let !(T_Patterns_vOut47 _patsIerrors _patsIoutput) = inv_Patterns_s53 _patsX53 (T_Patterns_vIn47 _patsOchildInhs _patsOdefs _patsOforcedIrrefutables) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule138 _patsIerrors in let !_output = rule140 _patsIoutput arg_name_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule142 _output in let !__result_ = T_Pattern_vOut42 _lhsOerrors _lhsOoutput in __result_ ) in C_Pattern_s51 v42 {-# NOINLINE st54 #-} st54 = \ !_patsX56 -> let v48 :: T_Pattern_v48 v48 = \ !(T_Pattern_vIn48 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_patsOcon = rule145 _lhsIcon in let !_patsOnt = rule148 _lhsInt in let !_patsOchildInhs = rule143 _lhsIchildInhs in let !_patsOdefs = rule146 _lhsIdefs in let !_patsOforcedIrrefutables = rule147 _lhsIforcedIrrefutables in let !(T_Patterns_vOut52 _patsIallAttributes _patsIerrors _patsIoutput) = inv_Patterns_s56 _patsX56 (T_Patterns_vIn52 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule136 _patsIallAttributes in let _lhsOerrors :: Seq Error !_lhsOerrors = rule138 _patsIerrors in let !_output = rule140 _patsIoutput arg_name_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule142 _output in let !__result_ = T_Pattern_vOut48 _lhsOallAttributes _lhsOerrors _lhsOoutput in __result_ ) in C_Pattern_s54 v48 {-# NOINLINE st58 #-} st58 = \ !_patsX59 -> let v56 :: T_Pattern_v56 v56 = \ !(T_Pattern_vIn56 ) -> ( let !(T_Patterns_vOut58 _patsIdefsCollect _patsX53) = inv_Patterns_s59 _patsX59 (T_Patterns_vIn58 ) in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule137 _patsIdefsCollect in let !__st_ = st51 _patsX53 !__result_ = T_Pattern_vOut56 _lhsOdefsCollect __st_ in __result_ ) in C_Pattern_s58 v56 {-# NOINLINE[1] rule136 #-} rule136 = \ ((!_patsIallAttributes) :: AttrMap) -> _patsIallAttributes {-# NOINLINE[1] rule137 #-} rule137 = \ ((!_patsIdefsCollect) :: Set (Identifier, Identifier)) -> _patsIdefsCollect {-# NOINLINE[1] rule138 #-} rule138 = \ ((!_patsIerrors) :: Seq Error) -> _patsIerrors {-# NOINLINE[1] rule139 #-} rule139 = \ ((!_patsIcopy) :: Patterns) !name_ -> Constr name_ _patsIcopy {-# NOINLINE[1] rule140 #-} rule140 = \ ((!_patsIoutput) :: Patterns) !name_ -> Constr name_ _patsIoutput {-# NOINLINE[1] rule141 #-} rule141 = \ !_copy -> _copy {-# NOINLINE[1] rule142 #-} rule142 = \ !_output -> _output {-# NOINLINE[1] rule143 #-} rule143 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> _lhsIchildInhs {-# NOINLINE[1] rule145 #-} rule145 = \ ((!_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# NOINLINE[1] rule146 #-} rule146 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> _lhsIdefs {-# NOINLINE[1] rule147 #-} rule147 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# NOINLINE[1] rule148 #-} rule148 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product !arg_pos_ arg_pats_ = T_Pattern (return st18) where {-# NOINLINE st18 #-} !st18 = let k18 :: K_Pattern_s18 t -> t k18 K_Pattern_v9 = v9 k18 K_Pattern_v27 = v27 k18 K_Pattern_v31 = v31 k18 K_Pattern_v41 = v41 k18 K_Pattern_v46 = v46 k18 K_Pattern_v55 = v55 v9 :: T_Pattern_v9 v9 = \ !(T_Pattern_vIn9 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !_patsOcon = rule158 _lhsIcon in let !_patsOnt = rule161 _lhsInt in let !_patsOchildInhs = rule156 _lhsIchildInhs in let !_patsOdefs = rule159 _lhsIdefs in let !_patsOforcedIrrefutables = rule160 _lhsIforcedIrrefutables in let !(T_Patterns_vOut26 _patsIallAttributes _patsIcopy _patsIdefsCollect _patsIerrors _patsIoutput) = inv_Patterns_s20 _patsX20 K_Patterns_v26 (T_Patterns_vIn26 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule149 _patsIallAttributes in let !_copy = rule152 _patsIcopy arg_pos_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule154 _copy in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule150 _patsIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule151 _patsIerrors in let !_output = rule153 _patsIoutput arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule155 _output in let !__result_ = T_Pattern_vOut9 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v27 :: T_Pattern_v27 v27 = \ !(T_Pattern_vIn27 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !_patsOcon = rule158 _lhsIcon in let !_patsOnt = rule161 _lhsInt in let !_patsOchildInhs = rule156 _lhsIchildInhs in let !_patsOdefs = rule159 _lhsIdefs in let !_patsOforcedIrrefutables = rule160 _lhsIforcedIrrefutables in let !(T_Patterns_vOut26 _patsIallAttributes _patsIcopy _patsIdefsCollect _patsIerrors _patsIoutput) = inv_Patterns_s20 _patsX20 K_Patterns_v26 (T_Patterns_vIn26 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule149 _patsIallAttributes in let !_copy = rule152 _patsIcopy arg_pos_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule154 _copy in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule150 _patsIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule151 _patsIerrors in let !_output = rule153 _patsIoutput arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule155 _output in let !__result_ = T_Pattern_vOut27 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v31 :: T_Pattern_v31 v31 = \ !(T_Pattern_vIn31 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !_patsOcon = rule158 _lhsIcon in let !_patsOnt = rule161 _lhsInt in let !_patsOchildInhs = rule156 _lhsIchildInhs in let !_patsOdefs = rule159 _lhsIdefs in let !_patsOforcedIrrefutables = rule160 _lhsIforcedIrrefutables in let !(T_Patterns_vOut38 _patsIallAttributes _patsIdefsCollect _patsIerrors _patsIoutput) = inv_Patterns_s20 _patsX20 K_Patterns_v38 (T_Patterns_vIn38 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule149 _patsIallAttributes in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule150 _patsIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule151 _patsIerrors in let !_output = rule153 _patsIoutput arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule155 _output in let !__result_ = T_Pattern_vOut31 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v41 :: T_Pattern_v41 v41 = \ !(T_Pattern_vIn41 _lhsIcon _lhsInt) -> ( let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !_patsOcon = rule158 _lhsIcon in let !_patsOnt = rule161 _lhsInt in let !(T_Patterns_vOut45 _patsIallAttributes _patsIdefsCollect _patsX53) = inv_Patterns_s20 _patsX20 K_Patterns_v45 (T_Patterns_vIn45 _patsOcon _patsOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule149 _patsIallAttributes in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule150 _patsIdefsCollect in let !__st_ = st51 _patsX53 !__result_ = T_Pattern_vOut41 _lhsOallAttributes _lhsOdefsCollect __st_ in __result_ ) v46 :: T_Pattern_v46 v46 = \ !(T_Pattern_vIn46 ) -> ( let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !(T_Patterns_vOut51 _patsIdefsCollect _patsX56) = inv_Patterns_s20 _patsX20 K_Patterns_v51 (T_Patterns_vIn51 ) in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule150 _patsIdefsCollect in let !__st_ = st54 _patsX56 !__result_ = T_Pattern_vOut46 _lhsOdefsCollect __st_ in __result_ ) v55 :: T_Pattern_v55 v55 = \ !(T_Pattern_vIn55 _lhsIcon _lhsInt) -> ( let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in let !_patsOcon = rule158 _lhsIcon in let !_patsOnt = rule161 _lhsInt in let !(T_Patterns_vOut57 _patsIallAttributes _patsX59) = inv_Patterns_s20 _patsX20 K_Patterns_v57 (T_Patterns_vIn57 _patsOcon _patsOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule149 _patsIallAttributes in let !__st_ = st58 _patsX59 !__result_ = T_Pattern_vOut55 _lhsOallAttributes __st_ in __result_ ) in C_Pattern_s18 k18 {-# NOINLINE st51 #-} st51 = \ !_patsX53 -> let v42 :: T_Pattern_v42 v42 = \ !(T_Pattern_vIn42 _lhsIchildInhs _lhsIdefs _lhsIforcedIrrefutables) -> ( let !_patsOchildInhs = rule156 _lhsIchildInhs in let !_patsOdefs = rule159 _lhsIdefs in let !_patsOforcedIrrefutables = rule160 _lhsIforcedIrrefutables in let !(T_Patterns_vOut47 _patsIerrors _patsIoutput) = inv_Patterns_s53 _patsX53 (T_Patterns_vIn47 _patsOchildInhs _patsOdefs _patsOforcedIrrefutables) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule151 _patsIerrors in let !_output = rule153 _patsIoutput arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule155 _output in let !__result_ = T_Pattern_vOut42 _lhsOerrors _lhsOoutput in __result_ ) in C_Pattern_s51 v42 {-# NOINLINE st54 #-} st54 = \ !_patsX56 -> let v48 :: T_Pattern_v48 v48 = \ !(T_Pattern_vIn48 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_patsOcon = rule158 _lhsIcon in let !_patsOnt = rule161 _lhsInt in let !_patsOchildInhs = rule156 _lhsIchildInhs in let !_patsOdefs = rule159 _lhsIdefs in let !_patsOforcedIrrefutables = rule160 _lhsIforcedIrrefutables in let !(T_Patterns_vOut52 _patsIallAttributes _patsIerrors _patsIoutput) = inv_Patterns_s56 _patsX56 (T_Patterns_vIn52 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule149 _patsIallAttributes in let _lhsOerrors :: Seq Error !_lhsOerrors = rule151 _patsIerrors in let !_output = rule153 _patsIoutput arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule155 _output in let !__result_ = T_Pattern_vOut48 _lhsOallAttributes _lhsOerrors _lhsOoutput in __result_ ) in C_Pattern_s54 v48 {-# NOINLINE st58 #-} st58 = \ !_patsX59 -> let v56 :: T_Pattern_v56 v56 = \ !(T_Pattern_vIn56 ) -> ( let !(T_Patterns_vOut58 _patsIdefsCollect _patsX53) = inv_Patterns_s59 _patsX59 (T_Patterns_vIn58 ) in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule150 _patsIdefsCollect in let !__st_ = st51 _patsX53 !__result_ = T_Pattern_vOut56 _lhsOdefsCollect __st_ in __result_ ) in C_Pattern_s58 v56 {-# NOINLINE[1] rule149 #-} rule149 = \ ((!_patsIallAttributes) :: AttrMap) -> _patsIallAttributes {-# NOINLINE[1] rule150 #-} rule150 = \ ((!_patsIdefsCollect) :: Set (Identifier, Identifier)) -> _patsIdefsCollect {-# NOINLINE[1] rule151 #-} rule151 = \ ((!_patsIerrors) :: Seq Error) -> _patsIerrors {-# NOINLINE[1] rule152 #-} rule152 = \ ((!_patsIcopy) :: Patterns) !pos_ -> Product pos_ _patsIcopy {-# NOINLINE[1] rule153 #-} rule153 = \ ((!_patsIoutput) :: Patterns) !pos_ -> Product pos_ _patsIoutput {-# NOINLINE[1] rule154 #-} rule154 = \ !_copy -> _copy {-# NOINLINE[1] rule155 #-} rule155 = \ !_output -> _output {-# NOINLINE[1] rule156 #-} rule156 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> _lhsIchildInhs {-# NOINLINE[1] rule158 #-} rule158 = \ ((!_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# NOINLINE[1] rule159 #-} rule159 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> _lhsIdefs {-# NOINLINE[1] rule160 #-} rule160 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# NOINLINE[1] rule161 #-} rule161 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias !arg_field_ !arg_attr_ arg_pat_ = T_Pattern (return st18) where {-# NOINLINE st18 #-} !st18 = let k18 :: K_Pattern_s18 t -> t k18 K_Pattern_v9 = v9 k18 K_Pattern_v27 = v27 k18 K_Pattern_v31 = v31 k18 K_Pattern_v41 = v41 k18 K_Pattern_v46 = v46 k18 K_Pattern_v55 = v55 v9 :: T_Pattern_v9 v9 = \ !(T_Pattern_vIn9 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !_patOcon = rule174 _lhsIcon in let !_patOnt = rule177 _lhsInt in let !_def = rule166 arg_attr_ arg_field_ in let !_patOchildInhs = rule172 _lhsIchildInhs in let !_patOdefs = rule175 _lhsIdefs in let !(!_field',!_err1) = rule162 _lhsIchildInhs _lhsIcon _lhsInt arg_attr_ arg_field_ in let !_err2 = rule163 _field' _lhsIcon _lhsIdefs _lhsInt arg_attr_ arg_field_ in let !_patOforcedIrrefutables = rule176 _lhsIforcedIrrefutables in let !(T_Pattern_vOut27 _patIallAttributes _patIcopy _patIdefsCollect _patIerrors _patIoutput) = inv_Pattern_s18 _patX18 K_Pattern_v27 (T_Pattern_vIn27 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule168 _lhsIcon _lhsInt _patIallAttributes arg_attr_ arg_field_ in let !_copy = rule170 _patIcopy arg_attr_ arg_field_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule171 _copy in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule167 _def _patIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule164 _err1 _err2 _patIerrors in let !_output = rule165 _field' _patIoutput arg_attr_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule169 _lhsIcon _lhsIforcedIrrefutables _lhsInt _output arg_attr_ arg_field_ in let !__result_ = T_Pattern_vOut9 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v27 :: T_Pattern_v27 v27 = \ !(T_Pattern_vIn27 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !_patOcon = rule174 _lhsIcon in let !_patOnt = rule177 _lhsInt in let !_def = rule166 arg_attr_ arg_field_ in let !_patOchildInhs = rule172 _lhsIchildInhs in let !_patOdefs = rule175 _lhsIdefs in let !(!_field',!_err1) = rule162 _lhsIchildInhs _lhsIcon _lhsInt arg_attr_ arg_field_ in let !_err2 = rule163 _field' _lhsIcon _lhsIdefs _lhsInt arg_attr_ arg_field_ in let !_patOforcedIrrefutables = rule176 _lhsIforcedIrrefutables in let !(T_Pattern_vOut27 _patIallAttributes _patIcopy _patIdefsCollect _patIerrors _patIoutput) = inv_Pattern_s18 _patX18 K_Pattern_v27 (T_Pattern_vIn27 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule168 _lhsIcon _lhsInt _patIallAttributes arg_attr_ arg_field_ in let !_copy = rule170 _patIcopy arg_attr_ arg_field_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule171 _copy in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule167 _def _patIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule164 _err1 _err2 _patIerrors in let !_output = rule165 _field' _patIoutput arg_attr_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule169 _lhsIcon _lhsIforcedIrrefutables _lhsInt _output arg_attr_ arg_field_ in let !__result_ = T_Pattern_vOut27 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v31 :: T_Pattern_v31 v31 = \ !(T_Pattern_vIn31 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !_patOcon = rule174 _lhsIcon in let !_patOnt = rule177 _lhsInt in let !_def = rule166 arg_attr_ arg_field_ in let !_patOchildInhs = rule172 _lhsIchildInhs in let !_patOdefs = rule175 _lhsIdefs in let !(!_field',!_err1) = rule162 _lhsIchildInhs _lhsIcon _lhsInt arg_attr_ arg_field_ in let !_err2 = rule163 _field' _lhsIcon _lhsIdefs _lhsInt arg_attr_ arg_field_ in let !_patOforcedIrrefutables = rule176 _lhsIforcedIrrefutables in let !(T_Pattern_vOut31 _patIallAttributes _patIdefsCollect _patIerrors _patIoutput) = inv_Pattern_s18 _patX18 K_Pattern_v31 (T_Pattern_vIn31 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule168 _lhsIcon _lhsInt _patIallAttributes arg_attr_ arg_field_ in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule167 _def _patIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule164 _err1 _err2 _patIerrors in let !_output = rule165 _field' _patIoutput arg_attr_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule169 _lhsIcon _lhsIforcedIrrefutables _lhsInt _output arg_attr_ arg_field_ in let !__result_ = T_Pattern_vOut31 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v41 :: T_Pattern_v41 v41 = \ !(T_Pattern_vIn41 _lhsIcon _lhsInt) -> ( let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !_patOcon = rule174 _lhsIcon in let !_patOnt = rule177 _lhsInt in let !_def = rule166 arg_attr_ arg_field_ in let !(T_Pattern_vOut41 _patIallAttributes _patIdefsCollect _patX51) = inv_Pattern_s18 _patX18 K_Pattern_v41 (T_Pattern_vIn41 _patOcon _patOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule168 _lhsIcon _lhsInt _patIallAttributes arg_attr_ arg_field_ in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule167 _def _patIdefsCollect in let !__st_ = st51 _lhsIcon _lhsInt _patX51 !__result_ = T_Pattern_vOut41 _lhsOallAttributes _lhsOdefsCollect __st_ in __result_ ) v46 :: T_Pattern_v46 v46 = \ !(T_Pattern_vIn46 ) -> ( let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !_def = rule166 arg_attr_ arg_field_ in let !(T_Pattern_vOut46 _patIdefsCollect _patX54) = inv_Pattern_s18 _patX18 K_Pattern_v46 (T_Pattern_vIn46 ) in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule167 _def _patIdefsCollect in let !__st_ = st54 _patX54 !__result_ = T_Pattern_vOut46 _lhsOdefsCollect __st_ in __result_ ) v55 :: T_Pattern_v55 v55 = \ !(T_Pattern_vIn55 _lhsIcon _lhsInt) -> ( let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !_patOcon = rule174 _lhsIcon in let !_patOnt = rule177 _lhsInt in let !(T_Pattern_vOut55 _patIallAttributes _patX58) = inv_Pattern_s18 _patX18 K_Pattern_v55 (T_Pattern_vIn55 _patOcon _patOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule168 _lhsIcon _lhsInt _patIallAttributes arg_attr_ arg_field_ in let !__st_ = st58 _lhsIcon _lhsInt _patX58 !__result_ = T_Pattern_vOut55 _lhsOallAttributes __st_ in __result_ ) in C_Pattern_s18 k18 {-# NOINLINE st51 #-} st51 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) !_patX51 -> let v42 :: T_Pattern_v42 v42 = \ !(T_Pattern_vIn42 _lhsIchildInhs _lhsIdefs _lhsIforcedIrrefutables) -> ( let !_patOchildInhs = rule172 _lhsIchildInhs in let !_patOdefs = rule175 _lhsIdefs in let !(!_field',!_err1) = rule162 _lhsIchildInhs _lhsIcon _lhsInt arg_attr_ arg_field_ in let !_err2 = rule163 _field' _lhsIcon _lhsIdefs _lhsInt arg_attr_ arg_field_ in let !_patOforcedIrrefutables = rule176 _lhsIforcedIrrefutables in let !(T_Pattern_vOut42 _patIerrors _patIoutput) = inv_Pattern_s51 _patX51 (T_Pattern_vIn42 _patOchildInhs _patOdefs _patOforcedIrrefutables) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule164 _err1 _err2 _patIerrors in let !_output = rule165 _field' _patIoutput arg_attr_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule169 _lhsIcon _lhsIforcedIrrefutables _lhsInt _output arg_attr_ arg_field_ in let !__result_ = T_Pattern_vOut42 _lhsOerrors _lhsOoutput in __result_ ) in C_Pattern_s51 v42 {-# NOINLINE st54 #-} st54 = \ !_patX54 -> let v48 :: T_Pattern_v48 v48 = \ !(T_Pattern_vIn48 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_patOcon = rule174 _lhsIcon in let !_patOnt = rule177 _lhsInt in let !_patOchildInhs = rule172 _lhsIchildInhs in let !_patOdefs = rule175 _lhsIdefs in let !(!_field',!_err1) = rule162 _lhsIchildInhs _lhsIcon _lhsInt arg_attr_ arg_field_ in let !_err2 = rule163 _field' _lhsIcon _lhsIdefs _lhsInt arg_attr_ arg_field_ in let !_patOforcedIrrefutables = rule176 _lhsIforcedIrrefutables in let !(T_Pattern_vOut48 _patIallAttributes _patIerrors _patIoutput) = inv_Pattern_s54 _patX54 (T_Pattern_vIn48 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule168 _lhsIcon _lhsInt _patIallAttributes arg_attr_ arg_field_ in let _lhsOerrors :: Seq Error !_lhsOerrors = rule164 _err1 _err2 _patIerrors in let !_output = rule165 _field' _patIoutput arg_attr_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule169 _lhsIcon _lhsIforcedIrrefutables _lhsInt _output arg_attr_ arg_field_ in let !__result_ = T_Pattern_vOut48 _lhsOallAttributes _lhsOerrors _lhsOoutput in __result_ ) in C_Pattern_s54 v48 {-# NOINLINE st58 #-} st58 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) !_patX58 -> let v56 :: T_Pattern_v56 v56 = \ !(T_Pattern_vIn56 ) -> ( let !_def = rule166 arg_attr_ arg_field_ in let !(T_Pattern_vOut56 _patIdefsCollect _patX51) = inv_Pattern_s58 _patX58 (T_Pattern_vIn56 ) in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule167 _def _patIdefsCollect in let !__st_ = st51 _lhsIcon _lhsInt _patX51 !__result_ = T_Pattern_vOut56 _lhsOdefsCollect __st_ in __result_ ) in C_Pattern_s58 v56 {-# NOINLINE rule162 #-} {-# LINE 110 "src-ag/Desugar.ag" #-} rule162 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) !attr_ !field_ -> {-# LINE 110 "src-ag/Desugar.ag" #-} maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "" (getPos field_)) attr_ True) $ findField field_ attr_ _lhsIchildInhs {-# LINE 2470 "dist/build/Desugar.hs"#-} {-# NOINLINE rule163 #-} {-# LINE 112 "src-ag/Desugar.ag" #-} rule163 = \ !_field' ((!_lhsIcon) :: ConstructorIdent) ((!_lhsIdefs) :: Set (Identifier, Identifier)) ((!_lhsInt) :: NontermIdent) !attr_ !field_ -> {-# LINE 112 "src-ag/Desugar.ag" #-} if _field' == field_ then Seq.empty else if (_field' , attr_) `Set.member` _lhsIdefs then Seq.singleton $ DupRule _lhsInt _lhsIcon field_ attr_ _field' else Seq.empty {-# LINE 2480 "dist/build/Desugar.hs"#-} {-# NOINLINE rule164 #-} {-# LINE 117 "src-ag/Desugar.ag" #-} rule164 = \ !_err1 !_err2 ((!_patIerrors) :: Seq Error) -> {-# LINE 117 "src-ag/Desugar.ag" #-} _err1 Seq.>< _err2 Seq.>< _patIerrors {-# LINE 2486 "dist/build/Desugar.hs"#-} {-# NOINLINE rule165 #-} {-# LINE 118 "src-ag/Desugar.ag" #-} rule165 = \ !_field' ((!_patIoutput) :: Pattern) !attr_ -> {-# LINE 118 "src-ag/Desugar.ag" #-} Alias _field' attr_ _patIoutput {-# LINE 2492 "dist/build/Desugar.hs"#-} {-# NOINLINE rule166 #-} {-# LINE 182 "src-ag/Desugar.ag" #-} rule166 = \ !attr_ !field_ -> {-# LINE 182 "src-ag/Desugar.ag" #-} Set.singleton (field_, attr_) {-# LINE 2498 "dist/build/Desugar.hs"#-} {-# NOINLINE rule167 #-} {-# LINE 183 "src-ag/Desugar.ag" #-} rule167 = \ !_def ((!_patIdefsCollect) :: Set (Identifier, Identifier)) -> {-# LINE 183 "src-ag/Desugar.ag" #-} _def `Set.union` _patIdefsCollect {-# LINE 2504 "dist/build/Desugar.hs"#-} {-# NOINLINE rule168 #-} {-# LINE 200 "src-ag/Desugar.ag" #-} rule168 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) ((!_patIallAttributes) :: AttrMap) !attr_ !field_ -> {-# LINE 200 "src-ag/Desugar.ag" #-} (Map.singleton _lhsInt $ Map.singleton _lhsIcon $ Set.singleton (field_, attr_)) `mergeAttributes` _patIallAttributes {-# LINE 2510 "dist/build/Desugar.hs"#-} {-# NOINLINE rule169 #-} {-# LINE 219 "src-ag/Desugar.ag" #-} rule169 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsIforcedIrrefutables) :: AttrMap) ((!_lhsInt) :: NontermIdent) !_output !attr_ !field_ -> {-# LINE 219 "src-ag/Desugar.ag" #-} if Set.member (field_, attr_) $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt $ _lhsIforcedIrrefutables then Irrefutable _output else _output {-# LINE 2518 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule170 #-} rule170 = \ ((!_patIcopy) :: Pattern) !attr_ !field_ -> Alias field_ attr_ _patIcopy {-# NOINLINE[1] rule171 #-} rule171 = \ !_copy -> _copy {-# NOINLINE[1] rule172 #-} rule172 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> _lhsIchildInhs {-# NOINLINE[1] rule174 #-} rule174 = \ ((!_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# NOINLINE[1] rule175 #-} rule175 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> _lhsIdefs {-# NOINLINE[1] rule176 #-} rule176 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# NOINLINE[1] rule177 #-} rule177 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st18) where {-# NOINLINE st18 #-} !st18 = let k18 :: K_Pattern_s18 t -> t k18 K_Pattern_v9 = v9 k18 K_Pattern_v27 = v27 k18 K_Pattern_v31 = v31 k18 K_Pattern_v41 = v41 k18 K_Pattern_v46 = v46 k18 K_Pattern_v55 = v55 v9 :: T_Pattern_v9 v9 = \ !(T_Pattern_vIn9 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule178 () in let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !_patOchildInhs = rule185 _lhsIchildInhs in let !_patOcon = rule187 _lhsIcon in let !_patOdefs = rule188 _lhsIdefs in let !_patOnt = rule190 _lhsInt in let !_patOforcedIrrefutables = rule189 _lhsIforcedIrrefutables in let !(T_Pattern_vOut27 _patIallAttributes _patIcopy _patIdefsCollect _patIerrors _patIoutput) = inv_Pattern_s18 _patX18 K_Pattern_v27 (T_Pattern_vIn27 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in let !_copy = rule181 _patIcopy in let _lhsOcopy :: Pattern !_lhsOcopy = rule183 _copy in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule179 _patIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule180 _patIerrors in let !_output = rule182 _patIoutput in let _lhsOoutput :: Pattern !_lhsOoutput = rule184 _output in let !__result_ = T_Pattern_vOut9 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v27 :: T_Pattern_v27 v27 = \ !(T_Pattern_vIn27 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule178 () in let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !_patOchildInhs = rule185 _lhsIchildInhs in let !_patOcon = rule187 _lhsIcon in let !_patOdefs = rule188 _lhsIdefs in let !_patOnt = rule190 _lhsInt in let !_patOforcedIrrefutables = rule189 _lhsIforcedIrrefutables in let !(T_Pattern_vOut27 _patIallAttributes _patIcopy _patIdefsCollect _patIerrors _patIoutput) = inv_Pattern_s18 _patX18 K_Pattern_v27 (T_Pattern_vIn27 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in let !_copy = rule181 _patIcopy in let _lhsOcopy :: Pattern !_lhsOcopy = rule183 _copy in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule179 _patIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule180 _patIerrors in let !_output = rule182 _patIoutput in let _lhsOoutput :: Pattern !_lhsOoutput = rule184 _output in let !__result_ = T_Pattern_vOut27 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v31 :: T_Pattern_v31 v31 = \ !(T_Pattern_vIn31 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule178 () in let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !_patOchildInhs = rule185 _lhsIchildInhs in let !_patOcon = rule187 _lhsIcon in let !_patOdefs = rule188 _lhsIdefs in let !_patOnt = rule190 _lhsInt in let !_patOforcedIrrefutables = rule189 _lhsIforcedIrrefutables in let !(T_Pattern_vOut31 _patIallAttributes _patIdefsCollect _patIerrors _patIoutput) = inv_Pattern_s18 _patX18 K_Pattern_v31 (T_Pattern_vIn31 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule179 _patIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule180 _patIerrors in let !_output = rule182 _patIoutput in let _lhsOoutput :: Pattern !_lhsOoutput = rule184 _output in let !__result_ = T_Pattern_vOut31 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v41 :: T_Pattern_v41 v41 = \ !(T_Pattern_vIn41 _lhsIcon _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule178 () in let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !(T_Pattern_vOut46 _patIdefsCollect _patX54) = inv_Pattern_s18 _patX18 K_Pattern_v46 (T_Pattern_vIn46 ) in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule179 _patIdefsCollect in let !__st_ = st51 _lhsIcon _lhsInt _patX54 !__result_ = T_Pattern_vOut41 _lhsOallAttributes _lhsOdefsCollect __st_ in __result_ ) v46 :: T_Pattern_v46 v46 = \ !(T_Pattern_vIn46 ) -> ( let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !(T_Pattern_vOut46 _patIdefsCollect _patX54) = inv_Pattern_s18 _patX18 K_Pattern_v46 (T_Pattern_vIn46 ) in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule179 _patIdefsCollect in let !__st_ = st54 _patX54 !__result_ = T_Pattern_vOut46 _lhsOdefsCollect __st_ in __result_ ) v55 :: T_Pattern_v55 v55 = \ !(T_Pattern_vIn55 _lhsIcon _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule178 () in let !__st_ = st58 _lhsIcon _lhsInt !__result_ = T_Pattern_vOut55 _lhsOallAttributes __st_ in __result_ ) in C_Pattern_s18 k18 {-# NOINLINE st51 #-} st51 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) !_patX54 -> let v42 :: T_Pattern_v42 v42 = \ !(T_Pattern_vIn42 _lhsIchildInhs _lhsIdefs _lhsIforcedIrrefutables) -> ( let !_patOcon = rule187 _lhsIcon in let !_patOnt = rule190 _lhsInt in let !_patOchildInhs = rule185 _lhsIchildInhs in let !_patOdefs = rule188 _lhsIdefs in let !_patOforcedIrrefutables = rule189 _lhsIforcedIrrefutables in let !(T_Pattern_vOut48 _patIallAttributes _patIerrors _patIoutput) = inv_Pattern_s54 _patX54 (T_Pattern_vIn48 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule180 _patIerrors in let !_output = rule182 _patIoutput in let _lhsOoutput :: Pattern !_lhsOoutput = rule184 _output in let !__result_ = T_Pattern_vOut42 _lhsOerrors _lhsOoutput in __result_ ) in C_Pattern_s51 v42 {-# NOINLINE st54 #-} st54 = \ !_patX54 -> let v48 :: T_Pattern_v48 v48 = \ !(T_Pattern_vIn48 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule178 () in let !_patOchildInhs = rule185 _lhsIchildInhs in let !_patOcon = rule187 _lhsIcon in let !_patOdefs = rule188 _lhsIdefs in let !_patOnt = rule190 _lhsInt in let !_patOforcedIrrefutables = rule189 _lhsIforcedIrrefutables in let !(T_Pattern_vOut48 _patIallAttributes _patIerrors _patIoutput) = inv_Pattern_s54 _patX54 (T_Pattern_vIn48 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule180 _patIerrors in let !_output = rule182 _patIoutput in let _lhsOoutput :: Pattern !_lhsOoutput = rule184 _output in let !__result_ = T_Pattern_vOut48 _lhsOallAttributes _lhsOerrors _lhsOoutput in __result_ ) in C_Pattern_s54 v48 {-# NOINLINE st58 #-} st58 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) -> let v56 :: T_Pattern_v56 v56 = \ !(T_Pattern_vIn56 ) -> ( let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in let !(T_Pattern_vOut46 _patIdefsCollect _patX54) = inv_Pattern_s18 _patX18 K_Pattern_v46 (T_Pattern_vIn46 ) in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule179 _patIdefsCollect in let !__st_ = st51 _lhsIcon _lhsInt _patX54 !__result_ = T_Pattern_vOut56 _lhsOdefsCollect __st_ in __result_ ) in C_Pattern_s58 v56 {-# NOINLINE rule178 #-} {-# LINE 202 "src-ag/Desugar.ag" #-} rule178 = \ (_ :: ()) -> {-# LINE 202 "src-ag/Desugar.ag" #-} Map.empty {-# LINE 2701 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule179 #-} rule179 = \ ((!_patIdefsCollect) :: Set (Identifier, Identifier)) -> _patIdefsCollect {-# NOINLINE[1] rule180 #-} rule180 = \ ((!_patIerrors) :: Seq Error) -> _patIerrors {-# NOINLINE[1] rule181 #-} rule181 = \ ((!_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# NOINLINE[1] rule182 #-} rule182 = \ ((!_patIoutput) :: Pattern) -> Irrefutable _patIoutput {-# NOINLINE[1] rule183 #-} rule183 = \ !_copy -> _copy {-# NOINLINE[1] rule184 #-} rule184 = \ !_output -> _output {-# NOINLINE[1] rule185 #-} rule185 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> _lhsIchildInhs {-# NOINLINE[1] rule187 #-} rule187 = \ ((!_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# NOINLINE[1] rule188 #-} rule188 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> _lhsIdefs {-# NOINLINE[1] rule189 #-} rule189 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# NOINLINE[1] rule190 #-} rule190 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore !arg_pos_ = T_Pattern (return st18) where {-# NOINLINE st18 #-} !st18 = let k18 :: K_Pattern_s18 t -> t k18 K_Pattern_v9 = v9 k18 K_Pattern_v27 = v27 k18 K_Pattern_v31 = v31 k18 K_Pattern_v41 = v41 k18 K_Pattern_v46 = v46 k18 K_Pattern_v55 = v55 v9 :: T_Pattern_v9 v9 = \ !(T_Pattern_vIn9 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule191 () in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule192 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule193 () in let !_copy = rule194 arg_pos_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule196 _copy in let !_output = rule195 arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule197 _output in let !__result_ = T_Pattern_vOut9 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v27 :: T_Pattern_v27 v27 = \ !(T_Pattern_vIn27 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule191 () in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule192 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule193 () in let !_copy = rule194 arg_pos_ in let _lhsOcopy :: Pattern !_lhsOcopy = rule196 _copy in let !_output = rule195 arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule197 _output in let !__result_ = T_Pattern_vOut27 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v31 :: T_Pattern_v31 v31 = \ !(T_Pattern_vIn31 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule191 () in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule192 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule193 () in let !_output = rule195 arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule197 _output in let !__result_ = T_Pattern_vOut31 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v41 :: T_Pattern_v41 v41 = \ !(T_Pattern_vIn41 _lhsIcon _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule191 () in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule192 () in let !__st_ = st51 () !__result_ = T_Pattern_vOut41 _lhsOallAttributes _lhsOdefsCollect __st_ in __result_ ) v46 :: T_Pattern_v46 v46 = \ !(T_Pattern_vIn46 ) -> ( let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule192 () in let !__st_ = st54 () !__result_ = T_Pattern_vOut46 _lhsOdefsCollect __st_ in __result_ ) v55 :: T_Pattern_v55 v55 = \ !(T_Pattern_vIn55 _lhsIcon _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule191 () in let !__st_ = st58 () !__result_ = T_Pattern_vOut55 _lhsOallAttributes __st_ in __result_ ) in C_Pattern_s18 k18 {-# NOINLINE st51 #-} st51 = \ (_ :: ()) -> let v42 :: T_Pattern_v42 v42 = \ !(T_Pattern_vIn42 _lhsIchildInhs _lhsIdefs _lhsIforcedIrrefutables) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule193 () in let !_output = rule195 arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule197 _output in let !__result_ = T_Pattern_vOut42 _lhsOerrors _lhsOoutput in __result_ ) in C_Pattern_s51 v42 {-# NOINLINE st54 #-} st54 = \ (_ :: ()) -> let v48 :: T_Pattern_v48 v48 = \ !(T_Pattern_vIn48 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule191 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule193 () in let !_output = rule195 arg_pos_ in let _lhsOoutput :: Pattern !_lhsOoutput = rule197 _output in let !__result_ = T_Pattern_vOut48 _lhsOallAttributes _lhsOerrors _lhsOoutput in __result_ ) in C_Pattern_s54 v48 {-# NOINLINE st58 #-} st58 = \ (_ :: ()) -> let v56 :: T_Pattern_v56 v56 = \ !(T_Pattern_vIn56 ) -> ( let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule192 () in let !__st_ = st51 () !__result_ = T_Pattern_vOut56 _lhsOdefsCollect __st_ in __result_ ) in C_Pattern_s58 v56 {-# NOINLINE[1] rule191 #-} rule191 = \ (_ :: ()) -> Map.empty {-# NOINLINE[1] rule192 #-} rule192 = \ (_ :: ()) -> Set.empty {-# NOINLINE[1] rule193 #-} rule193 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule194 #-} rule194 = \ !pos_ -> Underscore pos_ {-# NOINLINE[1] rule195 #-} rule195 = \ !pos_ -> Underscore pos_ {-# NOINLINE[1] rule196 #-} rule196 = \ !_copy -> _copy {-# NOINLINE[1] rule197 #-} rule197 = \ !_output -> _output -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { childInhs_Inh_Patterns :: !([(Identifier, Identifier)]), childSyns_Inh_Patterns :: !([(Identifier, Identifier)]), con_Inh_Patterns :: !(ConstructorIdent), defs_Inh_Patterns :: !(Set (Identifier, Identifier)), forcedIrrefutables_Inh_Patterns :: !(AttrMap), nt_Inh_Patterns :: !(NontermIdent) } data Syn_Patterns = Syn_Patterns { allAttributes_Syn_Patterns :: !(AttrMap), copy_Syn_Patterns :: !(Patterns), defsCollect_Syn_Patterns :: !(Set (Identifier, Identifier)), errors_Syn_Patterns :: !(Seq Error), output_Syn_Patterns :: !(Patterns) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns !(T_Patterns act) !(Inh_Patterns _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg10 = T_Patterns_vIn10 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt !(T_Patterns_vOut10 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput) <- return (inv_Patterns_s20 sem K_Patterns_v10 arg10) return (Syn_Patterns _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s20 ) } data T_Patterns_s20 where C_Patterns_s20 :: { inv_Patterns_s20 :: !(forall t. K_Patterns_s20 t -> t) } -> T_Patterns_s20 data T_Patterns_s21 = C_Patterns_s21 data T_Patterns_s41 = C_Patterns_s41 data T_Patterns_s49 = C_Patterns_s49 newtype T_Patterns_s53 = C_Patterns_s53 { inv_Patterns_s53 :: (T_Patterns_v47 ) } newtype T_Patterns_s56 = C_Patterns_s56 { inv_Patterns_s56 :: (T_Patterns_v52 ) } newtype T_Patterns_s59 = C_Patterns_s59 { inv_Patterns_s59 :: (T_Patterns_v58 ) } data K_Patterns_s20 k where K_Patterns_v10 :: K_Patterns_s20 (T_Patterns_v10 ) K_Patterns_v26 :: K_Patterns_s20 (T_Patterns_v26 ) K_Patterns_v38 :: K_Patterns_s20 (T_Patterns_v38 ) K_Patterns_v45 :: K_Patterns_s20 (T_Patterns_v45 ) K_Patterns_v51 :: K_Patterns_s20 (T_Patterns_v51 ) K_Patterns_v57 :: K_Patterns_s20 (T_Patterns_v57 ) type T_Patterns_v10 = (T_Patterns_vIn10 ) -> (T_Patterns_vOut10 ) data T_Patterns_vIn10 = T_Patterns_vIn10 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) data T_Patterns_vOut10 = T_Patterns_vOut10 !(AttrMap) !(Patterns) !(Set (Identifier, Identifier)) !(Seq Error) !(Patterns) type T_Patterns_v26 = (T_Patterns_vIn26 ) -> (T_Patterns_vOut26 ) data T_Patterns_vIn26 = T_Patterns_vIn26 !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) data T_Patterns_vOut26 = T_Patterns_vOut26 !(AttrMap) !(Patterns) !(Set (Identifier, Identifier)) !(Seq Error) !(Patterns) type T_Patterns_v38 = (T_Patterns_vIn38 ) -> (T_Patterns_vOut38 ) data T_Patterns_vIn38 = T_Patterns_vIn38 !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) data T_Patterns_vOut38 = T_Patterns_vOut38 !(AttrMap) !(Set (Identifier, Identifier)) !(Seq Error) !(Patterns) type T_Patterns_v45 = (T_Patterns_vIn45 ) -> (T_Patterns_vOut45 ) data T_Patterns_vIn45 = T_Patterns_vIn45 !(ConstructorIdent) !(NontermIdent) data T_Patterns_vOut45 = T_Patterns_vOut45 !(AttrMap) !(Set (Identifier, Identifier)) !(T_Patterns_s53 ) type T_Patterns_v47 = (T_Patterns_vIn47 ) -> (T_Patterns_vOut47 ) data T_Patterns_vIn47 = T_Patterns_vIn47 !([(Identifier, Identifier)]) !(Set (Identifier, Identifier)) !(AttrMap) data T_Patterns_vOut47 = T_Patterns_vOut47 !(Seq Error) !(Patterns) type T_Patterns_v51 = (T_Patterns_vIn51 ) -> (T_Patterns_vOut51 ) data T_Patterns_vIn51 = T_Patterns_vIn51 data T_Patterns_vOut51 = T_Patterns_vOut51 !(Set (Identifier, Identifier)) !(T_Patterns_s56 ) type T_Patterns_v52 = (T_Patterns_vIn52 ) -> (T_Patterns_vOut52 ) data T_Patterns_vIn52 = T_Patterns_vIn52 !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) data T_Patterns_vOut52 = T_Patterns_vOut52 !(AttrMap) !(Seq Error) !(Patterns) type T_Patterns_v57 = (T_Patterns_vIn57 ) -> (T_Patterns_vOut57 ) data T_Patterns_vIn57 = T_Patterns_vIn57 !(ConstructorIdent) !(NontermIdent) data T_Patterns_vOut57 = T_Patterns_vOut57 !(AttrMap) !(T_Patterns_s59 ) type T_Patterns_v58 = (T_Patterns_vIn58 ) -> (T_Patterns_vOut58 ) data T_Patterns_vIn58 = T_Patterns_vIn58 data T_Patterns_vOut58 = T_Patterns_vOut58 !(Set (Identifier, Identifier)) !(T_Patterns_s53 ) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st20) where {-# NOINLINE st20 #-} !st20 = let k20 :: K_Patterns_s20 t -> t k20 K_Patterns_v10 = v10 k20 K_Patterns_v26 = v26 k20 K_Patterns_v38 = v38 k20 K_Patterns_v45 = v45 k20 K_Patterns_v51 = v51 k20 K_Patterns_v57 = v57 v10 :: T_Patterns_v10 v10 = \ !(T_Patterns_vIn10 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in let !_hdOcon = rule207 _lhsIcon in let !_hdOnt = rule210 _lhsInt in let !_tlOcon = rule213 _lhsIcon in let !_tlOnt = rule216 _lhsInt in let !_hdOchildInhs = rule205 _lhsIchildInhs in let !_hdOdefs = rule208 _lhsIdefs in let !_tlOchildInhs = rule211 _lhsIchildInhs in let !_tlOdefs = rule214 _lhsIdefs in let !_hdOforcedIrrefutables = rule209 _lhsIforcedIrrefutables in let !_tlOforcedIrrefutables = rule215 _lhsIforcedIrrefutables in let !(T_Pattern_vOut27 _hdIallAttributes _hdIcopy _hdIdefsCollect _hdIerrors _hdIoutput) = inv_Pattern_s18 _hdX18 K_Pattern_v27 (T_Pattern_vIn27 _hdOchildInhs _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt) in let !(T_Patterns_vOut26 _tlIallAttributes _tlIcopy _tlIdefsCollect _tlIerrors _tlIoutput) = inv_Patterns_s20 _tlX20 K_Patterns_v26 (T_Patterns_vIn26 _tlOchildInhs _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule198 _hdIallAttributes _tlIallAttributes in let !_copy = rule201 _hdIcopy _tlIcopy in let _lhsOcopy :: Patterns !_lhsOcopy = rule203 _copy in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule199 _hdIdefsCollect _tlIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule200 _hdIerrors _tlIerrors in let !_output = rule202 _hdIoutput _tlIoutput in let _lhsOoutput :: Patterns !_lhsOoutput = rule204 _output in let !__result_ = T_Patterns_vOut10 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v26 :: T_Patterns_v26 v26 = \ !(T_Patterns_vIn26 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in let !_hdOcon = rule207 _lhsIcon in let !_hdOnt = rule210 _lhsInt in let !_tlOcon = rule213 _lhsIcon in let !_tlOnt = rule216 _lhsInt in let !_hdOchildInhs = rule205 _lhsIchildInhs in let !_hdOdefs = rule208 _lhsIdefs in let !_tlOchildInhs = rule211 _lhsIchildInhs in let !_tlOdefs = rule214 _lhsIdefs in let !_hdOforcedIrrefutables = rule209 _lhsIforcedIrrefutables in let !_tlOforcedIrrefutables = rule215 _lhsIforcedIrrefutables in let !(T_Pattern_vOut27 _hdIallAttributes _hdIcopy _hdIdefsCollect _hdIerrors _hdIoutput) = inv_Pattern_s18 _hdX18 K_Pattern_v27 (T_Pattern_vIn27 _hdOchildInhs _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt) in let !(T_Patterns_vOut26 _tlIallAttributes _tlIcopy _tlIdefsCollect _tlIerrors _tlIoutput) = inv_Patterns_s20 _tlX20 K_Patterns_v26 (T_Patterns_vIn26 _tlOchildInhs _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule198 _hdIallAttributes _tlIallAttributes in let !_copy = rule201 _hdIcopy _tlIcopy in let _lhsOcopy :: Patterns !_lhsOcopy = rule203 _copy in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule199 _hdIdefsCollect _tlIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule200 _hdIerrors _tlIerrors in let !_output = rule202 _hdIoutput _tlIoutput in let _lhsOoutput :: Patterns !_lhsOoutput = rule204 _output in let !__result_ = T_Patterns_vOut26 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v38 :: T_Patterns_v38 v38 = \ !(T_Patterns_vIn38 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in let !_hdOcon = rule207 _lhsIcon in let !_hdOnt = rule210 _lhsInt in let !_tlOcon = rule213 _lhsIcon in let !_tlOnt = rule216 _lhsInt in let !_hdOchildInhs = rule205 _lhsIchildInhs in let !_hdOdefs = rule208 _lhsIdefs in let !_tlOchildInhs = rule211 _lhsIchildInhs in let !_tlOdefs = rule214 _lhsIdefs in let !_hdOforcedIrrefutables = rule209 _lhsIforcedIrrefutables in let !_tlOforcedIrrefutables = rule215 _lhsIforcedIrrefutables in let !(T_Pattern_vOut31 _hdIallAttributes _hdIdefsCollect _hdIerrors _hdIoutput) = inv_Pattern_s18 _hdX18 K_Pattern_v31 (T_Pattern_vIn31 _hdOchildInhs _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt) in let !(T_Patterns_vOut38 _tlIallAttributes _tlIdefsCollect _tlIerrors _tlIoutput) = inv_Patterns_s20 _tlX20 K_Patterns_v38 (T_Patterns_vIn38 _tlOchildInhs _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule198 _hdIallAttributes _tlIallAttributes in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule199 _hdIdefsCollect _tlIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule200 _hdIerrors _tlIerrors in let !_output = rule202 _hdIoutput _tlIoutput in let _lhsOoutput :: Patterns !_lhsOoutput = rule204 _output in let !__result_ = T_Patterns_vOut38 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v45 :: T_Patterns_v45 v45 = \ !(T_Patterns_vIn45 _lhsIcon _lhsInt) -> ( let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in let !_hdOcon = rule207 _lhsIcon in let !_hdOnt = rule210 _lhsInt in let !_tlOcon = rule213 _lhsIcon in let !_tlOnt = rule216 _lhsInt in let !(T_Pattern_vOut41 _hdIallAttributes _hdIdefsCollect _hdX51) = inv_Pattern_s18 _hdX18 K_Pattern_v41 (T_Pattern_vIn41 _hdOcon _hdOnt) in let !(T_Patterns_vOut45 _tlIallAttributes _tlIdefsCollect _tlX53) = inv_Patterns_s20 _tlX20 K_Patterns_v45 (T_Patterns_vIn45 _tlOcon _tlOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule198 _hdIallAttributes _tlIallAttributes in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule199 _hdIdefsCollect _tlIdefsCollect in let !__st_ = st53 _hdX51 _tlX53 !__result_ = T_Patterns_vOut45 _lhsOallAttributes _lhsOdefsCollect __st_ in __result_ ) v51 :: T_Patterns_v51 v51 = \ !(T_Patterns_vIn51 ) -> ( let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in let !(T_Pattern_vOut46 _hdIdefsCollect _hdX54) = inv_Pattern_s18 _hdX18 K_Pattern_v46 (T_Pattern_vIn46 ) in let !(T_Patterns_vOut51 _tlIdefsCollect _tlX56) = inv_Patterns_s20 _tlX20 K_Patterns_v51 (T_Patterns_vIn51 ) in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule199 _hdIdefsCollect _tlIdefsCollect in let !__st_ = st56 _hdX54 _tlX56 !__result_ = T_Patterns_vOut51 _lhsOdefsCollect __st_ in __result_ ) v57 :: T_Patterns_v57 v57 = \ !(T_Patterns_vIn57 _lhsIcon _lhsInt) -> ( let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in let !_hdOcon = rule207 _lhsIcon in let !_hdOnt = rule210 _lhsInt in let !_tlOcon = rule213 _lhsIcon in let !_tlOnt = rule216 _lhsInt in let !(T_Pattern_vOut55 _hdIallAttributes _hdX58) = inv_Pattern_s18 _hdX18 K_Pattern_v55 (T_Pattern_vIn55 _hdOcon _hdOnt) in let !(T_Patterns_vOut57 _tlIallAttributes _tlX59) = inv_Patterns_s20 _tlX20 K_Patterns_v57 (T_Patterns_vIn57 _tlOcon _tlOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule198 _hdIallAttributes _tlIallAttributes in let !__st_ = st59 _hdX58 _tlX59 !__result_ = T_Patterns_vOut57 _lhsOallAttributes __st_ in __result_ ) in C_Patterns_s20 k20 {-# NOINLINE st53 #-} st53 = \ !_hdX51 !_tlX53 -> let v47 :: T_Patterns_v47 v47 = \ !(T_Patterns_vIn47 _lhsIchildInhs _lhsIdefs _lhsIforcedIrrefutables) -> ( let !_hdOchildInhs = rule205 _lhsIchildInhs in let !_hdOdefs = rule208 _lhsIdefs in let !_tlOchildInhs = rule211 _lhsIchildInhs in let !_tlOdefs = rule214 _lhsIdefs in let !_hdOforcedIrrefutables = rule209 _lhsIforcedIrrefutables in let !_tlOforcedIrrefutables = rule215 _lhsIforcedIrrefutables in let !(T_Pattern_vOut42 _hdIerrors _hdIoutput) = inv_Pattern_s51 _hdX51 (T_Pattern_vIn42 _hdOchildInhs _hdOdefs _hdOforcedIrrefutables) in let !(T_Patterns_vOut47 _tlIerrors _tlIoutput) = inv_Patterns_s53 _tlX53 (T_Patterns_vIn47 _tlOchildInhs _tlOdefs _tlOforcedIrrefutables) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule200 _hdIerrors _tlIerrors in let !_output = rule202 _hdIoutput _tlIoutput in let _lhsOoutput :: Patterns !_lhsOoutput = rule204 _output in let !__result_ = T_Patterns_vOut47 _lhsOerrors _lhsOoutput in __result_ ) in C_Patterns_s53 v47 {-# NOINLINE st56 #-} st56 = \ !_hdX54 !_tlX56 -> let v52 :: T_Patterns_v52 v52 = \ !(T_Patterns_vIn52 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let !_hdOcon = rule207 _lhsIcon in let !_hdOnt = rule210 _lhsInt in let !_tlOcon = rule213 _lhsIcon in let !_tlOnt = rule216 _lhsInt in let !_hdOchildInhs = rule205 _lhsIchildInhs in let !_hdOdefs = rule208 _lhsIdefs in let !_tlOchildInhs = rule211 _lhsIchildInhs in let !_tlOdefs = rule214 _lhsIdefs in let !_hdOforcedIrrefutables = rule209 _lhsIforcedIrrefutables in let !_tlOforcedIrrefutables = rule215 _lhsIforcedIrrefutables in let !(T_Pattern_vOut48 _hdIallAttributes _hdIerrors _hdIoutput) = inv_Pattern_s54 _hdX54 (T_Pattern_vIn48 _hdOchildInhs _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt) in let !(T_Patterns_vOut52 _tlIallAttributes _tlIerrors _tlIoutput) = inv_Patterns_s56 _tlX56 (T_Patterns_vIn52 _tlOchildInhs _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule198 _hdIallAttributes _tlIallAttributes in let _lhsOerrors :: Seq Error !_lhsOerrors = rule200 _hdIerrors _tlIerrors in let !_output = rule202 _hdIoutput _tlIoutput in let _lhsOoutput :: Patterns !_lhsOoutput = rule204 _output in let !__result_ = T_Patterns_vOut52 _lhsOallAttributes _lhsOerrors _lhsOoutput in __result_ ) in C_Patterns_s56 v52 {-# NOINLINE st59 #-} st59 = \ !_hdX58 !_tlX59 -> let v58 :: T_Patterns_v58 v58 = \ !(T_Patterns_vIn58 ) -> ( let !(T_Pattern_vOut56 _hdIdefsCollect _hdX51) = inv_Pattern_s58 _hdX58 (T_Pattern_vIn56 ) in let !(T_Patterns_vOut58 _tlIdefsCollect _tlX53) = inv_Patterns_s59 _tlX59 (T_Patterns_vIn58 ) in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule199 _hdIdefsCollect _tlIdefsCollect in let !__st_ = st53 _hdX51 _tlX53 !__result_ = T_Patterns_vOut58 _lhsOdefsCollect __st_ in __result_ ) in C_Patterns_s59 v58 {-# NOINLINE[1] rule198 #-} rule198 = \ ((!_hdIallAttributes) :: AttrMap) ((!_tlIallAttributes) :: AttrMap) -> _hdIallAttributes `mergeAttributes` _tlIallAttributes {-# NOINLINE[1] rule199 #-} rule199 = \ ((!_hdIdefsCollect) :: Set (Identifier, Identifier)) ((!_tlIdefsCollect) :: Set (Identifier, Identifier)) -> _hdIdefsCollect `Set.union` _tlIdefsCollect {-# NOINLINE[1] rule200 #-} rule200 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# NOINLINE[1] rule201 #-} rule201 = \ ((!_hdIcopy) :: Pattern) ((!_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# NOINLINE[1] rule202 #-} rule202 = \ ((!_hdIoutput) :: Pattern) ((!_tlIoutput) :: Patterns) -> (:) _hdIoutput _tlIoutput {-# NOINLINE[1] rule203 #-} rule203 = \ !_copy -> _copy {-# NOINLINE[1] rule204 #-} rule204 = \ !_output -> _output {-# NOINLINE[1] rule205 #-} rule205 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> _lhsIchildInhs {-# NOINLINE[1] rule207 #-} rule207 = \ ((!_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# NOINLINE[1] rule208 #-} rule208 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> _lhsIdefs {-# NOINLINE[1] rule209 #-} rule209 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# NOINLINE[1] rule210 #-} rule210 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE[1] rule211 #-} rule211 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> _lhsIchildInhs {-# NOINLINE[1] rule213 #-} rule213 = \ ((!_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# NOINLINE[1] rule214 #-} rule214 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> _lhsIdefs {-# NOINLINE[1] rule215 #-} rule215 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# NOINLINE[1] rule216 #-} rule216 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st20) where {-# NOINLINE st20 #-} !st20 = let k20 :: K_Patterns_s20 t -> t k20 K_Patterns_v10 = v10 k20 K_Patterns_v26 = v26 k20 K_Patterns_v38 = v38 k20 K_Patterns_v45 = v45 k20 K_Patterns_v51 = v51 k20 K_Patterns_v57 = v57 v10 :: T_Patterns_v10 v10 = \ !(T_Patterns_vIn10 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule217 () in let !_copy = rule220 () in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule218 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule219 () in let !_output = rule221 () in let _lhsOcopy :: Patterns !_lhsOcopy = rule222 _copy in let _lhsOoutput :: Patterns !_lhsOoutput = rule223 _output in let !__result_ = T_Patterns_vOut10 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v26 :: T_Patterns_v26 v26 = \ !(T_Patterns_vIn26 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule217 () in let !_copy = rule220 () in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule218 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule219 () in let !_output = rule221 () in let _lhsOcopy :: Patterns !_lhsOcopy = rule222 _copy in let _lhsOoutput :: Patterns !_lhsOoutput = rule223 _output in let !__result_ = T_Patterns_vOut26 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v38 :: T_Patterns_v38 v38 = \ !(T_Patterns_vIn38 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule217 () in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule218 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule219 () in let !_output = rule221 () in let _lhsOoutput :: Patterns !_lhsOoutput = rule223 _output in let !__result_ = T_Patterns_vOut38 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v45 :: T_Patterns_v45 v45 = \ !(T_Patterns_vIn45 _lhsIcon _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule217 () in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule218 () in let !__st_ = st53 () !__result_ = T_Patterns_vOut45 _lhsOallAttributes _lhsOdefsCollect __st_ in __result_ ) v51 :: T_Patterns_v51 v51 = \ !(T_Patterns_vIn51 ) -> ( let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule218 () in let !__st_ = st56 () !__result_ = T_Patterns_vOut51 _lhsOdefsCollect __st_ in __result_ ) v57 :: T_Patterns_v57 v57 = \ !(T_Patterns_vIn57 _lhsIcon _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule217 () in let !__st_ = st59 () !__result_ = T_Patterns_vOut57 _lhsOallAttributes __st_ in __result_ ) in C_Patterns_s20 k20 {-# NOINLINE st53 #-} st53 = \ (_ :: ()) -> let v47 :: T_Patterns_v47 v47 = \ !(T_Patterns_vIn47 _lhsIchildInhs _lhsIdefs _lhsIforcedIrrefutables) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule219 () in let !_output = rule221 () in let _lhsOoutput :: Patterns !_lhsOoutput = rule223 _output in let !__result_ = T_Patterns_vOut47 _lhsOerrors _lhsOoutput in __result_ ) in C_Patterns_s53 v47 {-# NOINLINE st56 #-} st56 = \ (_ :: ()) -> let v52 :: T_Patterns_v52 v52 = \ !(T_Patterns_vIn52 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule217 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule219 () in let !_output = rule221 () in let _lhsOoutput :: Patterns !_lhsOoutput = rule223 _output in let !__result_ = T_Patterns_vOut52 _lhsOallAttributes _lhsOerrors _lhsOoutput in __result_ ) in C_Patterns_s56 v52 {-# NOINLINE st59 #-} st59 = \ (_ :: ()) -> let v58 :: T_Patterns_v58 v58 = \ !(T_Patterns_vIn58 ) -> ( let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule218 () in let !__st_ = st53 () !__result_ = T_Patterns_vOut58 _lhsOdefsCollect __st_ in __result_ ) in C_Patterns_s59 v58 {-# NOINLINE[1] rule217 #-} rule217 = \ (_ :: ()) -> Map.empty {-# NOINLINE[1] rule218 #-} rule218 = \ (_ :: ()) -> Set.empty {-# NOINLINE[1] rule219 #-} rule219 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule220 #-} rule220 = \ (_ :: ()) -> [] {-# NOINLINE[1] rule221 #-} rule221 = \ (_ :: ()) -> [] {-# NOINLINE[1] rule222 #-} rule222 = \ !_copy -> _copy {-# NOINLINE[1] rule223 #-} rule223 = \ !_output -> _output -- Production -------------------------------------------------- -- wrapper data Inh_Production = Inh_Production { augmentsIn_Inh_Production :: !(Map ConstructorIdent (Map Identifier [Expression])), forcedIrrefutables_Inh_Production :: !(AttrMap), inhMap_Inh_Production :: !(Map Identifier Attributes), mainName_Inh_Production :: !(String), nt_Inh_Production :: !(NontermIdent), options_Inh_Production :: !(Options), synMap_Inh_Production :: !(Map Identifier Attributes) } data Syn_Production = Syn_Production { allAttributes_Syn_Production :: !(AttrMap), augmentsOut_Syn_Production :: !(Map ConstructorIdent (Map Identifier [Expression])), errors_Syn_Production :: !(Seq Error), output_Syn_Production :: !(Production) } {-# INLINABLE wrap_Production #-} wrap_Production :: T_Production -> Inh_Production -> (Syn_Production ) wrap_Production !(T_Production act) !(Inh_Production _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg11 = T_Production_vIn11 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap !(T_Production_vOut11 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput) <- return (inv_Production_s22 sem K_Production_v11 arg11) return (Syn_Production _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput) ) -- cata {-# INLINE sem_Production #-} sem_Production :: Production -> T_Production sem_Production ( Production !con_ !params_ !constraints_ children_ rules_ typeSigs_ !macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_ -- semantic domain newtype T_Production = T_Production { attach_T_Production :: Identity (T_Production_s22 ) } data T_Production_s22 where C_Production_s22 :: { inv_Production_s22 :: !(forall t. K_Production_s22 t -> t) } -> T_Production_s22 data T_Production_s23 = C_Production_s23 data T_Production_s44 = C_Production_s44 newtype T_Production_s52 = C_Production_s52 { inv_Production_s52 :: (T_Production_v44 ) } data K_Production_s22 k where K_Production_v11 :: K_Production_s22 (T_Production_v11 ) K_Production_v30 :: K_Production_s22 (T_Production_v30 ) K_Production_v43 :: K_Production_s22 (T_Production_v43 ) type T_Production_v11 = (T_Production_vIn11 ) -> (T_Production_vOut11 ) data T_Production_vIn11 = T_Production_vIn11 !(Map ConstructorIdent (Map Identifier [Expression])) !(AttrMap) !(Map Identifier Attributes) !(String) !(NontermIdent) !(Options) !(Map Identifier Attributes) data T_Production_vOut11 = T_Production_vOut11 !(AttrMap) !(Map ConstructorIdent (Map Identifier [Expression])) !(Seq Error) !(Production) type T_Production_v30 = (T_Production_vIn30 ) -> (T_Production_vOut30 ) data T_Production_vIn30 = T_Production_vIn30 !(Map ConstructorIdent (Map Identifier [Expression])) !(AttrMap) !(Map Identifier Attributes) !(NontermIdent) !(Options) !(Map Identifier Attributes) data T_Production_vOut30 = T_Production_vOut30 !(AttrMap) !(Map ConstructorIdent (Map Identifier [Expression])) !(Seq Error) !(Production) type T_Production_v43 = (T_Production_vIn43 ) -> (T_Production_vOut43 ) data T_Production_vIn43 = T_Production_vIn43 !(NontermIdent) data T_Production_vOut43 = T_Production_vOut43 !(AttrMap) !(T_Production_s52 ) type T_Production_v44 = (T_Production_vIn44 ) -> (T_Production_vOut44 ) data T_Production_vIn44 = T_Production_vIn44 !(Map ConstructorIdent (Map Identifier [Expression])) !(AttrMap) !(Map Identifier Attributes) !(Options) !(Map Identifier Attributes) data T_Production_vOut44 = T_Production_vOut44 !(Map ConstructorIdent (Map Identifier [Expression])) !(Seq Error) !(Production) {-# NOINLINE sem_Production_Production #-} sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production sem_Production_Production !arg_con_ !arg_params_ !arg_constraints_ arg_children_ arg_rules_ arg_typeSigs_ !arg_macro_ = T_Production (return st22) where {-# NOINLINE st22 #-} !st22 = let k22 :: K_Production_s22 t -> t k22 K_Production_v11 = v11 k22 K_Production_v30 = v30 k22 K_Production_v43 = v43 v11 :: T_Production_v11 v11 = \ !(T_Production_vIn11 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) -> ( let !_rulesX28 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) in let !_childrenX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) in let !_typeSigsX32 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) in let !_rulesOcon = rule224 arg_con_ in let !_rulesOnt = rule241 _lhsInt in let !_childrenOinhMap = rule234 _lhsIinhMap in let !_childrenOsynMap = rule237 _lhsIsynMap in let !_augmentsIn = rule226 _lhsIaugmentsIn arg_con_ in let !_rulesOoptions = rule242 _lhsIoptions in let !_rulesOforcedIrrefutables = rule240 _lhsIforcedIrrefutables in let !(T_Children_vOut18 _childrenIchildInhs _childrenIchildSyns _childrenIoutput) = inv_Children_s2 _childrenX2 K_Children_v18 (T_Children_vIn18 _childrenOinhMap _childrenOsynMap) in let !(T_Rules_vOut28 _rulesIallAttributes _rulesIdefsCollect _rulesX43) = inv_Rules_s28 _rulesX28 K_Rules_v28 (T_Rules_vIn28 _rulesOcon _rulesOnt) in let !(T_TypeSigs_vOut16 _typeSigsIoutput) = inv_TypeSigs_s32 _typeSigsX32 (T_TypeSigs_vIn16 ) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule230 _rulesIallAttributes in let !(!_augmentErrs,!_augmentsOut1) = rule228 _augmentsIn _childrenIchildInhs _childrenIchildSyns _lhsInt _lhsIoptions arg_con_ in let !_augmentsOut = rule227 _augmentsOut1 arg_con_ in let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) !_lhsOaugmentsOut = rule231 _augmentsOut in let !_rulesOchildInhs = rule238 _childrenIchildInhs in let !_rulesOchildSyns = rule239 _childrenIchildSyns in let !_rulesOdefs = rule225 _rulesIdefsCollect in let !(T_Rules_vOut29 _rulesIerrors _rulesIoutput) = inv_Rules_s43 _rulesX43 (T_Rules_vIn29 _rulesOchildInhs _rulesOchildSyns _rulesOdefs _rulesOforcedIrrefutables _rulesOoptions) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule229 _augmentErrs _rulesIerrors in let !_output = rule232 _childrenIoutput _rulesIoutput _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ in let _lhsOoutput :: Production !_lhsOoutput = rule233 _output in let !__result_ = T_Production_vOut11 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput in __result_ ) v30 :: T_Production_v30 v30 = \ !(T_Production_vIn30 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsInt _lhsIoptions _lhsIsynMap) -> ( let !_rulesX28 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) in let !_childrenX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) in let !_typeSigsX32 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) in let !_rulesOcon = rule224 arg_con_ in let !_rulesOnt = rule241 _lhsInt in let !_childrenOinhMap = rule234 _lhsIinhMap in let !_childrenOsynMap = rule237 _lhsIsynMap in let !_augmentsIn = rule226 _lhsIaugmentsIn arg_con_ in let !_rulesOoptions = rule242 _lhsIoptions in let !_rulesOforcedIrrefutables = rule240 _lhsIforcedIrrefutables in let !(T_Children_vOut18 _childrenIchildInhs _childrenIchildSyns _childrenIoutput) = inv_Children_s2 _childrenX2 K_Children_v18 (T_Children_vIn18 _childrenOinhMap _childrenOsynMap) in let !(T_Rules_vOut28 _rulesIallAttributes _rulesIdefsCollect _rulesX43) = inv_Rules_s28 _rulesX28 K_Rules_v28 (T_Rules_vIn28 _rulesOcon _rulesOnt) in let !(T_TypeSigs_vOut16 _typeSigsIoutput) = inv_TypeSigs_s32 _typeSigsX32 (T_TypeSigs_vIn16 ) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule230 _rulesIallAttributes in let !(!_augmentErrs,!_augmentsOut1) = rule228 _augmentsIn _childrenIchildInhs _childrenIchildSyns _lhsInt _lhsIoptions arg_con_ in let !_augmentsOut = rule227 _augmentsOut1 arg_con_ in let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) !_lhsOaugmentsOut = rule231 _augmentsOut in let !_rulesOchildInhs = rule238 _childrenIchildInhs in let !_rulesOchildSyns = rule239 _childrenIchildSyns in let !_rulesOdefs = rule225 _rulesIdefsCollect in let !(T_Rules_vOut29 _rulesIerrors _rulesIoutput) = inv_Rules_s43 _rulesX43 (T_Rules_vIn29 _rulesOchildInhs _rulesOchildSyns _rulesOdefs _rulesOforcedIrrefutables _rulesOoptions) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule229 _augmentErrs _rulesIerrors in let !_output = rule232 _childrenIoutput _rulesIoutput _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ in let _lhsOoutput :: Production !_lhsOoutput = rule233 _output in let !__result_ = T_Production_vOut30 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput in __result_ ) v43 :: T_Production_v43 v43 = \ !(T_Production_vIn43 _lhsInt) -> ( let !_rulesX28 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) in let !_rulesOcon = rule224 arg_con_ in let !_rulesOnt = rule241 _lhsInt in let !(T_Rules_vOut49 _rulesIallAttributes _rulesX55) = inv_Rules_s28 _rulesX28 K_Rules_v49 (T_Rules_vIn49 _rulesOcon _rulesOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule230 _rulesIallAttributes in let !__st_ = st52 _lhsInt _rulesX55 !__result_ = T_Production_vOut43 _lhsOallAttributes __st_ in __result_ ) in C_Production_s22 k22 {-# NOINLINE st52 #-} st52 = \ ((!_lhsInt) :: NontermIdent) !_rulesX55 -> let v44 :: T_Production_v44 v44 = \ !(T_Production_vIn44 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsIoptions _lhsIsynMap) -> ( let !_childrenX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) in let !_typeSigsX32 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) in let !_childrenOinhMap = rule234 _lhsIinhMap in let !_childrenOsynMap = rule237 _lhsIsynMap in let !_augmentsIn = rule226 _lhsIaugmentsIn arg_con_ in let !_rulesOoptions = rule242 _lhsIoptions in let !_rulesOforcedIrrefutables = rule240 _lhsIforcedIrrefutables in let !(T_Children_vOut18 _childrenIchildInhs _childrenIchildSyns _childrenIoutput) = inv_Children_s2 _childrenX2 K_Children_v18 (T_Children_vIn18 _childrenOinhMap _childrenOsynMap) in let !(T_Rules_vOut50 _rulesIdefsCollect _rulesX43) = inv_Rules_s55 _rulesX55 (T_Rules_vIn50 ) in let !(T_TypeSigs_vOut16 _typeSigsIoutput) = inv_TypeSigs_s32 _typeSigsX32 (T_TypeSigs_vIn16 ) in let !(!_augmentErrs,!_augmentsOut1) = rule228 _augmentsIn _childrenIchildInhs _childrenIchildSyns _lhsInt _lhsIoptions arg_con_ in let !_augmentsOut = rule227 _augmentsOut1 arg_con_ in let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) !_lhsOaugmentsOut = rule231 _augmentsOut in let !_rulesOchildInhs = rule238 _childrenIchildInhs in let !_rulesOchildSyns = rule239 _childrenIchildSyns in let !_rulesOdefs = rule225 _rulesIdefsCollect in let !(T_Rules_vOut29 _rulesIerrors _rulesIoutput) = inv_Rules_s43 _rulesX43 (T_Rules_vIn29 _rulesOchildInhs _rulesOchildSyns _rulesOdefs _rulesOforcedIrrefutables _rulesOoptions) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule229 _augmentErrs _rulesIerrors in let !_output = rule232 _childrenIoutput _rulesIoutput _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ in let _lhsOoutput :: Production !_lhsOoutput = rule233 _output in let !__result_ = T_Production_vOut44 _lhsOaugmentsOut _lhsOerrors _lhsOoutput in __result_ ) in C_Production_s52 v44 {-# NOINLINE[1] rule224 #-} {-# LINE 161 "src-ag/Desugar.ag" #-} rule224 = \ !con_ -> {-# LINE 161 "src-ag/Desugar.ag" #-} con_ {-# LINE 3504 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule225 #-} {-# LINE 188 "src-ag/Desugar.ag" #-} rule225 = \ ((!_rulesIdefsCollect) :: Set (Identifier, Identifier)) -> {-# LINE 188 "src-ag/Desugar.ag" #-} _rulesIdefsCollect {-# LINE 3510 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule226 #-} {-# LINE 244 "src-ag/Desugar.ag" #-} rule226 = \ ((!_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) !con_ -> {-# LINE 244 "src-ag/Desugar.ag" #-} Map.findWithDefault Map.empty con_ _lhsIaugmentsIn {-# LINE 3516 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule227 #-} {-# LINE 245 "src-ag/Desugar.ag" #-} rule227 = \ !_augmentsOut1 !con_ -> {-# LINE 245 "src-ag/Desugar.ag" #-} Map.singleton con_ _augmentsOut1 {-# LINE 3522 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule228 #-} {-# LINE 247 "src-ag/Desugar.ag" #-} rule228 = \ !_augmentsIn ((!_childrenIchildInhs) :: [(Identifier, Identifier)]) ((!_childrenIchildSyns) :: [(Identifier, Identifier)]) ((!_lhsInt) :: NontermIdent) ((!_lhsIoptions) :: Options) !con_ -> {-# LINE 247 "src-ag/Desugar.ag" #-} Map.mapAccum (desugarExprs _lhsIoptions _lhsInt con_ _childrenIchildInhs _childrenIchildSyns) Seq.empty _augmentsIn {-# LINE 3528 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule229 #-} {-# LINE 283 "src-ag/Desugar.ag" #-} rule229 = \ !_augmentErrs ((!_rulesIerrors) :: Seq Error) -> {-# LINE 283 "src-ag/Desugar.ag" #-} _rulesIerrors Seq.>< _augmentErrs {-# LINE 3534 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule230 #-} rule230 = \ ((!_rulesIallAttributes) :: AttrMap) -> _rulesIallAttributes {-# NOINLINE[1] rule231 #-} rule231 = \ !_augmentsOut -> _augmentsOut {-# NOINLINE[1] rule232 #-} rule232 = \ ((!_childrenIoutput) :: Children) ((!_rulesIoutput) :: Rules) ((!_typeSigsIoutput) :: TypeSigs) !con_ !constraints_ !macro_ !params_ -> Production con_ params_ constraints_ _childrenIoutput _rulesIoutput _typeSigsIoutput macro_ {-# NOINLINE[1] rule233 #-} rule233 = \ !_output -> _output {-# NOINLINE[1] rule234 #-} rule234 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule237 #-} rule237 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE[1] rule238 #-} rule238 = \ ((!_childrenIchildInhs) :: [(Identifier, Identifier)]) -> _childrenIchildInhs {-# NOINLINE[1] rule239 #-} rule239 = \ ((!_childrenIchildSyns) :: [(Identifier, Identifier)]) -> _childrenIchildSyns {-# NOINLINE[1] rule240 #-} rule240 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# NOINLINE[1] rule241 #-} rule241 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE[1] rule242 #-} rule242 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions -- Productions ------------------------------------------------- -- wrapper data Inh_Productions = Inh_Productions { augmentsIn_Inh_Productions :: !(Map ConstructorIdent (Map Identifier [Expression])), forcedIrrefutables_Inh_Productions :: !(AttrMap), inhMap_Inh_Productions :: !(Map Identifier Attributes), mainName_Inh_Productions :: !(String), nt_Inh_Productions :: !(NontermIdent), options_Inh_Productions :: !(Options), synMap_Inh_Productions :: !(Map Identifier Attributes) } data Syn_Productions = Syn_Productions { allAttributes_Syn_Productions :: !(AttrMap), augmentsOut_Syn_Productions :: !(Map ConstructorIdent (Map Identifier [Expression])), errors_Syn_Productions :: !(Seq Error), output_Syn_Productions :: !(Productions) } {-# INLINABLE wrap_Productions #-} wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions ) wrap_Productions !(T_Productions act) !(Inh_Productions _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg12 = T_Productions_vIn12 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap !(T_Productions_vOut12 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput) <- return (inv_Productions_s24 sem K_Productions_v12 arg12) return (Syn_Productions _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput) ) -- cata {-# NOINLINE sem_Productions #-} sem_Productions :: Productions -> T_Productions sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) -- semantic domain newtype T_Productions = T_Productions { attach_T_Productions :: Identity (T_Productions_s24 ) } data T_Productions_s24 where C_Productions_s24 :: { inv_Productions_s24 :: !(forall t. K_Productions_s24 t -> t) } -> T_Productions_s24 data T_Productions_s25 = C_Productions_s25 data T_Productions_s40 = C_Productions_s40 newtype T_Productions_s50 = C_Productions_s50 { inv_Productions_s50 :: (T_Productions_v40 ) } data K_Productions_s24 k where K_Productions_v12 :: K_Productions_s24 (T_Productions_v12 ) K_Productions_v25 :: K_Productions_s24 (T_Productions_v25 ) K_Productions_v39 :: K_Productions_s24 (T_Productions_v39 ) type T_Productions_v12 = (T_Productions_vIn12 ) -> (T_Productions_vOut12 ) data T_Productions_vIn12 = T_Productions_vIn12 !(Map ConstructorIdent (Map Identifier [Expression])) !(AttrMap) !(Map Identifier Attributes) !(String) !(NontermIdent) !(Options) !(Map Identifier Attributes) data T_Productions_vOut12 = T_Productions_vOut12 !(AttrMap) !(Map ConstructorIdent (Map Identifier [Expression])) !(Seq Error) !(Productions) type T_Productions_v25 = (T_Productions_vIn25 ) -> (T_Productions_vOut25 ) data T_Productions_vIn25 = T_Productions_vIn25 !(Map ConstructorIdent (Map Identifier [Expression])) !(AttrMap) !(Map Identifier Attributes) !(NontermIdent) !(Options) !(Map Identifier Attributes) data T_Productions_vOut25 = T_Productions_vOut25 !(AttrMap) !(Map ConstructorIdent (Map Identifier [Expression])) !(Seq Error) !(Productions) type T_Productions_v39 = (T_Productions_vIn39 ) -> (T_Productions_vOut39 ) data T_Productions_vIn39 = T_Productions_vIn39 !(NontermIdent) data T_Productions_vOut39 = T_Productions_vOut39 !(AttrMap) !(T_Productions_s50 ) type T_Productions_v40 = (T_Productions_vIn40 ) -> (T_Productions_vOut40 ) data T_Productions_vIn40 = T_Productions_vIn40 !(Map ConstructorIdent (Map Identifier [Expression])) !(AttrMap) !(Map Identifier Attributes) !(Options) !(Map Identifier Attributes) data T_Productions_vOut40 = T_Productions_vOut40 !(Map ConstructorIdent (Map Identifier [Expression])) !(Seq Error) !(Productions) {-# NOINLINE sem_Productions_Cons #-} sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st24) where {-# NOINLINE st24 #-} !st24 = let k24 :: K_Productions_s24 t -> t k24 K_Productions_v12 = v12 k24 K_Productions_v25 = v25 k24 K_Productions_v39 = v39 v12 :: T_Productions_v12 v12 = \ !(T_Productions_vIn12 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) -> ( let !_hdX22 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) in let !_tlX24 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) in let !_hdOnt = rule252 _lhsInt in let !_tlOnt = rule259 _lhsInt in let !_hdOaugmentsIn = rule248 _lhsIaugmentsIn in let !_hdOinhMap = rule250 _lhsIinhMap in let !_hdOoptions = rule253 _lhsIoptions in let !_hdOsynMap = rule254 _lhsIsynMap in let !_tlOaugmentsIn = rule255 _lhsIaugmentsIn in let !_tlOinhMap = rule257 _lhsIinhMap in let !_tlOoptions = rule260 _lhsIoptions in let !_tlOsynMap = rule261 _lhsIsynMap in let !_hdOforcedIrrefutables = rule249 _lhsIforcedIrrefutables in let !_tlOforcedIrrefutables = rule256 _lhsIforcedIrrefutables in let !(T_Production_vOut30 _hdIallAttributes _hdIaugmentsOut _hdIerrors _hdIoutput) = inv_Production_s22 _hdX22 K_Production_v30 (T_Production_vIn30 _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOnt _hdOoptions _hdOsynMap) in let !(T_Productions_vOut25 _tlIallAttributes _tlIaugmentsOut _tlIerrors _tlIoutput) = inv_Productions_s24 _tlX24 K_Productions_v25 (T_Productions_vIn25 _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOnt _tlOoptions _tlOsynMap) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule243 _hdIallAttributes _tlIallAttributes in let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) !_lhsOaugmentsOut = rule244 _hdIaugmentsOut _tlIaugmentsOut in let _lhsOerrors :: Seq Error !_lhsOerrors = rule245 _hdIerrors _tlIerrors in let !_output = rule246 _hdIoutput _tlIoutput in let _lhsOoutput :: Productions !_lhsOoutput = rule247 _output in let !__result_ = T_Productions_vOut12 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput in __result_ ) v25 :: T_Productions_v25 v25 = \ !(T_Productions_vIn25 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsInt _lhsIoptions _lhsIsynMap) -> ( let !_hdX22 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) in let !_tlX24 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) in let !_hdOnt = rule252 _lhsInt in let !_tlOnt = rule259 _lhsInt in let !_hdOaugmentsIn = rule248 _lhsIaugmentsIn in let !_hdOinhMap = rule250 _lhsIinhMap in let !_hdOoptions = rule253 _lhsIoptions in let !_hdOsynMap = rule254 _lhsIsynMap in let !_tlOaugmentsIn = rule255 _lhsIaugmentsIn in let !_tlOinhMap = rule257 _lhsIinhMap in let !_tlOoptions = rule260 _lhsIoptions in let !_tlOsynMap = rule261 _lhsIsynMap in let !_hdOforcedIrrefutables = rule249 _lhsIforcedIrrefutables in let !_tlOforcedIrrefutables = rule256 _lhsIforcedIrrefutables in let !(T_Production_vOut30 _hdIallAttributes _hdIaugmentsOut _hdIerrors _hdIoutput) = inv_Production_s22 _hdX22 K_Production_v30 (T_Production_vIn30 _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOnt _hdOoptions _hdOsynMap) in let !(T_Productions_vOut25 _tlIallAttributes _tlIaugmentsOut _tlIerrors _tlIoutput) = inv_Productions_s24 _tlX24 K_Productions_v25 (T_Productions_vIn25 _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOnt _tlOoptions _tlOsynMap) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule243 _hdIallAttributes _tlIallAttributes in let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) !_lhsOaugmentsOut = rule244 _hdIaugmentsOut _tlIaugmentsOut in let _lhsOerrors :: Seq Error !_lhsOerrors = rule245 _hdIerrors _tlIerrors in let !_output = rule246 _hdIoutput _tlIoutput in let _lhsOoutput :: Productions !_lhsOoutput = rule247 _output in let !__result_ = T_Productions_vOut25 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput in __result_ ) v39 :: T_Productions_v39 v39 = \ !(T_Productions_vIn39 _lhsInt) -> ( let !_hdX22 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) in let !_tlX24 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) in let !_hdOnt = rule252 _lhsInt in let !_tlOnt = rule259 _lhsInt in let !(T_Production_vOut43 _hdIallAttributes _hdX52) = inv_Production_s22 _hdX22 K_Production_v43 (T_Production_vIn43 _hdOnt) in let !(T_Productions_vOut39 _tlIallAttributes _tlX50) = inv_Productions_s24 _tlX24 K_Productions_v39 (T_Productions_vIn39 _tlOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule243 _hdIallAttributes _tlIallAttributes in let !__st_ = st50 _hdX52 _tlX50 !__result_ = T_Productions_vOut39 _lhsOallAttributes __st_ in __result_ ) in C_Productions_s24 k24 {-# NOINLINE st50 #-} st50 = \ !_hdX52 !_tlX50 -> let v40 :: T_Productions_v40 v40 = \ !(T_Productions_vIn40 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsIoptions _lhsIsynMap) -> ( let !_hdOaugmentsIn = rule248 _lhsIaugmentsIn in let !_hdOinhMap = rule250 _lhsIinhMap in let !_hdOoptions = rule253 _lhsIoptions in let !_hdOsynMap = rule254 _lhsIsynMap in let !_tlOaugmentsIn = rule255 _lhsIaugmentsIn in let !_tlOinhMap = rule257 _lhsIinhMap in let !_tlOoptions = rule260 _lhsIoptions in let !_tlOsynMap = rule261 _lhsIsynMap in let !_hdOforcedIrrefutables = rule249 _lhsIforcedIrrefutables in let !_tlOforcedIrrefutables = rule256 _lhsIforcedIrrefutables in let !(T_Production_vOut44 _hdIaugmentsOut _hdIerrors _hdIoutput) = inv_Production_s52 _hdX52 (T_Production_vIn44 _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOoptions _hdOsynMap) in let !(T_Productions_vOut40 _tlIaugmentsOut _tlIerrors _tlIoutput) = inv_Productions_s50 _tlX50 (T_Productions_vIn40 _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOoptions _tlOsynMap) in let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) !_lhsOaugmentsOut = rule244 _hdIaugmentsOut _tlIaugmentsOut in let _lhsOerrors :: Seq Error !_lhsOerrors = rule245 _hdIerrors _tlIerrors in let !_output = rule246 _hdIoutput _tlIoutput in let _lhsOoutput :: Productions !_lhsOoutput = rule247 _output in let !__result_ = T_Productions_vOut40 _lhsOaugmentsOut _lhsOerrors _lhsOoutput in __result_ ) in C_Productions_s50 v40 {-# NOINLINE[1] rule243 #-} rule243 = \ ((!_hdIallAttributes) :: AttrMap) ((!_tlIallAttributes) :: AttrMap) -> _hdIallAttributes `mergeAttributes` _tlIallAttributes {-# NOINLINE[1] rule244 #-} rule244 = \ ((!_hdIaugmentsOut) :: Map ConstructorIdent (Map Identifier [Expression])) ((!_tlIaugmentsOut) :: Map ConstructorIdent (Map Identifier [Expression])) -> _hdIaugmentsOut `Map.union` _tlIaugmentsOut {-# NOINLINE[1] rule245 #-} rule245 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# NOINLINE[1] rule246 #-} rule246 = \ ((!_hdIoutput) :: Production) ((!_tlIoutput) :: Productions) -> (:) _hdIoutput _tlIoutput {-# NOINLINE[1] rule247 #-} rule247 = \ !_output -> _output {-# NOINLINE[1] rule248 #-} rule248 = \ ((!_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> _lhsIaugmentsIn {-# NOINLINE[1] rule249 #-} rule249 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# NOINLINE[1] rule250 #-} rule250 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule252 #-} rule252 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE[1] rule253 #-} rule253 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE[1] rule254 #-} rule254 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE[1] rule255 #-} rule255 = \ ((!_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> _lhsIaugmentsIn {-# NOINLINE[1] rule256 #-} rule256 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# NOINLINE[1] rule257 #-} rule257 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# NOINLINE[1] rule259 #-} rule259 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE[1] rule260 #-} rule260 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE[1] rule261 #-} rule261 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE sem_Productions_Nil #-} sem_Productions_Nil :: T_Productions sem_Productions_Nil = T_Productions (return st24) where {-# NOINLINE st24 #-} !st24 = let k24 :: K_Productions_s24 t -> t k24 K_Productions_v12 = v12 k24 K_Productions_v25 = v25 k24 K_Productions_v39 = v39 v12 :: T_Productions_v12 v12 = \ !(T_Productions_vIn12 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule262 () in let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) !_lhsOaugmentsOut = rule263 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule264 () in let !_output = rule265 () in let _lhsOoutput :: Productions !_lhsOoutput = rule266 _output in let !__result_ = T_Productions_vOut12 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput in __result_ ) v25 :: T_Productions_v25 v25 = \ !(T_Productions_vIn25 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsInt _lhsIoptions _lhsIsynMap) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule262 () in let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) !_lhsOaugmentsOut = rule263 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule264 () in let !_output = rule265 () in let _lhsOoutput :: Productions !_lhsOoutput = rule266 _output in let !__result_ = T_Productions_vOut25 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput in __result_ ) v39 :: T_Productions_v39 v39 = \ !(T_Productions_vIn39 _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule262 () in let !__st_ = st50 () !__result_ = T_Productions_vOut39 _lhsOallAttributes __st_ in __result_ ) in C_Productions_s24 k24 {-# NOINLINE st50 #-} st50 = \ (_ :: ()) -> let v40 :: T_Productions_v40 v40 = \ !(T_Productions_vIn40 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsIoptions _lhsIsynMap) -> ( let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) !_lhsOaugmentsOut = rule263 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule264 () in let !_output = rule265 () in let _lhsOoutput :: Productions !_lhsOoutput = rule266 _output in let !__result_ = T_Productions_vOut40 _lhsOaugmentsOut _lhsOerrors _lhsOoutput in __result_ ) in C_Productions_s50 v40 {-# NOINLINE[1] rule262 #-} rule262 = \ (_ :: ()) -> Map.empty {-# NOINLINE[1] rule263 #-} rule263 = \ (_ :: ()) -> Map.empty {-# NOINLINE[1] rule264 #-} rule264 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule265 #-} rule265 = \ (_ :: ()) -> [] {-# NOINLINE[1] rule266 #-} rule266 = \ !_output -> _output -- Rule -------------------------------------------------------- -- wrapper data Inh_Rule = Inh_Rule { childInhs_Inh_Rule :: !([(Identifier, Identifier)]), childSyns_Inh_Rule :: !([(Identifier, Identifier)]), con_Inh_Rule :: !(ConstructorIdent), defs_Inh_Rule :: !(Set (Identifier, Identifier)), forcedIrrefutables_Inh_Rule :: !(AttrMap), nt_Inh_Rule :: !(NontermIdent), options_Inh_Rule :: !(Options) } data Syn_Rule = Syn_Rule { allAttributes_Syn_Rule :: !(AttrMap), defsCollect_Syn_Rule :: !(Set (Identifier, Identifier)), errors_Syn_Rule :: !(Seq Error), output_Syn_Rule :: !(Rule) } {-# INLINABLE wrap_Rule #-} wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule ) wrap_Rule !(T_Rule act) !(Inh_Rule _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg13 = T_Rule_vIn13 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions !(T_Rule_vOut13 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput) <- return (inv_Rule_s26 sem K_Rule_v13 arg13) return (Syn_Rule _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput) ) -- cata {-# INLINE sem_Rule #-} sem_Rule :: Rule -> T_Rule sem_Rule ( Rule !mbName_ pattern_ rhs_ !owrt_ !origin_ !explicit_ !pure_ !identity_ !mbError_ !eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ -- semantic domain newtype T_Rule = T_Rule { attach_T_Rule :: Identity (T_Rule_s26 ) } data T_Rule_s26 where C_Rule_s26 :: { inv_Rule_s26 :: !(forall t. K_Rule_s26 t -> t) } -> T_Rule_s26 data T_Rule_s27 = C_Rule_s27 newtype T_Rule_s48 = C_Rule_s48 { inv_Rule_s48 :: (T_Rule_v37 ) } newtype T_Rule_s57 = C_Rule_s57 { inv_Rule_s57 :: (T_Rule_v54 ) } data K_Rule_s26 k where K_Rule_v13 :: K_Rule_s26 (T_Rule_v13 ) K_Rule_v36 :: K_Rule_s26 (T_Rule_v36 ) K_Rule_v53 :: K_Rule_s26 (T_Rule_v53 ) type T_Rule_v13 = (T_Rule_vIn13 ) -> (T_Rule_vOut13 ) data T_Rule_vIn13 = T_Rule_vIn13 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) !(Options) data T_Rule_vOut13 = T_Rule_vOut13 !(AttrMap) !(Set (Identifier, Identifier)) !(Seq Error) !(Rule) type T_Rule_v36 = (T_Rule_vIn36 ) -> (T_Rule_vOut36 ) data T_Rule_vIn36 = T_Rule_vIn36 !(ConstructorIdent) !(NontermIdent) data T_Rule_vOut36 = T_Rule_vOut36 !(AttrMap) !(Set (Identifier, Identifier)) !(T_Rule_s48 ) type T_Rule_v37 = (T_Rule_vIn37 ) -> (T_Rule_vOut37 ) data T_Rule_vIn37 = T_Rule_vIn37 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(Set (Identifier, Identifier)) !(AttrMap) !(Options) data T_Rule_vOut37 = T_Rule_vOut37 !(Seq Error) !(Rule) type T_Rule_v53 = (T_Rule_vIn53 ) -> (T_Rule_vOut53 ) data T_Rule_vIn53 = T_Rule_vIn53 !(ConstructorIdent) !(NontermIdent) data T_Rule_vOut53 = T_Rule_vOut53 !(AttrMap) !(T_Rule_s57 ) type T_Rule_v54 = (T_Rule_vIn54 ) -> (T_Rule_vOut54 ) data T_Rule_vIn54 = T_Rule_vIn54 data T_Rule_vOut54 = T_Rule_vOut54 !(Set (Identifier, Identifier)) !(T_Rule_s48 ) {-# NOINLINE sem_Rule_Rule #-} sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule sem_Rule_Rule !arg_mbName_ arg_pattern_ arg_rhs_ !arg_owrt_ !arg_origin_ !arg_explicit_ !arg_pure_ !arg_identity_ !arg_mbError_ !arg_eager_ = T_Rule (return st26) where {-# NOINLINE st26 #-} !st26 = let k26 :: K_Rule_s26 t -> t k26 K_Rule_v13 = v13 k26 K_Rule_v36 = v36 k26 K_Rule_v53 = v53 v13 :: T_Rule_v13 v13 = \ !(T_Rule_vIn13 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) -> ( let !_patternX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) in let !_rhsX4 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) in let !_patternOcon = rule275 _lhsIcon in let !_patternOnt = rule278 _lhsInt in let !_patternOchildInhs = rule273 _lhsIchildInhs in let !_patternOdefs = rule276 _lhsIdefs in let !_rhsOchildInhs = rule279 _lhsIchildInhs in let !_rhsOchildSyns = rule280 _lhsIchildSyns in let !_rhsOcon = rule281 _lhsIcon in let !_rhsOnt = rule282 _lhsInt in let !_rhsOoptions = rule283 _lhsIoptions in let !_patternOforcedIrrefutables = rule277 _lhsIforcedIrrefutables in let !(T_Pattern_vOut31 _patternIallAttributes _patternIdefsCollect _patternIerrors _patternIoutput) = inv_Pattern_s18 _patternX18 K_Pattern_v31 (T_Pattern_vIn31 _patternOchildInhs _patternOcon _patternOdefs _patternOforcedIrrefutables _patternOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule268 _patternIallAttributes in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule269 _patternIdefsCollect in let !_ruleDescr = rule267 _lhsIcon _lhsInt _patternIdefsCollect in let !_rhsOruleDescr = rule284 _ruleDescr in let !(T_Expression_vOut2 _rhsIerrors _rhsIoutput) = inv_Expression_s4 _rhsX4 (T_Expression_vIn2 _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule270 _patternIerrors _rhsIerrors in let !_output = rule271 _patternIoutput _rhsIoutput arg_eager_ arg_explicit_ arg_identity_ arg_mbError_ arg_mbName_ arg_origin_ arg_owrt_ arg_pure_ in let _lhsOoutput :: Rule !_lhsOoutput = rule272 _output in let !__result_ = T_Rule_vOut13 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v36 :: T_Rule_v36 v36 = \ !(T_Rule_vIn36 _lhsIcon _lhsInt) -> ( let !_patternX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) in let !_patternOcon = rule275 _lhsIcon in let !_patternOnt = rule278 _lhsInt in let !(T_Pattern_vOut41 _patternIallAttributes _patternIdefsCollect _patternX51) = inv_Pattern_s18 _patternX18 K_Pattern_v41 (T_Pattern_vIn41 _patternOcon _patternOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule268 _patternIallAttributes in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule269 _patternIdefsCollect in let !__st_ = st48 _lhsIcon _lhsInt _patternIdefsCollect _patternX51 !__result_ = T_Rule_vOut36 _lhsOallAttributes _lhsOdefsCollect __st_ in __result_ ) v53 :: T_Rule_v53 v53 = \ !(T_Rule_vIn53 _lhsIcon _lhsInt) -> ( let !_patternX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) in let !_patternOcon = rule275 _lhsIcon in let !_patternOnt = rule278 _lhsInt in let !(T_Pattern_vOut55 _patternIallAttributes _patternX58) = inv_Pattern_s18 _patternX18 K_Pattern_v55 (T_Pattern_vIn55 _patternOcon _patternOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule268 _patternIallAttributes in let !__st_ = st57 _lhsIcon _lhsInt _patternX58 !__result_ = T_Rule_vOut53 _lhsOallAttributes __st_ in __result_ ) in C_Rule_s26 k26 {-# NOINLINE st48 #-} st48 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) ((!_patternIdefsCollect) :: Set (Identifier, Identifier)) !_patternX51 -> let v37 :: T_Rule_v37 v37 = \ !(T_Rule_vIn37 _lhsIchildInhs _lhsIchildSyns _lhsIdefs _lhsIforcedIrrefutables _lhsIoptions) -> ( let !_rhsOcon = rule281 _lhsIcon in let !_rhsOnt = rule282 _lhsInt in let !_ruleDescr = rule267 _lhsIcon _lhsInt _patternIdefsCollect in let !_rhsX4 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) in let !_patternOchildInhs = rule273 _lhsIchildInhs in let !_patternOdefs = rule276 _lhsIdefs in let !_rhsOchildInhs = rule279 _lhsIchildInhs in let !_rhsOchildSyns = rule280 _lhsIchildSyns in let !_rhsOoptions = rule283 _lhsIoptions in let !_rhsOruleDescr = rule284 _ruleDescr in let !_patternOforcedIrrefutables = rule277 _lhsIforcedIrrefutables in let !(T_Pattern_vOut42 _patternIerrors _patternIoutput) = inv_Pattern_s51 _patternX51 (T_Pattern_vIn42 _patternOchildInhs _patternOdefs _patternOforcedIrrefutables) in let !(T_Expression_vOut2 _rhsIerrors _rhsIoutput) = inv_Expression_s4 _rhsX4 (T_Expression_vIn2 _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule270 _patternIerrors _rhsIerrors in let !_output = rule271 _patternIoutput _rhsIoutput arg_eager_ arg_explicit_ arg_identity_ arg_mbError_ arg_mbName_ arg_origin_ arg_owrt_ arg_pure_ in let _lhsOoutput :: Rule !_lhsOoutput = rule272 _output in let !__result_ = T_Rule_vOut37 _lhsOerrors _lhsOoutput in __result_ ) in C_Rule_s48 v37 {-# NOINLINE st57 #-} st57 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) !_patternX58 -> let v54 :: T_Rule_v54 v54 = \ !(T_Rule_vIn54 ) -> ( let !(T_Pattern_vOut56 _patternIdefsCollect _patternX51) = inv_Pattern_s58 _patternX58 (T_Pattern_vIn56 ) in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule269 _patternIdefsCollect in let !__st_ = st48 _lhsIcon _lhsInt _patternIdefsCollect _patternX51 !__result_ = T_Rule_vOut54 _lhsOdefsCollect __st_ in __result_ ) in C_Rule_s57 v54 {-# NOINLINE[1] rule267 #-} {-# LINE 172 "src-ag/Desugar.ag" #-} rule267 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) ((!_patternIdefsCollect) :: Set (Identifier, Identifier)) -> {-# LINE 172 "src-ag/Desugar.ag" #-} show _lhsInt ++ " :: " ++ show _lhsIcon ++ " :: " ++ (concat $ intersperse "," $ map (\(f,a) -> show f ++ "." ++ show a) $ Set.toList _patternIdefsCollect) {-# LINE 4003 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule268 #-} rule268 = \ ((!_patternIallAttributes) :: AttrMap) -> _patternIallAttributes {-# NOINLINE[1] rule269 #-} rule269 = \ ((!_patternIdefsCollect) :: Set (Identifier, Identifier)) -> _patternIdefsCollect {-# NOINLINE[1] rule270 #-} rule270 = \ ((!_patternIerrors) :: Seq Error) ((!_rhsIerrors) :: Seq Error) -> _patternIerrors Seq.>< _rhsIerrors {-# NOINLINE[1] rule271 #-} rule271 = \ ((!_patternIoutput) :: Pattern) ((!_rhsIoutput) :: Expression) !eager_ !explicit_ !identity_ !mbError_ !mbName_ !origin_ !owrt_ !pure_ -> Rule mbName_ _patternIoutput _rhsIoutput owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ {-# NOINLINE[1] rule272 #-} rule272 = \ !_output -> _output {-# NOINLINE[1] rule273 #-} rule273 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> _lhsIchildInhs {-# NOINLINE[1] rule275 #-} rule275 = \ ((!_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# NOINLINE[1] rule276 #-} rule276 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> _lhsIdefs {-# NOINLINE[1] rule277 #-} rule277 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# NOINLINE[1] rule278 #-} rule278 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE[1] rule279 #-} rule279 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> _lhsIchildInhs {-# NOINLINE[1] rule280 #-} rule280 = \ ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) -> _lhsIchildSyns {-# NOINLINE[1] rule281 #-} rule281 = \ ((!_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# NOINLINE[1] rule282 #-} rule282 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE[1] rule283 #-} rule283 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE[1] rule284 #-} rule284 = \ !_ruleDescr -> _ruleDescr -- Rules ------------------------------------------------------- -- wrapper data Inh_Rules = Inh_Rules { childInhs_Inh_Rules :: !([(Identifier, Identifier)]), childSyns_Inh_Rules :: !([(Identifier, Identifier)]), con_Inh_Rules :: !(ConstructorIdent), defs_Inh_Rules :: !(Set (Identifier, Identifier)), forcedIrrefutables_Inh_Rules :: !(AttrMap), nt_Inh_Rules :: !(NontermIdent), options_Inh_Rules :: !(Options) } data Syn_Rules = Syn_Rules { allAttributes_Syn_Rules :: !(AttrMap), defsCollect_Syn_Rules :: !(Set (Identifier, Identifier)), errors_Syn_Rules :: !(Seq Error), output_Syn_Rules :: !(Rules) } {-# INLINABLE wrap_Rules #-} wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules ) wrap_Rules !(T_Rules act) !(Inh_Rules _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg14 = T_Rules_vIn14 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions !(T_Rules_vOut14 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput) <- return (inv_Rules_s28 sem K_Rules_v14 arg14) return (Syn_Rules _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput) ) -- cata {-# NOINLINE sem_Rules #-} sem_Rules :: Rules -> T_Rules sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) -- semantic domain newtype T_Rules = T_Rules { attach_T_Rules :: Identity (T_Rules_s28 ) } data T_Rules_s28 where C_Rules_s28 :: { inv_Rules_s28 :: !(forall t. K_Rules_s28 t -> t) } -> T_Rules_s28 data T_Rules_s29 = C_Rules_s29 newtype T_Rules_s43 = C_Rules_s43 { inv_Rules_s43 :: (T_Rules_v29 ) } newtype T_Rules_s55 = C_Rules_s55 { inv_Rules_s55 :: (T_Rules_v50 ) } data K_Rules_s28 k where K_Rules_v14 :: K_Rules_s28 (T_Rules_v14 ) K_Rules_v28 :: K_Rules_s28 (T_Rules_v28 ) K_Rules_v49 :: K_Rules_s28 (T_Rules_v49 ) type T_Rules_v14 = (T_Rules_vIn14 ) -> (T_Rules_vOut14 ) data T_Rules_vIn14 = T_Rules_vIn14 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) !(Options) data T_Rules_vOut14 = T_Rules_vOut14 !(AttrMap) !(Set (Identifier, Identifier)) !(Seq Error) !(Rules) type T_Rules_v28 = (T_Rules_vIn28 ) -> (T_Rules_vOut28 ) data T_Rules_vIn28 = T_Rules_vIn28 !(ConstructorIdent) !(NontermIdent) data T_Rules_vOut28 = T_Rules_vOut28 !(AttrMap) !(Set (Identifier, Identifier)) !(T_Rules_s43 ) type T_Rules_v29 = (T_Rules_vIn29 ) -> (T_Rules_vOut29 ) data T_Rules_vIn29 = T_Rules_vIn29 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(Set (Identifier, Identifier)) !(AttrMap) !(Options) data T_Rules_vOut29 = T_Rules_vOut29 !(Seq Error) !(Rules) type T_Rules_v49 = (T_Rules_vIn49 ) -> (T_Rules_vOut49 ) data T_Rules_vIn49 = T_Rules_vIn49 !(ConstructorIdent) !(NontermIdent) data T_Rules_vOut49 = T_Rules_vOut49 !(AttrMap) !(T_Rules_s55 ) type T_Rules_v50 = (T_Rules_vIn50 ) -> (T_Rules_vOut50 ) data T_Rules_vIn50 = T_Rules_vIn50 data T_Rules_vOut50 = T_Rules_vOut50 !(Set (Identifier, Identifier)) !(T_Rules_s43 ) {-# NOINLINE sem_Rules_Cons #-} sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st28) where {-# NOINLINE st28 #-} !st28 = let k28 :: K_Rules_s28 t -> t k28 K_Rules_v14 = v14 k28 K_Rules_v28 = v28 k28 K_Rules_v49 = v49 v14 :: T_Rules_v14 v14 = \ !(T_Rules_vIn14 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) -> ( let !_hdX26 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) in let !_tlX28 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) in let !_hdOcon = rule292 _lhsIcon in let !_hdOnt = rule295 _lhsInt in let !_tlOcon = rule299 _lhsIcon in let !_tlOnt = rule302 _lhsInt in let !_hdOchildInhs = rule290 _lhsIchildInhs in let !_hdOchildSyns = rule291 _lhsIchildSyns in let !_hdOdefs = rule293 _lhsIdefs in let !_hdOoptions = rule296 _lhsIoptions in let !_tlOchildInhs = rule297 _lhsIchildInhs in let !_tlOchildSyns = rule298 _lhsIchildSyns in let !_tlOdefs = rule300 _lhsIdefs in let !_tlOoptions = rule303 _lhsIoptions in let !_hdOforcedIrrefutables = rule294 _lhsIforcedIrrefutables in let !_tlOforcedIrrefutables = rule301 _lhsIforcedIrrefutables in let !(T_Rule_vOut13 _hdIallAttributes _hdIdefsCollect _hdIerrors _hdIoutput) = inv_Rule_s26 _hdX26 K_Rule_v13 (T_Rule_vIn13 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt _hdOoptions) in let !(T_Rules_vOut14 _tlIallAttributes _tlIdefsCollect _tlIerrors _tlIoutput) = inv_Rules_s28 _tlX28 K_Rules_v14 (T_Rules_vIn14 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt _tlOoptions) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule285 _hdIallAttributes _tlIallAttributes in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule286 _hdIdefsCollect _tlIdefsCollect in let _lhsOerrors :: Seq Error !_lhsOerrors = rule287 _hdIerrors _tlIerrors in let !_output = rule288 _hdIoutput _tlIoutput in let _lhsOoutput :: Rules !_lhsOoutput = rule289 _output in let !__result_ = T_Rules_vOut14 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v28 :: T_Rules_v28 v28 = \ !(T_Rules_vIn28 _lhsIcon _lhsInt) -> ( let !_hdX26 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) in let !_tlX28 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) in let !_hdOcon = rule292 _lhsIcon in let !_hdOnt = rule295 _lhsInt in let !_tlOcon = rule299 _lhsIcon in let !_tlOnt = rule302 _lhsInt in let !(T_Rule_vOut36 _hdIallAttributes _hdIdefsCollect _hdX48) = inv_Rule_s26 _hdX26 K_Rule_v36 (T_Rule_vIn36 _hdOcon _hdOnt) in let !(T_Rules_vOut28 _tlIallAttributes _tlIdefsCollect _tlX43) = inv_Rules_s28 _tlX28 K_Rules_v28 (T_Rules_vIn28 _tlOcon _tlOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule285 _hdIallAttributes _tlIallAttributes in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule286 _hdIdefsCollect _tlIdefsCollect in let !__st_ = st43 _hdX48 _tlX43 !__result_ = T_Rules_vOut28 _lhsOallAttributes _lhsOdefsCollect __st_ in __result_ ) v49 :: T_Rules_v49 v49 = \ !(T_Rules_vIn49 _lhsIcon _lhsInt) -> ( let !_hdX26 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) in let !_tlX28 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) in let !_hdOcon = rule292 _lhsIcon in let !_hdOnt = rule295 _lhsInt in let !_tlOcon = rule299 _lhsIcon in let !_tlOnt = rule302 _lhsInt in let !(T_Rule_vOut53 _hdIallAttributes _hdX57) = inv_Rule_s26 _hdX26 K_Rule_v53 (T_Rule_vIn53 _hdOcon _hdOnt) in let !(T_Rules_vOut49 _tlIallAttributes _tlX55) = inv_Rules_s28 _tlX28 K_Rules_v49 (T_Rules_vIn49 _tlOcon _tlOnt) in let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule285 _hdIallAttributes _tlIallAttributes in let !__st_ = st55 _hdX57 _tlX55 !__result_ = T_Rules_vOut49 _lhsOallAttributes __st_ in __result_ ) in C_Rules_s28 k28 {-# NOINLINE st43 #-} st43 = \ !_hdX48 !_tlX43 -> let v29 :: T_Rules_v29 v29 = \ !(T_Rules_vIn29 _lhsIchildInhs _lhsIchildSyns _lhsIdefs _lhsIforcedIrrefutables _lhsIoptions) -> ( let !_hdOchildInhs = rule290 _lhsIchildInhs in let !_hdOchildSyns = rule291 _lhsIchildSyns in let !_hdOdefs = rule293 _lhsIdefs in let !_hdOoptions = rule296 _lhsIoptions in let !_tlOchildInhs = rule297 _lhsIchildInhs in let !_tlOchildSyns = rule298 _lhsIchildSyns in let !_tlOdefs = rule300 _lhsIdefs in let !_tlOoptions = rule303 _lhsIoptions in let !_hdOforcedIrrefutables = rule294 _lhsIforcedIrrefutables in let !_tlOforcedIrrefutables = rule301 _lhsIforcedIrrefutables in let !(T_Rule_vOut37 _hdIerrors _hdIoutput) = inv_Rule_s48 _hdX48 (T_Rule_vIn37 _hdOchildInhs _hdOchildSyns _hdOdefs _hdOforcedIrrefutables _hdOoptions) in let !(T_Rules_vOut29 _tlIerrors _tlIoutput) = inv_Rules_s43 _tlX43 (T_Rules_vIn29 _tlOchildInhs _tlOchildSyns _tlOdefs _tlOforcedIrrefutables _tlOoptions) in let _lhsOerrors :: Seq Error !_lhsOerrors = rule287 _hdIerrors _tlIerrors in let !_output = rule288 _hdIoutput _tlIoutput in let _lhsOoutput :: Rules !_lhsOoutput = rule289 _output in let !__result_ = T_Rules_vOut29 _lhsOerrors _lhsOoutput in __result_ ) in C_Rules_s43 v29 {-# NOINLINE st55 #-} st55 = \ !_hdX57 !_tlX55 -> let v50 :: T_Rules_v50 v50 = \ !(T_Rules_vIn50 ) -> ( let !(T_Rule_vOut54 _hdIdefsCollect _hdX48) = inv_Rule_s57 _hdX57 (T_Rule_vIn54 ) in let !(T_Rules_vOut50 _tlIdefsCollect _tlX43) = inv_Rules_s55 _tlX55 (T_Rules_vIn50 ) in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule286 _hdIdefsCollect _tlIdefsCollect in let !__st_ = st43 _hdX48 _tlX43 !__result_ = T_Rules_vOut50 _lhsOdefsCollect __st_ in __result_ ) in C_Rules_s55 v50 {-# NOINLINE[1] rule285 #-} rule285 = \ ((!_hdIallAttributes) :: AttrMap) ((!_tlIallAttributes) :: AttrMap) -> _hdIallAttributes `mergeAttributes` _tlIallAttributes {-# NOINLINE[1] rule286 #-} rule286 = \ ((!_hdIdefsCollect) :: Set (Identifier, Identifier)) ((!_tlIdefsCollect) :: Set (Identifier, Identifier)) -> _hdIdefsCollect `Set.union` _tlIdefsCollect {-# NOINLINE[1] rule287 #-} rule287 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# NOINLINE[1] rule288 #-} rule288 = \ ((!_hdIoutput) :: Rule) ((!_tlIoutput) :: Rules) -> (:) _hdIoutput _tlIoutput {-# NOINLINE[1] rule289 #-} rule289 = \ !_output -> _output {-# NOINLINE[1] rule290 #-} rule290 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> _lhsIchildInhs {-# NOINLINE[1] rule291 #-} rule291 = \ ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) -> _lhsIchildSyns {-# NOINLINE[1] rule292 #-} rule292 = \ ((!_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# NOINLINE[1] rule293 #-} rule293 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> _lhsIdefs {-# NOINLINE[1] rule294 #-} rule294 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# NOINLINE[1] rule295 #-} rule295 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE[1] rule296 #-} rule296 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE[1] rule297 #-} rule297 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> _lhsIchildInhs {-# NOINLINE[1] rule298 #-} rule298 = \ ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) -> _lhsIchildSyns {-# NOINLINE[1] rule299 #-} rule299 = \ ((!_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# NOINLINE[1] rule300 #-} rule300 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> _lhsIdefs {-# NOINLINE[1] rule301 #-} rule301 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> _lhsIforcedIrrefutables {-# NOINLINE[1] rule302 #-} rule302 = \ ((!_lhsInt) :: NontermIdent) -> _lhsInt {-# NOINLINE[1] rule303 #-} rule303 = \ ((!_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Rules_Nil #-} sem_Rules_Nil :: T_Rules sem_Rules_Nil = T_Rules (return st28) where {-# NOINLINE st28 #-} !st28 = let k28 :: K_Rules_s28 t -> t k28 K_Rules_v14 = v14 k28 K_Rules_v28 = v28 k28 K_Rules_v49 = v49 v14 :: T_Rules_v14 v14 = \ !(T_Rules_vIn14 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule304 () in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule305 () in let _lhsOerrors :: Seq Error !_lhsOerrors = rule306 () in let !_output = rule307 () in let _lhsOoutput :: Rules !_lhsOoutput = rule308 _output in let !__result_ = T_Rules_vOut14 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput in __result_ ) v28 :: T_Rules_v28 v28 = \ !(T_Rules_vIn28 _lhsIcon _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule304 () in let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule305 () in let !__st_ = st43 () !__result_ = T_Rules_vOut28 _lhsOallAttributes _lhsOdefsCollect __st_ in __result_ ) v49 :: T_Rules_v49 v49 = \ !(T_Rules_vIn49 _lhsIcon _lhsInt) -> ( let _lhsOallAttributes :: AttrMap !_lhsOallAttributes = rule304 () in let !__st_ = st55 () !__result_ = T_Rules_vOut49 _lhsOallAttributes __st_ in __result_ ) in C_Rules_s28 k28 {-# NOINLINE st43 #-} st43 = \ (_ :: ()) -> let v29 :: T_Rules_v29 v29 = \ !(T_Rules_vIn29 _lhsIchildInhs _lhsIchildSyns _lhsIdefs _lhsIforcedIrrefutables _lhsIoptions) -> ( let _lhsOerrors :: Seq Error !_lhsOerrors = rule306 () in let !_output = rule307 () in let _lhsOoutput :: Rules !_lhsOoutput = rule308 _output in let !__result_ = T_Rules_vOut29 _lhsOerrors _lhsOoutput in __result_ ) in C_Rules_s43 v29 {-# NOINLINE st55 #-} st55 = \ (_ :: ()) -> let v50 :: T_Rules_v50 v50 = \ !(T_Rules_vIn50 ) -> ( let _lhsOdefsCollect :: Set (Identifier, Identifier) !_lhsOdefsCollect = rule305 () in let !__st_ = st43 () !__result_ = T_Rules_vOut50 _lhsOdefsCollect __st_ in __result_ ) in C_Rules_s55 v50 {-# NOINLINE[1] rule304 #-} rule304 = \ (_ :: ()) -> Map.empty {-# NOINLINE[1] rule305 #-} rule305 = \ (_ :: ()) -> Set.empty {-# NOINLINE[1] rule306 #-} rule306 = \ (_ :: ()) -> Seq.empty {-# NOINLINE[1] rule307 #-} rule307 = \ (_ :: ()) -> [] {-# NOINLINE[1] rule308 #-} rule308 = \ !_output -> _output -- TypeSig ----------------------------------------------------- -- wrapper data Inh_TypeSig = Inh_TypeSig { } data Syn_TypeSig = Syn_TypeSig { output_Syn_TypeSig :: !(TypeSig) } {-# INLINABLE wrap_TypeSig #-} wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig ) wrap_TypeSig !(T_TypeSig act) !(Inh_TypeSig ) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg15 = T_TypeSig_vIn15 !(T_TypeSig_vOut15 _lhsOoutput) <- return (inv_TypeSig_s30 sem arg15) return (Syn_TypeSig _lhsOoutput) ) -- cata {-# INLINE sem_TypeSig #-} sem_TypeSig :: TypeSig -> T_TypeSig sem_TypeSig ( TypeSig !name_ !tp_ ) = sem_TypeSig_TypeSig name_ tp_ -- semantic domain newtype T_TypeSig = T_TypeSig { attach_T_TypeSig :: Identity (T_TypeSig_s30 ) } newtype T_TypeSig_s30 = C_TypeSig_s30 { inv_TypeSig_s30 :: (T_TypeSig_v15 ) } data T_TypeSig_s31 = C_TypeSig_s31 type T_TypeSig_v15 = (T_TypeSig_vIn15 ) -> (T_TypeSig_vOut15 ) data T_TypeSig_vIn15 = T_TypeSig_vIn15 data T_TypeSig_vOut15 = T_TypeSig_vOut15 !(TypeSig) {-# NOINLINE sem_TypeSig_TypeSig #-} sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig sem_TypeSig_TypeSig !arg_name_ !arg_tp_ = T_TypeSig (return st30) where {-# NOINLINE st30 #-} !st30 = let v15 :: T_TypeSig_v15 v15 = \ !(T_TypeSig_vIn15 ) -> ( let !_output = rule309 arg_name_ arg_tp_ in let _lhsOoutput :: TypeSig !_lhsOoutput = rule310 _output in let !__result_ = T_TypeSig_vOut15 _lhsOoutput in __result_ ) in C_TypeSig_s30 v15 {-# INLINE rule309 #-} rule309 = \ !name_ !tp_ -> TypeSig name_ tp_ {-# INLINE rule310 #-} rule310 = \ !_output -> _output -- TypeSigs ---------------------------------------------------- -- wrapper data Inh_TypeSigs = Inh_TypeSigs { } data Syn_TypeSigs = Syn_TypeSigs { output_Syn_TypeSigs :: !(TypeSigs) } {-# INLINABLE wrap_TypeSigs #-} wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs ) wrap_TypeSigs !(T_TypeSigs act) !(Inh_TypeSigs ) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg16 = T_TypeSigs_vIn16 !(T_TypeSigs_vOut16 _lhsOoutput) <- return (inv_TypeSigs_s32 sem arg16) return (Syn_TypeSigs _lhsOoutput) ) -- cata {-# NOINLINE sem_TypeSigs #-} sem_TypeSigs :: TypeSigs -> T_TypeSigs sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) -- semantic domain newtype T_TypeSigs = T_TypeSigs { attach_T_TypeSigs :: Identity (T_TypeSigs_s32 ) } newtype T_TypeSigs_s32 = C_TypeSigs_s32 { inv_TypeSigs_s32 :: (T_TypeSigs_v16 ) } data T_TypeSigs_s33 = C_TypeSigs_s33 type T_TypeSigs_v16 = (T_TypeSigs_vIn16 ) -> (T_TypeSigs_vOut16 ) data T_TypeSigs_vIn16 = T_TypeSigs_vIn16 data T_TypeSigs_vOut16 = T_TypeSigs_vOut16 !(TypeSigs) {-# NOINLINE sem_TypeSigs_Cons #-} sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st32) where {-# NOINLINE st32 #-} !st32 = let v16 :: T_TypeSigs_v16 v16 = \ !(T_TypeSigs_vIn16 ) -> ( let !_hdX30 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_)) in let !_tlX32 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_)) in let !(T_TypeSig_vOut15 _hdIoutput) = inv_TypeSig_s30 _hdX30 (T_TypeSig_vIn15 ) in let !(T_TypeSigs_vOut16 _tlIoutput) = inv_TypeSigs_s32 _tlX32 (T_TypeSigs_vIn16 ) in let !_output = rule311 _hdIoutput _tlIoutput in let _lhsOoutput :: TypeSigs !_lhsOoutput = rule312 _output in let !__result_ = T_TypeSigs_vOut16 _lhsOoutput in __result_ ) in C_TypeSigs_s32 v16 {-# INLINE rule311 #-} rule311 = \ ((!_hdIoutput) :: TypeSig) ((!_tlIoutput) :: TypeSigs) -> (:) _hdIoutput _tlIoutput {-# INLINE rule312 #-} rule312 = \ !_output -> _output {-# NOINLINE sem_TypeSigs_Nil #-} sem_TypeSigs_Nil :: T_TypeSigs sem_TypeSigs_Nil = T_TypeSigs (return st32) where {-# NOINLINE st32 #-} !st32 = let v16 :: T_TypeSigs_v16 v16 = \ !(T_TypeSigs_vIn16 ) -> ( let !_output = rule313 () in let _lhsOoutput :: TypeSigs !_lhsOoutput = rule314 _output in let !__result_ = T_TypeSigs_vOut16 _lhsOoutput in __result_ ) in C_TypeSigs_s32 v16 {-# INLINE rule313 #-} rule313 = \ (_ :: ()) -> [] {-# INLINE rule314 #-} rule314 = \ !_output -> _output uuagc-0.9.52.2/src-generated/ExecutionPlan2Clean.hs0000644000000000000000000147137613433540502020145 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module ExecutionPlan2Clean where {-# LINE 2 "src-ag/HsToken.ag" #-} import CommonTypes import UU.Scanner.Position(Pos) {-# LINE 10 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 2 "src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken {-# LINE 16 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 23 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 2 "src-ag/ExecutionPlan.ag" #-} -- VisitSyntax.ag imports import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import CommonTypes import ErrorMessages import qualified Data.Set as Set import Data.Set(Set) import qualified Data.Map as Map import Data.Map(Map) {-# LINE 37 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 7 "src-ag/ExecutionPlan2Clean.ag" #-} import ExecutionPlan import Pretty import PPUtil import Options import Data.Monoid(mappend,mempty) import Data.Maybe import Debug.Trace import System.IO import System.Directory import System.FilePath import UU.Scanner.Position import TokenDef import HsToken import ErrorMessages import Data.Set (Set) import qualified Data.Set as Set import Data.Map (Map) import qualified Data.Map as Map import Data.Sequence(Seq) import qualified Data.Sequence as Seq import Data.Foldable(toList) {-# LINE 64 "dist/build/ExecutionPlan2Clean.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 190 "src-ag/ExecutionPlan2Clean.ag" #-} classCtxsToDocs :: ClassContext -> [PP_Doc] classCtxsToDocs = map toDoc where toDoc (ident,args) = (ident >#< ppSpaced (map pp_parens args)) classConstrsToDocs :: [Type] -> [PP_Doc] classConstrsToDocs = map ppTp ppClasses :: [PP_Doc] -> PP_Doc ppClasses [] = empty ppClasses xs = "|" >#< pp_block "" "" "&" xs ppQuants :: [Identifier] -> PP_Doc ppQuants [] = empty ppQuants ps = "E." >#< ppSpaced ps >#< ":" {-# LINE 83 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 227 "src-ag/ExecutionPlan2Clean.ag" #-} -- first parameter indicates: generate a record or not ppConFields :: Bool -> [PP_Doc] -> PP_Doc ppConFields True flds = ppListSep "{" "}" ", " flds ppConFields False flds = ppSpaced flds {-# LINE 91 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 260 "src-ag/ExecutionPlan2Clean.ag" #-} ppTp :: Type -> PP_Doc ppTp = text . typeToHaskellString Nothing [] {-# LINE 97 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 333 "src-ag/ExecutionPlan2Clean.ag" #-} isRecordConstructor :: NontermIdent -> Map NontermIdent ConstructorType -> Bool isRecordConstructor nt ctm = Map.lookup nt ctm == Just RecordConstructor {-# LINE 103 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 374 "src-ag/ExecutionPlan2Clean.ag" #-} type VisitStateState = (VisitIdentifier,StateIdentifier, StateIdentifier) {-# LINE 107 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 483 "src-ag/ExecutionPlan2Clean.ag" #-} conNmTVisit nt vId = "T_" >|< nt >|< "_v" >|< vId conNmTVisitIn nt vId = "T_" >|< nt >|< "_vIn" >|< vId conNmTVisitOut nt vId = "T_" >|< nt >|< "_vOut" >|< vId conNmTNextVisit nt stId = "T_" >|< nt >|< "_s" >|< stId ppMonadType :: Options -> PP_Doc ppMonadType opts | parallelInvoke opts = text "IO" | otherwise = text "Identity" {-# LINE 120 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 652 "src-ag/ExecutionPlan2Clean.ag" #-} ppDefor :: Type -> PP_Doc ppDefor (NT nt args _) = "T_" >|< nt >#< ppSpaced (map pp_parens args) ppDefor (Haskell s) = text s {-# LINE 127 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 756 "src-ag/ExecutionPlan2Clean.ag" #-} mklet :: (PP a, PP b, PP c) => a -> b -> c -> PP_Doc mklet prefix defs body = prefix >-< indent (length (show prefix)) ("let" >-< indent 4 defs >-< "in" >#< body) {-# LINE 138 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 817 "src-ag/ExecutionPlan2Clean.ag" #-} resultValName :: String resultValName = "ag__result_" nextStName :: String nextStName = "ag__st_" {-# LINE 147 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 878 "src-ag/ExecutionPlan2Clean.ag" #-} parResultName :: String parResultName = "__outcome_" fmtDecl :: PP a => Bool -> FormatMode -> a -> PP_Doc fmtDecl declPure fmt decl = case fmt of FormatLetDecl -> pp decl FormatLetLine -> "let" >#< decl >#< "in" FormatDo | declPure -> "let" >#< decl >#< "in" | otherwise -> pp decl {-# LINE 160 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 992 "src-ag/ExecutionPlan2Clean.ag" #-} stname :: Identifier -> Int -> String stname child st = "st_" ++ getName child ++ "X" ++ show st -- should actually return some conversion info compatibleAttach :: VisitKind -> NontermIdent -> Options -> Bool compatibleAttach _ _ _ = True unMon :: Options -> PP_Doc unMon options | parallelInvoke options = text "'System.IO.Unsafe'.unsafePerformIO" -- IO monad | otherwise = text "'Control.Monad.Identity'.runIdentity" -- identity monad {-# LINE 175 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 1079 "src-ag/ExecutionPlan2Clean.ag" #-} dummyPat :: Options -> Bool -> PP_Doc dummyPat opts noArgs | not noArgs && tupleAsDummyToken opts = empty -- no unnecessary tuples | tupleAsDummyToken opts = if strictDummyToken opts then text "Void" else text "(_)" | otherwise = let match | strictDummyToken opts = "!_" | otherwise = "_" in pp_parens (match >#< "::" >#< dummyType opts noArgs) where match | strictDummyToken opts = "(!_)" | otherwise = "_" dummyArg :: Options -> Bool -> PP_Doc dummyArg opts noArgs | not noArgs && tupleAsDummyToken opts = empty -- no unnecessary tuples | tupleAsDummyToken opts = text "Void" | otherwise = text "GHC.Prim.realWorld#" dummyType :: Options -> Bool -> PP_Doc dummyType opts noArgs | not noArgs && tupleAsDummyToken opts = empty -- no unnecessary tuples | tupleAsDummyToken opts = text "Void" | otherwise = text "(GHC.Prim.State# GHC.Prim.RealWorld)" {-# LINE 202 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 1105 "src-ag/ExecutionPlan2Clean.ag" #-} -- rules are "deinlined" to prevent needless code duplication. -- if there is only a bit of duplication, we allow ghc to decide if it is worth it. -- if the duplication crosses this threshold, however, we tell ghc definitely not to inline it. ruleInlineThresholdSoft :: Int ruleInlineThresholdSoft = 3 ruleInlineThresholdHard :: Int ruleInlineThresholdHard = 5 reallyOftenUsedThreshold :: Int reallyOftenUsedThreshold = 12 {-# LINE 217 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 1172 "src-ag/ExecutionPlan2Clean.ag" #-} data NonLocalAttr = AttrInh Identifier Identifier | AttrSyn Identifier Identifier deriving Show mkNonLocalAttr :: Bool -> Identifier -> Identifier -> NonLocalAttr mkNonLocalAttr True = AttrInh -- True: inherited attr mkNonLocalAttr False = AttrSyn lookupAttrType :: NonLocalAttr -> Map Identifier Attributes -> Map Identifier Attributes -> Map Identifier Type -> Maybe PP_Doc lookupAttrType (AttrInh child name) inhs _ = lookupType child name inhs lookupAttrType (AttrSyn child name) _ syns = lookupType child name syns -- Note: if the child takes type parameters, the type of an attribute of this child may refer to these parameters. This means that -- the actual type of the attribute needs to have its type parameters substituted with the actual type argument of the child. -- However, for now we simply decide to return Nothing in this case, which skips the type annotation. lookupType :: Identifier -> Identifier -> Map Identifier Attributes -> Map Identifier Type -> Maybe PP_Doc lookupType child name attrMp childMp | noParameters childTp = Just ppDoc | otherwise = Nothing where attrTp = Map.findWithDefault (error "lookupType: the attribute is not in the attrs of the child") name childAttrs childAttrs = Map.findWithDefault (error "lookupType: the attributes of the nonterm are not in the map") nonterm attrMp nonterm = extractNonterminal childTp childTp = Map.findWithDefault (error ("lookupType: the child " ++ show child ++ "is not in the appropriate map")) child childMp ppDoc = ppTp attrTp noParameters :: Type -> Bool noParameters (Haskell _) = True noParameters (NT _ args _) = null args {-# LINE 250 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 1259 "src-ag/ExecutionPlan2Clean.ag" #-} -- a `compatibleKind` b means: can kind b be invoked from a compatibleKind :: VisitKind -> VisitKind -> Bool compatibleKind _ _ = True compatibleRule :: VisitKind -> Bool -> Bool compatibleRule (VisitPure _) False = False compatibleRule _ _ = True {-# LINE 261 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 1281 "src-ag/ExecutionPlan2Clean.ag" #-} unionWithSum = Map.unionWith (+) {-# LINE 266 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 1304 "src-ag/ExecutionPlan2Clean.ag" #-} uwSetUnion :: (Ord a, Ord b) => Map a (Set b) -> Map a (Set b) -> Map a (Set b) uwSetUnion = Map.unionWith Set.union uwMapUnion :: (Ord a, Ord b) => Map a (Map b c) -> Map a (Map b c) -> Map a (Map b c) uwMapUnion = Map.unionWith Map.union {-# LINE 275 "dist/build/ExecutionPlan2Clean.hs" #-} {-# LINE 1499 "src-ag/ExecutionPlan2Clean.ag" #-} renderDocs :: [PP_Doc] -> String renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) "" writeModule :: FilePath -> [PP_Doc] -> IO () writeModule path docs = do bExists <- doesFileExist path if bExists then do input <- readFile path seq (length input) (return ()) if input /= output then dumpIt else return () else dumpIt where output = renderDocs docs dumpIt = writeFile path output cleanIclModuleHeader :: Options -> String -> String cleanIclModuleHeader flags input = case moduleName flags of Name nm -> genMod nm Default -> genMod (defaultModuleName input) NoName -> "" where genMod x = "implementation module " ++ x cleanDclModuleHeader :: Options -> String -> Maybe String -> String cleanDclModuleHeader flags input export = case moduleName flags of Name nm -> genMod nm Default -> genMod (defaultModuleName input) NoName -> "" where genMod x = "definition module " ++ x ++ genExp export x genExp Nothing _ = "" genExp (Just e) x = "(module " ++ x ++ ", module " ++ e ++ ")" defaultModuleName :: String -> String defaultModuleName = dropExtension mkIclModuleHeader :: Maybe (String,String,String) -> String -> String -> String -> Bool -> String mkIclModuleHeader Nothing defaultName suffix _ _ = "implementation module " ++ defaultName ++ suffix mkIclModuleHeader (Just (name, exports, imports)) _ suffix addExports replaceExports = "implementation module " ++ name ++ suffix ++ "\n" ++ imports ++ "\n" mkDclModuleHeader :: Maybe (String,String,String) -> String -> String -> String -> Bool -> String mkDclModuleHeader Nothing defaultName suffix _ _ = "definition module " ++ defaultName ++ suffix mkDclModuleHeader (Just (name, exports, _)) _ suffix addExports replaceExports = "definition module " ++ name ++ suffix ++ ex ++ "\n" where ex = if null exports || (replaceExports && null addExports) then "" else if null addExports then exports else if replaceExports then addExports else exports ++ "," ++ addExports {-# LINE 336 "dist/build/ExecutionPlan2Clean.hs" #-} -- EChild ------------------------------------------------------ -- wrapper data Inh_EChild = Inh_EChild { allInitStates_Inh_EChild :: (Map NontermIdent Int), con_Inh_EChild :: (ConstructorIdent), constructorTypeMap_Inh_EChild :: (Map NontermIdent ConstructorType), dclModuleHeader_Inh_EChild :: (String -> String -> String -> Bool -> String), iclModuleHeader_Inh_EChild :: (String -> String -> String -> Bool -> String), importBlocks_Inh_EChild :: (PP_Doc), mainFile_Inh_EChild :: (String), mainName_Inh_EChild :: (String), nt_Inh_EChild :: (NontermIdent), options_Inh_EChild :: (Options), textBlocks_Inh_EChild :: (PP_Doc) } data Syn_EChild = Syn_EChild { argnamesw_Syn_EChild :: ( PP_Doc ), argpats_Syn_EChild :: ( PP_Doc ), argtps_Syn_EChild :: ( PP_Doc ), childTypes_Syn_EChild :: (Map Identifier Type), childintros_Syn_EChild :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), datatype_Syn_EChild :: (PP_Doc), recfields_Syn_EChild :: ( [Identifier] ), recordtype_Syn_EChild :: (PP_Doc), terminaldefs_Syn_EChild :: (Set String), usedArgs_Syn_EChild :: (Set String) } {-# INLINABLE wrap_EChild #-} wrap_EChild :: T_EChild -> Inh_EChild -> (Syn_EChild ) wrap_EChild (T_EChild act) (Inh_EChild _lhsIallInitStates _lhsIcon _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_EChild_vIn1 _lhsIallInitStates _lhsIcon _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsItextBlocks (T_EChild_vOut1 _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOrecfields _lhsOrecordtype _lhsOterminaldefs _lhsOusedArgs) <- return (inv_EChild_s2 sem arg1) return (Syn_EChild _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOrecfields _lhsOrecordtype _lhsOterminaldefs _lhsOusedArgs) ) -- cata {-# NOINLINE sem_EChild #-} sem_EChild :: EChild -> T_EChild sem_EChild ( EChild name_ tp_ kind_ hasAround_ merges_ isMerged_ ) = sem_EChild_EChild name_ tp_ kind_ hasAround_ merges_ isMerged_ sem_EChild ( ETerm name_ tp_ ) = sem_EChild_ETerm name_ tp_ -- semantic domain newtype T_EChild = T_EChild { attach_T_EChild :: Identity (T_EChild_s2 ) } newtype T_EChild_s2 = C_EChild_s2 { inv_EChild_s2 :: (T_EChild_v1 ) } data T_EChild_s3 = C_EChild_s3 type T_EChild_v1 = (T_EChild_vIn1 ) -> (T_EChild_vOut1 ) data T_EChild_vIn1 = T_EChild_vIn1 (Map NontermIdent Int) (ConstructorIdent) (Map NontermIdent ConstructorType) (String -> String -> String -> Bool -> String) (String -> String -> String -> Bool -> String) (PP_Doc) (String) (String) (NontermIdent) (Options) (PP_Doc) data T_EChild_vOut1 = T_EChild_vOut1 ( PP_Doc ) ( PP_Doc ) ( PP_Doc ) (Map Identifier Type) (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) (PP_Doc) ( [Identifier] ) (PP_Doc) (Set String) (Set String) {-# NOINLINE sem_EChild_EChild #-} sem_EChild_EChild :: (Identifier) -> (Type) -> (ChildKind) -> (Bool) -> (Maybe [Identifier]) -> (Bool) -> T_EChild sem_EChild_EChild arg_name_ arg_tp_ arg_kind_ arg_hasAround_ _ _ = T_EChild (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_EChild_v1 v1 = \ (T_EChild_vIn1 _lhsIallInitStates _lhsIcon _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsItextBlocks) -> ( let _lhsOusedArgs :: Set String _lhsOusedArgs = rule0 _usedArgs_augmented_f1 _usedArgs_augmented_syn _usedArgs_augmented_f1 = rule1 arg_kind_ arg_name_ _tpDoc = rule2 _addStrict arg_tp_ _strNm = rule3 _lhsIcon _lhsInt arg_name_ _field = rule4 _lhsIoptions _strNm _tpDoc _recordfield = rule5 _strNm _tpDoc _addStrict = rule6 _lhsIoptions _lhsOdatatype :: PP_Doc _lhsOdatatype = rule7 _field arg_kind_ _lhsOrecordtype :: PP_Doc _lhsOrecordtype = rule8 _recordfield arg_kind_ _lhsOargnamesw :: PP_Doc _lhsOargnamesw = rule9 _nt arg_kind_ arg_name_ _lhsOargtps :: PP_Doc _lhsOargtps = rule10 arg_kind_ arg_tp_ _argpats = rule11 arg_kind_ arg_name_ _lhsOrecfields :: [Identifier] _lhsOrecfields = rule12 arg_kind_ arg_name_ _lhsOchildintros :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) _lhsOchildintros = rule13 _introcode arg_name_ _isDefor = rule14 arg_tp_ _valcode = rule15 _isDefor _lhsIoptions _nt arg_kind_ arg_name_ _aroundcode = rule16 _lhsIoptions arg_hasAround_ arg_name_ _introcode = rule17 _addbang _aroundcode _initSt _isDefor _lhsIoptions _nt _valcode arg_hasAround_ arg_kind_ arg_name_ _nt = rule18 arg_tp_ _addbang = rule19 _lhsIoptions _lhsOchildTypes :: Map Identifier Type _lhsOchildTypes = rule20 arg_name_ arg_tp_ _initSt = rule21 _lhsIallInitStates _nt _lhsOterminaldefs :: Set String _lhsOterminaldefs = rule22 () _usedArgs_augmented_syn = rule23 () _lhsOargpats :: PP_Doc _lhsOargpats = rule24 _argpats __result_ = T_EChild_vOut1 _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOrecfields _lhsOrecordtype _lhsOterminaldefs _lhsOusedArgs in __result_ ) in C_EChild_s2 v1 {-# INLINE rule0 #-} rule0 = \ _usedArgs_augmented_f1 _usedArgs_augmented_syn -> foldr ($) _usedArgs_augmented_syn [_usedArgs_augmented_f1] {-# INLINE rule1 #-} rule1 = \ kind_ name_ -> \s -> case kind_ of ChildSyntax -> Set.insert ("arg_" ++ show name_ ++ "_") s _ -> s {-# INLINE rule2 #-} {-# LINE 243 "src-ag/ExecutionPlan2Clean.ag" #-} rule2 = \ _addStrict tp_ -> {-# LINE 243 "src-ag/ExecutionPlan2Clean.ag" #-} _addStrict $ pp_parens $ ppTp $ removeDeforested tp_ {-# LINE 426 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule3 #-} {-# LINE 244 "src-ag/ExecutionPlan2Clean.ag" #-} rule3 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) name_ -> {-# LINE 244 "src-ag/ExecutionPlan2Clean.ag" #-} recordFieldname _lhsInt _lhsIcon name_ {-# LINE 432 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule4 #-} {-# LINE 245 "src-ag/ExecutionPlan2Clean.ag" #-} rule4 = \ ((_lhsIoptions) :: Options) _strNm _tpDoc -> {-# LINE 245 "src-ag/ExecutionPlan2Clean.ag" #-} if dataRecords _lhsIoptions then _strNm >#< "::" >#< _tpDoc else _tpDoc {-# LINE 440 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule5 #-} {-# LINE 248 "src-ag/ExecutionPlan2Clean.ag" #-} rule5 = \ _strNm _tpDoc -> {-# LINE 248 "src-ag/ExecutionPlan2Clean.ag" #-} _strNm >#< "::" >#< _tpDoc {-# LINE 446 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule6 #-} {-# LINE 249 "src-ag/ExecutionPlan2Clean.ag" #-} rule6 = \ ((_lhsIoptions) :: Options) -> {-# LINE 249 "src-ag/ExecutionPlan2Clean.ag" #-} \x -> if strictData _lhsIoptions then "!" >|< x else x {-# LINE 452 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule7 #-} {-# LINE 250 "src-ag/ExecutionPlan2Clean.ag" #-} rule7 = \ _field kind_ -> {-# LINE 250 "src-ag/ExecutionPlan2Clean.ag" #-} case kind_ of ChildAttr -> empty _ -> _field {-# LINE 460 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule8 #-} {-# LINE 254 "src-ag/ExecutionPlan2Clean.ag" #-} rule8 = \ _recordfield kind_ -> {-# LINE 254 "src-ag/ExecutionPlan2Clean.ag" #-} case kind_ of ChildAttr -> empty _ -> _recordfield {-# LINE 468 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule9 #-} {-# LINE 342 "src-ag/ExecutionPlan2Clean.ag" #-} rule9 = \ _nt kind_ name_ -> {-# LINE 342 "src-ag/ExecutionPlan2Clean.ag" #-} case kind_ of ChildSyntax -> "(" >#< "sem_" >|< _nt >#< name_ >|< "_" >#< ")" ChildAttr -> empty ChildReplace tp -> "(" >#< "sem_" >|< extractNonterminal tp >#< name_ >|< "_" >#< ")" {-# LINE 477 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule10 #-} {-# LINE 633 "src-ag/ExecutionPlan2Clean.ag" #-} rule10 = \ kind_ tp_ -> {-# LINE 633 "src-ag/ExecutionPlan2Clean.ag" #-} case kind_ of ChildSyntax -> pp_parens $ ppDefor tp_ ChildReplace tp -> pp_parens $ ppDefor tp _ -> empty {-# LINE 486 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule11 #-} {-# LINE 637 "src-ag/ExecutionPlan2Clean.ag" #-} rule11 = \ kind_ name_ -> {-# LINE 637 "src-ag/ExecutionPlan2Clean.ag" #-} case kind_ of ChildSyntax -> name_ >|< "_" ChildReplace _ -> name_ >|< "_" _ -> empty {-# LINE 495 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule12 #-} {-# LINE 642 "src-ag/ExecutionPlan2Clean.ag" #-} rule12 = \ kind_ name_ -> {-# LINE 642 "src-ag/ExecutionPlan2Clean.ag" #-} case kind_ of ChildSyntax -> [name_] ChildReplace _ -> [name_] _ -> [] {-# LINE 504 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule13 #-} {-# LINE 946 "src-ag/ExecutionPlan2Clean.ag" #-} rule13 = \ _introcode name_ -> {-# LINE 946 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton name_ _introcode {-# LINE 510 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule14 #-} {-# LINE 947 "src-ag/ExecutionPlan2Clean.ag" #-} rule14 = \ tp_ -> {-# LINE 947 "src-ag/ExecutionPlan2Clean.ag" #-} case tp_ of NT _ _ defor -> defor _ -> False {-# LINE 518 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule15 #-} {-# LINE 950 "src-ag/ExecutionPlan2Clean.ag" #-} rule15 = \ _isDefor ((_lhsIoptions) :: Options) _nt kind_ name_ -> {-# LINE 950 "src-ag/ExecutionPlan2Clean.ag" #-} case kind_ of ChildSyntax -> "arg_" >|< name_ >|< "_" ChildAttr -> let prefix | not _isDefor = if lateHigherOrderBinding _lhsIoptions then lateSemNtLabel _nt >#< lhsname _lhsIoptions True idLateBindingAttr else "sem_" >|< _nt | otherwise = empty in pp_parens (prefix >#< instname name_) ChildReplace _ -> pp_parens (instname name_ >#< name_ >|< "_") {-# LINE 533 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule16 #-} {-# LINE 961 "src-ag/ExecutionPlan2Clean.ag" #-} rule16 = \ ((_lhsIoptions) :: Options) hasAround_ name_ -> {-# LINE 961 "src-ag/ExecutionPlan2Clean.ag" #-} if hasAround_ then locname _lhsIoptions name_ >|< "_around" else empty {-# LINE 541 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule17 #-} {-# LINE 964 "src-ag/ExecutionPlan2Clean.ag" #-} rule17 = \ _addbang _aroundcode _initSt _isDefor ((_lhsIoptions) :: Options) _nt _valcode hasAround_ kind_ name_ -> {-# LINE 964 "src-ag/ExecutionPlan2Clean.ag" #-} \kind fmtMode -> let pat = text $ stname name_ _initSt patStrict = _addbang pat attach = "attach_T_" >|< _nt >#< pp_parens (_aroundcode >#< _valcode ) runAttach = unMon _lhsIoptions >#< pp_parens attach decl = case kind of VisitPure False -> pat >#< "=" >#< runAttach VisitPure True -> patStrict >#< "=" >#< runAttach VisitMonadic -> attach >#< ">>= \\" >#< patStrict >#< "->" in if compatibleAttach kind _nt _lhsIoptions then Right ( fmtDecl False fmtMode decl , Set.singleton (stname name_ _initSt ) , case kind_ of ChildAttr -> Map.insert (instname name_) Nothing $ ( if _isDefor || not (lateHigherOrderBinding _lhsIoptions) then id else Map.insert (lhsname _lhsIoptions True idLateBindingAttr) (Just $ AttrInh _LHS idLateBindingAttr) ) $ ( if hasAround_ then Map.insert (locname _lhsIoptions (name_) ++ "_around") Nothing else id ) $ Map.empty ChildReplace _ -> Map.singleton (instname name_) Nothing ChildSyntax -> Map.empty ) else Left $ IncompatibleAttachKind name_ kind {-# LINE 572 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule18 #-} {-# LINE 990 "src-ag/ExecutionPlan2Clean.ag" #-} rule18 = \ tp_ -> {-# LINE 990 "src-ag/ExecutionPlan2Clean.ag" #-} extractNonterminal tp_ {-# LINE 578 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule19 #-} {-# LINE 1568 "src-ag/ExecutionPlan2Clean.ag" #-} rule19 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1568 "src-ag/ExecutionPlan2Clean.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 584 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule20 #-} {-# LINE 1620 "src-ag/ExecutionPlan2Clean.ag" #-} rule20 = \ name_ tp_ -> {-# LINE 1620 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton name_ tp_ {-# LINE 590 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule21 #-} {-# LINE 1664 "src-ag/ExecutionPlan2Clean.ag" #-} rule21 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) _nt -> {-# LINE 1664 "src-ag/ExecutionPlan2Clean.ag" #-} Map.findWithDefault (error "nonterminal not in allInitStates map") _nt _lhsIallInitStates {-# LINE 596 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule22 #-} rule22 = \ (_ :: ()) -> Set.empty {-# INLINE rule23 #-} rule23 = \ (_ :: ()) -> Set.empty {-# INLINE rule24 #-} rule24 = \ _argpats -> _argpats {-# NOINLINE sem_EChild_ETerm #-} sem_EChild_ETerm :: (Identifier) -> (Type) -> T_EChild sem_EChild_ETerm arg_name_ arg_tp_ = T_EChild (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_EChild_v1 v1 = \ (T_EChild_vIn1 _lhsIallInitStates _lhsIcon _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsItextBlocks) -> ( let _tpDoc = rule25 _addStrict arg_tp_ _strNm = rule26 _lhsIcon _lhsInt arg_name_ _field = rule27 _lhsIoptions _strNm _tpDoc _recordfield = rule28 _strNm _tpDoc _addStrict = rule29 _lhsIoptions _lhsOdatatype :: PP_Doc _lhsOdatatype = rule30 _field _lhsOrecordtype :: PP_Doc _lhsOrecordtype = rule31 _recordfield _lhsOargnamesw :: PP_Doc _lhsOargnamesw = rule32 arg_name_ _lhsOargtps :: PP_Doc _lhsOargtps = rule33 arg_tp_ _argpats = rule34 _addbang arg_name_ _lhsOrecfields :: [Identifier] _lhsOrecfields = rule35 arg_name_ _lhsOchildintros :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) _lhsOchildintros = rule36 arg_name_ _lhsOterminaldefs :: Set String _lhsOterminaldefs = rule37 arg_name_ _addbang = rule38 _lhsIoptions _lhsOchildTypes :: Map Identifier Type _lhsOchildTypes = rule39 arg_name_ arg_tp_ _lhsOusedArgs :: Set String _lhsOusedArgs = rule40 () _lhsOargpats :: PP_Doc _lhsOargpats = rule41 _argpats __result_ = T_EChild_vOut1 _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOrecfields _lhsOrecordtype _lhsOterminaldefs _lhsOusedArgs in __result_ ) in C_EChild_s2 v1 {-# INLINE rule25 #-} {-# LINE 243 "src-ag/ExecutionPlan2Clean.ag" #-} rule25 = \ _addStrict tp_ -> {-# LINE 243 "src-ag/ExecutionPlan2Clean.ag" #-} _addStrict $ pp_parens $ ppTp $ removeDeforested tp_ {-# LINE 648 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule26 #-} {-# LINE 244 "src-ag/ExecutionPlan2Clean.ag" #-} rule26 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) name_ -> {-# LINE 244 "src-ag/ExecutionPlan2Clean.ag" #-} recordFieldname _lhsInt _lhsIcon name_ {-# LINE 654 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule27 #-} {-# LINE 245 "src-ag/ExecutionPlan2Clean.ag" #-} rule27 = \ ((_lhsIoptions) :: Options) _strNm _tpDoc -> {-# LINE 245 "src-ag/ExecutionPlan2Clean.ag" #-} if dataRecords _lhsIoptions then _strNm >#< "::" >#< _tpDoc else _tpDoc {-# LINE 662 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule28 #-} {-# LINE 248 "src-ag/ExecutionPlan2Clean.ag" #-} rule28 = \ _strNm _tpDoc -> {-# LINE 248 "src-ag/ExecutionPlan2Clean.ag" #-} _strNm >#< "::" >#< _tpDoc {-# LINE 668 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule29 #-} {-# LINE 249 "src-ag/ExecutionPlan2Clean.ag" #-} rule29 = \ ((_lhsIoptions) :: Options) -> {-# LINE 249 "src-ag/ExecutionPlan2Clean.ag" #-} \x -> if strictData _lhsIoptions then "!" >|< x else x {-# LINE 674 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule30 #-} {-# LINE 257 "src-ag/ExecutionPlan2Clean.ag" #-} rule30 = \ _field -> {-# LINE 257 "src-ag/ExecutionPlan2Clean.ag" #-} _field {-# LINE 680 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule31 #-} {-# LINE 258 "src-ag/ExecutionPlan2Clean.ag" #-} rule31 = \ _recordfield -> {-# LINE 258 "src-ag/ExecutionPlan2Clean.ag" #-} _recordfield {-# LINE 686 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule32 #-} {-# LINE 346 "src-ag/ExecutionPlan2Clean.ag" #-} rule32 = \ name_ -> {-# LINE 346 "src-ag/ExecutionPlan2Clean.ag" #-} text $ fieldname name_ {-# LINE 692 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule33 #-} {-# LINE 648 "src-ag/ExecutionPlan2Clean.ag" #-} rule33 = \ tp_ -> {-# LINE 648 "src-ag/ExecutionPlan2Clean.ag" #-} pp_parens $ show tp_ {-# LINE 698 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule34 #-} {-# LINE 649 "src-ag/ExecutionPlan2Clean.ag" #-} rule34 = \ _addbang name_ -> {-# LINE 649 "src-ag/ExecutionPlan2Clean.ag" #-} _addbang $ text $ fieldname name_ {-# LINE 704 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule35 #-} {-# LINE 650 "src-ag/ExecutionPlan2Clean.ag" #-} rule35 = \ name_ -> {-# LINE 650 "src-ag/ExecutionPlan2Clean.ag" #-} [name_] {-# LINE 710 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule36 #-} {-# LINE 945 "src-ag/ExecutionPlan2Clean.ag" #-} rule36 = \ name_ -> {-# LINE 945 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton name_ (\_ _ -> Right (empty, Set.empty, Map.empty)) {-# LINE 716 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule37 #-} {-# LINE 1318 "src-ag/ExecutionPlan2Clean.ag" #-} rule37 = \ name_ -> {-# LINE 1318 "src-ag/ExecutionPlan2Clean.ag" #-} Set.singleton $ fieldname name_ {-# LINE 722 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule38 #-} {-# LINE 1569 "src-ag/ExecutionPlan2Clean.ag" #-} rule38 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1569 "src-ag/ExecutionPlan2Clean.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 728 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule39 #-} {-# LINE 1620 "src-ag/ExecutionPlan2Clean.ag" #-} rule39 = \ name_ tp_ -> {-# LINE 1620 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton name_ tp_ {-# LINE 734 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule40 #-} rule40 = \ (_ :: ()) -> Set.empty {-# INLINE rule41 #-} rule41 = \ _argpats -> _argpats -- EChildren --------------------------------------------------- -- wrapper data Inh_EChildren = Inh_EChildren { allInitStates_Inh_EChildren :: (Map NontermIdent Int), con_Inh_EChildren :: (ConstructorIdent), constructorTypeMap_Inh_EChildren :: (Map NontermIdent ConstructorType), dclModuleHeader_Inh_EChildren :: (String -> String -> String -> Bool -> String), iclModuleHeader_Inh_EChildren :: (String -> String -> String -> Bool -> String), importBlocks_Inh_EChildren :: (PP_Doc), mainFile_Inh_EChildren :: (String), mainName_Inh_EChildren :: (String), nt_Inh_EChildren :: (NontermIdent), options_Inh_EChildren :: (Options), textBlocks_Inh_EChildren :: (PP_Doc) } data Syn_EChildren = Syn_EChildren { argnamesw_Syn_EChildren :: ([PP_Doc]), argpats_Syn_EChildren :: ( [PP_Doc] ), argtps_Syn_EChildren :: ( [PP_Doc] ), childTypes_Syn_EChildren :: (Map Identifier Type), childintros_Syn_EChildren :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), datatype_Syn_EChildren :: ([PP_Doc]), recfields_Syn_EChildren :: ( [Identifier] ), recordtype_Syn_EChildren :: ([PP_Doc]), terminaldefs_Syn_EChildren :: (Set String), usedArgs_Syn_EChildren :: (Set String) } {-# INLINABLE wrap_EChildren #-} wrap_EChildren :: T_EChildren -> Inh_EChildren -> (Syn_EChildren ) wrap_EChildren (T_EChildren act) (Inh_EChildren _lhsIallInitStates _lhsIcon _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_EChildren_vIn4 _lhsIallInitStates _lhsIcon _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsItextBlocks (T_EChildren_vOut4 _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOrecfields _lhsOrecordtype _lhsOterminaldefs _lhsOusedArgs) <- return (inv_EChildren_s5 sem arg4) return (Syn_EChildren _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOrecfields _lhsOrecordtype _lhsOterminaldefs _lhsOusedArgs) ) -- cata {-# NOINLINE sem_EChildren #-} sem_EChildren :: EChildren -> T_EChildren sem_EChildren list = Prelude.foldr sem_EChildren_Cons sem_EChildren_Nil (Prelude.map sem_EChild list) -- semantic domain newtype T_EChildren = T_EChildren { attach_T_EChildren :: Identity (T_EChildren_s5 ) } newtype T_EChildren_s5 = C_EChildren_s5 { inv_EChildren_s5 :: (T_EChildren_v4 ) } data T_EChildren_s6 = C_EChildren_s6 type T_EChildren_v4 = (T_EChildren_vIn4 ) -> (T_EChildren_vOut4 ) data T_EChildren_vIn4 = T_EChildren_vIn4 (Map NontermIdent Int) (ConstructorIdent) (Map NontermIdent ConstructorType) (String -> String -> String -> Bool -> String) (String -> String -> String -> Bool -> String) (PP_Doc) (String) (String) (NontermIdent) (Options) (PP_Doc) data T_EChildren_vOut4 = T_EChildren_vOut4 ([PP_Doc]) ( [PP_Doc] ) ( [PP_Doc] ) (Map Identifier Type) (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) ([PP_Doc]) ( [Identifier] ) ([PP_Doc]) (Set String) (Set String) {-# NOINLINE sem_EChildren_Cons #-} sem_EChildren_Cons :: T_EChild -> T_EChildren -> T_EChildren sem_EChildren_Cons arg_hd_ arg_tl_ = T_EChildren (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_EChildren_v4 v4 = \ (T_EChildren_vIn4 _lhsIallInitStates _lhsIcon _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsItextBlocks) -> ( let _hdX2 = Control.Monad.Identity.runIdentity (attach_T_EChild (arg_hd_)) _tlX5 = Control.Monad.Identity.runIdentity (attach_T_EChildren (arg_tl_)) (T_EChild_vOut1 _hdIargnamesw _hdIargpats _hdIargtps _hdIchildTypes _hdIchildintros _hdIdatatype _hdIrecfields _hdIrecordtype _hdIterminaldefs _hdIusedArgs) = inv_EChild_s2 _hdX2 (T_EChild_vIn1 _hdOallInitStates _hdOcon _hdOconstructorTypeMap _hdOdclModuleHeader _hdOiclModuleHeader _hdOimportBlocks _hdOmainFile _hdOmainName _hdOnt _hdOoptions _hdOtextBlocks) (T_EChildren_vOut4 _tlIargnamesw _tlIargpats _tlIargtps _tlIchildTypes _tlIchildintros _tlIdatatype _tlIrecfields _tlIrecordtype _tlIterminaldefs _tlIusedArgs) = inv_EChildren_s5 _tlX5 (T_EChildren_vIn4 _tlOallInitStates _tlOcon _tlOconstructorTypeMap _tlOdclModuleHeader _tlOiclModuleHeader _tlOimportBlocks _tlOmainFile _tlOmainName _tlOnt _tlOoptions _tlOtextBlocks) _lhsOargnamesw :: [PP_Doc] _lhsOargnamesw = rule42 _hdIargnamesw _tlIargnamesw _lhsOargpats :: [PP_Doc] _lhsOargpats = rule43 _hdIargpats _tlIargpats _lhsOargtps :: [PP_Doc] _lhsOargtps = rule44 _hdIargtps _tlIargtps _lhsOchildTypes :: Map Identifier Type _lhsOchildTypes = rule45 _hdIchildTypes _tlIchildTypes _lhsOchildintros :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) _lhsOchildintros = rule46 _hdIchildintros _tlIchildintros _lhsOdatatype :: [PP_Doc] _lhsOdatatype = rule47 _hdIdatatype _tlIdatatype _lhsOrecfields :: [Identifier] _lhsOrecfields = rule48 _hdIrecfields _tlIrecfields _lhsOrecordtype :: [PP_Doc] _lhsOrecordtype = rule49 _hdIrecordtype _tlIrecordtype _lhsOterminaldefs :: Set String _lhsOterminaldefs = rule50 _hdIterminaldefs _tlIterminaldefs _lhsOusedArgs :: Set String _lhsOusedArgs = rule51 _hdIusedArgs _tlIusedArgs _hdOallInitStates = rule52 _lhsIallInitStates _hdOcon = rule53 _lhsIcon _hdOconstructorTypeMap = rule54 _lhsIconstructorTypeMap _hdOdclModuleHeader = rule55 _lhsIdclModuleHeader _hdOiclModuleHeader = rule56 _lhsIiclModuleHeader _hdOimportBlocks = rule57 _lhsIimportBlocks _hdOmainFile = rule58 _lhsImainFile _hdOmainName = rule59 _lhsImainName _hdOnt = rule60 _lhsInt _hdOoptions = rule61 _lhsIoptions _hdOtextBlocks = rule62 _lhsItextBlocks _tlOallInitStates = rule63 _lhsIallInitStates _tlOcon = rule64 _lhsIcon _tlOconstructorTypeMap = rule65 _lhsIconstructorTypeMap _tlOdclModuleHeader = rule66 _lhsIdclModuleHeader _tlOiclModuleHeader = rule67 _lhsIiclModuleHeader _tlOimportBlocks = rule68 _lhsIimportBlocks _tlOmainFile = rule69 _lhsImainFile _tlOmainName = rule70 _lhsImainName _tlOnt = rule71 _lhsInt _tlOoptions = rule72 _lhsIoptions _tlOtextBlocks = rule73 _lhsItextBlocks __result_ = T_EChildren_vOut4 _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOrecfields _lhsOrecordtype _lhsOterminaldefs _lhsOusedArgs in __result_ ) in C_EChildren_s5 v4 {-# INLINE rule42 #-} rule42 = \ ((_hdIargnamesw) :: PP_Doc ) ((_tlIargnamesw) :: [PP_Doc]) -> _hdIargnamesw : _tlIargnamesw {-# INLINE rule43 #-} rule43 = \ ((_hdIargpats) :: PP_Doc ) ((_tlIargpats) :: [PP_Doc] ) -> _hdIargpats : _tlIargpats {-# INLINE rule44 #-} rule44 = \ ((_hdIargtps) :: PP_Doc ) ((_tlIargtps) :: [PP_Doc] ) -> _hdIargtps : _tlIargtps {-# INLINE rule45 #-} rule45 = \ ((_hdIchildTypes) :: Map Identifier Type) ((_tlIchildTypes) :: Map Identifier Type) -> _hdIchildTypes `mappend` _tlIchildTypes {-# INLINE rule46 #-} rule46 = \ ((_hdIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) ((_tlIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _hdIchildintros `Map.union` _tlIchildintros {-# INLINE rule47 #-} rule47 = \ ((_hdIdatatype) :: PP_Doc) ((_tlIdatatype) :: [PP_Doc]) -> _hdIdatatype : _tlIdatatype {-# INLINE rule48 #-} rule48 = \ ((_hdIrecfields) :: [Identifier] ) ((_tlIrecfields) :: [Identifier] ) -> _hdIrecfields ++ _tlIrecfields {-# INLINE rule49 #-} rule49 = \ ((_hdIrecordtype) :: PP_Doc) ((_tlIrecordtype) :: [PP_Doc]) -> _hdIrecordtype : _tlIrecordtype {-# INLINE rule50 #-} rule50 = \ ((_hdIterminaldefs) :: Set String) ((_tlIterminaldefs) :: Set String) -> _hdIterminaldefs `Set.union` _tlIterminaldefs {-# INLINE rule51 #-} rule51 = \ ((_hdIusedArgs) :: Set String) ((_tlIusedArgs) :: Set String) -> _hdIusedArgs `Set.union` _tlIusedArgs {-# INLINE rule52 #-} rule52 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule53 #-} rule53 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule54 #-} rule54 = \ ((_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# INLINE rule55 #-} rule55 = \ ((_lhsIdclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIdclModuleHeader {-# INLINE rule56 #-} rule56 = \ ((_lhsIiclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIiclModuleHeader {-# INLINE rule57 #-} rule57 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule58 #-} rule58 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule59 #-} rule59 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule60 #-} rule60 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule61 #-} rule61 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule62 #-} rule62 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule63 #-} rule63 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule64 #-} rule64 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule65 #-} rule65 = \ ((_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# INLINE rule66 #-} rule66 = \ ((_lhsIdclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIdclModuleHeader {-# INLINE rule67 #-} rule67 = \ ((_lhsIiclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIiclModuleHeader {-# INLINE rule68 #-} rule68 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule69 #-} rule69 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule70 #-} rule70 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule71 #-} rule71 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule72 #-} rule72 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule73 #-} rule73 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# NOINLINE sem_EChildren_Nil #-} sem_EChildren_Nil :: T_EChildren sem_EChildren_Nil = T_EChildren (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_EChildren_v4 v4 = \ (T_EChildren_vIn4 _lhsIallInitStates _lhsIcon _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsItextBlocks) -> ( let _lhsOargnamesw :: [PP_Doc] _lhsOargnamesw = rule74 () _lhsOargpats :: [PP_Doc] _lhsOargpats = rule75 () _lhsOargtps :: [PP_Doc] _lhsOargtps = rule76 () _lhsOchildTypes :: Map Identifier Type _lhsOchildTypes = rule77 () _lhsOchildintros :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) _lhsOchildintros = rule78 () _lhsOdatatype :: [PP_Doc] _lhsOdatatype = rule79 () _lhsOrecfields :: [Identifier] _lhsOrecfields = rule80 () _lhsOrecordtype :: [PP_Doc] _lhsOrecordtype = rule81 () _lhsOterminaldefs :: Set String _lhsOterminaldefs = rule82 () _lhsOusedArgs :: Set String _lhsOusedArgs = rule83 () __result_ = T_EChildren_vOut4 _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOrecfields _lhsOrecordtype _lhsOterminaldefs _lhsOusedArgs in __result_ ) in C_EChildren_s5 v4 {-# INLINE rule74 #-} rule74 = \ (_ :: ()) -> [] {-# INLINE rule75 #-} rule75 = \ (_ :: ()) -> [] {-# INLINE rule76 #-} rule76 = \ (_ :: ()) -> [] {-# INLINE rule77 #-} rule77 = \ (_ :: ()) -> mempty {-# INLINE rule78 #-} rule78 = \ (_ :: ()) -> Map.empty {-# INLINE rule79 #-} rule79 = \ (_ :: ()) -> [] {-# INLINE rule80 #-} rule80 = \ (_ :: ()) -> [] {-# INLINE rule81 #-} rule81 = \ (_ :: ()) -> [] {-# INLINE rule82 #-} rule82 = \ (_ :: ()) -> Set.empty {-# INLINE rule83 #-} rule83 = \ (_ :: ()) -> Set.empty -- ENonterminal ------------------------------------------------ -- wrapper data Inh_ENonterminal = Inh_ENonterminal { allFromToStates_Inh_ENonterminal :: (Map VisitIdentifier (Int,Int)), allInitStates_Inh_ENonterminal :: (Map NontermIdent Int), allVisitKinds_Inh_ENonterminal :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_ENonterminal :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), avisitdefs_Inh_ENonterminal :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_ENonterminal :: (Map VisitIdentifier (Set Identifier)), constructorTypeMap_Inh_ENonterminal :: (Map NontermIdent ConstructorType), dclModuleHeader_Inh_ENonterminal :: (String -> String -> String -> Bool -> String), derivings_Inh_ENonterminal :: (Derivings), iclModuleHeader_Inh_ENonterminal :: (String -> String -> String -> Bool -> String), importBlocks_Inh_ENonterminal :: (PP_Doc), inhmap_Inh_ENonterminal :: (Map NontermIdent Attributes), localAttrTypes_Inh_ENonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))), mainFile_Inh_ENonterminal :: (String), mainName_Inh_ENonterminal :: (String), options_Inh_ENonterminal :: (Options), synmap_Inh_ENonterminal :: (Map NontermIdent Attributes), textBlocks_Inh_ENonterminal :: (PP_Doc), typeSyns_Inh_ENonterminal :: (TypeSyns), wrappers_Inh_ENonterminal :: (Set NontermIdent) } data Syn_ENonterminal = Syn_ENonterminal { appendCommon_Syn_ENonterminal :: ( PP_Doc ), appendMain_Syn_ENonterminal :: ( PP_Doc ), childvisit_Syn_ENonterminal :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), errors_Syn_ENonterminal :: (Seq Error), fromToStates_Syn_ENonterminal :: (Map VisitIdentifier (Int,Int)), genProdIO_Syn_ENonterminal :: (IO ()), imports_Syn_ENonterminal :: ([PP_Doc]), initStates_Syn_ENonterminal :: (Map NontermIdent Int), output_Syn_ENonterminal :: (PP_Doc), output_dcl_Syn_ENonterminal :: (PP_Doc), semFunBndDefs_Syn_ENonterminal :: (Seq PP_Doc), semFunBndTps_Syn_ENonterminal :: (Seq PP_Doc), visitKinds_Syn_ENonterminal :: (Map VisitIdentifier VisitKind), visitdefs_Syn_ENonterminal :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_ENonterminal :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_ENonterminal #-} wrap_ENonterminal :: T_ENonterminal -> Inh_ENonterminal -> (Syn_ENonterminal ) wrap_ENonterminal (T_ENonterminal act) (Inh_ENonterminal _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIderivings _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_ENonterminal_vIn7 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIderivings _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers (T_ENonterminal_vOut7 _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOoutput_dcl _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_ENonterminal_s8 sem arg7) return (Syn_ENonterminal _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOoutput_dcl _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# INLINE sem_ENonterminal #-} sem_ENonterminal :: ENonterminal -> T_ENonterminal sem_ENonterminal ( ENonterminal nt_ params_ classCtxs_ initial_ initialv_ nextVisits_ prevVisits_ prods_ recursive_ hoInfo_ ) = sem_ENonterminal_ENonterminal nt_ params_ classCtxs_ initial_ initialv_ nextVisits_ prevVisits_ ( sem_EProductions prods_ ) recursive_ hoInfo_ -- semantic domain newtype T_ENonterminal = T_ENonterminal { attach_T_ENonterminal :: Identity (T_ENonterminal_s8 ) } newtype T_ENonterminal_s8 = C_ENonterminal_s8 { inv_ENonterminal_s8 :: (T_ENonterminal_v7 ) } data T_ENonterminal_s9 = C_ENonterminal_s9 type T_ENonterminal_v7 = (T_ENonterminal_vIn7 ) -> (T_ENonterminal_vOut7 ) data T_ENonterminal_vIn7 = T_ENonterminal_vIn7 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Int) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map NontermIdent ConstructorType) (String -> String -> String -> Bool -> String) (Derivings) (String -> String -> String -> Bool -> String) (PP_Doc) (Map NontermIdent Attributes) (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) (String) (String) (Options) (Map NontermIdent Attributes) (PP_Doc) (TypeSyns) (Set NontermIdent) data T_ENonterminal_vOut7 = T_ENonterminal_vOut7 ( PP_Doc ) ( PP_Doc ) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Seq Error) (Map VisitIdentifier (Int,Int)) (IO ()) ([PP_Doc]) (Map NontermIdent Int) (PP_Doc) (PP_Doc) (Seq PP_Doc) (Seq PP_Doc) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_ENonterminal_ENonterminal #-} sem_ENonterminal_ENonterminal :: (NontermIdent) -> ([Identifier]) -> (ClassContext) -> (StateIdentifier) -> ([VisitIdentifier]) -> (Map StateIdentifier StateCtx) -> (Map StateIdentifier StateCtx) -> T_EProductions -> (Bool) -> (HigherOrderInfo) -> T_ENonterminal sem_ENonterminal_ENonterminal arg_nt_ arg_params_ arg_classCtxs_ arg_initial_ arg_initialv_ arg_nextVisits_ arg_prevVisits_ arg_prods_ _ _ = T_ENonterminal (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_ENonterminal_v7 v7 = \ (T_ENonterminal_vIn7 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIderivings _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers) -> ( let _prodsX17 = Control.Monad.Identity.runIdentity (attach_T_EProductions (arg_prods_)) (T_EProductions_vOut16 _prodsIallvisits _prodsIchildvisit _prodsIcount _prodsIdatatype _prodsIerrors _prodsIfromToStates _prodsIgenProdIO _prodsIimports _prodsIrecordtype _prodsIsemFunBndDefs _prodsIsemFunBndTps _prodsIsem_nt _prodsIsem_prod _prodsIsem_prod_tys _prodsIt_visits _prodsIvisitKinds _prodsIvisitdefs _prodsIvisituses) = inv_EProductions_s17 _prodsX17 (T_EProductions_vIn16 _prodsOallFromToStates _prodsOallInhmap _prodsOallInitStates _prodsOallSynmap _prodsOallVisitKinds _prodsOallchildvisit _prodsOallstates _prodsOavisitdefs _prodsOavisituses _prodsOclassCtxs _prodsOconstructorTypeMap _prodsOdclModuleHeader _prodsOiclModuleHeader _prodsOimportBlocks _prodsOinhmap _prodsOinitial _prodsOlocalAttrTypes _prodsOmainFile _prodsOmainName _prodsOnextVisits _prodsOnt _prodsOntType _prodsOoptions _prodsOparams _prodsOprevVisits _prodsOrename _prodsOsynmap _prodsOtextBlocks) _prodsOrename = rule84 _lhsIoptions _prodsOnt = rule85 arg_nt_ _prodsOparams = rule86 arg_params_ _prodsOclassCtxs = rule87 arg_classCtxs_ _lhsOoutput :: PP_Doc _lhsOoutput = rule88 _hasWrapper _k_states _lhsIoptions _prodsIsem_prod _sem_nt _t_init_icl _t_states_icl _wr_inh_icl _wr_syn_icl _wrapper_icl arg_nt_ _hasWrapper = rule89 _lhsIwrappers arg_nt_ _lhsOoutput_dcl :: PP_Doc _lhsOoutput_dcl = rule90 _datatype _hasWrapper _lhsIoptions _prodsIsem_prod_tys _prodsIt_visits _sem_tp _semname _t_init_dcl _t_states_dcl _wr_inh_dcl _wr_syn_dcl _wrapper_dcl arg_nt_ _classPP = rule91 arg_classCtxs_ _aliasPre = rule92 _classPP _t_params arg_nt_ _datatype = rule93 _aliasPre _classPP _derivings _lhsIconstructorTypeMap _lhsItypeSyns _prodsIdatatype _prodsIrecordtype _t_params arg_nt_ _derivings = rule94 _lhsIderivings arg_nt_ _fsemname = rule95 () _semname = rule96 _fsemname arg_nt_ _frecarg = rule97 _fsemname _sem_tp = rule98 _classPP _quantPP _t_params _t_type arg_nt_ _quantPP = rule99 arg_params_ _sem_nt = rule100 _frecarg _fsemname _lhsItypeSyns _prodsIsem_nt _sem_tp _semname arg_nt_ (Just _prodsOinhmap) = rule101 _lhsIinhmap arg_nt_ (Just _prodsOsynmap) = rule102 _lhsIsynmap arg_nt_ _prodsOallInhmap = rule103 _lhsIinhmap _prodsOallSynmap = rule104 _lhsIsynmap _outedges = rule105 _prodsIallvisits _inedges = rule106 _prodsIallvisits _allstates = rule107 _inedges _outedges arg_initial_ _stvisits = rule108 _prodsIallvisits _t_type = rule109 arg_nt_ _lt_type = rule110 arg_nt_ _t_params = rule111 arg_params_ _t_init_icl = rule112 _lt_type _t_init_dcl _t_type _t_init_dcl = rule113 _lhsIoptions _t_params _t_type arg_initial_ _t_states_icl = rule114 _allstates arg_nextVisits_ arg_nt_ _t_states_dcl = rule115 _allstates _t_params arg_nextVisits_ arg_nt_ _k_type = rule116 arg_nt_ _k_states = rule117 _allstates _k_type _prodsIallvisits _t_params _t_type arg_nextVisits_ arg_nt_ _wr_inh_icl = rule118 _genwrap_icl _wr_inhs _wr_syn_icl = rule119 _genwrap_icl _wr_syns _genwrap_icl = rule120 _addbang arg_nt_ _wr_inh_dcl = rule121 _genwrap_dcl _wr_inhs _wr_syn_dcl = rule122 _genwrap_dcl _wr_syns _genwrap_dcl = rule123 _addbang _t_params arg_nt_ _synAttrs = rule124 _lhsIinhmap arg_nt_ _wr_inhs = rule125 _synAttrs _wr_filter _wr_inhs1 = rule126 _synAttrs _wr_filter = rule127 _lhsIoptions _wr_syns = rule128 _lhsIsynmap arg_nt_ _inhlist = rule129 _lhsIoptions _wr_inhs _inhlist1 = rule130 _lhsIoptions _wr_inhs1 _synlist = rule131 _lhsIoptions _wr_syns _wrapname = rule132 arg_nt_ _inhname = rule133 arg_nt_ _synname = rule134 arg_nt_ _firstVisitInfo = rule135 arg_initial_ arg_nextVisits_ _wrapper_icl = rule136 _addbang _addbangWrap _classPP _firstVisitInfo _inhlist _inhlist1 _inhname _k_type _lhsIallVisitKinds _lhsImainName _lhsIoptions _quantPP _synlist _synname _t_params _t_type _wrapname arg_initial_ arg_initialv_ arg_nt_ _wrapper_dcl = rule137 _classPP _inhname _lhsIoptions _quantPP _synname _t_params _t_type _wrapname _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule138 _prodsIsemFunBndDefs _semFunBndDef _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule139 _prodsIsemFunBndTps _semFunBndTp _semFunBndDef = rule140 _semFunBndNm _semname _semFunBndTp = rule141 _semFunBndNm _sem_tp _semFunBndNm = rule142 arg_nt_ _prodsOinitial = rule143 arg_initial_ _prodsOallstates = rule144 _allstates _lhsOappendMain :: PP_Doc _lhsOappendMain = rule145 _lhsIwrappers _sem_nt _wr_inh_icl _wr_syn_icl _wrapper_icl arg_nt_ _lhsOappendCommon :: PP_Doc _lhsOappendCommon = rule146 _datatype _k_states _lhsIoptions _prodsIt_visits _t_init_icl _t_states_icl _addbang = rule147 _lhsIoptions _addbangWrap = rule148 () _prodsOnextVisits = rule149 arg_nextVisits_ _prodsOprevVisits = rule150 arg_prevVisits_ _prodsOlocalAttrTypes = rule151 _lhsIlocalAttrTypes arg_nt_ _lhsOinitStates :: Map NontermIdent Int _lhsOinitStates = rule152 arg_initial_ arg_nt_ _ntType = rule153 arg_nt_ arg_params_ _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule154 _prodsIchildvisit _lhsOerrors :: Seq Error _lhsOerrors = rule155 _prodsIerrors _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule156 _prodsIfromToStates _lhsOgenProdIO :: IO () _lhsOgenProdIO = rule157 _prodsIgenProdIO _lhsOimports :: [PP_Doc] _lhsOimports = rule158 _prodsIimports _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule159 _prodsIvisitKinds _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule160 _prodsIvisitdefs _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule161 _prodsIvisituses _prodsOallFromToStates = rule162 _lhsIallFromToStates _prodsOallInitStates = rule163 _lhsIallInitStates _prodsOallVisitKinds = rule164 _lhsIallVisitKinds _prodsOallchildvisit = rule165 _lhsIallchildvisit _prodsOavisitdefs = rule166 _lhsIavisitdefs _prodsOavisituses = rule167 _lhsIavisituses _prodsOconstructorTypeMap = rule168 _lhsIconstructorTypeMap _prodsOdclModuleHeader = rule169 _lhsIdclModuleHeader _prodsOiclModuleHeader = rule170 _lhsIiclModuleHeader _prodsOimportBlocks = rule171 _lhsIimportBlocks _prodsOmainFile = rule172 _lhsImainFile _prodsOmainName = rule173 _lhsImainName _prodsOntType = rule174 _ntType _prodsOoptions = rule175 _lhsIoptions _prodsOtextBlocks = rule176 _lhsItextBlocks __result_ = T_ENonterminal_vOut7 _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOoutput_dcl _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_ENonterminal_s8 v7 {-# INLINE rule84 #-} {-# LINE 58 "src-ag/ExecutionPlan2Clean.ag" #-} rule84 = \ ((_lhsIoptions) :: Options) -> {-# LINE 58 "src-ag/ExecutionPlan2Clean.ag" #-} rename _lhsIoptions {-# LINE 1140 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule85 #-} {-# LINE 66 "src-ag/ExecutionPlan2Clean.ag" #-} rule85 = \ nt_ -> {-# LINE 66 "src-ag/ExecutionPlan2Clean.ag" #-} nt_ {-# LINE 1146 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule86 #-} {-# LINE 78 "src-ag/ExecutionPlan2Clean.ag" #-} rule86 = \ params_ -> {-# LINE 78 "src-ag/ExecutionPlan2Clean.ag" #-} params_ {-# LINE 1152 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule87 #-} {-# LINE 82 "src-ag/ExecutionPlan2Clean.ag" #-} rule87 = \ classCtxs_ -> {-# LINE 82 "src-ag/ExecutionPlan2Clean.ag" #-} classCtxs_ {-# LINE 1158 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule88 #-} {-# LINE 102 "src-ag/ExecutionPlan2Clean.ag" #-} rule88 = \ _hasWrapper _k_states ((_lhsIoptions) :: Options) ((_prodsIsem_prod) :: PP_Doc) _sem_nt _t_init_icl _t_states_icl _wr_inh_icl _wr_syn_icl _wrapper_icl nt_ -> {-# LINE 102 "src-ag/ExecutionPlan2Clean.ag" #-} ("// " ++ getName nt_ ++ " " ++ replicate (60 - length (getName nt_)) '-') >-< (if _hasWrapper then "// wrapper" >-< _wr_inh_icl >-< _wr_syn_icl >-< _wrapper_icl >-< "" else empty) >-< (if folds _lhsIoptions then "// cata" >-< _sem_nt >-< "" else empty) >-< (if semfuns _lhsIoptions then "// semantic domain" >-< _t_init_icl >-< _t_states_icl >-< _k_states >-< _prodsIsem_prod >-< "" else empty) {-# LINE 1184 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule89 #-} {-# LINE 123 "src-ag/ExecutionPlan2Clean.ag" #-} rule89 = \ ((_lhsIwrappers) :: Set NontermIdent) nt_ -> {-# LINE 123 "src-ag/ExecutionPlan2Clean.ag" #-} nt_ `Set.member` _lhsIwrappers {-# LINE 1190 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule90 #-} {-# LINE 125 "src-ag/ExecutionPlan2Clean.ag" #-} rule90 = \ _datatype _hasWrapper ((_lhsIoptions) :: Options) ((_prodsIsem_prod_tys) :: PP_Doc) ((_prodsIt_visits) :: PP_Doc) _sem_tp _semname _t_init_dcl _t_states_dcl _wr_inh_dcl _wr_syn_dcl _wrapper_dcl nt_ -> {-# LINE 125 "src-ag/ExecutionPlan2Clean.ag" #-} ("// " ++ getName nt_ ++ " " ++ replicate (60 - length (getName nt_)) '-') >-< (if dataTypes _lhsIoptions then "// data" >-< _datatype >-< "" else empty) >-< (if _hasWrapper then "// wrapper" >-< _wr_inh_dcl >-< _wr_syn_dcl >-< _wrapper_dcl >-< "" else empty) >-< (if folds _lhsIoptions then "// cata" >-< _semname >#< "::" >#< _sem_tp >-< "" else empty) >-< (if semfuns _lhsIoptions then "// semantic domain" >-< _t_init_dcl >-< _t_states_dcl >-< _prodsIt_visits >-< _prodsIsem_prod_tys >-< "" else empty) {-# LINE 1221 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule91 #-} {-# LINE 163 "src-ag/ExecutionPlan2Clean.ag" #-} rule91 = \ classCtxs_ -> {-# LINE 163 "src-ag/ExecutionPlan2Clean.ag" #-} ppClasses $ classCtxsToDocs classCtxs_ {-# LINE 1227 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule92 #-} {-# LINE 164 "src-ag/ExecutionPlan2Clean.ag" #-} rule92 = \ _classPP _t_params nt_ -> {-# LINE 164 "src-ag/ExecutionPlan2Clean.ag" #-} "::" >#< _classPP >#< nt_ >#< _t_params >#< ":==" {-# LINE 1233 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule93 #-} {-# LINE 165 "src-ag/ExecutionPlan2Clean.ag" #-} rule93 = \ _aliasPre _classPP _derivings ((_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) ((_lhsItypeSyns) :: TypeSyns) ((_prodsIdatatype) :: [PP_Doc]) ((_prodsIrecordtype) :: PP_Doc) _t_params nt_ -> {-# LINE 165 "src-ag/ExecutionPlan2Clean.ag" #-} case lookup nt_ _lhsItypeSyns of Nothing -> "::" >#< _classPP >#< nt_ >#< _t_params >-< ( if null _prodsIdatatype then empty else if isRecordConstructor nt_ _lhsIconstructorTypeMap then indent 2 $ "=" >#< _prodsIrecordtype else indent 2 $ vlist $ ( ("=" >#< head _prodsIdatatype) : (map ("|" >#<) $ tail _prodsIdatatype)) ) >-< indent 2 _derivings Just (List t) -> _aliasPre >#< "[" >#< show t >#< "]" Just (Maybe t) -> _aliasPre >#< "Data.Maybe" >#< pp_parens (show t) Just (Tuple ts) -> _aliasPre >#< pp_parens (ppCommas $ map (show . snd) ts) Just (Either l r) -> _aliasPre >#< "Data.Either" >#< pp_parens (show l) >#< pp_parens (show r) Just (Map k v) -> _aliasPre >#< "Data.Map" >#< pp_parens (show k) >#< pp_parens (show v) Just (IntMap t) -> _aliasPre >#< "Data.IntMap.IntMap" >#< pp_parens (show t) Just (OrdSet t) -> _aliasPre >#< "Data.Set.Set" >#< pp_parens (show t) Just IntSet -> _aliasPre >#< "Data.IntSet.IntSet" {-# LINE 1256 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule94 #-} {-# LINE 184 "src-ag/ExecutionPlan2Clean.ag" #-} rule94 = \ ((_lhsIderivings) :: Derivings) nt_ -> {-# LINE 184 "src-ag/ExecutionPlan2Clean.ag" #-} case Map.lookup nt_ _lhsIderivings of Nothing -> empty Just s -> if Set.null s then empty else "deriving" >#< (pp_parens $ ppCommas $ map pp $ Set.toList s) {-# LINE 1266 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule95 #-} {-# LINE 269 "src-ag/ExecutionPlan2Clean.ag" #-} rule95 = \ (_ :: ()) -> {-# LINE 269 "src-ag/ExecutionPlan2Clean.ag" #-} \x -> "sem_" ++ show x {-# LINE 1272 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule96 #-} {-# LINE 270 "src-ag/ExecutionPlan2Clean.ag" #-} rule96 = \ _fsemname nt_ -> {-# LINE 270 "src-ag/ExecutionPlan2Clean.ag" #-} _fsemname nt_ {-# LINE 1278 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule97 #-} {-# LINE 271 "src-ag/ExecutionPlan2Clean.ag" #-} rule97 = \ _fsemname -> {-# LINE 271 "src-ag/ExecutionPlan2Clean.ag" #-} \t x -> case t of NT nt _ _ -> pp_parens (_fsemname nt >#< x) _ -> pp x {-# LINE 1286 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule98 #-} {-# LINE 277 "src-ag/ExecutionPlan2Clean.ag" #-} rule98 = \ _classPP _quantPP _t_params _t_type nt_ -> {-# LINE 277 "src-ag/ExecutionPlan2Clean.ag" #-} _quantPP >#< _classPP >#< nt_ >#< _t_params >#< "->" >#< _t_type >#< _t_params {-# LINE 1292 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule99 #-} {-# LINE 278 "src-ag/ExecutionPlan2Clean.ag" #-} rule99 = \ params_ -> {-# LINE 278 "src-ag/ExecutionPlan2Clean.ag" #-} ppQuants params_ {-# LINE 1298 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule100 #-} {-# LINE 280 "src-ag/ExecutionPlan2Clean.ag" #-} rule100 = \ _frecarg _fsemname ((_lhsItypeSyns) :: TypeSyns) ((_prodsIsem_nt) :: PP_Doc) _sem_tp _semname nt_ -> {-# LINE 280 "src-ag/ExecutionPlan2Clean.ag" #-} _semname >#< "::" >#< _sem_tp >-< case lookup nt_ _lhsItypeSyns of Nothing -> _prodsIsem_nt Just (List t) -> _semname >#< "list" >#< "=" >#< "foldr" >#< _semname >|< "_Cons" >#< _semname >|< "_Nil" >#< case t of NT nt _ _ -> pp_parens ("map" >#< _fsemname nt >#< "list") _ -> pp "list" Just (Maybe t) -> _semname >#< "'Data.Maybe'.Nothing" >#< "=" >#< _semname >|< "_Nothing" >-< _semname >#< pp_parens ("'Data.Maybe'.Just just") >#< "=" >#< _semname >|< "_Just" >#< _frecarg t "just" Just (Tuple ts) -> _semname >#< pp_parens (ppCommas $ map fst ts) >#< "=" >#< _semname >|< "_Tuple" >#< ppSpaced (map (\t -> _frecarg (snd t) (show $ fst t)) ts) Just (Either l r) -> _semname >#< "('Data.Either'.Left left)" >#< "=" >#< _semname >|< "_Left" >#< _frecarg l "left" >-< _semname >#< "('Data.Either'.Right right)" >#< "=" >#< _semname >|< "_Right" >#< _frecarg r "right" Just (Map k v) -> _semname >#< "m" >#< "=" >#< "'Data.Map'.foldrWithKey" >#< _semname >|< "_Entry" >#< _semname >|< "_Nil" >#< case v of NT nt _ _ -> pp_parens ("'Data.Map'.map" >#< _fsemname nt >#< "m") _ -> pp "m" Just (IntMap v) -> _semname >#< "m" >#< "=" >#< "'Data.IntMap'.foldWithKey" >#< _semname >|< "_Entry" >#< _semname >|< "_Nil" >#< case v of NT nt _ _ -> pp_parens ("'Data.IntMap'.map" >#< _fsemname nt >#< "m") _ -> pp "m" Just (OrdSet t) -> _semname >#< "s" >#< "=" >#< "foldr" >#< _semname >|< "_Entry" >#< _semname >|< "_Nil" >#< pp_parens ( ( case t of NT nt _ _ -> pp_parens ("map" >#< _fsemname nt) _ -> empty ) >#< pp_parens ("'Data.IntSet'.elems" >#< "s") ) Just IntSet -> _semname >#< "s" >#< "=" >#< "foldr" >#< _semname >|< "_Entry" >#< _semname >|< "_Nil" >#< pp_parens ("'Data.IntSet'.elems" >#< "s") {-# LINE 1339 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule101 #-} {-# LINE 366 "src-ag/ExecutionPlan2Clean.ag" #-} rule101 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) nt_ -> {-# LINE 366 "src-ag/ExecutionPlan2Clean.ag" #-} Map.lookup nt_ _lhsIinhmap {-# LINE 1345 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule102 #-} {-# LINE 367 "src-ag/ExecutionPlan2Clean.ag" #-} rule102 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) nt_ -> {-# LINE 367 "src-ag/ExecutionPlan2Clean.ag" #-} Map.lookup nt_ _lhsIsynmap {-# LINE 1351 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule103 #-} {-# LINE 368 "src-ag/ExecutionPlan2Clean.ag" #-} rule103 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) -> {-# LINE 368 "src-ag/ExecutionPlan2Clean.ag" #-} _lhsIinhmap {-# LINE 1357 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule104 #-} {-# LINE 369 "src-ag/ExecutionPlan2Clean.ag" #-} rule104 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) -> {-# LINE 369 "src-ag/ExecutionPlan2Clean.ag" #-} _lhsIsynmap {-# LINE 1363 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule105 #-} {-# LINE 390 "src-ag/ExecutionPlan2Clean.ag" #-} rule105 = \ ((_prodsIallvisits) :: [VisitStateState]) -> {-# LINE 390 "src-ag/ExecutionPlan2Clean.ag" #-} Set.fromList $ map (\(_,f,_) -> f) _prodsIallvisits {-# LINE 1369 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule106 #-} {-# LINE 391 "src-ag/ExecutionPlan2Clean.ag" #-} rule106 = \ ((_prodsIallvisits) :: [VisitStateState]) -> {-# LINE 391 "src-ag/ExecutionPlan2Clean.ag" #-} Set.fromList $ map (\(_,_,t) -> t) _prodsIallvisits {-# LINE 1375 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule107 #-} {-# LINE 392 "src-ag/ExecutionPlan2Clean.ag" #-} rule107 = \ _inedges _outedges initial_ -> {-# LINE 392 "src-ag/ExecutionPlan2Clean.ag" #-} Set.insert initial_ $ _inedges `Set.union` _outedges {-# LINE 1381 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule108 #-} {-# LINE 393 "src-ag/ExecutionPlan2Clean.ag" #-} rule108 = \ ((_prodsIallvisits) :: [VisitStateState]) -> {-# LINE 393 "src-ag/ExecutionPlan2Clean.ag" #-} \st -> filter (\(v,f,t) -> f == st) _prodsIallvisits {-# LINE 1387 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule109 #-} {-# LINE 394 "src-ag/ExecutionPlan2Clean.ag" #-} rule109 = \ nt_ -> {-# LINE 394 "src-ag/ExecutionPlan2Clean.ag" #-} "T_" >|< nt_ {-# LINE 1393 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule110 #-} {-# LINE 395 "src-ag/ExecutionPlan2Clean.ag" #-} rule110 = \ nt_ -> {-# LINE 395 "src-ag/ExecutionPlan2Clean.ag" #-} "t_" >|< nt_ {-# LINE 1399 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule111 #-} {-# LINE 396 "src-ag/ExecutionPlan2Clean.ag" #-} rule111 = \ params_ -> {-# LINE 396 "src-ag/ExecutionPlan2Clean.ag" #-} ppSpaced params_ {-# LINE 1405 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule112 #-} {-# LINE 397 "src-ag/ExecutionPlan2Clean.ag" #-} rule112 = \ _lt_type _t_init_dcl _t_type -> {-# LINE 397 "src-ag/ExecutionPlan2Clean.ag" #-} _t_init_dcl >-< "attach_" >|< _t_type >#< pp_parens (_t_type >#< _lt_type ) >#< "=" >#< _lt_type {-# LINE 1412 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule113 #-} {-# LINE 399 "src-ag/ExecutionPlan2Clean.ag" #-} rule113 = \ ((_lhsIoptions) :: Options) _t_params _t_type initial_ -> {-# LINE 399 "src-ag/ExecutionPlan2Clean.ag" #-} "::" >#< _t_type >#< _t_params >#< "=" >#< _t_type >#< pp_parens ( ppMonadType _lhsIoptions >#< pp_parens (_t_type >|< "_s" >|< initial_ >#< _t_params )) {-# LINE 1421 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule114 #-} {-# LINE 403 "src-ag/ExecutionPlan2Clean.ag" #-} rule114 = \ _allstates nextVisits_ nt_ -> {-# LINE 403 "src-ag/ExecutionPlan2Clean.ag" #-} vlist $ map (\st -> let nt_st = nt_ >|< "_s" >|< st c_st = "C_" >|< nt_st inv_st = "inv_" >|< nt_st nextVisit = Map.findWithDefault ManyVis st nextVisits_ in case nextVisit of NoneVis -> empty OneVis vId -> inv_st >#< pp_parens (c_st >#< "x") >#< "=" >#< "x" ManyVis -> empty ) $ Set.toList _allstates {-# LINE 1436 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule115 #-} {-# LINE 413 "src-ag/ExecutionPlan2Clean.ag" #-} rule115 = \ _allstates _t_params nextVisits_ nt_ -> {-# LINE 413 "src-ag/ExecutionPlan2Clean.ag" #-} vlist $ map (\st -> let nt_st = nt_ >|< "_s" >|< st t_st = "T_" >|< nt_st k_st = "K_" >|< nt_st c_st = "C_" >|< nt_st inv_st = "inv_" >|< nt_st nextVisit = Map.findWithDefault ManyVis st nextVisits_ in case nextVisit of NoneVis -> "::" >#< t_st >#< _t_params >#< "=" >#< c_st OneVis vId -> "::" >#< t_st >#< _t_params >#< "=" >#< c_st >#< (pp_parens (conNmTVisit nt_ vId >#< _t_params )) ManyVis -> "::" >#< t_st >#< _t_params >#< "where" >#< c_st >#< "::" >#< (pp_braces $ inv_st >#< "::" >#< "!" >|< pp_parens ("E.t:" >#< k_st >#< _t_params >#< "t" >#< "->" >#< "t")) >#< "->" >#< t_st >#< _t_params ) $ Set.toList _allstates {-# LINE 1455 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule116 #-} {-# LINE 430 "src-ag/ExecutionPlan2Clean.ag" #-} rule116 = \ nt_ -> {-# LINE 430 "src-ag/ExecutionPlan2Clean.ag" #-} "K_" ++ show nt_ {-# LINE 1461 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule117 #-} {-# LINE 431 "src-ag/ExecutionPlan2Clean.ag" #-} rule117 = \ _allstates _k_type ((_prodsIallvisits) :: [VisitStateState]) _t_params _t_type nextVisits_ nt_ -> {-# LINE 431 "src-ag/ExecutionPlan2Clean.ag" #-} vlist $ map (\st -> let nt_st = nt_ >|< "_s" >|< st k_st = "K_" >|< nt_st outg = filter (\(v,f,t) -> f == st) _prodsIallvisits visitlist = vlist $ map (\(v,f,t) -> _k_type >|< "_v" >|< v >#< "::" >#< k_st >#< _t_params >#< pp_parens (_t_type >|< "_v" >|< v >#< _t_params ) ) outg nextVisit = Map.findWithDefault ManyVis st nextVisits_ decl = "::" >#< k_st >#< "k" >#< _t_params >#< "where" >-< indent 3 visitlist in case nextVisit of NoneVis -> empty OneVis _ -> empty ManyVis -> decl ) $ Set.toList _allstates {-# LINE 1480 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule118 #-} {-# LINE 499 "src-ag/ExecutionPlan2Clean.ag" #-} rule118 = \ _genwrap_icl _wr_inhs -> {-# LINE 499 "src-ag/ExecutionPlan2Clean.ag" #-} _genwrap_icl "Inh" _wr_inhs {-# LINE 1486 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule119 #-} {-# LINE 500 "src-ag/ExecutionPlan2Clean.ag" #-} rule119 = \ _genwrap_icl _wr_syns -> {-# LINE 500 "src-ag/ExecutionPlan2Clean.ag" #-} _genwrap_icl "Syn" _wr_syns {-# LINE 1492 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule120 #-} {-# LINE 501 "src-ag/ExecutionPlan2Clean.ag" #-} rule120 = \ _addbang nt_ -> {-# LINE 501 "src-ag/ExecutionPlan2Clean.ag" #-} \nm attr -> let tyConName = nm >|< "_" >|< nt_ in (let (d, _, _) = foldr (\(i, t) (d, c, n) -> (d >-< i >|< "_" >|< tyConName >#< "::" >#< tyConName >#< "->" >#< (_addbang $ pp_parens $ typeToHaskellString (Just nt_) [] t) >-< i >|< "_" >|< tyConName >#< pp_parens (tyConName >#< unwords (replicate (n - c - 1) "_" ++ ["x"] ++ replicate c "_")) >#< "= x" , c + 1, n) ) (empty, 0, length attr) attr in d) {-# LINE 1505 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule121 #-} {-# LINE 509 "src-ag/ExecutionPlan2Clean.ag" #-} rule121 = \ _genwrap_dcl _wr_inhs -> {-# LINE 509 "src-ag/ExecutionPlan2Clean.ag" #-} _genwrap_dcl "Inh" _wr_inhs {-# LINE 1511 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule122 #-} {-# LINE 510 "src-ag/ExecutionPlan2Clean.ag" #-} rule122 = \ _genwrap_dcl _wr_syns -> {-# LINE 510 "src-ag/ExecutionPlan2Clean.ag" #-} _genwrap_dcl "Syn" _wr_syns {-# LINE 1517 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule123 #-} {-# LINE 511 "src-ag/ExecutionPlan2Clean.ag" #-} rule123 = \ _addbang _t_params nt_ -> {-# LINE 511 "src-ag/ExecutionPlan2Clean.ag" #-} \nm attr -> let tyConName = nm >|< "_" >|< nt_ in "::" >#< tyConName >#< _t_params >#< "=" >#< tyConName >#< (ppSpaced $ map (\(_,t) -> _addbang $ pp_parens $ typeToHaskellString (Just nt_) [] t) attr) >-< (let (d, _, _) = foldr (\(i, t) (d, c, n) -> (d >-< i >|< "_" >|< tyConName >#< "::" >#< tyConName >#< "->" >#< (_addbang $ pp_parens $ typeToHaskellString (Just nt_) [] t) , c + 1, n) ) (empty, 0, length attr) attr in d) {-# LINE 1532 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule124 #-} {-# LINE 521 "src-ag/ExecutionPlan2Clean.ag" #-} rule124 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) nt_ -> {-# LINE 521 "src-ag/ExecutionPlan2Clean.ag" #-} fromJust $ Map.lookup nt_ _lhsIinhmap {-# LINE 1538 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule125 #-} {-# LINE 522 "src-ag/ExecutionPlan2Clean.ag" #-} rule125 = \ _synAttrs _wr_filter -> {-# LINE 522 "src-ag/ExecutionPlan2Clean.ag" #-} Map.toList $ _wr_filter $ _synAttrs {-# LINE 1544 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule126 #-} {-# LINE 523 "src-ag/ExecutionPlan2Clean.ag" #-} rule126 = \ _synAttrs -> {-# LINE 523 "src-ag/ExecutionPlan2Clean.ag" #-} Map.toList _synAttrs {-# LINE 1550 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule127 #-} {-# LINE 524 "src-ag/ExecutionPlan2Clean.ag" #-} rule127 = \ ((_lhsIoptions) :: Options) -> {-# LINE 524 "src-ag/ExecutionPlan2Clean.ag" #-} if lateHigherOrderBinding _lhsIoptions then Map.delete idLateBindingAttr else id {-# LINE 1558 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule128 #-} {-# LINE 527 "src-ag/ExecutionPlan2Clean.ag" #-} rule128 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) nt_ -> {-# LINE 527 "src-ag/ExecutionPlan2Clean.ag" #-} Map.toList $ fromJust $ Map.lookup nt_ _lhsIsynmap {-# LINE 1564 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule129 #-} {-# LINE 528 "src-ag/ExecutionPlan2Clean.ag" #-} rule129 = \ ((_lhsIoptions) :: Options) _wr_inhs -> {-# LINE 528 "src-ag/ExecutionPlan2Clean.ag" #-} map (lhsname _lhsIoptions True . fst) _wr_inhs {-# LINE 1570 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule130 #-} {-# LINE 529 "src-ag/ExecutionPlan2Clean.ag" #-} rule130 = \ ((_lhsIoptions) :: Options) _wr_inhs1 -> {-# LINE 529 "src-ag/ExecutionPlan2Clean.ag" #-} map (lhsname _lhsIoptions True . fst) _wr_inhs1 {-# LINE 1576 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule131 #-} {-# LINE 530 "src-ag/ExecutionPlan2Clean.ag" #-} rule131 = \ ((_lhsIoptions) :: Options) _wr_syns -> {-# LINE 530 "src-ag/ExecutionPlan2Clean.ag" #-} map (lhsname _lhsIoptions False . fst) _wr_syns {-# LINE 1582 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule132 #-} {-# LINE 531 "src-ag/ExecutionPlan2Clean.ag" #-} rule132 = \ nt_ -> {-# LINE 531 "src-ag/ExecutionPlan2Clean.ag" #-} "wrap_" ++ show nt_ {-# LINE 1588 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule133 #-} {-# LINE 532 "src-ag/ExecutionPlan2Clean.ag" #-} rule133 = \ nt_ -> {-# LINE 532 "src-ag/ExecutionPlan2Clean.ag" #-} "Inh_" ++ show nt_ {-# LINE 1594 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule134 #-} {-# LINE 533 "src-ag/ExecutionPlan2Clean.ag" #-} rule134 = \ nt_ -> {-# LINE 533 "src-ag/ExecutionPlan2Clean.ag" #-} "Syn_" ++ show nt_ {-# LINE 1600 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule135 #-} {-# LINE 534 "src-ag/ExecutionPlan2Clean.ag" #-} rule135 = \ initial_ nextVisits_ -> {-# LINE 534 "src-ag/ExecutionPlan2Clean.ag" #-} Map.findWithDefault ManyVis initial_ nextVisits_ {-# LINE 1606 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule136 #-} {-# LINE 535 "src-ag/ExecutionPlan2Clean.ag" #-} rule136 = \ _addbang _addbangWrap _classPP _firstVisitInfo _inhlist _inhlist1 _inhname _k_type ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) ((_lhsImainName) :: String) ((_lhsIoptions) :: Options) _quantPP _synlist _synname _t_params _t_type _wrapname initial_ initialv_ nt_ -> {-# LINE 535 "src-ag/ExecutionPlan2Clean.ag" #-} (_wrapname >#< "::" >#< _quantPP >#< _classPP >#< _t_type >#< _t_params >#< _inhname >#< _t_params >#< "->" >#< ( if monadicWrappers _lhsIoptions then ppMonadType _lhsIoptions else empty) >#< pp_parens (_synname >#< _t_params )) >-< (_wrapname >#< (_addbang $ pp_parens (_t_type >#< pp "act")) >#< (_addbang $ pp_parens (_inhname >#< (ppSpaced $ map (_addbangWrap . pp) _inhlist )) >#< "=")) >-< indent 3 (case initialv_ of [] -> text _synname (initv:_) -> let inCon = conNmTVisitIn nt_ initv outCon = conNmTVisitOut nt_ initv pat = _addbang $ pp_parens $ pat0 pat0 = outCon >#< ppSpaced _synlist arg = inCon >#< ppSpaced _inhlist1 ind = case _firstVisitInfo of NoneVis -> error "wrapper: initial state should have a next visit but it has none" OneVis _ -> empty ManyVis -> _k_type >|< "_v" >|< initv extra = if dummyTokenVisit _lhsIoptions then pp $ dummyArg _lhsIoptions True else empty convert = case Map.lookup initv _lhsIallVisitKinds of Just kind -> case kind of VisitPure _ -> text "lift" VisitMonadic -> empty _ -> empty unMonad | monadicWrappers _lhsIoptions = empty | otherwise = unMon _lhsIoptions in unMonad >#< "(" >-< indent 2 ("act >>= \\" >#< _addbang (pp "sem") >#< "->" >-< "lift" >#< pp_parens arg >#< ">>= \\" >#< _addbangWrap (pp "arg") >#< "->" >-< convert >#< pp_parens ("inv_" >|< nt_ >|< "_s" >|< initial_ >#< "sem" >#< ind >#< "arg" >#< extra) >#< ">>= \\" >#< pat >#< "->" >-< "lift" >#< pp_parens (_synname >#< ppSpaced _synlist ) ) >-< ")" ) >-< if lateHigherOrderBinding _lhsIoptions then indent 2 ("where" >#< lhsname _lhsIoptions True idLateBindingAttr >#< "=" >#< lateBindingFieldNm _lhsImainName) else empty {-# LINE 1650 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule137 #-} {-# LINE 575 "src-ag/ExecutionPlan2Clean.ag" #-} rule137 = \ _classPP _inhname ((_lhsIoptions) :: Options) _quantPP _synname _t_params _t_type _wrapname -> {-# LINE 575 "src-ag/ExecutionPlan2Clean.ag" #-} (_wrapname >#< "::" >#< _quantPP >#< _classPP >#< _t_type >#< _t_params >#< _inhname >#< _t_params >#< "->" >#< ( if monadicWrappers _lhsIoptions then ppMonadType _lhsIoptions else empty) >#< pp_parens (_synname >#< _t_params )) {-# LINE 1657 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule138 #-} {-# LINE 584 "src-ag/ExecutionPlan2Clean.ag" #-} rule138 = \ ((_prodsIsemFunBndDefs) :: Seq PP_Doc) _semFunBndDef -> {-# LINE 584 "src-ag/ExecutionPlan2Clean.ag" #-} _semFunBndDef Seq.<| _prodsIsemFunBndDefs {-# LINE 1663 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule139 #-} {-# LINE 585 "src-ag/ExecutionPlan2Clean.ag" #-} rule139 = \ ((_prodsIsemFunBndTps) :: Seq PP_Doc) _semFunBndTp -> {-# LINE 585 "src-ag/ExecutionPlan2Clean.ag" #-} _semFunBndTp Seq.<| _prodsIsemFunBndTps {-# LINE 1669 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule140 #-} {-# LINE 586 "src-ag/ExecutionPlan2Clean.ag" #-} rule140 = \ _semFunBndNm _semname -> {-# LINE 586 "src-ag/ExecutionPlan2Clean.ag" #-} _semFunBndNm >#< "=" >#< _semname {-# LINE 1675 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule141 #-} {-# LINE 587 "src-ag/ExecutionPlan2Clean.ag" #-} rule141 = \ _semFunBndNm _sem_tp -> {-# LINE 587 "src-ag/ExecutionPlan2Clean.ag" #-} _semFunBndNm >#< "::" >#< _sem_tp {-# LINE 1681 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule142 #-} {-# LINE 588 "src-ag/ExecutionPlan2Clean.ag" #-} rule142 = \ nt_ -> {-# LINE 588 "src-ag/ExecutionPlan2Clean.ag" #-} lateSemNtLabel nt_ {-# LINE 1687 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule143 #-} {-# LINE 622 "src-ag/ExecutionPlan2Clean.ag" #-} rule143 = \ initial_ -> {-# LINE 622 "src-ag/ExecutionPlan2Clean.ag" #-} initial_ {-# LINE 1693 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule144 #-} {-# LINE 623 "src-ag/ExecutionPlan2Clean.ag" #-} rule144 = \ _allstates -> {-# LINE 623 "src-ag/ExecutionPlan2Clean.ag" #-} _allstates {-# LINE 1699 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule145 #-} {-# LINE 1469 "src-ag/ExecutionPlan2Clean.ag" #-} rule145 = \ ((_lhsIwrappers) :: Set NontermIdent) _sem_nt _wr_inh_icl _wr_syn_icl _wrapper_icl nt_ -> {-# LINE 1469 "src-ag/ExecutionPlan2Clean.ag" #-} (if nt_ `Set.member` _lhsIwrappers then _wr_inh_icl >-< _wr_syn_icl >-< _wrapper_icl else empty) >-< _sem_nt {-# LINE 1710 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule146 #-} {-# LINE 1475 "src-ag/ExecutionPlan2Clean.ag" #-} rule146 = \ _datatype _k_states ((_lhsIoptions) :: Options) ((_prodsIt_visits) :: PP_Doc) _t_init_icl _t_states_icl -> {-# LINE 1475 "src-ag/ExecutionPlan2Clean.ag" #-} (if dataTypes _lhsIoptions then _datatype else empty) >-< _t_init_icl >-< _t_states_icl >-< _k_states >-< _prodsIt_visits {-# LINE 1720 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule147 #-} {-# LINE 1566 "src-ag/ExecutionPlan2Clean.ag" #-} rule147 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1566 "src-ag/ExecutionPlan2Clean.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 1726 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule148 #-} {-# LINE 1574 "src-ag/ExecutionPlan2Clean.ag" #-} rule148 = \ (_ :: ()) -> {-# LINE 1574 "src-ag/ExecutionPlan2Clean.ag" #-} id {-# LINE 1732 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule149 #-} {-# LINE 1586 "src-ag/ExecutionPlan2Clean.ag" #-} rule149 = \ nextVisits_ -> {-# LINE 1586 "src-ag/ExecutionPlan2Clean.ag" #-} nextVisits_ {-# LINE 1738 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule150 #-} {-# LINE 1587 "src-ag/ExecutionPlan2Clean.ag" #-} rule150 = \ prevVisits_ -> {-# LINE 1587 "src-ag/ExecutionPlan2Clean.ag" #-} prevVisits_ {-# LINE 1744 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule151 #-} {-# LINE 1631 "src-ag/ExecutionPlan2Clean.ag" #-} rule151 = \ ((_lhsIlocalAttrTypes) :: Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) nt_ -> {-# LINE 1631 "src-ag/ExecutionPlan2Clean.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIlocalAttrTypes {-# LINE 1750 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule152 #-} {-# LINE 1658 "src-ag/ExecutionPlan2Clean.ag" #-} rule152 = \ initial_ nt_ -> {-# LINE 1658 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton nt_ initial_ {-# LINE 1756 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule153 #-} {-# LINE 1672 "src-ag/ExecutionPlan2Clean.ag" #-} rule153 = \ nt_ params_ -> {-# LINE 1672 "src-ag/ExecutionPlan2Clean.ag" #-} NT nt_ (map show params_) False {-# LINE 1762 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule154 #-} rule154 = \ ((_prodsIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _prodsIchildvisit {-# INLINE rule155 #-} rule155 = \ ((_prodsIerrors) :: Seq Error) -> _prodsIerrors {-# INLINE rule156 #-} rule156 = \ ((_prodsIfromToStates) :: Map VisitIdentifier (Int,Int)) -> _prodsIfromToStates {-# INLINE rule157 #-} rule157 = \ ((_prodsIgenProdIO) :: IO ()) -> _prodsIgenProdIO {-# INLINE rule158 #-} rule158 = \ ((_prodsIimports) :: [PP_Doc]) -> _prodsIimports {-# INLINE rule159 #-} rule159 = \ ((_prodsIvisitKinds) :: Map VisitIdentifier VisitKind) -> _prodsIvisitKinds {-# INLINE rule160 #-} rule160 = \ ((_prodsIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _prodsIvisitdefs {-# INLINE rule161 #-} rule161 = \ ((_prodsIvisituses) :: Map VisitIdentifier (Set Identifier)) -> _prodsIvisituses {-# INLINE rule162 #-} rule162 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule163 #-} rule163 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule164 #-} rule164 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule165 #-} rule165 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule166 #-} rule166 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule167 #-} rule167 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule168 #-} rule168 = \ ((_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# INLINE rule169 #-} rule169 = \ ((_lhsIdclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIdclModuleHeader {-# INLINE rule170 #-} rule170 = \ ((_lhsIiclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIiclModuleHeader {-# INLINE rule171 #-} rule171 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule172 #-} rule172 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule173 #-} rule173 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule174 #-} rule174 = \ _ntType -> _ntType {-# INLINE rule175 #-} rule175 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule176 #-} rule176 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks -- ENonterminals ----------------------------------------------- -- wrapper data Inh_ENonterminals = Inh_ENonterminals { allFromToStates_Inh_ENonterminals :: (Map VisitIdentifier (Int,Int)), allInitStates_Inh_ENonterminals :: (Map NontermIdent Int), allVisitKinds_Inh_ENonterminals :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_ENonterminals :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), avisitdefs_Inh_ENonterminals :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_ENonterminals :: (Map VisitIdentifier (Set Identifier)), constructorTypeMap_Inh_ENonterminals :: (Map NontermIdent ConstructorType), dclModuleHeader_Inh_ENonterminals :: (String -> String -> String -> Bool -> String), derivings_Inh_ENonterminals :: (Derivings), iclModuleHeader_Inh_ENonterminals :: (String -> String -> String -> Bool -> String), importBlocks_Inh_ENonterminals :: (PP_Doc), inhmap_Inh_ENonterminals :: (Map NontermIdent Attributes), localAttrTypes_Inh_ENonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))), mainFile_Inh_ENonterminals :: (String), mainName_Inh_ENonterminals :: (String), options_Inh_ENonterminals :: (Options), synmap_Inh_ENonterminals :: (Map NontermIdent Attributes), textBlocks_Inh_ENonterminals :: (PP_Doc), typeSyns_Inh_ENonterminals :: (TypeSyns), wrappers_Inh_ENonterminals :: (Set NontermIdent) } data Syn_ENonterminals = Syn_ENonterminals { appendCommon_Syn_ENonterminals :: ([PP_Doc]), appendMain_Syn_ENonterminals :: ([PP_Doc]), childvisit_Syn_ENonterminals :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), errors_Syn_ENonterminals :: (Seq Error), fromToStates_Syn_ENonterminals :: (Map VisitIdentifier (Int,Int)), genProdIO_Syn_ENonterminals :: (IO ()), imports_Syn_ENonterminals :: ([PP_Doc]), initStates_Syn_ENonterminals :: (Map NontermIdent Int), output_Syn_ENonterminals :: (PP_Doc), output_dcl_Syn_ENonterminals :: (PP_Doc), semFunBndDefs_Syn_ENonterminals :: (Seq PP_Doc), semFunBndTps_Syn_ENonterminals :: (Seq PP_Doc), visitKinds_Syn_ENonterminals :: (Map VisitIdentifier VisitKind), visitdefs_Syn_ENonterminals :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_ENonterminals :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_ENonterminals #-} wrap_ENonterminals :: T_ENonterminals -> Inh_ENonterminals -> (Syn_ENonterminals ) wrap_ENonterminals (T_ENonterminals act) (Inh_ENonterminals _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIderivings _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do sem <- act let arg10 = T_ENonterminals_vIn10 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIderivings _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers (T_ENonterminals_vOut10 _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOoutput_dcl _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_ENonterminals_s11 sem arg10) return (Syn_ENonterminals _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOoutput_dcl _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# NOINLINE sem_ENonterminals #-} sem_ENonterminals :: ENonterminals -> T_ENonterminals sem_ENonterminals list = Prelude.foldr sem_ENonterminals_Cons sem_ENonterminals_Nil (Prelude.map sem_ENonterminal list) -- semantic domain newtype T_ENonterminals = T_ENonterminals { attach_T_ENonterminals :: Identity (T_ENonterminals_s11 ) } newtype T_ENonterminals_s11 = C_ENonterminals_s11 { inv_ENonterminals_s11 :: (T_ENonterminals_v10 ) } data T_ENonterminals_s12 = C_ENonterminals_s12 type T_ENonterminals_v10 = (T_ENonterminals_vIn10 ) -> (T_ENonterminals_vOut10 ) data T_ENonterminals_vIn10 = T_ENonterminals_vIn10 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Int) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map NontermIdent ConstructorType) (String -> String -> String -> Bool -> String) (Derivings) (String -> String -> String -> Bool -> String) (PP_Doc) (Map NontermIdent Attributes) (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) (String) (String) (Options) (Map NontermIdent Attributes) (PP_Doc) (TypeSyns) (Set NontermIdent) data T_ENonterminals_vOut10 = T_ENonterminals_vOut10 ([PP_Doc]) ([PP_Doc]) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Seq Error) (Map VisitIdentifier (Int,Int)) (IO ()) ([PP_Doc]) (Map NontermIdent Int) (PP_Doc) (PP_Doc) (Seq PP_Doc) (Seq PP_Doc) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_ENonterminals_Cons #-} sem_ENonterminals_Cons :: T_ENonterminal -> T_ENonterminals -> T_ENonterminals sem_ENonterminals_Cons arg_hd_ arg_tl_ = T_ENonterminals (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_ENonterminals_v10 v10 = \ (T_ENonterminals_vIn10 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIderivings _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers) -> ( let _hdX8 = Control.Monad.Identity.runIdentity (attach_T_ENonterminal (arg_hd_)) _tlX11 = Control.Monad.Identity.runIdentity (attach_T_ENonterminals (arg_tl_)) (T_ENonterminal_vOut7 _hdIappendCommon _hdIappendMain _hdIchildvisit _hdIerrors _hdIfromToStates _hdIgenProdIO _hdIimports _hdIinitStates _hdIoutput _hdIoutput_dcl _hdIsemFunBndDefs _hdIsemFunBndTps _hdIvisitKinds _hdIvisitdefs _hdIvisituses) = inv_ENonterminal_s8 _hdX8 (T_ENonterminal_vIn7 _hdOallFromToStates _hdOallInitStates _hdOallVisitKinds _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOconstructorTypeMap _hdOdclModuleHeader _hdOderivings _hdOiclModuleHeader _hdOimportBlocks _hdOinhmap _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOoptions _hdOsynmap _hdOtextBlocks _hdOtypeSyns _hdOwrappers) (T_ENonterminals_vOut10 _tlIappendCommon _tlIappendMain _tlIchildvisit _tlIerrors _tlIfromToStates _tlIgenProdIO _tlIimports _tlIinitStates _tlIoutput _tlIoutput_dcl _tlIsemFunBndDefs _tlIsemFunBndTps _tlIvisitKinds _tlIvisitdefs _tlIvisituses) = inv_ENonterminals_s11 _tlX11 (T_ENonterminals_vIn10 _tlOallFromToStates _tlOallInitStates _tlOallVisitKinds _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOconstructorTypeMap _tlOdclModuleHeader _tlOderivings _tlOiclModuleHeader _tlOimportBlocks _tlOinhmap _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOoptions _tlOsynmap _tlOtextBlocks _tlOtypeSyns _tlOwrappers) _lhsOappendCommon :: [PP_Doc] _lhsOappendCommon = rule177 _hdIappendCommon _tlIappendCommon _lhsOappendMain :: [PP_Doc] _lhsOappendMain = rule178 _hdIappendMain _tlIappendMain _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule179 _hdIchildvisit _tlIchildvisit _lhsOerrors :: Seq Error _lhsOerrors = rule180 _hdIerrors _tlIerrors _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule181 _hdIfromToStates _tlIfromToStates _lhsOgenProdIO :: IO () _lhsOgenProdIO = rule182 _hdIgenProdIO _tlIgenProdIO _lhsOimports :: [PP_Doc] _lhsOimports = rule183 _hdIimports _tlIimports _lhsOinitStates :: Map NontermIdent Int _lhsOinitStates = rule184 _hdIinitStates _tlIinitStates _lhsOoutput :: PP_Doc _lhsOoutput = rule185 _hdIoutput _tlIoutput _lhsOoutput_dcl :: PP_Doc _lhsOoutput_dcl = rule186 _hdIoutput_dcl _tlIoutput_dcl _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule187 _hdIsemFunBndDefs _tlIsemFunBndDefs _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule188 _hdIsemFunBndTps _tlIsemFunBndTps _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule189 _hdIvisitKinds _tlIvisitKinds _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule190 _hdIvisitdefs _tlIvisitdefs _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule191 _hdIvisituses _tlIvisituses _hdOallFromToStates = rule192 _lhsIallFromToStates _hdOallInitStates = rule193 _lhsIallInitStates _hdOallVisitKinds = rule194 _lhsIallVisitKinds _hdOallchildvisit = rule195 _lhsIallchildvisit _hdOavisitdefs = rule196 _lhsIavisitdefs _hdOavisituses = rule197 _lhsIavisituses _hdOconstructorTypeMap = rule198 _lhsIconstructorTypeMap _hdOdclModuleHeader = rule199 _lhsIdclModuleHeader _hdOderivings = rule200 _lhsIderivings _hdOiclModuleHeader = rule201 _lhsIiclModuleHeader _hdOimportBlocks = rule202 _lhsIimportBlocks _hdOinhmap = rule203 _lhsIinhmap _hdOlocalAttrTypes = rule204 _lhsIlocalAttrTypes _hdOmainFile = rule205 _lhsImainFile _hdOmainName = rule206 _lhsImainName _hdOoptions = rule207 _lhsIoptions _hdOsynmap = rule208 _lhsIsynmap _hdOtextBlocks = rule209 _lhsItextBlocks _hdOtypeSyns = rule210 _lhsItypeSyns _hdOwrappers = rule211 _lhsIwrappers _tlOallFromToStates = rule212 _lhsIallFromToStates _tlOallInitStates = rule213 _lhsIallInitStates _tlOallVisitKinds = rule214 _lhsIallVisitKinds _tlOallchildvisit = rule215 _lhsIallchildvisit _tlOavisitdefs = rule216 _lhsIavisitdefs _tlOavisituses = rule217 _lhsIavisituses _tlOconstructorTypeMap = rule218 _lhsIconstructorTypeMap _tlOdclModuleHeader = rule219 _lhsIdclModuleHeader _tlOderivings = rule220 _lhsIderivings _tlOiclModuleHeader = rule221 _lhsIiclModuleHeader _tlOimportBlocks = rule222 _lhsIimportBlocks _tlOinhmap = rule223 _lhsIinhmap _tlOlocalAttrTypes = rule224 _lhsIlocalAttrTypes _tlOmainFile = rule225 _lhsImainFile _tlOmainName = rule226 _lhsImainName _tlOoptions = rule227 _lhsIoptions _tlOsynmap = rule228 _lhsIsynmap _tlOtextBlocks = rule229 _lhsItextBlocks _tlOtypeSyns = rule230 _lhsItypeSyns _tlOwrappers = rule231 _lhsIwrappers __result_ = T_ENonterminals_vOut10 _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOoutput_dcl _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_ENonterminals_s11 v10 {-# INLINE rule177 #-} rule177 = \ ((_hdIappendCommon) :: PP_Doc ) ((_tlIappendCommon) :: [PP_Doc]) -> _hdIappendCommon : _tlIappendCommon {-# INLINE rule178 #-} rule178 = \ ((_hdIappendMain) :: PP_Doc ) ((_tlIappendMain) :: [PP_Doc]) -> _hdIappendMain : _tlIappendMain {-# INLINE rule179 #-} rule179 = \ ((_hdIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) ((_tlIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _hdIchildvisit `Map.union` _tlIchildvisit {-# INLINE rule180 #-} rule180 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule181 #-} rule181 = \ ((_hdIfromToStates) :: Map VisitIdentifier (Int,Int)) ((_tlIfromToStates) :: Map VisitIdentifier (Int,Int)) -> _hdIfromToStates `mappend` _tlIfromToStates {-# INLINE rule182 #-} rule182 = \ ((_hdIgenProdIO) :: IO ()) ((_tlIgenProdIO) :: IO ()) -> _hdIgenProdIO >> _tlIgenProdIO {-# INLINE rule183 #-} rule183 = \ ((_hdIimports) :: [PP_Doc]) ((_tlIimports) :: [PP_Doc]) -> _hdIimports ++ _tlIimports {-# INLINE rule184 #-} rule184 = \ ((_hdIinitStates) :: Map NontermIdent Int) ((_tlIinitStates) :: Map NontermIdent Int) -> _hdIinitStates `mappend` _tlIinitStates {-# INLINE rule185 #-} rule185 = \ ((_hdIoutput) :: PP_Doc) ((_tlIoutput) :: PP_Doc) -> _hdIoutput >-< _tlIoutput {-# INLINE rule186 #-} rule186 = \ ((_hdIoutput_dcl) :: PP_Doc) ((_tlIoutput_dcl) :: PP_Doc) -> _hdIoutput_dcl >-< _tlIoutput_dcl {-# INLINE rule187 #-} rule187 = \ ((_hdIsemFunBndDefs) :: Seq PP_Doc) ((_tlIsemFunBndDefs) :: Seq PP_Doc) -> _hdIsemFunBndDefs Seq.>< _tlIsemFunBndDefs {-# INLINE rule188 #-} rule188 = \ ((_hdIsemFunBndTps) :: Seq PP_Doc) ((_tlIsemFunBndTps) :: Seq PP_Doc) -> _hdIsemFunBndTps Seq.>< _tlIsemFunBndTps {-# INLINE rule189 #-} rule189 = \ ((_hdIvisitKinds) :: Map VisitIdentifier VisitKind) ((_tlIvisitKinds) :: Map VisitIdentifier VisitKind) -> _hdIvisitKinds `mappend` _tlIvisitKinds {-# INLINE rule190 #-} rule190 = \ ((_hdIvisitdefs) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisitdefs `uwSetUnion` _tlIvisitdefs {-# INLINE rule191 #-} rule191 = \ ((_hdIvisituses) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisituses) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisituses `uwSetUnion` _tlIvisituses {-# INLINE rule192 #-} rule192 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule193 #-} rule193 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule194 #-} rule194 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule195 #-} rule195 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule196 #-} rule196 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule197 #-} rule197 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule198 #-} rule198 = \ ((_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# INLINE rule199 #-} rule199 = \ ((_lhsIdclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIdclModuleHeader {-# INLINE rule200 #-} rule200 = \ ((_lhsIderivings) :: Derivings) -> _lhsIderivings {-# INLINE rule201 #-} rule201 = \ ((_lhsIiclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIiclModuleHeader {-# INLINE rule202 #-} rule202 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule203 #-} rule203 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) -> _lhsIinhmap {-# INLINE rule204 #-} rule204 = \ ((_lhsIlocalAttrTypes) :: Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) -> _lhsIlocalAttrTypes {-# INLINE rule205 #-} rule205 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule206 #-} rule206 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule207 #-} rule207 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule208 #-} rule208 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) -> _lhsIsynmap {-# INLINE rule209 #-} rule209 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule210 #-} rule210 = \ ((_lhsItypeSyns) :: TypeSyns) -> _lhsItypeSyns {-# INLINE rule211 #-} rule211 = \ ((_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# INLINE rule212 #-} rule212 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule213 #-} rule213 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule214 #-} rule214 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule215 #-} rule215 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule216 #-} rule216 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule217 #-} rule217 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule218 #-} rule218 = \ ((_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# INLINE rule219 #-} rule219 = \ ((_lhsIdclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIdclModuleHeader {-# INLINE rule220 #-} rule220 = \ ((_lhsIderivings) :: Derivings) -> _lhsIderivings {-# INLINE rule221 #-} rule221 = \ ((_lhsIiclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIiclModuleHeader {-# INLINE rule222 #-} rule222 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule223 #-} rule223 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) -> _lhsIinhmap {-# INLINE rule224 #-} rule224 = \ ((_lhsIlocalAttrTypes) :: Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) -> _lhsIlocalAttrTypes {-# INLINE rule225 #-} rule225 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule226 #-} rule226 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule227 #-} rule227 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule228 #-} rule228 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) -> _lhsIsynmap {-# INLINE rule229 #-} rule229 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule230 #-} rule230 = \ ((_lhsItypeSyns) :: TypeSyns) -> _lhsItypeSyns {-# INLINE rule231 #-} rule231 = \ ((_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# NOINLINE sem_ENonterminals_Nil #-} sem_ENonterminals_Nil :: T_ENonterminals sem_ENonterminals_Nil = T_ENonterminals (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_ENonterminals_v10 v10 = \ (T_ENonterminals_vIn10 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIderivings _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers) -> ( let _lhsOappendCommon :: [PP_Doc] _lhsOappendCommon = rule232 () _lhsOappendMain :: [PP_Doc] _lhsOappendMain = rule233 () _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule234 () _lhsOerrors :: Seq Error _lhsOerrors = rule235 () _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule236 () _lhsOgenProdIO :: IO () _lhsOgenProdIO = rule237 () _lhsOimports :: [PP_Doc] _lhsOimports = rule238 () _lhsOinitStates :: Map NontermIdent Int _lhsOinitStates = rule239 () _lhsOoutput :: PP_Doc _lhsOoutput = rule240 () _lhsOoutput_dcl :: PP_Doc _lhsOoutput_dcl = rule241 () _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule242 () _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule243 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule244 () _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule245 () _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule246 () __result_ = T_ENonterminals_vOut10 _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOoutput_dcl _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_ENonterminals_s11 v10 {-# INLINE rule232 #-} rule232 = \ (_ :: ()) -> [] {-# INLINE rule233 #-} rule233 = \ (_ :: ()) -> [] {-# INLINE rule234 #-} rule234 = \ (_ :: ()) -> Map.empty {-# INLINE rule235 #-} rule235 = \ (_ :: ()) -> Seq.empty {-# INLINE rule236 #-} rule236 = \ (_ :: ()) -> mempty {-# INLINE rule237 #-} rule237 = \ (_ :: ()) -> return () {-# INLINE rule238 #-} rule238 = \ (_ :: ()) -> [] {-# INLINE rule239 #-} rule239 = \ (_ :: ()) -> mempty {-# INLINE rule240 #-} rule240 = \ (_ :: ()) -> empty {-# INLINE rule241 #-} rule241 = \ (_ :: ()) -> empty {-# INLINE rule242 #-} rule242 = \ (_ :: ()) -> Seq.empty {-# INLINE rule243 #-} rule243 = \ (_ :: ()) -> Seq.empty {-# INLINE rule244 #-} rule244 = \ (_ :: ()) -> mempty {-# INLINE rule245 #-} rule245 = \ (_ :: ()) -> Map.empty {-# INLINE rule246 #-} rule246 = \ (_ :: ()) -> Map.empty -- EProduction ------------------------------------------------- -- wrapper data Inh_EProduction = Inh_EProduction { allFromToStates_Inh_EProduction :: (Map VisitIdentifier (Int,Int)), allInhmap_Inh_EProduction :: (Map NontermIdent Attributes), allInitStates_Inh_EProduction :: (Map NontermIdent Int), allSynmap_Inh_EProduction :: (Map NontermIdent Attributes), allVisitKinds_Inh_EProduction :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_EProduction :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), allstates_Inh_EProduction :: (Set StateIdentifier), avisitdefs_Inh_EProduction :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_EProduction :: (Map VisitIdentifier (Set Identifier)), classCtxs_Inh_EProduction :: (ClassContext), constructorTypeMap_Inh_EProduction :: (Map NontermIdent ConstructorType), dclModuleHeader_Inh_EProduction :: (String -> String -> String -> Bool -> String), iclModuleHeader_Inh_EProduction :: (String -> String -> String -> Bool -> String), importBlocks_Inh_EProduction :: (PP_Doc), inhmap_Inh_EProduction :: (Attributes), initial_Inh_EProduction :: (StateIdentifier), localAttrTypes_Inh_EProduction :: (Map ConstructorIdent (Map Identifier Type)), mainFile_Inh_EProduction :: (String), mainName_Inh_EProduction :: (String), nextVisits_Inh_EProduction :: (Map StateIdentifier StateCtx), nt_Inh_EProduction :: (NontermIdent), ntType_Inh_EProduction :: (Type), options_Inh_EProduction :: (Options), params_Inh_EProduction :: ([Identifier]), prevVisits_Inh_EProduction :: (Map StateIdentifier StateCtx), rename_Inh_EProduction :: (Bool), synmap_Inh_EProduction :: (Attributes), textBlocks_Inh_EProduction :: (PP_Doc) } data Syn_EProduction = Syn_EProduction { allvisits_Syn_EProduction :: ([VisitStateState]), childvisit_Syn_EProduction :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), count_Syn_EProduction :: (Int), datatype_Syn_EProduction :: (PP_Doc), errors_Syn_EProduction :: (Seq Error), fromToStates_Syn_EProduction :: (Map VisitIdentifier (Int,Int)), genProdIO_Syn_EProduction :: (IO ()), imports_Syn_EProduction :: ([PP_Doc]), recordtype_Syn_EProduction :: (PP_Doc), semFunBndDefs_Syn_EProduction :: (Seq PP_Doc), semFunBndTps_Syn_EProduction :: (Seq PP_Doc), sem_nt_Syn_EProduction :: (PP_Doc), sem_prod_Syn_EProduction :: (PP_Doc), sem_prod_tys_Syn_EProduction :: (PP_Doc), t_visits_Syn_EProduction :: (PP_Doc), visitKinds_Syn_EProduction :: (Map VisitIdentifier VisitKind), visitdefs_Syn_EProduction :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_EProduction :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_EProduction #-} wrap_EProduction :: T_EProduction -> Inh_EProduction -> (Syn_EProduction ) wrap_EProduction (T_EProduction act) (Inh_EProduction _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do sem <- act let arg13 = T_EProduction_vIn13 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks (T_EProduction_vOut13 _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOrecordtype _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOsem_prod_tys _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_EProduction_s14 sem arg13) return (Syn_EProduction _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOrecordtype _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOsem_prod_tys _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# INLINE sem_EProduction #-} sem_EProduction :: EProduction -> T_EProduction sem_EProduction ( EProduction con_ params_ constraints_ rules_ children_ visits_ ) = sem_EProduction_EProduction con_ params_ constraints_ ( sem_ERules rules_ ) ( sem_EChildren children_ ) ( sem_Visits visits_ ) -- semantic domain newtype T_EProduction = T_EProduction { attach_T_EProduction :: Identity (T_EProduction_s14 ) } newtype T_EProduction_s14 = C_EProduction_s14 { inv_EProduction_s14 :: (T_EProduction_v13 ) } data T_EProduction_s15 = C_EProduction_s15 type T_EProduction_v13 = (T_EProduction_vIn13 ) -> (T_EProduction_vOut13 ) data T_EProduction_vIn13 = T_EProduction_vIn13 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Attributes) (Map NontermIdent Int) (Map NontermIdent Attributes) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Set StateIdentifier) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (ClassContext) (Map NontermIdent ConstructorType) (String -> String -> String -> Bool -> String) (String -> String -> String -> Bool -> String) (PP_Doc) (Attributes) (StateIdentifier) (Map ConstructorIdent (Map Identifier Type)) (String) (String) (Map StateIdentifier StateCtx) (NontermIdent) (Type) (Options) ([Identifier]) (Map StateIdentifier StateCtx) (Bool) (Attributes) (PP_Doc) data T_EProduction_vOut13 = T_EProduction_vOut13 ([VisitStateState]) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Int) (PP_Doc) (Seq Error) (Map VisitIdentifier (Int,Int)) (IO ()) ([PP_Doc]) (PP_Doc) (Seq PP_Doc) (Seq PP_Doc) (PP_Doc) (PP_Doc) (PP_Doc) (PP_Doc) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_EProduction_EProduction #-} sem_EProduction_EProduction :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_ERules -> T_EChildren -> T_Visits -> T_EProduction sem_EProduction_EProduction arg_con_ arg_params_ arg_constraints_ arg_rules_ arg_children_ arg_visits_ = T_EProduction (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_EProduction_v13 v13 = \ (T_EProduction_vIn13 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks) -> ( let _rulesX23 = Control.Monad.Identity.runIdentity (attach_T_ERules (arg_rules_)) _childrenX5 = Control.Monad.Identity.runIdentity (attach_T_EChildren (arg_children_)) _visitsX56 = Control.Monad.Identity.runIdentity (attach_T_Visits (arg_visits_)) (T_ERules_vOut22 _rulesIerrors _rulesImrules _rulesIruledefs _rulesIruleuses _rulesIsem_rules _rulesIusedArgs) = inv_ERules_s23 _rulesX23 (T_ERules_vIn22 _rulesOallInhmap _rulesOallSynmap _rulesOchildTypes _rulesOcon _rulesOconstructorTypeMap _rulesOdclModuleHeader _rulesOiclModuleHeader _rulesOimportBlocks _rulesOinhmap _rulesOlazyIntras _rulesOlocalAttrTypes _rulesOmainFile _rulesOmainName _rulesOnt _rulesOoptions _rulesOruleKinds _rulesOsynmap _rulesOtextBlocks _rulesOusageInfo) (T_EChildren_vOut4 _childrenIargnamesw _childrenIargpats _childrenIargtps _childrenIchildTypes _childrenIchildintros _childrenIdatatype _childrenIrecfields _childrenIrecordtype _childrenIterminaldefs _childrenIusedArgs) = inv_EChildren_s5 _childrenX5 (T_EChildren_vIn4 _childrenOallInitStates _childrenOcon _childrenOconstructorTypeMap _childrenOdclModuleHeader _childrenOiclModuleHeader _childrenOimportBlocks _childrenOmainFile _childrenOmainName _childrenOnt _childrenOoptions _childrenOtextBlocks) (T_Visits_vOut55 _visitsIallvisits _visitsIchildvisit _visitsIerrors _visitsIfromToStates _visitsIintramap _visitsIlazyIntras _visitsIruleKinds _visitsIruleUsage _visitsIsem_visit _visitsIt_visits _visitsIusedArgs _visitsIvisitKinds _visitsIvisitdefs _visitsIvisituses) = inv_Visits_s56 _visitsX56 (T_Visits_vIn55 _visitsOallFromToStates _visitsOallInhmap _visitsOallInitStates _visitsOallSynmap _visitsOallVisitKinds _visitsOallchildvisit _visitsOallintramap _visitsOavisitdefs _visitsOavisituses _visitsOchildTypes _visitsOchildintros _visitsOcon _visitsOinhmap _visitsOmrules _visitsOnextVisits _visitsOnt _visitsOoptions _visitsOparams _visitsOprevVisits _visitsOruledefs _visitsOruleuses _visitsOsynmap _visitsOterminaldefs) _childrenOcon = rule247 arg_con_ _rulesOcon = rule248 arg_con_ _visitsOcon = rule249 arg_con_ _lhsOdatatype :: PP_Doc _lhsOdatatype = rule250 _childrenIdatatype _classPP1 _lhsInt _lhsIoptions _lhsIrename _quantPP1 arg_con_ _lhsOrecordtype :: PP_Doc _lhsOrecordtype = rule251 _childrenIrecordtype _classPP1 _quantPP1 _classPP1 = rule252 arg_constraints_ _quantPP1 = rule253 arg_params_ _lhsOcount :: Int _lhsOcount = rule254 () _lhsOsem_nt :: PP_Doc _lhsOsem_nt = rule255 _childrenIargnamesw _childrenIargpats _childrenIrecfields _lhsIconstructorTypeMap _lhsInt _lhsIrename arg_con_ _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule256 _semFunBndDef _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule257 _semFunBndTp _semFunBndDef = rule258 _semFunBndNm _semname _semFunBndTp = rule259 _semFunBndNm _sem_tp _semFunBndNm = rule260 _lhsInt arg_con_ _t_type = rule261 _lhsInt _t_params = rule262 _lhsIparams _usedArgs = rule263 _childrenIusedArgs _rulesIusedArgs _visitsIusedArgs _args = rule264 _childrenIargpats _usedArgs _semname = rule265 _lhsInt arg_con_ _sem_tp = rule266 _childrenIargtps _classPP2 _quantPP2 _t_params _t_type _classPP2 = rule267 _lhsIclassCtxs arg_constraints_ _quantPP2 = rule268 _lhsIparams arg_params_ _lhsOsem_prod_tys :: PP_Doc _lhsOsem_prod_tys = rule269 _sem_tp _semname _sem_prod = rule270 _args _lhsIinitial _mbInitializer _mkSemBody _outerlet _sem_tp _semname _t_type _mkSemBody = rule271 () _mbInitializer = rule272 _lhsIoptions _outerlet = rule273 _rulesIsem_rules _statefns _statefns = rule274 _genstfn _lhsIallstates _genstfn = rule275 _addbang _lhsIinitial _lhsInextVisits _lhsInt _lhsIprevVisits _stargs _stks _stvs _stargs = rule276 _addbang _childTypes _lazyIntras _lhsIallInhmap _lhsIallSynmap _lhsIoptions _localAttrTypes _visitsIintramap _stks = rule277 _lhsInt _stvisits _t_params _stvisits = rule278 _visitsIallvisits _stvs = rule279 _visitsIsem_visit _visitsOmrules = rule280 _rulesImrules _visitsOchildintros = rule281 _childrenIchildintros _rulesOusageInfo = rule282 _visitsIruleUsage _rulesOruleKinds = rule283 _visitsIruleKinds _visitsOallintramap = rule284 _visitsIintramap _visitsOterminaldefs = rule285 _childrenIterminaldefs _visitsOruledefs = rule286 _rulesIruledefs _visitsOruleuses = rule287 _rulesIruleuses _lazyIntras = rule288 _visitsIlazyIntras _lhsOimports :: [PP_Doc] _lhsOimports = rule289 _moduleName _moduleName = rule290 _lhsImainName _suffix _suffix = rule291 _lhsInt arg_con_ _outputfile = rule292 _lhsImainFile _suffix _ppMonadImports = rule293 () _lhsOgenProdIO :: IO () _lhsOgenProdIO = rule294 _lhsIiclModuleHeader _lhsIimportBlocks _lhsImainName _outputfile _ppMonadImports _sem_prod _semname _suffix _addbang = rule295 _lhsIoptions _childTypes = rule296 _childrenIchildTypes _lhsIntType _localAttrTypes = rule297 _lhsIlocalAttrTypes arg_con_ _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule298 _visitsIchildvisit _lhsOerrors :: Seq Error _lhsOerrors = rule299 _rulesIerrors _visitsIerrors _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule300 _visitsIfromToStates _lhsOt_visits :: PP_Doc _lhsOt_visits = rule301 _visitsIt_visits _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule302 _visitsIvisitKinds _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule303 _visitsIvisitdefs _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule304 _visitsIvisituses _lhsOallvisits :: [VisitStateState] _lhsOallvisits = rule305 _visitsIallvisits _lhsOsem_prod :: PP_Doc _lhsOsem_prod = rule306 _sem_prod _rulesOallInhmap = rule307 _lhsIallInhmap _rulesOallSynmap = rule308 _lhsIallSynmap _rulesOchildTypes = rule309 _childTypes _rulesOconstructorTypeMap = rule310 _lhsIconstructorTypeMap _rulesOdclModuleHeader = rule311 _lhsIdclModuleHeader _rulesOiclModuleHeader = rule312 _lhsIiclModuleHeader _rulesOimportBlocks = rule313 _lhsIimportBlocks _rulesOinhmap = rule314 _lhsIinhmap _rulesOlazyIntras = rule315 _lazyIntras _rulesOlocalAttrTypes = rule316 _localAttrTypes _rulesOmainFile = rule317 _lhsImainFile _rulesOmainName = rule318 _lhsImainName _rulesOnt = rule319 _lhsInt _rulesOoptions = rule320 _lhsIoptions _rulesOsynmap = rule321 _lhsIsynmap _rulesOtextBlocks = rule322 _lhsItextBlocks _childrenOallInitStates = rule323 _lhsIallInitStates _childrenOconstructorTypeMap = rule324 _lhsIconstructorTypeMap _childrenOdclModuleHeader = rule325 _lhsIdclModuleHeader _childrenOiclModuleHeader = rule326 _lhsIiclModuleHeader _childrenOimportBlocks = rule327 _lhsIimportBlocks _childrenOmainFile = rule328 _lhsImainFile _childrenOmainName = rule329 _lhsImainName _childrenOnt = rule330 _lhsInt _childrenOoptions = rule331 _lhsIoptions _childrenOtextBlocks = rule332 _lhsItextBlocks _visitsOallFromToStates = rule333 _lhsIallFromToStates _visitsOallInhmap = rule334 _lhsIallInhmap _visitsOallInitStates = rule335 _lhsIallInitStates _visitsOallSynmap = rule336 _lhsIallSynmap _visitsOallVisitKinds = rule337 _lhsIallVisitKinds _visitsOallchildvisit = rule338 _lhsIallchildvisit _visitsOavisitdefs = rule339 _lhsIavisitdefs _visitsOavisituses = rule340 _lhsIavisituses _visitsOchildTypes = rule341 _childTypes _visitsOinhmap = rule342 _lhsIinhmap _visitsOnextVisits = rule343 _lhsInextVisits _visitsOnt = rule344 _lhsInt _visitsOoptions = rule345 _lhsIoptions _visitsOparams = rule346 _lhsIparams _visitsOprevVisits = rule347 _lhsIprevVisits _visitsOsynmap = rule348 _lhsIsynmap __result_ = T_EProduction_vOut13 _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOrecordtype _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOsem_prod_tys _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_EProduction_s14 v13 {-# INLINE rule247 #-} {-# LINE 72 "src-ag/ExecutionPlan2Clean.ag" #-} rule247 = \ con_ -> {-# LINE 72 "src-ag/ExecutionPlan2Clean.ag" #-} con_ {-# LINE 2369 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule248 #-} {-# LINE 73 "src-ag/ExecutionPlan2Clean.ag" #-} rule248 = \ con_ -> {-# LINE 73 "src-ag/ExecutionPlan2Clean.ag" #-} con_ {-# LINE 2375 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule249 #-} {-# LINE 74 "src-ag/ExecutionPlan2Clean.ag" #-} rule249 = \ con_ -> {-# LINE 74 "src-ag/ExecutionPlan2Clean.ag" #-} con_ {-# LINE 2381 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule250 #-} {-# LINE 215 "src-ag/ExecutionPlan2Clean.ag" #-} rule250 = \ ((_childrenIdatatype) :: [PP_Doc]) _classPP1 ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) ((_lhsIrename) :: Bool) _quantPP1 con_ -> {-# LINE 215 "src-ag/ExecutionPlan2Clean.ag" #-} _quantPP1 >#< _classPP1 >#< conname _lhsIrename _lhsInt con_ >#< ppConFields (dataRecords _lhsIoptions) _childrenIdatatype {-# LINE 2389 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule251 #-} {-# LINE 218 "src-ag/ExecutionPlan2Clean.ag" #-} rule251 = \ ((_childrenIrecordtype) :: [PP_Doc]) _classPP1 _quantPP1 -> {-# LINE 218 "src-ag/ExecutionPlan2Clean.ag" #-} _quantPP1 >#< _classPP1 >#< ppConFields True _childrenIrecordtype {-# LINE 2396 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule252 #-} {-# LINE 220 "src-ag/ExecutionPlan2Clean.ag" #-} rule252 = \ constraints_ -> {-# LINE 220 "src-ag/ExecutionPlan2Clean.ag" #-} ppClasses (classConstrsToDocs constraints_) {-# LINE 2402 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule253 #-} {-# LINE 221 "src-ag/ExecutionPlan2Clean.ag" #-} rule253 = \ params_ -> {-# LINE 221 "src-ag/ExecutionPlan2Clean.ag" #-} ppQuants params_ {-# LINE 2408 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule254 #-} {-# LINE 320 "src-ag/ExecutionPlan2Clean.ag" #-} rule254 = \ (_ :: ()) -> {-# LINE 320 "src-ag/ExecutionPlan2Clean.ag" #-} 1 {-# LINE 2414 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule255 #-} {-# LINE 325 "src-ag/ExecutionPlan2Clean.ag" #-} rule255 = \ ((_childrenIargnamesw) :: [PP_Doc]) ((_childrenIargpats) :: [PP_Doc] ) ((_childrenIrecfields) :: [Identifier] ) ((_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) ((_lhsInt) :: NontermIdent) ((_lhsIrename) :: Bool) con_ -> {-# LINE 325 "src-ag/ExecutionPlan2Clean.ag" #-} let lhs = "sem_" >|< _lhsInt rhs = "=" >#< "sem_" >|< _lhsInt >|< "_" >|< con_ >#< ppSpaced _childrenIargnamesw cnnm = conname _lhsIrename _lhsInt con_ in if isRecordConstructor _lhsInt _lhsIconstructorTypeMap then lhs >#< "{" >#< cnnm >#< "|" >#< pp_block "" "" "," (zipWith (\l r -> l >#< "=" >#< r) _childrenIrecfields _childrenIargpats) >#< "}" >#< rhs else lhs >#< "(" >#< cnnm >#< ppSpaced _childrenIargpats >#< ")" >#< rhs {-# LINE 2426 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule256 #-} {-# LINE 591 "src-ag/ExecutionPlan2Clean.ag" #-} rule256 = \ _semFunBndDef -> {-# LINE 591 "src-ag/ExecutionPlan2Clean.ag" #-} Seq.singleton _semFunBndDef {-# LINE 2432 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule257 #-} {-# LINE 592 "src-ag/ExecutionPlan2Clean.ag" #-} rule257 = \ _semFunBndTp -> {-# LINE 592 "src-ag/ExecutionPlan2Clean.ag" #-} Seq.singleton _semFunBndTp {-# LINE 2438 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule258 #-} {-# LINE 593 "src-ag/ExecutionPlan2Clean.ag" #-} rule258 = \ _semFunBndNm _semname -> {-# LINE 593 "src-ag/ExecutionPlan2Clean.ag" #-} _semFunBndNm >#< "=" >#< _semname {-# LINE 2444 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule259 #-} {-# LINE 594 "src-ag/ExecutionPlan2Clean.ag" #-} rule259 = \ _semFunBndNm _sem_tp -> {-# LINE 594 "src-ag/ExecutionPlan2Clean.ag" #-} _semFunBndNm >#< "::" >#< _sem_tp {-# LINE 2450 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule260 #-} {-# LINE 595 "src-ag/ExecutionPlan2Clean.ag" #-} rule260 = \ ((_lhsInt) :: NontermIdent) con_ -> {-# LINE 595 "src-ag/ExecutionPlan2Clean.ag" #-} lateSemConLabel _lhsInt con_ {-# LINE 2456 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule261 #-} {-# LINE 659 "src-ag/ExecutionPlan2Clean.ag" #-} rule261 = \ ((_lhsInt) :: NontermIdent) -> {-# LINE 659 "src-ag/ExecutionPlan2Clean.ag" #-} "T_" >|< _lhsInt {-# LINE 2462 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule262 #-} {-# LINE 660 "src-ag/ExecutionPlan2Clean.ag" #-} rule262 = \ ((_lhsIparams) :: [Identifier]) -> {-# LINE 660 "src-ag/ExecutionPlan2Clean.ag" #-} ppSpaced _lhsIparams {-# LINE 2468 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule263 #-} {-# LINE 661 "src-ag/ExecutionPlan2Clean.ag" #-} rule263 = \ ((_childrenIusedArgs) :: Set String) ((_rulesIusedArgs) :: Set String) ((_visitsIusedArgs) :: Set String) -> {-# LINE 661 "src-ag/ExecutionPlan2Clean.ag" #-} _childrenIusedArgs `Set.union` _visitsIusedArgs `Set.union` _rulesIusedArgs {-# LINE 2474 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule264 #-} {-# LINE 664 "src-ag/ExecutionPlan2Clean.ag" #-} rule264 = \ ((_childrenIargpats) :: [PP_Doc] ) _usedArgs -> {-# LINE 664 "src-ag/ExecutionPlan2Clean.ag" #-} map (\x -> let (name,arg) = case show x of "" -> ("", empty) '!':name -> ("arg_" ++ name, "!arg_" >|< name) name -> ("arg_" ++ name, "arg_" >|< name) in if null name || name `Set.member` _usedArgs then arg else text "_") _childrenIargpats {-# LINE 2486 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule265 #-} {-# LINE 671 "src-ag/ExecutionPlan2Clean.ag" #-} rule265 = \ ((_lhsInt) :: NontermIdent) con_ -> {-# LINE 671 "src-ag/ExecutionPlan2Clean.ag" #-} "sem_" ++ show _lhsInt ++ "_" ++ show con_ {-# LINE 2492 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule266 #-} {-# LINE 672 "src-ag/ExecutionPlan2Clean.ag" #-} rule266 = \ ((_childrenIargtps) :: [PP_Doc] ) _classPP2 _quantPP2 _t_params _t_type -> {-# LINE 672 "src-ag/ExecutionPlan2Clean.ag" #-} _quantPP2 >#< _classPP2 >#< ppSpaced _childrenIargtps >#< (if length _childrenIargtps > 0 then "->" else "") >#< _t_type >#< _t_params {-# LINE 2500 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule267 #-} {-# LINE 675 "src-ag/ExecutionPlan2Clean.ag" #-} rule267 = \ ((_lhsIclassCtxs) :: ClassContext) constraints_ -> {-# LINE 675 "src-ag/ExecutionPlan2Clean.ag" #-} ppClasses (classCtxsToDocs _lhsIclassCtxs ++ classConstrsToDocs constraints_) {-# LINE 2506 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule268 #-} {-# LINE 676 "src-ag/ExecutionPlan2Clean.ag" #-} rule268 = \ ((_lhsIparams) :: [Identifier]) params_ -> {-# LINE 676 "src-ag/ExecutionPlan2Clean.ag" #-} ppQuants (_lhsIparams ++ params_) {-# LINE 2512 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule269 #-} {-# LINE 678 "src-ag/ExecutionPlan2Clean.ag" #-} rule269 = \ _sem_tp _semname -> {-# LINE 678 "src-ag/ExecutionPlan2Clean.ag" #-} _semname >#< " ::" >#< _sem_tp {-# LINE 2518 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule270 #-} {-# LINE 680 "src-ag/ExecutionPlan2Clean.ag" #-} rule270 = \ _args ((_lhsIinitial) :: StateIdentifier) _mbInitializer _mkSemBody _outerlet _sem_tp _semname _t_type -> {-# LINE 680 "src-ag/ExecutionPlan2Clean.ag" #-} _semname >#< " ::" >#< _sem_tp >-< _mkSemBody (_semname >#< ppSpaced _args >#< "=" >#< _t_type ) _mbInitializer _outerlet ("lift" >#< "st" >|< _lhsIinitial) {-# LINE 2526 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule271 #-} {-# LINE 683 "src-ag/ExecutionPlan2Clean.ag" #-} rule271 = \ (_ :: ()) -> {-# LINE 683 "src-ag/ExecutionPlan2Clean.ag" #-} \prefix mbInit outerlet ret -> case mbInit of Nothing -> prefix >#< pp_parens ret >#< "where" >-< indent 3 outerlet Just m -> prefix >#< "(" >#< "do" >-< indent 1 ( m >-< "let" >-< indent 2 outerlet >-< ret ) >-< indent 1 ")" {-# LINE 2542 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule272 #-} {-# LINE 695 "src-ag/ExecutionPlan2Clean.ag" #-} rule272 = \ ((_lhsIoptions) :: Options) -> {-# LINE 695 "src-ag/ExecutionPlan2Clean.ag" #-} if parallelInvoke _lhsIoptions then (Nothing :: Maybe PP_Doc) else Nothing {-# LINE 2550 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule273 #-} {-# LINE 701 "src-ag/ExecutionPlan2Clean.ag" #-} rule273 = \ ((_rulesIsem_rules) :: PP_Doc) _statefns -> {-# LINE 701 "src-ag/ExecutionPlan2Clean.ag" #-} vlist _statefns >-< _rulesIsem_rules {-# LINE 2556 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule274 #-} {-# LINE 702 "src-ag/ExecutionPlan2Clean.ag" #-} rule274 = \ _genstfn ((_lhsIallstates) :: Set StateIdentifier) -> {-# LINE 702 "src-ag/ExecutionPlan2Clean.ag" #-} map _genstfn $ Set.toList _lhsIallstates {-# LINE 2562 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule275 #-} {-# LINE 703 "src-ag/ExecutionPlan2Clean.ag" #-} rule275 = \ _addbang ((_lhsIinitial) :: StateIdentifier) ((_lhsInextVisits) :: Map StateIdentifier StateCtx) ((_lhsInt) :: NontermIdent) ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) _stargs _stks _stvs -> {-# LINE 703 "src-ag/ExecutionPlan2Clean.ag" #-} \st -> let nextVisitInfo = Map.findWithDefault ManyVis st _lhsInextVisits prevVisitInfo = Map.findWithDefault ManyVis st _lhsIprevVisits stNm = "st" >|< st lhs = bang stNm >#< "=" >#< ( if st == _lhsIinitial then empty else "\\" >#< _stargs st >#< "->" ) cCon = "C_" >|< _lhsInt >|< "_s" >|< st bang | st == _lhsIinitial = _addbang | otherwise = id in case nextVisitInfo of NoneVis -> if st == _lhsIinitial then lhs >#< cCon else empty OneVis vId -> mklet lhs (_stvs st False) (cCon >#< "v" >|< vId) ManyVis -> mklet lhs (_stks st >-< _stvs st True) (cCon >#< "k" >|< st) {-# LINE 2586 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule276 #-} {-# LINE 731 "src-ag/ExecutionPlan2Clean.ag" #-} rule276 = \ _addbang _childTypes _lazyIntras ((_lhsIallInhmap) :: Map NontermIdent Attributes) ((_lhsIallSynmap) :: Map NontermIdent Attributes) ((_lhsIoptions) :: Options) _localAttrTypes ((_visitsIintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> {-# LINE 731 "src-ag/ExecutionPlan2Clean.ag" #-} \st -> let attrs = maybe Map.empty id $ Map.lookup st _visitsIintramap in ppSpaced [ let match | str `Set.member` _lazyIntras = pp str | otherwise = _addbang (pp str) in case mbAttr of Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs _lhsIoptions) -> case Map.lookup nm _localAttrTypes of Just tp -> pp_parens (pp_parens match >#< "::" >#< ppTp tp) Nothing -> match Just attr | not (noPerStateTypeSigs _lhsIoptions) -> case lookupAttrType attr _lhsIallInhmap _lhsIallSynmap _childTypes of Just tpDoc -> pp_parens (pp_parens match >#< "::" >#< tpDoc) Nothing -> match _ -> match | (str,mbAttr) <- Map.assocs attrs ] >#< dummyPat _lhsIoptions (Map.null attrs) {-# LINE 2606 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule277 #-} {-# LINE 747 "src-ag/ExecutionPlan2Clean.ag" #-} rule277 = \ ((_lhsInt) :: NontermIdent) _stvisits _t_params -> {-# LINE 747 "src-ag/ExecutionPlan2Clean.ag" #-} \st -> if null (_stvisits st) then empty else "k" >|< st >#< "::" >#< "K_" >|< _lhsInt >|< "_s" >|< st >#< _t_params >#< "t" >#< "->" >#< "t" >-< vlist (map (\(v,f,t) -> "k" >|< st >#< "K_" >|< _lhsInt >|< "_v" >|< v >#< "=" >#< "v" >|< v) $ _stvisits st) {-# LINE 2616 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule278 #-} {-# LINE 752 "src-ag/ExecutionPlan2Clean.ag" #-} rule278 = \ ((_visitsIallvisits) :: [VisitStateState]) -> {-# LINE 752 "src-ag/ExecutionPlan2Clean.ag" #-} \st -> filter (\(v,f,t) -> f == st) _visitsIallvisits {-# LINE 2622 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule279 #-} {-# LINE 753 "src-ag/ExecutionPlan2Clean.ag" #-} rule279 = \ ((_visitsIsem_visit) :: [(StateIdentifier,Bool -> PP_Doc)] ) -> {-# LINE 753 "src-ag/ExecutionPlan2Clean.ag" #-} \st inlinePragma -> vlist [ppf inlinePragma | (f,ppf) <- _visitsIsem_visit, f == st] {-# LINE 2628 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule280 #-} {-# LINE 754 "src-ag/ExecutionPlan2Clean.ag" #-} rule280 = \ ((_rulesImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> {-# LINE 754 "src-ag/ExecutionPlan2Clean.ag" #-} _rulesImrules {-# LINE 2634 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule281 #-} {-# LINE 942 "src-ag/ExecutionPlan2Clean.ag" #-} rule281 = \ ((_childrenIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> {-# LINE 942 "src-ag/ExecutionPlan2Clean.ag" #-} _childrenIchildintros {-# LINE 2640 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule282 #-} {-# LINE 1277 "src-ag/ExecutionPlan2Clean.ag" #-} rule282 = \ ((_visitsIruleUsage) :: Map Identifier Int) -> {-# LINE 1277 "src-ag/ExecutionPlan2Clean.ag" #-} _visitsIruleUsage {-# LINE 2646 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule283 #-} {-# LINE 1292 "src-ag/ExecutionPlan2Clean.ag" #-} rule283 = \ ((_visitsIruleKinds) :: Map Identifier (Set VisitKind)) -> {-# LINE 1292 "src-ag/ExecutionPlan2Clean.ag" #-} _visitsIruleKinds {-# LINE 2652 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule284 #-} {-# LINE 1321 "src-ag/ExecutionPlan2Clean.ag" #-} rule284 = \ ((_visitsIintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> {-# LINE 1321 "src-ag/ExecutionPlan2Clean.ag" #-} _visitsIintramap {-# LINE 2658 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule285 #-} {-# LINE 1322 "src-ag/ExecutionPlan2Clean.ag" #-} rule285 = \ ((_childrenIterminaldefs) :: Set String) -> {-# LINE 1322 "src-ag/ExecutionPlan2Clean.ag" #-} _childrenIterminaldefs {-# LINE 2664 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule286 #-} {-# LINE 1346 "src-ag/ExecutionPlan2Clean.ag" #-} rule286 = \ ((_rulesIruledefs) :: Map Identifier (Set String)) -> {-# LINE 1346 "src-ag/ExecutionPlan2Clean.ag" #-} _rulesIruledefs {-# LINE 2670 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule287 #-} {-# LINE 1347 "src-ag/ExecutionPlan2Clean.ag" #-} rule287 = \ ((_rulesIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> {-# LINE 1347 "src-ag/ExecutionPlan2Clean.ag" #-} _rulesIruleuses {-# LINE 2676 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule288 #-} {-# LINE 1401 "src-ag/ExecutionPlan2Clean.ag" #-} rule288 = \ ((_visitsIlazyIntras) :: Set String) -> {-# LINE 1401 "src-ag/ExecutionPlan2Clean.ag" #-} _visitsIlazyIntras {-# LINE 2682 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule289 #-} {-# LINE 1486 "src-ag/ExecutionPlan2Clean.ag" #-} rule289 = \ _moduleName -> {-# LINE 1486 "src-ag/ExecutionPlan2Clean.ag" #-} [pp $ "import " ++ _moduleName ] {-# LINE 2688 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule290 #-} {-# LINE 1487 "src-ag/ExecutionPlan2Clean.ag" #-} rule290 = \ ((_lhsImainName) :: String) _suffix -> {-# LINE 1487 "src-ag/ExecutionPlan2Clean.ag" #-} _lhsImainName ++ _suffix {-# LINE 2694 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule291 #-} {-# LINE 1488 "src-ag/ExecutionPlan2Clean.ag" #-} rule291 = \ ((_lhsInt) :: NontermIdent) con_ -> {-# LINE 1488 "src-ag/ExecutionPlan2Clean.ag" #-} '_' : show _lhsInt ++ ('_' : show con_) {-# LINE 2700 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule292 #-} {-# LINE 1489 "src-ag/ExecutionPlan2Clean.ag" #-} rule292 = \ ((_lhsImainFile) :: String) _suffix -> {-# LINE 1489 "src-ag/ExecutionPlan2Clean.ag" #-} replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ _suffix ) {-# LINE 2706 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule293 #-} {-# LINE 1490 "src-ag/ExecutionPlan2Clean.ag" #-} rule293 = \ (_ :: ()) -> {-# LINE 1490 "src-ag/ExecutionPlan2Clean.ag" #-} pp "import qualified Control.Monad.Identity" {-# LINE 2712 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule294 #-} {-# LINE 1491 "src-ag/ExecutionPlan2Clean.ag" #-} rule294 = \ ((_lhsIiclModuleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIimportBlocks) :: PP_Doc) ((_lhsImainName) :: String) _outputfile _ppMonadImports _sem_prod _semname _suffix -> {-# LINE 1491 "src-ag/ExecutionPlan2Clean.ag" #-} writeModule _outputfile [ pp $ _lhsIiclModuleHeader _lhsImainName _suffix _semname True , _lhsIimportBlocks , _ppMonadImports , pp $ "import " ++ _lhsImainName ++ "_common" , _sem_prod ] {-# LINE 2724 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule295 #-} {-# LINE 1567 "src-ag/ExecutionPlan2Clean.ag" #-} rule295 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1567 "src-ag/ExecutionPlan2Clean.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 2730 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule296 #-} {-# LINE 1617 "src-ag/ExecutionPlan2Clean.ag" #-} rule296 = \ ((_childrenIchildTypes) :: Map Identifier Type) ((_lhsIntType) :: Type) -> {-# LINE 1617 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton _LHS _lhsIntType `Map.union` _childrenIchildTypes {-# LINE 2736 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule297 #-} {-# LINE 1634 "src-ag/ExecutionPlan2Clean.ag" #-} rule297 = \ ((_lhsIlocalAttrTypes) :: Map ConstructorIdent (Map Identifier Type)) con_ -> {-# LINE 1634 "src-ag/ExecutionPlan2Clean.ag" #-} Map.findWithDefault Map.empty con_ _lhsIlocalAttrTypes {-# LINE 2742 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule298 #-} rule298 = \ ((_visitsIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _visitsIchildvisit {-# INLINE rule299 #-} rule299 = \ ((_rulesIerrors) :: Seq Error) ((_visitsIerrors) :: Seq Error) -> _rulesIerrors Seq.>< _visitsIerrors {-# INLINE rule300 #-} rule300 = \ ((_visitsIfromToStates) :: Map VisitIdentifier (Int,Int)) -> _visitsIfromToStates {-# INLINE rule301 #-} rule301 = \ ((_visitsIt_visits) :: PP_Doc) -> _visitsIt_visits {-# INLINE rule302 #-} rule302 = \ ((_visitsIvisitKinds) :: Map VisitIdentifier VisitKind) -> _visitsIvisitKinds {-# INLINE rule303 #-} rule303 = \ ((_visitsIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _visitsIvisitdefs {-# INLINE rule304 #-} rule304 = \ ((_visitsIvisituses) :: Map VisitIdentifier (Set Identifier)) -> _visitsIvisituses {-# INLINE rule305 #-} rule305 = \ ((_visitsIallvisits) :: [VisitStateState]) -> _visitsIallvisits {-# INLINE rule306 #-} rule306 = \ _sem_prod -> _sem_prod {-# INLINE rule307 #-} rule307 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule308 #-} rule308 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule309 #-} rule309 = \ _childTypes -> _childTypes {-# INLINE rule310 #-} rule310 = \ ((_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# INLINE rule311 #-} rule311 = \ ((_lhsIdclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIdclModuleHeader {-# INLINE rule312 #-} rule312 = \ ((_lhsIiclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIiclModuleHeader {-# INLINE rule313 #-} rule313 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule314 #-} rule314 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule315 #-} rule315 = \ _lazyIntras -> _lazyIntras {-# INLINE rule316 #-} rule316 = \ _localAttrTypes -> _localAttrTypes {-# INLINE rule317 #-} rule317 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule318 #-} rule318 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule319 #-} rule319 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule320 #-} rule320 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule321 #-} rule321 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule322 #-} rule322 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule323 #-} rule323 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule324 #-} rule324 = \ ((_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# INLINE rule325 #-} rule325 = \ ((_lhsIdclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIdclModuleHeader {-# INLINE rule326 #-} rule326 = \ ((_lhsIiclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIiclModuleHeader {-# INLINE rule327 #-} rule327 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule328 #-} rule328 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule329 #-} rule329 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule330 #-} rule330 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule331 #-} rule331 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule332 #-} rule332 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule333 #-} rule333 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule334 #-} rule334 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule335 #-} rule335 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule336 #-} rule336 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule337 #-} rule337 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule338 #-} rule338 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule339 #-} rule339 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule340 #-} rule340 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule341 #-} rule341 = \ _childTypes -> _childTypes {-# INLINE rule342 #-} rule342 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule343 #-} rule343 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) -> _lhsInextVisits {-# INLINE rule344 #-} rule344 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule345 #-} rule345 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule346 #-} rule346 = \ ((_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule347 #-} rule347 = \ ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) -> _lhsIprevVisits {-# INLINE rule348 #-} rule348 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap -- EProductions ------------------------------------------------ -- wrapper data Inh_EProductions = Inh_EProductions { allFromToStates_Inh_EProductions :: (Map VisitIdentifier (Int,Int)), allInhmap_Inh_EProductions :: (Map NontermIdent Attributes), allInitStates_Inh_EProductions :: (Map NontermIdent Int), allSynmap_Inh_EProductions :: (Map NontermIdent Attributes), allVisitKinds_Inh_EProductions :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_EProductions :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), allstates_Inh_EProductions :: (Set StateIdentifier), avisitdefs_Inh_EProductions :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_EProductions :: (Map VisitIdentifier (Set Identifier)), classCtxs_Inh_EProductions :: (ClassContext), constructorTypeMap_Inh_EProductions :: (Map NontermIdent ConstructorType), dclModuleHeader_Inh_EProductions :: (String -> String -> String -> Bool -> String), iclModuleHeader_Inh_EProductions :: (String -> String -> String -> Bool -> String), importBlocks_Inh_EProductions :: (PP_Doc), inhmap_Inh_EProductions :: (Attributes), initial_Inh_EProductions :: (StateIdentifier), localAttrTypes_Inh_EProductions :: (Map ConstructorIdent (Map Identifier Type)), mainFile_Inh_EProductions :: (String), mainName_Inh_EProductions :: (String), nextVisits_Inh_EProductions :: (Map StateIdentifier StateCtx), nt_Inh_EProductions :: (NontermIdent), ntType_Inh_EProductions :: (Type), options_Inh_EProductions :: (Options), params_Inh_EProductions :: ([Identifier]), prevVisits_Inh_EProductions :: (Map StateIdentifier StateCtx), rename_Inh_EProductions :: (Bool), synmap_Inh_EProductions :: (Attributes), textBlocks_Inh_EProductions :: (PP_Doc) } data Syn_EProductions = Syn_EProductions { allvisits_Syn_EProductions :: ([VisitStateState]), childvisit_Syn_EProductions :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), count_Syn_EProductions :: (Int), datatype_Syn_EProductions :: ([PP_Doc]), errors_Syn_EProductions :: (Seq Error), fromToStates_Syn_EProductions :: (Map VisitIdentifier (Int,Int)), genProdIO_Syn_EProductions :: (IO ()), imports_Syn_EProductions :: ([PP_Doc]), recordtype_Syn_EProductions :: (PP_Doc), semFunBndDefs_Syn_EProductions :: (Seq PP_Doc), semFunBndTps_Syn_EProductions :: (Seq PP_Doc), sem_nt_Syn_EProductions :: (PP_Doc), sem_prod_Syn_EProductions :: (PP_Doc), sem_prod_tys_Syn_EProductions :: (PP_Doc), t_visits_Syn_EProductions :: (PP_Doc), visitKinds_Syn_EProductions :: (Map VisitIdentifier VisitKind), visitdefs_Syn_EProductions :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_EProductions :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_EProductions #-} wrap_EProductions :: T_EProductions -> Inh_EProductions -> (Syn_EProductions ) wrap_EProductions (T_EProductions act) (Inh_EProductions _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do sem <- act let arg16 = T_EProductions_vIn16 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks (T_EProductions_vOut16 _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOrecordtype _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOsem_prod_tys _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_EProductions_s17 sem arg16) return (Syn_EProductions _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOrecordtype _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOsem_prod_tys _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# NOINLINE sem_EProductions #-} sem_EProductions :: EProductions -> T_EProductions sem_EProductions list = Prelude.foldr sem_EProductions_Cons sem_EProductions_Nil (Prelude.map sem_EProduction list) -- semantic domain newtype T_EProductions = T_EProductions { attach_T_EProductions :: Identity (T_EProductions_s17 ) } newtype T_EProductions_s17 = C_EProductions_s17 { inv_EProductions_s17 :: (T_EProductions_v16 ) } data T_EProductions_s18 = C_EProductions_s18 type T_EProductions_v16 = (T_EProductions_vIn16 ) -> (T_EProductions_vOut16 ) data T_EProductions_vIn16 = T_EProductions_vIn16 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Attributes) (Map NontermIdent Int) (Map NontermIdent Attributes) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Set StateIdentifier) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (ClassContext) (Map NontermIdent ConstructorType) (String -> String -> String -> Bool -> String) (String -> String -> String -> Bool -> String) (PP_Doc) (Attributes) (StateIdentifier) (Map ConstructorIdent (Map Identifier Type)) (String) (String) (Map StateIdentifier StateCtx) (NontermIdent) (Type) (Options) ([Identifier]) (Map StateIdentifier StateCtx) (Bool) (Attributes) (PP_Doc) data T_EProductions_vOut16 = T_EProductions_vOut16 ([VisitStateState]) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Int) ([PP_Doc]) (Seq Error) (Map VisitIdentifier (Int,Int)) (IO ()) ([PP_Doc]) (PP_Doc) (Seq PP_Doc) (Seq PP_Doc) (PP_Doc) (PP_Doc) (PP_Doc) (PP_Doc) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_EProductions_Cons #-} sem_EProductions_Cons :: T_EProduction -> T_EProductions -> T_EProductions sem_EProductions_Cons arg_hd_ arg_tl_ = T_EProductions (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_EProductions_v16 v16 = \ (T_EProductions_vIn16 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_EProduction (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_EProductions (arg_tl_)) (T_EProduction_vOut13 _hdIallvisits _hdIchildvisit _hdIcount _hdIdatatype _hdIerrors _hdIfromToStates _hdIgenProdIO _hdIimports _hdIrecordtype _hdIsemFunBndDefs _hdIsemFunBndTps _hdIsem_nt _hdIsem_prod _hdIsem_prod_tys _hdIt_visits _hdIvisitKinds _hdIvisitdefs _hdIvisituses) = inv_EProduction_s14 _hdX14 (T_EProduction_vIn13 _hdOallFromToStates _hdOallInhmap _hdOallInitStates _hdOallSynmap _hdOallVisitKinds _hdOallchildvisit _hdOallstates _hdOavisitdefs _hdOavisituses _hdOclassCtxs _hdOconstructorTypeMap _hdOdclModuleHeader _hdOiclModuleHeader _hdOimportBlocks _hdOinhmap _hdOinitial _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOnextVisits _hdOnt _hdOntType _hdOoptions _hdOparams _hdOprevVisits _hdOrename _hdOsynmap _hdOtextBlocks) (T_EProductions_vOut16 _tlIallvisits _tlIchildvisit _tlIcount _tlIdatatype _tlIerrors _tlIfromToStates _tlIgenProdIO _tlIimports _tlIrecordtype _tlIsemFunBndDefs _tlIsemFunBndTps _tlIsem_nt _tlIsem_prod _tlIsem_prod_tys _tlIt_visits _tlIvisitKinds _tlIvisitdefs _tlIvisituses) = inv_EProductions_s17 _tlX17 (T_EProductions_vIn16 _tlOallFromToStates _tlOallInhmap _tlOallInitStates _tlOallSynmap _tlOallVisitKinds _tlOallchildvisit _tlOallstates _tlOavisitdefs _tlOavisituses _tlOclassCtxs _tlOconstructorTypeMap _tlOdclModuleHeader _tlOiclModuleHeader _tlOimportBlocks _tlOinhmap _tlOinitial _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOnextVisits _tlOnt _tlOntType _tlOoptions _tlOparams _tlOprevVisits _tlOrename _tlOsynmap _tlOtextBlocks) _lhsOrecordtype :: PP_Doc _lhsOrecordtype = rule349 _hdIrecordtype _lhsOallvisits :: [VisitStateState] _lhsOallvisits = rule350 _hdIallvisits _lhsOt_visits :: PP_Doc _lhsOt_visits = rule351 _hdIt_visits _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule352 _hdIchildvisit _tlIchildvisit _lhsOcount :: Int _lhsOcount = rule353 _hdIcount _tlIcount _lhsOdatatype :: [PP_Doc] _lhsOdatatype = rule354 _hdIdatatype _tlIdatatype _lhsOerrors :: Seq Error _lhsOerrors = rule355 _hdIerrors _tlIerrors _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule356 _hdIfromToStates _tlIfromToStates _lhsOgenProdIO :: IO () _lhsOgenProdIO = rule357 _hdIgenProdIO _tlIgenProdIO _lhsOimports :: [PP_Doc] _lhsOimports = rule358 _hdIimports _tlIimports _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule359 _hdIsemFunBndDefs _tlIsemFunBndDefs _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule360 _hdIsemFunBndTps _tlIsemFunBndTps _lhsOsem_nt :: PP_Doc _lhsOsem_nt = rule361 _hdIsem_nt _tlIsem_nt _lhsOsem_prod :: PP_Doc _lhsOsem_prod = rule362 _hdIsem_prod _tlIsem_prod _lhsOsem_prod_tys :: PP_Doc _lhsOsem_prod_tys = rule363 _hdIsem_prod_tys _tlIsem_prod_tys _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule364 _hdIvisitKinds _tlIvisitKinds _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule365 _hdIvisitdefs _tlIvisitdefs _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule366 _hdIvisituses _tlIvisituses _hdOallFromToStates = rule367 _lhsIallFromToStates _hdOallInhmap = rule368 _lhsIallInhmap _hdOallInitStates = rule369 _lhsIallInitStates _hdOallSynmap = rule370 _lhsIallSynmap _hdOallVisitKinds = rule371 _lhsIallVisitKinds _hdOallchildvisit = rule372 _lhsIallchildvisit _hdOallstates = rule373 _lhsIallstates _hdOavisitdefs = rule374 _lhsIavisitdefs _hdOavisituses = rule375 _lhsIavisituses _hdOclassCtxs = rule376 _lhsIclassCtxs _hdOconstructorTypeMap = rule377 _lhsIconstructorTypeMap _hdOdclModuleHeader = rule378 _lhsIdclModuleHeader _hdOiclModuleHeader = rule379 _lhsIiclModuleHeader _hdOimportBlocks = rule380 _lhsIimportBlocks _hdOinhmap = rule381 _lhsIinhmap _hdOinitial = rule382 _lhsIinitial _hdOlocalAttrTypes = rule383 _lhsIlocalAttrTypes _hdOmainFile = rule384 _lhsImainFile _hdOmainName = rule385 _lhsImainName _hdOnextVisits = rule386 _lhsInextVisits _hdOnt = rule387 _lhsInt _hdOntType = rule388 _lhsIntType _hdOoptions = rule389 _lhsIoptions _hdOparams = rule390 _lhsIparams _hdOprevVisits = rule391 _lhsIprevVisits _hdOrename = rule392 _lhsIrename _hdOsynmap = rule393 _lhsIsynmap _hdOtextBlocks = rule394 _lhsItextBlocks _tlOallFromToStates = rule395 _lhsIallFromToStates _tlOallInhmap = rule396 _lhsIallInhmap _tlOallInitStates = rule397 _lhsIallInitStates _tlOallSynmap = rule398 _lhsIallSynmap _tlOallVisitKinds = rule399 _lhsIallVisitKinds _tlOallchildvisit = rule400 _lhsIallchildvisit _tlOallstates = rule401 _lhsIallstates _tlOavisitdefs = rule402 _lhsIavisitdefs _tlOavisituses = rule403 _lhsIavisituses _tlOclassCtxs = rule404 _lhsIclassCtxs _tlOconstructorTypeMap = rule405 _lhsIconstructorTypeMap _tlOdclModuleHeader = rule406 _lhsIdclModuleHeader _tlOiclModuleHeader = rule407 _lhsIiclModuleHeader _tlOimportBlocks = rule408 _lhsIimportBlocks _tlOinhmap = rule409 _lhsIinhmap _tlOinitial = rule410 _lhsIinitial _tlOlocalAttrTypes = rule411 _lhsIlocalAttrTypes _tlOmainFile = rule412 _lhsImainFile _tlOmainName = rule413 _lhsImainName _tlOnextVisits = rule414 _lhsInextVisits _tlOnt = rule415 _lhsInt _tlOntType = rule416 _lhsIntType _tlOoptions = rule417 _lhsIoptions _tlOparams = rule418 _lhsIparams _tlOprevVisits = rule419 _lhsIprevVisits _tlOrename = rule420 _lhsIrename _tlOsynmap = rule421 _lhsIsynmap _tlOtextBlocks = rule422 _lhsItextBlocks __result_ = T_EProductions_vOut16 _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOrecordtype _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOsem_prod_tys _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_EProductions_s17 v16 {-# INLINE rule349 #-} {-# LINE 224 "src-ag/ExecutionPlan2Clean.ag" #-} rule349 = \ ((_hdIrecordtype) :: PP_Doc) -> {-# LINE 224 "src-ag/ExecutionPlan2Clean.ag" #-} _hdIrecordtype {-# LINE 3038 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule350 #-} {-# LINE 385 "src-ag/ExecutionPlan2Clean.ag" #-} rule350 = \ ((_hdIallvisits) :: [VisitStateState]) -> {-# LINE 385 "src-ag/ExecutionPlan2Clean.ag" #-} _hdIallvisits {-# LINE 3044 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule351 #-} {-# LINE 450 "src-ag/ExecutionPlan2Clean.ag" #-} rule351 = \ ((_hdIt_visits) :: PP_Doc) -> {-# LINE 450 "src-ag/ExecutionPlan2Clean.ag" #-} _hdIt_visits {-# LINE 3050 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule352 #-} rule352 = \ ((_hdIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) ((_tlIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _hdIchildvisit `Map.union` _tlIchildvisit {-# INLINE rule353 #-} rule353 = \ ((_hdIcount) :: Int) ((_tlIcount) :: Int) -> _hdIcount + _tlIcount {-# INLINE rule354 #-} rule354 = \ ((_hdIdatatype) :: PP_Doc) ((_tlIdatatype) :: [PP_Doc]) -> _hdIdatatype : _tlIdatatype {-# INLINE rule355 #-} rule355 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule356 #-} rule356 = \ ((_hdIfromToStates) :: Map VisitIdentifier (Int,Int)) ((_tlIfromToStates) :: Map VisitIdentifier (Int,Int)) -> _hdIfromToStates `mappend` _tlIfromToStates {-# INLINE rule357 #-} rule357 = \ ((_hdIgenProdIO) :: IO ()) ((_tlIgenProdIO) :: IO ()) -> _hdIgenProdIO >> _tlIgenProdIO {-# INLINE rule358 #-} rule358 = \ ((_hdIimports) :: [PP_Doc]) ((_tlIimports) :: [PP_Doc]) -> _hdIimports ++ _tlIimports {-# INLINE rule359 #-} rule359 = \ ((_hdIsemFunBndDefs) :: Seq PP_Doc) ((_tlIsemFunBndDefs) :: Seq PP_Doc) -> _hdIsemFunBndDefs Seq.>< _tlIsemFunBndDefs {-# INLINE rule360 #-} rule360 = \ ((_hdIsemFunBndTps) :: Seq PP_Doc) ((_tlIsemFunBndTps) :: Seq PP_Doc) -> _hdIsemFunBndTps Seq.>< _tlIsemFunBndTps {-# INLINE rule361 #-} rule361 = \ ((_hdIsem_nt) :: PP_Doc) ((_tlIsem_nt) :: PP_Doc) -> _hdIsem_nt >-< _tlIsem_nt {-# INLINE rule362 #-} rule362 = \ ((_hdIsem_prod) :: PP_Doc) ((_tlIsem_prod) :: PP_Doc) -> _hdIsem_prod >-< _tlIsem_prod {-# INLINE rule363 #-} rule363 = \ ((_hdIsem_prod_tys) :: PP_Doc) ((_tlIsem_prod_tys) :: PP_Doc) -> _hdIsem_prod_tys >-< _tlIsem_prod_tys {-# INLINE rule364 #-} rule364 = \ ((_hdIvisitKinds) :: Map VisitIdentifier VisitKind) ((_tlIvisitKinds) :: Map VisitIdentifier VisitKind) -> _hdIvisitKinds `mappend` _tlIvisitKinds {-# INLINE rule365 #-} rule365 = \ ((_hdIvisitdefs) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisitdefs `uwSetUnion` _tlIvisitdefs {-# INLINE rule366 #-} rule366 = \ ((_hdIvisituses) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisituses) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisituses `uwSetUnion` _tlIvisituses {-# INLINE rule367 #-} rule367 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule368 #-} rule368 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule369 #-} rule369 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule370 #-} rule370 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule371 #-} rule371 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule372 #-} rule372 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule373 #-} rule373 = \ ((_lhsIallstates) :: Set StateIdentifier) -> _lhsIallstates {-# INLINE rule374 #-} rule374 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule375 #-} rule375 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule376 #-} rule376 = \ ((_lhsIclassCtxs) :: ClassContext) -> _lhsIclassCtxs {-# INLINE rule377 #-} rule377 = \ ((_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# INLINE rule378 #-} rule378 = \ ((_lhsIdclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIdclModuleHeader {-# INLINE rule379 #-} rule379 = \ ((_lhsIiclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIiclModuleHeader {-# INLINE rule380 #-} rule380 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule381 #-} rule381 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule382 #-} rule382 = \ ((_lhsIinitial) :: StateIdentifier) -> _lhsIinitial {-# INLINE rule383 #-} rule383 = \ ((_lhsIlocalAttrTypes) :: Map ConstructorIdent (Map Identifier Type)) -> _lhsIlocalAttrTypes {-# INLINE rule384 #-} rule384 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule385 #-} rule385 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule386 #-} rule386 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) -> _lhsInextVisits {-# INLINE rule387 #-} rule387 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule388 #-} rule388 = \ ((_lhsIntType) :: Type) -> _lhsIntType {-# INLINE rule389 #-} rule389 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule390 #-} rule390 = \ ((_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule391 #-} rule391 = \ ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) -> _lhsIprevVisits {-# INLINE rule392 #-} rule392 = \ ((_lhsIrename) :: Bool) -> _lhsIrename {-# INLINE rule393 #-} rule393 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule394 #-} rule394 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule395 #-} rule395 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule396 #-} rule396 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule397 #-} rule397 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule398 #-} rule398 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule399 #-} rule399 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule400 #-} rule400 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule401 #-} rule401 = \ ((_lhsIallstates) :: Set StateIdentifier) -> _lhsIallstates {-# INLINE rule402 #-} rule402 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule403 #-} rule403 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule404 #-} rule404 = \ ((_lhsIclassCtxs) :: ClassContext) -> _lhsIclassCtxs {-# INLINE rule405 #-} rule405 = \ ((_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# INLINE rule406 #-} rule406 = \ ((_lhsIdclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIdclModuleHeader {-# INLINE rule407 #-} rule407 = \ ((_lhsIiclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIiclModuleHeader {-# INLINE rule408 #-} rule408 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule409 #-} rule409 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule410 #-} rule410 = \ ((_lhsIinitial) :: StateIdentifier) -> _lhsIinitial {-# INLINE rule411 #-} rule411 = \ ((_lhsIlocalAttrTypes) :: Map ConstructorIdent (Map Identifier Type)) -> _lhsIlocalAttrTypes {-# INLINE rule412 #-} rule412 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule413 #-} rule413 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule414 #-} rule414 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) -> _lhsInextVisits {-# INLINE rule415 #-} rule415 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule416 #-} rule416 = \ ((_lhsIntType) :: Type) -> _lhsIntType {-# INLINE rule417 #-} rule417 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule418 #-} rule418 = \ ((_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule419 #-} rule419 = \ ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) -> _lhsIprevVisits {-# INLINE rule420 #-} rule420 = \ ((_lhsIrename) :: Bool) -> _lhsIrename {-# INLINE rule421 #-} rule421 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule422 #-} rule422 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# NOINLINE sem_EProductions_Nil #-} sem_EProductions_Nil :: T_EProductions sem_EProductions_Nil = T_EProductions (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_EProductions_v16 v16 = \ (T_EProductions_vIn16 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks) -> ( let _lhsOrecordtype :: PP_Doc _lhsOrecordtype = rule423 () _lhsOallvisits :: [VisitStateState] _lhsOallvisits = rule424 () _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule425 () _lhsOcount :: Int _lhsOcount = rule426 () _lhsOdatatype :: [PP_Doc] _lhsOdatatype = rule427 () _lhsOerrors :: Seq Error _lhsOerrors = rule428 () _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule429 () _lhsOgenProdIO :: IO () _lhsOgenProdIO = rule430 () _lhsOimports :: [PP_Doc] _lhsOimports = rule431 () _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule432 () _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule433 () _lhsOsem_nt :: PP_Doc _lhsOsem_nt = rule434 () _lhsOsem_prod :: PP_Doc _lhsOsem_prod = rule435 () _lhsOsem_prod_tys :: PP_Doc _lhsOsem_prod_tys = rule436 () _lhsOt_visits :: PP_Doc _lhsOt_visits = rule437 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule438 () _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule439 () _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule440 () __result_ = T_EProductions_vOut16 _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOrecordtype _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOsem_prod_tys _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_EProductions_s17 v16 {-# INLINE rule423 #-} {-# LINE 225 "src-ag/ExecutionPlan2Clean.ag" #-} rule423 = \ (_ :: ()) -> {-# LINE 225 "src-ag/ExecutionPlan2Clean.ag" #-} empty {-# LINE 3315 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule424 #-} {-# LINE 386 "src-ag/ExecutionPlan2Clean.ag" #-} rule424 = \ (_ :: ()) -> {-# LINE 386 "src-ag/ExecutionPlan2Clean.ag" #-} error "Every nonterminal should have at least 1 production" {-# LINE 3321 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule425 #-} rule425 = \ (_ :: ()) -> Map.empty {-# INLINE rule426 #-} rule426 = \ (_ :: ()) -> 0 {-# INLINE rule427 #-} rule427 = \ (_ :: ()) -> [] {-# INLINE rule428 #-} rule428 = \ (_ :: ()) -> Seq.empty {-# INLINE rule429 #-} rule429 = \ (_ :: ()) -> mempty {-# INLINE rule430 #-} rule430 = \ (_ :: ()) -> return () {-# INLINE rule431 #-} rule431 = \ (_ :: ()) -> [] {-# INLINE rule432 #-} rule432 = \ (_ :: ()) -> Seq.empty {-# INLINE rule433 #-} rule433 = \ (_ :: ()) -> Seq.empty {-# INLINE rule434 #-} rule434 = \ (_ :: ()) -> empty {-# INLINE rule435 #-} rule435 = \ (_ :: ()) -> empty {-# INLINE rule436 #-} rule436 = \ (_ :: ()) -> empty {-# INLINE rule437 #-} rule437 = \ (_ :: ()) -> empty {-# INLINE rule438 #-} rule438 = \ (_ :: ()) -> mempty {-# INLINE rule439 #-} rule439 = \ (_ :: ()) -> Map.empty {-# INLINE rule440 #-} rule440 = \ (_ :: ()) -> Map.empty -- ERule ------------------------------------------------------- -- wrapper data Inh_ERule = Inh_ERule { allInhmap_Inh_ERule :: (Map NontermIdent Attributes), allSynmap_Inh_ERule :: (Map NontermIdent Attributes), childTypes_Inh_ERule :: (Map Identifier Type), con_Inh_ERule :: (ConstructorIdent), constructorTypeMap_Inh_ERule :: (Map NontermIdent ConstructorType), dclModuleHeader_Inh_ERule :: (String -> String -> String -> Bool -> String), iclModuleHeader_Inh_ERule :: (String -> String -> String -> Bool -> String), importBlocks_Inh_ERule :: (PP_Doc), inhmap_Inh_ERule :: (Attributes), lazyIntras_Inh_ERule :: (Set String), localAttrTypes_Inh_ERule :: (Map Identifier Type), mainFile_Inh_ERule :: (String), mainName_Inh_ERule :: (String), nt_Inh_ERule :: (NontermIdent), options_Inh_ERule :: (Options), ruleKinds_Inh_ERule :: (Map Identifier (Set VisitKind)), synmap_Inh_ERule :: (Attributes), textBlocks_Inh_ERule :: (PP_Doc), usageInfo_Inh_ERule :: (Map Identifier Int) } data Syn_ERule = Syn_ERule { errors_Syn_ERule :: (Seq Error), mrules_Syn_ERule :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)), ruledefs_Syn_ERule :: (Map Identifier (Set String)), ruleuses_Syn_ERule :: (Map Identifier (Map String (Maybe NonLocalAttr))), sem_rules_Syn_ERule :: (PP_Doc), usedArgs_Syn_ERule :: (Set String) } {-# INLINABLE wrap_ERule #-} wrap_ERule :: T_ERule -> Inh_ERule -> (Syn_ERule ) wrap_ERule (T_ERule act) (Inh_ERule _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo) = Control.Monad.Identity.runIdentity ( do sem <- act let arg19 = T_ERule_vIn19 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo (T_ERule_vOut19 _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules _lhsOusedArgs) <- return (inv_ERule_s20 sem arg19) return (Syn_ERule _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules _lhsOusedArgs) ) -- cata {-# INLINE sem_ERule #-} sem_ERule :: ERule -> T_ERule sem_ERule ( ERule name_ pattern_ rhs_ owrt_ origin_ explicit_ pure_ mbError_ ) = sem_ERule_ERule name_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ mbError_ -- semantic domain newtype T_ERule = T_ERule { attach_T_ERule :: Identity (T_ERule_s20 ) } newtype T_ERule_s20 = C_ERule_s20 { inv_ERule_s20 :: (T_ERule_v19 ) } data T_ERule_s21 = C_ERule_s21 type T_ERule_v19 = (T_ERule_vIn19 ) -> (T_ERule_vOut19 ) data T_ERule_vIn19 = T_ERule_vIn19 (Map NontermIdent Attributes) (Map NontermIdent Attributes) (Map Identifier Type) (ConstructorIdent) (Map NontermIdent ConstructorType) (String -> String -> String -> Bool -> String) (String -> String -> String -> Bool -> String) (PP_Doc) (Attributes) (Set String) (Map Identifier Type) (String) (String) (NontermIdent) (Options) (Map Identifier (Set VisitKind)) (Attributes) (PP_Doc) (Map Identifier Int) data T_ERule_vOut19 = T_ERule_vOut19 (Seq Error) (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (PP_Doc) (Set String) {-# NOINLINE sem_ERule_ERule #-} sem_ERule_ERule :: (Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Maybe Error) -> T_ERule sem_ERule_ERule arg_name_ arg_pattern_ arg_rhs_ _ _ arg_explicit_ arg_pure_ arg_mbError_ = T_ERule (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_ERule_v19 v19 = \ (T_ERule_vIn19 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo) -> ( let _patternX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) _rhsX29 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) (T_Pattern_vOut40 _patternIattrTypes _patternIattrs _patternIcopy _patternIisUnderscore _patternIsem_lhs) = inv_Pattern_s41 _patternX41 (T_Pattern_vIn40 _patternOallInhmap _patternOallSynmap _patternOanyLazyKind _patternOinhmap _patternOlocalAttrTypes _patternOoptions _patternOsynmap) (T_Expression_vOut28 _rhsIattrs _rhsIpos _rhsIsemfunc _rhsItks) = inv_Expression_s29 _rhsX29 (T_Expression_vIn28 _rhsOoptions) _lhsOusedArgs :: Set String _lhsOusedArgs = rule441 _usedArgs_augmented_f1 _usedArgs_augmented_syn _usedArgs_augmented_f1 = rule442 _rhsIattrs _lhsOsem_rules :: PP_Doc _lhsOsem_rules = rule443 _rulecode _used _rulecode = rule444 _endpragma _genpragma _lambda _pragma _rhsIpos _rhsIsemfunc _pragma = rule445 _rhsIpos _endpragma = rule446 _lhsImainFile _genpragma = rule447 _haspos _lhsIoptions arg_explicit_ _haspos = rule448 _rhsIpos _lambda = rule449 _argPats _lhsIoptions _rhsIattrs arg_name_ _argPats = rule450 _addbang1 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIlazyIntras _lhsIlocalAttrTypes _lhsIoptions _rhsIattrs _argExprs = rule451 _rhsIattrs _stepcode = rule452 _argExprs _lhsIoptions _patternIattrTypes _patternIsem_lhs _rhsIattrs arg_name_ arg_pure_ _lhsOmrules :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc) _lhsOmrules = rule453 _stepcode arg_name_ _used = rule454 _lhsIusageInfo arg_name_ _kinds = rule455 _lhsIruleKinds arg_name_ _anyLazyKind = rule456 _kinds _lhsOruledefs :: Map Identifier (Set String) _lhsOruledefs = rule457 _patternIattrs arg_name_ _lhsOruleuses :: Map Identifier (Map String (Maybe NonLocalAttr)) _lhsOruleuses = rule458 _rhsIattrs arg_name_ _addbang = rule459 _lhsIoptions _addbang1 = rule460 _addbang _anyLazyKind _lhsOerrors :: Seq Error _lhsOerrors = rule461 _used arg_mbError_ _usedArgs_augmented_syn = rule462 () _patternOallInhmap = rule463 _lhsIallInhmap _patternOallSynmap = rule464 _lhsIallSynmap _patternOanyLazyKind = rule465 _anyLazyKind _patternOinhmap = rule466 _lhsIinhmap _patternOlocalAttrTypes = rule467 _lhsIlocalAttrTypes _patternOoptions = rule468 _lhsIoptions _patternOsynmap = rule469 _lhsIsynmap _rhsOoptions = rule470 _lhsIoptions __result_ = T_ERule_vOut19 _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules _lhsOusedArgs in __result_ ) in C_ERule_s20 v19 {-# INLINE rule441 #-} rule441 = \ _usedArgs_augmented_f1 _usedArgs_augmented_syn -> foldr ($) _usedArgs_augmented_syn [_usedArgs_augmented_f1] {-# INLINE rule442 #-} rule442 = \ ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) -> Set.union $ Map.keysSet $ Map.mapKeys (\a -> "arg_" ++ a) $ Map.filter isNothing _rhsIattrs {-# INLINE rule443 #-} {-# LINE 1011 "src-ag/ExecutionPlan2Clean.ag" #-} rule443 = \ _rulecode _used -> {-# LINE 1011 "src-ag/ExecutionPlan2Clean.ag" #-} if _used == 0 then empty else _rulecode {-# LINE 3464 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule444 #-} {-# LINE 1014 "src-ag/ExecutionPlan2Clean.ag" #-} rule444 = \ _endpragma _genpragma _lambda _pragma ((_rhsIpos) :: Pos) ((_rhsIsemfunc) :: PP_Doc) -> {-# LINE 1014 "src-ag/ExecutionPlan2Clean.ag" #-} ( if _genpragma then _pragma else empty ) >-< _lambda >-< indent ((column _rhsIpos - 2) `max` 2) ( if _genpragma then _pragma >-< _rhsIsemfunc >-< _endpragma else _rhsIsemfunc ) {-# LINE 3479 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule445 #-} {-# LINE 1026 "src-ag/ExecutionPlan2Clean.ag" #-} rule445 = \ ((_rhsIpos) :: Pos) -> {-# LINE 1026 "src-ag/ExecutionPlan2Clean.ag" #-} "/*# LINE" >#< show (line _rhsIpos) >#< show (file _rhsIpos) >#< "#*/" {-# LINE 3485 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule446 #-} {-# LINE 1027 "src-ag/ExecutionPlan2Clean.ag" #-} rule446 = \ ((_lhsImainFile) :: String) -> {-# LINE 1027 "src-ag/ExecutionPlan2Clean.ag" #-} ppWithLineNr (\ln -> "/*# LINE " ++ show (ln+1) ++ " " ++ show _lhsImainFile ++ "#*/") {-# LINE 3491 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule447 #-} {-# LINE 1028 "src-ag/ExecutionPlan2Clean.ag" #-} rule447 = \ _haspos ((_lhsIoptions) :: Options) explicit_ -> {-# LINE 1028 "src-ag/ExecutionPlan2Clean.ag" #-} genLinePragmas _lhsIoptions && explicit_ && _haspos {-# LINE 3497 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule448 #-} {-# LINE 1029 "src-ag/ExecutionPlan2Clean.ag" #-} rule448 = \ ((_rhsIpos) :: Pos) -> {-# LINE 1029 "src-ag/ExecutionPlan2Clean.ag" #-} line _rhsIpos > 0 && column _rhsIpos >= 0 && not (null (file _rhsIpos)) {-# LINE 3503 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule449 #-} {-# LINE 1042 "src-ag/ExecutionPlan2Clean.ag" #-} rule449 = \ _argPats ((_lhsIoptions) :: Options) ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) name_ -> {-# LINE 1042 "src-ag/ExecutionPlan2Clean.ag" #-} name_ >#< _argPats >#< dummyPat _lhsIoptions (Map.null _rhsIattrs) >#< "=" {-# LINE 3509 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule450 #-} {-# LINE 1044 "src-ag/ExecutionPlan2Clean.ag" #-} rule450 = \ _addbang1 ((_lhsIallInhmap) :: Map NontermIdent Attributes) ((_lhsIallSynmap) :: Map NontermIdent Attributes) ((_lhsIchildTypes) :: Map Identifier Type) ((_lhsIlazyIntras) :: Set String) ((_lhsIlocalAttrTypes) :: Map Identifier Type) ((_lhsIoptions) :: Options) ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) -> {-# LINE 1044 "src-ag/ExecutionPlan2Clean.ag" #-} ppSpaced [ let match | str `Set.member` _lhsIlazyIntras = pp str | otherwise = _addbang1 (pp str) in case mbAttr of Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs _lhsIoptions) -> case Map.lookup nm _lhsIlocalAttrTypes of Just tp -> pp_parens (pp_parens match) Nothing -> match Just attr | not (noPerRuleTypeSigs _lhsIoptions) -> case lookupAttrType attr _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes of Just tpDoc -> pp_parens (pp_parens match) Nothing -> match _ -> match | (str,mbAttr) <- Map.assocs _rhsIattrs ] {-# LINE 3528 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule451 #-} {-# LINE 1058 "src-ag/ExecutionPlan2Clean.ag" #-} rule451 = \ ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) -> {-# LINE 1058 "src-ag/ExecutionPlan2Clean.ag" #-} ppSpaced [ case mbAttr of Nothing -> "arg_" >|< str _ -> text str | (str,mbAttr) <- Map.assocs _rhsIattrs ] {-# LINE 3538 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule452 #-} {-# LINE 1063 "src-ag/ExecutionPlan2Clean.ag" #-} rule452 = \ _argExprs ((_lhsIoptions) :: Options) ((_patternIattrTypes) :: PP_Doc) ((_patternIsem_lhs) :: PP_Doc ) ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) name_ pure_ -> {-# LINE 1063 "src-ag/ExecutionPlan2Clean.ag" #-} \kind fmtMode -> if kind `compatibleRule` pure_ then Right $ let oper | pure_ = "=" | otherwise = "<-" decl = _patternIsem_lhs >#< oper >#< name_ >#< _argExprs >#< dummyArg _lhsIoptions (Map.null _rhsIattrs) tp = if pure_ && not (noPerRuleTypeSigs _lhsIoptions) then _patternIattrTypes else empty in fmtDecl pure_ fmtMode (tp >-< decl) else Left $ IncompatibleRuleKind name_ kind {-# LINE 3552 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule453 #-} {-# LINE 1073 "src-ag/ExecutionPlan2Clean.ag" #-} rule453 = \ _stepcode name_ -> {-# LINE 1073 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton name_ _stepcode {-# LINE 3558 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule454 #-} {-# LINE 1279 "src-ag/ExecutionPlan2Clean.ag" #-} rule454 = \ ((_lhsIusageInfo) :: Map Identifier Int) name_ -> {-# LINE 1279 "src-ag/ExecutionPlan2Clean.ag" #-} Map.findWithDefault 0 name_ _lhsIusageInfo {-# LINE 3564 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule455 #-} {-# LINE 1295 "src-ag/ExecutionPlan2Clean.ag" #-} rule455 = \ ((_lhsIruleKinds) :: Map Identifier (Set VisitKind)) name_ -> {-# LINE 1295 "src-ag/ExecutionPlan2Clean.ag" #-} Map.findWithDefault Set.empty name_ _lhsIruleKinds {-# LINE 3570 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule456 #-} {-# LINE 1296 "src-ag/ExecutionPlan2Clean.ag" #-} rule456 = \ _kinds -> {-# LINE 1296 "src-ag/ExecutionPlan2Clean.ag" #-} Set.fold (\k r -> isLazyKind k || r) False _kinds {-# LINE 3576 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule457 #-} {-# LINE 1342 "src-ag/ExecutionPlan2Clean.ag" #-} rule457 = \ ((_patternIattrs) :: Set String) name_ -> {-# LINE 1342 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton name_ _patternIattrs {-# LINE 3582 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule458 #-} {-# LINE 1343 "src-ag/ExecutionPlan2Clean.ag" #-} rule458 = \ ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) name_ -> {-# LINE 1343 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton name_ _rhsIattrs {-# LINE 3588 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule459 #-} {-# LINE 1564 "src-ag/ExecutionPlan2Clean.ag" #-} rule459 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1564 "src-ag/ExecutionPlan2Clean.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 3594 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule460 #-} {-# LINE 1575 "src-ag/ExecutionPlan2Clean.ag" #-} rule460 = \ _addbang _anyLazyKind -> {-# LINE 1575 "src-ag/ExecutionPlan2Clean.ag" #-} if _anyLazyKind then id else _addbang {-# LINE 3600 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule461 #-} {-# LINE 1681 "src-ag/ExecutionPlan2Clean.ag" #-} rule461 = \ _used mbError_ -> {-# LINE 1681 "src-ag/ExecutionPlan2Clean.ag" #-} case mbError_ of Just e | _used > 0 -> Seq.singleton e _ -> Seq.empty {-# LINE 3608 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule462 #-} rule462 = \ (_ :: ()) -> Set.empty {-# INLINE rule463 #-} rule463 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule464 #-} rule464 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule465 #-} rule465 = \ _anyLazyKind -> _anyLazyKind {-# INLINE rule466 #-} rule466 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule467 #-} rule467 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule468 #-} rule468 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule469 #-} rule469 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule470 #-} rule470 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- ERules ------------------------------------------------------ -- wrapper data Inh_ERules = Inh_ERules { allInhmap_Inh_ERules :: (Map NontermIdent Attributes), allSynmap_Inh_ERules :: (Map NontermIdent Attributes), childTypes_Inh_ERules :: (Map Identifier Type), con_Inh_ERules :: (ConstructorIdent), constructorTypeMap_Inh_ERules :: (Map NontermIdent ConstructorType), dclModuleHeader_Inh_ERules :: (String -> String -> String -> Bool -> String), iclModuleHeader_Inh_ERules :: (String -> String -> String -> Bool -> String), importBlocks_Inh_ERules :: (PP_Doc), inhmap_Inh_ERules :: (Attributes), lazyIntras_Inh_ERules :: (Set String), localAttrTypes_Inh_ERules :: (Map Identifier Type), mainFile_Inh_ERules :: (String), mainName_Inh_ERules :: (String), nt_Inh_ERules :: (NontermIdent), options_Inh_ERules :: (Options), ruleKinds_Inh_ERules :: (Map Identifier (Set VisitKind)), synmap_Inh_ERules :: (Attributes), textBlocks_Inh_ERules :: (PP_Doc), usageInfo_Inh_ERules :: (Map Identifier Int) } data Syn_ERules = Syn_ERules { errors_Syn_ERules :: (Seq Error), mrules_Syn_ERules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)), ruledefs_Syn_ERules :: (Map Identifier (Set String)), ruleuses_Syn_ERules :: (Map Identifier (Map String (Maybe NonLocalAttr))), sem_rules_Syn_ERules :: (PP_Doc), usedArgs_Syn_ERules :: (Set String) } {-# INLINABLE wrap_ERules #-} wrap_ERules :: T_ERules -> Inh_ERules -> (Syn_ERules ) wrap_ERules (T_ERules act) (Inh_ERules _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo) = Control.Monad.Identity.runIdentity ( do sem <- act let arg22 = T_ERules_vIn22 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo (T_ERules_vOut22 _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules _lhsOusedArgs) <- return (inv_ERules_s23 sem arg22) return (Syn_ERules _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules _lhsOusedArgs) ) -- cata {-# NOINLINE sem_ERules #-} sem_ERules :: ERules -> T_ERules sem_ERules list = Prelude.foldr sem_ERules_Cons sem_ERules_Nil (Prelude.map sem_ERule list) -- semantic domain newtype T_ERules = T_ERules { attach_T_ERules :: Identity (T_ERules_s23 ) } newtype T_ERules_s23 = C_ERules_s23 { inv_ERules_s23 :: (T_ERules_v22 ) } data T_ERules_s24 = C_ERules_s24 type T_ERules_v22 = (T_ERules_vIn22 ) -> (T_ERules_vOut22 ) data T_ERules_vIn22 = T_ERules_vIn22 (Map NontermIdent Attributes) (Map NontermIdent Attributes) (Map Identifier Type) (ConstructorIdent) (Map NontermIdent ConstructorType) (String -> String -> String -> Bool -> String) (String -> String -> String -> Bool -> String) (PP_Doc) (Attributes) (Set String) (Map Identifier Type) (String) (String) (NontermIdent) (Options) (Map Identifier (Set VisitKind)) (Attributes) (PP_Doc) (Map Identifier Int) data T_ERules_vOut22 = T_ERules_vOut22 (Seq Error) (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (PP_Doc) (Set String) {-# NOINLINE sem_ERules_Cons #-} sem_ERules_Cons :: T_ERule -> T_ERules -> T_ERules sem_ERules_Cons arg_hd_ arg_tl_ = T_ERules (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_ERules_v22 v22 = \ (T_ERules_vIn22 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo) -> ( let _hdX20 = Control.Monad.Identity.runIdentity (attach_T_ERule (arg_hd_)) _tlX23 = Control.Monad.Identity.runIdentity (attach_T_ERules (arg_tl_)) (T_ERule_vOut19 _hdIerrors _hdImrules _hdIruledefs _hdIruleuses _hdIsem_rules _hdIusedArgs) = inv_ERule_s20 _hdX20 (T_ERule_vIn19 _hdOallInhmap _hdOallSynmap _hdOchildTypes _hdOcon _hdOconstructorTypeMap _hdOdclModuleHeader _hdOiclModuleHeader _hdOimportBlocks _hdOinhmap _hdOlazyIntras _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOnt _hdOoptions _hdOruleKinds _hdOsynmap _hdOtextBlocks _hdOusageInfo) (T_ERules_vOut22 _tlIerrors _tlImrules _tlIruledefs _tlIruleuses _tlIsem_rules _tlIusedArgs) = inv_ERules_s23 _tlX23 (T_ERules_vIn22 _tlOallInhmap _tlOallSynmap _tlOchildTypes _tlOcon _tlOconstructorTypeMap _tlOdclModuleHeader _tlOiclModuleHeader _tlOimportBlocks _tlOinhmap _tlOlazyIntras _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOnt _tlOoptions _tlOruleKinds _tlOsynmap _tlOtextBlocks _tlOusageInfo) _lhsOerrors :: Seq Error _lhsOerrors = rule471 _hdIerrors _tlIerrors _lhsOmrules :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc) _lhsOmrules = rule472 _hdImrules _tlImrules _lhsOruledefs :: Map Identifier (Set String) _lhsOruledefs = rule473 _hdIruledefs _tlIruledefs _lhsOruleuses :: Map Identifier (Map String (Maybe NonLocalAttr)) _lhsOruleuses = rule474 _hdIruleuses _tlIruleuses _lhsOsem_rules :: PP_Doc _lhsOsem_rules = rule475 _hdIsem_rules _tlIsem_rules _lhsOusedArgs :: Set String _lhsOusedArgs = rule476 _hdIusedArgs _tlIusedArgs _hdOallInhmap = rule477 _lhsIallInhmap _hdOallSynmap = rule478 _lhsIallSynmap _hdOchildTypes = rule479 _lhsIchildTypes _hdOcon = rule480 _lhsIcon _hdOconstructorTypeMap = rule481 _lhsIconstructorTypeMap _hdOdclModuleHeader = rule482 _lhsIdclModuleHeader _hdOiclModuleHeader = rule483 _lhsIiclModuleHeader _hdOimportBlocks = rule484 _lhsIimportBlocks _hdOinhmap = rule485 _lhsIinhmap _hdOlazyIntras = rule486 _lhsIlazyIntras _hdOlocalAttrTypes = rule487 _lhsIlocalAttrTypes _hdOmainFile = rule488 _lhsImainFile _hdOmainName = rule489 _lhsImainName _hdOnt = rule490 _lhsInt _hdOoptions = rule491 _lhsIoptions _hdOruleKinds = rule492 _lhsIruleKinds _hdOsynmap = rule493 _lhsIsynmap _hdOtextBlocks = rule494 _lhsItextBlocks _hdOusageInfo = rule495 _lhsIusageInfo _tlOallInhmap = rule496 _lhsIallInhmap _tlOallSynmap = rule497 _lhsIallSynmap _tlOchildTypes = rule498 _lhsIchildTypes _tlOcon = rule499 _lhsIcon _tlOconstructorTypeMap = rule500 _lhsIconstructorTypeMap _tlOdclModuleHeader = rule501 _lhsIdclModuleHeader _tlOiclModuleHeader = rule502 _lhsIiclModuleHeader _tlOimportBlocks = rule503 _lhsIimportBlocks _tlOinhmap = rule504 _lhsIinhmap _tlOlazyIntras = rule505 _lhsIlazyIntras _tlOlocalAttrTypes = rule506 _lhsIlocalAttrTypes _tlOmainFile = rule507 _lhsImainFile _tlOmainName = rule508 _lhsImainName _tlOnt = rule509 _lhsInt _tlOoptions = rule510 _lhsIoptions _tlOruleKinds = rule511 _lhsIruleKinds _tlOsynmap = rule512 _lhsIsynmap _tlOtextBlocks = rule513 _lhsItextBlocks _tlOusageInfo = rule514 _lhsIusageInfo __result_ = T_ERules_vOut22 _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules _lhsOusedArgs in __result_ ) in C_ERules_s23 v22 {-# INLINE rule471 #-} rule471 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule472 #-} rule472 = \ ((_hdImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) ((_tlImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _hdImrules `Map.union` _tlImrules {-# INLINE rule473 #-} rule473 = \ ((_hdIruledefs) :: Map Identifier (Set String)) ((_tlIruledefs) :: Map Identifier (Set String)) -> _hdIruledefs `uwSetUnion` _tlIruledefs {-# INLINE rule474 #-} rule474 = \ ((_hdIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) ((_tlIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _hdIruleuses `uwMapUnion` _tlIruleuses {-# INLINE rule475 #-} rule475 = \ ((_hdIsem_rules) :: PP_Doc) ((_tlIsem_rules) :: PP_Doc) -> _hdIsem_rules >-< _tlIsem_rules {-# INLINE rule476 #-} rule476 = \ ((_hdIusedArgs) :: Set String) ((_tlIusedArgs) :: Set String) -> _hdIusedArgs `Set.union` _tlIusedArgs {-# INLINE rule477 #-} rule477 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule478 #-} rule478 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule479 #-} rule479 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule480 #-} rule480 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule481 #-} rule481 = \ ((_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# INLINE rule482 #-} rule482 = \ ((_lhsIdclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIdclModuleHeader {-# INLINE rule483 #-} rule483 = \ ((_lhsIiclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIiclModuleHeader {-# INLINE rule484 #-} rule484 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule485 #-} rule485 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule486 #-} rule486 = \ ((_lhsIlazyIntras) :: Set String) -> _lhsIlazyIntras {-# INLINE rule487 #-} rule487 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule488 #-} rule488 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule489 #-} rule489 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule490 #-} rule490 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule491 #-} rule491 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule492 #-} rule492 = \ ((_lhsIruleKinds) :: Map Identifier (Set VisitKind)) -> _lhsIruleKinds {-# INLINE rule493 #-} rule493 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule494 #-} rule494 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule495 #-} rule495 = \ ((_lhsIusageInfo) :: Map Identifier Int) -> _lhsIusageInfo {-# INLINE rule496 #-} rule496 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule497 #-} rule497 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule498 #-} rule498 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule499 #-} rule499 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule500 #-} rule500 = \ ((_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# INLINE rule501 #-} rule501 = \ ((_lhsIdclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIdclModuleHeader {-# INLINE rule502 #-} rule502 = \ ((_lhsIiclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIiclModuleHeader {-# INLINE rule503 #-} rule503 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule504 #-} rule504 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule505 #-} rule505 = \ ((_lhsIlazyIntras) :: Set String) -> _lhsIlazyIntras {-# INLINE rule506 #-} rule506 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule507 #-} rule507 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule508 #-} rule508 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule509 #-} rule509 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule510 #-} rule510 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule511 #-} rule511 = \ ((_lhsIruleKinds) :: Map Identifier (Set VisitKind)) -> _lhsIruleKinds {-# INLINE rule512 #-} rule512 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule513 #-} rule513 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule514 #-} rule514 = \ ((_lhsIusageInfo) :: Map Identifier Int) -> _lhsIusageInfo {-# NOINLINE sem_ERules_Nil #-} sem_ERules_Nil :: T_ERules sem_ERules_Nil = T_ERules (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_ERules_v22 v22 = \ (T_ERules_vIn22 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsInt _lhsIoptions _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo) -> ( let _lhsOerrors :: Seq Error _lhsOerrors = rule515 () _lhsOmrules :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc) _lhsOmrules = rule516 () _lhsOruledefs :: Map Identifier (Set String) _lhsOruledefs = rule517 () _lhsOruleuses :: Map Identifier (Map String (Maybe NonLocalAttr)) _lhsOruleuses = rule518 () _lhsOsem_rules :: PP_Doc _lhsOsem_rules = rule519 () _lhsOusedArgs :: Set String _lhsOusedArgs = rule520 () __result_ = T_ERules_vOut22 _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules _lhsOusedArgs in __result_ ) in C_ERules_s23 v22 {-# INLINE rule515 #-} rule515 = \ (_ :: ()) -> Seq.empty {-# INLINE rule516 #-} rule516 = \ (_ :: ()) -> Map.empty {-# INLINE rule517 #-} rule517 = \ (_ :: ()) -> Map.empty {-# INLINE rule518 #-} rule518 = \ (_ :: ()) -> Map.empty {-# INLINE rule519 #-} rule519 = \ (_ :: ()) -> empty {-# INLINE rule520 #-} rule520 = \ (_ :: ()) -> Set.empty -- ExecutionPlan ----------------------------------------------- -- wrapper data Inh_ExecutionPlan = Inh_ExecutionPlan { constructorTypeMap_Inh_ExecutionPlan :: (Map NontermIdent ConstructorType), dclModuleHeader_Inh_ExecutionPlan :: (String -> String -> String -> Bool -> String), iclModuleHeader_Inh_ExecutionPlan :: (String -> String -> String -> Bool -> String), importBlocks_Inh_ExecutionPlan :: (PP_Doc), inhmap_Inh_ExecutionPlan :: (Map NontermIdent Attributes), localAttrTypes_Inh_ExecutionPlan :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))), mainBlocksDoc_Inh_ExecutionPlan :: (PP_Doc), mainFile_Inh_ExecutionPlan :: (String), mainName_Inh_ExecutionPlan :: (String), options_Inh_ExecutionPlan :: (Options), synmap_Inh_ExecutionPlan :: (Map NontermIdent Attributes), textBlockMap_Inh_ExecutionPlan :: (Map BlockInfo PP_Doc), textBlocks_Inh_ExecutionPlan :: (PP_Doc) } data Syn_ExecutionPlan = Syn_ExecutionPlan { errors_Syn_ExecutionPlan :: (Seq Error), genIO_Syn_ExecutionPlan :: (IO ()), output_Syn_ExecutionPlan :: (PP_Doc), output_dcl_Syn_ExecutionPlan :: (PP_Doc) } {-# INLINABLE wrap_ExecutionPlan #-} wrap_ExecutionPlan :: T_ExecutionPlan -> Inh_ExecutionPlan -> (Syn_ExecutionPlan ) wrap_ExecutionPlan (T_ExecutionPlan act) (Inh_ExecutionPlan _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItextBlockMap _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do sem <- act let arg25 = T_ExecutionPlan_vIn25 _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItextBlockMap _lhsItextBlocks (T_ExecutionPlan_vOut25 _lhsOerrors _lhsOgenIO _lhsOoutput _lhsOoutput_dcl) <- return (inv_ExecutionPlan_s26 sem arg25) return (Syn_ExecutionPlan _lhsOerrors _lhsOgenIO _lhsOoutput _lhsOoutput_dcl) ) -- cata {-# INLINE sem_ExecutionPlan #-} sem_ExecutionPlan :: ExecutionPlan -> T_ExecutionPlan sem_ExecutionPlan ( ExecutionPlan nonts_ typeSyns_ wrappers_ derivings_ ) = sem_ExecutionPlan_ExecutionPlan ( sem_ENonterminals nonts_ ) typeSyns_ wrappers_ derivings_ -- semantic domain newtype T_ExecutionPlan = T_ExecutionPlan { attach_T_ExecutionPlan :: Identity (T_ExecutionPlan_s26 ) } newtype T_ExecutionPlan_s26 = C_ExecutionPlan_s26 { inv_ExecutionPlan_s26 :: (T_ExecutionPlan_v25 ) } data T_ExecutionPlan_s27 = C_ExecutionPlan_s27 type T_ExecutionPlan_v25 = (T_ExecutionPlan_vIn25 ) -> (T_ExecutionPlan_vOut25 ) data T_ExecutionPlan_vIn25 = T_ExecutionPlan_vIn25 (Map NontermIdent ConstructorType) (String -> String -> String -> Bool -> String) (String -> String -> String -> Bool -> String) (PP_Doc) (Map NontermIdent Attributes) (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) (PP_Doc) (String) (String) (Options) (Map NontermIdent Attributes) (Map BlockInfo PP_Doc) (PP_Doc) data T_ExecutionPlan_vOut25 = T_ExecutionPlan_vOut25 (Seq Error) (IO ()) (PP_Doc) (PP_Doc) {-# NOINLINE sem_ExecutionPlan_ExecutionPlan #-} sem_ExecutionPlan_ExecutionPlan :: T_ENonterminals -> (TypeSyns) -> (Set NontermIdent) -> (Derivings) -> T_ExecutionPlan sem_ExecutionPlan_ExecutionPlan arg_nonts_ arg_typeSyns_ arg_wrappers_ arg_derivings_ = T_ExecutionPlan (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_ExecutionPlan_v25 v25 = \ (T_ExecutionPlan_vIn25 _lhsIconstructorTypeMap _lhsIdclModuleHeader _lhsIiclModuleHeader _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap _lhsItextBlockMap _lhsItextBlocks) -> ( let _nontsX11 = Control.Monad.Identity.runIdentity (attach_T_ENonterminals (arg_nonts_)) (T_ENonterminals_vOut10 _nontsIappendCommon _nontsIappendMain _nontsIchildvisit _nontsIerrors _nontsIfromToStates _nontsIgenProdIO _nontsIimports _nontsIinitStates _nontsIoutput _nontsIoutput_dcl _nontsIsemFunBndDefs _nontsIsemFunBndTps _nontsIvisitKinds _nontsIvisitdefs _nontsIvisituses) = inv_ENonterminals_s11 _nontsX11 (T_ENonterminals_vIn10 _nontsOallFromToStates _nontsOallInitStates _nontsOallVisitKinds _nontsOallchildvisit _nontsOavisitdefs _nontsOavisituses _nontsOconstructorTypeMap _nontsOdclModuleHeader _nontsOderivings _nontsOiclModuleHeader _nontsOimportBlocks _nontsOinhmap _nontsOlocalAttrTypes _nontsOmainFile _nontsOmainName _nontsOoptions _nontsOsynmap _nontsOtextBlocks _nontsOtypeSyns _nontsOwrappers) _lhsOoutput :: PP_Doc _lhsOoutput = rule521 _commonExtra _nontsIoutput _wrappersExtra _lhsOoutput_dcl :: PP_Doc _lhsOoutput_dcl = rule522 _nontsIoutput_dcl _nontsOwrappers = rule523 arg_wrappers_ _nontsOtypeSyns = rule524 arg_typeSyns_ _nontsOderivings = rule525 arg_derivings_ _wrappersExtra = rule526 _lateSemBndDef _lhsIoptions _commonExtra = rule527 _lateSemBndTp _lhsIoptions _lateSemBndTp = rule528 _lhsImainName _nontsIsemFunBndTps _lateSemBndDef = rule529 _lhsImainName _nontsIsemFunBndDefs _nontsOallchildvisit = rule530 _nontsIchildvisit _nontsOavisitdefs = rule531 _nontsIvisitdefs _nontsOavisituses = rule532 _nontsIvisituses _lhsOgenIO :: IO () _lhsOgenIO = rule533 _genCommonModule _genMainModule _nontsIgenProdIO _mainModuleFile = rule534 _lhsImainFile _ppMonadImports = rule535 () _genMainModule = rule536 _lhsIiclModuleHeader _lhsImainBlocksDoc _lhsImainName _mainModuleFile _nontsIappendMain _nontsIimports _ppMonadImports _wrappersExtra _commonFile = rule537 _lhsImainFile _genCommonModule = rule538 _commonExtra _commonFile _lhsIiclModuleHeader _lhsIimportBlocks _lhsImainName _lhsItextBlocks _nontsIappendCommon _ppMonadImports _nontsOallFromToStates = rule539 _nontsIfromToStates _nontsOallVisitKinds = rule540 _nontsIvisitKinds _nontsOallInitStates = rule541 _nontsIinitStates _lhsOerrors :: Seq Error _lhsOerrors = rule542 _nontsIerrors _nontsOconstructorTypeMap = rule543 _lhsIconstructorTypeMap _nontsOdclModuleHeader = rule544 _lhsIdclModuleHeader _nontsOiclModuleHeader = rule545 _lhsIiclModuleHeader _nontsOimportBlocks = rule546 _lhsIimportBlocks _nontsOinhmap = rule547 _lhsIinhmap _nontsOlocalAttrTypes = rule548 _lhsIlocalAttrTypes _nontsOmainFile = rule549 _lhsImainFile _nontsOmainName = rule550 _lhsImainName _nontsOoptions = rule551 _lhsIoptions _nontsOsynmap = rule552 _lhsIsynmap _nontsOtextBlocks = rule553 _lhsItextBlocks __result_ = T_ExecutionPlan_vOut25 _lhsOerrors _lhsOgenIO _lhsOoutput _lhsOoutput_dcl in __result_ ) in C_ExecutionPlan_s26 v25 {-# INLINE rule521 #-} {-# LINE 91 "src-ag/ExecutionPlan2Clean.ag" #-} rule521 = \ _commonExtra ((_nontsIoutput) :: PP_Doc) _wrappersExtra -> {-# LINE 91 "src-ag/ExecutionPlan2Clean.ag" #-} _nontsIoutput >-< _commonExtra >-< _wrappersExtra {-# LINE 3988 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule522 #-} {-# LINE 92 "src-ag/ExecutionPlan2Clean.ag" #-} rule522 = \ ((_nontsIoutput_dcl) :: PP_Doc) -> {-# LINE 92 "src-ag/ExecutionPlan2Clean.ag" #-} _nontsIoutput_dcl {-# LINE 3994 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule523 #-} {-# LINE 99 "src-ag/ExecutionPlan2Clean.ag" #-} rule523 = \ wrappers_ -> {-# LINE 99 "src-ag/ExecutionPlan2Clean.ag" #-} wrappers_ {-# LINE 4000 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule524 #-} {-# LINE 159 "src-ag/ExecutionPlan2Clean.ag" #-} rule524 = \ typeSyns_ -> {-# LINE 159 "src-ag/ExecutionPlan2Clean.ag" #-} typeSyns_ {-# LINE 4006 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule525 #-} {-# LINE 160 "src-ag/ExecutionPlan2Clean.ag" #-} rule525 = \ derivings_ -> {-# LINE 160 "src-ag/ExecutionPlan2Clean.ag" #-} derivings_ {-# LINE 4012 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule526 #-} {-# LINE 599 "src-ag/ExecutionPlan2Clean.ag" #-} rule526 = \ _lateSemBndDef ((_lhsIoptions) :: Options) -> {-# LINE 599 "src-ag/ExecutionPlan2Clean.ag" #-} if lateHigherOrderBinding _lhsIoptions then _lateSemBndDef else empty {-# LINE 4020 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule527 #-} {-# LINE 602 "src-ag/ExecutionPlan2Clean.ag" #-} rule527 = \ _lateSemBndTp ((_lhsIoptions) :: Options) -> {-# LINE 602 "src-ag/ExecutionPlan2Clean.ag" #-} if lateHigherOrderBinding _lhsIoptions then _lateSemBndTp else empty {-# LINE 4028 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule528 #-} {-# LINE 605 "src-ag/ExecutionPlan2Clean.ag" #-} rule528 = \ ((_lhsImainName) :: String) ((_nontsIsemFunBndTps) :: Seq PP_Doc) -> {-# LINE 605 "src-ag/ExecutionPlan2Clean.ag" #-} "::" >#< lateBindingTypeNm _lhsImainName >#< "=" >#< lateBindingTypeNm _lhsImainName >-< (indent 2 $ pp_block "{" "}" "," $ toList _nontsIsemFunBndTps) {-# LINE 4035 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule529 #-} {-# LINE 607 "src-ag/ExecutionPlan2Clean.ag" #-} rule529 = \ ((_lhsImainName) :: String) ((_nontsIsemFunBndDefs) :: Seq PP_Doc) -> {-# LINE 607 "src-ag/ExecutionPlan2Clean.ag" #-} lateBindingFieldNm _lhsImainName >#< "::" >#< lateBindingTypeNm _lhsImainName >-< lateBindingFieldNm _lhsImainName >#< "=" >#< lateBindingTypeNm _lhsImainName >-< (indent 2 $ pp_block "{" "}" "," $ toList _nontsIsemFunBndDefs ) {-# LINE 4043 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule530 #-} {-# LINE 1223 "src-ag/ExecutionPlan2Clean.ag" #-} rule530 = \ ((_nontsIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> {-# LINE 1223 "src-ag/ExecutionPlan2Clean.ag" #-} _nontsIchildvisit {-# LINE 4049 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule531 #-} {-# LINE 1367 "src-ag/ExecutionPlan2Clean.ag" #-} rule531 = \ ((_nontsIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> {-# LINE 1367 "src-ag/ExecutionPlan2Clean.ag" #-} _nontsIvisitdefs {-# LINE 4055 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule532 #-} {-# LINE 1368 "src-ag/ExecutionPlan2Clean.ag" #-} rule532 = \ ((_nontsIvisituses) :: Map VisitIdentifier (Set Identifier)) -> {-# LINE 1368 "src-ag/ExecutionPlan2Clean.ag" #-} _nontsIvisituses {-# LINE 4061 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule533 #-} {-# LINE 1439 "src-ag/ExecutionPlan2Clean.ag" #-} rule533 = \ _genCommonModule _genMainModule ((_nontsIgenProdIO) :: IO ()) -> {-# LINE 1439 "src-ag/ExecutionPlan2Clean.ag" #-} do _genMainModule _genCommonModule _nontsIgenProdIO {-# LINE 4069 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule534 #-} {-# LINE 1442 "src-ag/ExecutionPlan2Clean.ag" #-} rule534 = \ ((_lhsImainFile) :: String) -> {-# LINE 1442 "src-ag/ExecutionPlan2Clean.ag" #-} _lhsImainFile {-# LINE 4075 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule535 #-} {-# LINE 1443 "src-ag/ExecutionPlan2Clean.ag" #-} rule535 = \ (_ :: ()) -> {-# LINE 1443 "src-ag/ExecutionPlan2Clean.ag" #-} pp "import qualified Control.Monad.Identity" {-# LINE 4081 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule536 #-} {-# LINE 1444 "src-ag/ExecutionPlan2Clean.ag" #-} rule536 = \ ((_lhsIiclModuleHeader) :: String -> String -> String -> Bool -> String) ((_lhsImainBlocksDoc) :: PP_Doc) ((_lhsImainName) :: String) _mainModuleFile ((_nontsIappendMain) :: [PP_Doc]) ((_nontsIimports) :: [PP_Doc]) _ppMonadImports _wrappersExtra -> {-# LINE 1444 "src-ag/ExecutionPlan2Clean.ag" #-} writeModule _mainModuleFile ( [ pp $ _lhsIiclModuleHeader _lhsImainName "" "" False , _ppMonadImports , pp $ "import " ++ _lhsImainName ++ "_common" ] ++ _nontsIimports ++ [_lhsImainBlocksDoc] ++ [_wrappersExtra ] ++ _nontsIappendMain ) {-# LINE 4096 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule537 #-} {-# LINE 1454 "src-ag/ExecutionPlan2Clean.ag" #-} rule537 = \ ((_lhsImainFile) :: String) -> {-# LINE 1454 "src-ag/ExecutionPlan2Clean.ag" #-} replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ "_common") {-# LINE 4102 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule538 #-} {-# LINE 1455 "src-ag/ExecutionPlan2Clean.ag" #-} rule538 = \ _commonExtra _commonFile ((_lhsIiclModuleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIimportBlocks) :: PP_Doc) ((_lhsImainName) :: String) ((_lhsItextBlocks) :: PP_Doc) ((_nontsIappendCommon) :: [PP_Doc]) _ppMonadImports -> {-# LINE 1455 "src-ag/ExecutionPlan2Clean.ag" #-} writeModule _commonFile ( [ pp $ _lhsIiclModuleHeader _lhsImainName "_common" "" True , _ppMonadImports , _lhsIimportBlocks , _lhsItextBlocks , _commonExtra ] ++ _nontsIappendCommon ) {-# LINE 4116 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule539 #-} {-# LINE 1603 "src-ag/ExecutionPlan2Clean.ag" #-} rule539 = \ ((_nontsIfromToStates) :: Map VisitIdentifier (Int,Int)) -> {-# LINE 1603 "src-ag/ExecutionPlan2Clean.ag" #-} _nontsIfromToStates {-# LINE 4122 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule540 #-} {-# LINE 1647 "src-ag/ExecutionPlan2Clean.ag" #-} rule540 = \ ((_nontsIvisitKinds) :: Map VisitIdentifier VisitKind) -> {-# LINE 1647 "src-ag/ExecutionPlan2Clean.ag" #-} _nontsIvisitKinds {-# LINE 4128 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule541 #-} {-# LINE 1661 "src-ag/ExecutionPlan2Clean.ag" #-} rule541 = \ ((_nontsIinitStates) :: Map NontermIdent Int) -> {-# LINE 1661 "src-ag/ExecutionPlan2Clean.ag" #-} _nontsIinitStates {-# LINE 4134 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule542 #-} rule542 = \ ((_nontsIerrors) :: Seq Error) -> _nontsIerrors {-# INLINE rule543 #-} rule543 = \ ((_lhsIconstructorTypeMap) :: Map NontermIdent ConstructorType) -> _lhsIconstructorTypeMap {-# INLINE rule544 #-} rule544 = \ ((_lhsIdclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIdclModuleHeader {-# INLINE rule545 #-} rule545 = \ ((_lhsIiclModuleHeader) :: String -> String -> String -> Bool -> String) -> _lhsIiclModuleHeader {-# INLINE rule546 #-} rule546 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule547 #-} rule547 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) -> _lhsIinhmap {-# INLINE rule548 #-} rule548 = \ ((_lhsIlocalAttrTypes) :: Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) -> _lhsIlocalAttrTypes {-# INLINE rule549 #-} rule549 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule550 #-} rule550 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule551 #-} rule551 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule552 #-} rule552 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) -> _lhsIsynmap {-# INLINE rule553 #-} rule553 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks -- Expression -------------------------------------------------- -- wrapper data Inh_Expression = Inh_Expression { options_Inh_Expression :: (Options) } data Syn_Expression = Syn_Expression { attrs_Syn_Expression :: (Map String (Maybe NonLocalAttr)), pos_Syn_Expression :: (Pos), semfunc_Syn_Expression :: (PP_Doc), tks_Syn_Expression :: ([HsToken]) } {-# INLINABLE wrap_Expression #-} wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) wrap_Expression (T_Expression act) (Inh_Expression _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg28 = T_Expression_vIn28 _lhsIoptions (T_Expression_vOut28 _lhsOattrs _lhsOpos _lhsOsemfunc _lhsOtks) <- return (inv_Expression_s29 sem arg28) return (Syn_Expression _lhsOattrs _lhsOpos _lhsOsemfunc _lhsOtks) ) -- cata {-# INLINE sem_Expression #-} sem_Expression :: Expression -> T_Expression sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_ -- semantic domain newtype T_Expression = T_Expression { attach_T_Expression :: Identity (T_Expression_s29 ) } newtype T_Expression_s29 = C_Expression_s29 { inv_Expression_s29 :: (T_Expression_v28 ) } data T_Expression_s30 = C_Expression_s30 type T_Expression_v28 = (T_Expression_vIn28 ) -> (T_Expression_vOut28 ) data T_Expression_vIn28 = T_Expression_vIn28 (Options) data T_Expression_vOut28 = T_Expression_vOut28 (Map String (Maybe NonLocalAttr)) (Pos) (PP_Doc) ([HsToken]) {-# NOINLINE sem_Expression_Expression #-} sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression sem_Expression_Expression arg_pos_ arg_tks_ = T_Expression (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Expression_v28 v28 = \ (T_Expression_vIn28 _lhsIoptions) -> ( let _lhsOtks :: [HsToken] _lhsOtks = rule554 arg_tks_ _lhsOpos :: Pos _lhsOpos = rule555 arg_pos_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule556 _inhhstoken arg_tks_ _lhsOsemfunc :: PP_Doc _lhsOsemfunc = rule557 _inhhstoken arg_tks_ _inhhstoken = rule558 _lhsIoptions __result_ = T_Expression_vOut28 _lhsOattrs _lhsOpos _lhsOsemfunc _lhsOtks in __result_ ) in C_Expression_s29 v28 {-# INLINE rule554 #-} {-# LINE 1077 "src-ag/ExecutionPlan2Clean.ag" #-} rule554 = \ tks_ -> {-# LINE 1077 "src-ag/ExecutionPlan2Clean.ag" #-} tks_ {-# LINE 4226 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule555 #-} {-# LINE 1120 "src-ag/ExecutionPlan2Clean.ag" #-} rule555 = \ pos_ -> {-# LINE 1120 "src-ag/ExecutionPlan2Clean.ag" #-} pos_ {-# LINE 4232 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule556 #-} {-# LINE 1207 "src-ag/ExecutionPlan2Clean.ag" #-} rule556 = \ _inhhstoken tks_ -> {-# LINE 1207 "src-ag/ExecutionPlan2Clean.ag" #-} Map.unions $ map (\tok -> attrs_Syn_HsToken (wrap_HsToken (sem_HsToken tok) _inhhstoken )) tks_ {-# LINE 4238 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule557 #-} {-# LINE 1208 "src-ag/ExecutionPlan2Clean.ag" #-} rule557 = \ _inhhstoken tks_ -> {-# LINE 1208 "src-ag/ExecutionPlan2Clean.ag" #-} vlist $ showTokens $ map (\tok -> tok_Syn_HsToken (wrap_HsToken (sem_HsToken tok) _inhhstoken )) tks_ {-# LINE 4244 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule558 #-} {-# LINE 1209 "src-ag/ExecutionPlan2Clean.ag" #-} rule558 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1209 "src-ag/ExecutionPlan2Clean.ag" #-} Inh_HsToken _lhsIoptions {-# LINE 4250 "dist/build/ExecutionPlan2Clean.hs"#-} -- HsToken ----------------------------------------------------- -- wrapper data Inh_HsToken = Inh_HsToken { options_Inh_HsToken :: (Options) } data Syn_HsToken = Syn_HsToken { attrs_Syn_HsToken :: (Map String (Maybe NonLocalAttr)), tok_Syn_HsToken :: ((Pos,String)) } {-# INLINABLE wrap_HsToken #-} wrap_HsToken :: T_HsToken -> Inh_HsToken -> (Syn_HsToken ) wrap_HsToken (T_HsToken act) (Inh_HsToken _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg31 = T_HsToken_vIn31 _lhsIoptions (T_HsToken_vOut31 _lhsOattrs _lhsOtok) <- return (inv_HsToken_s32 sem arg31) return (Syn_HsToken _lhsOattrs _lhsOtok) ) -- cata {-# NOINLINE sem_HsToken #-} sem_HsToken :: HsToken -> T_HsToken sem_HsToken ( AGLocal var_ pos_ rdesc_ ) = sem_HsToken_AGLocal var_ pos_ rdesc_ sem_HsToken ( AGField field_ attr_ pos_ rdesc_ ) = sem_HsToken_AGField field_ attr_ pos_ rdesc_ sem_HsToken ( HsToken value_ pos_ ) = sem_HsToken_HsToken value_ pos_ sem_HsToken ( CharToken value_ pos_ ) = sem_HsToken_CharToken value_ pos_ sem_HsToken ( StrToken value_ pos_ ) = sem_HsToken_StrToken value_ pos_ sem_HsToken ( Err mesg_ pos_ ) = sem_HsToken_Err mesg_ pos_ -- semantic domain newtype T_HsToken = T_HsToken { attach_T_HsToken :: Identity (T_HsToken_s32 ) } newtype T_HsToken_s32 = C_HsToken_s32 { inv_HsToken_s32 :: (T_HsToken_v31 ) } data T_HsToken_s33 = C_HsToken_s33 type T_HsToken_v31 = (T_HsToken_vIn31 ) -> (T_HsToken_vOut31 ) data T_HsToken_vIn31 = T_HsToken_vIn31 (Options) data T_HsToken_vOut31 = T_HsToken_vOut31 (Map String (Maybe NonLocalAttr)) ((Pos,String)) {-# NOINLINE sem_HsToken_AGLocal #-} sem_HsToken_AGLocal :: (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGLocal arg_var_ arg_pos_ _ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule559 arg_var_ _tok = rule560 arg_pos_ arg_var_ _lhsOtok :: (Pos,String) _lhsOtok = rule561 _tok __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule559 #-} {-# LINE 1166 "src-ag/ExecutionPlan2Clean.ag" #-} rule559 = \ var_ -> {-# LINE 1166 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton (fieldname var_) Nothing {-# LINE 4307 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule560 #-} {-# LINE 1412 "src-ag/ExecutionPlan2Clean.ag" #-} rule560 = \ pos_ var_ -> {-# LINE 1412 "src-ag/ExecutionPlan2Clean.ag" #-} (pos_,fieldname var_) {-# LINE 4313 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule561 #-} rule561 = \ _tok -> _tok {-# NOINLINE sem_HsToken_AGField #-} sem_HsToken_AGField :: (Identifier) -> (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGField arg_field_ arg_attr_ arg_pos_ arg_rdesc_ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _mbAttr = rule562 arg_attr_ arg_field_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule563 _lhsIoptions _mbAttr arg_attr_ arg_field_ _addTrace = rule564 arg_attr_ arg_field_ arg_rdesc_ _lhsOtok :: (Pos,String) _lhsOtok = rule565 _addTrace _lhsIoptions arg_attr_ arg_field_ arg_pos_ __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule562 #-} {-# LINE 1167 "src-ag/ExecutionPlan2Clean.ag" #-} rule562 = \ attr_ field_ -> {-# LINE 1167 "src-ag/ExecutionPlan2Clean.ag" #-} if field_ == _INST || field_ == _FIELD || field_ == _INST' then Nothing else Just $ mkNonLocalAttr (field_ == _LHS) field_ attr_ {-# LINE 4340 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule563 #-} {-# LINE 1170 "src-ag/ExecutionPlan2Clean.ag" #-} rule563 = \ ((_lhsIoptions) :: Options) _mbAttr attr_ field_ -> {-# LINE 1170 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton (attrname _lhsIoptions True field_ attr_) _mbAttr {-# LINE 4346 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule564 #-} {-# LINE 1416 "src-ag/ExecutionPlan2Clean.ag" #-} rule564 = \ attr_ field_ rdesc_ -> {-# LINE 1416 "src-ag/ExecutionPlan2Clean.ag" #-} case rdesc_ of Just d -> \x -> "(trace_n " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))" Nothing -> id {-# LINE 4354 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule565 #-} {-# LINE 1419 "src-ag/ExecutionPlan2Clean.ag" #-} rule565 = \ _addTrace ((_lhsIoptions) :: Options) attr_ field_ pos_ -> {-# LINE 1419 "src-ag/ExecutionPlan2Clean.ag" #-} (pos_, _addTrace $ attrname _lhsIoptions True field_ attr_) {-# LINE 4360 "dist/build/ExecutionPlan2Clean.hs"#-} {-# NOINLINE sem_HsToken_HsToken #-} sem_HsToken_HsToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_HsToken arg_value_ arg_pos_ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _lhsOtok :: (Pos,String) _lhsOtok = rule566 arg_pos_ arg_value_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule567 () __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule566 #-} {-# LINE 1421 "src-ag/ExecutionPlan2Clean.ag" #-} rule566 = \ pos_ value_ -> {-# LINE 1421 "src-ag/ExecutionPlan2Clean.ag" #-} (pos_, value_) {-# LINE 4380 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule567 #-} rule567 = \ (_ :: ()) -> Map.empty {-# NOINLINE sem_HsToken_CharToken #-} sem_HsToken_CharToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_CharToken arg_value_ arg_pos_ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _lhsOtok :: (Pos,String) _lhsOtok = rule568 arg_pos_ arg_value_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule569 () __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule568 #-} {-# LINE 1423 "src-ag/ExecutionPlan2Clean.ag" #-} rule568 = \ pos_ value_ -> {-# LINE 1423 "src-ag/ExecutionPlan2Clean.ag" #-} (pos_, if null value_ then "" else showCharShort (head value_) ) {-# LINE 4406 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule569 #-} rule569 = \ (_ :: ()) -> Map.empty {-# NOINLINE sem_HsToken_StrToken #-} sem_HsToken_StrToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_StrToken arg_value_ arg_pos_ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _lhsOtok :: (Pos,String) _lhsOtok = rule570 arg_pos_ arg_value_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule571 () __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule570 #-} {-# LINE 1428 "src-ag/ExecutionPlan2Clean.ag" #-} rule570 = \ pos_ value_ -> {-# LINE 1428 "src-ag/ExecutionPlan2Clean.ag" #-} (pos_, showStrShort value_) {-# LINE 4429 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule571 #-} rule571 = \ (_ :: ()) -> Map.empty {-# NOINLINE sem_HsToken_Err #-} sem_HsToken_Err :: (String) -> (Pos) -> T_HsToken sem_HsToken_Err _ arg_pos_ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _lhsOtok :: (Pos,String) _lhsOtok = rule572 arg_pos_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule573 () __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule572 #-} {-# LINE 1429 "src-ag/ExecutionPlan2Clean.ag" #-} rule572 = \ pos_ -> {-# LINE 1429 "src-ag/ExecutionPlan2Clean.ag" #-} (pos_, "") {-# LINE 4452 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule573 #-} rule573 = \ (_ :: ()) -> Map.empty -- HsTokens ---------------------------------------------------- -- wrapper data Inh_HsTokens = Inh_HsTokens { options_Inh_HsTokens :: (Options) } data Syn_HsTokens = Syn_HsTokens { tks_Syn_HsTokens :: ([(Pos,String)]) } {-# INLINABLE wrap_HsTokens #-} wrap_HsTokens :: T_HsTokens -> Inh_HsTokens -> (Syn_HsTokens ) wrap_HsTokens (T_HsTokens act) (Inh_HsTokens _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg34 = T_HsTokens_vIn34 _lhsIoptions (T_HsTokens_vOut34 _lhsOtks) <- return (inv_HsTokens_s35 sem arg34) return (Syn_HsTokens _lhsOtks) ) -- cata {-# NOINLINE sem_HsTokens #-} sem_HsTokens :: HsTokens -> T_HsTokens sem_HsTokens list = Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) -- semantic domain newtype T_HsTokens = T_HsTokens { attach_T_HsTokens :: Identity (T_HsTokens_s35 ) } newtype T_HsTokens_s35 = C_HsTokens_s35 { inv_HsTokens_s35 :: (T_HsTokens_v34 ) } data T_HsTokens_s36 = C_HsTokens_s36 type T_HsTokens_v34 = (T_HsTokens_vIn34 ) -> (T_HsTokens_vOut34 ) data T_HsTokens_vIn34 = T_HsTokens_vIn34 (Options) data T_HsTokens_vOut34 = T_HsTokens_vOut34 ([(Pos,String)]) {-# NOINLINE sem_HsTokens_Cons #-} sem_HsTokens_Cons :: T_HsToken -> T_HsTokens -> T_HsTokens sem_HsTokens_Cons arg_hd_ arg_tl_ = T_HsTokens (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_HsTokens_v34 v34 = \ (T_HsTokens_vIn34 _lhsIoptions) -> ( let _hdX32 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_)) _tlX35 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_)) (T_HsToken_vOut31 _hdIattrs _hdItok) = inv_HsToken_s32 _hdX32 (T_HsToken_vIn31 _hdOoptions) (T_HsTokens_vOut34 _tlItks) = inv_HsTokens_s35 _tlX35 (T_HsTokens_vIn34 _tlOoptions) _lhsOtks :: [(Pos,String)] _lhsOtks = rule574 _hdItok _tlItks _hdOoptions = rule575 _lhsIoptions _tlOoptions = rule576 _lhsIoptions __result_ = T_HsTokens_vOut34 _lhsOtks in __result_ ) in C_HsTokens_s35 v34 {-# INLINE rule574 #-} {-# LINE 1408 "src-ag/ExecutionPlan2Clean.ag" #-} rule574 = \ ((_hdItok) :: (Pos,String)) ((_tlItks) :: [(Pos,String)]) -> {-# LINE 1408 "src-ag/ExecutionPlan2Clean.ag" #-} _hdItok : _tlItks {-# LINE 4510 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule575 #-} rule575 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule576 #-} rule576 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_HsTokens_Nil #-} sem_HsTokens_Nil :: T_HsTokens sem_HsTokens_Nil = T_HsTokens (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_HsTokens_v34 v34 = \ (T_HsTokens_vIn34 _lhsIoptions) -> ( let _lhsOtks :: [(Pos,String)] _lhsOtks = rule577 () __result_ = T_HsTokens_vOut34 _lhsOtks in __result_ ) in C_HsTokens_s35 v34 {-# INLINE rule577 #-} {-# LINE 1409 "src-ag/ExecutionPlan2Clean.ag" #-} rule577 = \ (_ :: ()) -> {-# LINE 1409 "src-ag/ExecutionPlan2Clean.ag" #-} [] {-# LINE 4534 "dist/build/ExecutionPlan2Clean.hs"#-} -- HsTokensRoot ------------------------------------------------ -- wrapper data Inh_HsTokensRoot = Inh_HsTokensRoot { options_Inh_HsTokensRoot :: (Options) } data Syn_HsTokensRoot = Syn_HsTokensRoot { } {-# INLINABLE wrap_HsTokensRoot #-} wrap_HsTokensRoot :: T_HsTokensRoot -> Inh_HsTokensRoot -> (Syn_HsTokensRoot ) wrap_HsTokensRoot (T_HsTokensRoot act) (Inh_HsTokensRoot _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg37 = T_HsTokensRoot_vIn37 _lhsIoptions (T_HsTokensRoot_vOut37 ) <- return (inv_HsTokensRoot_s38 sem arg37) return (Syn_HsTokensRoot ) ) -- cata {-# INLINE sem_HsTokensRoot #-} sem_HsTokensRoot :: HsTokensRoot -> T_HsTokensRoot sem_HsTokensRoot ( HsTokensRoot tokens_ ) = sem_HsTokensRoot_HsTokensRoot ( sem_HsTokens tokens_ ) -- semantic domain newtype T_HsTokensRoot = T_HsTokensRoot { attach_T_HsTokensRoot :: Identity (T_HsTokensRoot_s38 ) } newtype T_HsTokensRoot_s38 = C_HsTokensRoot_s38 { inv_HsTokensRoot_s38 :: (T_HsTokensRoot_v37 ) } data T_HsTokensRoot_s39 = C_HsTokensRoot_s39 type T_HsTokensRoot_v37 = (T_HsTokensRoot_vIn37 ) -> (T_HsTokensRoot_vOut37 ) data T_HsTokensRoot_vIn37 = T_HsTokensRoot_vIn37 (Options) data T_HsTokensRoot_vOut37 = T_HsTokensRoot_vOut37 {-# NOINLINE sem_HsTokensRoot_HsTokensRoot #-} sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> T_HsTokensRoot sem_HsTokensRoot_HsTokensRoot arg_tokens_ = T_HsTokensRoot (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_HsTokensRoot_v37 v37 = \ (T_HsTokensRoot_vIn37 _lhsIoptions) -> ( let _tokensX35 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tokens_)) (T_HsTokens_vOut34 _tokensItks) = inv_HsTokens_s35 _tokensX35 (T_HsTokens_vIn34 _tokensOoptions) _tokensOoptions = rule578 _lhsIoptions __result_ = T_HsTokensRoot_vOut37 in __result_ ) in C_HsTokensRoot_s38 v37 {-# INLINE rule578 #-} rule578 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { allInhmap_Inh_Pattern :: (Map NontermIdent Attributes), allSynmap_Inh_Pattern :: (Map NontermIdent Attributes), anyLazyKind_Inh_Pattern :: (Bool), inhmap_Inh_Pattern :: (Attributes), localAttrTypes_Inh_Pattern :: (Map Identifier Type), options_Inh_Pattern :: (Options), synmap_Inh_Pattern :: (Attributes) } data Syn_Pattern = Syn_Pattern { attrTypes_Syn_Pattern :: (PP_Doc), attrs_Syn_Pattern :: (Set String), copy_Syn_Pattern :: (Pattern), isUnderscore_Syn_Pattern :: (Bool), sem_lhs_Syn_Pattern :: ( PP_Doc ) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern (T_Pattern act) (Inh_Pattern _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg40 = T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap (T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs) <- return (inv_Pattern_s41 sem arg40) return (Syn_Pattern _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s41 ) } newtype T_Pattern_s41 = C_Pattern_s41 { inv_Pattern_s41 :: (T_Pattern_v40 ) } data T_Pattern_s42 = C_Pattern_s42 type T_Pattern_v40 = (T_Pattern_vIn40 ) -> (T_Pattern_vOut40 ) data T_Pattern_vIn40 = T_Pattern_vIn40 (Map NontermIdent Attributes) (Map NontermIdent Attributes) (Bool) (Attributes) (Map Identifier Type) (Options) (Attributes) data T_Pattern_vOut40 = T_Pattern_vOut40 (PP_Doc) (Set String) (Pattern) (Bool) ( PP_Doc ) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIattrTypes _patsIattrs _patsIcopy _patsIsem_lhs) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 _patsOallInhmap _patsOallSynmap _patsOanyLazyKind _patsOinhmap _patsOlocalAttrTypes _patsOoptions _patsOsynmap) _lhsOsem_lhs :: PP_Doc _lhsOsem_lhs = rule579 _addbang1 _patsIsem_lhs arg_name_ _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule580 () _addbang = rule581 _lhsIoptions _addbang1 = rule582 _addbang _lhsIanyLazyKind _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule583 _patsIattrTypes _lhsOattrs :: Set String _lhsOattrs = rule584 _patsIattrs _copy = rule585 _patsIcopy arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule586 _copy _patsOallInhmap = rule587 _lhsIallInhmap _patsOallSynmap = rule588 _lhsIallSynmap _patsOanyLazyKind = rule589 _lhsIanyLazyKind _patsOinhmap = rule590 _lhsIinhmap _patsOlocalAttrTypes = rule591 _lhsIlocalAttrTypes _patsOoptions = rule592 _lhsIoptions _patsOsynmap = rule593 _lhsIsynmap __result_ = T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule579 #-} {-# LINE 1134 "src-ag/ExecutionPlan2Clean.ag" #-} rule579 = \ _addbang1 ((_patsIsem_lhs) :: [PP_Doc]) name_ -> {-# LINE 1134 "src-ag/ExecutionPlan2Clean.ag" #-} _addbang1 $ pp_parens $ name_ >#< hv_sp _patsIsem_lhs {-# LINE 4654 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule580 #-} {-# LINE 1141 "src-ag/ExecutionPlan2Clean.ag" #-} rule580 = \ (_ :: ()) -> {-# LINE 1141 "src-ag/ExecutionPlan2Clean.ag" #-} False {-# LINE 4660 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule581 #-} {-# LINE 1571 "src-ag/ExecutionPlan2Clean.ag" #-} rule581 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1571 "src-ag/ExecutionPlan2Clean.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 4666 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule582 #-} {-# LINE 1576 "src-ag/ExecutionPlan2Clean.ag" #-} rule582 = \ _addbang ((_lhsIanyLazyKind) :: Bool) -> {-# LINE 1576 "src-ag/ExecutionPlan2Clean.ag" #-} if _lhsIanyLazyKind then id else _addbang {-# LINE 4672 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule583 #-} rule583 = \ ((_patsIattrTypes) :: PP_Doc) -> _patsIattrTypes {-# INLINE rule584 #-} rule584 = \ ((_patsIattrs) :: Set String) -> _patsIattrs {-# INLINE rule585 #-} rule585 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule586 #-} rule586 = \ _copy -> _copy {-# INLINE rule587 #-} rule587 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule588 #-} rule588 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule589 #-} rule589 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule590 #-} rule590 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule591 #-} rule591 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule592 #-} rule592 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule593 #-} rule593 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIattrTypes _patsIattrs _patsIcopy _patsIsem_lhs) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 _patsOallInhmap _patsOallSynmap _patsOanyLazyKind _patsOinhmap _patsOlocalAttrTypes _patsOoptions _patsOsynmap) _lhsOsem_lhs :: PP_Doc _lhsOsem_lhs = rule594 _addbang1 _patsIsem_lhs _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule595 () _addbang = rule596 _lhsIoptions _addbang1 = rule597 _addbang _lhsIanyLazyKind _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule598 _patsIattrTypes _lhsOattrs :: Set String _lhsOattrs = rule599 _patsIattrs _copy = rule600 _patsIcopy arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule601 _copy _patsOallInhmap = rule602 _lhsIallInhmap _patsOallSynmap = rule603 _lhsIallSynmap _patsOanyLazyKind = rule604 _lhsIanyLazyKind _patsOinhmap = rule605 _lhsIinhmap _patsOlocalAttrTypes = rule606 _lhsIlocalAttrTypes _patsOoptions = rule607 _lhsIoptions _patsOsynmap = rule608 _lhsIsynmap __result_ = T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule594 #-} {-# LINE 1133 "src-ag/ExecutionPlan2Clean.ag" #-} rule594 = \ _addbang1 ((_patsIsem_lhs) :: [PP_Doc]) -> {-# LINE 1133 "src-ag/ExecutionPlan2Clean.ag" #-} _addbang1 $ pp_block "(" ")" "," _patsIsem_lhs {-# LINE 4743 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule595 #-} {-# LINE 1142 "src-ag/ExecutionPlan2Clean.ag" #-} rule595 = \ (_ :: ()) -> {-# LINE 1142 "src-ag/ExecutionPlan2Clean.ag" #-} False {-# LINE 4749 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule596 #-} {-# LINE 1571 "src-ag/ExecutionPlan2Clean.ag" #-} rule596 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1571 "src-ag/ExecutionPlan2Clean.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 4755 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule597 #-} {-# LINE 1576 "src-ag/ExecutionPlan2Clean.ag" #-} rule597 = \ _addbang ((_lhsIanyLazyKind) :: Bool) -> {-# LINE 1576 "src-ag/ExecutionPlan2Clean.ag" #-} if _lhsIanyLazyKind then id else _addbang {-# LINE 4761 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule598 #-} rule598 = \ ((_patsIattrTypes) :: PP_Doc) -> _patsIattrTypes {-# INLINE rule599 #-} rule599 = \ ((_patsIattrs) :: Set String) -> _patsIattrs {-# INLINE rule600 #-} rule600 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule601 #-} rule601 = \ _copy -> _copy {-# INLINE rule602 #-} rule602 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule603 #-} rule603 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule604 #-} rule604 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule605 #-} rule605 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule606 #-} rule606 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule607 #-} rule607 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule608 #-} rule608 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIattrTypes _patIattrs _patIcopy _patIisUnderscore _patIsem_lhs) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 _patOallInhmap _patOallSynmap _patOanyLazyKind _patOinhmap _patOlocalAttrTypes _patOoptions _patOsynmap) _varPat = rule609 _lhsIoptions arg_attr_ arg_field_ _patExpr = rule610 _patIisUnderscore _patIsem_lhs _varPat _lhsOsem_lhs :: PP_Doc _lhsOsem_lhs = rule611 _addbang1 _patExpr _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule612 () _lhsOattrs :: Set String _lhsOattrs = rule613 _lhsIoptions _patIattrs arg_attr_ arg_field_ _mbTp = rule614 _lhsIlocalAttrTypes _lhsIsynmap arg_attr_ arg_field_ _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule615 () _addbang = rule616 _lhsIoptions _addbang1 = rule617 _addbang _lhsIanyLazyKind _copy = rule618 _patIcopy arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule619 _copy _patOallInhmap = rule620 _lhsIallInhmap _patOallSynmap = rule621 _lhsIallSynmap _patOanyLazyKind = rule622 _lhsIanyLazyKind _patOinhmap = rule623 _lhsIinhmap _patOlocalAttrTypes = rule624 _lhsIlocalAttrTypes _patOoptions = rule625 _lhsIoptions _patOsynmap = rule626 _lhsIsynmap __result_ = T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule609 #-} {-# LINE 1128 "src-ag/ExecutionPlan2Clean.ag" #-} rule609 = \ ((_lhsIoptions) :: Options) attr_ field_ -> {-# LINE 1128 "src-ag/ExecutionPlan2Clean.ag" #-} text $ attrname _lhsIoptions False field_ attr_ {-# LINE 4835 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule610 #-} {-# LINE 1129 "src-ag/ExecutionPlan2Clean.ag" #-} rule610 = \ ((_patIisUnderscore) :: Bool) ((_patIsem_lhs) :: PP_Doc ) _varPat -> {-# LINE 1129 "src-ag/ExecutionPlan2Clean.ag" #-} if _patIisUnderscore then _varPat else _varPat >|< "@" >|< _patIsem_lhs {-# LINE 4843 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule611 #-} {-# LINE 1132 "src-ag/ExecutionPlan2Clean.ag" #-} rule611 = \ _addbang1 _patExpr -> {-# LINE 1132 "src-ag/ExecutionPlan2Clean.ag" #-} _addbang1 _patExpr {-# LINE 4849 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule612 #-} {-# LINE 1143 "src-ag/ExecutionPlan2Clean.ag" #-} rule612 = \ (_ :: ()) -> {-# LINE 1143 "src-ag/ExecutionPlan2Clean.ag" #-} False {-# LINE 4855 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule613 #-} {-# LINE 1149 "src-ag/ExecutionPlan2Clean.ag" #-} rule613 = \ ((_lhsIoptions) :: Options) ((_patIattrs) :: Set String) attr_ field_ -> {-# LINE 1149 "src-ag/ExecutionPlan2Clean.ag" #-} Set.insert (attrname _lhsIoptions False field_ attr_) _patIattrs {-# LINE 4861 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule614 #-} {-# LINE 1154 "src-ag/ExecutionPlan2Clean.ag" #-} rule614 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) ((_lhsIsynmap) :: Attributes) attr_ field_ -> {-# LINE 1154 "src-ag/ExecutionPlan2Clean.ag" #-} if field_ == _LHS then Map.lookup attr_ _lhsIsynmap else if field_ == _LOC then Map.lookup attr_ _lhsIlocalAttrTypes else Nothing {-# LINE 4871 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule615 #-} {-# LINE 1159 "src-ag/ExecutionPlan2Clean.ag" #-} rule615 = \ (_ :: ()) -> {-# LINE 1159 "src-ag/ExecutionPlan2Clean.ag" #-} empty {-# LINE 4877 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule616 #-} {-# LINE 1571 "src-ag/ExecutionPlan2Clean.ag" #-} rule616 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1571 "src-ag/ExecutionPlan2Clean.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 4883 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule617 #-} {-# LINE 1576 "src-ag/ExecutionPlan2Clean.ag" #-} rule617 = \ _addbang ((_lhsIanyLazyKind) :: Bool) -> {-# LINE 1576 "src-ag/ExecutionPlan2Clean.ag" #-} if _lhsIanyLazyKind then id else _addbang {-# LINE 4889 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule618 #-} rule618 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule619 #-} rule619 = \ _copy -> _copy {-# INLINE rule620 #-} rule620 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule621 #-} rule621 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule622 #-} rule622 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule623 #-} rule623 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule624 #-} rule624 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule625 #-} rule625 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule626 #-} rule626 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIattrTypes _patIattrs _patIcopy _patIisUnderscore _patIsem_lhs) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 _patOallInhmap _patOallSynmap _patOanyLazyKind _patOinhmap _patOlocalAttrTypes _patOoptions _patOsynmap) _lhsOsem_lhs :: PP_Doc _lhsOsem_lhs = rule627 _patIsem_lhs _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule628 _patIattrTypes _lhsOattrs :: Set String _lhsOattrs = rule629 _patIattrs _copy = rule630 _patIcopy _lhsOcopy :: Pattern _lhsOcopy = rule631 _copy _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule632 _patIisUnderscore _patOallInhmap = rule633 _lhsIallInhmap _patOallSynmap = rule634 _lhsIallSynmap _patOanyLazyKind = rule635 _lhsIanyLazyKind _patOinhmap = rule636 _lhsIinhmap _patOlocalAttrTypes = rule637 _lhsIlocalAttrTypes _patOoptions = rule638 _lhsIoptions _patOsynmap = rule639 _lhsIsynmap __result_ = T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule627 #-} {-# LINE 1136 "src-ag/ExecutionPlan2Clean.ag" #-} rule627 = \ ((_patIsem_lhs) :: PP_Doc ) -> {-# LINE 1136 "src-ag/ExecutionPlan2Clean.ag" #-} text "~" >|< pp_parens _patIsem_lhs {-# LINE 4952 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule628 #-} rule628 = \ ((_patIattrTypes) :: PP_Doc) -> _patIattrTypes {-# INLINE rule629 #-} rule629 = \ ((_patIattrs) :: Set String) -> _patIattrs {-# INLINE rule630 #-} rule630 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule631 #-} rule631 = \ _copy -> _copy {-# INLINE rule632 #-} rule632 = \ ((_patIisUnderscore) :: Bool) -> _patIisUnderscore {-# INLINE rule633 #-} rule633 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule634 #-} rule634 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule635 #-} rule635 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule636 #-} rule636 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule637 #-} rule637 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule638 #-} rule638 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule639 #-} rule639 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore arg_pos_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _lhsOsem_lhs :: PP_Doc _lhsOsem_lhs = rule640 () _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule641 () _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule642 () _lhsOattrs :: Set String _lhsOattrs = rule643 () _copy = rule644 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule645 _copy __result_ = T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule640 #-} {-# LINE 1135 "src-ag/ExecutionPlan2Clean.ag" #-} rule640 = \ (_ :: ()) -> {-# LINE 1135 "src-ag/ExecutionPlan2Clean.ag" #-} text "_" {-# LINE 5015 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule641 #-} {-# LINE 1144 "src-ag/ExecutionPlan2Clean.ag" #-} rule641 = \ (_ :: ()) -> {-# LINE 1144 "src-ag/ExecutionPlan2Clean.ag" #-} True {-# LINE 5021 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule642 #-} rule642 = \ (_ :: ()) -> empty {-# INLINE rule643 #-} rule643 = \ (_ :: ()) -> Set.empty {-# INLINE rule644 #-} rule644 = \ pos_ -> Underscore pos_ {-# INLINE rule645 #-} rule645 = \ _copy -> _copy -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { allInhmap_Inh_Patterns :: (Map NontermIdent Attributes), allSynmap_Inh_Patterns :: (Map NontermIdent Attributes), anyLazyKind_Inh_Patterns :: (Bool), inhmap_Inh_Patterns :: (Attributes), localAttrTypes_Inh_Patterns :: (Map Identifier Type), options_Inh_Patterns :: (Options), synmap_Inh_Patterns :: (Attributes) } data Syn_Patterns = Syn_Patterns { attrTypes_Syn_Patterns :: (PP_Doc), attrs_Syn_Patterns :: (Set String), copy_Syn_Patterns :: (Patterns), sem_lhs_Syn_Patterns :: ([PP_Doc]) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns (T_Patterns act) (Inh_Patterns _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg43 = T_Patterns_vIn43 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap (T_Patterns_vOut43 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOsem_lhs) <- return (inv_Patterns_s44 sem arg43) return (Syn_Patterns _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOsem_lhs) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s44 ) } newtype T_Patterns_s44 = C_Patterns_s44 { inv_Patterns_s44 :: (T_Patterns_v43 ) } data T_Patterns_s45 = C_Patterns_s45 type T_Patterns_v43 = (T_Patterns_vIn43 ) -> (T_Patterns_vOut43 ) data T_Patterns_vIn43 = T_Patterns_vIn43 (Map NontermIdent Attributes) (Map NontermIdent Attributes) (Bool) (Attributes) (Map Identifier Type) (Options) (Attributes) data T_Patterns_vOut43 = T_Patterns_vOut43 (PP_Doc) (Set String) (Patterns) ([PP_Doc]) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_Patterns_v43 v43 = \ (T_Patterns_vIn43 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut40 _hdIattrTypes _hdIattrs _hdIcopy _hdIisUnderscore _hdIsem_lhs) = inv_Pattern_s41 _hdX41 (T_Pattern_vIn40 _hdOallInhmap _hdOallSynmap _hdOanyLazyKind _hdOinhmap _hdOlocalAttrTypes _hdOoptions _hdOsynmap) (T_Patterns_vOut43 _tlIattrTypes _tlIattrs _tlIcopy _tlIsem_lhs) = inv_Patterns_s44 _tlX44 (T_Patterns_vIn43 _tlOallInhmap _tlOallSynmap _tlOanyLazyKind _tlOinhmap _tlOlocalAttrTypes _tlOoptions _tlOsynmap) _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule646 _hdIattrTypes _tlIattrTypes _lhsOattrs :: Set String _lhsOattrs = rule647 _hdIattrs _tlIattrs _lhsOsem_lhs :: [PP_Doc] _lhsOsem_lhs = rule648 _hdIsem_lhs _tlIsem_lhs _copy = rule649 _hdIcopy _tlIcopy _lhsOcopy :: Patterns _lhsOcopy = rule650 _copy _hdOallInhmap = rule651 _lhsIallInhmap _hdOallSynmap = rule652 _lhsIallSynmap _hdOanyLazyKind = rule653 _lhsIanyLazyKind _hdOinhmap = rule654 _lhsIinhmap _hdOlocalAttrTypes = rule655 _lhsIlocalAttrTypes _hdOoptions = rule656 _lhsIoptions _hdOsynmap = rule657 _lhsIsynmap _tlOallInhmap = rule658 _lhsIallInhmap _tlOallSynmap = rule659 _lhsIallSynmap _tlOanyLazyKind = rule660 _lhsIanyLazyKind _tlOinhmap = rule661 _lhsIinhmap _tlOlocalAttrTypes = rule662 _lhsIlocalAttrTypes _tlOoptions = rule663 _lhsIoptions _tlOsynmap = rule664 _lhsIsynmap __result_ = T_Patterns_vOut43 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOsem_lhs in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule646 #-} rule646 = \ ((_hdIattrTypes) :: PP_Doc) ((_tlIattrTypes) :: PP_Doc) -> _hdIattrTypes >-< _tlIattrTypes {-# INLINE rule647 #-} rule647 = \ ((_hdIattrs) :: Set String) ((_tlIattrs) :: Set String) -> _hdIattrs `Set.union` _tlIattrs {-# INLINE rule648 #-} rule648 = \ ((_hdIsem_lhs) :: PP_Doc ) ((_tlIsem_lhs) :: [PP_Doc]) -> _hdIsem_lhs : _tlIsem_lhs {-# INLINE rule649 #-} rule649 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule650 #-} rule650 = \ _copy -> _copy {-# INLINE rule651 #-} rule651 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule652 #-} rule652 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule653 #-} rule653 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule654 #-} rule654 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule655 #-} rule655 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule656 #-} rule656 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule657 #-} rule657 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule658 #-} rule658 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule659 #-} rule659 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule660 #-} rule660 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule661 #-} rule661 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule662 #-} rule662 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule663 #-} rule663 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule664 #-} rule664 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_Patterns_v43 v43 = \ (T_Patterns_vIn43 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule665 () _lhsOattrs :: Set String _lhsOattrs = rule666 () _lhsOsem_lhs :: [PP_Doc] _lhsOsem_lhs = rule667 () _copy = rule668 () _lhsOcopy :: Patterns _lhsOcopy = rule669 _copy __result_ = T_Patterns_vOut43 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOsem_lhs in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule665 #-} rule665 = \ (_ :: ()) -> empty {-# INLINE rule666 #-} rule666 = \ (_ :: ()) -> Set.empty {-# INLINE rule667 #-} rule667 = \ (_ :: ()) -> [] {-# INLINE rule668 #-} rule668 = \ (_ :: ()) -> [] {-# INLINE rule669 #-} rule669 = \ _copy -> _copy -- Visit ------------------------------------------------------- -- wrapper data Inh_Visit = Inh_Visit { allFromToStates_Inh_Visit :: (Map VisitIdentifier (Int,Int)), allInhmap_Inh_Visit :: (Map NontermIdent Attributes), allInitStates_Inh_Visit :: (Map NontermIdent Int), allSynmap_Inh_Visit :: (Map NontermIdent Attributes), allVisitKinds_Inh_Visit :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_Visit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), allintramap_Inh_Visit :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))), avisitdefs_Inh_Visit :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_Visit :: (Map VisitIdentifier (Set Identifier)), childTypes_Inh_Visit :: (Map Identifier Type), childintros_Inh_Visit :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), con_Inh_Visit :: (ConstructorIdent), inhmap_Inh_Visit :: (Attributes), mrules_Inh_Visit :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)), nextVisits_Inh_Visit :: (Map StateIdentifier StateCtx), nt_Inh_Visit :: (NontermIdent), options_Inh_Visit :: (Options), params_Inh_Visit :: ([Identifier]), prevVisits_Inh_Visit :: (Map StateIdentifier StateCtx), ruledefs_Inh_Visit :: (Map Identifier (Set String)), ruleuses_Inh_Visit :: (Map Identifier (Map String (Maybe NonLocalAttr))), synmap_Inh_Visit :: (Attributes), terminaldefs_Inh_Visit :: (Set String) } data Syn_Visit = Syn_Visit { allvisits_Syn_Visit :: ( VisitStateState ), childvisit_Syn_Visit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), errors_Syn_Visit :: (Seq Error), fromToStates_Syn_Visit :: (Map VisitIdentifier (Int,Int)), intramap_Syn_Visit :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))), lazyIntras_Syn_Visit :: (Set String), ruleKinds_Syn_Visit :: (Map Identifier (Set VisitKind)), ruleUsage_Syn_Visit :: (Map Identifier Int), sem_visit_Syn_Visit :: ( (StateIdentifier,Bool -> PP_Doc) ), t_visits_Syn_Visit :: (PP_Doc), usedArgs_Syn_Visit :: (Set String), visitKinds_Syn_Visit :: (Map VisitIdentifier VisitKind), visitdefs_Syn_Visit :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_Visit :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_Visit #-} wrap_Visit :: T_Visit -> Inh_Visit -> (Syn_Visit ) wrap_Visit (T_Visit act) (Inh_Visit _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) = Control.Monad.Identity.runIdentity ( do sem <- act let arg46 = T_Visit_vIn46 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs (T_Visit_vOut46 _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOusedArgs _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_Visit_s47 sem arg46) return (Syn_Visit _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOusedArgs _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# INLINE sem_Visit #-} sem_Visit :: Visit -> T_Visit sem_Visit ( Visit ident_ from_ to_ inh_ syn_ steps_ kind_ ) = sem_Visit_Visit ident_ from_ to_ inh_ syn_ ( sem_VisitSteps steps_ ) kind_ -- semantic domain newtype T_Visit = T_Visit { attach_T_Visit :: Identity (T_Visit_s47 ) } newtype T_Visit_s47 = C_Visit_s47 { inv_Visit_s47 :: (T_Visit_v46 ) } data T_Visit_s48 = C_Visit_s48 type T_Visit_v46 = (T_Visit_vIn46 ) -> (T_Visit_vOut46 ) data T_Visit_vIn46 = T_Visit_vIn46 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Attributes) (Map NontermIdent Int) (Map NontermIdent Attributes) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Map StateIdentifier (Map String (Maybe NonLocalAttr))) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map Identifier Type) (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) (ConstructorIdent) (Attributes) (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) (Map StateIdentifier StateCtx) (NontermIdent) (Options) ([Identifier]) (Map StateIdentifier StateCtx) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (Attributes) (Set String) data T_Visit_vOut46 = T_Visit_vOut46 ( VisitStateState ) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Seq Error) (Map VisitIdentifier (Int,Int)) (Map StateIdentifier (Map String (Maybe NonLocalAttr))) (Set String) (Map Identifier (Set VisitKind)) (Map Identifier Int) ( (StateIdentifier,Bool -> PP_Doc) ) (PP_Doc) (Set String) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_Visit_Visit #-} sem_Visit_Visit :: (VisitIdentifier) -> (StateIdentifier) -> (StateIdentifier) -> (Set Identifier) -> (Set Identifier) -> T_VisitSteps -> (VisitKind) -> T_Visit sem_Visit_Visit arg_ident_ arg_from_ arg_to_ arg_inh_ arg_syn_ arg_steps_ arg_kind_ = T_Visit (return st47) where {-# NOINLINE st47 #-} st47 = let v46 :: T_Visit_v46 v46 = \ (T_Visit_vIn46 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) -> ( let _stepsX53 = Control.Monad.Identity.runIdentity (attach_T_VisitSteps (arg_steps_)) (T_VisitSteps_vOut52 _stepsIdefs _stepsIerrors _stepsIindex _stepsIisLast _stepsIlazyIntras _stepsIruleKinds _stepsIruleUsage _stepsIsem_steps _stepsIsize _stepsIusedArgs _stepsIuses _stepsIvisitKinds) = inv_VisitSteps_s53 _stepsX53 (T_VisitSteps_vIn52 _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfmtMode _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOruledefs _stepsOruleuses) _lhsOallvisits :: VisitStateState _lhsOallvisits = rule670 arg_from_ arg_ident_ arg_to_ _nameT_visit = rule671 _lhsInt arg_ident_ _nameTIn_visit = rule672 _lhsInt arg_ident_ _nameTOut_visit = rule673 _lhsInt arg_ident_ _nameTNext_visit = rule674 _lhsInt arg_to_ _nextVisitInfo = rule675 _lhsInextVisits arg_to_ _typecon = rule676 _lhsIoptions arg_kind_ _t_params = rule677 _lhsIparams _lhsOt_visits :: PP_Doc _lhsOt_visits = rule678 _addbang1 _inhpart _lhsIoptions _nameTIn_visit _nameTNext_visit _nameTOut_visit _nameT_visit _nextVisitInfo _synpart _t_params _typecon _inhpart = rule679 _lhsIinhmap _ppTypeList arg_inh_ _synpart = rule680 _lhsIsynmap _ppTypeList arg_syn_ _ppTypeList = rule681 _addbang1 _lhsOsem_visit :: (StateIdentifier,Bool -> PP_Doc) _lhsOsem_visit = rule682 _addbang _inhpats _lhsIoptions _nameTIn_visit _stepsClosing _stepsInitial _stepsIsem_steps arg_from_ arg_ident_ _stepsInitial = rule683 arg_kind_ _stepsClosing = rule684 _addbang _nextStBuild _resultval arg_kind_ _vname = rule685 arg_ident_ _inhpats = rule686 _lhsIoptions arg_inh_ _inhargs = rule687 _lhsIoptions arg_inh_ _synargs = rule688 _lhsIoptions arg_syn_ _nextargsMp = rule689 _lhsIallintramap arg_to_ _nextargs = rule690 _nextargsMp _nextst = rule691 _lhsIoptions _nextargs _nextargsMp arg_to_ _resultval = rule692 _nameTOut_visit _nextStRef _synargs (_nextStBuild,_nextStRef) = rule693 _addbang _nextVisitInfo _nextst _stepsOkind = rule694 arg_kind_ _stepsOfmtMode = rule695 arg_kind_ _stepsOindex = rule696 () _prevVisitInfo = rule697 _lhsInextVisits arg_from_ _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule698 _invokecode arg_ident_ _invokecode = rule699 _addbang _inhargs _lhsInt _lhsIoptions _nameTIn_visit _nameTOut_visit _nextVisitInfo _prevVisitInfo arg_from_ arg_ident_ arg_kind_ arg_syn_ arg_to_ _thisintra = rule700 _defsAsMap _nextintra _uses _lhsOintramap :: Map StateIdentifier (Map String (Maybe NonLocalAttr)) _lhsOintramap = rule701 _thisintra arg_from_ _nextintra = rule702 _lhsIallintramap arg_to_ _uses = rule703 _lhsIoptions _stepsIuses arg_syn_ _inhVarNms = rule704 _lhsIoptions arg_inh_ _defs = rule705 _inhVarNms _lhsIterminaldefs _stepsIdefs _defsAsMap = rule706 _defs _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule707 arg_ident_ arg_syn_ _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule708 arg_ident_ arg_inh_ _lazyIntrasInh = rule709 _inhVarNms _stepsIdefs arg_kind_ _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule710 _lazyIntrasInh _stepsIlazyIntras _addbang = rule711 _lhsIoptions _addbang1 = rule712 _addbang arg_kind_ _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule713 arg_from_ arg_ident_ arg_to_ _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule714 arg_ident_ arg_kind_ _lhsOerrors :: Seq Error _lhsOerrors = rule715 _stepsIerrors _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule716 _stepsIruleKinds _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule717 _stepsIruleUsage _lhsOusedArgs :: Set String _lhsOusedArgs = rule718 _stepsIusedArgs _stepsOallFromToStates = rule719 _lhsIallFromToStates _stepsOallInitStates = rule720 _lhsIallInitStates _stepsOallVisitKinds = rule721 _lhsIallVisitKinds _stepsOallchildvisit = rule722 _lhsIallchildvisit _stepsOavisitdefs = rule723 _lhsIavisitdefs _stepsOavisituses = rule724 _lhsIavisituses _stepsOchildTypes = rule725 _lhsIchildTypes _stepsOchildintros = rule726 _lhsIchildintros _stepsOmrules = rule727 _lhsImrules _stepsOoptions = rule728 _lhsIoptions _stepsOruledefs = rule729 _lhsIruledefs _stepsOruleuses = rule730 _lhsIruleuses __result_ = T_Visit_vOut46 _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOusedArgs _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_Visit_s47 v46 {-# INLINE rule670 #-} {-# LINE 382 "src-ag/ExecutionPlan2Clean.ag" #-} rule670 = \ from_ ident_ to_ -> {-# LINE 382 "src-ag/ExecutionPlan2Clean.ag" #-} (ident_, from_, to_) {-# LINE 5316 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule671 #-} {-# LINE 453 "src-ag/ExecutionPlan2Clean.ag" #-} rule671 = \ ((_lhsInt) :: NontermIdent) ident_ -> {-# LINE 453 "src-ag/ExecutionPlan2Clean.ag" #-} conNmTVisit _lhsInt ident_ {-# LINE 5322 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule672 #-} {-# LINE 454 "src-ag/ExecutionPlan2Clean.ag" #-} rule672 = \ ((_lhsInt) :: NontermIdent) ident_ -> {-# LINE 454 "src-ag/ExecutionPlan2Clean.ag" #-} conNmTVisitIn _lhsInt ident_ {-# LINE 5328 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule673 #-} {-# LINE 455 "src-ag/ExecutionPlan2Clean.ag" #-} rule673 = \ ((_lhsInt) :: NontermIdent) ident_ -> {-# LINE 455 "src-ag/ExecutionPlan2Clean.ag" #-} conNmTVisitOut _lhsInt ident_ {-# LINE 5334 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule674 #-} {-# LINE 456 "src-ag/ExecutionPlan2Clean.ag" #-} rule674 = \ ((_lhsInt) :: NontermIdent) to_ -> {-# LINE 456 "src-ag/ExecutionPlan2Clean.ag" #-} conNmTNextVisit _lhsInt to_ {-# LINE 5340 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule675 #-} {-# LINE 458 "src-ag/ExecutionPlan2Clean.ag" #-} rule675 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) to_ -> {-# LINE 458 "src-ag/ExecutionPlan2Clean.ag" #-} Map.findWithDefault ManyVis to_ _lhsInextVisits {-# LINE 5346 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule676 #-} {-# LINE 459 "src-ag/ExecutionPlan2Clean.ag" #-} rule676 = \ ((_lhsIoptions) :: Options) kind_ -> {-# LINE 459 "src-ag/ExecutionPlan2Clean.ag" #-} case kind_ of VisitPure _ -> empty VisitMonadic -> ppMonadType _lhsIoptions {-# LINE 5354 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule677 #-} {-# LINE 463 "src-ag/ExecutionPlan2Clean.ag" #-} rule677 = \ ((_lhsIparams) :: [Identifier]) -> {-# LINE 463 "src-ag/ExecutionPlan2Clean.ag" #-} ppSpaced _lhsIparams {-# LINE 5360 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule678 #-} {-# LINE 464 "src-ag/ExecutionPlan2Clean.ag" #-} rule678 = \ _addbang1 _inhpart ((_lhsIoptions) :: Options) _nameTIn_visit _nameTNext_visit _nameTOut_visit _nameT_visit _nextVisitInfo _synpart _t_params _typecon -> {-# LINE 464 "src-ag/ExecutionPlan2Clean.ag" #-} "::" >#< _nameT_visit >#< _t_params >#< ":==" >#< pp_parens (_nameTIn_visit >#< _t_params ) >#< ( if dummyTokenVisit _lhsIoptions then "->" >#< dummyType _lhsIoptions True else empty ) >#< "->" >#< _typecon >#< pp_parens (_nameTOut_visit >#< _t_params ) >-< "::" >#< _nameTIn_visit >#< _t_params >#< "=" >#< _nameTIn_visit >#< _inhpart >-< "::" >#< _nameTOut_visit >#< _t_params >#< "=" >#< _nameTOut_visit >#< _synpart >#< case _nextVisitInfo of NoneVis -> empty _ -> _addbang1 $ pp_parens (_nameTNext_visit >#< _t_params ) {-# LINE 5378 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule679 #-} {-# LINE 478 "src-ag/ExecutionPlan2Clean.ag" #-} rule679 = \ ((_lhsIinhmap) :: Attributes) _ppTypeList inh_ -> {-# LINE 478 "src-ag/ExecutionPlan2Clean.ag" #-} _ppTypeList inh_ _lhsIinhmap {-# LINE 5384 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule680 #-} {-# LINE 479 "src-ag/ExecutionPlan2Clean.ag" #-} rule680 = \ ((_lhsIsynmap) :: Attributes) _ppTypeList syn_ -> {-# LINE 479 "src-ag/ExecutionPlan2Clean.ag" #-} _ppTypeList syn_ _lhsIsynmap {-# LINE 5390 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule681 #-} {-# LINE 480 "src-ag/ExecutionPlan2Clean.ag" #-} rule681 = \ _addbang1 -> {-# LINE 480 "src-ag/ExecutionPlan2Clean.ag" #-} \s m -> ppSpaced $ map (\i -> _addbang1 $ pp_parens $ case Map.lookup i m of Just tp -> ppTp tp ) $ Set.toList s {-# LINE 5397 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule682 #-} {-# LINE 773 "src-ag/ExecutionPlan2Clean.ag" #-} rule682 = \ _addbang _inhpats ((_lhsIoptions) :: Options) _nameTIn_visit _stepsClosing _stepsInitial ((_stepsIsem_steps) :: PP_Doc) from_ ident_ -> {-# LINE 773 "src-ag/ExecutionPlan2Clean.ag" #-} ( from_ , \_ -> "v" >|< ident_ >#< (_addbang $ pp_parens (_nameTIn_visit >#< _inhpats )) >#< "=" >#< ( if dummyTokenVisit _lhsIoptions then pp $ dummyPat _lhsIoptions True else empty ) >-< indent 10 (_stepsInitial >-< indent 4 _stepsIsem_steps) >-< indent 10 _stepsClosing ) {-# LINE 5412 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule683 #-} {-# LINE 791 "src-ag/ExecutionPlan2Clean.ag" #-} rule683 = \ kind_ -> {-# LINE 791 "src-ag/ExecutionPlan2Clean.ag" #-} case kind_ of VisitPure False -> text "let" VisitPure True -> empty VisitMonadic -> text "do" {-# LINE 5421 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule684 #-} {-# LINE 795 "src-ag/ExecutionPlan2Clean.ag" #-} rule684 = \ _addbang _nextStBuild _resultval kind_ -> {-# LINE 795 "src-ag/ExecutionPlan2Clean.ag" #-} let decls = _nextStBuild >-< _addbang (pp resultValName) >#< "=" >#< _resultval in case kind_ of VisitPure False -> indent 4 decls >-< "in" >#< resultValName VisitPure True -> "let" >#< decls >-< indent 1 ("in" >#< resultValName) VisitMonadic -> "let" >#< decls >-< "lift" >#< resultValName {-# LINE 5435 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule685 #-} {-# LINE 804 "src-ag/ExecutionPlan2Clean.ag" #-} rule685 = \ ident_ -> {-# LINE 804 "src-ag/ExecutionPlan2Clean.ag" #-} "v" >|< ident_ {-# LINE 5441 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule686 #-} {-# LINE 805 "src-ag/ExecutionPlan2Clean.ag" #-} rule686 = \ ((_lhsIoptions) :: Options) inh_ -> {-# LINE 805 "src-ag/ExecutionPlan2Clean.ag" #-} ppSpaced $ map (\arg -> pp $ attrname _lhsIoptions True _LHS arg) $ Set.toList inh_ {-# LINE 5447 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule687 #-} {-# LINE 806 "src-ag/ExecutionPlan2Clean.ag" #-} rule687 = \ ((_lhsIoptions) :: Options) inh_ -> {-# LINE 806 "src-ag/ExecutionPlan2Clean.ag" #-} \chn -> ppSpaced $ map (attrname _lhsIoptions False chn) $ Set.toList inh_ {-# LINE 5453 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule688 #-} {-# LINE 807 "src-ag/ExecutionPlan2Clean.ag" #-} rule688 = \ ((_lhsIoptions) :: Options) syn_ -> {-# LINE 807 "src-ag/ExecutionPlan2Clean.ag" #-} ppSpaced $ map (\arg -> attrname _lhsIoptions False _LHS arg) $ Set.toList syn_ {-# LINE 5459 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule689 #-} {-# LINE 808 "src-ag/ExecutionPlan2Clean.ag" #-} rule689 = \ ((_lhsIallintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) to_ -> {-# LINE 808 "src-ag/ExecutionPlan2Clean.ag" #-} maybe Map.empty id $ Map.lookup to_ _lhsIallintramap {-# LINE 5465 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule690 #-} {-# LINE 809 "src-ag/ExecutionPlan2Clean.ag" #-} rule690 = \ _nextargsMp -> {-# LINE 809 "src-ag/ExecutionPlan2Clean.ag" #-} ppSpaced $ Map.keys $ _nextargsMp {-# LINE 5471 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule691 #-} {-# LINE 810 "src-ag/ExecutionPlan2Clean.ag" #-} rule691 = \ ((_lhsIoptions) :: Options) _nextargs _nextargsMp to_ -> {-# LINE 810 "src-ag/ExecutionPlan2Clean.ag" #-} "st" >|< to_ >#< _nextargs >#< dummyArg _lhsIoptions (Map.null _nextargsMp ) {-# LINE 5477 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule692 #-} {-# LINE 811 "src-ag/ExecutionPlan2Clean.ag" #-} rule692 = \ _nameTOut_visit _nextStRef _synargs -> {-# LINE 811 "src-ag/ExecutionPlan2Clean.ag" #-} _nameTOut_visit >#< _synargs >#< _nextStRef {-# LINE 5483 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule693 #-} {-# LINE 813 "src-ag/ExecutionPlan2Clean.ag" #-} rule693 = \ _addbang _nextVisitInfo _nextst -> {-# LINE 813 "src-ag/ExecutionPlan2Clean.ag" #-} case _nextVisitInfo of NoneVis -> (empty, empty) _ -> (_addbang (pp nextStName) >#< "=" >#< _nextst , pp nextStName) {-# LINE 5491 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule694 #-} {-# LINE 827 "src-ag/ExecutionPlan2Clean.ag" #-} rule694 = \ kind_ -> {-# LINE 827 "src-ag/ExecutionPlan2Clean.ag" #-} kind_ {-# LINE 5497 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule695 #-} {-# LINE 868 "src-ag/ExecutionPlan2Clean.ag" #-} rule695 = \ kind_ -> {-# LINE 868 "src-ag/ExecutionPlan2Clean.ag" #-} case kind_ of VisitPure False -> FormatLetDecl VisitPure True -> FormatLetLine VisitMonadic -> FormatDo {-# LINE 5506 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule696 #-} {-# LINE 917 "src-ag/ExecutionPlan2Clean.ag" #-} rule696 = \ (_ :: ()) -> {-# LINE 917 "src-ag/ExecutionPlan2Clean.ag" #-} 0 {-# LINE 5512 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule697 #-} {-# LINE 1227 "src-ag/ExecutionPlan2Clean.ag" #-} rule697 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) from_ -> {-# LINE 1227 "src-ag/ExecutionPlan2Clean.ag" #-} Map.findWithDefault ManyVis from_ _lhsInextVisits {-# LINE 5518 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule698 #-} {-# LINE 1228 "src-ag/ExecutionPlan2Clean.ag" #-} rule698 = \ _invokecode ident_ -> {-# LINE 1228 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton ident_ _invokecode {-# LINE 5524 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule699 #-} {-# LINE 1229 "src-ag/ExecutionPlan2Clean.ag" #-} rule699 = \ _addbang _inhargs ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) _nameTIn_visit _nameTOut_visit _nextVisitInfo _prevVisitInfo from_ ident_ kind_ syn_ to_ -> {-# LINE 1229 "src-ag/ExecutionPlan2Clean.ag" #-} \chn kind -> if kind `compatibleKind` kind_ then Right $ let pat | isLazyKind kind_ = pat0 | otherwise = _addbang pat0 pat0 = pp_parens pat1 pat1 = _nameTOut_visit >#< (ppSpaced $ map (attrname _lhsIoptions True chn) $ Set.toList syn_) >#< cont cont = case _nextVisitInfo of NoneVis -> empty _ -> ch1 ch0 = text $ stname chn from_ ch1 = text $ stname chn to_ expr = case (kind, kind_) of (VisitPure _, VisitPure _) -> expr0 (VisitPure _, VisitMonadic) -> unMon _lhsIoptions >#< expr0 (VisitMonadic, VisitPure _) -> "lift" >#< expr0 (VisitMonadic, VisitMonadic) -> expr0 expr0 = case _prevVisitInfo of NoneVis -> error "error: invocation of a visit from a state that has no next visits" OneVis _ -> "inv_" >|< _lhsInt >|< "_s" >|< from_ >#< ch0 >#< args ManyVis -> "inv_" >|< _lhsInt >|< "_s" >|< from_ >#< ch0 >#< "K_" >|< _lhsInt >|< "_v" >|< ident_ >#< args args = pp_parens args0 >#< args1 args0 = _nameTIn_visit >#< _inhargs chn args1 | dummyTokenVisit _lhsIoptions = pp $ dummyArg _lhsIoptions True | otherwise = empty in (pat, expr) else Left $ IncompatibleVisitKind chn ident_ kind kind_ {-# LINE 5558 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule700 #-} {-# LINE 1325 "src-ag/ExecutionPlan2Clean.ag" #-} rule700 = \ _defsAsMap _nextintra _uses -> {-# LINE 1325 "src-ag/ExecutionPlan2Clean.ag" #-} (_uses `Map.union` _nextintra ) `Map.difference` _defsAsMap {-# LINE 5564 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule701 #-} {-# LINE 1326 "src-ag/ExecutionPlan2Clean.ag" #-} rule701 = \ _thisintra from_ -> {-# LINE 1326 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton from_ _thisintra {-# LINE 5570 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule702 #-} {-# LINE 1327 "src-ag/ExecutionPlan2Clean.ag" #-} rule702 = \ ((_lhsIallintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) to_ -> {-# LINE 1327 "src-ag/ExecutionPlan2Clean.ag" #-} maybe Map.empty id $ Map.lookup to_ _lhsIallintramap {-# LINE 5576 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule703 #-} {-# LINE 1328 "src-ag/ExecutionPlan2Clean.ag" #-} rule703 = \ ((_lhsIoptions) :: Options) ((_stepsIuses) :: Map String (Maybe NonLocalAttr)) syn_ -> {-# LINE 1328 "src-ag/ExecutionPlan2Clean.ag" #-} let mp1 = _stepsIuses mp2 = Map.fromList [ (lhsname _lhsIoptions False i, Just (AttrSyn _LHS i)) | i <- Set.elems syn_ ] in mp1 `Map.union` mp2 {-# LINE 5584 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule704 #-} {-# LINE 1331 "src-ag/ExecutionPlan2Clean.ag" #-} rule704 = \ ((_lhsIoptions) :: Options) inh_ -> {-# LINE 1331 "src-ag/ExecutionPlan2Clean.ag" #-} Set.map (lhsname _lhsIoptions True) inh_ {-# LINE 5590 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule705 #-} {-# LINE 1332 "src-ag/ExecutionPlan2Clean.ag" #-} rule705 = \ _inhVarNms ((_lhsIterminaldefs) :: Set String) ((_stepsIdefs) :: Set String) -> {-# LINE 1332 "src-ag/ExecutionPlan2Clean.ag" #-} _stepsIdefs `Set.union` _inhVarNms `Set.union` _lhsIterminaldefs {-# LINE 5596 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule706 #-} {-# LINE 1333 "src-ag/ExecutionPlan2Clean.ag" #-} rule706 = \ _defs -> {-# LINE 1333 "src-ag/ExecutionPlan2Clean.ag" #-} Map.fromList [ (a, Nothing) | a <- Set.elems _defs ] {-# LINE 5602 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule707 #-} {-# LINE 1357 "src-ag/ExecutionPlan2Clean.ag" #-} rule707 = \ ident_ syn_ -> {-# LINE 1357 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton ident_ syn_ {-# LINE 5608 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule708 #-} {-# LINE 1358 "src-ag/ExecutionPlan2Clean.ag" #-} rule708 = \ ident_ inh_ -> {-# LINE 1358 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton ident_ inh_ {-# LINE 5614 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule709 #-} {-# LINE 1390 "src-ag/ExecutionPlan2Clean.ag" #-} rule709 = \ _inhVarNms ((_stepsIdefs) :: Set String) kind_ -> {-# LINE 1390 "src-ag/ExecutionPlan2Clean.ag" #-} case kind_ of VisitPure False -> _inhVarNms `Set.union` _stepsIdefs _ -> Set.empty {-# LINE 5622 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule710 #-} {-# LINE 1393 "src-ag/ExecutionPlan2Clean.ag" #-} rule710 = \ _lazyIntrasInh ((_stepsIlazyIntras) :: Set String) -> {-# LINE 1393 "src-ag/ExecutionPlan2Clean.ag" #-} _lazyIntrasInh `Set.union` _stepsIlazyIntras {-# LINE 5628 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule711 #-} {-# LINE 1565 "src-ag/ExecutionPlan2Clean.ag" #-} rule711 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1565 "src-ag/ExecutionPlan2Clean.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 5634 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule712 #-} {-# LINE 1573 "src-ag/ExecutionPlan2Clean.ag" #-} rule712 = \ _addbang kind_ -> {-# LINE 1573 "src-ag/ExecutionPlan2Clean.ag" #-} if isLazyKind kind_ then id else _addbang {-# LINE 5640 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule713 #-} {-# LINE 1600 "src-ag/ExecutionPlan2Clean.ag" #-} rule713 = \ from_ ident_ to_ -> {-# LINE 1600 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton ident_ (from_, to_) {-# LINE 5646 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule714 #-} {-# LINE 1644 "src-ag/ExecutionPlan2Clean.ag" #-} rule714 = \ ident_ kind_ -> {-# LINE 1644 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton ident_ kind_ {-# LINE 5652 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule715 #-} rule715 = \ ((_stepsIerrors) :: Seq Error) -> _stepsIerrors {-# INLINE rule716 #-} rule716 = \ ((_stepsIruleKinds) :: Map Identifier (Set VisitKind)) -> _stepsIruleKinds {-# INLINE rule717 #-} rule717 = \ ((_stepsIruleUsage) :: Map Identifier Int) -> _stepsIruleUsage {-# INLINE rule718 #-} rule718 = \ ((_stepsIusedArgs) :: Set String) -> _stepsIusedArgs {-# INLINE rule719 #-} rule719 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule720 #-} rule720 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule721 #-} rule721 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule722 #-} rule722 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule723 #-} rule723 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule724 #-} rule724 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule725 #-} rule725 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule726 #-} rule726 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule727 #-} rule727 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule728 #-} rule728 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule729 #-} rule729 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule730 #-} rule730 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses -- VisitStep --------------------------------------------------- -- wrapper data Inh_VisitStep = Inh_VisitStep { allFromToStates_Inh_VisitStep :: (Map VisitIdentifier (Int,Int)), allInitStates_Inh_VisitStep :: (Map NontermIdent Int), allVisitKinds_Inh_VisitStep :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_VisitStep :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), avisitdefs_Inh_VisitStep :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_VisitStep :: (Map VisitIdentifier (Set Identifier)), childTypes_Inh_VisitStep :: (Map Identifier Type), childintros_Inh_VisitStep :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), fmtMode_Inh_VisitStep :: (FormatMode), index_Inh_VisitStep :: (Int), isLast_Inh_VisitStep :: (Bool), kind_Inh_VisitStep :: (VisitKind), mrules_Inh_VisitStep :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)), options_Inh_VisitStep :: (Options), ruledefs_Inh_VisitStep :: (Map Identifier (Set String)), ruleuses_Inh_VisitStep :: (Map Identifier (Map String (Maybe NonLocalAttr))) } data Syn_VisitStep = Syn_VisitStep { defs_Syn_VisitStep :: (Set String), errors_Syn_VisitStep :: (Seq Error), index_Syn_VisitStep :: (Int), isLast_Syn_VisitStep :: (Bool), lazyIntras_Syn_VisitStep :: (Set String), ruleKinds_Syn_VisitStep :: (Map Identifier (Set VisitKind)), ruleUsage_Syn_VisitStep :: (Map Identifier Int), sem_steps_Syn_VisitStep :: (PP_Doc), usedArgs_Syn_VisitStep :: (Set String), uses_Syn_VisitStep :: (Map String (Maybe NonLocalAttr)), visitKinds_Syn_VisitStep :: (Map VisitIdentifier VisitKind) } {-# INLINABLE wrap_VisitStep #-} wrap_VisitStep :: T_VisitStep -> Inh_VisitStep -> (Syn_VisitStep ) wrap_VisitStep (T_VisitStep act) (Inh_VisitStep _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIruledefs _lhsIruleuses) = Control.Monad.Identity.runIdentity ( do sem <- act let arg49 = T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIruledefs _lhsIruleuses (T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds) <- return (inv_VisitStep_s50 sem arg49) return (Syn_VisitStep _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds) ) -- cata {-# NOINLINE sem_VisitStep #-} sem_VisitStep :: VisitStep -> T_VisitStep sem_VisitStep ( Sem name_ ) = sem_VisitStep_Sem name_ sem_VisitStep ( ChildVisit child_ nonterm_ visit_ ) = sem_VisitStep_ChildVisit child_ nonterm_ visit_ sem_VisitStep ( PureGroup steps_ ordered_ ) = sem_VisitStep_PureGroup ( sem_VisitSteps steps_ ) ordered_ sem_VisitStep ( Sim steps_ ) = sem_VisitStep_Sim ( sem_VisitSteps steps_ ) sem_VisitStep ( ChildIntro child_ ) = sem_VisitStep_ChildIntro child_ -- semantic domain newtype T_VisitStep = T_VisitStep { attach_T_VisitStep :: Identity (T_VisitStep_s50 ) } newtype T_VisitStep_s50 = C_VisitStep_s50 { inv_VisitStep_s50 :: (T_VisitStep_v49 ) } data T_VisitStep_s51 = C_VisitStep_s51 type T_VisitStep_v49 = (T_VisitStep_vIn49 ) -> (T_VisitStep_vOut49 ) data T_VisitStep_vIn49 = T_VisitStep_vIn49 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Int) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map Identifier Type) (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) (FormatMode) (Int) (Bool) (VisitKind) (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) (Options) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) data T_VisitStep_vOut49 = T_VisitStep_vOut49 (Set String) (Seq Error) (Int) (Bool) (Set String) (Map Identifier (Set VisitKind)) (Map Identifier Int) (PP_Doc) (Set String) (Map String (Maybe NonLocalAttr)) (Map VisitIdentifier VisitKind) {-# NOINLINE sem_VisitStep_Sem #-} sem_VisitStep_Sem :: (Identifier) -> T_VisitStep sem_VisitStep_Sem arg_name_ = T_VisitStep (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_VisitStep_v49 v49 = \ (T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIruledefs _lhsIruleuses) -> ( let _ruleItf = rule731 _lhsImrules arg_name_ _lhsOerrors :: Seq Error (_lhsOerrors,_sem_steps) = rule732 _lhsIfmtMode _lhsIkind _ruleItf _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule733 arg_name_ _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule734 _lhsIkind arg_name_ _lhsOdefs :: Set String _lhsOdefs = rule735 _lhsIruledefs arg_name_ _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule736 _lhsIruleuses arg_name_ _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule737 () _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule738 _sem_steps _lhsOusedArgs :: Set String _lhsOusedArgs = rule739 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule740 () _lhsOindex :: Int _lhsOindex = rule741 _lhsIindex _lhsOisLast :: Bool _lhsOisLast = rule742 _lhsIisLast __result_ = T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitStep_s50 v49 {-# INLINE rule731 #-} {-# LINE 836 "src-ag/ExecutionPlan2Clean.ag" #-} rule731 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) name_ -> {-# LINE 836 "src-ag/ExecutionPlan2Clean.ag" #-} Map.findWithDefault (error $ "Rule " ++ show name_ ++ " not found") name_ _lhsImrules {-# LINE 5774 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule732 #-} {-# LINE 837 "src-ag/ExecutionPlan2Clean.ag" #-} rule732 = \ ((_lhsIfmtMode) :: FormatMode) ((_lhsIkind) :: VisitKind) _ruleItf -> {-# LINE 837 "src-ag/ExecutionPlan2Clean.ag" #-} case _ruleItf _lhsIkind _lhsIfmtMode of Left e -> (Seq.singleton e, empty) Right stmt -> (Seq.empty, stmt) {-# LINE 5782 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule733 #-} {-# LINE 1278 "src-ag/ExecutionPlan2Clean.ag" #-} rule733 = \ name_ -> {-# LINE 1278 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton name_ 1 {-# LINE 5788 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule734 #-} {-# LINE 1288 "src-ag/ExecutionPlan2Clean.ag" #-} rule734 = \ ((_lhsIkind) :: VisitKind) name_ -> {-# LINE 1288 "src-ag/ExecutionPlan2Clean.ag" #-} Map.singleton name_ (Set.singleton _lhsIkind) {-# LINE 5794 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule735 #-} {-# LINE 1373 "src-ag/ExecutionPlan2Clean.ag" #-} rule735 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) name_ -> {-# LINE 1373 "src-ag/ExecutionPlan2Clean.ag" #-} maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruledefs {-# LINE 5800 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule736 #-} {-# LINE 1374 "src-ag/ExecutionPlan2Clean.ag" #-} rule736 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) name_ -> {-# LINE 1374 "src-ag/ExecutionPlan2Clean.ag" #-} maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruleuses {-# LINE 5806 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule737 #-} rule737 = \ (_ :: ()) -> Set.empty {-# INLINE rule738 #-} rule738 = \ _sem_steps -> _sem_steps {-# INLINE rule739 #-} rule739 = \ (_ :: ()) -> Set.empty {-# INLINE rule740 #-} rule740 = \ (_ :: ()) -> mempty {-# INLINE rule741 #-} rule741 = \ ((_lhsIindex) :: Int) -> _lhsIindex {-# INLINE rule742 #-} rule742 = \ ((_lhsIisLast) :: Bool) -> _lhsIisLast {-# NOINLINE sem_VisitStep_ChildVisit #-} sem_VisitStep_ChildVisit :: (Identifier) -> (NontermIdent) -> (VisitIdentifier) -> T_VisitStep sem_VisitStep_ChildVisit arg_child_ _ arg_visit_ = T_VisitStep (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_VisitStep_v49 v49 = \ (T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIruledefs _lhsIruleuses) -> ( let _visitItf = rule743 _lhsIallchildvisit arg_visit_ _lhsOerrors :: Seq Error (_lhsOerrors,_patPP,_exprPP) = rule744 _lhsIkind _visitItf arg_child_ _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule745 _exprPP _lhsIfmtMode _lhsIkind _patPP _convToMonad = rule746 _callKind _callKind = rule747 _lhsIallVisitKinds arg_visit_ _lhsOdefs :: Set String _lhsOdefs = rule748 _lhsIavisitdefs _lhsIoptions _to arg_child_ arg_visit_ _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule749 _from _lhsIavisituses _lhsIoptions arg_child_ arg_visit_ _addbang = rule750 _lhsIoptions (_from,_to) = rule751 _lhsIallFromToStates arg_visit_ _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule752 () _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule753 () _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule754 () _lhsOusedArgs :: Set String _lhsOusedArgs = rule755 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule756 () _lhsOindex :: Int _lhsOindex = rule757 _lhsIindex _lhsOisLast :: Bool _lhsOisLast = rule758 _lhsIisLast __result_ = T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitStep_s50 v49 {-# INLINE rule743 #-} {-# LINE 845 "src-ag/ExecutionPlan2Clean.ag" #-} rule743 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) visit_ -> {-# LINE 845 "src-ag/ExecutionPlan2Clean.ag" #-} Map.findWithDefault (error $ "Visit " ++ show visit_ ++ " not found") visit_ _lhsIallchildvisit {-# LINE 5867 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule744 #-} {-# LINE 846 "src-ag/ExecutionPlan2Clean.ag" #-} rule744 = \ ((_lhsIkind) :: VisitKind) _visitItf child_ -> {-# LINE 846 "src-ag/ExecutionPlan2Clean.ag" #-} case _visitItf child_ _lhsIkind of Left e -> (Seq.singleton e, empty, empty) Right (pat,expr) -> (Seq.empty, pat, expr) {-# LINE 5875 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule745 #-} {-# LINE 850 "src-ag/ExecutionPlan2Clean.ag" #-} rule745 = \ _exprPP ((_lhsIfmtMode) :: FormatMode) ((_lhsIkind) :: VisitKind) _patPP -> {-# LINE 850 "src-ag/ExecutionPlan2Clean.ag" #-} let decl = case _lhsIkind of VisitPure _ -> _patPP >#< "=" >#< _exprPP VisitMonadic -> _exprPP >#< ">>= \\" >#< _patPP >#< "->" in fmtDecl False _lhsIfmtMode decl {-# LINE 5884 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule746 #-} {-# LINE 854 "src-ag/ExecutionPlan2Clean.ag" #-} rule746 = \ _callKind -> {-# LINE 854 "src-ag/ExecutionPlan2Clean.ag" #-} case _callKind of VisitPure _ -> text "lift" VisitMonadic -> empty {-# LINE 5892 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule747 #-} {-# LINE 857 "src-ag/ExecutionPlan2Clean.ag" #-} rule747 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) visit_ -> {-# LINE 857 "src-ag/ExecutionPlan2Clean.ag" #-} Map.findWithDefault (error "visit kind should be in the map") visit_ _lhsIallVisitKinds {-# LINE 5898 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule748 #-} {-# LINE 1375 "src-ag/ExecutionPlan2Clean.ag" #-} rule748 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) ((_lhsIoptions) :: Options) _to child_ visit_ -> {-# LINE 1375 "src-ag/ExecutionPlan2Clean.ag" #-} Set.insert (stname child_ _to) $ maybe (error "Visit not found") (Set.map $ attrname _lhsIoptions True child_) $ Map.lookup visit_ _lhsIavisitdefs {-# LINE 5904 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule749 #-} {-# LINE 1376 "src-ag/ExecutionPlan2Clean.ag" #-} rule749 = \ _from ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) ((_lhsIoptions) :: Options) child_ visit_ -> {-# LINE 1376 "src-ag/ExecutionPlan2Clean.ag" #-} let convert attrs = Map.fromList [ (attrname _lhsIoptions False child_ attr, Just $ mkNonLocalAttr True child_ attr) | attr <- Set.elems attrs ] in Map.insert (stname child_ _from) Nothing $ convert $ maybe (error "Visit not found") id $ Map.lookup visit_ _lhsIavisituses {-# LINE 5912 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule750 #-} {-# LINE 1570 "src-ag/ExecutionPlan2Clean.ag" #-} rule750 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1570 "src-ag/ExecutionPlan2Clean.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 5918 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule751 #-} {-# LINE 1606 "src-ag/ExecutionPlan2Clean.ag" #-} rule751 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) visit_ -> {-# LINE 1606 "src-ag/ExecutionPlan2Clean.ag" #-} Map.findWithDefault (error "visit not in allFromToStates") visit_ _lhsIallFromToStates {-# LINE 5924 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule752 #-} rule752 = \ (_ :: ()) -> Set.empty {-# INLINE rule753 #-} rule753 = \ (_ :: ()) -> Map.empty {-# INLINE rule754 #-} rule754 = \ (_ :: ()) -> Map.empty {-# INLINE rule755 #-} rule755 = \ (_ :: ()) -> Set.empty {-# INLINE rule756 #-} rule756 = \ (_ :: ()) -> mempty {-# INLINE rule757 #-} rule757 = \ ((_lhsIindex) :: Int) -> _lhsIindex {-# INLINE rule758 #-} rule758 = \ ((_lhsIisLast) :: Bool) -> _lhsIisLast {-# NOINLINE sem_VisitStep_PureGroup #-} sem_VisitStep_PureGroup :: T_VisitSteps -> (Bool) -> T_VisitStep sem_VisitStep_PureGroup arg_steps_ arg_ordered_ = T_VisitStep (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_VisitStep_v49 v49 = \ (T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIruledefs _lhsIruleuses) -> ( let _stepsX53 = Control.Monad.Identity.runIdentity (attach_T_VisitSteps (arg_steps_)) (T_VisitSteps_vOut52 _stepsIdefs _stepsIerrors _stepsIindex _stepsIisLast _stepsIlazyIntras _stepsIruleKinds _stepsIruleUsage _stepsIsem_steps _stepsIsize _stepsIusedArgs _stepsIuses _stepsIvisitKinds) = inv_VisitSteps_s53 _stepsX53 (T_VisitSteps_vIn52 _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfmtMode _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOruledefs _stepsOruleuses) _stepsOkind = rule759 arg_ordered_ _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule760 _lhsIfmtMode _stepsIsem_steps _stepsOfmtMode = rule761 _lhsIfmtMode _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule762 _stepsIdefs _stepsIlazyIntras arg_ordered_ _lhsOdefs :: Set String _lhsOdefs = rule763 _stepsIdefs _lhsOerrors :: Seq Error _lhsOerrors = rule764 _stepsIerrors _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule765 _stepsIruleKinds _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule766 _stepsIruleUsage _lhsOusedArgs :: Set String _lhsOusedArgs = rule767 _stepsIusedArgs _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule768 _stepsIuses _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule769 _stepsIvisitKinds _lhsOindex :: Int _lhsOindex = rule770 _stepsIindex _lhsOisLast :: Bool _lhsOisLast = rule771 _stepsIisLast _stepsOallFromToStates = rule772 _lhsIallFromToStates _stepsOallInitStates = rule773 _lhsIallInitStates _stepsOallVisitKinds = rule774 _lhsIallVisitKinds _stepsOallchildvisit = rule775 _lhsIallchildvisit _stepsOavisitdefs = rule776 _lhsIavisitdefs _stepsOavisituses = rule777 _lhsIavisituses _stepsOchildTypes = rule778 _lhsIchildTypes _stepsOchildintros = rule779 _lhsIchildintros _stepsOindex = rule780 _lhsIindex _stepsOmrules = rule781 _lhsImrules _stepsOoptions = rule782 _lhsIoptions _stepsOruledefs = rule783 _lhsIruledefs _stepsOruleuses = rule784 _lhsIruleuses __result_ = T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitStep_s50 v49 {-# INLINE rule759 #-} {-# LINE 831 "src-ag/ExecutionPlan2Clean.ag" #-} rule759 = \ ordered_ -> {-# LINE 831 "src-ag/ExecutionPlan2Clean.ag" #-} VisitPure ordered_ {-# LINE 6000 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule760 #-} {-# LINE 859 "src-ag/ExecutionPlan2Clean.ag" #-} rule760 = \ ((_lhsIfmtMode) :: FormatMode) ((_stepsIsem_steps) :: PP_Doc) -> {-# LINE 859 "src-ag/ExecutionPlan2Clean.ag" #-} case _lhsIfmtMode of FormatDo -> "let" >#< _stepsIsem_steps _ -> _stepsIsem_steps {-# LINE 6008 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule761 #-} {-# LINE 874 "src-ag/ExecutionPlan2Clean.ag" #-} rule761 = \ ((_lhsIfmtMode) :: FormatMode) -> {-# LINE 874 "src-ag/ExecutionPlan2Clean.ag" #-} case _lhsIfmtMode of FormatDo -> FormatLetDecl mode -> mode {-# LINE 6016 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule762 #-} {-# LINE 1396 "src-ag/ExecutionPlan2Clean.ag" #-} rule762 = \ ((_stepsIdefs) :: Set String) ((_stepsIlazyIntras) :: Set String) ordered_ -> {-# LINE 1396 "src-ag/ExecutionPlan2Clean.ag" #-} if ordered_ then _stepsIlazyIntras else _stepsIdefs {-# LINE 6024 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule763 #-} rule763 = \ ((_stepsIdefs) :: Set String) -> _stepsIdefs {-# INLINE rule764 #-} rule764 = \ ((_stepsIerrors) :: Seq Error) -> _stepsIerrors {-# INLINE rule765 #-} rule765 = \ ((_stepsIruleKinds) :: Map Identifier (Set VisitKind)) -> _stepsIruleKinds {-# INLINE rule766 #-} rule766 = \ ((_stepsIruleUsage) :: Map Identifier Int) -> _stepsIruleUsage {-# INLINE rule767 #-} rule767 = \ ((_stepsIusedArgs) :: Set String) -> _stepsIusedArgs {-# INLINE rule768 #-} rule768 = \ ((_stepsIuses) :: Map String (Maybe NonLocalAttr)) -> _stepsIuses {-# INLINE rule769 #-} rule769 = \ ((_stepsIvisitKinds) :: Map VisitIdentifier VisitKind) -> _stepsIvisitKinds {-# INLINE rule770 #-} rule770 = \ ((_stepsIindex) :: Int) -> _stepsIindex {-# INLINE rule771 #-} rule771 = \ ((_stepsIisLast) :: Bool) -> _stepsIisLast {-# INLINE rule772 #-} rule772 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule773 #-} rule773 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule774 #-} rule774 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule775 #-} rule775 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule776 #-} rule776 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule777 #-} rule777 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule778 #-} rule778 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule779 #-} rule779 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule780 #-} rule780 = \ ((_lhsIindex) :: Int) -> _lhsIindex {-# INLINE rule781 #-} rule781 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule782 #-} rule782 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule783 #-} rule783 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule784 #-} rule784 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# NOINLINE sem_VisitStep_Sim #-} sem_VisitStep_Sim :: T_VisitSteps -> T_VisitStep sem_VisitStep_Sim arg_steps_ = T_VisitStep (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_VisitStep_v49 v49 = \ (T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIruledefs _lhsIruleuses) -> ( let _stepsX53 = Control.Monad.Identity.runIdentity (attach_T_VisitSteps (arg_steps_)) (T_VisitSteps_vOut52 _stepsIdefs _stepsIerrors _stepsIindex _stepsIisLast _stepsIlazyIntras _stepsIruleKinds _stepsIruleUsage _stepsIsem_steps _stepsIsize _stepsIusedArgs _stepsIuses _stepsIvisitKinds) = inv_VisitSteps_s53 _stepsX53 (T_VisitSteps_vIn52 _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfmtMode _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOruledefs _stepsOruleuses) _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule785 _stepsIsem_steps _stepsOindex = rule786 () _lhsOindex :: Int _lhsOindex = rule787 _lhsIindex _isMonadic = rule788 _lhsIkind _lhsOdefs :: Set String _lhsOdefs = rule789 _stepsIdefs _lhsOerrors :: Seq Error _lhsOerrors = rule790 _stepsIerrors _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule791 _stepsIlazyIntras _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule792 _stepsIruleKinds _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule793 _stepsIruleUsage _lhsOusedArgs :: Set String _lhsOusedArgs = rule794 _stepsIusedArgs _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule795 _stepsIuses _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule796 _stepsIvisitKinds _lhsOisLast :: Bool _lhsOisLast = rule797 _stepsIisLast _stepsOallFromToStates = rule798 _lhsIallFromToStates _stepsOallInitStates = rule799 _lhsIallInitStates _stepsOallVisitKinds = rule800 _lhsIallVisitKinds _stepsOallchildvisit = rule801 _lhsIallchildvisit _stepsOavisitdefs = rule802 _lhsIavisitdefs _stepsOavisituses = rule803 _lhsIavisituses _stepsOchildTypes = rule804 _lhsIchildTypes _stepsOchildintros = rule805 _lhsIchildintros _stepsOfmtMode = rule806 _lhsIfmtMode _stepsOkind = rule807 _lhsIkind _stepsOmrules = rule808 _lhsImrules _stepsOoptions = rule809 _lhsIoptions _stepsOruledefs = rule810 _lhsIruledefs _stepsOruleuses = rule811 _lhsIruleuses __result_ = T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitStep_s50 v49 {-# INLINE rule785 #-} {-# LINE 858 "src-ag/ExecutionPlan2Clean.ag" #-} rule785 = \ ((_stepsIsem_steps) :: PP_Doc) -> {-# LINE 858 "src-ag/ExecutionPlan2Clean.ag" #-} _stepsIsem_steps {-# LINE 6146 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule786 #-} {-# LINE 918 "src-ag/ExecutionPlan2Clean.ag" #-} rule786 = \ (_ :: ()) -> {-# LINE 918 "src-ag/ExecutionPlan2Clean.ag" #-} 0 {-# LINE 6152 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule787 #-} {-# LINE 919 "src-ag/ExecutionPlan2Clean.ag" #-} rule787 = \ ((_lhsIindex) :: Int) -> {-# LINE 919 "src-ag/ExecutionPlan2Clean.ag" #-} _lhsIindex {-# LINE 6158 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule788 #-} {-# LINE 930 "src-ag/ExecutionPlan2Clean.ag" #-} rule788 = \ ((_lhsIkind) :: VisitKind) -> {-# LINE 930 "src-ag/ExecutionPlan2Clean.ag" #-} case _lhsIkind of VisitMonadic -> True _ -> False {-# LINE 6166 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule789 #-} rule789 = \ ((_stepsIdefs) :: Set String) -> _stepsIdefs {-# INLINE rule790 #-} rule790 = \ ((_stepsIerrors) :: Seq Error) -> _stepsIerrors {-# INLINE rule791 #-} rule791 = \ ((_stepsIlazyIntras) :: Set String) -> _stepsIlazyIntras {-# INLINE rule792 #-} rule792 = \ ((_stepsIruleKinds) :: Map Identifier (Set VisitKind)) -> _stepsIruleKinds {-# INLINE rule793 #-} rule793 = \ ((_stepsIruleUsage) :: Map Identifier Int) -> _stepsIruleUsage {-# INLINE rule794 #-} rule794 = \ ((_stepsIusedArgs) :: Set String) -> _stepsIusedArgs {-# INLINE rule795 #-} rule795 = \ ((_stepsIuses) :: Map String (Maybe NonLocalAttr)) -> _stepsIuses {-# INLINE rule796 #-} rule796 = \ ((_stepsIvisitKinds) :: Map VisitIdentifier VisitKind) -> _stepsIvisitKinds {-# INLINE rule797 #-} rule797 = \ ((_stepsIisLast) :: Bool) -> _stepsIisLast {-# INLINE rule798 #-} rule798 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule799 #-} rule799 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule800 #-} rule800 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule801 #-} rule801 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule802 #-} rule802 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule803 #-} rule803 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule804 #-} rule804 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule805 #-} rule805 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule806 #-} rule806 = \ ((_lhsIfmtMode) :: FormatMode) -> _lhsIfmtMode {-# INLINE rule807 #-} rule807 = \ ((_lhsIkind) :: VisitKind) -> _lhsIkind {-# INLINE rule808 #-} rule808 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule809 #-} rule809 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule810 #-} rule810 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule811 #-} rule811 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# NOINLINE sem_VisitStep_ChildIntro #-} sem_VisitStep_ChildIntro :: (Identifier) -> T_VisitStep sem_VisitStep_ChildIntro arg_child_ = T_VisitStep (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_VisitStep_v49 v49 = \ (T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIruledefs _lhsIruleuses) -> ( let _attachItf = rule812 _lhsIchildintros arg_child_ _lhsOerrors :: Seq Error _lhsOsem_steps :: PP_Doc _lhsOdefs :: Set String _lhsOuses :: Map String (Maybe NonLocalAttr) (_lhsOerrors,_lhsOsem_steps,_lhsOdefs,_lhsOuses) = rule813 _attachItf _lhsIfmtMode _lhsIkind _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule814 () _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule815 () _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule816 () _lhsOusedArgs :: Set String _lhsOusedArgs = rule817 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule818 () _lhsOindex :: Int _lhsOindex = rule819 _lhsIindex _lhsOisLast :: Bool _lhsOisLast = rule820 _lhsIisLast __result_ = T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitStep_s50 v49 {-# INLINE rule812 #-} {-# LINE 840 "src-ag/ExecutionPlan2Clean.ag" #-} rule812 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) child_ -> {-# LINE 840 "src-ag/ExecutionPlan2Clean.ag" #-} Map.findWithDefault (error $ "Child " ++ show child_ ++ " not found") child_ _lhsIchildintros {-# LINE 6271 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule813 #-} {-# LINE 842 "src-ag/ExecutionPlan2Clean.ag" #-} rule813 = \ _attachItf ((_lhsIfmtMode) :: FormatMode) ((_lhsIkind) :: VisitKind) -> {-# LINE 842 "src-ag/ExecutionPlan2Clean.ag" #-} case _attachItf _lhsIkind _lhsIfmtMode of Left e -> (Seq.singleton e, empty, Set.empty, Map.empty) Right (code, defs, uses) -> (Seq.empty, code, defs, uses) {-# LINE 6279 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule814 #-} rule814 = \ (_ :: ()) -> Set.empty {-# INLINE rule815 #-} rule815 = \ (_ :: ()) -> Map.empty {-# INLINE rule816 #-} rule816 = \ (_ :: ()) -> Map.empty {-# INLINE rule817 #-} rule817 = \ (_ :: ()) -> Set.empty {-# INLINE rule818 #-} rule818 = \ (_ :: ()) -> mempty {-# INLINE rule819 #-} rule819 = \ ((_lhsIindex) :: Int) -> _lhsIindex {-# INLINE rule820 #-} rule820 = \ ((_lhsIisLast) :: Bool) -> _lhsIisLast -- VisitSteps -------------------------------------------------- -- wrapper data Inh_VisitSteps = Inh_VisitSteps { allFromToStates_Inh_VisitSteps :: (Map VisitIdentifier (Int,Int)), allInitStates_Inh_VisitSteps :: (Map NontermIdent Int), allVisitKinds_Inh_VisitSteps :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_VisitSteps :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), avisitdefs_Inh_VisitSteps :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_VisitSteps :: (Map VisitIdentifier (Set Identifier)), childTypes_Inh_VisitSteps :: (Map Identifier Type), childintros_Inh_VisitSteps :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), fmtMode_Inh_VisitSteps :: (FormatMode), index_Inh_VisitSteps :: (Int), kind_Inh_VisitSteps :: (VisitKind), mrules_Inh_VisitSteps :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)), options_Inh_VisitSteps :: (Options), ruledefs_Inh_VisitSteps :: (Map Identifier (Set String)), ruleuses_Inh_VisitSteps :: (Map Identifier (Map String (Maybe NonLocalAttr))) } data Syn_VisitSteps = Syn_VisitSteps { defs_Syn_VisitSteps :: (Set String), errors_Syn_VisitSteps :: (Seq Error), index_Syn_VisitSteps :: (Int), isLast_Syn_VisitSteps :: (Bool), lazyIntras_Syn_VisitSteps :: (Set String), ruleKinds_Syn_VisitSteps :: (Map Identifier (Set VisitKind)), ruleUsage_Syn_VisitSteps :: (Map Identifier Int), sem_steps_Syn_VisitSteps :: (PP_Doc), size_Syn_VisitSteps :: (Int), usedArgs_Syn_VisitSteps :: (Set String), uses_Syn_VisitSteps :: (Map String (Maybe NonLocalAttr)), visitKinds_Syn_VisitSteps :: (Map VisitIdentifier VisitKind) } {-# INLINABLE wrap_VisitSteps #-} wrap_VisitSteps :: T_VisitSteps -> Inh_VisitSteps -> (Syn_VisitSteps ) wrap_VisitSteps (T_VisitSteps act) (Inh_VisitSteps _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIruledefs _lhsIruleuses) = Control.Monad.Identity.runIdentity ( do sem <- act let arg52 = T_VisitSteps_vIn52 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIruledefs _lhsIruleuses (T_VisitSteps_vOut52 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsize _lhsOusedArgs _lhsOuses _lhsOvisitKinds) <- return (inv_VisitSteps_s53 sem arg52) return (Syn_VisitSteps _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsize _lhsOusedArgs _lhsOuses _lhsOvisitKinds) ) -- cata {-# NOINLINE sem_VisitSteps #-} sem_VisitSteps :: VisitSteps -> T_VisitSteps sem_VisitSteps list = Prelude.foldr sem_VisitSteps_Cons sem_VisitSteps_Nil (Prelude.map sem_VisitStep list) -- semantic domain newtype T_VisitSteps = T_VisitSteps { attach_T_VisitSteps :: Identity (T_VisitSteps_s53 ) } newtype T_VisitSteps_s53 = C_VisitSteps_s53 { inv_VisitSteps_s53 :: (T_VisitSteps_v52 ) } data T_VisitSteps_s54 = C_VisitSteps_s54 type T_VisitSteps_v52 = (T_VisitSteps_vIn52 ) -> (T_VisitSteps_vOut52 ) data T_VisitSteps_vIn52 = T_VisitSteps_vIn52 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Int) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map Identifier Type) (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) (FormatMode) (Int) (VisitKind) (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) (Options) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) data T_VisitSteps_vOut52 = T_VisitSteps_vOut52 (Set String) (Seq Error) (Int) (Bool) (Set String) (Map Identifier (Set VisitKind)) (Map Identifier Int) (PP_Doc) (Int) (Set String) (Map String (Maybe NonLocalAttr)) (Map VisitIdentifier VisitKind) {-# NOINLINE sem_VisitSteps_Cons #-} sem_VisitSteps_Cons :: T_VisitStep -> T_VisitSteps -> T_VisitSteps sem_VisitSteps_Cons arg_hd_ arg_tl_ = T_VisitSteps (return st53) where {-# NOINLINE st53 #-} st53 = let v52 :: T_VisitSteps_v52 v52 = \ (T_VisitSteps_vIn52 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIruledefs _lhsIruleuses) -> ( let _hdX50 = Control.Monad.Identity.runIdentity (attach_T_VisitStep (arg_hd_)) _tlX53 = Control.Monad.Identity.runIdentity (attach_T_VisitSteps (arg_tl_)) (T_VisitStep_vOut49 _hdIdefs _hdIerrors _hdIindex _hdIisLast _hdIlazyIntras _hdIruleKinds _hdIruleUsage _hdIsem_steps _hdIusedArgs _hdIuses _hdIvisitKinds) = inv_VisitStep_s50 _hdX50 (T_VisitStep_vIn49 _hdOallFromToStates _hdOallInitStates _hdOallVisitKinds _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOchildTypes _hdOchildintros _hdOfmtMode _hdOindex _hdOisLast _hdOkind _hdOmrules _hdOoptions _hdOruledefs _hdOruleuses) (T_VisitSteps_vOut52 _tlIdefs _tlIerrors _tlIindex _tlIisLast _tlIlazyIntras _tlIruleKinds _tlIruleUsage _tlIsem_steps _tlIsize _tlIusedArgs _tlIuses _tlIvisitKinds) = inv_VisitSteps_s53 _tlX53 (T_VisitSteps_vIn52 _tlOallFromToStates _tlOallInitStates _tlOallVisitKinds _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOchildTypes _tlOchildintros _tlOfmtMode _tlOindex _tlOkind _tlOmrules _tlOoptions _tlOruledefs _tlOruleuses) _lhsOsize :: Int _lhsOsize = rule821 _tlIsize _hdOindex = rule822 _lhsIindex _tlOindex = rule823 _lhsIindex _lhsOindex :: Int _lhsOindex = rule824 _tlIindex _lhsOisLast :: Bool _lhsOisLast = rule825 () _hdOisLast = rule826 _tlIisLast _lhsOdefs :: Set String _lhsOdefs = rule827 _hdIdefs _tlIdefs _lhsOerrors :: Seq Error _lhsOerrors = rule828 _hdIerrors _tlIerrors _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule829 _hdIlazyIntras _tlIlazyIntras _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule830 _hdIruleKinds _tlIruleKinds _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule831 _hdIruleUsage _tlIruleUsage _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule832 _hdIsem_steps _tlIsem_steps _lhsOusedArgs :: Set String _lhsOusedArgs = rule833 _hdIusedArgs _tlIusedArgs _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule834 _hdIuses _tlIuses _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule835 _hdIvisitKinds _tlIvisitKinds _hdOallFromToStates = rule836 _lhsIallFromToStates _hdOallInitStates = rule837 _lhsIallInitStates _hdOallVisitKinds = rule838 _lhsIallVisitKinds _hdOallchildvisit = rule839 _lhsIallchildvisit _hdOavisitdefs = rule840 _lhsIavisitdefs _hdOavisituses = rule841 _lhsIavisituses _hdOchildTypes = rule842 _lhsIchildTypes _hdOchildintros = rule843 _lhsIchildintros _hdOfmtMode = rule844 _lhsIfmtMode _hdOkind = rule845 _lhsIkind _hdOmrules = rule846 _lhsImrules _hdOoptions = rule847 _lhsIoptions _hdOruledefs = rule848 _lhsIruledefs _hdOruleuses = rule849 _lhsIruleuses _tlOallFromToStates = rule850 _lhsIallFromToStates _tlOallInitStates = rule851 _lhsIallInitStates _tlOallVisitKinds = rule852 _lhsIallVisitKinds _tlOallchildvisit = rule853 _lhsIallchildvisit _tlOavisitdefs = rule854 _lhsIavisitdefs _tlOavisituses = rule855 _lhsIavisituses _tlOchildTypes = rule856 _lhsIchildTypes _tlOchildintros = rule857 _lhsIchildintros _tlOfmtMode = rule858 _lhsIfmtMode _tlOkind = rule859 _lhsIkind _tlOmrules = rule860 _lhsImrules _tlOoptions = rule861 _lhsIoptions _tlOruledefs = rule862 _lhsIruledefs _tlOruleuses = rule863 _lhsIruleuses __result_ = T_VisitSteps_vOut52 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsize _lhsOusedArgs _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitSteps_s53 v52 {-# INLINE rule821 #-} {-# LINE 909 "src-ag/ExecutionPlan2Clean.ag" #-} rule821 = \ ((_tlIsize) :: Int) -> {-# LINE 909 "src-ag/ExecutionPlan2Clean.ag" #-} 1 + _tlIsize {-# LINE 6406 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule822 #-} {-# LINE 914 "src-ag/ExecutionPlan2Clean.ag" #-} rule822 = \ ((_lhsIindex) :: Int) -> {-# LINE 914 "src-ag/ExecutionPlan2Clean.ag" #-} _lhsIindex {-# LINE 6412 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule823 #-} {-# LINE 915 "src-ag/ExecutionPlan2Clean.ag" #-} rule823 = \ ((_lhsIindex) :: Int) -> {-# LINE 915 "src-ag/ExecutionPlan2Clean.ag" #-} 1 + _lhsIindex {-# LINE 6418 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule824 #-} {-# LINE 916 "src-ag/ExecutionPlan2Clean.ag" #-} rule824 = \ ((_tlIindex) :: Int) -> {-# LINE 916 "src-ag/ExecutionPlan2Clean.ag" #-} _tlIindex {-# LINE 6424 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule825 #-} {-# LINE 926 "src-ag/ExecutionPlan2Clean.ag" #-} rule825 = \ (_ :: ()) -> {-# LINE 926 "src-ag/ExecutionPlan2Clean.ag" #-} False {-# LINE 6430 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule826 #-} {-# LINE 927 "src-ag/ExecutionPlan2Clean.ag" #-} rule826 = \ ((_tlIisLast) :: Bool) -> {-# LINE 927 "src-ag/ExecutionPlan2Clean.ag" #-} _tlIisLast {-# LINE 6436 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule827 #-} rule827 = \ ((_hdIdefs) :: Set String) ((_tlIdefs) :: Set String) -> _hdIdefs `Set.union` _tlIdefs {-# INLINE rule828 #-} rule828 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule829 #-} rule829 = \ ((_hdIlazyIntras) :: Set String) ((_tlIlazyIntras) :: Set String) -> _hdIlazyIntras `Set.union` _tlIlazyIntras {-# INLINE rule830 #-} rule830 = \ ((_hdIruleKinds) :: Map Identifier (Set VisitKind)) ((_tlIruleKinds) :: Map Identifier (Set VisitKind)) -> _hdIruleKinds `unionWithMappend` _tlIruleKinds {-# INLINE rule831 #-} rule831 = \ ((_hdIruleUsage) :: Map Identifier Int) ((_tlIruleUsage) :: Map Identifier Int) -> _hdIruleUsage `unionWithSum` _tlIruleUsage {-# INLINE rule832 #-} rule832 = \ ((_hdIsem_steps) :: PP_Doc) ((_tlIsem_steps) :: PP_Doc) -> _hdIsem_steps >-< _tlIsem_steps {-# INLINE rule833 #-} rule833 = \ ((_hdIusedArgs) :: Set String) ((_tlIusedArgs) :: Set String) -> _hdIusedArgs `Set.union` _tlIusedArgs {-# INLINE rule834 #-} rule834 = \ ((_hdIuses) :: Map String (Maybe NonLocalAttr)) ((_tlIuses) :: Map String (Maybe NonLocalAttr)) -> _hdIuses `Map.union` _tlIuses {-# INLINE rule835 #-} rule835 = \ ((_hdIvisitKinds) :: Map VisitIdentifier VisitKind) ((_tlIvisitKinds) :: Map VisitIdentifier VisitKind) -> _hdIvisitKinds `mappend` _tlIvisitKinds {-# INLINE rule836 #-} rule836 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule837 #-} rule837 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule838 #-} rule838 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule839 #-} rule839 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule840 #-} rule840 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule841 #-} rule841 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule842 #-} rule842 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule843 #-} rule843 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule844 #-} rule844 = \ ((_lhsIfmtMode) :: FormatMode) -> _lhsIfmtMode {-# INLINE rule845 #-} rule845 = \ ((_lhsIkind) :: VisitKind) -> _lhsIkind {-# INLINE rule846 #-} rule846 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule847 #-} rule847 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule848 #-} rule848 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule849 #-} rule849 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# INLINE rule850 #-} rule850 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule851 #-} rule851 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule852 #-} rule852 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule853 #-} rule853 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule854 #-} rule854 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule855 #-} rule855 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule856 #-} rule856 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule857 #-} rule857 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule858 #-} rule858 = \ ((_lhsIfmtMode) :: FormatMode) -> _lhsIfmtMode {-# INLINE rule859 #-} rule859 = \ ((_lhsIkind) :: VisitKind) -> _lhsIkind {-# INLINE rule860 #-} rule860 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule861 #-} rule861 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule862 #-} rule862 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule863 #-} rule863 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# NOINLINE sem_VisitSteps_Nil #-} sem_VisitSteps_Nil :: T_VisitSteps sem_VisitSteps_Nil = T_VisitSteps (return st53) where {-# NOINLINE st53 #-} st53 = let v52 :: T_VisitSteps_v52 v52 = \ (T_VisitSteps_vIn52 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIruledefs _lhsIruleuses) -> ( let _lhsOsize :: Int _lhsOsize = rule864 () _lhsOisLast :: Bool _lhsOisLast = rule865 () _lhsOdefs :: Set String _lhsOdefs = rule866 () _lhsOerrors :: Seq Error _lhsOerrors = rule867 () _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule868 () _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule869 () _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule870 () _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule871 () _lhsOusedArgs :: Set String _lhsOusedArgs = rule872 () _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule873 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule874 () _lhsOindex :: Int _lhsOindex = rule875 _lhsIindex __result_ = T_VisitSteps_vOut52 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsize _lhsOusedArgs _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitSteps_s53 v52 {-# INLINE rule864 #-} {-# LINE 908 "src-ag/ExecutionPlan2Clean.ag" #-} rule864 = \ (_ :: ()) -> {-# LINE 908 "src-ag/ExecutionPlan2Clean.ag" #-} 0 {-# LINE 6587 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule865 #-} {-# LINE 925 "src-ag/ExecutionPlan2Clean.ag" #-} rule865 = \ (_ :: ()) -> {-# LINE 925 "src-ag/ExecutionPlan2Clean.ag" #-} True {-# LINE 6593 "dist/build/ExecutionPlan2Clean.hs"#-} {-# INLINE rule866 #-} rule866 = \ (_ :: ()) -> Set.empty {-# INLINE rule867 #-} rule867 = \ (_ :: ()) -> Seq.empty {-# INLINE rule868 #-} rule868 = \ (_ :: ()) -> Set.empty {-# INLINE rule869 #-} rule869 = \ (_ :: ()) -> Map.empty {-# INLINE rule870 #-} rule870 = \ (_ :: ()) -> Map.empty {-# INLINE rule871 #-} rule871 = \ (_ :: ()) -> empty {-# INLINE rule872 #-} rule872 = \ (_ :: ()) -> Set.empty {-# INLINE rule873 #-} rule873 = \ (_ :: ()) -> Map.empty {-# INLINE rule874 #-} rule874 = \ (_ :: ()) -> mempty {-# INLINE rule875 #-} rule875 = \ ((_lhsIindex) :: Int) -> _lhsIindex -- Visits ------------------------------------------------------ -- wrapper data Inh_Visits = Inh_Visits { allFromToStates_Inh_Visits :: (Map VisitIdentifier (Int,Int)), allInhmap_Inh_Visits :: (Map NontermIdent Attributes), allInitStates_Inh_Visits :: (Map NontermIdent Int), allSynmap_Inh_Visits :: (Map NontermIdent Attributes), allVisitKinds_Inh_Visits :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_Visits :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), allintramap_Inh_Visits :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))), avisitdefs_Inh_Visits :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_Visits :: (Map VisitIdentifier (Set Identifier)), childTypes_Inh_Visits :: (Map Identifier Type), childintros_Inh_Visits :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), con_Inh_Visits :: (ConstructorIdent), inhmap_Inh_Visits :: (Attributes), mrules_Inh_Visits :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)), nextVisits_Inh_Visits :: (Map StateIdentifier StateCtx), nt_Inh_Visits :: (NontermIdent), options_Inh_Visits :: (Options), params_Inh_Visits :: ([Identifier]), prevVisits_Inh_Visits :: (Map StateIdentifier StateCtx), ruledefs_Inh_Visits :: (Map Identifier (Set String)), ruleuses_Inh_Visits :: (Map Identifier (Map String (Maybe NonLocalAttr))), synmap_Inh_Visits :: (Attributes), terminaldefs_Inh_Visits :: (Set String) } data Syn_Visits = Syn_Visits { allvisits_Syn_Visits :: ([VisitStateState]), childvisit_Syn_Visits :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), errors_Syn_Visits :: (Seq Error), fromToStates_Syn_Visits :: (Map VisitIdentifier (Int,Int)), intramap_Syn_Visits :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))), lazyIntras_Syn_Visits :: (Set String), ruleKinds_Syn_Visits :: (Map Identifier (Set VisitKind)), ruleUsage_Syn_Visits :: (Map Identifier Int), sem_visit_Syn_Visits :: ( [(StateIdentifier,Bool -> PP_Doc)] ), t_visits_Syn_Visits :: (PP_Doc), usedArgs_Syn_Visits :: (Set String), visitKinds_Syn_Visits :: (Map VisitIdentifier VisitKind), visitdefs_Syn_Visits :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_Visits :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_Visits #-} wrap_Visits :: T_Visits -> Inh_Visits -> (Syn_Visits ) wrap_Visits (T_Visits act) (Inh_Visits _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) = Control.Monad.Identity.runIdentity ( do sem <- act let arg55 = T_Visits_vIn55 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs (T_Visits_vOut55 _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOusedArgs _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_Visits_s56 sem arg55) return (Syn_Visits _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOusedArgs _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# NOINLINE sem_Visits #-} sem_Visits :: Visits -> T_Visits sem_Visits list = Prelude.foldr sem_Visits_Cons sem_Visits_Nil (Prelude.map sem_Visit list) -- semantic domain newtype T_Visits = T_Visits { attach_T_Visits :: Identity (T_Visits_s56 ) } newtype T_Visits_s56 = C_Visits_s56 { inv_Visits_s56 :: (T_Visits_v55 ) } data T_Visits_s57 = C_Visits_s57 type T_Visits_v55 = (T_Visits_vIn55 ) -> (T_Visits_vOut55 ) data T_Visits_vIn55 = T_Visits_vIn55 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Attributes) (Map NontermIdent Int) (Map NontermIdent Attributes) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Map StateIdentifier (Map String (Maybe NonLocalAttr))) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map Identifier Type) (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) (ConstructorIdent) (Attributes) (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) (Map StateIdentifier StateCtx) (NontermIdent) (Options) ([Identifier]) (Map StateIdentifier StateCtx) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (Attributes) (Set String) data T_Visits_vOut55 = T_Visits_vOut55 ([VisitStateState]) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Seq Error) (Map VisitIdentifier (Int,Int)) (Map StateIdentifier (Map String (Maybe NonLocalAttr))) (Set String) (Map Identifier (Set VisitKind)) (Map Identifier Int) ( [(StateIdentifier,Bool -> PP_Doc)] ) (PP_Doc) (Set String) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_Visits_Cons #-} sem_Visits_Cons :: T_Visit -> T_Visits -> T_Visits sem_Visits_Cons arg_hd_ arg_tl_ = T_Visits (return st56) where {-# NOINLINE st56 #-} st56 = let v55 :: T_Visits_v55 v55 = \ (T_Visits_vIn55 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) -> ( let _hdX47 = Control.Monad.Identity.runIdentity (attach_T_Visit (arg_hd_)) _tlX56 = Control.Monad.Identity.runIdentity (attach_T_Visits (arg_tl_)) (T_Visit_vOut46 _hdIallvisits _hdIchildvisit _hdIerrors _hdIfromToStates _hdIintramap _hdIlazyIntras _hdIruleKinds _hdIruleUsage _hdIsem_visit _hdIt_visits _hdIusedArgs _hdIvisitKinds _hdIvisitdefs _hdIvisituses) = inv_Visit_s47 _hdX47 (T_Visit_vIn46 _hdOallFromToStates _hdOallInhmap _hdOallInitStates _hdOallSynmap _hdOallVisitKinds _hdOallchildvisit _hdOallintramap _hdOavisitdefs _hdOavisituses _hdOchildTypes _hdOchildintros _hdOcon _hdOinhmap _hdOmrules _hdOnextVisits _hdOnt _hdOoptions _hdOparams _hdOprevVisits _hdOruledefs _hdOruleuses _hdOsynmap _hdOterminaldefs) (T_Visits_vOut55 _tlIallvisits _tlIchildvisit _tlIerrors _tlIfromToStates _tlIintramap _tlIlazyIntras _tlIruleKinds _tlIruleUsage _tlIsem_visit _tlIt_visits _tlIusedArgs _tlIvisitKinds _tlIvisitdefs _tlIvisituses) = inv_Visits_s56 _tlX56 (T_Visits_vIn55 _tlOallFromToStates _tlOallInhmap _tlOallInitStates _tlOallSynmap _tlOallVisitKinds _tlOallchildvisit _tlOallintramap _tlOavisitdefs _tlOavisituses _tlOchildTypes _tlOchildintros _tlOcon _tlOinhmap _tlOmrules _tlOnextVisits _tlOnt _tlOoptions _tlOparams _tlOprevVisits _tlOruledefs _tlOruleuses _tlOsynmap _tlOterminaldefs) _lhsOallvisits :: [VisitStateState] _lhsOallvisits = rule876 _hdIallvisits _tlIallvisits _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule877 _hdIchildvisit _tlIchildvisit _lhsOerrors :: Seq Error _lhsOerrors = rule878 _hdIerrors _tlIerrors _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule879 _hdIfromToStates _tlIfromToStates _lhsOintramap :: Map StateIdentifier (Map String (Maybe NonLocalAttr)) _lhsOintramap = rule880 _hdIintramap _tlIintramap _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule881 _hdIlazyIntras _tlIlazyIntras _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule882 _hdIruleKinds _tlIruleKinds _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule883 _hdIruleUsage _tlIruleUsage _lhsOsem_visit :: [(StateIdentifier,Bool -> PP_Doc)] _lhsOsem_visit = rule884 _hdIsem_visit _tlIsem_visit _lhsOt_visits :: PP_Doc _lhsOt_visits = rule885 _hdIt_visits _tlIt_visits _lhsOusedArgs :: Set String _lhsOusedArgs = rule886 _hdIusedArgs _tlIusedArgs _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule887 _hdIvisitKinds _tlIvisitKinds _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule888 _hdIvisitdefs _tlIvisitdefs _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule889 _hdIvisituses _tlIvisituses _hdOallFromToStates = rule890 _lhsIallFromToStates _hdOallInhmap = rule891 _lhsIallInhmap _hdOallInitStates = rule892 _lhsIallInitStates _hdOallSynmap = rule893 _lhsIallSynmap _hdOallVisitKinds = rule894 _lhsIallVisitKinds _hdOallchildvisit = rule895 _lhsIallchildvisit _hdOallintramap = rule896 _lhsIallintramap _hdOavisitdefs = rule897 _lhsIavisitdefs _hdOavisituses = rule898 _lhsIavisituses _hdOchildTypes = rule899 _lhsIchildTypes _hdOchildintros = rule900 _lhsIchildintros _hdOcon = rule901 _lhsIcon _hdOinhmap = rule902 _lhsIinhmap _hdOmrules = rule903 _lhsImrules _hdOnextVisits = rule904 _lhsInextVisits _hdOnt = rule905 _lhsInt _hdOoptions = rule906 _lhsIoptions _hdOparams = rule907 _lhsIparams _hdOprevVisits = rule908 _lhsIprevVisits _hdOruledefs = rule909 _lhsIruledefs _hdOruleuses = rule910 _lhsIruleuses _hdOsynmap = rule911 _lhsIsynmap _hdOterminaldefs = rule912 _lhsIterminaldefs _tlOallFromToStates = rule913 _lhsIallFromToStates _tlOallInhmap = rule914 _lhsIallInhmap _tlOallInitStates = rule915 _lhsIallInitStates _tlOallSynmap = rule916 _lhsIallSynmap _tlOallVisitKinds = rule917 _lhsIallVisitKinds _tlOallchildvisit = rule918 _lhsIallchildvisit _tlOallintramap = rule919 _lhsIallintramap _tlOavisitdefs = rule920 _lhsIavisitdefs _tlOavisituses = rule921 _lhsIavisituses _tlOchildTypes = rule922 _lhsIchildTypes _tlOchildintros = rule923 _lhsIchildintros _tlOcon = rule924 _lhsIcon _tlOinhmap = rule925 _lhsIinhmap _tlOmrules = rule926 _lhsImrules _tlOnextVisits = rule927 _lhsInextVisits _tlOnt = rule928 _lhsInt _tlOoptions = rule929 _lhsIoptions _tlOparams = rule930 _lhsIparams _tlOprevVisits = rule931 _lhsIprevVisits _tlOruledefs = rule932 _lhsIruledefs _tlOruleuses = rule933 _lhsIruleuses _tlOsynmap = rule934 _lhsIsynmap _tlOterminaldefs = rule935 _lhsIterminaldefs __result_ = T_Visits_vOut55 _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOusedArgs _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_Visits_s56 v55 {-# INLINE rule876 #-} rule876 = \ ((_hdIallvisits) :: VisitStateState ) ((_tlIallvisits) :: [VisitStateState]) -> _hdIallvisits : _tlIallvisits {-# INLINE rule877 #-} rule877 = \ ((_hdIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) ((_tlIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _hdIchildvisit `Map.union` _tlIchildvisit {-# INLINE rule878 #-} rule878 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule879 #-} rule879 = \ ((_hdIfromToStates) :: Map VisitIdentifier (Int,Int)) ((_tlIfromToStates) :: Map VisitIdentifier (Int,Int)) -> _hdIfromToStates `mappend` _tlIfromToStates {-# INLINE rule880 #-} rule880 = \ ((_hdIintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) ((_tlIintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> _hdIintramap `uwMapUnion` _tlIintramap {-# INLINE rule881 #-} rule881 = \ ((_hdIlazyIntras) :: Set String) ((_tlIlazyIntras) :: Set String) -> _hdIlazyIntras `Set.union` _tlIlazyIntras {-# INLINE rule882 #-} rule882 = \ ((_hdIruleKinds) :: Map Identifier (Set VisitKind)) ((_tlIruleKinds) :: Map Identifier (Set VisitKind)) -> _hdIruleKinds `unionWithMappend` _tlIruleKinds {-# INLINE rule883 #-} rule883 = \ ((_hdIruleUsage) :: Map Identifier Int) ((_tlIruleUsage) :: Map Identifier Int) -> _hdIruleUsage `unionWithSum` _tlIruleUsage {-# INLINE rule884 #-} rule884 = \ ((_hdIsem_visit) :: (StateIdentifier,Bool -> PP_Doc) ) ((_tlIsem_visit) :: [(StateIdentifier,Bool -> PP_Doc)] ) -> _hdIsem_visit : _tlIsem_visit {-# INLINE rule885 #-} rule885 = \ ((_hdIt_visits) :: PP_Doc) ((_tlIt_visits) :: PP_Doc) -> _hdIt_visits >-< _tlIt_visits {-# INLINE rule886 #-} rule886 = \ ((_hdIusedArgs) :: Set String) ((_tlIusedArgs) :: Set String) -> _hdIusedArgs `Set.union` _tlIusedArgs {-# INLINE rule887 #-} rule887 = \ ((_hdIvisitKinds) :: Map VisitIdentifier VisitKind) ((_tlIvisitKinds) :: Map VisitIdentifier VisitKind) -> _hdIvisitKinds `mappend` _tlIvisitKinds {-# INLINE rule888 #-} rule888 = \ ((_hdIvisitdefs) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisitdefs `uwSetUnion` _tlIvisitdefs {-# INLINE rule889 #-} rule889 = \ ((_hdIvisituses) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisituses) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisituses `uwSetUnion` _tlIvisituses {-# INLINE rule890 #-} rule890 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule891 #-} rule891 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule892 #-} rule892 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule893 #-} rule893 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule894 #-} rule894 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule895 #-} rule895 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule896 #-} rule896 = \ ((_lhsIallintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> _lhsIallintramap {-# INLINE rule897 #-} rule897 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule898 #-} rule898 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule899 #-} rule899 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule900 #-} rule900 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule901 #-} rule901 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule902 #-} rule902 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule903 #-} rule903 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule904 #-} rule904 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) -> _lhsInextVisits {-# INLINE rule905 #-} rule905 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule906 #-} rule906 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule907 #-} rule907 = \ ((_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule908 #-} rule908 = \ ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) -> _lhsIprevVisits {-# INLINE rule909 #-} rule909 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule910 #-} rule910 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# INLINE rule911 #-} rule911 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule912 #-} rule912 = \ ((_lhsIterminaldefs) :: Set String) -> _lhsIterminaldefs {-# INLINE rule913 #-} rule913 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule914 #-} rule914 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule915 #-} rule915 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule916 #-} rule916 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule917 #-} rule917 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule918 #-} rule918 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule919 #-} rule919 = \ ((_lhsIallintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> _lhsIallintramap {-# INLINE rule920 #-} rule920 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule921 #-} rule921 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule922 #-} rule922 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule923 #-} rule923 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule924 #-} rule924 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule925 #-} rule925 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule926 #-} rule926 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule927 #-} rule927 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) -> _lhsInextVisits {-# INLINE rule928 #-} rule928 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule929 #-} rule929 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule930 #-} rule930 = \ ((_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule931 #-} rule931 = \ ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) -> _lhsIprevVisits {-# INLINE rule932 #-} rule932 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule933 #-} rule933 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# INLINE rule934 #-} rule934 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule935 #-} rule935 = \ ((_lhsIterminaldefs) :: Set String) -> _lhsIterminaldefs {-# NOINLINE sem_Visits_Nil #-} sem_Visits_Nil :: T_Visits sem_Visits_Nil = T_Visits (return st56) where {-# NOINLINE st56 #-} st56 = let v55 :: T_Visits_v55 v55 = \ (T_Visits_vIn55 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) -> ( let _lhsOallvisits :: [VisitStateState] _lhsOallvisits = rule936 () _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule937 () _lhsOerrors :: Seq Error _lhsOerrors = rule938 () _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule939 () _lhsOintramap :: Map StateIdentifier (Map String (Maybe NonLocalAttr)) _lhsOintramap = rule940 () _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule941 () _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule942 () _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule943 () _lhsOsem_visit :: [(StateIdentifier,Bool -> PP_Doc)] _lhsOsem_visit = rule944 () _lhsOt_visits :: PP_Doc _lhsOt_visits = rule945 () _lhsOusedArgs :: Set String _lhsOusedArgs = rule946 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule947 () _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule948 () _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule949 () __result_ = T_Visits_vOut55 _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOusedArgs _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_Visits_s56 v55 {-# INLINE rule936 #-} rule936 = \ (_ :: ()) -> [] {-# INLINE rule937 #-} rule937 = \ (_ :: ()) -> Map.empty {-# INLINE rule938 #-} rule938 = \ (_ :: ()) -> Seq.empty {-# INLINE rule939 #-} rule939 = \ (_ :: ()) -> mempty {-# INLINE rule940 #-} rule940 = \ (_ :: ()) -> Map.empty {-# INLINE rule941 #-} rule941 = \ (_ :: ()) -> Set.empty {-# INLINE rule942 #-} rule942 = \ (_ :: ()) -> Map.empty {-# INLINE rule943 #-} rule943 = \ (_ :: ()) -> Map.empty {-# INLINE rule944 #-} rule944 = \ (_ :: ()) -> [] {-# INLINE rule945 #-} rule945 = \ (_ :: ()) -> empty {-# INLINE rule946 #-} rule946 = \ (_ :: ()) -> Set.empty {-# INLINE rule947 #-} rule947 = \ (_ :: ()) -> mempty {-# INLINE rule948 #-} rule948 = \ (_ :: ()) -> Map.empty {-# INLINE rule949 #-} rule949 = \ (_ :: ()) -> Map.empty uuagc-0.9.52.2/src-generated/Macro.hs0000644000000000000000000000304613433540502015363 0ustar0000000000000000 -- UUAGC 0.9.51 (src-ag/Macro.ag) module Macro where {-# LINE 4 "src-ag/Macro.ag" #-} import CommonTypes {-# LINE 9 "dist/build/Macro.hs" #-} -- Macro ------------------------------------------------------- {- alternatives: alternative Macro: child con : {ConstructorIdent} child children : MacroChildren alternative None: -} data Macro = Macro (ConstructorIdent) (MacroChildren) | None deriving ( Show) -- MacroChild -------------------------------------------------- {- alternatives: alternative RuleChild: child name : {Identifier} child macro : Macro alternative ChildChild: child name : {Identifier} child child : {Identifier} alternative ValueChild: child name : {Identifier} child value : {String} -} data MacroChild = RuleChild (Identifier) (Macro) | ChildChild (Identifier) (Identifier) | ValueChild (Identifier) (String) deriving ( Show) -- MacroChildren ----------------------------------------------- {- alternatives: alternative Cons: child hd : MacroChild child tl : MacroChildren alternative Nil: -} type MacroChildren = [MacroChild] -- MaybeMacro -------------------------------------------------- {- alternatives: alternative Just: child just : Macro alternative Nothing: -} type MaybeMacro = Maybe (Macro)uuagc-0.9.52.2/src-generated/ConcreteSyntax.hs0000644000000000000000000002210113433540502017264 0ustar0000000000000000 -- UUAGC 0.9.51 (src-ag/ConcreteSyntax.ag) module ConcreteSyntax where {-# LINE 2 "src-ag/ConcreteSyntax.ag" #-} import UU.Scanner.Position (Pos) import Patterns (Pattern) import Expression (Expression) import CommonTypes import Macro --marcos {-# LINE 13 "dist/build/ConcreteSyntax.hs" #-} -- AG ---------------------------------------------------------- {- alternatives: alternative AG: child elems : Elems -} data AG = AG (Elems) -- Alt --------------------------------------------------------- {- alternatives: alternative Alt: child pos : {Pos} child names : ConstructorSet child tyvars : {[Identifier]} child fields : Fields child macro : {MaybeMacro} -} data Alt = Alt (Pos) (ConstructorSet) (([Identifier])) (Fields) (MaybeMacro) -- Alts -------------------------------------------------------- {- alternatives: alternative Cons: child hd : Alt child tl : Alts alternative Nil: -} type Alts = [Alt] -- Attrs ------------------------------------------------------- {- alternatives: alternative Attrs: child pos : {Pos} child inh : {AttrNames} child chn : {AttrNames} child syn : {AttrNames} -} data Attrs = Attrs (Pos) (AttrNames) (AttrNames) (AttrNames) -- ConstructorSet ---------------------------------------------- {- alternatives: alternative CName: child name : {ConstructorIdent} alternative CUnion: child set1 : ConstructorSet child set2 : ConstructorSet alternative CDifference: child set1 : ConstructorSet child set2 : ConstructorSet alternative CAll: -} data ConstructorSet = CName (ConstructorIdent) | CUnion (ConstructorSet) (ConstructorSet) | CDifference (ConstructorSet) (ConstructorSet) | CAll -- Elem -------------------------------------------------------- {- alternatives: alternative Data: child pos : {Pos} child contype : {ConstructorType} child ctx : {ClassContext} child names : NontSet child params : {[Identifier]} child attrs : Attrs child alts : Alts child ext : {Bool} alternative Type: child pos : {Pos} child ctx : {ClassContext} child name : {NontermIdent} child params : {[Identifier]} child type : {ComplexType} alternative Attr: child pos : {Pos} child ctx : {ClassContext} child names : NontSet child quants : {[String]} child attrs : Attrs alternative Sem: child pos : {Pos} child ctx : {ClassContext} child names : NontSet child attrs : Attrs child quants : {[String]} child alts : SemAlts alternative Txt: child pos : {Pos} child kind : {BlockKind} child mbNt : {Maybe NontermIdent} child lines : {[String]} alternative Set: child pos : {Pos} child name : {NontermIdent} child merge : {Bool} child set : NontSet alternative Deriving: child pos : {Pos} child set : NontSet child classes : {[NontermIdent]} alternative Wrapper: child pos : {Pos} child set : NontSet alternative Nocatas: child pos : {Pos} child set : NontSet alternative Pragma: child pos : {Pos} child names : {[NontermIdent]} alternative Module: child pos : {Pos} child name : {String} child exports : {String} child imports : {String} -} data Elem = Data (Pos) (ConstructorType) (ClassContext) (NontSet) (([Identifier])) (Attrs) (Alts) (Bool) | Type (Pos) (ClassContext) (NontermIdent) (([Identifier])) (ComplexType) | Attr (Pos) (ClassContext) (NontSet) (([String])) (Attrs) | Sem (Pos) (ClassContext) (NontSet) (Attrs) (([String])) (SemAlts) | Txt (Pos) (BlockKind) ((Maybe NontermIdent)) (([String])) | Set (Pos) (NontermIdent) (Bool) (NontSet) | Deriving (Pos) (NontSet) (([NontermIdent])) | Wrapper (Pos) (NontSet) | Nocatas (Pos) (NontSet) | Pragma (Pos) (([NontermIdent])) | Module (Pos) (String) (String) (String) -- Elems ------------------------------------------------------- {- alternatives: alternative Cons: child hd : Elem child tl : Elems alternative Nil: -} type Elems = [Elem] -- Field ------------------------------------------------------- {- alternatives: alternative FChild: child name : {Identifier} child tp : {Type} alternative FCtx: child tps : {[Type]} -} data Field = FChild (Identifier) (Type) | FCtx (([Type])) -- Fields ------------------------------------------------------ {- alternatives: alternative Cons: child hd : Field child tl : Fields alternative Nil: -} type Fields = [Field] -- NontSet ----------------------------------------------------- {- alternatives: alternative NamedSet: child name : {NontermIdent} alternative All: alternative Union: child set1 : NontSet child set2 : NontSet alternative Intersect: child set1 : NontSet child set2 : NontSet alternative Difference: child set1 : NontSet child set2 : NontSet alternative Path: child from : {NontermIdent} child to : {NontermIdent} -} data NontSet = NamedSet (NontermIdent) | All | Union (NontSet) (NontSet) | Intersect (NontSet) (NontSet) | Difference (NontSet) (NontSet) | Path (NontermIdent) (NontermIdent) -- SemAlt ------------------------------------------------------ {- alternatives: alternative SemAlt: child pos : {Pos} child constructorSet : ConstructorSet child rules : SemDefs -} data SemAlt = SemAlt (Pos) (ConstructorSet) (SemDefs) -- SemAlts ----------------------------------------------------- {- alternatives: alternative Cons: child hd : SemAlt child tl : SemAlts alternative Nil: -} type SemAlts = [SemAlt] -- SemDef ------------------------------------------------------ {- alternatives: alternative Def: child pos : {Pos} child mbName : {Maybe Identifier} child pattern : {Pattern} child rhs : {Expression} child owrt : {Bool} child pure : {Bool} child eager : {Bool} alternative TypeDef: child pos : {Pos} child ident : {Identifier} child tp : {Type} alternative UniqueDef: child ident : {Identifier} child ref : {Identifier} alternative AugmentDef: child ident : {Identifier} child rhs : {Expression} alternative AroundDef: child ident : {Identifier} child rhs : {Expression} alternative MergeDef: child target : {Identifier} child nt : {Identifier} child sources : {[Identifier]} child rhs : {Expression} alternative SemPragma: child names : {[NontermIdent]} alternative AttrOrderBefore: child before : {[Occurrence]} child after : {[Occurrence]} -} data SemDef = Def (Pos) ((Maybe Identifier)) (Pattern) (Expression) (Bool) (Bool) (Bool) | TypeDef (Pos) (Identifier) (Type) | UniqueDef (Identifier) (Identifier) | AugmentDef (Identifier) (Expression) | AroundDef (Identifier) (Expression) | MergeDef (Identifier) (Identifier) (([Identifier])) (Expression) | SemPragma (([NontermIdent])) | AttrOrderBefore (([Occurrence])) (([Occurrence])) -- SemDefs ----------------------------------------------------- {- alternatives: alternative Cons: child hd : SemDef child tl : SemDefs alternative Nil: -} type SemDefs = [SemDef]uuagc-0.9.52.2/src-generated/PrintCleanCode.hs0000644000000000000000000062321313433540502017160 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} module PrintCleanCode where {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 12 "dist/build/PrintCleanCode.hs" #-} {-# LINE 2 "src-ag/Code.ag" #-} import Patterns import Data.Set(Set) import qualified Data.Set as Set import Data.Map(Map) import qualified Data.Map as Map {-# LINE 21 "dist/build/PrintCleanCode.hs" #-} {-# LINE 10 "src-ag/PrintCleanCode.ag" #-} import Data.Char (isAlphaNum) import Pretty import Code import Options import CommonTypes (attrname, _LOC, nullIdent) import Data.List(intersperse) import System.IO import System.Directory import System.FilePath import CommonTypes(BlockInfo, BlockKind(..)) {-# LINE 35 "dist/build/PrintCleanCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 146 "src-ag/Code.ag" #-} -- Unboxed tuples -- unbox Whether unboxed tuples are wanted or not -- inh The inherited attributes. -- If there are none, no unboxing can take place, -- because in that case the semantic function (a top-level identifier) would have an unboxed type. -- Of course we can't have an unboxed 1-tuple mkTupleExpr :: Bool -> Bool -> Exprs -> Expr mkTupleExpr unbox' noInh exprs | not unbox' || noInh || length exprs == 1 = TupleExpr exprs | otherwise = UnboxedTupleExpr exprs mkTupleType :: Bool -> Bool -> Types -> Type mkTupleType unbox' noInh tps | not unbox' || noInh || length tps == 1 = TupleType tps | otherwise = UnboxedTupleType tps mkTupleLhs :: Bool -> Bool -> [String] -> Lhs mkTupleLhs unbox' noInh comps | not unbox' || noInh || length comps == 1 = TupleLhs comps | otherwise = UnboxedTupleLhs comps {-# LINE 55 "dist/build/PrintCleanCode.hs" #-} {-# LINE 23 "src-ag/PrintCleanCode.ag" #-} type PP_Docs = [PP_Doc] {-# LINE 60 "dist/build/PrintCleanCode.hs" #-} {-# LINE 27 "src-ag/PrintCleanCode.ag" #-} ppMultiSeqH :: [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeqH = ppMultiSeq' (>#<) ppMultiSeqV :: [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeqV = ppMultiSeq' (>-<) ppMultiSeq' :: (PP_Doc -> PP_Doc -> PP_Doc) -> [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeq' next strictArgs expr = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs {-# LINE 73 "dist/build/PrintCleanCode.hs" #-} {-# LINE 322 "src-ag/PrintCleanCode.ag" #-} reallySimple :: String -> Bool reallySimple = and . map (\x -> isAlphaNum x || x=='_') ppTuple :: Bool -> [PP_Doc] -> PP_Doc ppTuple _ [x] = pp x ppTuple True pps = "(" >|< pp_block " " (replicate (length pps `max` 1) ')') ",(" pps ppTuple False pps = "(" >|< pp_block " " ")" "," pps ppUnboxedTuple :: Bool -> [PP_Doc] -> PP_Doc ppUnboxedTuple = ppTuple --ppUnboxedTuple True pps = "(# " >|< pp_block " " (concat $ replicate (length pps `max` 1) " #)") ",(# " pps --ppUnboxedTuple False pps = "(# " >|< pp_block " " " #)" "," pps {-# LINE 90 "dist/build/PrintCleanCode.hs" #-} {-# LINE 425 "src-ag/PrintCleanCode.ag" #-} locname' :: Identifier -> [Char] locname' n = "_loc_" ++ getName n {-# LINE 96 "dist/build/PrintCleanCode.hs" #-} {-# LINE 500 "src-ag/PrintCleanCode.ag" #-} renderDocs :: [PP_Doc] -> String renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) "" {-# LINE 102 "dist/build/PrintCleanCode.hs" #-} {-# LINE 548 "src-ag/PrintCleanCode.ag" #-} writeModule :: FilePath -> [PP_Doc] -> IO () writeModule path docs = do bExists <- doesFileExist path if bExists then do input <- readFile path seq (length input) (return ()) if input /= output then dumpIt else return () else dumpIt where output = renderDocs docs dumpIt = writeFile path output {-# LINE 119 "dist/build/PrintCleanCode.hs" #-} -- CaseAlt ----------------------------------------------------- -- wrapper data Inh_CaseAlt = Inh_CaseAlt { nested_Inh_CaseAlt :: !(Bool), options_Inh_CaseAlt :: !(Options), outputfile_Inh_CaseAlt :: !(String) } data Syn_CaseAlt = Syn_CaseAlt { pps_Syn_CaseAlt :: !(PP_Docs) } {-# INLINABLE wrap_CaseAlt #-} wrap_CaseAlt :: T_CaseAlt -> Inh_CaseAlt -> (Syn_CaseAlt ) wrap_CaseAlt !(T_CaseAlt act) !(Inh_CaseAlt _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg1 = T_CaseAlt_vIn1 _lhsInested _lhsIoptions _lhsIoutputfile !(T_CaseAlt_vOut1 _lhsOpps) <- return (inv_CaseAlt_s2 sem arg1) return (Syn_CaseAlt _lhsOpps) ) -- cata {-# NOINLINE sem_CaseAlt #-} sem_CaseAlt :: CaseAlt -> T_CaseAlt sem_CaseAlt ( CaseAlt left_ expr_ ) = sem_CaseAlt_CaseAlt ( sem_Lhs left_ ) ( sem_Expr expr_ ) -- semantic domain newtype T_CaseAlt = T_CaseAlt { attach_T_CaseAlt :: Identity (T_CaseAlt_s2 ) } newtype T_CaseAlt_s2 = C_CaseAlt_s2 { inv_CaseAlt_s2 :: (T_CaseAlt_v1 ) } data T_CaseAlt_s3 = C_CaseAlt_s3 type T_CaseAlt_v1 = (T_CaseAlt_vIn1 ) -> (T_CaseAlt_vOut1 ) data T_CaseAlt_vIn1 = T_CaseAlt_vIn1 (Bool) (Options) (String) data T_CaseAlt_vOut1 = T_CaseAlt_vOut1 (PP_Docs) {-# NOINLINE sem_CaseAlt_CaseAlt #-} sem_CaseAlt_CaseAlt :: T_Lhs -> T_Expr -> T_CaseAlt sem_CaseAlt_CaseAlt arg_left_ arg_expr_ = T_CaseAlt (return st2) where {-# NOINLINE st2 #-} !st2 = let v1 :: T_CaseAlt_v1 v1 = \ !(T_CaseAlt_vIn1 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) _lhsOpps :: PP_Docs _lhsOpps = rule0 _exprIpp _leftIpp _leftOisDeclOfLet = rule1 () _leftOnested = rule2 _lhsInested _leftOoptions = rule3 _lhsIoptions _leftOoutputfile = rule4 _lhsIoutputfile _exprOnested = rule5 _lhsInested _exprOoptions = rule6 _lhsIoptions _exprOoutputfile = rule7 _lhsIoutputfile !__result_ = T_CaseAlt_vOut1 _lhsOpps in __result_ ) in C_CaseAlt_s2 v1 {-# INLINE rule0 #-} {-# LINE 228 "src-ag/PrintCleanCode.ag" #-} rule0 = \ ((_exprIpp) :: PP_Doc) ((_leftIpp) :: PP_Doc) -> {-# LINE 228 "src-ag/PrintCleanCode.ag" #-} ["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"] {-# LINE 178 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule1 #-} {-# LINE 449 "src-ag/PrintCleanCode.ag" #-} rule1 = \ (_ :: ()) -> {-# LINE 449 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 184 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule2 #-} rule2 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule3 #-} rule3 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule4 #-} rule4 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule5 #-} rule5 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule6 #-} rule6 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule7 #-} rule7 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile -- CaseAlts ---------------------------------------------------- -- wrapper data Inh_CaseAlts = Inh_CaseAlts { nested_Inh_CaseAlts :: !(Bool), options_Inh_CaseAlts :: !(Options), outputfile_Inh_CaseAlts :: !(String) } data Syn_CaseAlts = Syn_CaseAlts { pps_Syn_CaseAlts :: !(PP_Docs) } {-# INLINABLE wrap_CaseAlts #-} wrap_CaseAlts :: T_CaseAlts -> Inh_CaseAlts -> (Syn_CaseAlts ) wrap_CaseAlts !(T_CaseAlts act) !(Inh_CaseAlts _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg4 = T_CaseAlts_vIn4 _lhsInested _lhsIoptions _lhsIoutputfile !(T_CaseAlts_vOut4 _lhsOpps) <- return (inv_CaseAlts_s5 sem arg4) return (Syn_CaseAlts _lhsOpps) ) -- cata {-# NOINLINE sem_CaseAlts #-} sem_CaseAlts :: CaseAlts -> T_CaseAlts sem_CaseAlts list = Prelude.foldr sem_CaseAlts_Cons sem_CaseAlts_Nil (Prelude.map sem_CaseAlt list) -- semantic domain newtype T_CaseAlts = T_CaseAlts { attach_T_CaseAlts :: Identity (T_CaseAlts_s5 ) } newtype T_CaseAlts_s5 = C_CaseAlts_s5 { inv_CaseAlts_s5 :: (T_CaseAlts_v4 ) } data T_CaseAlts_s6 = C_CaseAlts_s6 type T_CaseAlts_v4 = (T_CaseAlts_vIn4 ) -> (T_CaseAlts_vOut4 ) data T_CaseAlts_vIn4 = T_CaseAlts_vIn4 (Bool) (Options) (String) data T_CaseAlts_vOut4 = T_CaseAlts_vOut4 (PP_Docs) {-# NOINLINE sem_CaseAlts_Cons #-} sem_CaseAlts_Cons :: T_CaseAlt -> T_CaseAlts -> T_CaseAlts sem_CaseAlts_Cons arg_hd_ arg_tl_ = T_CaseAlts (return st5) where {-# NOINLINE st5 #-} !st5 = let v4 :: T_CaseAlts_v4 v4 = \ !(T_CaseAlts_vIn4 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _hdX2 = Control.Monad.Identity.runIdentity (attach_T_CaseAlt (arg_hd_)) _tlX5 = Control.Monad.Identity.runIdentity (attach_T_CaseAlts (arg_tl_)) (T_CaseAlt_vOut1 _hdIpps) = inv_CaseAlt_s2 _hdX2 (T_CaseAlt_vIn1 _hdOnested _hdOoptions _hdOoutputfile) (T_CaseAlts_vOut4 _tlIpps) = inv_CaseAlts_s5 _tlX5 (T_CaseAlts_vIn4 _tlOnested _tlOoptions _tlOoutputfile) _lhsOpps :: PP_Docs _lhsOpps = rule8 _hdIpps _tlIpps _hdOnested = rule9 _lhsInested _hdOoptions = rule10 _lhsIoptions _hdOoutputfile = rule11 _lhsIoutputfile _tlOnested = rule12 _lhsInested _tlOoptions = rule13 _lhsIoptions _tlOoutputfile = rule14 _lhsIoutputfile !__result_ = T_CaseAlts_vOut4 _lhsOpps in __result_ ) in C_CaseAlts_s5 v4 {-# INLINE rule8 #-} {-# LINE 72 "src-ag/PrintCleanCode.ag" #-} rule8 = \ ((_hdIpps) :: PP_Docs) ((_tlIpps) :: PP_Docs) -> {-# LINE 72 "src-ag/PrintCleanCode.ag" #-} _hdIpps ++ _tlIpps {-# LINE 261 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule9 #-} rule9 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule10 #-} rule10 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule11 #-} rule11 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule12 #-} rule12 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule13 #-} rule13 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule14 #-} rule14 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_CaseAlts_Nil #-} sem_CaseAlts_Nil :: T_CaseAlts sem_CaseAlts_Nil = T_CaseAlts (return st5) where {-# NOINLINE st5 #-} !st5 = let v4 :: T_CaseAlts_v4 v4 = \ !(T_CaseAlts_vIn4 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule15 () !__result_ = T_CaseAlts_vOut4 _lhsOpps in __result_ ) in C_CaseAlts_s5 v4 {-# INLINE rule15 #-} {-# LINE 73 "src-ag/PrintCleanCode.ag" #-} rule15 = \ (_ :: ()) -> {-# LINE 73 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 297 "dist/build/PrintCleanCode.hs"#-} -- Chunk ------------------------------------------------------- -- wrapper data Inh_Chunk = Inh_Chunk { importBlocks_Inh_Chunk :: !(PP_Doc), isDeclOfLet_Inh_Chunk :: !(Bool), mainFile_Inh_Chunk :: !(String), mainName_Inh_Chunk :: !(String), moduleHeader_Inh_Chunk :: !(String -> String -> String -> Bool -> String), nested_Inh_Chunk :: !(Bool), options_Inh_Chunk :: !(Options), optionsLine_Inh_Chunk :: !(String), pragmaBlocks_Inh_Chunk :: !(String), textBlockMap_Inh_Chunk :: !(Map BlockInfo PP_Doc), textBlocks_Inh_Chunk :: !(PP_Doc) } data Syn_Chunk = Syn_Chunk { appendCommon_Syn_Chunk :: !([[PP_Doc]]), appendMain_Syn_Chunk :: !([[PP_Doc]]), genSems_Syn_Chunk :: !(IO ()), imports_Syn_Chunk :: !([String]), pps_Syn_Chunk :: !(PP_Docs) } {-# INLINABLE wrap_Chunk #-} wrap_Chunk :: T_Chunk -> Inh_Chunk -> (Syn_Chunk ) wrap_Chunk !(T_Chunk act) !(Inh_Chunk _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg7 = T_Chunk_vIn7 _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks !(T_Chunk_vOut7 _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps) <- return (inv_Chunk_s8 sem arg7) return (Syn_Chunk _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps) ) -- cata {-# INLINE sem_Chunk #-} sem_Chunk :: Chunk -> T_Chunk sem_Chunk ( Chunk !name_ comment_ info_ dataDef_ cataFun_ semDom_ semWrapper_ semFunctions_ !semNames_ ) = sem_Chunk_Chunk name_ ( sem_Decl comment_ ) ( sem_Decls info_ ) ( sem_Decls dataDef_ ) ( sem_Decls cataFun_ ) ( sem_Decls semDom_ ) ( sem_Decls semWrapper_ ) ( sem_Decls semFunctions_ ) semNames_ -- semantic domain newtype T_Chunk = T_Chunk { attach_T_Chunk :: Identity (T_Chunk_s8 ) } newtype T_Chunk_s8 = C_Chunk_s8 { inv_Chunk_s8 :: (T_Chunk_v7 ) } data T_Chunk_s9 = C_Chunk_s9 type T_Chunk_v7 = (T_Chunk_vIn7 ) -> (T_Chunk_vOut7 ) data T_Chunk_vIn7 = T_Chunk_vIn7 (PP_Doc) (Bool) (String) (String) (String -> String -> String -> Bool -> String) (Bool) (Options) (String) (String) (Map BlockInfo PP_Doc) (PP_Doc) data T_Chunk_vOut7 = T_Chunk_vOut7 ([[PP_Doc]]) ([[PP_Doc]]) (IO ()) ([String]) (PP_Docs) {-# NOINLINE sem_Chunk_Chunk #-} sem_Chunk_Chunk :: (String) -> T_Decl -> T_Decls -> T_Decls -> T_Decls -> T_Decls -> T_Decls -> T_Decls -> ([String]) -> T_Chunk sem_Chunk_Chunk !arg_name_ arg_comment_ arg_info_ arg_dataDef_ arg_cataFun_ arg_semDom_ arg_semWrapper_ arg_semFunctions_ !arg_semNames_ = T_Chunk (return st8) where {-# NOINLINE st8 #-} !st8 = let v7 :: T_Chunk_v7 v7 = \ !(T_Chunk_vIn7 _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) -> ( let _commentX20 = Control.Monad.Identity.runIdentity (attach_T_Decl (arg_comment_)) _infoX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_info_)) _dataDefX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_dataDef_)) _cataFunX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_cataFun_)) _semDomX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_semDom_)) _semWrapperX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_semWrapper_)) _semFunctionsX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_semFunctions_)) (T_Decl_vOut19 _commentIpp _commentIppa) = inv_Decl_s20 _commentX20 (T_Decl_vIn19 _commentOisDeclOfLet _commentOnested _commentOoptions _commentOoutputfile) (T_Decls_vOut22 _infoIpps) = inv_Decls_s23 _infoX23 (T_Decls_vIn22 _infoOisDeclOfLet _infoOnested _infoOoptions _infoOoutputfile) (T_Decls_vOut22 _dataDefIpps) = inv_Decls_s23 _dataDefX23 (T_Decls_vIn22 _dataDefOisDeclOfLet _dataDefOnested _dataDefOoptions _dataDefOoutputfile) (T_Decls_vOut22 _cataFunIpps) = inv_Decls_s23 _cataFunX23 (T_Decls_vIn22 _cataFunOisDeclOfLet _cataFunOnested _cataFunOoptions _cataFunOoutputfile) (T_Decls_vOut22 _semDomIpps) = inv_Decls_s23 _semDomX23 (T_Decls_vIn22 _semDomOisDeclOfLet _semDomOnested _semDomOoptions _semDomOoutputfile) (T_Decls_vOut22 _semWrapperIpps) = inv_Decls_s23 _semWrapperX23 (T_Decls_vIn22 _semWrapperOisDeclOfLet _semWrapperOnested _semWrapperOoptions _semWrapperOoutputfile) (T_Decls_vOut22 _semFunctionsIpps) = inv_Decls_s23 _semFunctionsX23 (T_Decls_vIn22 _semFunctionsOisDeclOfLet _semFunctionsOnested _semFunctionsOoptions _semFunctionsOoutputfile) _outputfile = rule16 _lhsImainFile _lhsIoptions arg_name_ _lhsOpps :: PP_Docs _lhsOpps = rule17 _cataFunIpps _commentIpp _dataDefIpps _infoIpps _lhsItextBlockMap _semDomIpps _semFunctionsIpps _semWrapperIpps arg_name_ _lhsOimports :: [String] _lhsOimports = rule18 _lhsImainName arg_name_ _lhsOappendCommon :: [[PP_Doc]] _lhsOappendCommon = rule19 _commentIpp _dataDefIpps _lhsIoptions _semDomIpps _semWrapperIpps _lhsOappendMain :: [[PP_Doc]] _lhsOappendMain = rule20 _cataFunIpps _commentIpp _lhsIoptions _semWrapperIpps _lhsOgenSems :: IO () _lhsOgenSems = rule21 _commentIpp _exports _infoIpps _lhsImainName _lhsImoduleHeader _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _outputfile _semFunctionsIpps arg_name_ _exports = rule22 arg_semNames_ _commentOisDeclOfLet = rule23 _lhsIisDeclOfLet _commentOnested = rule24 _lhsInested _commentOoptions = rule25 _lhsIoptions _commentOoutputfile = rule26 _outputfile _infoOisDeclOfLet = rule27 _lhsIisDeclOfLet _infoOnested = rule28 _lhsInested _infoOoptions = rule29 _lhsIoptions _infoOoutputfile = rule30 _outputfile _dataDefOisDeclOfLet = rule31 _lhsIisDeclOfLet _dataDefOnested = rule32 _lhsInested _dataDefOoptions = rule33 _lhsIoptions _dataDefOoutputfile = rule34 _outputfile _cataFunOisDeclOfLet = rule35 _lhsIisDeclOfLet _cataFunOnested = rule36 _lhsInested _cataFunOoptions = rule37 _lhsIoptions _cataFunOoutputfile = rule38 _outputfile _semDomOisDeclOfLet = rule39 _lhsIisDeclOfLet _semDomOnested = rule40 _lhsInested _semDomOoptions = rule41 _lhsIoptions _semDomOoutputfile = rule42 _outputfile _semWrapperOisDeclOfLet = rule43 _lhsIisDeclOfLet _semWrapperOnested = rule44 _lhsInested _semWrapperOoptions = rule45 _lhsIoptions _semWrapperOoutputfile = rule46 _outputfile _semFunctionsOisDeclOfLet = rule47 _lhsIisDeclOfLet _semFunctionsOnested = rule48 _lhsInested _semFunctionsOoptions = rule49 _lhsIoptions _semFunctionsOoutputfile = rule50 _outputfile !__result_ = T_Chunk_vOut7 _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps in __result_ ) in C_Chunk_s8 v7 {-# INLINE rule16 #-} {-# LINE 43 "src-ag/PrintCleanCode.ag" #-} rule16 = \ ((_lhsImainFile) :: String) ((_lhsIoptions) :: Options) name_ -> {-# LINE 43 "src-ag/PrintCleanCode.ag" #-} if sepSemMods _lhsIoptions then replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ "_" ++ name_) else _lhsImainFile {-# LINE 400 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule17 #-} {-# LINE 104 "src-ag/PrintCleanCode.ag" #-} rule17 = \ ((_cataFunIpps) :: PP_Docs) ((_commentIpp) :: PP_Doc) ((_dataDefIpps) :: PP_Docs) ((_infoIpps) :: PP_Docs) ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) ((_semDomIpps) :: PP_Docs) ((_semFunctionsIpps) :: PP_Docs) ((_semWrapperIpps) :: PP_Docs) name_ -> {-# LINE 104 "src-ag/PrintCleanCode.ag" #-} _commentIpp : _infoIpps ++ _dataDefIpps ++ _cataFunIpps ++ _semDomIpps ++ _semWrapperIpps ++ _semFunctionsIpps ++ [Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap] {-# LINE 413 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule18 #-} {-# LINE 508 "src-ag/PrintCleanCode.ag" #-} rule18 = \ ((_lhsImainName) :: String) name_ -> {-# LINE 508 "src-ag/PrintCleanCode.ag" #-} ["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"] {-# LINE 419 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule19 #-} {-# LINE 515 "src-ag/PrintCleanCode.ag" #-} rule19 = \ ((_commentIpp) :: PP_Doc) ((_dataDefIpps) :: PP_Docs) ((_lhsIoptions) :: Options) ((_semDomIpps) :: PP_Docs) ((_semWrapperIpps) :: PP_Docs) -> {-# LINE 515 "src-ag/PrintCleanCode.ag" #-} [ [_commentIpp] , _dataDefIpps , _semDomIpps , if reference _lhsIoptions then _semWrapperIpps else [] ] {-# LINE 429 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule20 #-} {-# LINE 521 "src-ag/PrintCleanCode.ag" #-} rule20 = \ ((_cataFunIpps) :: PP_Docs) ((_commentIpp) :: PP_Doc) ((_lhsIoptions) :: Options) ((_semWrapperIpps) :: PP_Docs) -> {-# LINE 521 "src-ag/PrintCleanCode.ag" #-} [ [_commentIpp] , _cataFunIpps , if reference _lhsIoptions then [] else _semWrapperIpps ] {-# LINE 438 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule21 #-} {-# LINE 531 "src-ag/PrintCleanCode.ag" #-} rule21 = \ ((_commentIpp) :: PP_Doc) _exports ((_infoIpps) :: PP_Docs) ((_lhsImainName) :: String) ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIoptionsLine) :: String) ((_lhsIpragmaBlocks) :: String) ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) _outputfile ((_semFunctionsIpps) :: PP_Docs) name_ -> {-# LINE 531 "src-ag/PrintCleanCode.ag" #-} writeModule _outputfile [ pp $ _lhsIpragmaBlocks , pp $ Map.findWithDefault empty (BlockPragma, Just $ identifier name_) _lhsItextBlockMap , pp $ _lhsIoptionsLine , pp $ _lhsImoduleHeader _lhsImainName ("_" ++ name_) _exports True , pp $ ("import " ++ _lhsImainName ++ "_common\n") , pp $ Map.findWithDefault empty (BlockImport, Just $ identifier name_) _lhsItextBlockMap , _commentIpp , vlist_sep "" _infoIpps , vlist_sep "" _semFunctionsIpps , Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap ] {-# LINE 455 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule22 #-} {-# LINE 546 "src-ag/PrintCleanCode.ag" #-} rule22 = \ semNames_ -> {-# LINE 546 "src-ag/PrintCleanCode.ag" #-} concat $ intersperse "," semNames_ {-# LINE 461 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule23 #-} rule23 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule24 #-} rule24 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule25 #-} rule25 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule26 #-} rule26 = \ _outputfile -> _outputfile {-# INLINE rule27 #-} rule27 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule28 #-} rule28 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule29 #-} rule29 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule30 #-} rule30 = \ _outputfile -> _outputfile {-# INLINE rule31 #-} rule31 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule32 #-} rule32 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule33 #-} rule33 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule34 #-} rule34 = \ _outputfile -> _outputfile {-# INLINE rule35 #-} rule35 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule36 #-} rule36 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule37 #-} rule37 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule38 #-} rule38 = \ _outputfile -> _outputfile {-# INLINE rule39 #-} rule39 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule40 #-} rule40 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule41 #-} rule41 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule42 #-} rule42 = \ _outputfile -> _outputfile {-# INLINE rule43 #-} rule43 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule44 #-} rule44 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule45 #-} rule45 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule46 #-} rule46 = \ _outputfile -> _outputfile {-# INLINE rule47 #-} rule47 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule48 #-} rule48 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule49 #-} rule49 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule50 #-} rule50 = \ _outputfile -> _outputfile -- Chunks ------------------------------------------------------ -- wrapper data Inh_Chunks = Inh_Chunks { importBlocks_Inh_Chunks :: !(PP_Doc), isDeclOfLet_Inh_Chunks :: !(Bool), mainFile_Inh_Chunks :: !(String), mainName_Inh_Chunks :: !(String), moduleHeader_Inh_Chunks :: !(String -> String -> String -> Bool -> String), nested_Inh_Chunks :: !(Bool), options_Inh_Chunks :: !(Options), optionsLine_Inh_Chunks :: !(String), pragmaBlocks_Inh_Chunks :: !(String), textBlockMap_Inh_Chunks :: !(Map BlockInfo PP_Doc), textBlocks_Inh_Chunks :: !(PP_Doc) } data Syn_Chunks = Syn_Chunks { appendCommon_Syn_Chunks :: !([[PP_Doc]]), appendMain_Syn_Chunks :: !([[PP_Doc]]), genSems_Syn_Chunks :: !(IO ()), imports_Syn_Chunks :: !([String]), pps_Syn_Chunks :: !(PP_Docs) } {-# INLINABLE wrap_Chunks #-} wrap_Chunks :: T_Chunks -> Inh_Chunks -> (Syn_Chunks ) wrap_Chunks !(T_Chunks act) !(Inh_Chunks _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg10 = T_Chunks_vIn10 _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks !(T_Chunks_vOut10 _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps) <- return (inv_Chunks_s11 sem arg10) return (Syn_Chunks _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps) ) -- cata {-# NOINLINE sem_Chunks #-} sem_Chunks :: Chunks -> T_Chunks sem_Chunks list = Prelude.foldr sem_Chunks_Cons sem_Chunks_Nil (Prelude.map sem_Chunk list) -- semantic domain newtype T_Chunks = T_Chunks { attach_T_Chunks :: Identity (T_Chunks_s11 ) } newtype T_Chunks_s11 = C_Chunks_s11 { inv_Chunks_s11 :: (T_Chunks_v10 ) } data T_Chunks_s12 = C_Chunks_s12 type T_Chunks_v10 = (T_Chunks_vIn10 ) -> (T_Chunks_vOut10 ) data T_Chunks_vIn10 = T_Chunks_vIn10 (PP_Doc) (Bool) (String) (String) (String -> String -> String -> Bool -> String) (Bool) (Options) (String) (String) (Map BlockInfo PP_Doc) (PP_Doc) data T_Chunks_vOut10 = T_Chunks_vOut10 ([[PP_Doc]]) ([[PP_Doc]]) (IO ()) ([String]) (PP_Docs) {-# NOINLINE sem_Chunks_Cons #-} sem_Chunks_Cons :: T_Chunk -> T_Chunks -> T_Chunks sem_Chunks_Cons arg_hd_ arg_tl_ = T_Chunks (return st11) where {-# NOINLINE st11 #-} !st11 = let v10 :: T_Chunks_v10 v10 = \ !(T_Chunks_vIn10 _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) -> ( let _hdX8 = Control.Monad.Identity.runIdentity (attach_T_Chunk (arg_hd_)) _tlX11 = Control.Monad.Identity.runIdentity (attach_T_Chunks (arg_tl_)) (T_Chunk_vOut7 _hdIappendCommon _hdIappendMain _hdIgenSems _hdIimports _hdIpps) = inv_Chunk_s8 _hdX8 (T_Chunk_vIn7 _hdOimportBlocks _hdOisDeclOfLet _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnested _hdOoptions _hdOoptionsLine _hdOpragmaBlocks _hdOtextBlockMap _hdOtextBlocks) (T_Chunks_vOut10 _tlIappendCommon _tlIappendMain _tlIgenSems _tlIimports _tlIpps) = inv_Chunks_s11 _tlX11 (T_Chunks_vIn10 _tlOimportBlocks _tlOisDeclOfLet _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnested _tlOoptions _tlOoptionsLine _tlOpragmaBlocks _tlOtextBlockMap _tlOtextBlocks) _lhsOpps :: PP_Docs _lhsOpps = rule51 _hdIpps _tlIpps _lhsOappendCommon :: [[PP_Doc]] _lhsOappendCommon = rule52 _hdIappendCommon _tlIappendCommon _lhsOappendMain :: [[PP_Doc]] _lhsOappendMain = rule53 _hdIappendMain _tlIappendMain _lhsOgenSems :: IO () _lhsOgenSems = rule54 _hdIgenSems _tlIgenSems _lhsOimports :: [String] _lhsOimports = rule55 _hdIimports _tlIimports _hdOimportBlocks = rule56 _lhsIimportBlocks _hdOisDeclOfLet = rule57 _lhsIisDeclOfLet _hdOmainFile = rule58 _lhsImainFile _hdOmainName = rule59 _lhsImainName _hdOmoduleHeader = rule60 _lhsImoduleHeader _hdOnested = rule61 _lhsInested _hdOoptions = rule62 _lhsIoptions _hdOoptionsLine = rule63 _lhsIoptionsLine _hdOpragmaBlocks = rule64 _lhsIpragmaBlocks _hdOtextBlockMap = rule65 _lhsItextBlockMap _hdOtextBlocks = rule66 _lhsItextBlocks _tlOimportBlocks = rule67 _lhsIimportBlocks _tlOisDeclOfLet = rule68 _lhsIisDeclOfLet _tlOmainFile = rule69 _lhsImainFile _tlOmainName = rule70 _lhsImainName _tlOmoduleHeader = rule71 _lhsImoduleHeader _tlOnested = rule72 _lhsInested _tlOoptions = rule73 _lhsIoptions _tlOoptionsLine = rule74 _lhsIoptionsLine _tlOpragmaBlocks = rule75 _lhsIpragmaBlocks _tlOtextBlockMap = rule76 _lhsItextBlockMap _tlOtextBlocks = rule77 _lhsItextBlocks !__result_ = T_Chunks_vOut10 _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps in __result_ ) in C_Chunks_s11 v10 {-# INLINE rule51 #-} {-# LINE 96 "src-ag/PrintCleanCode.ag" #-} rule51 = \ ((_hdIpps) :: PP_Docs) ((_tlIpps) :: PP_Docs) -> {-# LINE 96 "src-ag/PrintCleanCode.ag" #-} _hdIpps ++ _tlIpps {-# LINE 628 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule52 #-} rule52 = \ ((_hdIappendCommon) :: [[PP_Doc]]) ((_tlIappendCommon) :: [[PP_Doc]]) -> _hdIappendCommon ++ _tlIappendCommon {-# INLINE rule53 #-} rule53 = \ ((_hdIappendMain) :: [[PP_Doc]]) ((_tlIappendMain) :: [[PP_Doc]]) -> _hdIappendMain ++ _tlIappendMain {-# INLINE rule54 #-} rule54 = \ ((_hdIgenSems) :: IO ()) ((_tlIgenSems) :: IO ()) -> _hdIgenSems >> _tlIgenSems {-# INLINE rule55 #-} rule55 = \ ((_hdIimports) :: [String]) ((_tlIimports) :: [String]) -> _hdIimports ++ _tlIimports {-# INLINE rule56 #-} rule56 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule57 #-} rule57 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule58 #-} rule58 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule59 #-} rule59 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule60 #-} rule60 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule61 #-} rule61 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule62 #-} rule62 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule63 #-} rule63 = \ ((_lhsIoptionsLine) :: String) -> _lhsIoptionsLine {-# INLINE rule64 #-} rule64 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule65 #-} rule65 = \ ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) -> _lhsItextBlockMap {-# INLINE rule66 #-} rule66 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule67 #-} rule67 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule68 #-} rule68 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule69 #-} rule69 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule70 #-} rule70 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule71 #-} rule71 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule72 #-} rule72 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule73 #-} rule73 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule74 #-} rule74 = \ ((_lhsIoptionsLine) :: String) -> _lhsIoptionsLine {-# INLINE rule75 #-} rule75 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule76 #-} rule76 = \ ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) -> _lhsItextBlockMap {-# INLINE rule77 #-} rule77 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# NOINLINE sem_Chunks_Nil #-} sem_Chunks_Nil :: T_Chunks sem_Chunks_Nil = T_Chunks (return st11) where {-# NOINLINE st11 #-} !st11 = let v10 :: T_Chunks_v10 v10 = \ !(T_Chunks_vIn10 _lhsIimportBlocks _lhsIisDeclOfLet _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInested _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule78 () _lhsOappendCommon :: [[PP_Doc]] _lhsOappendCommon = rule79 () _lhsOappendMain :: [[PP_Doc]] _lhsOappendMain = rule80 () _lhsOgenSems :: IO () _lhsOgenSems = rule81 () _lhsOimports :: [String] _lhsOimports = rule82 () !__result_ = T_Chunks_vOut10 _lhsOappendCommon _lhsOappendMain _lhsOgenSems _lhsOimports _lhsOpps in __result_ ) in C_Chunks_s11 v10 {-# INLINE rule78 #-} {-# LINE 97 "src-ag/PrintCleanCode.ag" #-} rule78 = \ (_ :: ()) -> {-# LINE 97 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 732 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule79 #-} rule79 = \ (_ :: ()) -> [] {-# INLINE rule80 #-} rule80 = \ (_ :: ()) -> [] {-# INLINE rule81 #-} rule81 = \ (_ :: ()) -> return () {-# INLINE rule82 #-} rule82 = \ (_ :: ()) -> [] -- DataAlt ----------------------------------------------------- -- wrapper data Inh_DataAlt = Inh_DataAlt { nested_Inh_DataAlt :: !(Bool), strictPre_Inh_DataAlt :: !(PP_Doc) } data Syn_DataAlt = Syn_DataAlt { pp_Syn_DataAlt :: !(PP_Doc), ppa_Syn_DataAlt :: !(PP_Doc) } {-# INLINABLE wrap_DataAlt #-} wrap_DataAlt :: T_DataAlt -> Inh_DataAlt -> (Syn_DataAlt ) wrap_DataAlt !(T_DataAlt act) !(Inh_DataAlt _lhsInested _lhsIstrictPre) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg13 = T_DataAlt_vIn13 _lhsInested _lhsIstrictPre !(T_DataAlt_vOut13 _lhsOpp _lhsOppa) <- return (inv_DataAlt_s14 sem arg13) return (Syn_DataAlt _lhsOpp _lhsOppa) ) -- cata {-# NOINLINE sem_DataAlt #-} sem_DataAlt :: DataAlt -> T_DataAlt sem_DataAlt ( DataAlt !name_ args_ ) = sem_DataAlt_DataAlt name_ ( sem_Types args_ ) sem_DataAlt ( Record !name_ args_ ) = sem_DataAlt_Record name_ ( sem_NamedTypes args_ ) -- semantic domain newtype T_DataAlt = T_DataAlt { attach_T_DataAlt :: Identity (T_DataAlt_s14 ) } newtype T_DataAlt_s14 = C_DataAlt_s14 { inv_DataAlt_s14 :: (T_DataAlt_v13 ) } data T_DataAlt_s15 = C_DataAlt_s15 type T_DataAlt_v13 = (T_DataAlt_vIn13 ) -> (T_DataAlt_vOut13 ) data T_DataAlt_vIn13 = T_DataAlt_vIn13 (Bool) (PP_Doc) data T_DataAlt_vOut13 = T_DataAlt_vOut13 (PP_Doc) (PP_Doc) {-# NOINLINE sem_DataAlt_DataAlt #-} sem_DataAlt_DataAlt :: (String) -> T_Types -> T_DataAlt sem_DataAlt_DataAlt !arg_name_ arg_args_ = T_DataAlt (return st14) where {-# NOINLINE st14 #-} !st14 = let v13 :: T_DataAlt_v13 v13 = \ !(T_DataAlt_vIn13 _lhsInested _lhsIstrictPre) -> ( let _argsX53 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_args_)) (T_Types_vOut52 _argsIcopy _argsIpps) = inv_Types_s53 _argsX53 (T_Types_vIn52 _argsOnested) _lhsOpp :: PP_Doc _lhsOpp = rule83 _argsIpps _lhsIstrictPre arg_name_ _lhsOppa :: PP_Doc _lhsOppa = rule84 () _argsOnested = rule85 _lhsInested !__result_ = T_DataAlt_vOut13 _lhsOpp _lhsOppa in __result_ ) in C_DataAlt_s14 v13 {-# INLINE rule83 #-} {-# LINE 231 "src-ag/PrintCleanCode.ag" #-} rule83 = \ ((_argsIpps) :: PP_Docs) ((_lhsIstrictPre) :: PP_Doc) name_ -> {-# LINE 231 "src-ag/PrintCleanCode.ag" #-} name_ >#< hv_sp (map ((_lhsIstrictPre >|<) . pp_parens) _argsIpps) {-# LINE 799 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule84 #-} {-# LINE 232 "src-ag/PrintCleanCode.ag" #-} rule84 = \ (_ :: ()) -> {-# LINE 232 "src-ag/PrintCleanCode.ag" #-} empty {-# LINE 805 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule85 #-} rule85 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_DataAlt_Record #-} sem_DataAlt_Record :: (String) -> T_NamedTypes -> T_DataAlt sem_DataAlt_Record !arg_name_ arg_args_ = T_DataAlt (return st14) where {-# NOINLINE st14 #-} !st14 = let v13 :: T_DataAlt_v13 v13 = \ !(T_DataAlt_vIn13 _lhsInested _lhsIstrictPre) -> ( let _argsX38 = Control.Monad.Identity.runIdentity (attach_T_NamedTypes (arg_args_)) (T_NamedTypes_vOut37 _argsIppas _argsIpps) = inv_NamedTypes_s38 _argsX38 (T_NamedTypes_vIn37 _argsOnested) _lhsOpp :: PP_Doc _lhsOpp = rule86 _argsIpps _lhsIstrictPre arg_name_ _lhsOppa :: PP_Doc _lhsOppa = rule87 _argsIppas arg_name_ _argsOnested = rule88 _lhsInested !__result_ = T_DataAlt_vOut13 _lhsOpp _lhsOppa in __result_ ) in C_DataAlt_s14 v13 {-# INLINE rule86 #-} {-# LINE 233 "src-ag/PrintCleanCode.ag" #-} rule86 = \ ((_argsIpps) :: PP_Docs) ((_lhsIstrictPre) :: PP_Doc) name_ -> {-# LINE 233 "src-ag/PrintCleanCode.ag" #-} name_ >#< hv_sp (map ((_lhsIstrictPre >|<) . pp_parens) _argsIpps) {-# LINE 831 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule87 #-} {-# LINE 234 "src-ag/PrintCleanCode.ag" #-} rule87 = \ ((_argsIppas) :: PP_Docs) name_ -> {-# LINE 234 "src-ag/PrintCleanCode.ag" #-} let f n d = d >#< (pp_block ("(" ++ name_) ")" "" $ map pp (ppat n)) >#< pp "=" >#< pp "x" ppat n = replicate (length _argsIppas - n - 1) (pp " _") ++ [pp " x"] ++ replicate n (pp " _") in snd $ foldr (\x (n, xs) -> (n + 1, f n x >-< xs)) (0, empty) _argsIppas {-# LINE 840 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule88 #-} rule88 = \ ((_lhsInested) :: Bool) -> _lhsInested -- DataAlts ---------------------------------------------------- -- wrapper data Inh_DataAlts = Inh_DataAlts { nested_Inh_DataAlts :: !(Bool), strictPre_Inh_DataAlts :: !(PP_Doc) } data Syn_DataAlts = Syn_DataAlts { ppas_Syn_DataAlts :: !(PP_Docs), pps_Syn_DataAlts :: !(PP_Docs) } {-# INLINABLE wrap_DataAlts #-} wrap_DataAlts :: T_DataAlts -> Inh_DataAlts -> (Syn_DataAlts ) wrap_DataAlts !(T_DataAlts act) !(Inh_DataAlts _lhsInested _lhsIstrictPre) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg16 = T_DataAlts_vIn16 _lhsInested _lhsIstrictPre !(T_DataAlts_vOut16 _lhsOppas _lhsOpps) <- return (inv_DataAlts_s17 sem arg16) return (Syn_DataAlts _lhsOppas _lhsOpps) ) -- cata {-# NOINLINE sem_DataAlts #-} sem_DataAlts :: DataAlts -> T_DataAlts sem_DataAlts list = Prelude.foldr sem_DataAlts_Cons sem_DataAlts_Nil (Prelude.map sem_DataAlt list) -- semantic domain newtype T_DataAlts = T_DataAlts { attach_T_DataAlts :: Identity (T_DataAlts_s17 ) } newtype T_DataAlts_s17 = C_DataAlts_s17 { inv_DataAlts_s17 :: (T_DataAlts_v16 ) } data T_DataAlts_s18 = C_DataAlts_s18 type T_DataAlts_v16 = (T_DataAlts_vIn16 ) -> (T_DataAlts_vOut16 ) data T_DataAlts_vIn16 = T_DataAlts_vIn16 (Bool) (PP_Doc) data T_DataAlts_vOut16 = T_DataAlts_vOut16 (PP_Docs) (PP_Docs) {-# NOINLINE sem_DataAlts_Cons #-} sem_DataAlts_Cons :: T_DataAlt -> T_DataAlts -> T_DataAlts sem_DataAlts_Cons arg_hd_ arg_tl_ = T_DataAlts (return st17) where {-# NOINLINE st17 #-} !st17 = let v16 :: T_DataAlts_v16 v16 = \ !(T_DataAlts_vIn16 _lhsInested _lhsIstrictPre) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_DataAlt (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_DataAlts (arg_tl_)) (T_DataAlt_vOut13 _hdIpp _hdIppa) = inv_DataAlt_s14 _hdX14 (T_DataAlt_vIn13 _hdOnested _hdOstrictPre) (T_DataAlts_vOut16 _tlIppas _tlIpps) = inv_DataAlts_s17 _tlX17 (T_DataAlts_vIn16 _tlOnested _tlOstrictPre) _lhsOpps :: PP_Docs _lhsOpps = rule89 _hdIpp _tlIpps _lhsOppas :: PP_Docs _lhsOppas = rule90 _hdIppa _tlIppas _hdOnested = rule91 _lhsInested _hdOstrictPre = rule92 _lhsIstrictPre _tlOnested = rule93 _lhsInested _tlOstrictPre = rule94 _lhsIstrictPre !__result_ = T_DataAlts_vOut16 _lhsOppas _lhsOpps in __result_ ) in C_DataAlts_s17 v16 {-# INLINE rule89 #-} {-# LINE 76 "src-ag/PrintCleanCode.ag" #-} rule89 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 76 "src-ag/PrintCleanCode.ag" #-} _hdIpp : _tlIpps {-# LINE 902 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule90 #-} {-# LINE 77 "src-ag/PrintCleanCode.ag" #-} rule90 = \ ((_hdIppa) :: PP_Doc) ((_tlIppas) :: PP_Docs) -> {-# LINE 77 "src-ag/PrintCleanCode.ag" #-} _hdIppa : _tlIppas {-# LINE 908 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule91 #-} rule91 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule92 #-} rule92 = \ ((_lhsIstrictPre) :: PP_Doc) -> _lhsIstrictPre {-# INLINE rule93 #-} rule93 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule94 #-} rule94 = \ ((_lhsIstrictPre) :: PP_Doc) -> _lhsIstrictPre {-# NOINLINE sem_DataAlts_Nil #-} sem_DataAlts_Nil :: T_DataAlts sem_DataAlts_Nil = T_DataAlts (return st17) where {-# NOINLINE st17 #-} !st17 = let v16 :: T_DataAlts_v16 v16 = \ !(T_DataAlts_vIn16 _lhsInested _lhsIstrictPre) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule95 () _lhsOppas :: PP_Docs _lhsOppas = rule96 () !__result_ = T_DataAlts_vOut16 _lhsOppas _lhsOpps in __result_ ) in C_DataAlts_s17 v16 {-# INLINE rule95 #-} {-# LINE 78 "src-ag/PrintCleanCode.ag" #-} rule95 = \ (_ :: ()) -> {-# LINE 78 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 940 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule96 #-} {-# LINE 79 "src-ag/PrintCleanCode.ag" #-} rule96 = \ (_ :: ()) -> {-# LINE 79 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 946 "dist/build/PrintCleanCode.hs"#-} -- Decl -------------------------------------------------------- -- wrapper data Inh_Decl = Inh_Decl { isDeclOfLet_Inh_Decl :: !(Bool), nested_Inh_Decl :: !(Bool), options_Inh_Decl :: !(Options), outputfile_Inh_Decl :: !(String) } data Syn_Decl = Syn_Decl { pp_Syn_Decl :: !(PP_Doc), ppa_Syn_Decl :: !(PP_Doc) } {-# INLINABLE wrap_Decl #-} wrap_Decl :: T_Decl -> Inh_Decl -> (Syn_Decl ) wrap_Decl !(T_Decl act) !(Inh_Decl _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg19 = T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile !(T_Decl_vOut19 _lhsOpp _lhsOppa) <- return (inv_Decl_s20 sem arg19) return (Syn_Decl _lhsOpp _lhsOppa) ) -- cata {-# NOINLINE sem_Decl #-} sem_Decl :: Decl -> T_Decl sem_Decl ( Decl left_ rhs_ !binds_ !uses_ ) = sem_Decl_Decl ( sem_Lhs left_ ) ( sem_Expr rhs_ ) binds_ uses_ sem_Decl ( Bind left_ rhs_ ) = sem_Decl_Bind ( sem_Lhs left_ ) ( sem_Expr rhs_ ) sem_Decl ( BindLet left_ rhs_ ) = sem_Decl_BindLet ( sem_Lhs left_ ) ( sem_Expr rhs_ ) sem_Decl ( Data !name_ !params_ alts_ !strict_ !derivings_ ) = sem_Decl_Data name_ params_ ( sem_DataAlts alts_ ) strict_ derivings_ sem_Decl ( NewType !name_ !params_ !con_ tp_ ) = sem_Decl_NewType name_ params_ con_ ( sem_Type tp_ ) sem_Decl ( Type !name_ !params_ tp_ ) = sem_Decl_Type name_ params_ ( sem_Type tp_ ) sem_Decl ( TSig !name_ tp_ ) = sem_Decl_TSig name_ ( sem_Type tp_ ) sem_Decl ( Comment !txt_ ) = sem_Decl_Comment txt_ sem_Decl ( PragmaDecl !txt_ ) = sem_Decl_PragmaDecl txt_ sem_Decl ( Resume !monadic_ !nt_ left_ rhs_ ) = sem_Decl_Resume monadic_ nt_ ( sem_Lhs left_ ) ( sem_Expr rhs_ ) sem_Decl ( EvalDecl !nt_ left_ rhs_ ) = sem_Decl_EvalDecl nt_ ( sem_Lhs left_ ) ( sem_Expr rhs_ ) -- semantic domain newtype T_Decl = T_Decl { attach_T_Decl :: Identity (T_Decl_s20 ) } newtype T_Decl_s20 = C_Decl_s20 { inv_Decl_s20 :: (T_Decl_v19 ) } data T_Decl_s21 = C_Decl_s21 type T_Decl_v19 = (T_Decl_vIn19 ) -> (T_Decl_vOut19 ) data T_Decl_vIn19 = T_Decl_vIn19 (Bool) (Bool) (Options) (String) data T_Decl_vOut19 = T_Decl_vOut19 (PP_Doc) (PP_Doc) {-# NOINLINE sem_Decl_Decl #-} sem_Decl_Decl :: T_Lhs -> T_Expr -> (Set String) -> (Set String) -> T_Decl sem_Decl_Decl arg_left_ arg_rhs_ _ _ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOnested _rhsOoptions _rhsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule97 _leftIpp _rhsIpp _lhsOppa :: PP_Doc _lhsOppa = rule98 () _leftOisDeclOfLet = rule99 _lhsIisDeclOfLet _leftOnested = rule100 _lhsInested _leftOoptions = rule101 _lhsIoptions _leftOoutputfile = rule102 _lhsIoutputfile _rhsOnested = rule103 _lhsInested _rhsOoptions = rule104 _lhsIoptions _rhsOoutputfile = rule105 _lhsIoutputfile !__result_ = T_Decl_vOut19 _lhsOpp _lhsOppa in __result_ ) in C_Decl_s20 v19 {-# INLINE rule97 #-} {-# LINE 114 "src-ag/PrintCleanCode.ag" #-} rule97 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) -> {-# LINE 114 "src-ag/PrintCleanCode.ag" #-} _leftIpp >#< "=" >-< indent 4 _rhsIpp {-# LINE 1019 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule98 #-} rule98 = \ (_ :: ()) -> empty {-# INLINE rule99 #-} rule99 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule100 #-} rule100 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule101 #-} rule101 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule102 #-} rule102 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule103 #-} rule103 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule104 #-} rule104 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule105 #-} rule105 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Decl_Bind #-} sem_Decl_Bind :: T_Lhs -> T_Expr -> T_Decl sem_Decl_Bind arg_left_ arg_rhs_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOnested _rhsOoptions _rhsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule106 _leftIpp _rhsIpp _lhsOppa :: PP_Doc _lhsOppa = rule107 () _leftOisDeclOfLet = rule108 _lhsIisDeclOfLet _leftOnested = rule109 _lhsInested _leftOoptions = rule110 _lhsIoptions _leftOoutputfile = rule111 _lhsIoutputfile _rhsOnested = rule112 _lhsInested _rhsOoptions = rule113 _lhsIoptions _rhsOoutputfile = rule114 _lhsIoutputfile !__result_ = T_Decl_vOut19 _lhsOpp _lhsOppa in __result_ ) in C_Decl_s20 v19 {-# INLINE rule106 #-} {-# LINE 116 "src-ag/PrintCleanCode.ag" #-} rule106 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) -> {-# LINE 116 "src-ag/PrintCleanCode.ag" #-} _leftIpp >#< "<-" >#< _rhsIpp {-# LINE 1074 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule107 #-} rule107 = \ (_ :: ()) -> empty {-# INLINE rule108 #-} rule108 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule109 #-} rule109 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule110 #-} rule110 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule111 #-} rule111 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule112 #-} rule112 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule113 #-} rule113 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule114 #-} rule114 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Decl_BindLet #-} sem_Decl_BindLet :: T_Lhs -> T_Expr -> T_Decl sem_Decl_BindLet arg_left_ arg_rhs_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOnested _rhsOoptions _rhsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule115 _leftIpp _rhsIpp _lhsOppa :: PP_Doc _lhsOppa = rule116 () _leftOisDeclOfLet = rule117 _lhsIisDeclOfLet _leftOnested = rule118 _lhsInested _leftOoptions = rule119 _lhsIoptions _leftOoutputfile = rule120 _lhsIoutputfile _rhsOnested = rule121 _lhsInested _rhsOoptions = rule122 _lhsIoptions _rhsOoutputfile = rule123 _lhsIoutputfile !__result_ = T_Decl_vOut19 _lhsOpp _lhsOppa in __result_ ) in C_Decl_s20 v19 {-# INLINE rule115 #-} {-# LINE 117 "src-ag/PrintCleanCode.ag" #-} rule115 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) -> {-# LINE 117 "src-ag/PrintCleanCode.ag" #-} "let" >#< _leftIpp >#< "=" >#< _rhsIpp {-# LINE 1129 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule116 #-} rule116 = \ (_ :: ()) -> empty {-# INLINE rule117 #-} rule117 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule118 #-} rule118 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule119 #-} rule119 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule120 #-} rule120 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule121 #-} rule121 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule122 #-} rule122 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule123 #-} rule123 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Decl_Data #-} sem_Decl_Data :: (String) -> ([String]) -> T_DataAlts -> (Bool) -> ([String]) -> T_Decl sem_Decl_Data !arg_name_ !arg_params_ arg_alts_ !arg_strict_ !arg_derivings_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _altsX17 = Control.Monad.Identity.runIdentity (attach_T_DataAlts (arg_alts_)) (T_DataAlts_vOut16 _altsIppas _altsIpps) = inv_DataAlts_s17 _altsX17 (T_DataAlts_vIn16 _altsOnested _altsOstrictPre) _lhsOpp :: PP_Doc _lhsOpp = rule124 _altsIppas _altsIpps arg_derivings_ arg_name_ arg_params_ _altsOstrictPre = rule125 arg_strict_ _lhsOppa :: PP_Doc _lhsOppa = rule126 () _altsOnested = rule127 _lhsInested !__result_ = T_Decl_vOut19 _lhsOpp _lhsOppa in __result_ ) in C_Decl_s20 v19 {-# INLINE rule124 #-} {-# LINE 118 "src-ag/PrintCleanCode.ag" #-} rule124 = \ ((_altsIppas) :: PP_Docs) ((_altsIpps) :: PP_Docs) derivings_ name_ params_ -> {-# LINE 118 "src-ag/PrintCleanCode.ag" #-} "::" >#< hv_sp (name_ : params_) >#< ( case _altsIpps of [] -> empty (x:xs) -> "=" >#< x >-< vlist (map ("|" >#<) xs) >-< if null derivings_ then empty else "deriving" >#< ppTuple False (map text derivings_) ) >-< foldr (>-<) empty _altsIppas {-# LINE 1186 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule125 #-} {-# LINE 346 "src-ag/PrintCleanCode.ag" #-} rule125 = \ strict_ -> {-# LINE 346 "src-ag/PrintCleanCode.ag" #-} if strict_ then pp "!" else empty {-# LINE 1192 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule126 #-} rule126 = \ (_ :: ()) -> empty {-# INLINE rule127 #-} rule127 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Decl_NewType #-} sem_Decl_NewType :: (String) -> ([String]) -> (String) -> T_Type -> T_Decl sem_Decl_NewType !arg_name_ !arg_params_ !arg_con_ arg_tp_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIcopy _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOpp :: PP_Doc _lhsOpp = rule128 _tpIpp arg_con_ arg_name_ arg_params_ _lhsOppa :: PP_Doc _lhsOppa = rule129 () _tpOnested = rule130 _lhsInested !__result_ = T_Decl_vOut19 _lhsOpp _lhsOppa in __result_ ) in C_Decl_s20 v19 {-# INLINE rule128 #-} {-# LINE 129 "src-ag/PrintCleanCode.ag" #-} rule128 = \ ((_tpIpp) :: PP_Doc) con_ name_ params_ -> {-# LINE 129 "src-ag/PrintCleanCode.ag" #-} "::" >#< hv_sp (name_ : params_) >#< "=" >#< con_ >#< pp_parens _tpIpp {-# LINE 1221 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule129 #-} rule129 = \ (_ :: ()) -> empty {-# INLINE rule130 #-} rule130 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Decl_Type #-} sem_Decl_Type :: (String) -> ([String]) -> T_Type -> T_Decl sem_Decl_Type !arg_name_ !arg_params_ arg_tp_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIcopy _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOpp :: PP_Doc _lhsOpp = rule131 _tpIpp arg_name_ arg_params_ _lhsOppa :: PP_Doc _lhsOppa = rule132 () _tpOnested = rule133 _lhsInested !__result_ = T_Decl_vOut19 _lhsOpp _lhsOppa in __result_ ) in C_Decl_s20 v19 {-# INLINE rule131 #-} {-# LINE 130 "src-ag/PrintCleanCode.ag" #-} rule131 = \ ((_tpIpp) :: PP_Doc) name_ params_ -> {-# LINE 130 "src-ag/PrintCleanCode.ag" #-} "::" >#< hv_sp (name_ : params_) >#< ":==" >#< _tpIpp {-# LINE 1250 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule132 #-} rule132 = \ (_ :: ()) -> empty {-# INLINE rule133 #-} rule133 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Decl_TSig #-} sem_Decl_TSig :: (String) -> T_Type -> T_Decl sem_Decl_TSig !arg_name_ arg_tp_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIcopy _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOpp :: PP_Doc _lhsOpp = rule134 _tpIpp arg_name_ _lhsOppa :: PP_Doc _lhsOppa = rule135 () _tpOnested = rule136 _lhsInested !__result_ = T_Decl_vOut19 _lhsOpp _lhsOppa in __result_ ) in C_Decl_s20 v19 {-# INLINE rule134 #-} {-# LINE 131 "src-ag/PrintCleanCode.ag" #-} rule134 = \ ((_tpIpp) :: PP_Doc) name_ -> {-# LINE 131 "src-ag/PrintCleanCode.ag" #-} name_ >#< "::" >#< _tpIpp {-# LINE 1279 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule135 #-} rule135 = \ (_ :: ()) -> empty {-# INLINE rule136 #-} rule136 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Decl_Comment #-} sem_Decl_Comment :: (String) -> T_Decl sem_Decl_Comment !arg_txt_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule137 arg_txt_ _lhsOppa :: PP_Doc _lhsOppa = rule138 () !__result_ = T_Decl_vOut19 _lhsOpp _lhsOppa in __result_ ) in C_Decl_s20 v19 {-# INLINE rule137 #-} {-# LINE 132 "src-ag/PrintCleanCode.ag" #-} rule137 = \ txt_ -> {-# LINE 132 "src-ag/PrintCleanCode.ag" #-} if '\n' `elem` txt_ then "/*" >-< vlist (lines txt_) >-< "*/" else "//" >#< txt_ {-# LINE 1307 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule138 #-} rule138 = \ (_ :: ()) -> empty {-# NOINLINE sem_Decl_PragmaDecl #-} sem_Decl_PragmaDecl :: (String) -> T_Decl sem_Decl_PragmaDecl !arg_txt_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule139 arg_txt_ _lhsOppa :: PP_Doc _lhsOppa = rule140 () !__result_ = T_Decl_vOut19 _lhsOpp _lhsOppa in __result_ ) in C_Decl_s20 v19 {-# INLINE rule139 #-} {-# LINE 135 "src-ag/PrintCleanCode.ag" #-} rule139 = \ txt_ -> {-# LINE 135 "src-ag/PrintCleanCode.ag" #-} "/*#" >#< text txt_ >#< "#*/" {-# LINE 1330 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule140 #-} rule140 = \ (_ :: ()) -> empty {-# NOINLINE sem_Decl_Resume #-} sem_Decl_Resume :: (Bool) -> (String) -> T_Lhs -> T_Expr -> T_Decl sem_Decl_Resume !arg_monadic_ _ arg_left_ arg_rhs_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOnested _rhsOoptions _rhsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule141 _leftIpp _rhsIpp arg_monadic_ _lhsOppa :: PP_Doc _lhsOppa = rule142 () _leftOisDeclOfLet = rule143 _lhsIisDeclOfLet _leftOnested = rule144 _lhsInested _leftOoptions = rule145 _lhsIoptions _leftOoutputfile = rule146 _lhsIoutputfile _rhsOnested = rule147 _lhsInested _rhsOoptions = rule148 _lhsIoptions _rhsOoutputfile = rule149 _lhsIoutputfile !__result_ = T_Decl_vOut19 _lhsOpp _lhsOppa in __result_ ) in C_Decl_s20 v19 {-# INLINE rule141 #-} {-# LINE 136 "src-ag/PrintCleanCode.ag" #-} rule141 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) monadic_ -> {-# LINE 136 "src-ag/PrintCleanCode.ag" #-} if monadic_ then _leftIpp >#< "<-" >#< _rhsIpp else _leftIpp >#< "=" >-< indent 4 _rhsIpp {-# LINE 1366 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule142 #-} rule142 = \ (_ :: ()) -> empty {-# INLINE rule143 #-} rule143 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule144 #-} rule144 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule145 #-} rule145 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule146 #-} rule146 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule147 #-} rule147 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule148 #-} rule148 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule149 #-} rule149 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Decl_EvalDecl #-} sem_Decl_EvalDecl :: (String) -> T_Lhs -> T_Expr -> T_Decl sem_Decl_EvalDecl !arg_nt_ arg_left_ arg_rhs_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOnested _rhsOoptions _rhsOoutputfile) _strat = rule150 _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule151 _leftIpp _lhsIoptions _rhsIpp _strat arg_nt_ _lhsOppa :: PP_Doc _lhsOppa = rule152 () _leftOisDeclOfLet = rule153 _lhsIisDeclOfLet _leftOnested = rule154 _lhsInested _leftOoptions = rule155 _lhsIoptions _leftOoutputfile = rule156 _lhsIoutputfile _rhsOnested = rule157 _lhsInested _rhsOoptions = rule158 _lhsIoptions _rhsOoutputfile = rule159 _lhsIoutputfile !__result_ = T_Decl_vOut19 _lhsOpp _lhsOppa in __result_ ) in C_Decl_s20 v19 {-# INLINE rule150 #-} {-# LINE 139 "src-ag/PrintCleanCode.ag" #-} rule150 = \ ((_lhsIoptions) :: Options) -> {-# LINE 139 "src-ag/PrintCleanCode.ag" #-} if breadthFirstStrict _lhsIoptions then "stepwiseEval" else "lazyEval" {-# LINE 1424 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule151 #-} {-# LINE 142 "src-ag/PrintCleanCode.ag" #-} rule151 = \ ((_leftIpp) :: PP_Doc) ((_lhsIoptions) :: Options) ((_rhsIpp) :: PP_Doc) _strat nt_ -> {-# LINE 142 "src-ag/PrintCleanCode.ag" #-} if breadthFirst _lhsIoptions then _leftIpp >#< "=" >#< "case" >#< _strat >#< pp_parens _rhsIpp >#< "of" >-< indent 4 ( pp_parens (nt_ >|< "_Syn" >#< "_val") >#< "-> _val" ) else _leftIpp >#< "=" >#< _rhsIpp {-# LINE 1435 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule152 #-} rule152 = \ (_ :: ()) -> empty {-# INLINE rule153 #-} rule153 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule154 #-} rule154 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule155 #-} rule155 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule156 #-} rule156 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule157 #-} rule157 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule158 #-} rule158 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule159 #-} rule159 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile -- Decls ------------------------------------------------------- -- wrapper data Inh_Decls = Inh_Decls { isDeclOfLet_Inh_Decls :: !(Bool), nested_Inh_Decls :: !(Bool), options_Inh_Decls :: !(Options), outputfile_Inh_Decls :: !(String) } data Syn_Decls = Syn_Decls { pps_Syn_Decls :: !(PP_Docs) } {-# INLINABLE wrap_Decls #-} wrap_Decls :: T_Decls -> Inh_Decls -> (Syn_Decls ) wrap_Decls !(T_Decls act) !(Inh_Decls _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg22 = T_Decls_vIn22 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile !(T_Decls_vOut22 _lhsOpps) <- return (inv_Decls_s23 sem arg22) return (Syn_Decls _lhsOpps) ) -- cata {-# NOINLINE sem_Decls #-} sem_Decls :: Decls -> T_Decls sem_Decls list = Prelude.foldr sem_Decls_Cons sem_Decls_Nil (Prelude.map sem_Decl list) -- semantic domain newtype T_Decls = T_Decls { attach_T_Decls :: Identity (T_Decls_s23 ) } newtype T_Decls_s23 = C_Decls_s23 { inv_Decls_s23 :: (T_Decls_v22 ) } data T_Decls_s24 = C_Decls_s24 type T_Decls_v22 = (T_Decls_vIn22 ) -> (T_Decls_vOut22 ) data T_Decls_vIn22 = T_Decls_vIn22 (Bool) (Bool) (Options) (String) data T_Decls_vOut22 = T_Decls_vOut22 (PP_Docs) {-# NOINLINE sem_Decls_Cons #-} sem_Decls_Cons :: T_Decl -> T_Decls -> T_Decls sem_Decls_Cons arg_hd_ arg_tl_ = T_Decls (return st23) where {-# NOINLINE st23 #-} !st23 = let v22 :: T_Decls_v22 v22 = \ !(T_Decls_vIn22 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _hdX20 = Control.Monad.Identity.runIdentity (attach_T_Decl (arg_hd_)) _tlX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_tl_)) (T_Decl_vOut19 _hdIpp _hdIppa) = inv_Decl_s20 _hdX20 (T_Decl_vIn19 _hdOisDeclOfLet _hdOnested _hdOoptions _hdOoutputfile) (T_Decls_vOut22 _tlIpps) = inv_Decls_s23 _tlX23 (T_Decls_vIn22 _tlOisDeclOfLet _tlOnested _tlOoptions _tlOoutputfile) _lhsOpps :: PP_Docs _lhsOpps = rule160 _hdIpp _tlIpps _hdOisDeclOfLet = rule161 _lhsIisDeclOfLet _hdOnested = rule162 _lhsInested _hdOoptions = rule163 _lhsIoptions _hdOoutputfile = rule164 _lhsIoutputfile _tlOisDeclOfLet = rule165 _lhsIisDeclOfLet _tlOnested = rule166 _lhsInested _tlOoptions = rule167 _lhsIoptions _tlOoutputfile = rule168 _lhsIoutputfile !__result_ = T_Decls_vOut22 _lhsOpps in __result_ ) in C_Decls_s23 v22 {-# INLINE rule160 #-} {-# LINE 92 "src-ag/PrintCleanCode.ag" #-} rule160 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 92 "src-ag/PrintCleanCode.ag" #-} _hdIpp : _tlIpps {-# LINE 1520 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule161 #-} rule161 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule162 #-} rule162 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule163 #-} rule163 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule164 #-} rule164 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule165 #-} rule165 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule166 #-} rule166 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule167 #-} rule167 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule168 #-} rule168 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Decls_Nil #-} sem_Decls_Nil :: T_Decls sem_Decls_Nil = T_Decls (return st23) where {-# NOINLINE st23 #-} !st23 = let v22 :: T_Decls_v22 v22 = \ !(T_Decls_vIn22 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule169 () !__result_ = T_Decls_vOut22 _lhsOpps in __result_ ) in C_Decls_s23 v22 {-# INLINE rule169 #-} {-# LINE 93 "src-ag/PrintCleanCode.ag" #-} rule169 = \ (_ :: ()) -> {-# LINE 93 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 1562 "dist/build/PrintCleanCode.hs"#-} -- Expr -------------------------------------------------------- -- wrapper data Inh_Expr = Inh_Expr { nested_Inh_Expr :: !(Bool), options_Inh_Expr :: !(Options), outputfile_Inh_Expr :: !(String) } data Syn_Expr = Syn_Expr { pp_Syn_Expr :: !(PP_Doc) } {-# INLINABLE wrap_Expr #-} wrap_Expr :: T_Expr -> Inh_Expr -> (Syn_Expr ) wrap_Expr !(T_Expr act) !(Inh_Expr _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg25 = T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile !(T_Expr_vOut25 _lhsOpp) <- return (inv_Expr_s26 sem arg25) return (Syn_Expr _lhsOpp) ) -- cata {-# NOINLINE sem_Expr #-} sem_Expr :: Expr -> T_Expr sem_Expr ( Let decls_ body_ ) = sem_Expr_Let ( sem_Decls decls_ ) ( sem_Expr body_ ) sem_Expr ( Case expr_ alts_ ) = sem_Expr_Case ( sem_Expr expr_ ) ( sem_CaseAlts alts_ ) sem_Expr ( Do stmts_ body_ ) = sem_Expr_Do ( sem_Decls stmts_ ) ( sem_Expr body_ ) sem_Expr ( Lambda args_ body_ ) = sem_Expr_Lambda ( sem_Exprs args_ ) ( sem_Expr body_ ) sem_Expr ( TupleExpr exprs_ ) = sem_Expr_TupleExpr ( sem_Exprs exprs_ ) sem_Expr ( UnboxedTupleExpr exprs_ ) = sem_Expr_UnboxedTupleExpr ( sem_Exprs exprs_ ) sem_Expr ( App !name_ args_ ) = sem_Expr_App name_ ( sem_Exprs args_ ) sem_Expr ( SimpleExpr !txt_ ) = sem_Expr_SimpleExpr txt_ sem_Expr ( TextExpr !lns_ ) = sem_Expr_TextExpr lns_ sem_Expr ( Trace !txt_ expr_ ) = sem_Expr_Trace txt_ ( sem_Expr expr_ ) sem_Expr ( PragmaExpr !onLeftSide_ !onNewLine_ !txt_ expr_ ) = sem_Expr_PragmaExpr onLeftSide_ onNewLine_ txt_ ( sem_Expr expr_ ) sem_Expr ( LineExpr expr_ ) = sem_Expr_LineExpr ( sem_Expr expr_ ) sem_Expr ( TypedExpr expr_ tp_ ) = sem_Expr_TypedExpr ( sem_Expr expr_ ) ( sem_Type tp_ ) sem_Expr ( ResultExpr !nt_ expr_ ) = sem_Expr_ResultExpr nt_ ( sem_Expr expr_ ) sem_Expr ( InvokeExpr !nt_ expr_ args_ ) = sem_Expr_InvokeExpr nt_ ( sem_Expr expr_ ) ( sem_Exprs args_ ) sem_Expr ( ResumeExpr !nt_ expr_ left_ rhs_ ) = sem_Expr_ResumeExpr nt_ ( sem_Expr expr_ ) ( sem_Lhs left_ ) ( sem_Expr rhs_ ) sem_Expr ( SemFun !nt_ args_ body_ ) = sem_Expr_SemFun nt_ ( sem_Exprs args_ ) ( sem_Expr body_ ) -- semantic domain newtype T_Expr = T_Expr { attach_T_Expr :: Identity (T_Expr_s26 ) } newtype T_Expr_s26 = C_Expr_s26 { inv_Expr_s26 :: (T_Expr_v25 ) } data T_Expr_s27 = C_Expr_s27 type T_Expr_v25 = (T_Expr_vIn25 ) -> (T_Expr_vOut25 ) data T_Expr_vIn25 = T_Expr_vIn25 (Bool) (Options) (String) data T_Expr_vOut25 = T_Expr_vOut25 (PP_Doc) {-# NOINLINE sem_Expr_Let #-} sem_Expr_Let :: T_Decls -> T_Expr -> T_Expr sem_Expr_Let arg_decls_ arg_body_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _declsX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_decls_)) _bodyX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_body_)) (T_Decls_vOut22 _declsIpps) = inv_Decls_s23 _declsX23 (T_Decls_vIn22 _declsOisDeclOfLet _declsOnested _declsOoptions _declsOoutputfile) (T_Expr_vOut25 _bodyIpp) = inv_Expr_s26 _bodyX26 (T_Expr_vIn25 _bodyOnested _bodyOoptions _bodyOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule170 _bodyIpp _declsIpps _declsOisDeclOfLet = rule171 () _declsOnested = rule172 _lhsInested _declsOoptions = rule173 _lhsIoptions _declsOoutputfile = rule174 _lhsIoutputfile _bodyOnested = rule175 _lhsInested _bodyOoptions = rule176 _lhsIoptions _bodyOoutputfile = rule177 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule170 #-} {-# LINE 150 "src-ag/PrintCleanCode.ag" #-} rule170 = \ ((_bodyIpp) :: PP_Doc) ((_declsIpps) :: PP_Docs) -> {-# LINE 150 "src-ag/PrintCleanCode.ag" #-} pp_parens ( "let" >#< (vlist _declsIpps) >-< "in " >#< _bodyIpp ) {-# LINE 1640 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule171 #-} {-# LINE 441 "src-ag/PrintCleanCode.ag" #-} rule171 = \ (_ :: ()) -> {-# LINE 441 "src-ag/PrintCleanCode.ag" #-} True {-# LINE 1646 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule172 #-} rule172 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule173 #-} rule173 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule174 #-} rule174 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule175 #-} rule175 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule176 #-} rule176 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule177 #-} rule177 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_Case #-} sem_Expr_Case :: T_Expr -> T_CaseAlts -> T_Expr sem_Expr_Case arg_expr_ arg_alts_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) _altsX5 = Control.Monad.Identity.runIdentity (attach_T_CaseAlts (arg_alts_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) (T_CaseAlts_vOut4 _altsIpps) = inv_CaseAlts_s5 _altsX5 (T_CaseAlts_vIn4 _altsOnested _altsOoptions _altsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule178 _altsIpps _exprIpp _exprOnested = rule179 _lhsInested _exprOoptions = rule180 _lhsIoptions _exprOoutputfile = rule181 _lhsIoutputfile _altsOnested = rule182 _lhsInested _altsOoptions = rule183 _lhsIoptions _altsOoutputfile = rule184 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule178 #-} {-# LINE 153 "src-ag/PrintCleanCode.ag" #-} rule178 = \ ((_altsIpps) :: PP_Docs) ((_exprIpp) :: PP_Doc) -> {-# LINE 153 "src-ag/PrintCleanCode.ag" #-} pp_parens ( "case" >#< pp_parens _exprIpp >#< "of" >-< (vlist _altsIpps) ) {-# LINE 1694 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule179 #-} rule179 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule180 #-} rule180 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule181 #-} rule181 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule182 #-} rule182 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule183 #-} rule183 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule184 #-} rule184 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_Do #-} sem_Expr_Do :: T_Decls -> T_Expr -> T_Expr sem_Expr_Do arg_stmts_ arg_body_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _stmtsX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_stmts_)) _bodyX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_body_)) (T_Decls_vOut22 _stmtsIpps) = inv_Decls_s23 _stmtsX23 (T_Decls_vIn22 _stmtsOisDeclOfLet _stmtsOnested _stmtsOoptions _stmtsOoutputfile) (T_Expr_vOut25 _bodyIpp) = inv_Expr_s26 _bodyX26 (T_Expr_vIn25 _bodyOnested _bodyOoptions _bodyOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule185 _bodyIpp _stmtsIpps _stmtsOisDeclOfLet = rule186 () _stmtsOnested = rule187 _lhsInested _stmtsOoptions = rule188 _lhsIoptions _stmtsOoutputfile = rule189 _lhsIoutputfile _bodyOnested = rule190 _lhsInested _bodyOoptions = rule191 _lhsIoptions _bodyOoutputfile = rule192 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule185 #-} {-# LINE 156 "src-ag/PrintCleanCode.ag" #-} rule185 = \ ((_bodyIpp) :: PP_Doc) ((_stmtsIpps) :: PP_Docs) -> {-# LINE 156 "src-ag/PrintCleanCode.ag" #-} pp_parens ( "do" >#< ( vlist _stmtsIpps >-< ("return" >#< _bodyIpp)) ) {-# LINE 1743 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule186 #-} {-# LINE 443 "src-ag/PrintCleanCode.ag" #-} rule186 = \ (_ :: ()) -> {-# LINE 443 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 1749 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule187 #-} rule187 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule188 #-} rule188 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule189 #-} rule189 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule190 #-} rule190 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule191 #-} rule191 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule192 #-} rule192 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_Lambda #-} sem_Expr_Lambda :: T_Exprs -> T_Expr -> T_Expr sem_Expr_Lambda arg_args_ arg_body_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _argsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_args_)) _bodyX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_body_)) (T_Exprs_vOut28 _argsIpps) = inv_Exprs_s29 _argsX29 (T_Exprs_vIn28 _argsOnested _argsOoptions _argsOoutputfile) (T_Expr_vOut25 _bodyIpp) = inv_Expr_s26 _bodyX26 (T_Expr_vIn25 _bodyOnested _bodyOoptions _bodyOoutputfile) _strictParams = rule193 _argsIpps _lhsIoptions _addBang = rule194 _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule195 _addBang _argsIpps _bodyIpp _strictParams _argsOnested = rule196 _lhsInested _argsOoptions = rule197 _lhsIoptions _argsOoutputfile = rule198 _lhsIoutputfile _bodyOnested = rule199 _lhsInested _bodyOoptions = rule200 _lhsIoptions _bodyOoutputfile = rule201 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule193 #-} {-# LINE 159 "src-ag/PrintCleanCode.ag" #-} rule193 = \ ((_argsIpps) :: PP_Docs) ((_lhsIoptions) :: Options) -> {-# LINE 159 "src-ag/PrintCleanCode.ag" #-} if strictSems _lhsIoptions then _argsIpps else [] {-# LINE 1799 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule194 #-} {-# LINE 162 "src-ag/PrintCleanCode.ag" #-} rule194 = \ ((_lhsIoptions) :: Options) -> {-# LINE 162 "src-ag/PrintCleanCode.ag" #-} if bangpats _lhsIoptions then \p -> pp_parens ("!" >|< p) else id {-# LINE 1807 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule195 #-} {-# LINE 165 "src-ag/PrintCleanCode.ag" #-} rule195 = \ _addBang ((_argsIpps) :: PP_Docs) ((_bodyIpp) :: PP_Doc) _strictParams -> {-# LINE 165 "src-ag/PrintCleanCode.ag" #-} pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->" >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp) ) {-# LINE 1815 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule196 #-} rule196 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule197 #-} rule197 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule198 #-} rule198 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule199 #-} rule199 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule200 #-} rule200 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule201 #-} rule201 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_TupleExpr #-} sem_Expr_TupleExpr :: T_Exprs -> T_Expr sem_Expr_TupleExpr arg_exprs_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_exprs_)) (T_Exprs_vOut28 _exprsIpps) = inv_Exprs_s29 _exprsX29 (T_Exprs_vIn28 _exprsOnested _exprsOoptions _exprsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule202 _exprsIpps _lhsInested _exprsOnested = rule203 _lhsInested _exprsOoptions = rule204 _lhsIoptions _exprsOoutputfile = rule205 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule202 #-} {-# LINE 168 "src-ag/PrintCleanCode.ag" #-} rule202 = \ ((_exprsIpps) :: PP_Docs) ((_lhsInested) :: Bool) -> {-# LINE 168 "src-ag/PrintCleanCode.ag" #-} ppTuple _lhsInested _exprsIpps {-# LINE 1856 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule203 #-} rule203 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule204 #-} rule204 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule205 #-} rule205 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_UnboxedTupleExpr #-} sem_Expr_UnboxedTupleExpr :: T_Exprs -> T_Expr sem_Expr_UnboxedTupleExpr arg_exprs_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_exprs_)) (T_Exprs_vOut28 _exprsIpps) = inv_Exprs_s29 _exprsX29 (T_Exprs_vIn28 _exprsOnested _exprsOoptions _exprsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule206 _exprsIpps _lhsInested _exprsOnested = rule207 _lhsInested _exprsOoptions = rule208 _lhsIoptions _exprsOoutputfile = rule209 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule206 #-} {-# LINE 169 "src-ag/PrintCleanCode.ag" #-} rule206 = \ ((_exprsIpps) :: PP_Docs) ((_lhsInested) :: Bool) -> {-# LINE 169 "src-ag/PrintCleanCode.ag" #-} ppUnboxedTuple _lhsInested _exprsIpps {-# LINE 1888 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule207 #-} rule207 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule208 #-} rule208 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule209 #-} rule209 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_App #-} sem_Expr_App :: (String) -> T_Exprs -> T_Expr sem_Expr_App !arg_name_ arg_args_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _argsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_args_)) (T_Exprs_vOut28 _argsIpps) = inv_Exprs_s29 _argsX29 (T_Exprs_vIn28 _argsOnested _argsOoptions _argsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule210 _argsIpps arg_name_ _argsOnested = rule211 _lhsInested _argsOoptions = rule212 _lhsIoptions _argsOoutputfile = rule213 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule210 #-} {-# LINE 170 "src-ag/PrintCleanCode.ag" #-} rule210 = \ ((_argsIpps) :: PP_Docs) name_ -> {-# LINE 170 "src-ag/PrintCleanCode.ag" #-} pp_parens $ name_ >#< hv_sp _argsIpps {-# LINE 1920 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule211 #-} rule211 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule212 #-} rule212 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule213 #-} rule213 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_SimpleExpr #-} sem_Expr_SimpleExpr :: (String) -> T_Expr sem_Expr_SimpleExpr !arg_txt_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule214 arg_txt_ !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule214 #-} {-# LINE 171 "src-ag/PrintCleanCode.ag" #-} rule214 = \ txt_ -> {-# LINE 171 "src-ag/PrintCleanCode.ag" #-} text txt_ {-# LINE 1947 "dist/build/PrintCleanCode.hs"#-} {-# NOINLINE sem_Expr_TextExpr #-} sem_Expr_TextExpr :: ([String]) -> T_Expr sem_Expr_TextExpr !arg_lns_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule215 arg_lns_ !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule215 #-} {-# LINE 172 "src-ag/PrintCleanCode.ag" #-} rule215 = \ lns_ -> {-# LINE 172 "src-ag/PrintCleanCode.ag" #-} vlist (map text lns_) {-# LINE 1965 "dist/build/PrintCleanCode.hs"#-} {-# NOINLINE sem_Expr_Trace #-} sem_Expr_Trace :: (String) -> T_Expr -> T_Expr sem_Expr_Trace !arg_txt_ arg_expr_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule216 _exprIpp arg_txt_ _exprOnested = rule217 _lhsInested _exprOoptions = rule218 _lhsIoptions _exprOoutputfile = rule219 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule216 #-} {-# LINE 173 "src-ag/PrintCleanCode.ag" #-} rule216 = \ ((_exprIpp) :: PP_Doc) txt_ -> {-# LINE 173 "src-ag/PrintCleanCode.ag" #-} "trace" >#< ( pp_parens ("\"" >|< text txt_ >|< "\"") >-< pp_parens _exprIpp ) {-# LINE 1990 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule217 #-} rule217 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule218 #-} rule218 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule219 #-} rule219 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_PragmaExpr #-} sem_Expr_PragmaExpr :: (Bool) -> (Bool) -> (String) -> T_Expr -> T_Expr sem_Expr_PragmaExpr !arg_onLeftSide_ !arg_onNewLine_ !arg_txt_ arg_expr_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule220 _exprIpp arg_onLeftSide_ arg_onNewLine_ arg_txt_ _exprOnested = rule221 _lhsInested _exprOoptions = rule222 _lhsIoptions _exprOoutputfile = rule223 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule220 #-} {-# LINE 176 "src-ag/PrintCleanCode.ag" #-} rule220 = \ ((_exprIpp) :: PP_Doc) onLeftSide_ onNewLine_ txt_ -> {-# LINE 176 "src-ag/PrintCleanCode.ag" #-} let pragmaDoc = "/*#" >#< txt_ >#< "#*/" op = if onNewLine_ then (>-<) else (>#<) leftOp x y = if onLeftSide_ then x `op` y else y rightOp x y = if onLeftSide_ then x else x `op` y in pp_parens (pragmaDoc `leftOp` _exprIpp `rightOp` pragmaDoc) {-# LINE 2032 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule221 #-} rule221 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule222 #-} rule222 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule223 #-} rule223 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_LineExpr #-} sem_Expr_LineExpr :: T_Expr -> T_Expr sem_Expr_LineExpr arg_expr_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule224 _exprIpp _lhsIoutputfile _exprOnested = rule225 _lhsInested _exprOoptions = rule226 _lhsIoptions _exprOoutputfile = rule227 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule224 #-} {-# LINE 187 "src-ag/PrintCleanCode.ag" #-} rule224 = \ ((_exprIpp) :: PP_Doc) ((_lhsIoutputfile) :: String) -> {-# LINE 187 "src-ag/PrintCleanCode.ag" #-} _exprIpp >-< "/*# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show _lhsIoutputfile >#< "#*/" >-< "" {-# LINE 2065 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule225 #-} rule225 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule226 #-} rule226 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule227 #-} rule227 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_TypedExpr #-} sem_Expr_TypedExpr :: T_Expr -> T_Type -> T_Expr sem_Expr_TypedExpr arg_expr_ arg_tp_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) (T_Type_vOut49 _tpIcopy _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOpp :: PP_Doc _lhsOpp = rule228 _exprIpp _tpIpp _exprOnested = rule229 _lhsInested _exprOoptions = rule230 _lhsIoptions _exprOoutputfile = rule231 _lhsIoutputfile _tpOnested = rule232 _lhsInested !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule228 #-} {-# LINE 189 "src-ag/PrintCleanCode.ag" #-} rule228 = \ ((_exprIpp) :: PP_Doc) ((_tpIpp) :: PP_Doc) -> {-# LINE 189 "src-ag/PrintCleanCode.ag" #-} pp_parens (_exprIpp >#< "::" >#< _tpIpp) {-# LINE 2100 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule229 #-} rule229 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule230 #-} rule230 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule231 #-} rule231 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule232 #-} rule232 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Expr_ResultExpr #-} sem_Expr_ResultExpr :: (String) -> T_Expr -> T_Expr sem_Expr_ResultExpr !arg_nt_ arg_expr_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule233 _exprIpp _lhsIoptions arg_nt_ _exprOnested = rule234 _lhsInested _exprOoptions = rule235 _lhsIoptions _exprOoutputfile = rule236 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule233 #-} {-# LINE 190 "src-ag/PrintCleanCode.ag" #-} rule233 = \ ((_exprIpp) :: PP_Doc) ((_lhsIoptions) :: Options) nt_ -> {-# LINE 190 "src-ag/PrintCleanCode.ag" #-} if breadthFirst _lhsIoptions then "final" >#< pp_parens (nt_ >|< "_Syn" >#< pp_parens _exprIpp) else _exprIpp {-# LINE 2138 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule234 #-} rule234 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule235 #-} rule235 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule236 #-} rule236 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_InvokeExpr #-} sem_Expr_InvokeExpr :: (String) -> T_Expr -> T_Exprs -> T_Expr sem_Expr_InvokeExpr !arg_nt_ arg_expr_ arg_args_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) _argsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_args_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) (T_Exprs_vOut28 _argsIpps) = inv_Exprs_s29 _argsX29 (T_Exprs_vIn28 _argsOnested _argsOoptions _argsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule237 _argsIpps _exprIpp _lhsIoptions arg_nt_ _exprOnested = rule238 _lhsInested _exprOoptions = rule239 _lhsIoptions _exprOoutputfile = rule240 _lhsIoutputfile _argsOnested = rule241 _lhsInested _argsOoptions = rule242 _lhsIoptions _argsOoutputfile = rule243 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule237 #-} {-# LINE 194 "src-ag/PrintCleanCode.ag" #-} rule237 = \ ((_argsIpps) :: PP_Docs) ((_exprIpp) :: PP_Doc) ((_lhsIoptions) :: Options) nt_ -> {-# LINE 194 "src-ag/PrintCleanCode.ag" #-} if breadthFirst _lhsIoptions then "invoke" >#< pp_parens _exprIpp >#< pp_parens ( nt_ >|< "_Inh" >#< pp_parens (ppTuple False _argsIpps)) else _exprIpp >#< hv_sp _argsIpps {-# LINE 2178 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule238 #-} rule238 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule239 #-} rule239 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule240 #-} rule240 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule241 #-} rule241 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule242 #-} rule242 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule243 #-} rule243 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_ResumeExpr #-} sem_Expr_ResumeExpr :: (String) -> T_Expr -> T_Lhs -> T_Expr -> T_Expr sem_Expr_ResumeExpr !arg_nt_ arg_expr_ arg_left_ arg_rhs_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOnested _exprOoptions _exprOoutputfile) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOisDeclOfLet _leftOnested _leftOoptions _leftOoutputfile) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOnested _rhsOoptions _rhsOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule244 _exprIpp _leftIpp _lhsIoptions _rhsIpp arg_nt_ _leftOisDeclOfLet = rule245 () _exprOnested = rule246 _lhsInested _exprOoptions = rule247 _lhsIoptions _exprOoutputfile = rule248 _lhsIoutputfile _leftOnested = rule249 _lhsInested _leftOoptions = rule250 _lhsIoptions _leftOoutputfile = rule251 _lhsIoutputfile _rhsOnested = rule252 _lhsInested _rhsOoptions = rule253 _lhsIoptions _rhsOoutputfile = rule254 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule244 #-} {-# LINE 198 "src-ag/PrintCleanCode.ag" #-} rule244 = \ ((_exprIpp) :: PP_Doc) ((_leftIpp) :: PP_Doc) ((_lhsIoptions) :: Options) ((_rhsIpp) :: PP_Doc) nt_ -> {-# LINE 198 "src-ag/PrintCleanCode.ag" #-} if breadthFirst _lhsIoptions then pp_parens ("resume" >#< pp_parens _exprIpp >-< indent 2 (pp_parens ( "\\" >|< pp_parens ("~" >|< pp_parens (nt_ >|< "_Syn" >#< "_inh_arg")) >#< "->" >-< indent 2 ( "let" >#< _leftIpp >#< "= _inh_arg" >-< indent 2 ("in" >#< _rhsIpp) )))) else pp_parens ( "case" >#< pp_parens _exprIpp >#< "of" >-< ("{" >#< _leftIpp >#< "->") >-< indent 4 (_rhsIpp >#< "}") ) {-# LINE 2241 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule245 #-} {-# LINE 445 "src-ag/PrintCleanCode.ag" #-} rule245 = \ (_ :: ()) -> {-# LINE 445 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 2247 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule246 #-} rule246 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule247 #-} rule247 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule248 #-} rule248 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule249 #-} rule249 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule250 #-} rule250 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule251 #-} rule251 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule252 #-} rule252 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule253 #-} rule253 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule254 #-} rule254 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Expr_SemFun #-} sem_Expr_SemFun :: (String) -> T_Exprs -> T_Expr -> T_Expr sem_Expr_SemFun !arg_nt_ arg_args_ arg_body_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _argsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_args_)) _bodyX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_body_)) (T_Exprs_vOut28 _argsIpps) = inv_Exprs_s29 _argsX29 (T_Exprs_vIn28 _argsOnested _argsOoptions _argsOoutputfile) (T_Expr_vOut25 _bodyIpp) = inv_Expr_s26 _bodyX26 (T_Expr_vIn25 _bodyOnested _bodyOoptions _bodyOoutputfile) _strictParams = rule255 _argsIpps _lhsIoptions _addBang = rule256 _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule257 _addBang _argsIpps _bodyIpp _lhsIoptions _strictParams arg_nt_ _argsOnested = rule258 _lhsInested _argsOoptions = rule259 _lhsIoptions _argsOoutputfile = rule260 _lhsIoutputfile _bodyOnested = rule261 _lhsInested _bodyOoptions = rule262 _lhsIoptions _bodyOoutputfile = rule263 _lhsIoutputfile !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule255 #-} {-# LINE 210 "src-ag/PrintCleanCode.ag" #-} rule255 = \ ((_argsIpps) :: PP_Docs) ((_lhsIoptions) :: Options) -> {-# LINE 210 "src-ag/PrintCleanCode.ag" #-} if strictSems _lhsIoptions then _argsIpps else [] {-# LINE 2306 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule256 #-} {-# LINE 213 "src-ag/PrintCleanCode.ag" #-} rule256 = \ ((_lhsIoptions) :: Options) -> {-# LINE 213 "src-ag/PrintCleanCode.ag" #-} if bangpats _lhsIoptions then \p -> pp_parens ("!" >|< p) else id {-# LINE 2314 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule257 #-} {-# LINE 216 "src-ag/PrintCleanCode.ag" #-} rule257 = \ _addBang ((_argsIpps) :: PP_Docs) ((_bodyIpp) :: PP_Doc) ((_lhsIoptions) :: Options) _strictParams nt_ -> {-# LINE 216 "src-ag/PrintCleanCode.ag" #-} if breadthFirst _lhsIoptions then "Child" >#< pp_parens ( "\\" >|< pp_parens (nt_ >|< "_Inh" >#< ppTuple False (map _addBang _argsIpps)) >#< "->" >-< indent 2 (_strictParams `ppMultiSeqV` _bodyIpp)) else if null _argsIpps then _bodyIpp else pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->" >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp) ) {-# LINE 2329 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule258 #-} rule258 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule259 #-} rule259 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule260 #-} rule260 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule261 #-} rule261 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule262 #-} rule262 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule263 #-} rule263 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile -- Exprs ------------------------------------------------------- -- wrapper data Inh_Exprs = Inh_Exprs { nested_Inh_Exprs :: !(Bool), options_Inh_Exprs :: !(Options), outputfile_Inh_Exprs :: !(String) } data Syn_Exprs = Syn_Exprs { pps_Syn_Exprs :: !(PP_Docs) } {-# INLINABLE wrap_Exprs #-} wrap_Exprs :: T_Exprs -> Inh_Exprs -> (Syn_Exprs ) wrap_Exprs !(T_Exprs act) !(Inh_Exprs _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg28 = T_Exprs_vIn28 _lhsInested _lhsIoptions _lhsIoutputfile !(T_Exprs_vOut28 _lhsOpps) <- return (inv_Exprs_s29 sem arg28) return (Syn_Exprs _lhsOpps) ) -- cata {-# NOINLINE sem_Exprs #-} sem_Exprs :: Exprs -> T_Exprs sem_Exprs list = Prelude.foldr sem_Exprs_Cons sem_Exprs_Nil (Prelude.map sem_Expr list) -- semantic domain newtype T_Exprs = T_Exprs { attach_T_Exprs :: Identity (T_Exprs_s29 ) } newtype T_Exprs_s29 = C_Exprs_s29 { inv_Exprs_s29 :: (T_Exprs_v28 ) } data T_Exprs_s30 = C_Exprs_s30 type T_Exprs_v28 = (T_Exprs_vIn28 ) -> (T_Exprs_vOut28 ) data T_Exprs_vIn28 = T_Exprs_vIn28 (Bool) (Options) (String) data T_Exprs_vOut28 = T_Exprs_vOut28 (PP_Docs) {-# NOINLINE sem_Exprs_Cons #-} sem_Exprs_Cons :: T_Expr -> T_Exprs -> T_Exprs sem_Exprs_Cons arg_hd_ arg_tl_ = T_Exprs (return st29) where {-# NOINLINE st29 #-} !st29 = let v28 :: T_Exprs_v28 v28 = \ !(T_Exprs_vIn28 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _hdX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_hd_)) _tlX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_tl_)) (T_Expr_vOut25 _hdIpp) = inv_Expr_s26 _hdX26 (T_Expr_vIn25 _hdOnested _hdOoptions _hdOoutputfile) (T_Exprs_vOut28 _tlIpps) = inv_Exprs_s29 _tlX29 (T_Exprs_vIn28 _tlOnested _tlOoptions _tlOoutputfile) _lhsOpps :: PP_Docs _lhsOpps = rule264 _hdIpp _tlIpps _hdOnested = rule265 _lhsInested _hdOoptions = rule266 _lhsIoptions _hdOoutputfile = rule267 _lhsIoutputfile _tlOnested = rule268 _lhsInested _tlOoptions = rule269 _lhsIoptions _tlOoutputfile = rule270 _lhsIoutputfile !__result_ = T_Exprs_vOut28 _lhsOpps in __result_ ) in C_Exprs_s29 v28 {-# INLINE rule264 #-} {-# LINE 68 "src-ag/PrintCleanCode.ag" #-} rule264 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 68 "src-ag/PrintCleanCode.ag" #-} _hdIpp : _tlIpps {-# LINE 2406 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule265 #-} rule265 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule266 #-} rule266 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule267 #-} rule267 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# INLINE rule268 #-} rule268 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule269 #-} rule269 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule270 #-} rule270 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Exprs_Nil #-} sem_Exprs_Nil :: T_Exprs sem_Exprs_Nil = T_Exprs (return st29) where {-# NOINLINE st29 #-} !st29 = let v28 :: T_Exprs_v28 v28 = \ !(T_Exprs_vIn28 _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule271 () !__result_ = T_Exprs_vOut28 _lhsOpps in __result_ ) in C_Exprs_s29 v28 {-# INLINE rule271 #-} {-# LINE 69 "src-ag/PrintCleanCode.ag" #-} rule271 = \ (_ :: ()) -> {-# LINE 69 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 2442 "dist/build/PrintCleanCode.hs"#-} -- Lhs --------------------------------------------------------- -- wrapper data Inh_Lhs = Inh_Lhs { isDeclOfLet_Inh_Lhs :: !(Bool), nested_Inh_Lhs :: !(Bool), options_Inh_Lhs :: !(Options), outputfile_Inh_Lhs :: !(String) } data Syn_Lhs = Syn_Lhs { pp_Syn_Lhs :: !(PP_Doc) } {-# INLINABLE wrap_Lhs #-} wrap_Lhs :: T_Lhs -> Inh_Lhs -> (Syn_Lhs ) wrap_Lhs !(T_Lhs act) !(Inh_Lhs _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg31 = T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile !(T_Lhs_vOut31 _lhsOpp) <- return (inv_Lhs_s32 sem arg31) return (Syn_Lhs _lhsOpp) ) -- cata {-# NOINLINE sem_Lhs #-} sem_Lhs :: Lhs -> T_Lhs sem_Lhs ( Pattern3 pat3_ ) = sem_Lhs_Pattern3 ( sem_Pattern pat3_ ) sem_Lhs ( Pattern3SM pat3_ ) = sem_Lhs_Pattern3SM ( sem_Pattern pat3_ ) sem_Lhs ( TupleLhs !comps_ ) = sem_Lhs_TupleLhs comps_ sem_Lhs ( UnboxedTupleLhs !comps_ ) = sem_Lhs_UnboxedTupleLhs comps_ sem_Lhs ( Fun !name_ args_ ) = sem_Lhs_Fun name_ ( sem_Exprs args_ ) sem_Lhs ( Unwrap !name_ sub_ ) = sem_Lhs_Unwrap name_ ( sem_Lhs sub_ ) -- semantic domain newtype T_Lhs = T_Lhs { attach_T_Lhs :: Identity (T_Lhs_s32 ) } newtype T_Lhs_s32 = C_Lhs_s32 { inv_Lhs_s32 :: (T_Lhs_v31 ) } data T_Lhs_s33 = C_Lhs_s33 type T_Lhs_v31 = (T_Lhs_vIn31 ) -> (T_Lhs_vOut31 ) data T_Lhs_vIn31 = T_Lhs_vIn31 (Bool) (Bool) (Options) (String) data T_Lhs_vOut31 = T_Lhs_vOut31 (PP_Doc) {-# NOINLINE sem_Lhs_Pattern3 #-} sem_Lhs_Pattern3 :: T_Pattern -> T_Lhs sem_Lhs_Pattern3 arg_pat3_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _pat3X41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat3_)) (T_Pattern_vOut40 _pat3Icopy _pat3IisUnderscore _pat3Ipp _pat3Ipp' _pat3IstrictVars) = inv_Pattern_s41 _pat3X41 (T_Pattern_vIn40 _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions) _addStrictGuard = rule272 _hasStrictVars _lhsIoptions _strictGuard _strictGuard = rule273 _pat3IstrictVars _hasStrictVars = rule274 _pat3IstrictVars _lhsOpp :: PP_Doc _lhsOpp = rule275 _addStrictGuard _pat3Ipp _pat3ObelowIrrefutable = rule276 () _pat3OisDeclOfLet = rule277 _lhsIisDeclOfLet _pat3Ooptions = rule278 _lhsIoptions !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule272 #-} {-# LINE 248 "src-ag/PrintCleanCode.ag" #-} rule272 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> {-# LINE 248 "src-ag/PrintCleanCode.ag" #-} if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id {-# LINE 2504 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule273 #-} {-# LINE 250 "src-ag/PrintCleanCode.ag" #-} rule273 = \ ((_pat3IstrictVars) :: [PP_Doc]) -> {-# LINE 250 "src-ag/PrintCleanCode.ag" #-} _pat3IstrictVars `ppMultiSeqH` (pp "True") {-# LINE 2510 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule274 #-} {-# LINE 251 "src-ag/PrintCleanCode.ag" #-} rule274 = \ ((_pat3IstrictVars) :: [PP_Doc]) -> {-# LINE 251 "src-ag/PrintCleanCode.ag" #-} not (null _pat3IstrictVars) {-# LINE 2516 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule275 #-} {-# LINE 268 "src-ag/PrintCleanCode.ag" #-} rule275 = \ _addStrictGuard ((_pat3Ipp) :: PP_Doc) -> {-# LINE 268 "src-ag/PrintCleanCode.ag" #-} _addStrictGuard _pat3Ipp {-# LINE 2522 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule276 #-} {-# LINE 406 "src-ag/PrintCleanCode.ag" #-} rule276 = \ (_ :: ()) -> {-# LINE 406 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 2528 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule277 #-} rule277 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule278 #-} rule278 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Lhs_Pattern3SM #-} sem_Lhs_Pattern3SM :: T_Pattern -> T_Lhs sem_Lhs_Pattern3SM arg_pat3_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _pat3X41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat3_)) (T_Pattern_vOut40 _pat3Icopy _pat3IisUnderscore _pat3Ipp _pat3Ipp' _pat3IstrictVars) = inv_Pattern_s41 _pat3X41 (T_Pattern_vIn40 _pat3ObelowIrrefutable _pat3OisDeclOfLet _pat3Ooptions) _lhsOpp :: PP_Doc _lhsOpp = rule279 _pat3Ipp' _pat3ObelowIrrefutable = rule280 () _pat3OisDeclOfLet = rule281 _lhsIisDeclOfLet _pat3Ooptions = rule282 _lhsIoptions !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule279 #-} {-# LINE 269 "src-ag/PrintCleanCode.ag" #-} rule279 = \ ((_pat3Ipp') :: PP_Doc) -> {-# LINE 269 "src-ag/PrintCleanCode.ag" #-} _pat3Ipp' {-# LINE 2557 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule280 #-} {-# LINE 406 "src-ag/PrintCleanCode.ag" #-} rule280 = \ (_ :: ()) -> {-# LINE 406 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 2563 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule281 #-} rule281 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule282 #-} rule282 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Lhs_TupleLhs #-} sem_Lhs_TupleLhs :: ([String]) -> T_Lhs sem_Lhs_TupleLhs !arg_comps_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _addStrictGuard = rule283 _hasStrictVars _lhsIoptions _strictGuard _strictGuard = rule284 _lhsIisDeclOfLet _lhsIoptions arg_comps_ _hasStrictVars = rule285 arg_comps_ _addBang = rule286 _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule287 _addBang _addStrictGuard _lhsInested arg_comps_ !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule283 #-} {-# LINE 248 "src-ag/PrintCleanCode.ag" #-} rule283 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> {-# LINE 248 "src-ag/PrintCleanCode.ag" #-} if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id {-# LINE 2591 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule284 #-} {-# LINE 253 "src-ag/PrintCleanCode.ag" #-} rule284 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) comps_ -> {-# LINE 253 "src-ag/PrintCleanCode.ag" #-} if stricterCases _lhsIoptions && not _lhsIisDeclOfLet then map text comps_ `ppMultiSeqH` (pp "True") else pp "True" {-# LINE 2599 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule285 #-} {-# LINE 256 "src-ag/PrintCleanCode.ag" #-} rule285 = \ comps_ -> {-# LINE 256 "src-ag/PrintCleanCode.ag" #-} not (null comps_) {-# LINE 2605 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule286 #-} {-# LINE 264 "src-ag/PrintCleanCode.ag" #-} rule286 = \ ((_lhsIoptions) :: Options) -> {-# LINE 264 "src-ag/PrintCleanCode.ag" #-} if bangpats _lhsIoptions then \p -> "!" >|< p else id {-# LINE 2613 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule287 #-} {-# LINE 270 "src-ag/PrintCleanCode.ag" #-} rule287 = \ _addBang _addStrictGuard ((_lhsInested) :: Bool) comps_ -> {-# LINE 270 "src-ag/PrintCleanCode.ag" #-} _addStrictGuard $ ppTuple _lhsInested (map (_addBang . text) comps_) {-# LINE 2619 "dist/build/PrintCleanCode.hs"#-} {-# NOINLINE sem_Lhs_UnboxedTupleLhs #-} sem_Lhs_UnboxedTupleLhs :: ([String]) -> T_Lhs sem_Lhs_UnboxedTupleLhs !arg_comps_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _addStrictGuard = rule288 _hasStrictVars _lhsIoptions _strictGuard _strictGuard = rule289 _lhsIisDeclOfLet _lhsIoptions arg_comps_ _hasStrictVars = rule290 arg_comps_ _addBang = rule291 _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule292 _addBang _addStrictGuard _lhsInested arg_comps_ !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule288 #-} {-# LINE 248 "src-ag/PrintCleanCode.ag" #-} rule288 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> {-# LINE 248 "src-ag/PrintCleanCode.ag" #-} if strictCases _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id {-# LINE 2641 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule289 #-} {-# LINE 253 "src-ag/PrintCleanCode.ag" #-} rule289 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) comps_ -> {-# LINE 253 "src-ag/PrintCleanCode.ag" #-} if stricterCases _lhsIoptions && not _lhsIisDeclOfLet then map text comps_ `ppMultiSeqH` (pp "True") else pp "True" {-# LINE 2649 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule290 #-} {-# LINE 256 "src-ag/PrintCleanCode.ag" #-} rule290 = \ comps_ -> {-# LINE 256 "src-ag/PrintCleanCode.ag" #-} not (null comps_) {-# LINE 2655 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule291 #-} {-# LINE 264 "src-ag/PrintCleanCode.ag" #-} rule291 = \ ((_lhsIoptions) :: Options) -> {-# LINE 264 "src-ag/PrintCleanCode.ag" #-} if bangpats _lhsIoptions then \p -> "!" >|< p else id {-# LINE 2663 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule292 #-} {-# LINE 271 "src-ag/PrintCleanCode.ag" #-} rule292 = \ _addBang _addStrictGuard ((_lhsInested) :: Bool) comps_ -> {-# LINE 271 "src-ag/PrintCleanCode.ag" #-} _addStrictGuard $ ppUnboxedTuple _lhsInested (map (_addBang . text) comps_) {-# LINE 2669 "dist/build/PrintCleanCode.hs"#-} {-# NOINLINE sem_Lhs_Fun #-} sem_Lhs_Fun :: (String) -> T_Exprs -> T_Lhs sem_Lhs_Fun !arg_name_ arg_args_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _argsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_args_)) (T_Exprs_vOut28 _argsIpps) = inv_Exprs_s29 _argsX29 (T_Exprs_vIn28 _argsOnested _argsOoptions _argsOoutputfile) _addStrictGuard = rule293 _hasStrictVars _lhsIoptions _strictGuard _hasStrictVars = rule294 _argsIpps _strictGuard = rule295 _argsIpps _addBang = rule296 _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule297 _addBang _addStrictGuard _argsIpps arg_name_ _argsOnested = rule298 _lhsInested _argsOoptions = rule299 _lhsIoptions _argsOoutputfile = rule300 _lhsIoutputfile !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule293 #-} {-# LINE 259 "src-ag/PrintCleanCode.ag" #-} rule293 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> {-# LINE 259 "src-ag/PrintCleanCode.ag" #-} if strictSems _lhsIoptions && _hasStrictVars then \v -> v >#< "|" >#< _strictGuard else id {-# LINE 2696 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule294 #-} {-# LINE 260 "src-ag/PrintCleanCode.ag" #-} rule294 = \ ((_argsIpps) :: PP_Docs) -> {-# LINE 260 "src-ag/PrintCleanCode.ag" #-} not (null _argsIpps) {-# LINE 2702 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule295 #-} {-# LINE 261 "src-ag/PrintCleanCode.ag" #-} rule295 = \ ((_argsIpps) :: PP_Docs) -> {-# LINE 261 "src-ag/PrintCleanCode.ag" #-} _argsIpps `ppMultiSeqH` (pp "True") {-# LINE 2708 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule296 #-} {-# LINE 264 "src-ag/PrintCleanCode.ag" #-} rule296 = \ ((_lhsIoptions) :: Options) -> {-# LINE 264 "src-ag/PrintCleanCode.ag" #-} if bangpats _lhsIoptions then \p -> "!" >|< p else id {-# LINE 2716 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule297 #-} {-# LINE 272 "src-ag/PrintCleanCode.ag" #-} rule297 = \ _addBang _addStrictGuard ((_argsIpps) :: PP_Docs) name_ -> {-# LINE 272 "src-ag/PrintCleanCode.ag" #-} _addStrictGuard (name_ >#< hv_sp (map _addBang _argsIpps)) {-# LINE 2722 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule298 #-} rule298 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule299 #-} rule299 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule300 #-} rule300 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile {-# NOINLINE sem_Lhs_Unwrap #-} sem_Lhs_Unwrap :: (String) -> T_Lhs -> T_Lhs sem_Lhs_Unwrap !arg_name_ arg_sub_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) -> ( let _subX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_sub_)) (T_Lhs_vOut31 _subIpp) = inv_Lhs_s32 _subX32 (T_Lhs_vIn31 _subOisDeclOfLet _subOnested _subOoptions _subOoutputfile) _lhsOpp :: PP_Doc _lhsOpp = rule301 _subIpp arg_name_ _subOisDeclOfLet = rule302 _lhsIisDeclOfLet _subOnested = rule303 _lhsInested _subOoptions = rule304 _lhsIoptions _subOoutputfile = rule305 _lhsIoutputfile !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule301 #-} {-# LINE 273 "src-ag/PrintCleanCode.ag" #-} rule301 = \ ((_subIpp) :: PP_Doc) name_ -> {-# LINE 273 "src-ag/PrintCleanCode.ag" #-} pp_parens (name_ >#< _subIpp) {-# LINE 2755 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule302 #-} rule302 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule303 #-} rule303 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule304 #-} rule304 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule305 #-} rule305 = \ ((_lhsIoutputfile) :: String) -> _lhsIoutputfile -- NamedType --------------------------------------------------- -- wrapper data Inh_NamedType = Inh_NamedType { nested_Inh_NamedType :: !(Bool) } data Syn_NamedType = Syn_NamedType { pp_Syn_NamedType :: !(PP_Doc), ppa_Syn_NamedType :: !(PP_Doc) } {-# INLINABLE wrap_NamedType #-} wrap_NamedType :: T_NamedType -> Inh_NamedType -> (Syn_NamedType ) wrap_NamedType !(T_NamedType act) !(Inh_NamedType _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg34 = T_NamedType_vIn34 _lhsInested !(T_NamedType_vOut34 _lhsOpp _lhsOppa) <- return (inv_NamedType_s35 sem arg34) return (Syn_NamedType _lhsOpp _lhsOppa) ) -- cata {-# INLINE sem_NamedType #-} sem_NamedType :: NamedType -> T_NamedType sem_NamedType ( Named !strict_ !name_ tp_ ) = sem_NamedType_Named strict_ name_ ( sem_Type tp_ ) -- semantic domain newtype T_NamedType = T_NamedType { attach_T_NamedType :: Identity (T_NamedType_s35 ) } newtype T_NamedType_s35 = C_NamedType_s35 { inv_NamedType_s35 :: (T_NamedType_v34 ) } data T_NamedType_s36 = C_NamedType_s36 type T_NamedType_v34 = (T_NamedType_vIn34 ) -> (T_NamedType_vOut34 ) data T_NamedType_vIn34 = T_NamedType_vIn34 (Bool) data T_NamedType_vOut34 = T_NamedType_vOut34 (PP_Doc) (PP_Doc) {-# NOINLINE sem_NamedType_Named #-} sem_NamedType_Named :: (Bool) -> (String) -> T_Type -> T_NamedType sem_NamedType_Named !arg_strict_ !arg_name_ arg_tp_ = T_NamedType (return st35) where {-# NOINLINE st35 #-} !st35 = let v34 :: T_NamedType_v34 v34 = \ !(T_NamedType_vIn34 _lhsInested) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIcopy _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOpp :: PP_Doc _lhsOpp = rule306 _tpIpp arg_strict_ _lhsOppa :: PP_Doc _lhsOppa = rule307 arg_name_ _tpOnested = rule308 _lhsInested !__result_ = T_NamedType_vOut34 _lhsOpp _lhsOppa in __result_ ) in C_NamedType_s35 v34 {-# INLINE rule306 #-} {-# LINE 240 "src-ag/PrintCleanCode.ag" #-} rule306 = \ ((_tpIpp) :: PP_Doc) strict_ -> {-# LINE 240 "src-ag/PrintCleanCode.ag" #-} if strict_ then "!" >|< pp_parens _tpIpp else _tpIpp {-# LINE 2823 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule307 #-} {-# LINE 244 "src-ag/PrintCleanCode.ag" #-} rule307 = \ name_ -> {-# LINE 244 "src-ag/PrintCleanCode.ag" #-} pp name_ {-# LINE 2829 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule308 #-} rule308 = \ ((_lhsInested) :: Bool) -> _lhsInested -- NamedTypes -------------------------------------------------- -- wrapper data Inh_NamedTypes = Inh_NamedTypes { nested_Inh_NamedTypes :: !(Bool) } data Syn_NamedTypes = Syn_NamedTypes { ppas_Syn_NamedTypes :: !(PP_Docs), pps_Syn_NamedTypes :: !(PP_Docs) } {-# INLINABLE wrap_NamedTypes #-} wrap_NamedTypes :: T_NamedTypes -> Inh_NamedTypes -> (Syn_NamedTypes ) wrap_NamedTypes !(T_NamedTypes act) !(Inh_NamedTypes _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg37 = T_NamedTypes_vIn37 _lhsInested !(T_NamedTypes_vOut37 _lhsOppas _lhsOpps) <- return (inv_NamedTypes_s38 sem arg37) return (Syn_NamedTypes _lhsOppas _lhsOpps) ) -- cata {-# NOINLINE sem_NamedTypes #-} sem_NamedTypes :: NamedTypes -> T_NamedTypes sem_NamedTypes list = Prelude.foldr sem_NamedTypes_Cons sem_NamedTypes_Nil (Prelude.map sem_NamedType list) -- semantic domain newtype T_NamedTypes = T_NamedTypes { attach_T_NamedTypes :: Identity (T_NamedTypes_s38 ) } newtype T_NamedTypes_s38 = C_NamedTypes_s38 { inv_NamedTypes_s38 :: (T_NamedTypes_v37 ) } data T_NamedTypes_s39 = C_NamedTypes_s39 type T_NamedTypes_v37 = (T_NamedTypes_vIn37 ) -> (T_NamedTypes_vOut37 ) data T_NamedTypes_vIn37 = T_NamedTypes_vIn37 (Bool) data T_NamedTypes_vOut37 = T_NamedTypes_vOut37 (PP_Docs) (PP_Docs) {-# NOINLINE sem_NamedTypes_Cons #-} sem_NamedTypes_Cons :: T_NamedType -> T_NamedTypes -> T_NamedTypes sem_NamedTypes_Cons arg_hd_ arg_tl_ = T_NamedTypes (return st38) where {-# NOINLINE st38 #-} !st38 = let v37 :: T_NamedTypes_v37 v37 = \ !(T_NamedTypes_vIn37 _lhsInested) -> ( let _hdX35 = Control.Monad.Identity.runIdentity (attach_T_NamedType (arg_hd_)) _tlX38 = Control.Monad.Identity.runIdentity (attach_T_NamedTypes (arg_tl_)) (T_NamedType_vOut34 _hdIpp _hdIppa) = inv_NamedType_s35 _hdX35 (T_NamedType_vIn34 _hdOnested) (T_NamedTypes_vOut37 _tlIppas _tlIpps) = inv_NamedTypes_s38 _tlX38 (T_NamedTypes_vIn37 _tlOnested) _lhsOpps :: PP_Docs _lhsOpps = rule309 _hdIpp _tlIpps _lhsOppas :: PP_Docs _lhsOppas = rule310 _hdIppa _tlIppas _hdOnested = rule311 _lhsInested _tlOnested = rule312 _lhsInested !__result_ = T_NamedTypes_vOut37 _lhsOppas _lhsOpps in __result_ ) in C_NamedTypes_s38 v37 {-# INLINE rule309 #-} {-# LINE 86 "src-ag/PrintCleanCode.ag" #-} rule309 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 86 "src-ag/PrintCleanCode.ag" #-} _hdIpp : _tlIpps {-# LINE 2889 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule310 #-} {-# LINE 87 "src-ag/PrintCleanCode.ag" #-} rule310 = \ ((_hdIppa) :: PP_Doc) ((_tlIppas) :: PP_Docs) -> {-# LINE 87 "src-ag/PrintCleanCode.ag" #-} _hdIppa : _tlIppas {-# LINE 2895 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule311 #-} rule311 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule312 #-} rule312 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_NamedTypes_Nil #-} sem_NamedTypes_Nil :: T_NamedTypes sem_NamedTypes_Nil = T_NamedTypes (return st38) where {-# NOINLINE st38 #-} !st38 = let v37 :: T_NamedTypes_v37 v37 = \ !(T_NamedTypes_vIn37 _lhsInested) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule313 () _lhsOppas :: PP_Docs _lhsOppas = rule314 () !__result_ = T_NamedTypes_vOut37 _lhsOppas _lhsOpps in __result_ ) in C_NamedTypes_s38 v37 {-# INLINE rule313 #-} {-# LINE 88 "src-ag/PrintCleanCode.ag" #-} rule313 = \ (_ :: ()) -> {-# LINE 88 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 2921 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule314 #-} {-# LINE 89 "src-ag/PrintCleanCode.ag" #-} rule314 = \ (_ :: ()) -> {-# LINE 89 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 2927 "dist/build/PrintCleanCode.hs"#-} -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { belowIrrefutable_Inh_Pattern :: !(Bool), isDeclOfLet_Inh_Pattern :: !(Bool), options_Inh_Pattern :: !(Options) } data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: !(Pattern), isUnderscore_Syn_Pattern :: !(Bool), pp_Syn_Pattern :: !(PP_Doc), pp'_Syn_Pattern :: !(PP_Doc), strictVars_Syn_Pattern :: !([PP_Doc]) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern !(T_Pattern act) !(Inh_Pattern _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg40 = T_Pattern_vIn40 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions !(T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars) <- return (inv_Pattern_s41 sem arg40) return (Syn_Pattern _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr !name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product !pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias !field_ !attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore !pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s41 ) } newtype T_Pattern_s41 = C_Pattern_s41 { inv_Pattern_s41 :: (T_Pattern_v40 ) } data T_Pattern_s42 = C_Pattern_s42 type T_Pattern_v40 = (T_Pattern_vIn40 ) -> (T_Pattern_vOut40 ) data T_Pattern_vIn40 = T_Pattern_vIn40 (Bool) (Bool) (Options) data T_Pattern_vOut40 = T_Pattern_vOut40 (Pattern) (Bool) (PP_Doc) (PP_Doc) ([PP_Doc]) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr !arg_name_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} !st41 = let v40 :: T_Pattern_v40 v40 = \ !(T_Pattern_vIn40 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIcopy _patsIpps _patsIpps' _patsIstrictVars) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions) _addBang = rule315 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule316 _addBang _patsIpps arg_name_ _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule317 () _lhsOpp' :: PP_Doc _lhsOpp' = rule318 _patsIpps' arg_name_ _lhsOstrictVars :: [PP_Doc] _lhsOstrictVars = rule319 _patsIstrictVars _copy = rule320 _patsIcopy arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule321 _copy _patsObelowIrrefutable = rule322 _lhsIbelowIrrefutable _patsOisDeclOfLet = rule323 _lhsIisDeclOfLet _patsOoptions = rule324 _lhsIoptions !__result_ = T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule315 #-} {-# LINE 378 "src-ag/PrintCleanCode.ag" #-} rule315 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) -> {-# LINE 378 "src-ag/PrintCleanCode.ag" #-} if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable then \p -> "!" >|< p else id {-# LINE 2997 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule316 #-} {-# LINE 383 "src-ag/PrintCleanCode.ag" #-} rule316 = \ _addBang ((_patsIpps) :: [PP_Doc]) name_ -> {-# LINE 383 "src-ag/PrintCleanCode.ag" #-} _addBang $ pp_parens $ name_ >#< hv_sp _patsIpps {-# LINE 3003 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule317 #-} {-# LINE 394 "src-ag/PrintCleanCode.ag" #-} rule317 = \ (_ :: ()) -> {-# LINE 394 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 3009 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule318 #-} {-# LINE 417 "src-ag/PrintCleanCode.ag" #-} rule318 = \ ((_patsIpps') :: [PP_Doc]) name_ -> {-# LINE 417 "src-ag/PrintCleanCode.ag" #-} pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps') {-# LINE 3015 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule319 #-} rule319 = \ ((_patsIstrictVars) :: [PP_Doc]) -> _patsIstrictVars {-# INLINE rule320 #-} rule320 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule321 #-} rule321 = \ _copy -> _copy {-# INLINE rule322 #-} rule322 = \ ((_lhsIbelowIrrefutable) :: Bool) -> _lhsIbelowIrrefutable {-# INLINE rule323 #-} rule323 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule324 #-} rule324 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product !arg_pos_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} !st41 = let v40 :: T_Pattern_v40 v40 = \ !(T_Pattern_vIn40 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIcopy _patsIpps _patsIpps' _patsIstrictVars) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 _patsObelowIrrefutable _patsOisDeclOfLet _patsOoptions) _addBang = rule325 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule326 _addBang _patsIpps _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule327 () _lhsOpp' :: PP_Doc _lhsOpp' = rule328 _patsIpps' _lhsOstrictVars :: [PP_Doc] _lhsOstrictVars = rule329 _patsIstrictVars _copy = rule330 _patsIcopy arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule331 _copy _patsObelowIrrefutable = rule332 _lhsIbelowIrrefutable _patsOisDeclOfLet = rule333 _lhsIisDeclOfLet _patsOoptions = rule334 _lhsIoptions !__result_ = T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule325 #-} {-# LINE 378 "src-ag/PrintCleanCode.ag" #-} rule325 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) -> {-# LINE 378 "src-ag/PrintCleanCode.ag" #-} if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable then \p -> "!" >|< p else id {-# LINE 3068 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule326 #-} {-# LINE 384 "src-ag/PrintCleanCode.ag" #-} rule326 = \ _addBang ((_patsIpps) :: [PP_Doc]) -> {-# LINE 384 "src-ag/PrintCleanCode.ag" #-} _addBang $ pp_block "(" ")" "," _patsIpps {-# LINE 3074 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule327 #-} {-# LINE 395 "src-ag/PrintCleanCode.ag" #-} rule327 = \ (_ :: ()) -> {-# LINE 395 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 3080 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule328 #-} {-# LINE 418 "src-ag/PrintCleanCode.ag" #-} rule328 = \ ((_patsIpps') :: [PP_Doc]) -> {-# LINE 418 "src-ag/PrintCleanCode.ag" #-} pp_block "(" ")" "," _patsIpps' {-# LINE 3086 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule329 #-} rule329 = \ ((_patsIstrictVars) :: [PP_Doc]) -> _patsIstrictVars {-# INLINE rule330 #-} rule330 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule331 #-} rule331 = \ _copy -> _copy {-# INLINE rule332 #-} rule332 = \ ((_lhsIbelowIrrefutable) :: Bool) -> _lhsIbelowIrrefutable {-# INLINE rule333 #-} rule333 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule334 #-} rule334 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias !arg_field_ !arg_attr_ arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} !st41 = let v40 :: T_Pattern_v40 v40 = \ !(T_Pattern_vIn40 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIcopy _patIisUnderscore _patIpp _patIpp' _patIstrictVars) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 _patObelowIrrefutable _patOisDeclOfLet _patOoptions) _strictVar = rule335 _lhsIisDeclOfLet _lhsIoptions _ppVar _strictPatVars = rule336 _lhsIisDeclOfLet _lhsIoptions _patIstrictVars _lhsOstrictVars :: [PP_Doc] _lhsOstrictVars = rule337 _strictPatVars _strictVar _addBang = rule338 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions _ppVar = rule339 _lhsIoptions arg_attr_ arg_field_ _ppVarBang = rule340 _addBang _ppVar _lhsOpp :: PP_Doc _lhsOpp = rule341 _patIisUnderscore _patIpp _ppVarBang _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule342 () _lhsOpp' :: PP_Doc _lhsOpp' = rule343 _lhsIoptions _patIpp' arg_attr_ arg_field_ _copy = rule344 _patIcopy arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule345 _copy _patObelowIrrefutable = rule346 _lhsIbelowIrrefutable _patOisDeclOfLet = rule347 _lhsIisDeclOfLet _patOoptions = rule348 _lhsIoptions !__result_ = T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule335 #-} {-# LINE 356 "src-ag/PrintCleanCode.ag" #-} rule335 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) _ppVar -> {-# LINE 356 "src-ag/PrintCleanCode.ag" #-} if strictCases _lhsIoptions && not _lhsIisDeclOfLet then [_ppVar ] else [] {-# LINE 3143 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule336 #-} {-# LINE 360 "src-ag/PrintCleanCode.ag" #-} rule336 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) ((_patIstrictVars) :: [PP_Doc]) -> {-# LINE 360 "src-ag/PrintCleanCode.ag" #-} if stricterCases _lhsIoptions && not _lhsIisDeclOfLet then _patIstrictVars else [] {-# LINE 3151 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule337 #-} {-# LINE 364 "src-ag/PrintCleanCode.ag" #-} rule337 = \ _strictPatVars _strictVar -> {-# LINE 364 "src-ag/PrintCleanCode.ag" #-} _strictVar ++ _strictPatVars {-# LINE 3157 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule338 #-} {-# LINE 378 "src-ag/PrintCleanCode.ag" #-} rule338 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) -> {-# LINE 378 "src-ag/PrintCleanCode.ag" #-} if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable then \p -> "!" >|< p else id {-# LINE 3165 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule339 #-} {-# LINE 385 "src-ag/PrintCleanCode.ag" #-} rule339 = \ ((_lhsIoptions) :: Options) attr_ field_ -> {-# LINE 385 "src-ag/PrintCleanCode.ag" #-} pp (attrname _lhsIoptions False field_ attr_) {-# LINE 3171 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule340 #-} {-# LINE 386 "src-ag/PrintCleanCode.ag" #-} rule340 = \ _addBang _ppVar -> {-# LINE 386 "src-ag/PrintCleanCode.ag" #-} _addBang $ _ppVar {-# LINE 3177 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule341 #-} {-# LINE 387 "src-ag/PrintCleanCode.ag" #-} rule341 = \ ((_patIisUnderscore) :: Bool) ((_patIpp) :: PP_Doc) _ppVarBang -> {-# LINE 387 "src-ag/PrintCleanCode.ag" #-} if _patIisUnderscore then _ppVarBang else _ppVarBang >|< "@" >|< _patIpp {-# LINE 3185 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule342 #-} {-# LINE 396 "src-ag/PrintCleanCode.ag" #-} rule342 = \ (_ :: ()) -> {-# LINE 396 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 3191 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule343 #-} {-# LINE 419 "src-ag/PrintCleanCode.ag" #-} rule343 = \ ((_lhsIoptions) :: Options) ((_patIpp') :: PP_Doc) attr_ field_ -> {-# LINE 419 "src-ag/PrintCleanCode.ag" #-} let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_ | otherwise = attrname _lhsIoptions False field_ attr_ in attribute >|< "@" >|< _patIpp' {-# LINE 3199 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule344 #-} rule344 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule345 #-} rule345 = \ _copy -> _copy {-# INLINE rule346 #-} rule346 = \ ((_lhsIbelowIrrefutable) :: Bool) -> _lhsIbelowIrrefutable {-# INLINE rule347 #-} rule347 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule348 #-} rule348 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} !st41 = let v40 :: T_Pattern_v40 v40 = \ !(T_Pattern_vIn40 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIcopy _patIisUnderscore _patIpp _patIpp' _patIstrictVars) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 _patObelowIrrefutable _patOisDeclOfLet _patOoptions) _lhsOstrictVars :: [PP_Doc] _lhsOstrictVars = rule349 () _lhsOpp :: PP_Doc _lhsOpp = rule350 _patIpp _patObelowIrrefutable = rule351 () _lhsOpp' :: PP_Doc _lhsOpp' = rule352 _patIpp _copy = rule353 _patIcopy _lhsOcopy :: Pattern _lhsOcopy = rule354 _copy _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule355 _patIisUnderscore _patOisDeclOfLet = rule356 _lhsIisDeclOfLet _patOoptions = rule357 _lhsIoptions !__result_ = T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule349 #-} {-# LINE 366 "src-ag/PrintCleanCode.ag" #-} rule349 = \ (_ :: ()) -> {-# LINE 366 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 3246 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule350 #-} {-# LINE 390 "src-ag/PrintCleanCode.ag" #-} rule350 = \ ((_patIpp) :: PP_Doc) -> {-# LINE 390 "src-ag/PrintCleanCode.ag" #-} text "~" >|< pp_parens _patIpp {-# LINE 3252 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule351 #-} {-# LINE 402 "src-ag/PrintCleanCode.ag" #-} rule351 = \ (_ :: ()) -> {-# LINE 402 "src-ag/PrintCleanCode.ag" #-} True {-# LINE 3258 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule352 #-} {-# LINE 422 "src-ag/PrintCleanCode.ag" #-} rule352 = \ ((_patIpp) :: PP_Doc) -> {-# LINE 422 "src-ag/PrintCleanCode.ag" #-} text "~" >|< pp_parens _patIpp {-# LINE 3264 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule353 #-} rule353 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule354 #-} rule354 = \ _copy -> _copy {-# INLINE rule355 #-} rule355 = \ ((_patIisUnderscore) :: Bool) -> _patIisUnderscore {-# INLINE rule356 #-} rule356 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule357 #-} rule357 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore !arg_pos_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} !st41 = let v40 :: T_Pattern_v40 v40 = \ !(T_Pattern_vIn40 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule358 () _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule359 () _lhsOpp' :: PP_Doc _lhsOpp' = rule360 () _lhsOstrictVars :: [PP_Doc] _lhsOstrictVars = rule361 () _copy = rule362 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule363 _copy !__result_ = T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule358 #-} {-# LINE 391 "src-ag/PrintCleanCode.ag" #-} rule358 = \ (_ :: ()) -> {-# LINE 391 "src-ag/PrintCleanCode.ag" #-} text "_" {-# LINE 3306 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule359 #-} {-# LINE 397 "src-ag/PrintCleanCode.ag" #-} rule359 = \ (_ :: ()) -> {-# LINE 397 "src-ag/PrintCleanCode.ag" #-} True {-# LINE 3312 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule360 #-} {-# LINE 423 "src-ag/PrintCleanCode.ag" #-} rule360 = \ (_ :: ()) -> {-# LINE 423 "src-ag/PrintCleanCode.ag" #-} text "_" {-# LINE 3318 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule361 #-} rule361 = \ (_ :: ()) -> [] {-# INLINE rule362 #-} rule362 = \ pos_ -> Underscore pos_ {-# INLINE rule363 #-} rule363 = \ _copy -> _copy -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { belowIrrefutable_Inh_Patterns :: !(Bool), isDeclOfLet_Inh_Patterns :: !(Bool), options_Inh_Patterns :: !(Options) } data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: !(Patterns), pps_Syn_Patterns :: !([PP_Doc]), pps'_Syn_Patterns :: !([PP_Doc]), strictVars_Syn_Patterns :: !([PP_Doc]) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns !(T_Patterns act) !(Inh_Patterns _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg43 = T_Patterns_vIn43 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions !(T_Patterns_vOut43 _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars) <- return (inv_Patterns_s44 sem arg43) return (Syn_Patterns _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s44 ) } newtype T_Patterns_s44 = C_Patterns_s44 { inv_Patterns_s44 :: (T_Patterns_v43 ) } data T_Patterns_s45 = C_Patterns_s45 type T_Patterns_v43 = (T_Patterns_vIn43 ) -> (T_Patterns_vOut43 ) data T_Patterns_vIn43 = T_Patterns_vIn43 (Bool) (Bool) (Options) data T_Patterns_vOut43 = T_Patterns_vOut43 (Patterns) ([PP_Doc]) ([PP_Doc]) ([PP_Doc]) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st44) where {-# NOINLINE st44 #-} !st44 = let v43 :: T_Patterns_v43 v43 = \ !(T_Patterns_vIn43 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) -> ( let _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut40 _hdIcopy _hdIisUnderscore _hdIpp _hdIpp' _hdIstrictVars) = inv_Pattern_s41 _hdX41 (T_Pattern_vIn40 _hdObelowIrrefutable _hdOisDeclOfLet _hdOoptions) (T_Patterns_vOut43 _tlIcopy _tlIpps _tlIpps' _tlIstrictVars) = inv_Patterns_s44 _tlX44 (T_Patterns_vIn43 _tlObelowIrrefutable _tlOisDeclOfLet _tlOoptions) _lhsOpps :: [PP_Doc] _lhsOpps = rule364 _hdIpp _tlIpps _lhsOpps' :: [PP_Doc] _lhsOpps' = rule365 _hdIpp' _tlIpps' _lhsOstrictVars :: [PP_Doc] _lhsOstrictVars = rule366 _hdIstrictVars _tlIstrictVars _copy = rule367 _hdIcopy _tlIcopy _lhsOcopy :: Patterns _lhsOcopy = rule368 _copy _hdObelowIrrefutable = rule369 _lhsIbelowIrrefutable _hdOisDeclOfLet = rule370 _lhsIisDeclOfLet _hdOoptions = rule371 _lhsIoptions _tlObelowIrrefutable = rule372 _lhsIbelowIrrefutable _tlOisDeclOfLet = rule373 _lhsIisDeclOfLet _tlOoptions = rule374 _lhsIoptions !__result_ = T_Patterns_vOut43 _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule364 #-} {-# LINE 373 "src-ag/PrintCleanCode.ag" #-} rule364 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: [PP_Doc]) -> {-# LINE 373 "src-ag/PrintCleanCode.ag" #-} _hdIpp : _tlIpps {-# LINE 3393 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule365 #-} {-# LINE 413 "src-ag/PrintCleanCode.ag" #-} rule365 = \ ((_hdIpp') :: PP_Doc) ((_tlIpps') :: [PP_Doc]) -> {-# LINE 413 "src-ag/PrintCleanCode.ag" #-} _hdIpp' : _tlIpps' {-# LINE 3399 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule366 #-} rule366 = \ ((_hdIstrictVars) :: [PP_Doc]) ((_tlIstrictVars) :: [PP_Doc]) -> _hdIstrictVars ++ _tlIstrictVars {-# INLINE rule367 #-} rule367 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule368 #-} rule368 = \ _copy -> _copy {-# INLINE rule369 #-} rule369 = \ ((_lhsIbelowIrrefutable) :: Bool) -> _lhsIbelowIrrefutable {-# INLINE rule370 #-} rule370 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule371 #-} rule371 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule372 #-} rule372 = \ ((_lhsIbelowIrrefutable) :: Bool) -> _lhsIbelowIrrefutable {-# INLINE rule373 #-} rule373 = \ ((_lhsIisDeclOfLet) :: Bool) -> _lhsIisDeclOfLet {-# INLINE rule374 #-} rule374 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st44) where {-# NOINLINE st44 #-} !st44 = let v43 :: T_Patterns_v43 v43 = \ !(T_Patterns_vIn43 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) -> ( let _lhsOpps :: [PP_Doc] _lhsOpps = rule375 () _lhsOpps' :: [PP_Doc] _lhsOpps' = rule376 () _lhsOstrictVars :: [PP_Doc] _lhsOstrictVars = rule377 () _copy = rule378 () _lhsOcopy :: Patterns _lhsOcopy = rule379 _copy !__result_ = T_Patterns_vOut43 _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule375 #-} {-# LINE 374 "src-ag/PrintCleanCode.ag" #-} rule375 = \ (_ :: ()) -> {-# LINE 374 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 3451 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule376 #-} {-# LINE 414 "src-ag/PrintCleanCode.ag" #-} rule376 = \ (_ :: ()) -> {-# LINE 414 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 3457 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule377 #-} rule377 = \ (_ :: ()) -> [] {-# INLINE rule378 #-} rule378 = \ (_ :: ()) -> [] {-# INLINE rule379 #-} rule379 = \ _copy -> _copy -- Program ----------------------------------------------------- -- wrapper data Inh_Program = Inh_Program { importBlocks_Inh_Program :: !(PP_Doc), mainBlocksDoc_Inh_Program :: !(PP_Doc), mainFile_Inh_Program :: !(String), mainName_Inh_Program :: !(String), moduleHeader_Inh_Program :: !(String -> String -> String -> Bool -> String), options_Inh_Program :: !(Options), optionsLine_Inh_Program :: !(String), pragmaBlocks_Inh_Program :: !(String), textBlockMap_Inh_Program :: !(Map BlockInfo PP_Doc), textBlocks_Inh_Program :: !(PP_Doc) } data Syn_Program = Syn_Program { genIO_Syn_Program :: !(IO ()), output_Syn_Program :: !(PP_Docs) } {-# INLINABLE wrap_Program #-} wrap_Program :: T_Program -> Inh_Program -> (Syn_Program ) wrap_Program !(T_Program act) !(Inh_Program _lhsIimportBlocks _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg46 = T_Program_vIn46 _lhsIimportBlocks _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks !(T_Program_vOut46 _lhsOgenIO _lhsOoutput) <- return (inv_Program_s47 sem arg46) return (Syn_Program _lhsOgenIO _lhsOoutput) ) -- cata {-# INLINE sem_Program #-} sem_Program :: Program -> T_Program sem_Program ( Program chunks_ !ordered_ ) = sem_Program_Program ( sem_Chunks chunks_ ) ordered_ -- semantic domain newtype T_Program = T_Program { attach_T_Program :: Identity (T_Program_s47 ) } newtype T_Program_s47 = C_Program_s47 { inv_Program_s47 :: (T_Program_v46 ) } data T_Program_s48 = C_Program_s48 type T_Program_v46 = (T_Program_vIn46 ) -> (T_Program_vOut46 ) data T_Program_vIn46 = T_Program_vIn46 (PP_Doc) (PP_Doc) (String) (String) (String -> String -> String -> Bool -> String) (Options) (String) (String) (Map BlockInfo PP_Doc) (PP_Doc) data T_Program_vOut46 = T_Program_vOut46 (IO ()) (PP_Docs) {-# NOINLINE sem_Program_Program #-} sem_Program_Program :: T_Chunks -> (Bool) -> T_Program sem_Program_Program arg_chunks_ !arg_ordered_ = T_Program (return st47) where {-# NOINLINE st47 #-} !st47 = let v46 :: T_Program_v46 v46 = \ !(T_Program_vIn46 _lhsIimportBlocks _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks) -> ( let _chunksX11 = Control.Monad.Identity.runIdentity (attach_T_Chunks (arg_chunks_)) (T_Chunks_vOut10 _chunksIappendCommon _chunksIappendMain _chunksIgenSems _chunksIimports _chunksIpps) = inv_Chunks_s11 _chunksX11 (T_Chunks_vIn10 _chunksOimportBlocks _chunksOisDeclOfLet _chunksOmainFile _chunksOmainName _chunksOmoduleHeader _chunksOnested _chunksOoptions _chunksOoptionsLine _chunksOpragmaBlocks _chunksOtextBlockMap _chunksOtextBlocks) _options = rule380 _lhsIoptions arg_ordered_ _chunksOnested = rule381 _lhsIoptions _lhsOoutput :: PP_Docs _lhsOoutput = rule382 _chunksIpps _chunksOisDeclOfLet = rule383 () _mainModuleFile = rule384 _lhsImainFile _genMainModule = rule385 _chunksIappendMain _chunksIimports _lhsImainBlocksDoc _lhsImainName _lhsImoduleHeader _lhsIoptionsLine _lhsIpragmaBlocks _mainModuleFile _commonFile = rule386 _lhsImainFile _genCommonModule = rule387 _chunksIappendCommon _commonFile _lhsIimportBlocks _lhsImainName _lhsImoduleHeader _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlocks _lhsOgenIO :: IO () _lhsOgenIO = rule388 _chunksIgenSems _genCommonModule _genMainModule _chunksOimportBlocks = rule389 _lhsIimportBlocks _chunksOmainFile = rule390 _lhsImainFile _chunksOmainName = rule391 _lhsImainName _chunksOmoduleHeader = rule392 _lhsImoduleHeader _chunksOoptions = rule393 _options _chunksOoptionsLine = rule394 _lhsIoptionsLine _chunksOpragmaBlocks = rule395 _lhsIpragmaBlocks _chunksOtextBlockMap = rule396 _lhsItextBlockMap _chunksOtextBlocks = rule397 _lhsItextBlocks !__result_ = T_Program_vOut46 _lhsOgenIO _lhsOoutput in __result_ ) in C_Program_s47 v46 {-# INLINE rule380 #-} {-# LINE 62 "src-ag/PrintCleanCode.ag" #-} rule380 = \ ((_lhsIoptions) :: Options) ordered_ -> {-# LINE 62 "src-ag/PrintCleanCode.ag" #-} _lhsIoptions { breadthFirst = breadthFirst _lhsIoptions && visit _lhsIoptions && cases _lhsIoptions && ordered_ } {-# LINE 3535 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule381 #-} {-# LINE 65 "src-ag/PrintCleanCode.ag" #-} rule381 = \ ((_lhsIoptions) :: Options) -> {-# LINE 65 "src-ag/PrintCleanCode.ag" #-} nest _lhsIoptions {-# LINE 3541 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule382 #-} {-# LINE 101 "src-ag/PrintCleanCode.ag" #-} rule382 = \ ((_chunksIpps) :: PP_Docs) -> {-# LINE 101 "src-ag/PrintCleanCode.ag" #-} _chunksIpps {-# LINE 3547 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule383 #-} {-# LINE 437 "src-ag/PrintCleanCode.ag" #-} rule383 = \ (_ :: ()) -> {-# LINE 437 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 3553 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule384 #-} {-# LINE 471 "src-ag/PrintCleanCode.ag" #-} rule384 = \ ((_lhsImainFile) :: String) -> {-# LINE 471 "src-ag/PrintCleanCode.ag" #-} _lhsImainFile {-# LINE 3559 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule385 #-} {-# LINE 473 "src-ag/PrintCleanCode.ag" #-} rule385 = \ ((_chunksIappendMain) :: [[PP_Doc]]) ((_chunksIimports) :: [String]) ((_lhsImainBlocksDoc) :: PP_Doc) ((_lhsImainName) :: String) ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIoptionsLine) :: String) ((_lhsIpragmaBlocks) :: String) _mainModuleFile -> {-# LINE 473 "src-ag/PrintCleanCode.ag" #-} writeModule _mainModuleFile ( [ pp $ _lhsIpragmaBlocks , pp $ _lhsIoptionsLine , pp $ _lhsImoduleHeader _lhsImainName "" "" False , pp $ ("import " ++ _lhsImainName ++ "_common\n") ] ++ map pp _chunksIimports ++ map vlist _chunksIappendMain ++ [_lhsImainBlocksDoc] ) {-# LINE 3574 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule386 #-} {-# LINE 484 "src-ag/PrintCleanCode.ag" #-} rule386 = \ ((_lhsImainFile) :: String) -> {-# LINE 484 "src-ag/PrintCleanCode.ag" #-} replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ "_common") {-# LINE 3580 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule387 #-} {-# LINE 486 "src-ag/PrintCleanCode.ag" #-} rule387 = \ ((_chunksIappendCommon) :: [[PP_Doc]]) _commonFile ((_lhsIimportBlocks) :: PP_Doc) ((_lhsImainName) :: String) ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIoptionsLine) :: String) ((_lhsIpragmaBlocks) :: String) ((_lhsItextBlocks) :: PP_Doc) -> {-# LINE 486 "src-ag/PrintCleanCode.ag" #-} writeModule _commonFile ( [ pp $ _lhsIpragmaBlocks , pp $ _lhsIoptionsLine , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True , _lhsIimportBlocks , _lhsItextBlocks ] ++ map vlist _chunksIappendCommon ) {-# LINE 3594 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule388 #-} {-# LINE 496 "src-ag/PrintCleanCode.ag" #-} rule388 = \ ((_chunksIgenSems) :: IO ()) _genCommonModule _genMainModule -> {-# LINE 496 "src-ag/PrintCleanCode.ag" #-} do _genMainModule _genCommonModule _chunksIgenSems {-# LINE 3602 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule389 #-} rule389 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule390 #-} rule390 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule391 #-} rule391 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule392 #-} rule392 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule393 #-} rule393 = \ _options -> _options {-# INLINE rule394 #-} rule394 = \ ((_lhsIoptionsLine) :: String) -> _lhsIoptionsLine {-# INLINE rule395 #-} rule395 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule396 #-} rule396 = \ ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) -> _lhsItextBlockMap {-# INLINE rule397 #-} rule397 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks -- Type -------------------------------------------------------- -- wrapper data Inh_Type = Inh_Type { nested_Inh_Type :: !(Bool) } data Syn_Type = Syn_Type { copy_Syn_Type :: !(Type), pp_Syn_Type :: !(PP_Doc), prec_Syn_Type :: !(Int) } {-# INLINABLE wrap_Type #-} wrap_Type :: T_Type -> Inh_Type -> (Syn_Type ) wrap_Type !(T_Type act) !(Inh_Type _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg49 = T_Type_vIn49 _lhsInested !(T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec) <- return (inv_Type_s50 sem arg49) return (Syn_Type _lhsOcopy _lhsOpp _lhsOprec) ) -- cata {-# NOINLINE sem_Type #-} sem_Type :: Type -> T_Type sem_Type ( Arr left_ right_ ) = sem_Type_Arr ( sem_Type left_ ) ( sem_Type right_ ) sem_Type ( CtxApp !left_ right_ ) = sem_Type_CtxApp left_ ( sem_Type right_ ) sem_Type ( QuantApp !left_ right_ ) = sem_Type_QuantApp left_ ( sem_Type right_ ) sem_Type ( TypeApp func_ args_ ) = sem_Type_TypeApp ( sem_Type func_ ) ( sem_Types args_ ) sem_Type ( TupleType tps_ ) = sem_Type_TupleType ( sem_Types tps_ ) sem_Type ( UnboxedTupleType tps_ ) = sem_Type_UnboxedTupleType ( sem_Types tps_ ) sem_Type ( List tp_ ) = sem_Type_List ( sem_Type tp_ ) sem_Type ( SimpleType !txt_ ) = sem_Type_SimpleType txt_ sem_Type ( NontermType !name_ !params_ !deforested_ ) = sem_Type_NontermType name_ params_ deforested_ sem_Type ( TMaybe tp_ ) = sem_Type_TMaybe ( sem_Type tp_ ) sem_Type ( TEither left_ right_ ) = sem_Type_TEither ( sem_Type left_ ) ( sem_Type right_ ) sem_Type ( TMap key_ value_ ) = sem_Type_TMap ( sem_Type key_ ) ( sem_Type value_ ) sem_Type ( TIntMap value_ ) = sem_Type_TIntMap ( sem_Type value_ ) sem_Type ( TSet tp_ ) = sem_Type_TSet ( sem_Type tp_ ) sem_Type ( TIntSet ) = sem_Type_TIntSet -- semantic domain newtype T_Type = T_Type { attach_T_Type :: Identity (T_Type_s50 ) } newtype T_Type_s50 = C_Type_s50 { inv_Type_s50 :: (T_Type_v49 ) } data T_Type_s51 = C_Type_s51 type T_Type_v49 = (T_Type_vIn49 ) -> (T_Type_vOut49 ) data T_Type_vIn49 = T_Type_vIn49 (Bool) data T_Type_vOut49 = T_Type_vOut49 (Type) (PP_Doc) (Int) {-# NOINLINE sem_Type_Arr #-} sem_Type_Arr :: T_Type -> T_Type -> T_Type sem_Type_Arr arg_left_ arg_right_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _leftX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_left_)) _rightX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_right_)) (T_Type_vOut49 _leftIcopy _leftIpp _leftIprec) = inv_Type_s50 _leftX50 (T_Type_vIn49 _leftOnested) (T_Type_vOut49 _rightIcopy _rightIpp _rightIprec) = inv_Type_s50 _rightX50 (T_Type_vIn49 _rightOnested) _lhsOprec :: Int _lhsOprec = rule398 () _lhsOpp :: PP_Doc _lhsOpp = rule399 _l _r _rightIcopy _l = rule400 _leftIpp _leftIprec _r = rule401 _rightIpp _rightIprec _copy = rule402 _leftIcopy _rightIcopy _lhsOcopy :: Type _lhsOcopy = rule403 _copy _leftOnested = rule404 _lhsInested _rightOnested = rule405 _lhsInested !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule398 #-} {-# LINE 276 "src-ag/PrintCleanCode.ag" #-} rule398 = \ (_ :: ()) -> {-# LINE 276 "src-ag/PrintCleanCode.ag" #-} 2 {-# LINE 3705 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule399 #-} {-# LINE 277 "src-ag/PrintCleanCode.ag" #-} rule399 = \ _l _r ((_rightIcopy) :: Type) -> {-# LINE 277 "src-ag/PrintCleanCode.ag" #-} case _rightIcopy of Arr{} -> _l >-< _r _ -> _l >#< "->" >-< _r {-# LINE 3713 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule400 #-} {-# LINE 280 "src-ag/PrintCleanCode.ag" #-} rule400 = \ ((_leftIpp) :: PP_Doc) ((_leftIprec) :: Int) -> {-# LINE 280 "src-ag/PrintCleanCode.ag" #-} if _leftIprec <= 2 then pp_parens _leftIpp else _leftIpp {-# LINE 3719 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule401 #-} {-# LINE 281 "src-ag/PrintCleanCode.ag" #-} rule401 = \ ((_rightIpp) :: PP_Doc) ((_rightIprec) :: Int) -> {-# LINE 281 "src-ag/PrintCleanCode.ag" #-} if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp {-# LINE 3725 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule402 #-} rule402 = \ ((_leftIcopy) :: Type) ((_rightIcopy) :: Type) -> Arr _leftIcopy _rightIcopy {-# INLINE rule403 #-} rule403 = \ _copy -> _copy {-# INLINE rule404 #-} rule404 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule405 #-} rule405 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_CtxApp #-} sem_Type_CtxApp :: ([(String, [String])]) -> T_Type -> T_Type sem_Type_CtxApp !arg_left_ arg_right_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _rightX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_right_)) (T_Type_vOut49 _rightIcopy _rightIpp _rightIprec) = inv_Type_s50 _rightX50 (T_Type_vIn49 _rightOnested) _lhsOpp :: PP_Doc _lhsOpp = rule406 _rightIpp arg_left_ _copy = rule407 _rightIcopy arg_left_ _lhsOcopy :: Type _lhsOcopy = rule408 _copy _lhsOprec :: Int _lhsOprec = rule409 _rightIprec _rightOnested = rule410 _lhsInested !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule406 #-} {-# LINE 287 "src-ag/PrintCleanCode.ag" #-} rule406 = \ ((_rightIpp) :: PP_Doc) left_ -> {-# LINE 287 "src-ag/PrintCleanCode.ag" #-} _rightIpp >#< " | " >#< (pp_block "" "" "&" $ map (\(n,ns) -> hv_sp $ map pp (n:ns)) left_) {-# LINE 3763 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule407 #-} rule407 = \ ((_rightIcopy) :: Type) left_ -> CtxApp left_ _rightIcopy {-# INLINE rule408 #-} rule408 = \ _copy -> _copy {-# INLINE rule409 #-} rule409 = \ ((_rightIprec) :: Int) -> _rightIprec {-# INLINE rule410 #-} rule410 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_QuantApp #-} sem_Type_QuantApp :: (String) -> T_Type -> T_Type sem_Type_QuantApp !arg_left_ arg_right_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _rightX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_right_)) (T_Type_vOut49 _rightIcopy _rightIpp _rightIprec) = inv_Type_s50 _rightX50 (T_Type_vIn49 _rightOnested) _lhsOpp :: PP_Doc _lhsOpp = rule411 _rightIpp arg_left_ _copy = rule412 _rightIcopy arg_left_ _lhsOcopy :: Type _lhsOcopy = rule413 _copy _lhsOprec :: Int _lhsOprec = rule414 _rightIprec _rightOnested = rule415 _lhsInested !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule411 #-} {-# LINE 289 "src-ag/PrintCleanCode.ag" #-} rule411 = \ ((_rightIpp) :: PP_Doc) left_ -> {-# LINE 289 "src-ag/PrintCleanCode.ag" #-} left_ >#< _rightIpp {-# LINE 3801 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule412 #-} rule412 = \ ((_rightIcopy) :: Type) left_ -> QuantApp left_ _rightIcopy {-# INLINE rule413 #-} rule413 = \ _copy -> _copy {-# INLINE rule414 #-} rule414 = \ ((_rightIprec) :: Int) -> _rightIprec {-# INLINE rule415 #-} rule415 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_TypeApp #-} sem_Type_TypeApp :: T_Type -> T_Types -> T_Type sem_Type_TypeApp arg_func_ arg_args_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _funcX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_func_)) _argsX53 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_args_)) (T_Type_vOut49 _funcIcopy _funcIpp _funcIprec) = inv_Type_s50 _funcX50 (T_Type_vIn49 _funcOnested) (T_Types_vOut52 _argsIcopy _argsIpps) = inv_Types_s53 _argsX53 (T_Types_vIn52 _argsOnested) _lhsOpp :: PP_Doc _lhsOpp = rule416 _argsIpps _funcIpp _copy = rule417 _argsIcopy _funcIcopy _lhsOcopy :: Type _lhsOcopy = rule418 _copy _lhsOprec :: Int _lhsOprec = rule419 _funcIprec _funcOnested = rule420 _lhsInested _argsOnested = rule421 _lhsInested !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule416 #-} {-# LINE 284 "src-ag/PrintCleanCode.ag" #-} rule416 = \ ((_argsIpps) :: PP_Docs) ((_funcIpp) :: PP_Doc) -> {-# LINE 284 "src-ag/PrintCleanCode.ag" #-} pp "(" >#< hv_sp (_funcIpp : _argsIpps) >#< pp ")" {-# LINE 3842 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule417 #-} rule417 = \ ((_argsIcopy) :: Types) ((_funcIcopy) :: Type) -> TypeApp _funcIcopy _argsIcopy {-# INLINE rule418 #-} rule418 = \ _copy -> _copy {-# INLINE rule419 #-} rule419 = \ ((_funcIprec) :: Int) -> _funcIprec {-# INLINE rule420 #-} rule420 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule421 #-} rule421 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_TupleType #-} sem_Type_TupleType :: T_Types -> T_Type sem_Type_TupleType arg_tps_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _tpsX53 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tps_)) (T_Types_vOut52 _tpsIcopy _tpsIpps) = inv_Types_s53 _tpsX53 (T_Types_vIn52 _tpsOnested) _lhsOprec :: Int _lhsOprec = rule422 () _lhsOpp :: PP_Doc _lhsOpp = rule423 _lhsInested _tpsIpps _copy = rule424 _tpsIcopy _lhsOcopy :: Type _lhsOcopy = rule425 _copy _tpsOnested = rule426 _lhsInested !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule422 #-} {-# LINE 291 "src-ag/PrintCleanCode.ag" #-} rule422 = \ (_ :: ()) -> {-# LINE 291 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 3883 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule423 #-} {-# LINE 292 "src-ag/PrintCleanCode.ag" #-} rule423 = \ ((_lhsInested) :: Bool) ((_tpsIpps) :: PP_Docs) -> {-# LINE 292 "src-ag/PrintCleanCode.ag" #-} ppTuple _lhsInested _tpsIpps {-# LINE 3889 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule424 #-} rule424 = \ ((_tpsIcopy) :: Types) -> TupleType _tpsIcopy {-# INLINE rule425 #-} rule425 = \ _copy -> _copy {-# INLINE rule426 #-} rule426 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_UnboxedTupleType #-} sem_Type_UnboxedTupleType :: T_Types -> T_Type sem_Type_UnboxedTupleType arg_tps_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _tpsX53 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tps_)) (T_Types_vOut52 _tpsIcopy _tpsIpps) = inv_Types_s53 _tpsX53 (T_Types_vIn52 _tpsOnested) _lhsOprec :: Int _lhsOprec = rule427 () _lhsOpp :: PP_Doc _lhsOpp = rule428 _lhsInested _tpsIpps _copy = rule429 _tpsIcopy _lhsOcopy :: Type _lhsOcopy = rule430 _copy _tpsOnested = rule431 _lhsInested !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule427 #-} {-# LINE 294 "src-ag/PrintCleanCode.ag" #-} rule427 = \ (_ :: ()) -> {-# LINE 294 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 3924 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule428 #-} {-# LINE 295 "src-ag/PrintCleanCode.ag" #-} rule428 = \ ((_lhsInested) :: Bool) ((_tpsIpps) :: PP_Docs) -> {-# LINE 295 "src-ag/PrintCleanCode.ag" #-} ppUnboxedTuple _lhsInested _tpsIpps {-# LINE 3930 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule429 #-} rule429 = \ ((_tpsIcopy) :: Types) -> UnboxedTupleType _tpsIcopy {-# INLINE rule430 #-} rule430 = \ _copy -> _copy {-# INLINE rule431 #-} rule431 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_List #-} sem_Type_List :: T_Type -> T_Type sem_Type_List arg_tp_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIcopy _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOprec :: Int _lhsOprec = rule432 () _lhsOpp :: PP_Doc _lhsOpp = rule433 _tpIpp _copy = rule434 _tpIcopy _lhsOcopy :: Type _lhsOcopy = rule435 _copy _tpOnested = rule436 _lhsInested !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule432 #-} {-# LINE 297 "src-ag/PrintCleanCode.ag" #-} rule432 = \ (_ :: ()) -> {-# LINE 297 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 3965 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule433 #-} {-# LINE 298 "src-ag/PrintCleanCode.ag" #-} rule433 = \ ((_tpIpp) :: PP_Doc) -> {-# LINE 298 "src-ag/PrintCleanCode.ag" #-} "[" >|< _tpIpp >|< "]" {-# LINE 3971 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule434 #-} rule434 = \ ((_tpIcopy) :: Type) -> List _tpIcopy {-# INLINE rule435 #-} rule435 = \ _copy -> _copy {-# INLINE rule436 #-} rule436 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_SimpleType #-} sem_Type_SimpleType :: (String) -> T_Type sem_Type_SimpleType !arg_txt_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _lhsOprec :: Int _lhsOprec = rule437 () _lhsOpp :: PP_Doc _lhsOpp = rule438 arg_txt_ _copy = rule439 arg_txt_ _lhsOcopy :: Type _lhsOcopy = rule440 _copy !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule437 #-} {-# LINE 300 "src-ag/PrintCleanCode.ag" #-} rule437 = \ (_ :: ()) -> {-# LINE 300 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4003 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule438 #-} {-# LINE 301 "src-ag/PrintCleanCode.ag" #-} rule438 = \ txt_ -> {-# LINE 301 "src-ag/PrintCleanCode.ag" #-} if reallySimple txt_ then text txt_ else pp_parens (text txt_) {-# LINE 4009 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule439 #-} rule439 = \ txt_ -> SimpleType txt_ {-# INLINE rule440 #-} rule440 = \ _copy -> _copy {-# NOINLINE sem_Type_NontermType #-} sem_Type_NontermType :: (String) -> ([String]) -> (Bool) -> T_Type sem_Type_NontermType !arg_name_ !arg_params_ !arg_deforested_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _lhsOprec :: Int _lhsOprec = rule441 () _lhsOpp :: PP_Doc _lhsOpp = rule442 _prefix arg_name_ arg_params_ _prefix = rule443 arg_deforested_ _copy = rule444 arg_deforested_ arg_name_ arg_params_ _lhsOcopy :: Type _lhsOcopy = rule445 _copy !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule441 #-} {-# LINE 303 "src-ag/PrintCleanCode.ag" #-} rule441 = \ (_ :: ()) -> {-# LINE 303 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4039 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule442 #-} {-# LINE 304 "src-ag/PrintCleanCode.ag" #-} rule442 = \ _prefix name_ params_ -> {-# LINE 304 "src-ag/PrintCleanCode.ag" #-} _prefix >|< text name_ >#< hv_sp params_ {-# LINE 4045 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule443 #-} {-# LINE 305 "src-ag/PrintCleanCode.ag" #-} rule443 = \ deforested_ -> {-# LINE 305 "src-ag/PrintCleanCode.ag" #-} if deforested_ then text "T_" else empty {-# LINE 4053 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule444 #-} rule444 = \ deforested_ name_ params_ -> NontermType name_ params_ deforested_ {-# INLINE rule445 #-} rule445 = \ _copy -> _copy {-# NOINLINE sem_Type_TMaybe #-} sem_Type_TMaybe :: T_Type -> T_Type sem_Type_TMaybe arg_tp_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIcopy _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOprec :: Int _lhsOprec = rule446 () _lhsOpp :: PP_Doc _lhsOpp = rule447 _tpIpp _copy = rule448 _tpIcopy _lhsOcopy :: Type _lhsOcopy = rule449 _copy _tpOnested = rule450 _lhsInested !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule446 #-} {-# LINE 308 "src-ag/PrintCleanCode.ag" #-} rule446 = \ (_ :: ()) -> {-# LINE 308 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4085 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule447 #-} {-# LINE 309 "src-ag/PrintCleanCode.ag" #-} rule447 = \ ((_tpIpp) :: PP_Doc) -> {-# LINE 309 "src-ag/PrintCleanCode.ag" #-} text "Maybe" >#< pp_parens _tpIpp {-# LINE 4091 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule448 #-} rule448 = \ ((_tpIcopy) :: Type) -> TMaybe _tpIcopy {-# INLINE rule449 #-} rule449 = \ _copy -> _copy {-# INLINE rule450 #-} rule450 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_TEither #-} sem_Type_TEither :: T_Type -> T_Type -> T_Type sem_Type_TEither arg_left_ arg_right_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _leftX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_left_)) _rightX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_right_)) (T_Type_vOut49 _leftIcopy _leftIpp _leftIprec) = inv_Type_s50 _leftX50 (T_Type_vIn49 _leftOnested) (T_Type_vOut49 _rightIcopy _rightIpp _rightIprec) = inv_Type_s50 _rightX50 (T_Type_vIn49 _rightOnested) _lhsOprec :: Int _lhsOprec = rule451 () _lhsOpp :: PP_Doc _lhsOpp = rule452 _leftIpp _rightIpp _copy = rule453 _leftIcopy _rightIcopy _lhsOcopy :: Type _lhsOcopy = rule454 _copy _leftOnested = rule455 _lhsInested _rightOnested = rule456 _lhsInested !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule451 #-} {-# LINE 310 "src-ag/PrintCleanCode.ag" #-} rule451 = \ (_ :: ()) -> {-# LINE 310 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4129 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule452 #-} {-# LINE 311 "src-ag/PrintCleanCode.ag" #-} rule452 = \ ((_leftIpp) :: PP_Doc) ((_rightIpp) :: PP_Doc) -> {-# LINE 311 "src-ag/PrintCleanCode.ag" #-} text "Either" >#< pp_parens _leftIpp >#< pp_parens _rightIpp {-# LINE 4135 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule453 #-} rule453 = \ ((_leftIcopy) :: Type) ((_rightIcopy) :: Type) -> TEither _leftIcopy _rightIcopy {-# INLINE rule454 #-} rule454 = \ _copy -> _copy {-# INLINE rule455 #-} rule455 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule456 #-} rule456 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_TMap #-} sem_Type_TMap :: T_Type -> T_Type -> T_Type sem_Type_TMap arg_key_ arg_value_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _keyX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_key_)) _valueX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_value_)) (T_Type_vOut49 _keyIcopy _keyIpp _keyIprec) = inv_Type_s50 _keyX50 (T_Type_vIn49 _keyOnested) (T_Type_vOut49 _valueIcopy _valueIpp _valueIprec) = inv_Type_s50 _valueX50 (T_Type_vIn49 _valueOnested) _lhsOprec :: Int _lhsOprec = rule457 () _lhsOpp :: PP_Doc _lhsOpp = rule458 _keyIpp _valueIpp _copy = rule459 _keyIcopy _valueIcopy _lhsOcopy :: Type _lhsOcopy = rule460 _copy _keyOnested = rule461 _lhsInested _valueOnested = rule462 _lhsInested !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule457 #-} {-# LINE 312 "src-ag/PrintCleanCode.ag" #-} rule457 = \ (_ :: ()) -> {-# LINE 312 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4176 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule458 #-} {-# LINE 313 "src-ag/PrintCleanCode.ag" #-} rule458 = \ ((_keyIpp) :: PP_Doc) ((_valueIpp) :: PP_Doc) -> {-# LINE 313 "src-ag/PrintCleanCode.ag" #-} text "'Data.Map'.Map" >#< pp_parens _keyIpp >#< pp_parens _valueIpp {-# LINE 4182 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule459 #-} rule459 = \ ((_keyIcopy) :: Type) ((_valueIcopy) :: Type) -> TMap _keyIcopy _valueIcopy {-# INLINE rule460 #-} rule460 = \ _copy -> _copy {-# INLINE rule461 #-} rule461 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule462 #-} rule462 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_TIntMap #-} sem_Type_TIntMap :: T_Type -> T_Type sem_Type_TIntMap arg_value_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _valueX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_value_)) (T_Type_vOut49 _valueIcopy _valueIpp _valueIprec) = inv_Type_s50 _valueX50 (T_Type_vIn49 _valueOnested) _lhsOprec :: Int _lhsOprec = rule463 () _lhsOpp :: PP_Doc _lhsOpp = rule464 _valueIpp _copy = rule465 _valueIcopy _lhsOcopy :: Type _lhsOcopy = rule466 _copy _valueOnested = rule467 _lhsInested !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule463 #-} {-# LINE 314 "src-ag/PrintCleanCode.ag" #-} rule463 = \ (_ :: ()) -> {-# LINE 314 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4220 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule464 #-} {-# LINE 315 "src-ag/PrintCleanCode.ag" #-} rule464 = \ ((_valueIpp) :: PP_Doc) -> {-# LINE 315 "src-ag/PrintCleanCode.ag" #-} text "'Data.IntMap'.IntMap" >#< pp_parens _valueIpp {-# LINE 4226 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule465 #-} rule465 = \ ((_valueIcopy) :: Type) -> TIntMap _valueIcopy {-# INLINE rule466 #-} rule466 = \ _copy -> _copy {-# INLINE rule467 #-} rule467 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_TSet #-} sem_Type_TSet :: T_Type -> T_Type sem_Type_TSet arg_tp_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIcopy _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested) _lhsOprec :: Int _lhsOprec = rule468 () _lhsOpp :: PP_Doc _lhsOpp = rule469 _tpIpp _copy = rule470 _tpIcopy _lhsOcopy :: Type _lhsOcopy = rule471 _copy _tpOnested = rule472 _lhsInested !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule468 #-} {-# LINE 316 "src-ag/PrintCleanCode.ag" #-} rule468 = \ (_ :: ()) -> {-# LINE 316 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4261 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule469 #-} {-# LINE 317 "src-ag/PrintCleanCode.ag" #-} rule469 = \ ((_tpIpp) :: PP_Doc) -> {-# LINE 317 "src-ag/PrintCleanCode.ag" #-} text "'Data.Set'.Set" >#< pp_parens _tpIpp {-# LINE 4267 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule470 #-} rule470 = \ ((_tpIcopy) :: Type) -> TSet _tpIcopy {-# INLINE rule471 #-} rule471 = \ _copy -> _copy {-# INLINE rule472 #-} rule472 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Type_TIntSet #-} sem_Type_TIntSet :: T_Type sem_Type_TIntSet = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let _lhsOprec :: Int _lhsOprec = rule473 () _lhsOpp :: PP_Doc _lhsOpp = rule474 () _copy = rule475 () _lhsOcopy :: Type _lhsOcopy = rule476 _copy !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec in __result_ ) in C_Type_s50 v49 {-# INLINE rule473 #-} {-# LINE 318 "src-ag/PrintCleanCode.ag" #-} rule473 = \ (_ :: ()) -> {-# LINE 318 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4299 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule474 #-} {-# LINE 319 "src-ag/PrintCleanCode.ag" #-} rule474 = \ (_ :: ()) -> {-# LINE 319 "src-ag/PrintCleanCode.ag" #-} text "'Data.IntSet'.IntSet" {-# LINE 4305 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule475 #-} rule475 = \ (_ :: ()) -> TIntSet {-# INLINE rule476 #-} rule476 = \ _copy -> _copy -- Types ------------------------------------------------------- -- wrapper data Inh_Types = Inh_Types { nested_Inh_Types :: !(Bool) } data Syn_Types = Syn_Types { copy_Syn_Types :: !(Types), pps_Syn_Types :: !(PP_Docs) } {-# INLINABLE wrap_Types #-} wrap_Types :: T_Types -> Inh_Types -> (Syn_Types ) wrap_Types !(T_Types act) !(Inh_Types _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg52 = T_Types_vIn52 _lhsInested !(T_Types_vOut52 _lhsOcopy _lhsOpps) <- return (inv_Types_s53 sem arg52) return (Syn_Types _lhsOcopy _lhsOpps) ) -- cata {-# NOINLINE sem_Types #-} sem_Types :: Types -> T_Types sem_Types list = Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list) -- semantic domain newtype T_Types = T_Types { attach_T_Types :: Identity (T_Types_s53 ) } newtype T_Types_s53 = C_Types_s53 { inv_Types_s53 :: (T_Types_v52 ) } data T_Types_s54 = C_Types_s54 type T_Types_v52 = (T_Types_vIn52 ) -> (T_Types_vOut52 ) data T_Types_vIn52 = T_Types_vIn52 (Bool) data T_Types_vOut52 = T_Types_vOut52 (Types) (PP_Docs) {-# NOINLINE sem_Types_Cons #-} sem_Types_Cons :: T_Type -> T_Types -> T_Types sem_Types_Cons arg_hd_ arg_tl_ = T_Types (return st53) where {-# NOINLINE st53 #-} !st53 = let v52 :: T_Types_v52 v52 = \ !(T_Types_vIn52 _lhsInested) -> ( let _hdX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_hd_)) _tlX53 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tl_)) (T_Type_vOut49 _hdIcopy _hdIpp _hdIprec) = inv_Type_s50 _hdX50 (T_Type_vIn49 _hdOnested) (T_Types_vOut52 _tlIcopy _tlIpps) = inv_Types_s53 _tlX53 (T_Types_vIn52 _tlOnested) _lhsOpps :: PP_Docs _lhsOpps = rule477 _hdIpp _tlIpps _copy = rule478 _hdIcopy _tlIcopy _lhsOcopy :: Types _lhsOcopy = rule479 _copy _hdOnested = rule480 _lhsInested _tlOnested = rule481 _lhsInested !__result_ = T_Types_vOut52 _lhsOcopy _lhsOpps in __result_ ) in C_Types_s53 v52 {-# INLINE rule477 #-} {-# LINE 82 "src-ag/PrintCleanCode.ag" #-} rule477 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 82 "src-ag/PrintCleanCode.ag" #-} _hdIpp : _tlIpps {-# LINE 4369 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule478 #-} rule478 = \ ((_hdIcopy) :: Type) ((_tlIcopy) :: Types) -> (:) _hdIcopy _tlIcopy {-# INLINE rule479 #-} rule479 = \ _copy -> _copy {-# INLINE rule480 #-} rule480 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# INLINE rule481 #-} rule481 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Types_Nil #-} sem_Types_Nil :: T_Types sem_Types_Nil = T_Types (return st53) where {-# NOINLINE st53 #-} !st53 = let v52 :: T_Types_v52 v52 = \ !(T_Types_vIn52 _lhsInested) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule482 () _copy = rule483 () _lhsOcopy :: Types _lhsOcopy = rule484 _copy !__result_ = T_Types_vOut52 _lhsOcopy _lhsOpps in __result_ ) in C_Types_s53 v52 {-# INLINE rule482 #-} {-# LINE 83 "src-ag/PrintCleanCode.ag" #-} rule482 = \ (_ :: ()) -> {-# LINE 83 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 4402 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule483 #-} rule483 = \ (_ :: ()) -> [] {-# INLINE rule484 #-} rule484 = \ _copy -> _copy uuagc-0.9.52.2/src-generated/CodeSyntax.hs0000644000000000000000000001330113433540502016376 0ustar0000000000000000 -- UUAGC 0.9.51 (src-ag/CodeSyntax.ag) module CodeSyntax where {-# LINE 2 "src-ag/CodeSyntax.ag" #-} import Patterns import CommonTypes import Data.Map(Map) import Data.Set(Set) {-# LINE 12 "dist/build/CodeSyntax.hs" #-} -- CGrammar ---------------------------------------------------- {- alternatives: alternative CGrammar: child typeSyns : {TypeSyns} child derivings : {Derivings} child wrappers : {Set NontermIdent} child nonts : CNonterminals child pragmas : {PragmaMap} child paramMap : {ParamMap} child contextMap : {ContextMap} child quantMap : {QuantMap} child aroundsMap : {Map NontermIdent (Map ConstructorIdent (Set Identifier))} child mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))} child multivisit : {Bool} -} data CGrammar = CGrammar (TypeSyns) (Derivings) ((Set NontermIdent)) (CNonterminals) (PragmaMap) (ParamMap) (ContextMap) (QuantMap) ((Map NontermIdent (Map ConstructorIdent (Set Identifier)))) ((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))))) (Bool) -- CInterface -------------------------------------------------- {- alternatives: alternative CInterface: child seg : CSegments -} data CInterface = CInterface (CSegments) -- CNonterminal ------------------------------------------------ {- alternatives: alternative CNonterminal: child nt : {NontermIdent} child params : {[Identifier]} child inh : {Attributes} child syn : {Attributes} child prods : CProductions child inter : CInterface -} data CNonterminal = CNonterminal (NontermIdent) (([Identifier])) (Attributes) (Attributes) (CProductions) (CInterface) -- CNonterminals ----------------------------------------------- {- alternatives: alternative Cons: child hd : CNonterminal child tl : CNonterminals alternative Nil: -} type CNonterminals = [CNonterminal] -- CProduction ------------------------------------------------- {- alternatives: alternative CProduction: child con : {ConstructorIdent} child visits : CVisits child children : {[(Identifier,Type,ChildKind)]} child terminals : {[Identifier]} -} data CProduction = CProduction (ConstructorIdent) (CVisits) (([(Identifier,Type,ChildKind)])) (([Identifier])) -- CProductions ------------------------------------------------ {- alternatives: alternative Cons: child hd : CProduction child tl : CProductions alternative Nil: -} type CProductions = [CProduction] -- CRule ------------------------------------------------------- {- alternatives: alternative CRule: child name : {Identifier} child isIn : {Bool} child hasCode : {Bool} child nt : {NontermIdent} child con : {ConstructorIdent} child field : {Identifier} child childnt : {Maybe NontermIdent} child tp : {Maybe Type} child pattern : {Pattern} child rhs : {[String]} child defines : {Map Int (Identifier,Identifier,Maybe Type)} child owrt : {Bool} child origin : {String} child uses : {Set (Identifier, Identifier)} child explicit : {Bool} child mbNamed : {Maybe Identifier} alternative CChildVisit: child name : {Identifier} child nt : {NontermIdent} child nr : {Int} child inh : {Attributes} child syn : {Attributes} child isLast : {Bool} -} data CRule = CRule (Identifier) (Bool) (Bool) (NontermIdent) (ConstructorIdent) (Identifier) ((Maybe NontermIdent)) ((Maybe Type)) (Pattern) (([String])) ((Map Int (Identifier,Identifier,Maybe Type))) (Bool) (String) ((Set (Identifier, Identifier))) (Bool) ((Maybe Identifier)) | CChildVisit (Identifier) (NontermIdent) (Int) (Attributes) (Attributes) (Bool) -- CSegment ---------------------------------------------------- {- alternatives: alternative CSegment: child inh : {Attributes} child syn : {Attributes} -} data CSegment = CSegment (Attributes) (Attributes) -- CSegments --------------------------------------------------- {- alternatives: alternative Cons: child hd : CSegment child tl : CSegments alternative Nil: -} type CSegments = [CSegment] -- CVisit ------------------------------------------------------ {- alternatives: alternative CVisit: child inh : {Attributes} child syn : {Attributes} child vss : Sequence child intra : Sequence child ordered : {Bool} -} data CVisit = CVisit (Attributes) (Attributes) (Sequence) (Sequence) (Bool) -- CVisits ----------------------------------------------------- {- alternatives: alternative Cons: child hd : CVisit child tl : CVisits alternative Nil: -} type CVisits = [CVisit] -- Sequence ---------------------------------------------------- {- alternatives: alternative Cons: child hd : CRule child tl : Sequence alternative Nil: -} type Sequence = [CRule]uuagc-0.9.52.2/src-generated/ExecutionPlan2Hs.hs0000644000000000000000000146024613433540502017467 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module ExecutionPlan2Hs where {-# LINE 2 "src-ag/HsToken.ag" #-} import CommonTypes import UU.Scanner.Position(Pos) {-# LINE 10 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 2 "src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken {-# LINE 16 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 23 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 2 "src-ag/ExecutionPlan.ag" #-} -- VisitSyntax.ag imports import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import CommonTypes import ErrorMessages import qualified Data.Set as Set import Data.Set(Set) import qualified Data.Map as Map import Data.Map(Map) {-# LINE 37 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 7 "src-ag/ExecutionPlan2Hs.ag" #-} import ExecutionPlan import Pretty import PPUtil import Options import Data.Monoid(mappend,mempty) import Data.Maybe import Debug.Trace import System.IO import System.Directory import System.FilePath import UU.Scanner.Position import TokenDef import HsToken import ErrorMessages import Data.Set (Set) import qualified Data.Set as Set import Data.Map (Map) import qualified Data.Map as Map import Data.Sequence(Seq) import qualified Data.Sequence as Seq import Data.Foldable(toList) {-# LINE 64 "dist/build/ExecutionPlan2Hs.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 163 "src-ag/ExecutionPlan2Hs.ag" #-} classCtxsToDocs :: ClassContext -> [PP_Doc] classCtxsToDocs = map toDoc where toDoc (ident,args) = (ident >#< ppSpaced (map pp_parens args)) classConstrsToDocs :: [Type] -> [PP_Doc] classConstrsToDocs = map ppTp ppClasses :: [PP_Doc] -> PP_Doc ppClasses [] = empty ppClasses xs = pp_block "(" ")" "," xs >#< "=>" ppQuants :: [Identifier] -> PP_Doc ppQuants [] = empty ppQuants ps = "forall" >#< ppSpaced ps >#< "." {-# LINE 83 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 192 "src-ag/ExecutionPlan2Hs.ag" #-} -- first parameter indicates: generate a record or not ppConFields :: Bool -> [PP_Doc] -> PP_Doc ppConFields True flds = ppListSep "{" "}" ", " $ filter (not . isEmpty) flds ppConFields False flds = ppSpaced flds {-# LINE 91 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 218 "src-ag/ExecutionPlan2Hs.ag" #-} ppTp :: Type -> PP_Doc ppTp = text . typeToHaskellString Nothing [] {-# LINE 97 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 332 "src-ag/ExecutionPlan2Hs.ag" #-} type VisitStateState = (VisitIdentifier,StateIdentifier, StateIdentifier) {-# LINE 101 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 428 "src-ag/ExecutionPlan2Hs.ag" #-} conNmTVisit nt vId = "T_" >|< nt >|< "_v" >|< vId conNmTVisitIn nt vId = "T_" >|< nt >|< "_vIn" >|< vId conNmTVisitOut nt vId = "T_" >|< nt >|< "_vOut" >|< vId conNmTNextVisit nt stId = "T_" >|< nt >|< "_s" >|< stId ppMonadType :: Options -> PP_Doc ppMonadType opts | parallelInvoke opts = text "IO" | otherwise = text "Identity" {-# LINE 114 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 589 "src-ag/ExecutionPlan2Hs.ag" #-} ppDefor :: Type -> PP_Doc ppDefor (NT nt args _) = "T_" >|< nt >#< ppSpaced (map pp_parens args) ppDefor (Haskell s) = text s {-# LINE 121 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 713 "src-ag/ExecutionPlan2Hs.ag" #-} mklet :: (PP a, PP b, PP c) => a -> b -> c -> PP_Doc mklet prefix defs body = prefix >#< "let" >-< indent 3 defs >-< indent 2 "in" >#< body {-# LINE 130 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 779 "src-ag/ExecutionPlan2Hs.ag" #-} resultValName :: String resultValName = "__result_" nextStName :: String nextStName = "__st_" {-# LINE 139 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 850 "src-ag/ExecutionPlan2Hs.ag" #-} parResultName :: String parResultName = "__outcome_" fmtDecl :: PP a => Bool -> FormatMode -> a -> PP_Doc fmtDecl declPure fmt decl = case fmt of FormatLetDecl -> pp decl FormatLetLine -> "let" >#< decl >#< "in" FormatDo | declPure -> "let" >#< decl | otherwise -> pp decl {-# LINE 152 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 976 "src-ag/ExecutionPlan2Hs.ag" #-} stname :: Identifier -> Int -> String stname child st = "_" ++ getName child ++ "X" ++ show st -- should actually return some conversion info compatibleAttach :: VisitKind -> NontermIdent -> Options -> Bool compatibleAttach _ _ _ = True unMon :: Options -> PP_Doc unMon options | parallelInvoke options = text "System.IO.Unsafe.unsafePerformIO" -- IO monad | otherwise = text "Control.Monad.Identity.runIdentity" -- identity monad {-# LINE 167 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 1084 "src-ag/ExecutionPlan2Hs.ag" #-} dummyPat :: Options -> Bool -> PP_Doc dummyPat opts noArgs | not noArgs && tupleAsDummyToken opts = empty -- no unnecessary tuples | tupleAsDummyToken opts = if strictDummyToken opts then text "()" else text "(_ :: ())" | otherwise = let match | strictDummyToken opts = "!_" | otherwise = "_" in pp_parens (match >#< "::" >#< dummyType opts noArgs) where match | strictDummyToken opts = "(!_)" | otherwise = "_" dummyArg :: Options -> Bool -> PP_Doc dummyArg opts noArgs | not noArgs && tupleAsDummyToken opts = empty -- no unnecessary tuples | tupleAsDummyToken opts = text "()" | otherwise = text "GHC.Prim.realWorld#" dummyType :: Options -> Bool -> PP_Doc dummyType opts noArgs | not noArgs && tupleAsDummyToken opts = empty -- no unnecessary tuples | tupleAsDummyToken opts = text "()" | otherwise = text "(GHC.Prim.State# GHC.Prim.RealWorld)" {-# LINE 194 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 1110 "src-ag/ExecutionPlan2Hs.ag" #-} -- rules are "deinlined" to prevent needless code duplication. -- if there is only a bit of duplication, we allow ghc to decide if it is worth it. -- if the duplication crosses this threshold, however, we tell ghc definitely not to inline it. ruleInlineThresholdSoft :: Int ruleInlineThresholdSoft = 3 ruleInlineThresholdHard :: Int ruleInlineThresholdHard = 5 reallyOftenUsedThreshold :: Int reallyOftenUsedThreshold = 12 {-# LINE 209 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 1176 "src-ag/ExecutionPlan2Hs.ag" #-} data NonLocalAttr = AttrInh Identifier Identifier | AttrSyn Identifier Identifier deriving Show mkNonLocalAttr :: Bool -> Identifier -> Identifier -> NonLocalAttr mkNonLocalAttr True = AttrInh -- True: inherited attr mkNonLocalAttr False = AttrSyn lookupAttrType :: NonLocalAttr -> Map Identifier Attributes -> Map Identifier Attributes -> Map Identifier Type -> Maybe PP_Doc lookupAttrType (AttrInh child name) inhs _ = lookupType child name inhs lookupAttrType (AttrSyn child name) _ syns = lookupType child name syns -- Note: if the child takes type parameters, the type of an attribute of this child may refer to these parameters. This means that -- the actual type of the attribute needs to have its type parameters substituted with the actual type argument of the child. -- However, for now we simply decide to return Nothing in this case, which skips the type annotation. lookupType :: Identifier -> Identifier -> Map Identifier Attributes -> Map Identifier Type -> Maybe PP_Doc lookupType child name attrMp childMp | noParameters childTp = Just ppDoc | otherwise = Nothing where attrTp = Map.findWithDefault (error "lookupType: the attribute is not in the attrs of the child") name childAttrs childAttrs = Map.findWithDefault (error "lookupType: the attributes of the nonterm are not in the map") nonterm attrMp nonterm = extractNonterminal childTp childTp = Map.findWithDefault (error ("lookupType: the child " ++ show child ++ "is not in the appropriate map")) child childMp ppDoc = ppTp attrTp noParameters :: Type -> Bool noParameters (Haskell _) = True noParameters (NT _ args _) = null args {-# LINE 242 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 1263 "src-ag/ExecutionPlan2Hs.ag" #-} -- a `compatibleKind` b means: can kind b be invoked from a compatibleKind :: VisitKind -> VisitKind -> Bool compatibleKind _ _ = True compatibleRule :: VisitKind -> Bool -> Bool compatibleRule (VisitPure _) False = False compatibleRule _ _ = True {-# LINE 253 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 1285 "src-ag/ExecutionPlan2Hs.ag" #-} unionWithSum = Map.unionWith (+) {-# LINE 258 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 1308 "src-ag/ExecutionPlan2Hs.ag" #-} uwSetUnion :: (Ord a, Ord b) => Map a (Set b) -> Map a (Set b) -> Map a (Set b) uwSetUnion = Map.unionWith Set.union uwMapUnion :: (Ord a, Ord b) => Map a (Map b c) -> Map a (Map b c) -> Map a (Map b c) uwMapUnion = Map.unionWith Map.union {-# LINE 267 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 1525 "src-ag/ExecutionPlan2Hs.ag" #-} renderDocs :: [PP_Doc] -> String renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) "" writeModule :: FilePath -> [PP_Doc] -> IO () writeModule path docs = do bExists <- doesFileExist path if bExists then do input <- readFile path seq (length input) (return ()) if input /= output then dumpIt else return () else dumpIt where output = renderDocs docs dumpIt = writeFile path output {-# LINE 287 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 1672 "src-ag/ExecutionPlan2Hs.ag" #-} ppNoInline :: PP a => a -> PP_Doc ppNoInline = ppPragmaBinding "NOINLINE" ppInline :: PP a => a -> PP_Doc ppInline = ppPragmaBinding "INLINE" ppInlinable :: PP a => a -> PP_Doc ppInlinable = ppPragmaBinding "INLINABLE" ppPragmaBinding :: (PP a, PP b) => a -> b -> PP_Doc ppPragmaBinding pragma nm = "{-#" >#< pragma >#< nm >#< "#-}" ppCostCentre :: PP a => a -> PP_Doc ppCostCentre nm = "{-#" >#< "SCC" >#< "\"" >|< nm >|< "\"" >#< "#-}" warrenFlagsPP :: Options -> PP_Doc warrenFlagsPP options = vlist [ pp "{-# LANGUAGE Rank2Types, GADTs #-}" , if bangpats options then pp "{-# LANGUAGE BangPatterns #-}" else empty , if noPerRuleTypeSigs options && noPerStateTypeSigs options then empty else pp "{-# LANGUAGE ScopedTypeVariables #-}" , if tupleAsDummyToken options then empty else pp "{-# LANGUAGE ScopedTypeVariables, MagicHash #-}" , -- not that the meaning of "unbox" is here that strict fields in data types may be -- unboxed if possible. This may affect user-defined data types declared in the module. -- Unfortunately, we cannot turn it on for only the AG generated data types without -- causing a zillion of warnings. if unbox options && bangpats options then pp $ "{-# OPTIONS_GHC -funbox-strict-fields -fstrictness #-}" else empty , if parallelInvoke options && not (noEagerBlackholing options) then pp $ "{-# OPTIONS_GHC -feager-blackholing #-}" else empty ] {-# LINE 329 "dist/build/ExecutionPlan2Hs.hs" #-} -- EChild ------------------------------------------------------ -- wrapper data Inh_EChild = Inh_EChild { allInitStates_Inh_EChild :: (Map NontermIdent Int), con_Inh_EChild :: (ConstructorIdent), importBlocks_Inh_EChild :: (PP_Doc), mainFile_Inh_EChild :: (String), mainName_Inh_EChild :: (String), moduleHeader_Inh_EChild :: (String -> String -> String -> Bool -> String), nt_Inh_EChild :: (NontermIdent), options_Inh_EChild :: (Options), pragmaBlocks_Inh_EChild :: (String), textBlocks_Inh_EChild :: (PP_Doc) } data Syn_EChild = Syn_EChild { argnamesw_Syn_EChild :: ( PP_Doc ), argpats_Syn_EChild :: ( PP_Doc ), argtps_Syn_EChild :: ( PP_Doc ), childTypes_Syn_EChild :: (Map Identifier Type), childintros_Syn_EChild :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), datatype_Syn_EChild :: (PP_Doc), terminaldefs_Syn_EChild :: (Set String), usedArgs_Syn_EChild :: (Set String) } {-# INLINABLE wrap_EChild #-} wrap_EChild :: T_EChild -> Inh_EChild -> (Syn_EChild ) wrap_EChild (T_EChild act) (Inh_EChild _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_EChild_vIn1 _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks (T_EChild_vOut1 _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOterminaldefs _lhsOusedArgs) <- return (inv_EChild_s2 sem arg1) return (Syn_EChild _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOterminaldefs _lhsOusedArgs) ) -- cata {-# NOINLINE sem_EChild #-} sem_EChild :: EChild -> T_EChild sem_EChild ( EChild name_ tp_ kind_ hasAround_ merges_ isMerged_ ) = sem_EChild_EChild name_ tp_ kind_ hasAround_ merges_ isMerged_ sem_EChild ( ETerm name_ tp_ ) = sem_EChild_ETerm name_ tp_ -- semantic domain newtype T_EChild = T_EChild { attach_T_EChild :: Identity (T_EChild_s2 ) } newtype T_EChild_s2 = C_EChild_s2 { inv_EChild_s2 :: (T_EChild_v1 ) } data T_EChild_s3 = C_EChild_s3 type T_EChild_v1 = (T_EChild_vIn1 ) -> (T_EChild_vOut1 ) data T_EChild_vIn1 = T_EChild_vIn1 (Map NontermIdent Int) (ConstructorIdent) (PP_Doc) (String) (String) (String -> String -> String -> Bool -> String) (NontermIdent) (Options) (String) (PP_Doc) data T_EChild_vOut1 = T_EChild_vOut1 ( PP_Doc ) ( PP_Doc ) ( PP_Doc ) (Map Identifier Type) (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) (PP_Doc) (Set String) (Set String) {-# NOINLINE sem_EChild_EChild #-} sem_EChild_EChild :: (Identifier) -> (Type) -> (ChildKind) -> (Bool) -> (Maybe [Identifier]) -> (Bool) -> T_EChild sem_EChild_EChild arg_name_ arg_tp_ arg_kind_ arg_hasAround_ _ _ = T_EChild (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_EChild_v1 v1 = \ (T_EChild_vIn1 _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks) -> ( let _lhsOusedArgs :: Set String _lhsOusedArgs = rule0 _usedArgs_augmented_f1 _usedArgs_augmented_syn _usedArgs_augmented_f1 = rule1 arg_kind_ arg_name_ _tpDoc = rule2 _addStrict arg_tp_ _strNm = rule3 _lhsIcon _lhsInt arg_name_ _field = rule4 _lhsIoptions _strNm _tpDoc _addStrict = rule5 _lhsIoptions _lhsOdatatype :: PP_Doc _lhsOdatatype = rule6 _field arg_kind_ _lhsOargnamesw :: PP_Doc _lhsOargnamesw = rule7 _nt arg_kind_ arg_name_ _lhsOargtps :: PP_Doc _lhsOargtps = rule8 arg_kind_ arg_tp_ _argpats = rule9 arg_kind_ arg_name_ _lhsOchildintros :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) _lhsOchildintros = rule10 _introcode arg_name_ _isDefor = rule11 arg_tp_ _valcode = rule12 _isDefor _lhsIoptions _nt arg_kind_ arg_name_ _aroundcode = rule13 _lhsIoptions arg_hasAround_ arg_name_ _introcode = rule14 _addbang _aroundcode _initSt _isDefor _lhsIoptions _nt _valcode arg_hasAround_ arg_kind_ arg_name_ _nt = rule15 arg_tp_ _addbang = rule16 _lhsIoptions _lhsOchildTypes :: Map Identifier Type _lhsOchildTypes = rule17 arg_name_ arg_tp_ _initSt = rule18 _lhsIallInitStates _nt _lhsOterminaldefs :: Set String _lhsOterminaldefs = rule19 () _usedArgs_augmented_syn = rule20 () _lhsOargpats :: PP_Doc _lhsOargpats = rule21 _argpats __result_ = T_EChild_vOut1 _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOterminaldefs _lhsOusedArgs in __result_ ) in C_EChild_s2 v1 {-# INLINE rule0 #-} rule0 = \ _usedArgs_augmented_f1 _usedArgs_augmented_syn -> foldr ($) _usedArgs_augmented_syn [_usedArgs_augmented_f1] {-# INLINE rule1 #-} rule1 = \ kind_ name_ -> \s -> case kind_ of ChildSyntax -> Set.insert ("arg_" ++ show name_ ++ "_") s _ -> s {-# INLINE rule2 #-} {-# LINE 206 "src-ag/ExecutionPlan2Hs.ag" #-} rule2 = \ _addStrict tp_ -> {-# LINE 206 "src-ag/ExecutionPlan2Hs.ag" #-} _addStrict $ pp_parens $ ppTp $ removeDeforested tp_ {-# LINE 414 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule3 #-} {-# LINE 207 "src-ag/ExecutionPlan2Hs.ag" #-} rule3 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) name_ -> {-# LINE 207 "src-ag/ExecutionPlan2Hs.ag" #-} recordFieldname _lhsInt _lhsIcon name_ {-# LINE 420 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule4 #-} {-# LINE 208 "src-ag/ExecutionPlan2Hs.ag" #-} rule4 = \ ((_lhsIoptions) :: Options) _strNm _tpDoc -> {-# LINE 208 "src-ag/ExecutionPlan2Hs.ag" #-} if dataRecords _lhsIoptions then _strNm >#< "::" >#< _tpDoc else _tpDoc {-# LINE 428 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule5 #-} {-# LINE 211 "src-ag/ExecutionPlan2Hs.ag" #-} rule5 = \ ((_lhsIoptions) :: Options) -> {-# LINE 211 "src-ag/ExecutionPlan2Hs.ag" #-} \x -> if strictData _lhsIoptions then "!" >|< x else x {-# LINE 434 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule6 #-} {-# LINE 212 "src-ag/ExecutionPlan2Hs.ag" #-} rule6 = \ _field kind_ -> {-# LINE 212 "src-ag/ExecutionPlan2Hs.ag" #-} case kind_ of ChildAttr -> empty _ -> _field {-# LINE 442 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule7 #-} {-# LINE 300 "src-ag/ExecutionPlan2Hs.ag" #-} rule7 = \ _nt kind_ name_ -> {-# LINE 300 "src-ag/ExecutionPlan2Hs.ag" #-} case kind_ of ChildSyntax -> "(" >#< "sem_" >|< _nt >#< name_ >|< "_" >#< ")" ChildAttr -> empty ChildReplace tp -> "(" >#< "sem_" >|< extractNonterminal tp >#< name_ >|< "_" >#< ")" {-# LINE 451 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule8 #-} {-# LINE 578 "src-ag/ExecutionPlan2Hs.ag" #-} rule8 = \ kind_ tp_ -> {-# LINE 578 "src-ag/ExecutionPlan2Hs.ag" #-} case kind_ of ChildSyntax -> ppDefor tp_ >#< "->" ChildReplace tp -> ppDefor tp >#< "->" _ -> empty {-# LINE 460 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule9 #-} {-# LINE 582 "src-ag/ExecutionPlan2Hs.ag" #-} rule9 = \ kind_ name_ -> {-# LINE 582 "src-ag/ExecutionPlan2Hs.ag" #-} case kind_ of ChildSyntax -> name_ >|< "_" ChildReplace _ -> name_ >|< "_" _ -> empty {-# LINE 469 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule10 #-} {-# LINE 930 "src-ag/ExecutionPlan2Hs.ag" #-} rule10 = \ _introcode name_ -> {-# LINE 930 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton name_ _introcode {-# LINE 475 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule11 #-} {-# LINE 931 "src-ag/ExecutionPlan2Hs.ag" #-} rule11 = \ tp_ -> {-# LINE 931 "src-ag/ExecutionPlan2Hs.ag" #-} case tp_ of NT _ _ defor -> defor _ -> False {-# LINE 483 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule12 #-} {-# LINE 934 "src-ag/ExecutionPlan2Hs.ag" #-} rule12 = \ _isDefor ((_lhsIoptions) :: Options) _nt kind_ name_ -> {-# LINE 934 "src-ag/ExecutionPlan2Hs.ag" #-} case kind_ of ChildSyntax -> "arg_" >|< name_ >|< "_" ChildAttr -> let prefix | not _isDefor = if lateHigherOrderBinding _lhsIoptions then lateSemNtLabel _nt >#< lhsname _lhsIoptions True idLateBindingAttr else "sem_" >|< _nt | otherwise = empty in pp_parens (prefix >#< instname name_) ChildReplace _ -> pp_parens (instname name_ >#< name_ >|< "_") {-# LINE 498 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule13 #-} {-# LINE 945 "src-ag/ExecutionPlan2Hs.ag" #-} rule13 = \ ((_lhsIoptions) :: Options) hasAround_ name_ -> {-# LINE 945 "src-ag/ExecutionPlan2Hs.ag" #-} if hasAround_ then locname _lhsIoptions name_ >|< "_around" else empty {-# LINE 506 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule14 #-} {-# LINE 948 "src-ag/ExecutionPlan2Hs.ag" #-} rule14 = \ _addbang _aroundcode _initSt _isDefor ((_lhsIoptions) :: Options) _nt _valcode hasAround_ kind_ name_ -> {-# LINE 948 "src-ag/ExecutionPlan2Hs.ag" #-} \kind fmtMode -> let pat = text $ stname name_ _initSt patStrict = _addbang pat attach = "attach_T_" >|< _nt >#< pp_parens (_aroundcode >#< _valcode ) runAttach = unMon _lhsIoptions >#< pp_parens attach decl = case kind of VisitPure False -> pat >#< "=" >#< runAttach VisitPure True -> patStrict >#< "=" >#< runAttach VisitMonadic -> patStrict >#< "<-" >#< attach in if compatibleAttach kind _nt _lhsIoptions then Right ( fmtDecl False fmtMode decl , Set.singleton (stname name_ _initSt ) , case kind_ of ChildAttr -> Map.insert (instname name_) Nothing $ ( if _isDefor || not (lateHigherOrderBinding _lhsIoptions) then id else Map.insert (lhsname _lhsIoptions True idLateBindingAttr) (Just $ AttrInh _LHS idLateBindingAttr) ) $ ( if hasAround_ then Map.insert (locname _lhsIoptions (name_) ++ "_around") Nothing else id ) $ Map.empty ChildReplace _ -> Map.singleton (instname name_) Nothing ChildSyntax -> Map.empty ) else Left $ IncompatibleAttachKind name_ kind {-# LINE 537 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule15 #-} {-# LINE 974 "src-ag/ExecutionPlan2Hs.ag" #-} rule15 = \ tp_ -> {-# LINE 974 "src-ag/ExecutionPlan2Hs.ag" #-} extractNonterminal tp_ {-# LINE 543 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule16 #-} {-# LINE 1553 "src-ag/ExecutionPlan2Hs.ag" #-} rule16 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1553 "src-ag/ExecutionPlan2Hs.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 549 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule17 #-} {-# LINE 1605 "src-ag/ExecutionPlan2Hs.ag" #-} rule17 = \ name_ tp_ -> {-# LINE 1605 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton name_ tp_ {-# LINE 555 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule18 #-} {-# LINE 1649 "src-ag/ExecutionPlan2Hs.ag" #-} rule18 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) _nt -> {-# LINE 1649 "src-ag/ExecutionPlan2Hs.ag" #-} Map.findWithDefault (error "nonterminal not in allInitStates map") _nt _lhsIallInitStates {-# LINE 561 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule19 #-} rule19 = \ (_ :: ()) -> Set.empty {-# INLINE rule20 #-} rule20 = \ (_ :: ()) -> Set.empty {-# INLINE rule21 #-} rule21 = \ _argpats -> _argpats {-# NOINLINE sem_EChild_ETerm #-} sem_EChild_ETerm :: (Identifier) -> (Type) -> T_EChild sem_EChild_ETerm arg_name_ arg_tp_ = T_EChild (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_EChild_v1 v1 = \ (T_EChild_vIn1 _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks) -> ( let _tpDoc = rule22 _addStrict arg_tp_ _strNm = rule23 _lhsIcon _lhsInt arg_name_ _field = rule24 _lhsIoptions _strNm _tpDoc _addStrict = rule25 _lhsIoptions _lhsOdatatype :: PP_Doc _lhsOdatatype = rule26 _field _lhsOargnamesw :: PP_Doc _lhsOargnamesw = rule27 arg_name_ _lhsOargtps :: PP_Doc _lhsOargtps = rule28 arg_tp_ _argpats = rule29 _addbang arg_name_ _lhsOchildintros :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) _lhsOchildintros = rule30 arg_name_ _lhsOterminaldefs :: Set String _lhsOterminaldefs = rule31 arg_name_ _addbang = rule32 _lhsIoptions _lhsOchildTypes :: Map Identifier Type _lhsOchildTypes = rule33 arg_name_ arg_tp_ _lhsOusedArgs :: Set String _lhsOusedArgs = rule34 () _lhsOargpats :: PP_Doc _lhsOargpats = rule35 _argpats __result_ = T_EChild_vOut1 _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOterminaldefs _lhsOusedArgs in __result_ ) in C_EChild_s2 v1 {-# INLINE rule22 #-} {-# LINE 206 "src-ag/ExecutionPlan2Hs.ag" #-} rule22 = \ _addStrict tp_ -> {-# LINE 206 "src-ag/ExecutionPlan2Hs.ag" #-} _addStrict $ pp_parens $ ppTp $ removeDeforested tp_ {-# LINE 608 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule23 #-} {-# LINE 207 "src-ag/ExecutionPlan2Hs.ag" #-} rule23 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) name_ -> {-# LINE 207 "src-ag/ExecutionPlan2Hs.ag" #-} recordFieldname _lhsInt _lhsIcon name_ {-# LINE 614 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule24 #-} {-# LINE 208 "src-ag/ExecutionPlan2Hs.ag" #-} rule24 = \ ((_lhsIoptions) :: Options) _strNm _tpDoc -> {-# LINE 208 "src-ag/ExecutionPlan2Hs.ag" #-} if dataRecords _lhsIoptions then _strNm >#< "::" >#< _tpDoc else _tpDoc {-# LINE 622 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule25 #-} {-# LINE 211 "src-ag/ExecutionPlan2Hs.ag" #-} rule25 = \ ((_lhsIoptions) :: Options) -> {-# LINE 211 "src-ag/ExecutionPlan2Hs.ag" #-} \x -> if strictData _lhsIoptions then "!" >|< x else x {-# LINE 628 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule26 #-} {-# LINE 216 "src-ag/ExecutionPlan2Hs.ag" #-} rule26 = \ _field -> {-# LINE 216 "src-ag/ExecutionPlan2Hs.ag" #-} _field {-# LINE 634 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule27 #-} {-# LINE 304 "src-ag/ExecutionPlan2Hs.ag" #-} rule27 = \ name_ -> {-# LINE 304 "src-ag/ExecutionPlan2Hs.ag" #-} text $ fieldname name_ {-# LINE 640 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule28 #-} {-# LINE 586 "src-ag/ExecutionPlan2Hs.ag" #-} rule28 = \ tp_ -> {-# LINE 586 "src-ag/ExecutionPlan2Hs.ag" #-} (pp_parens $ show tp_) >#< "->" {-# LINE 646 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule29 #-} {-# LINE 587 "src-ag/ExecutionPlan2Hs.ag" #-} rule29 = \ _addbang name_ -> {-# LINE 587 "src-ag/ExecutionPlan2Hs.ag" #-} _addbang $ text $ fieldname name_ {-# LINE 652 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule30 #-} {-# LINE 929 "src-ag/ExecutionPlan2Hs.ag" #-} rule30 = \ name_ -> {-# LINE 929 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton name_ (\_ _ -> Right (empty, Set.empty, Map.empty)) {-# LINE 658 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule31 #-} {-# LINE 1322 "src-ag/ExecutionPlan2Hs.ag" #-} rule31 = \ name_ -> {-# LINE 1322 "src-ag/ExecutionPlan2Hs.ag" #-} Set.singleton $ fieldname name_ {-# LINE 664 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule32 #-} {-# LINE 1554 "src-ag/ExecutionPlan2Hs.ag" #-} rule32 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1554 "src-ag/ExecutionPlan2Hs.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 670 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule33 #-} {-# LINE 1605 "src-ag/ExecutionPlan2Hs.ag" #-} rule33 = \ name_ tp_ -> {-# LINE 1605 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton name_ tp_ {-# LINE 676 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule34 #-} rule34 = \ (_ :: ()) -> Set.empty {-# INLINE rule35 #-} rule35 = \ _argpats -> _argpats -- EChildren --------------------------------------------------- -- wrapper data Inh_EChildren = Inh_EChildren { allInitStates_Inh_EChildren :: (Map NontermIdent Int), con_Inh_EChildren :: (ConstructorIdent), importBlocks_Inh_EChildren :: (PP_Doc), mainFile_Inh_EChildren :: (String), mainName_Inh_EChildren :: (String), moduleHeader_Inh_EChildren :: (String -> String -> String -> Bool -> String), nt_Inh_EChildren :: (NontermIdent), options_Inh_EChildren :: (Options), pragmaBlocks_Inh_EChildren :: (String), textBlocks_Inh_EChildren :: (PP_Doc) } data Syn_EChildren = Syn_EChildren { argnamesw_Syn_EChildren :: ([PP_Doc]), argpats_Syn_EChildren :: ( [PP_Doc] ), argtps_Syn_EChildren :: ( [PP_Doc] ), childTypes_Syn_EChildren :: (Map Identifier Type), childintros_Syn_EChildren :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), datatype_Syn_EChildren :: ([PP_Doc]), terminaldefs_Syn_EChildren :: (Set String), usedArgs_Syn_EChildren :: (Set String) } {-# INLINABLE wrap_EChildren #-} wrap_EChildren :: T_EChildren -> Inh_EChildren -> (Syn_EChildren ) wrap_EChildren (T_EChildren act) (Inh_EChildren _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_EChildren_vIn4 _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks (T_EChildren_vOut4 _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOterminaldefs _lhsOusedArgs) <- return (inv_EChildren_s5 sem arg4) return (Syn_EChildren _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOterminaldefs _lhsOusedArgs) ) -- cata {-# NOINLINE sem_EChildren #-} sem_EChildren :: EChildren -> T_EChildren sem_EChildren list = Prelude.foldr sem_EChildren_Cons sem_EChildren_Nil (Prelude.map sem_EChild list) -- semantic domain newtype T_EChildren = T_EChildren { attach_T_EChildren :: Identity (T_EChildren_s5 ) } newtype T_EChildren_s5 = C_EChildren_s5 { inv_EChildren_s5 :: (T_EChildren_v4 ) } data T_EChildren_s6 = C_EChildren_s6 type T_EChildren_v4 = (T_EChildren_vIn4 ) -> (T_EChildren_vOut4 ) data T_EChildren_vIn4 = T_EChildren_vIn4 (Map NontermIdent Int) (ConstructorIdent) (PP_Doc) (String) (String) (String -> String -> String -> Bool -> String) (NontermIdent) (Options) (String) (PP_Doc) data T_EChildren_vOut4 = T_EChildren_vOut4 ([PP_Doc]) ( [PP_Doc] ) ( [PP_Doc] ) (Map Identifier Type) (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) ([PP_Doc]) (Set String) (Set String) {-# NOINLINE sem_EChildren_Cons #-} sem_EChildren_Cons :: T_EChild -> T_EChildren -> T_EChildren sem_EChildren_Cons arg_hd_ arg_tl_ = T_EChildren (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_EChildren_v4 v4 = \ (T_EChildren_vIn4 _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks) -> ( let _hdX2 = Control.Monad.Identity.runIdentity (attach_T_EChild (arg_hd_)) _tlX5 = Control.Monad.Identity.runIdentity (attach_T_EChildren (arg_tl_)) (T_EChild_vOut1 _hdIargnamesw _hdIargpats _hdIargtps _hdIchildTypes _hdIchildintros _hdIdatatype _hdIterminaldefs _hdIusedArgs) = inv_EChild_s2 _hdX2 (T_EChild_vIn1 _hdOallInitStates _hdOcon _hdOimportBlocks _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnt _hdOoptions _hdOpragmaBlocks _hdOtextBlocks) (T_EChildren_vOut4 _tlIargnamesw _tlIargpats _tlIargtps _tlIchildTypes _tlIchildintros _tlIdatatype _tlIterminaldefs _tlIusedArgs) = inv_EChildren_s5 _tlX5 (T_EChildren_vIn4 _tlOallInitStates _tlOcon _tlOimportBlocks _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnt _tlOoptions _tlOpragmaBlocks _tlOtextBlocks) _lhsOargnamesw :: [PP_Doc] _lhsOargnamesw = rule36 _hdIargnamesw _tlIargnamesw _lhsOargpats :: [PP_Doc] _lhsOargpats = rule37 _hdIargpats _tlIargpats _lhsOargtps :: [PP_Doc] _lhsOargtps = rule38 _hdIargtps _tlIargtps _lhsOchildTypes :: Map Identifier Type _lhsOchildTypes = rule39 _hdIchildTypes _tlIchildTypes _lhsOchildintros :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) _lhsOchildintros = rule40 _hdIchildintros _tlIchildintros _lhsOdatatype :: [PP_Doc] _lhsOdatatype = rule41 _hdIdatatype _tlIdatatype _lhsOterminaldefs :: Set String _lhsOterminaldefs = rule42 _hdIterminaldefs _tlIterminaldefs _lhsOusedArgs :: Set String _lhsOusedArgs = rule43 _hdIusedArgs _tlIusedArgs _hdOallInitStates = rule44 _lhsIallInitStates _hdOcon = rule45 _lhsIcon _hdOimportBlocks = rule46 _lhsIimportBlocks _hdOmainFile = rule47 _lhsImainFile _hdOmainName = rule48 _lhsImainName _hdOmoduleHeader = rule49 _lhsImoduleHeader _hdOnt = rule50 _lhsInt _hdOoptions = rule51 _lhsIoptions _hdOpragmaBlocks = rule52 _lhsIpragmaBlocks _hdOtextBlocks = rule53 _lhsItextBlocks _tlOallInitStates = rule54 _lhsIallInitStates _tlOcon = rule55 _lhsIcon _tlOimportBlocks = rule56 _lhsIimportBlocks _tlOmainFile = rule57 _lhsImainFile _tlOmainName = rule58 _lhsImainName _tlOmoduleHeader = rule59 _lhsImoduleHeader _tlOnt = rule60 _lhsInt _tlOoptions = rule61 _lhsIoptions _tlOpragmaBlocks = rule62 _lhsIpragmaBlocks _tlOtextBlocks = rule63 _lhsItextBlocks __result_ = T_EChildren_vOut4 _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOterminaldefs _lhsOusedArgs in __result_ ) in C_EChildren_s5 v4 {-# INLINE rule36 #-} rule36 = \ ((_hdIargnamesw) :: PP_Doc ) ((_tlIargnamesw) :: [PP_Doc]) -> _hdIargnamesw : _tlIargnamesw {-# INLINE rule37 #-} rule37 = \ ((_hdIargpats) :: PP_Doc ) ((_tlIargpats) :: [PP_Doc] ) -> _hdIargpats : _tlIargpats {-# INLINE rule38 #-} rule38 = \ ((_hdIargtps) :: PP_Doc ) ((_tlIargtps) :: [PP_Doc] ) -> _hdIargtps : _tlIargtps {-# INLINE rule39 #-} rule39 = \ ((_hdIchildTypes) :: Map Identifier Type) ((_tlIchildTypes) :: Map Identifier Type) -> _hdIchildTypes `mappend` _tlIchildTypes {-# INLINE rule40 #-} rule40 = \ ((_hdIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) ((_tlIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _hdIchildintros `Map.union` _tlIchildintros {-# INLINE rule41 #-} rule41 = \ ((_hdIdatatype) :: PP_Doc) ((_tlIdatatype) :: [PP_Doc]) -> _hdIdatatype : _tlIdatatype {-# INLINE rule42 #-} rule42 = \ ((_hdIterminaldefs) :: Set String) ((_tlIterminaldefs) :: Set String) -> _hdIterminaldefs `Set.union` _tlIterminaldefs {-# INLINE rule43 #-} rule43 = \ ((_hdIusedArgs) :: Set String) ((_tlIusedArgs) :: Set String) -> _hdIusedArgs `Set.union` _tlIusedArgs {-# INLINE rule44 #-} rule44 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule45 #-} rule45 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule46 #-} rule46 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule47 #-} rule47 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule48 #-} rule48 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule49 #-} rule49 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule50 #-} rule50 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule51 #-} rule51 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule52 #-} rule52 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule53 #-} rule53 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule54 #-} rule54 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule55 #-} rule55 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule56 #-} rule56 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule57 #-} rule57 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule58 #-} rule58 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule59 #-} rule59 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule60 #-} rule60 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule61 #-} rule61 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule62 #-} rule62 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule63 #-} rule63 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# NOINLINE sem_EChildren_Nil #-} sem_EChildren_Nil :: T_EChildren sem_EChildren_Nil = T_EChildren (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_EChildren_v4 v4 = \ (T_EChildren_vIn4 _lhsIallInitStates _lhsIcon _lhsIimportBlocks _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsItextBlocks) -> ( let _lhsOargnamesw :: [PP_Doc] _lhsOargnamesw = rule64 () _lhsOargpats :: [PP_Doc] _lhsOargpats = rule65 () _lhsOargtps :: [PP_Doc] _lhsOargtps = rule66 () _lhsOchildTypes :: Map Identifier Type _lhsOchildTypes = rule67 () _lhsOchildintros :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr))) _lhsOchildintros = rule68 () _lhsOdatatype :: [PP_Doc] _lhsOdatatype = rule69 () _lhsOterminaldefs :: Set String _lhsOterminaldefs = rule70 () _lhsOusedArgs :: Set String _lhsOusedArgs = rule71 () __result_ = T_EChildren_vOut4 _lhsOargnamesw _lhsOargpats _lhsOargtps _lhsOchildTypes _lhsOchildintros _lhsOdatatype _lhsOterminaldefs _lhsOusedArgs in __result_ ) in C_EChildren_s5 v4 {-# INLINE rule64 #-} rule64 = \ (_ :: ()) -> [] {-# INLINE rule65 #-} rule65 = \ (_ :: ()) -> [] {-# INLINE rule66 #-} rule66 = \ (_ :: ()) -> [] {-# INLINE rule67 #-} rule67 = \ (_ :: ()) -> mempty {-# INLINE rule68 #-} rule68 = \ (_ :: ()) -> Map.empty {-# INLINE rule69 #-} rule69 = \ (_ :: ()) -> [] {-# INLINE rule70 #-} rule70 = \ (_ :: ()) -> Set.empty {-# INLINE rule71 #-} rule71 = \ (_ :: ()) -> Set.empty -- ENonterminal ------------------------------------------------ -- wrapper data Inh_ENonterminal = Inh_ENonterminal { allFromToStates_Inh_ENonterminal :: (Map VisitIdentifier (Int,Int)), allInitStates_Inh_ENonterminal :: (Map NontermIdent Int), allVisitKinds_Inh_ENonterminal :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_ENonterminal :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), avisitdefs_Inh_ENonterminal :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_ENonterminal :: (Map VisitIdentifier (Set Identifier)), derivings_Inh_ENonterminal :: (Derivings), importBlocks_Inh_ENonterminal :: (PP_Doc), inhmap_Inh_ENonterminal :: (Map NontermIdent Attributes), localAttrTypes_Inh_ENonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))), mainFile_Inh_ENonterminal :: (String), mainName_Inh_ENonterminal :: (String), moduleHeader_Inh_ENonterminal :: (String -> String -> String -> Bool -> String), options_Inh_ENonterminal :: (Options), pragmaBlocks_Inh_ENonterminal :: (String), synmap_Inh_ENonterminal :: (Map NontermIdent Attributes), textBlocks_Inh_ENonterminal :: (PP_Doc), typeSyns_Inh_ENonterminal :: (TypeSyns), wrappers_Inh_ENonterminal :: (Set NontermIdent) } data Syn_ENonterminal = Syn_ENonterminal { appendCommon_Syn_ENonterminal :: ( PP_Doc ), appendMain_Syn_ENonterminal :: ( PP_Doc ), childvisit_Syn_ENonterminal :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), errors_Syn_ENonterminal :: (Seq Error), fromToStates_Syn_ENonterminal :: (Map VisitIdentifier (Int,Int)), genProdIO_Syn_ENonterminal :: (IO ()), imports_Syn_ENonterminal :: ([PP_Doc]), initStates_Syn_ENonterminal :: (Map NontermIdent Int), output_Syn_ENonterminal :: (PP_Doc), semFunBndDefs_Syn_ENonterminal :: (Seq PP_Doc), semFunBndTps_Syn_ENonterminal :: (Seq PP_Doc), visitKinds_Syn_ENonterminal :: (Map VisitIdentifier VisitKind), visitdefs_Syn_ENonterminal :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_ENonterminal :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_ENonterminal #-} wrap_ENonterminal :: T_ENonterminal -> Inh_ENonterminal -> (Syn_ENonterminal ) wrap_ENonterminal (T_ENonterminal act) (Inh_ENonterminal _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_ENonterminal_vIn7 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers (T_ENonterminal_vOut7 _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_ENonterminal_s8 sem arg7) return (Syn_ENonterminal _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# INLINE sem_ENonterminal #-} sem_ENonterminal :: ENonterminal -> T_ENonterminal sem_ENonterminal ( ENonterminal nt_ params_ classCtxs_ initial_ initialv_ nextVisits_ prevVisits_ prods_ recursive_ hoInfo_ ) = sem_ENonterminal_ENonterminal nt_ params_ classCtxs_ initial_ initialv_ nextVisits_ prevVisits_ ( sem_EProductions prods_ ) recursive_ hoInfo_ -- semantic domain newtype T_ENonterminal = T_ENonterminal { attach_T_ENonterminal :: Identity (T_ENonterminal_s8 ) } newtype T_ENonterminal_s8 = C_ENonterminal_s8 { inv_ENonterminal_s8 :: (T_ENonterminal_v7 ) } data T_ENonterminal_s9 = C_ENonterminal_s9 type T_ENonterminal_v7 = (T_ENonterminal_vIn7 ) -> (T_ENonterminal_vOut7 ) data T_ENonterminal_vIn7 = T_ENonterminal_vIn7 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Int) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Derivings) (PP_Doc) (Map NontermIdent Attributes) (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) (String) (String) (String -> String -> String -> Bool -> String) (Options) (String) (Map NontermIdent Attributes) (PP_Doc) (TypeSyns) (Set NontermIdent) data T_ENonterminal_vOut7 = T_ENonterminal_vOut7 ( PP_Doc ) ( PP_Doc ) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Seq Error) (Map VisitIdentifier (Int,Int)) (IO ()) ([PP_Doc]) (Map NontermIdent Int) (PP_Doc) (Seq PP_Doc) (Seq PP_Doc) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_ENonterminal_ENonterminal #-} sem_ENonterminal_ENonterminal :: (NontermIdent) -> ([Identifier]) -> (ClassContext) -> (StateIdentifier) -> ([VisitIdentifier]) -> (Map StateIdentifier StateCtx) -> (Map StateIdentifier StateCtx) -> T_EProductions -> (Bool) -> (HigherOrderInfo) -> T_ENonterminal sem_ENonterminal_ENonterminal arg_nt_ arg_params_ arg_classCtxs_ arg_initial_ arg_initialv_ arg_nextVisits_ arg_prevVisits_ arg_prods_ arg_recursive_ _ = T_ENonterminal (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_ENonterminal_v7 v7 = \ (T_ENonterminal_vIn7 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers) -> ( let _prodsX17 = Control.Monad.Identity.runIdentity (attach_T_EProductions (arg_prods_)) (T_EProductions_vOut16 _prodsIallvisits _prodsIchildvisit _prodsIcount _prodsIdatatype _prodsIerrors _prodsIfromToStates _prodsIgenProdIO _prodsIimports _prodsIsemFunBndDefs _prodsIsemFunBndTps _prodsIsem_nt _prodsIsem_prod _prodsIt_visits _prodsIvisitKinds _prodsIvisitdefs _prodsIvisituses) = inv_EProductions_s17 _prodsX17 (T_EProductions_vIn16 _prodsOallFromToStates _prodsOallInhmap _prodsOallInitStates _prodsOallSynmap _prodsOallVisitKinds _prodsOallchildvisit _prodsOallstates _prodsOavisitdefs _prodsOavisituses _prodsOclassCtxs _prodsOimportBlocks _prodsOinhmap _prodsOinitial _prodsOlocalAttrTypes _prodsOmainFile _prodsOmainName _prodsOmoduleHeader _prodsOnextVisits _prodsOnt _prodsOntType _prodsOoptions _prodsOparams _prodsOpragmaBlocks _prodsOprevVisits _prodsOrename _prodsOsynmap _prodsOtextBlocks) _prodsOrename = rule72 _lhsIoptions _prodsOnt = rule73 arg_nt_ _prodsOparams = rule74 arg_params_ _prodsOclassCtxs = rule75 arg_classCtxs_ _lhsOoutput :: PP_Doc _lhsOoutput = rule76 _datatype _hasWrapper _k_states _lhsIoptions _prodsIsem_prod _prodsIt_visits _sem_nt _t_init _t_states _wr_inh _wr_syn _wrapper arg_nt_ _hasWrapper = rule77 _lhsIwrappers arg_nt_ _classPP = rule78 arg_classCtxs_ _aliasPre = rule79 _classPP _t_params arg_nt_ _datatype = rule80 _aliasPre _classPP _derivings _lhsItypeSyns _prodsIdatatype _t_params arg_nt_ _derivings = rule81 _lhsIderivings arg_nt_ _fsemname = rule82 () _semname = rule83 _fsemname arg_nt_ _frecarg = rule84 _fsemname _sem_tp = rule85 _classPP _quantPP _t_params _t_type arg_nt_ _quantPP = rule86 arg_params_ _sem_nt = rule87 _frecarg _fsemname _lhsItypeSyns _prodsIsem_nt _semPragma _sem_tp _semname arg_nt_ _inlineNt = rule88 _hasWrapper _lhsIoptions _prodsIcount arg_recursive_ _semPragma = rule89 _inlineNt _lhsIoptions _semname (Just _prodsOinhmap) = rule90 _lhsIinhmap arg_nt_ (Just _prodsOsynmap) = rule91 _lhsIsynmap arg_nt_ _prodsOallInhmap = rule92 _lhsIinhmap _prodsOallSynmap = rule93 _lhsIsynmap _outedges = rule94 _prodsIallvisits _inedges = rule95 _prodsIallvisits _allstates = rule96 _inedges _outedges arg_initial_ _stvisits = rule97 _prodsIallvisits _t_type = rule98 arg_nt_ _t_params = rule99 arg_params_ _t_init = rule100 _lhsIoptions _t_params _t_type arg_initial_ _t_states = rule101 _allstates _t_params arg_nextVisits_ arg_nt_ _k_type = rule102 arg_nt_ _k_states = rule103 _allstates _k_type _prodsIallvisits _t_params _t_type arg_nextVisits_ arg_nt_ _wr_inh = rule104 _genwrap _wr_inhs _wr_syn = rule105 _genwrap _wr_syns _genwrap = rule106 _addbang _t_params arg_nt_ _synAttrs = rule107 _lhsIinhmap arg_nt_ _wr_inhs = rule108 _synAttrs _wr_filter _wr_inhs1 = rule109 _synAttrs _wr_filter = rule110 _lhsIoptions _wr_syns = rule111 _lhsIsynmap arg_nt_ _inhlist = rule112 _lhsIoptions _wr_inhs _inhlist1 = rule113 _lhsIoptions _wr_inhs1 _synlist = rule114 _lhsIoptions _wr_syns _wrapname = rule115 arg_nt_ _inhname = rule116 arg_nt_ _synname = rule117 arg_nt_ _firstVisitInfo = rule118 arg_initial_ arg_nextVisits_ _wrapper = rule119 _addbang _addbangWrap _classPP _inhlist _inhname _k_type _lhsIallVisitKinds _lhsImainName _lhsIoptions _prodsIvisitdefs _prodsIvisituses _quantPP _synlist _synname _t_params _t_type _wrapPragma _wrapname arg_initial_ arg_initialv_ arg_nextVisits_ arg_nt_ _wrapPragma = rule120 _lhsIoptions _wrapname _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule121 _prodsIsemFunBndDefs _semFunBndDef _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule122 _prodsIsemFunBndTps _semFunBndTp _semFunBndDef = rule123 _semFunBndNm _semname _semFunBndTp = rule124 _semFunBndNm _sem_tp _semFunBndNm = rule125 arg_nt_ _prodsOinitial = rule126 arg_initial_ _prodsOallstates = rule127 _allstates _lhsOappendMain :: PP_Doc _lhsOappendMain = rule128 _lhsIwrappers _sem_nt _wr_inh _wr_syn _wrapper arg_nt_ _lhsOappendCommon :: PP_Doc _lhsOappendCommon = rule129 _datatype _k_states _lhsIoptions _prodsIt_visits _t_init _t_states _addbang = rule130 _lhsIoptions _addbangWrap = rule131 () _prodsOnextVisits = rule132 arg_nextVisits_ _prodsOprevVisits = rule133 arg_prevVisits_ _prodsOlocalAttrTypes = rule134 _lhsIlocalAttrTypes arg_nt_ _lhsOinitStates :: Map NontermIdent Int _lhsOinitStates = rule135 arg_initial_ arg_nt_ _ntType = rule136 arg_nt_ arg_params_ _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule137 _prodsIchildvisit _lhsOerrors :: Seq Error _lhsOerrors = rule138 _prodsIerrors _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule139 _prodsIfromToStates _lhsOgenProdIO :: IO () _lhsOgenProdIO = rule140 _prodsIgenProdIO _lhsOimports :: [PP_Doc] _lhsOimports = rule141 _prodsIimports _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule142 _prodsIvisitKinds _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule143 _prodsIvisitdefs _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule144 _prodsIvisituses _prodsOallFromToStates = rule145 _lhsIallFromToStates _prodsOallInitStates = rule146 _lhsIallInitStates _prodsOallVisitKinds = rule147 _lhsIallVisitKinds _prodsOallchildvisit = rule148 _lhsIallchildvisit _prodsOavisitdefs = rule149 _lhsIavisitdefs _prodsOavisituses = rule150 _lhsIavisituses _prodsOimportBlocks = rule151 _lhsIimportBlocks _prodsOmainFile = rule152 _lhsImainFile _prodsOmainName = rule153 _lhsImainName _prodsOmoduleHeader = rule154 _lhsImoduleHeader _prodsOntType = rule155 _ntType _prodsOoptions = rule156 _lhsIoptions _prodsOpragmaBlocks = rule157 _lhsIpragmaBlocks _prodsOtextBlocks = rule158 _lhsItextBlocks __result_ = T_ENonterminal_vOut7 _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_ENonterminal_s8 v7 {-# INLINE rule72 #-} {-# LINE 57 "src-ag/ExecutionPlan2Hs.ag" #-} rule72 = \ ((_lhsIoptions) :: Options) -> {-# LINE 57 "src-ag/ExecutionPlan2Hs.ag" #-} rename _lhsIoptions {-# LINE 1047 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule73 #-} {-# LINE 65 "src-ag/ExecutionPlan2Hs.ag" #-} rule73 = \ nt_ -> {-# LINE 65 "src-ag/ExecutionPlan2Hs.ag" #-} nt_ {-# LINE 1053 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule74 #-} {-# LINE 77 "src-ag/ExecutionPlan2Hs.ag" #-} rule74 = \ params_ -> {-# LINE 77 "src-ag/ExecutionPlan2Hs.ag" #-} params_ {-# LINE 1059 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule75 #-} {-# LINE 81 "src-ag/ExecutionPlan2Hs.ag" #-} rule75 = \ classCtxs_ -> {-# LINE 81 "src-ag/ExecutionPlan2Hs.ag" #-} classCtxs_ {-# LINE 1065 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule76 #-} {-# LINE 98 "src-ag/ExecutionPlan2Hs.ag" #-} rule76 = \ _datatype _hasWrapper _k_states ((_lhsIoptions) :: Options) ((_prodsIsem_prod) :: PP_Doc) ((_prodsIt_visits) :: PP_Doc) _sem_nt _t_init _t_states _wr_inh _wr_syn _wrapper nt_ -> {-# LINE 98 "src-ag/ExecutionPlan2Hs.ag" #-} ("-- " ++ getName nt_ ++ " " ++ replicate (60 - length (getName nt_)) '-') >-< (if dataTypes _lhsIoptions then "-- data" >-< _datatype >-< "" else empty) >-< (if _hasWrapper then "-- wrapper" >-< _wr_inh >-< _wr_syn >-< _wrapper >-< "" else empty) >-< (if folds _lhsIoptions then "-- cata" >-< _sem_nt >-< "" else empty) >-< (if semfuns _lhsIoptions then "-- semantic domain" >-< _t_init >-< _t_states >-< _k_states >-< _prodsIt_visits >-< _prodsIsem_prod >-< "" else empty) {-# LINE 1097 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule77 #-} {-# LINE 125 "src-ag/ExecutionPlan2Hs.ag" #-} rule77 = \ ((_lhsIwrappers) :: Set NontermIdent) nt_ -> {-# LINE 125 "src-ag/ExecutionPlan2Hs.ag" #-} nt_ `Set.member` _lhsIwrappers {-# LINE 1103 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule78 #-} {-# LINE 138 "src-ag/ExecutionPlan2Hs.ag" #-} rule78 = \ classCtxs_ -> {-# LINE 138 "src-ag/ExecutionPlan2Hs.ag" #-} ppClasses $ classCtxsToDocs classCtxs_ {-# LINE 1109 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule79 #-} {-# LINE 139 "src-ag/ExecutionPlan2Hs.ag" #-} rule79 = \ _classPP _t_params nt_ -> {-# LINE 139 "src-ag/ExecutionPlan2Hs.ag" #-} "type" >#< _classPP >#< nt_ >#< _t_params >#< "=" {-# LINE 1115 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule80 #-} {-# LINE 140 "src-ag/ExecutionPlan2Hs.ag" #-} rule80 = \ _aliasPre _classPP _derivings ((_lhsItypeSyns) :: TypeSyns) ((_prodsIdatatype) :: [PP_Doc]) _t_params nt_ -> {-# LINE 140 "src-ag/ExecutionPlan2Hs.ag" #-} case lookup nt_ _lhsItypeSyns of Nothing -> "data" >#< _classPP >#< nt_ >#< _t_params >-< ( if null _prodsIdatatype then empty else indent 2 $ vlist $ ( ("=" >#< head _prodsIdatatype) : (map ("|" >#<) $ tail _prodsIdatatype)) ) >-< indent 2 _derivings Just (List t) -> _aliasPre >#< "[" >#< show t >#< "]" Just (Maybe t) -> _aliasPre >#< "Maybe" >#< pp_parens (show t) Just (Tuple ts) -> _aliasPre >#< pp_parens (ppCommas $ map (show . snd) ts) Just (Either l r) -> _aliasPre >#< "Either" >#< pp_parens (show l) >#< pp_parens (show r) Just (Map k v) -> _aliasPre >#< "Data.Map" >#< pp_parens (show k) >#< pp_parens (show v) Just (IntMap t) -> _aliasPre >#< "Data.IntMap.IntMap" >#< pp_parens (show t) Just (OrdSet t) -> _aliasPre >#< "Data.Set.Set" >#< pp_parens (show t) Just IntSet -> _aliasPre >#< "Data.IntSet.IntSet" {-# LINE 1136 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule81 #-} {-# LINE 157 "src-ag/ExecutionPlan2Hs.ag" #-} rule81 = \ ((_lhsIderivings) :: Derivings) nt_ -> {-# LINE 157 "src-ag/ExecutionPlan2Hs.ag" #-} case Map.lookup nt_ _lhsIderivings of Nothing -> empty Just s -> if Set.null s then empty else "deriving" >#< (pp_parens $ ppCommas $ map pp $ Set.toList s) {-# LINE 1146 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule82 #-} {-# LINE 227 "src-ag/ExecutionPlan2Hs.ag" #-} rule82 = \ (_ :: ()) -> {-# LINE 227 "src-ag/ExecutionPlan2Hs.ag" #-} \x -> "sem_" ++ show x {-# LINE 1152 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule83 #-} {-# LINE 228 "src-ag/ExecutionPlan2Hs.ag" #-} rule83 = \ _fsemname nt_ -> {-# LINE 228 "src-ag/ExecutionPlan2Hs.ag" #-} _fsemname nt_ {-# LINE 1158 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule84 #-} {-# LINE 229 "src-ag/ExecutionPlan2Hs.ag" #-} rule84 = \ _fsemname -> {-# LINE 229 "src-ag/ExecutionPlan2Hs.ag" #-} \t x -> case t of NT nt _ _ -> pp_parens (_fsemname nt >#< x) _ -> pp x {-# LINE 1166 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule85 #-} {-# LINE 235 "src-ag/ExecutionPlan2Hs.ag" #-} rule85 = \ _classPP _quantPP _t_params _t_type nt_ -> {-# LINE 235 "src-ag/ExecutionPlan2Hs.ag" #-} _quantPP >#< _classPP >#< nt_ >#< _t_params >#< "->" >#< _t_type >#< _t_params {-# LINE 1172 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule86 #-} {-# LINE 236 "src-ag/ExecutionPlan2Hs.ag" #-} rule86 = \ params_ -> {-# LINE 236 "src-ag/ExecutionPlan2Hs.ag" #-} ppQuants params_ {-# LINE 1178 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule87 #-} {-# LINE 237 "src-ag/ExecutionPlan2Hs.ag" #-} rule87 = \ _frecarg _fsemname ((_lhsItypeSyns) :: TypeSyns) ((_prodsIsem_nt) :: PP_Doc) _semPragma _sem_tp _semname nt_ -> {-# LINE 237 "src-ag/ExecutionPlan2Hs.ag" #-} _semPragma >-< _semname >#< "::" >#< _sem_tp >-< case lookup nt_ _lhsItypeSyns of Nothing -> _prodsIsem_nt Just (List t) -> _semname >#< "list" >#< "=" >#< "Prelude.foldr" >#< _semname >|< "_Cons" >#< _semname >|< "_Nil" >#< case t of NT nt _ _ -> pp_parens ("Prelude.map" >#< _fsemname nt >#< "list") _ -> pp "list" Just (Maybe t) -> _semname >#< "Prelude.Nothing" >#< "=" >#< _semname >|< "_Nothing" >-< _semname >#< pp_parens ("Prelude.Just just") >#< "=" >#< _semname >|< "_Just" >#< _frecarg t "just" Just (Tuple ts) -> _semname >#< pp_parens (ppCommas $ map fst ts) >#< "=" >#< _semname >|< "_Tuple" >#< ppSpaced (map (\t -> _frecarg (snd t) (show $ fst t)) ts) Just (Either l r) -> _semname >#< "(Prelude.Left left)" >#< "=" >#< _semname >|< "_Left" >#< _frecarg l "left" >-< _semname >#< "(Prelude.Right right)" >#< "=" >#< _semname >|< "_Right" >#< _frecarg r "right" Just (Map k v) -> _semname >#< "m" >#< "=" >#< "Data.Map.foldrWithKey" >#< _semname >|< "_Entry" >#< _semname >|< "_Nil" >#< case v of NT nt _ _ -> pp_parens ("Data.Map.map" >#< _fsemname nt >#< "m") _ -> pp "m" Just (IntMap v) -> _semname >#< "m" >#< "=" >#< "Data.IntMap.foldWithKey" >#< _semname >|< "_Entry" >#< _semname >|< "_Nil" >#< case v of NT nt _ _ -> pp_parens ("Data.IntMap.map" >#< _fsemname nt >#< "m") _ -> pp "m" Just (OrdSet t) -> _semname >#< "s" >#< "=" >#< "Prelude.foldr" >#< _semname >|< "_Entry" >#< _semname >|< "_Nil" >#< pp_parens ( ( case t of NT nt _ _ -> pp_parens ("Prelude.map" >#< _fsemname nt) _ -> empty ) >#< pp_parens ("Data.IntSet.elems" >#< "s") ) Just IntSet -> _semname >#< "s" >#< "=" >#< "Prelude.foldr" >#< _semname >|< "_Entry" >#< _semname >|< "_Nil" >#< pp_parens ("Data.IntSet.elems" >#< "s") {-# LINE 1220 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule88 #-} {-# LINE 277 "src-ag/ExecutionPlan2Hs.ag" #-} rule88 = \ _hasWrapper ((_lhsIoptions) :: Options) ((_prodsIcount) :: Int) recursive_ -> {-# LINE 277 "src-ag/ExecutionPlan2Hs.ag" #-} not (lateHigherOrderBinding _lhsIoptions) && not recursive_ && (_prodsIcount == 1 || (aggressiveInlinePragmas _lhsIoptions && not _hasWrapper )) {-# LINE 1226 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule89 #-} {-# LINE 278 "src-ag/ExecutionPlan2Hs.ag" #-} rule89 = \ _inlineNt ((_lhsIoptions) :: Options) _semname -> {-# LINE 278 "src-ag/ExecutionPlan2Hs.ag" #-} if noInlinePragmas _lhsIoptions then empty else if _inlineNt then ppInline _semname else if helpInlining _lhsIoptions && not (lateHigherOrderBinding _lhsIoptions) then ppInlinable _semname else ppNoInline _semname {-# LINE 1238 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule90 #-} {-# LINE 324 "src-ag/ExecutionPlan2Hs.ag" #-} rule90 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) nt_ -> {-# LINE 324 "src-ag/ExecutionPlan2Hs.ag" #-} Map.lookup nt_ _lhsIinhmap {-# LINE 1244 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule91 #-} {-# LINE 325 "src-ag/ExecutionPlan2Hs.ag" #-} rule91 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) nt_ -> {-# LINE 325 "src-ag/ExecutionPlan2Hs.ag" #-} Map.lookup nt_ _lhsIsynmap {-# LINE 1250 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule92 #-} {-# LINE 326 "src-ag/ExecutionPlan2Hs.ag" #-} rule92 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) -> {-# LINE 326 "src-ag/ExecutionPlan2Hs.ag" #-} _lhsIinhmap {-# LINE 1256 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule93 #-} {-# LINE 327 "src-ag/ExecutionPlan2Hs.ag" #-} rule93 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) -> {-# LINE 327 "src-ag/ExecutionPlan2Hs.ag" #-} _lhsIsynmap {-# LINE 1262 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule94 #-} {-# LINE 348 "src-ag/ExecutionPlan2Hs.ag" #-} rule94 = \ ((_prodsIallvisits) :: [VisitStateState]) -> {-# LINE 348 "src-ag/ExecutionPlan2Hs.ag" #-} Set.fromList $ map (\(_,f,_) -> f) _prodsIallvisits {-# LINE 1268 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule95 #-} {-# LINE 349 "src-ag/ExecutionPlan2Hs.ag" #-} rule95 = \ ((_prodsIallvisits) :: [VisitStateState]) -> {-# LINE 349 "src-ag/ExecutionPlan2Hs.ag" #-} Set.fromList $ map (\(_,_,t) -> t) _prodsIallvisits {-# LINE 1274 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule96 #-} {-# LINE 350 "src-ag/ExecutionPlan2Hs.ag" #-} rule96 = \ _inedges _outedges initial_ -> {-# LINE 350 "src-ag/ExecutionPlan2Hs.ag" #-} Set.insert initial_ $ _inedges `Set.union` _outedges {-# LINE 1280 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule97 #-} {-# LINE 351 "src-ag/ExecutionPlan2Hs.ag" #-} rule97 = \ ((_prodsIallvisits) :: [VisitStateState]) -> {-# LINE 351 "src-ag/ExecutionPlan2Hs.ag" #-} \st -> filter (\(v,f,t) -> f == st) _prodsIallvisits {-# LINE 1286 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule98 #-} {-# LINE 352 "src-ag/ExecutionPlan2Hs.ag" #-} rule98 = \ nt_ -> {-# LINE 352 "src-ag/ExecutionPlan2Hs.ag" #-} "T_" >|< nt_ {-# LINE 1292 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule99 #-} {-# LINE 353 "src-ag/ExecutionPlan2Hs.ag" #-} rule99 = \ params_ -> {-# LINE 353 "src-ag/ExecutionPlan2Hs.ag" #-} ppSpaced params_ {-# LINE 1298 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule100 #-} {-# LINE 354 "src-ag/ExecutionPlan2Hs.ag" #-} rule100 = \ ((_lhsIoptions) :: Options) _t_params _t_type initial_ -> {-# LINE 354 "src-ag/ExecutionPlan2Hs.ag" #-} "newtype" >#< _t_type >#< _t_params >#< "=" >#< _t_type >#< pp_braces ( "attach_">|< _t_type >#< "::" >#< ppMonadType _lhsIoptions >#< pp_parens (_t_type >|< "_s" >|< initial_ >#< _t_params )) {-# LINE 1307 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule101 #-} {-# LINE 358 "src-ag/ExecutionPlan2Hs.ag" #-} rule101 = \ _allstates _t_params nextVisits_ nt_ -> {-# LINE 358 "src-ag/ExecutionPlan2Hs.ag" #-} vlist $ map (\st -> let nt_st = nt_ >|< "_s" >|< st t_st = "T_" >|< nt_st k_st = "K_" >|< nt_st c_st = "C_" >|< nt_st inv_st = "inv_" >|< nt_st nextVisit = Map.findWithDefault ManyVis st nextVisits_ in case nextVisit of NoneVis -> "data" >#< t_st >#< _t_params >#< "=" >#< c_st OneVis vId -> "newtype" >#< t_st >#< _t_params >#< "=" >#< c_st >#< (pp_braces $ inv_st >#< "::" >#< pp_parens (conNmTVisit nt_ vId >#< _t_params )) ManyVis -> "data" >#< t_st >#< _t_params >#< "where" >#< c_st >#< "::" >#< (pp_braces $ inv_st >#< "::" >#< "!" >|< pp_parens ("forall t." >#< k_st >#< _t_params >#< "t" >#< "->" >#< "t")) >#< "->" >#< t_st >#< _t_params ) $ Set.toList _allstates {-# LINE 1327 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule102 #-} {-# LINE 376 "src-ag/ExecutionPlan2Hs.ag" #-} rule102 = \ nt_ -> {-# LINE 376 "src-ag/ExecutionPlan2Hs.ag" #-} "K_" ++ show nt_ {-# LINE 1333 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule103 #-} {-# LINE 377 "src-ag/ExecutionPlan2Hs.ag" #-} rule103 = \ _allstates _k_type ((_prodsIallvisits) :: [VisitStateState]) _t_params _t_type nextVisits_ nt_ -> {-# LINE 377 "src-ag/ExecutionPlan2Hs.ag" #-} vlist $ map (\st -> let nt_st = nt_ >|< "_s" >|< st k_st = "K_" >|< nt_st outg = filter (\(v,f,t) -> f == st) _prodsIallvisits visitlist = vlist $ map (\(v,f,t) -> _k_type >|< "_v" >|< v >#< "::" >#< k_st >#< _t_params >#< pp_parens (_t_type >|< "_v" >|< v >#< _t_params ) ) outg nextVisit = Map.findWithDefault ManyVis st nextVisits_ decl = "data" >#< k_st >#< "k" >#< _t_params >#< "where" >-< indent 3 visitlist in case nextVisit of NoneVis -> empty OneVis _ -> empty ManyVis -> decl ) $ Set.toList _allstates {-# LINE 1352 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule104 #-} {-# LINE 444 "src-ag/ExecutionPlan2Hs.ag" #-} rule104 = \ _genwrap _wr_inhs -> {-# LINE 444 "src-ag/ExecutionPlan2Hs.ag" #-} _genwrap "Inh" _wr_inhs {-# LINE 1358 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule105 #-} {-# LINE 445 "src-ag/ExecutionPlan2Hs.ag" #-} rule105 = \ _genwrap _wr_syns -> {-# LINE 445 "src-ag/ExecutionPlan2Hs.ag" #-} _genwrap "Syn" _wr_syns {-# LINE 1364 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule106 #-} {-# LINE 446 "src-ag/ExecutionPlan2Hs.ag" #-} rule106 = \ _addbang _t_params nt_ -> {-# LINE 446 "src-ag/ExecutionPlan2Hs.ag" #-} \nm attr -> "data" >#< nm >|< "_" >|< nt_ >#< _t_params >#< "=" >#< nm >|< "_" >|< nt_ >#< "{" >#< (ppCommas $ map (\(i,t) -> i >|< "_" >|< nm >|< "_" >|< nt_ >#< "::" >#< (_addbang $ pp_parens $ typeToHaskellString (Just nt_) [] t)) attr) >#< "}" {-# LINE 1372 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule107 #-} {-# LINE 449 "src-ag/ExecutionPlan2Hs.ag" #-} rule107 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) nt_ -> {-# LINE 449 "src-ag/ExecutionPlan2Hs.ag" #-} fromJust $ Map.lookup nt_ _lhsIinhmap {-# LINE 1378 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule108 #-} {-# LINE 450 "src-ag/ExecutionPlan2Hs.ag" #-} rule108 = \ _synAttrs _wr_filter -> {-# LINE 450 "src-ag/ExecutionPlan2Hs.ag" #-} Map.toList $ _wr_filter $ _synAttrs {-# LINE 1384 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule109 #-} {-# LINE 451 "src-ag/ExecutionPlan2Hs.ag" #-} rule109 = \ _synAttrs -> {-# LINE 451 "src-ag/ExecutionPlan2Hs.ag" #-} Map.toList _synAttrs {-# LINE 1390 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule110 #-} {-# LINE 452 "src-ag/ExecutionPlan2Hs.ag" #-} rule110 = \ ((_lhsIoptions) :: Options) -> {-# LINE 452 "src-ag/ExecutionPlan2Hs.ag" #-} if lateHigherOrderBinding _lhsIoptions then Map.delete idLateBindingAttr else id {-# LINE 1398 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule111 #-} {-# LINE 455 "src-ag/ExecutionPlan2Hs.ag" #-} rule111 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) nt_ -> {-# LINE 455 "src-ag/ExecutionPlan2Hs.ag" #-} Map.toList $ fromJust $ Map.lookup nt_ _lhsIsynmap {-# LINE 1404 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule112 #-} {-# LINE 456 "src-ag/ExecutionPlan2Hs.ag" #-} rule112 = \ ((_lhsIoptions) :: Options) _wr_inhs -> {-# LINE 456 "src-ag/ExecutionPlan2Hs.ag" #-} map (lhsname _lhsIoptions True . fst) _wr_inhs {-# LINE 1410 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule113 #-} {-# LINE 457 "src-ag/ExecutionPlan2Hs.ag" #-} rule113 = \ ((_lhsIoptions) :: Options) _wr_inhs1 -> {-# LINE 457 "src-ag/ExecutionPlan2Hs.ag" #-} map (lhsname _lhsIoptions True . fst) _wr_inhs1 {-# LINE 1416 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule114 #-} {-# LINE 458 "src-ag/ExecutionPlan2Hs.ag" #-} rule114 = \ ((_lhsIoptions) :: Options) _wr_syns -> {-# LINE 458 "src-ag/ExecutionPlan2Hs.ag" #-} map (lhsname _lhsIoptions False . fst) _wr_syns {-# LINE 1422 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule115 #-} {-# LINE 459 "src-ag/ExecutionPlan2Hs.ag" #-} rule115 = \ nt_ -> {-# LINE 459 "src-ag/ExecutionPlan2Hs.ag" #-} "wrap_" ++ show nt_ {-# LINE 1428 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule116 #-} {-# LINE 460 "src-ag/ExecutionPlan2Hs.ag" #-} rule116 = \ nt_ -> {-# LINE 460 "src-ag/ExecutionPlan2Hs.ag" #-} "Inh_" ++ show nt_ {-# LINE 1434 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule117 #-} {-# LINE 461 "src-ag/ExecutionPlan2Hs.ag" #-} rule117 = \ nt_ -> {-# LINE 461 "src-ag/ExecutionPlan2Hs.ag" #-} "Syn_" ++ show nt_ {-# LINE 1440 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule118 #-} {-# LINE 462 "src-ag/ExecutionPlan2Hs.ag" #-} rule118 = \ initial_ nextVisits_ -> {-# LINE 462 "src-ag/ExecutionPlan2Hs.ag" #-} Map.findWithDefault ManyVis initial_ nextVisits_ {-# LINE 1446 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule119 #-} {-# LINE 463 "src-ag/ExecutionPlan2Hs.ag" #-} rule119 = \ _addbang _addbangWrap _classPP _inhlist _inhname _k_type ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) ((_lhsImainName) :: String) ((_lhsIoptions) :: Options) ((_prodsIvisitdefs) :: Map VisitIdentifier (Set Identifier)) ((_prodsIvisituses) :: Map VisitIdentifier (Set Identifier)) _quantPP _synlist _synname _t_params _t_type _wrapPragma _wrapname initial_ initialv_ nextVisits_ nt_ -> {-# LINE 463 "src-ag/ExecutionPlan2Hs.ag" #-} _wrapPragma >-< (_wrapname >#< "::" >#< _quantPP >#< _classPP >#< _t_type >#< _t_params >#< "->" >#< _inhname >#< _t_params >#< "->" >#< ( if monadicWrappers _lhsIoptions then ppMonadType _lhsIoptions else empty) >#< pp_parens (_synname >#< _t_params )) >-< (_wrapname >#< (_addbang $ pp_parens (_t_type >#< pp "act")) >#< (_addbang $ pp_parens (_inhname >#< (ppSpaced $ map (_addbangWrap . pp) _inhlist )) >#< "=")) >-< indent 3 (case initialv_ of [] -> _synname >#< " { }" initvs@(initv:_) -> let extra = if dummyTokenVisit _lhsIoptions then pp $ dummyArg _lhsIoptions True else empty unMonad | monadicWrappers _lhsIoptions = empty | otherwise = unMon _lhsIoptions genSteps _ [] = [] genSteps curst (curv:nextvs) = setarg : dovis : genSteps nextst nextvs where inCon = conNmTVisitIn nt_ curv outCon = conNmTVisitOut nt_ curv pat = _addbang $ pp_parens $ pat0 pat0 = outCon >#< ppSpaced (map (lhsname _lhsIoptions False) syns) >#< cont cont | null nextvs = empty | otherwise = pp "sem" inhs = Set.toList $ Map.findWithDefault Set.empty curv _prodsIvisituses syns = Set.toList $ Map.findWithDefault Set.empty curv _prodsIvisitdefs arg = inCon >#< ppSpaced (map (lhsname _lhsIoptions True) inhs) setarg = "let" >#< _addbangWrap (pp "arg" >|< curv) >#< "=" >#< arg ind = case Map.findWithDefault ManyVis curst nextVisits_ of NoneVis -> error "wrapper: initial state should have a next visit but it has none" OneVis _ -> empty ManyVis -> _k_type >|< "_v" >|< initv nextst = curst + 1 convert = case Map.lookup curv _lhsIallVisitKinds of Just kind -> case kind of VisitPure _ -> text "return" VisitMonadic -> empty dovis = pat >#< "<-" >#< convert >#< pp_parens ("inv_" >|< nt_ >|< "_s" >|< curst >#< "sem" >#< ind >#< "arg" >|< curv >#< extra) in unMonad >#< "(" >-< indent 2 ( "do" >#< ( _addbang (pp "sem") >#< "<-" >#< "act" >-< vlist (genSteps initial_ initvs) >-< "return" >#< pp_parens (_synname >#< ppSpaced _synlist ) ) ) >-< ")" ) >-< if lateHigherOrderBinding _lhsIoptions then indent 2 ("where" >#< lhsname _lhsIoptions True idLateBindingAttr >#< "=" >#< lateBindingFieldNm _lhsImainName) else empty {-# LINE 1501 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule120 #-} {-# LINE 515 "src-ag/ExecutionPlan2Hs.ag" #-} rule120 = \ ((_lhsIoptions) :: Options) _wrapname -> {-# LINE 515 "src-ag/ExecutionPlan2Hs.ag" #-} if parallelInvoke _lhsIoptions && not (monadicWrappers _lhsIoptions) then ppNoInline _wrapname else if noInlinePragmas _lhsIoptions then empty else ppInlinable _wrapname {-# LINE 1511 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule121 #-} {-# LINE 527 "src-ag/ExecutionPlan2Hs.ag" #-} rule121 = \ ((_prodsIsemFunBndDefs) :: Seq PP_Doc) _semFunBndDef -> {-# LINE 527 "src-ag/ExecutionPlan2Hs.ag" #-} _semFunBndDef Seq.<| _prodsIsemFunBndDefs {-# LINE 1517 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule122 #-} {-# LINE 528 "src-ag/ExecutionPlan2Hs.ag" #-} rule122 = \ ((_prodsIsemFunBndTps) :: Seq PP_Doc) _semFunBndTp -> {-# LINE 528 "src-ag/ExecutionPlan2Hs.ag" #-} _semFunBndTp Seq.<| _prodsIsemFunBndTps {-# LINE 1523 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule123 #-} {-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-} rule123 = \ _semFunBndNm _semname -> {-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-} _semFunBndNm >#< "=" >#< _semname {-# LINE 1529 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule124 #-} {-# LINE 530 "src-ag/ExecutionPlan2Hs.ag" #-} rule124 = \ _semFunBndNm _sem_tp -> {-# LINE 530 "src-ag/ExecutionPlan2Hs.ag" #-} _semFunBndNm >#< "::" >#< _sem_tp {-# LINE 1535 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule125 #-} {-# LINE 531 "src-ag/ExecutionPlan2Hs.ag" #-} rule125 = \ nt_ -> {-# LINE 531 "src-ag/ExecutionPlan2Hs.ag" #-} lateSemNtLabel nt_ {-# LINE 1541 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule126 #-} {-# LINE 569 "src-ag/ExecutionPlan2Hs.ag" #-} rule126 = \ initial_ -> {-# LINE 569 "src-ag/ExecutionPlan2Hs.ag" #-} initial_ {-# LINE 1547 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule127 #-} {-# LINE 570 "src-ag/ExecutionPlan2Hs.ag" #-} rule127 = \ _allstates -> {-# LINE 570 "src-ag/ExecutionPlan2Hs.ag" #-} _allstates {-# LINE 1553 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule128 #-} {-# LINE 1485 "src-ag/ExecutionPlan2Hs.ag" #-} rule128 = \ ((_lhsIwrappers) :: Set NontermIdent) _sem_nt _wr_inh _wr_syn _wrapper nt_ -> {-# LINE 1485 "src-ag/ExecutionPlan2Hs.ag" #-} (if nt_ `Set.member` _lhsIwrappers then _wr_inh >-< _wr_syn >-< _wrapper else empty) >-< _sem_nt {-# LINE 1564 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule129 #-} {-# LINE 1491 "src-ag/ExecutionPlan2Hs.ag" #-} rule129 = \ _datatype _k_states ((_lhsIoptions) :: Options) ((_prodsIt_visits) :: PP_Doc) _t_init _t_states -> {-# LINE 1491 "src-ag/ExecutionPlan2Hs.ag" #-} (if dataTypes _lhsIoptions then _datatype else empty) >-< _t_init >-< _t_states >-< _k_states >-< _prodsIt_visits {-# LINE 1574 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule130 #-} {-# LINE 1551 "src-ag/ExecutionPlan2Hs.ag" #-} rule130 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1551 "src-ag/ExecutionPlan2Hs.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 1580 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule131 #-} {-# LINE 1559 "src-ag/ExecutionPlan2Hs.ag" #-} rule131 = \ (_ :: ()) -> {-# LINE 1559 "src-ag/ExecutionPlan2Hs.ag" #-} id {-# LINE 1586 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule132 #-} {-# LINE 1571 "src-ag/ExecutionPlan2Hs.ag" #-} rule132 = \ nextVisits_ -> {-# LINE 1571 "src-ag/ExecutionPlan2Hs.ag" #-} nextVisits_ {-# LINE 1592 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule133 #-} {-# LINE 1572 "src-ag/ExecutionPlan2Hs.ag" #-} rule133 = \ prevVisits_ -> {-# LINE 1572 "src-ag/ExecutionPlan2Hs.ag" #-} prevVisits_ {-# LINE 1598 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule134 #-} {-# LINE 1616 "src-ag/ExecutionPlan2Hs.ag" #-} rule134 = \ ((_lhsIlocalAttrTypes) :: Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) nt_ -> {-# LINE 1616 "src-ag/ExecutionPlan2Hs.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIlocalAttrTypes {-# LINE 1604 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule135 #-} {-# LINE 1643 "src-ag/ExecutionPlan2Hs.ag" #-} rule135 = \ initial_ nt_ -> {-# LINE 1643 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton nt_ initial_ {-# LINE 1610 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule136 #-} {-# LINE 1657 "src-ag/ExecutionPlan2Hs.ag" #-} rule136 = \ nt_ params_ -> {-# LINE 1657 "src-ag/ExecutionPlan2Hs.ag" #-} NT nt_ (map show params_) False {-# LINE 1616 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule137 #-} rule137 = \ ((_prodsIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _prodsIchildvisit {-# INLINE rule138 #-} rule138 = \ ((_prodsIerrors) :: Seq Error) -> _prodsIerrors {-# INLINE rule139 #-} rule139 = \ ((_prodsIfromToStates) :: Map VisitIdentifier (Int,Int)) -> _prodsIfromToStates {-# INLINE rule140 #-} rule140 = \ ((_prodsIgenProdIO) :: IO ()) -> _prodsIgenProdIO {-# INLINE rule141 #-} rule141 = \ ((_prodsIimports) :: [PP_Doc]) -> _prodsIimports {-# INLINE rule142 #-} rule142 = \ ((_prodsIvisitKinds) :: Map VisitIdentifier VisitKind) -> _prodsIvisitKinds {-# INLINE rule143 #-} rule143 = \ ((_prodsIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _prodsIvisitdefs {-# INLINE rule144 #-} rule144 = \ ((_prodsIvisituses) :: Map VisitIdentifier (Set Identifier)) -> _prodsIvisituses {-# INLINE rule145 #-} rule145 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule146 #-} rule146 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule147 #-} rule147 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule148 #-} rule148 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule149 #-} rule149 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule150 #-} rule150 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule151 #-} rule151 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule152 #-} rule152 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule153 #-} rule153 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule154 #-} rule154 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule155 #-} rule155 = \ _ntType -> _ntType {-# INLINE rule156 #-} rule156 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule157 #-} rule157 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule158 #-} rule158 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks -- ENonterminals ----------------------------------------------- -- wrapper data Inh_ENonterminals = Inh_ENonterminals { allFromToStates_Inh_ENonterminals :: (Map VisitIdentifier (Int,Int)), allInitStates_Inh_ENonterminals :: (Map NontermIdent Int), allVisitKinds_Inh_ENonterminals :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_ENonterminals :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), avisitdefs_Inh_ENonterminals :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_ENonterminals :: (Map VisitIdentifier (Set Identifier)), derivings_Inh_ENonterminals :: (Derivings), importBlocks_Inh_ENonterminals :: (PP_Doc), inhmap_Inh_ENonterminals :: (Map NontermIdent Attributes), localAttrTypes_Inh_ENonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))), mainFile_Inh_ENonterminals :: (String), mainName_Inh_ENonterminals :: (String), moduleHeader_Inh_ENonterminals :: (String -> String -> String -> Bool -> String), options_Inh_ENonterminals :: (Options), pragmaBlocks_Inh_ENonterminals :: (String), synmap_Inh_ENonterminals :: (Map NontermIdent Attributes), textBlocks_Inh_ENonterminals :: (PP_Doc), typeSyns_Inh_ENonterminals :: (TypeSyns), wrappers_Inh_ENonterminals :: (Set NontermIdent) } data Syn_ENonterminals = Syn_ENonterminals { appendCommon_Syn_ENonterminals :: ([PP_Doc]), appendMain_Syn_ENonterminals :: ([PP_Doc]), childvisit_Syn_ENonterminals :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), errors_Syn_ENonterminals :: (Seq Error), fromToStates_Syn_ENonterminals :: (Map VisitIdentifier (Int,Int)), genProdIO_Syn_ENonterminals :: (IO ()), imports_Syn_ENonterminals :: ([PP_Doc]), initStates_Syn_ENonterminals :: (Map NontermIdent Int), output_Syn_ENonterminals :: (PP_Doc), semFunBndDefs_Syn_ENonterminals :: (Seq PP_Doc), semFunBndTps_Syn_ENonterminals :: (Seq PP_Doc), visitKinds_Syn_ENonterminals :: (Map VisitIdentifier VisitKind), visitdefs_Syn_ENonterminals :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_ENonterminals :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_ENonterminals #-} wrap_ENonterminals :: T_ENonterminals -> Inh_ENonterminals -> (Syn_ENonterminals ) wrap_ENonterminals (T_ENonterminals act) (Inh_ENonterminals _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do sem <- act let arg10 = T_ENonterminals_vIn10 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers (T_ENonterminals_vOut10 _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_ENonterminals_s11 sem arg10) return (Syn_ENonterminals _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# NOINLINE sem_ENonterminals #-} sem_ENonterminals :: ENonterminals -> T_ENonterminals sem_ENonterminals list = Prelude.foldr sem_ENonterminals_Cons sem_ENonterminals_Nil (Prelude.map sem_ENonterminal list) -- semantic domain newtype T_ENonterminals = T_ENonterminals { attach_T_ENonterminals :: Identity (T_ENonterminals_s11 ) } newtype T_ENonterminals_s11 = C_ENonterminals_s11 { inv_ENonterminals_s11 :: (T_ENonterminals_v10 ) } data T_ENonterminals_s12 = C_ENonterminals_s12 type T_ENonterminals_v10 = (T_ENonterminals_vIn10 ) -> (T_ENonterminals_vOut10 ) data T_ENonterminals_vIn10 = T_ENonterminals_vIn10 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Int) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Derivings) (PP_Doc) (Map NontermIdent Attributes) (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) (String) (String) (String -> String -> String -> Bool -> String) (Options) (String) (Map NontermIdent Attributes) (PP_Doc) (TypeSyns) (Set NontermIdent) data T_ENonterminals_vOut10 = T_ENonterminals_vOut10 ([PP_Doc]) ([PP_Doc]) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Seq Error) (Map VisitIdentifier (Int,Int)) (IO ()) ([PP_Doc]) (Map NontermIdent Int) (PP_Doc) (Seq PP_Doc) (Seq PP_Doc) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_ENonterminals_Cons #-} sem_ENonterminals_Cons :: T_ENonterminal -> T_ENonterminals -> T_ENonterminals sem_ENonterminals_Cons arg_hd_ arg_tl_ = T_ENonterminals (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_ENonterminals_v10 v10 = \ (T_ENonterminals_vIn10 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers) -> ( let _hdX8 = Control.Monad.Identity.runIdentity (attach_T_ENonterminal (arg_hd_)) _tlX11 = Control.Monad.Identity.runIdentity (attach_T_ENonterminals (arg_tl_)) (T_ENonterminal_vOut7 _hdIappendCommon _hdIappendMain _hdIchildvisit _hdIerrors _hdIfromToStates _hdIgenProdIO _hdIimports _hdIinitStates _hdIoutput _hdIsemFunBndDefs _hdIsemFunBndTps _hdIvisitKinds _hdIvisitdefs _hdIvisituses) = inv_ENonterminal_s8 _hdX8 (T_ENonterminal_vIn7 _hdOallFromToStates _hdOallInitStates _hdOallVisitKinds _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOderivings _hdOimportBlocks _hdOinhmap _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOoptions _hdOpragmaBlocks _hdOsynmap _hdOtextBlocks _hdOtypeSyns _hdOwrappers) (T_ENonterminals_vOut10 _tlIappendCommon _tlIappendMain _tlIchildvisit _tlIerrors _tlIfromToStates _tlIgenProdIO _tlIimports _tlIinitStates _tlIoutput _tlIsemFunBndDefs _tlIsemFunBndTps _tlIvisitKinds _tlIvisitdefs _tlIvisituses) = inv_ENonterminals_s11 _tlX11 (T_ENonterminals_vIn10 _tlOallFromToStates _tlOallInitStates _tlOallVisitKinds _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOderivings _tlOimportBlocks _tlOinhmap _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOoptions _tlOpragmaBlocks _tlOsynmap _tlOtextBlocks _tlOtypeSyns _tlOwrappers) _lhsOappendCommon :: [PP_Doc] _lhsOappendCommon = rule159 _hdIappendCommon _tlIappendCommon _lhsOappendMain :: [PP_Doc] _lhsOappendMain = rule160 _hdIappendMain _tlIappendMain _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule161 _hdIchildvisit _tlIchildvisit _lhsOerrors :: Seq Error _lhsOerrors = rule162 _hdIerrors _tlIerrors _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule163 _hdIfromToStates _tlIfromToStates _lhsOgenProdIO :: IO () _lhsOgenProdIO = rule164 _hdIgenProdIO _tlIgenProdIO _lhsOimports :: [PP_Doc] _lhsOimports = rule165 _hdIimports _tlIimports _lhsOinitStates :: Map NontermIdent Int _lhsOinitStates = rule166 _hdIinitStates _tlIinitStates _lhsOoutput :: PP_Doc _lhsOoutput = rule167 _hdIoutput _tlIoutput _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule168 _hdIsemFunBndDefs _tlIsemFunBndDefs _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule169 _hdIsemFunBndTps _tlIsemFunBndTps _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule170 _hdIvisitKinds _tlIvisitKinds _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule171 _hdIvisitdefs _tlIvisitdefs _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule172 _hdIvisituses _tlIvisituses _hdOallFromToStates = rule173 _lhsIallFromToStates _hdOallInitStates = rule174 _lhsIallInitStates _hdOallVisitKinds = rule175 _lhsIallVisitKinds _hdOallchildvisit = rule176 _lhsIallchildvisit _hdOavisitdefs = rule177 _lhsIavisitdefs _hdOavisituses = rule178 _lhsIavisituses _hdOderivings = rule179 _lhsIderivings _hdOimportBlocks = rule180 _lhsIimportBlocks _hdOinhmap = rule181 _lhsIinhmap _hdOlocalAttrTypes = rule182 _lhsIlocalAttrTypes _hdOmainFile = rule183 _lhsImainFile _hdOmainName = rule184 _lhsImainName _hdOmoduleHeader = rule185 _lhsImoduleHeader _hdOoptions = rule186 _lhsIoptions _hdOpragmaBlocks = rule187 _lhsIpragmaBlocks _hdOsynmap = rule188 _lhsIsynmap _hdOtextBlocks = rule189 _lhsItextBlocks _hdOtypeSyns = rule190 _lhsItypeSyns _hdOwrappers = rule191 _lhsIwrappers _tlOallFromToStates = rule192 _lhsIallFromToStates _tlOallInitStates = rule193 _lhsIallInitStates _tlOallVisitKinds = rule194 _lhsIallVisitKinds _tlOallchildvisit = rule195 _lhsIallchildvisit _tlOavisitdefs = rule196 _lhsIavisitdefs _tlOavisituses = rule197 _lhsIavisituses _tlOderivings = rule198 _lhsIderivings _tlOimportBlocks = rule199 _lhsIimportBlocks _tlOinhmap = rule200 _lhsIinhmap _tlOlocalAttrTypes = rule201 _lhsIlocalAttrTypes _tlOmainFile = rule202 _lhsImainFile _tlOmainName = rule203 _lhsImainName _tlOmoduleHeader = rule204 _lhsImoduleHeader _tlOoptions = rule205 _lhsIoptions _tlOpragmaBlocks = rule206 _lhsIpragmaBlocks _tlOsynmap = rule207 _lhsIsynmap _tlOtextBlocks = rule208 _lhsItextBlocks _tlOtypeSyns = rule209 _lhsItypeSyns _tlOwrappers = rule210 _lhsIwrappers __result_ = T_ENonterminals_vOut10 _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_ENonterminals_s11 v10 {-# INLINE rule159 #-} rule159 = \ ((_hdIappendCommon) :: PP_Doc ) ((_tlIappendCommon) :: [PP_Doc]) -> _hdIappendCommon : _tlIappendCommon {-# INLINE rule160 #-} rule160 = \ ((_hdIappendMain) :: PP_Doc ) ((_tlIappendMain) :: [PP_Doc]) -> _hdIappendMain : _tlIappendMain {-# INLINE rule161 #-} rule161 = \ ((_hdIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) ((_tlIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _hdIchildvisit `Map.union` _tlIchildvisit {-# INLINE rule162 #-} rule162 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule163 #-} rule163 = \ ((_hdIfromToStates) :: Map VisitIdentifier (Int,Int)) ((_tlIfromToStates) :: Map VisitIdentifier (Int,Int)) -> _hdIfromToStates `mappend` _tlIfromToStates {-# INLINE rule164 #-} rule164 = \ ((_hdIgenProdIO) :: IO ()) ((_tlIgenProdIO) :: IO ()) -> _hdIgenProdIO >> _tlIgenProdIO {-# INLINE rule165 #-} rule165 = \ ((_hdIimports) :: [PP_Doc]) ((_tlIimports) :: [PP_Doc]) -> _hdIimports ++ _tlIimports {-# INLINE rule166 #-} rule166 = \ ((_hdIinitStates) :: Map NontermIdent Int) ((_tlIinitStates) :: Map NontermIdent Int) -> _hdIinitStates `mappend` _tlIinitStates {-# INLINE rule167 #-} rule167 = \ ((_hdIoutput) :: PP_Doc) ((_tlIoutput) :: PP_Doc) -> _hdIoutput >-< _tlIoutput {-# INLINE rule168 #-} rule168 = \ ((_hdIsemFunBndDefs) :: Seq PP_Doc) ((_tlIsemFunBndDefs) :: Seq PP_Doc) -> _hdIsemFunBndDefs Seq.>< _tlIsemFunBndDefs {-# INLINE rule169 #-} rule169 = \ ((_hdIsemFunBndTps) :: Seq PP_Doc) ((_tlIsemFunBndTps) :: Seq PP_Doc) -> _hdIsemFunBndTps Seq.>< _tlIsemFunBndTps {-# INLINE rule170 #-} rule170 = \ ((_hdIvisitKinds) :: Map VisitIdentifier VisitKind) ((_tlIvisitKinds) :: Map VisitIdentifier VisitKind) -> _hdIvisitKinds `mappend` _tlIvisitKinds {-# INLINE rule171 #-} rule171 = \ ((_hdIvisitdefs) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisitdefs `uwSetUnion` _tlIvisitdefs {-# INLINE rule172 #-} rule172 = \ ((_hdIvisituses) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisituses) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisituses `uwSetUnion` _tlIvisituses {-# INLINE rule173 #-} rule173 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule174 #-} rule174 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule175 #-} rule175 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule176 #-} rule176 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule177 #-} rule177 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule178 #-} rule178 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule179 #-} rule179 = \ ((_lhsIderivings) :: Derivings) -> _lhsIderivings {-# INLINE rule180 #-} rule180 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule181 #-} rule181 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) -> _lhsIinhmap {-# INLINE rule182 #-} rule182 = \ ((_lhsIlocalAttrTypes) :: Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) -> _lhsIlocalAttrTypes {-# INLINE rule183 #-} rule183 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule184 #-} rule184 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule185 #-} rule185 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule186 #-} rule186 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule187 #-} rule187 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule188 #-} rule188 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) -> _lhsIsynmap {-# INLINE rule189 #-} rule189 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule190 #-} rule190 = \ ((_lhsItypeSyns) :: TypeSyns) -> _lhsItypeSyns {-# INLINE rule191 #-} rule191 = \ ((_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# INLINE rule192 #-} rule192 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule193 #-} rule193 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule194 #-} rule194 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule195 #-} rule195 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule196 #-} rule196 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule197 #-} rule197 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule198 #-} rule198 = \ ((_lhsIderivings) :: Derivings) -> _lhsIderivings {-# INLINE rule199 #-} rule199 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule200 #-} rule200 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) -> _lhsIinhmap {-# INLINE rule201 #-} rule201 = \ ((_lhsIlocalAttrTypes) :: Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) -> _lhsIlocalAttrTypes {-# INLINE rule202 #-} rule202 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule203 #-} rule203 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule204 #-} rule204 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule205 #-} rule205 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule206 #-} rule206 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule207 #-} rule207 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) -> _lhsIsynmap {-# INLINE rule208 #-} rule208 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule209 #-} rule209 = \ ((_lhsItypeSyns) :: TypeSyns) -> _lhsItypeSyns {-# INLINE rule210 #-} rule210 = \ ((_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# NOINLINE sem_ENonterminals_Nil #-} sem_ENonterminals_Nil :: T_ENonterminals sem_ENonterminals_Nil = T_ENonterminals (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_ENonterminals_v10 v10 = \ (T_ENonterminals_vIn10 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIderivings _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks _lhsItypeSyns _lhsIwrappers) -> ( let _lhsOappendCommon :: [PP_Doc] _lhsOappendCommon = rule211 () _lhsOappendMain :: [PP_Doc] _lhsOappendMain = rule212 () _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule213 () _lhsOerrors :: Seq Error _lhsOerrors = rule214 () _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule215 () _lhsOgenProdIO :: IO () _lhsOgenProdIO = rule216 () _lhsOimports :: [PP_Doc] _lhsOimports = rule217 () _lhsOinitStates :: Map NontermIdent Int _lhsOinitStates = rule218 () _lhsOoutput :: PP_Doc _lhsOoutput = rule219 () _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule220 () _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule221 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule222 () _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule223 () _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule224 () __result_ = T_ENonterminals_vOut10 _lhsOappendCommon _lhsOappendMain _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOinitStates _lhsOoutput _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_ENonterminals_s11 v10 {-# INLINE rule211 #-} rule211 = \ (_ :: ()) -> [] {-# INLINE rule212 #-} rule212 = \ (_ :: ()) -> [] {-# INLINE rule213 #-} rule213 = \ (_ :: ()) -> Map.empty {-# INLINE rule214 #-} rule214 = \ (_ :: ()) -> Seq.empty {-# INLINE rule215 #-} rule215 = \ (_ :: ()) -> mempty {-# INLINE rule216 #-} rule216 = \ (_ :: ()) -> return () {-# INLINE rule217 #-} rule217 = \ (_ :: ()) -> [] {-# INLINE rule218 #-} rule218 = \ (_ :: ()) -> mempty {-# INLINE rule219 #-} rule219 = \ (_ :: ()) -> empty {-# INLINE rule220 #-} rule220 = \ (_ :: ()) -> Seq.empty {-# INLINE rule221 #-} rule221 = \ (_ :: ()) -> Seq.empty {-# INLINE rule222 #-} rule222 = \ (_ :: ()) -> mempty {-# INLINE rule223 #-} rule223 = \ (_ :: ()) -> Map.empty {-# INLINE rule224 #-} rule224 = \ (_ :: ()) -> Map.empty -- EProduction ------------------------------------------------- -- wrapper data Inh_EProduction = Inh_EProduction { allFromToStates_Inh_EProduction :: (Map VisitIdentifier (Int,Int)), allInhmap_Inh_EProduction :: (Map NontermIdent Attributes), allInitStates_Inh_EProduction :: (Map NontermIdent Int), allSynmap_Inh_EProduction :: (Map NontermIdent Attributes), allVisitKinds_Inh_EProduction :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_EProduction :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), allstates_Inh_EProduction :: (Set StateIdentifier), avisitdefs_Inh_EProduction :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_EProduction :: (Map VisitIdentifier (Set Identifier)), classCtxs_Inh_EProduction :: (ClassContext), importBlocks_Inh_EProduction :: (PP_Doc), inhmap_Inh_EProduction :: (Attributes), initial_Inh_EProduction :: (StateIdentifier), localAttrTypes_Inh_EProduction :: (Map ConstructorIdent (Map Identifier Type)), mainFile_Inh_EProduction :: (String), mainName_Inh_EProduction :: (String), moduleHeader_Inh_EProduction :: (String -> String -> String -> Bool -> String), nextVisits_Inh_EProduction :: (Map StateIdentifier StateCtx), nt_Inh_EProduction :: (NontermIdent), ntType_Inh_EProduction :: (Type), options_Inh_EProduction :: (Options), params_Inh_EProduction :: ([Identifier]), pragmaBlocks_Inh_EProduction :: (String), prevVisits_Inh_EProduction :: (Map StateIdentifier StateCtx), rename_Inh_EProduction :: (Bool), synmap_Inh_EProduction :: (Attributes), textBlocks_Inh_EProduction :: (PP_Doc) } data Syn_EProduction = Syn_EProduction { allvisits_Syn_EProduction :: ([VisitStateState]), childvisit_Syn_EProduction :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), count_Syn_EProduction :: (Int), datatype_Syn_EProduction :: (PP_Doc), errors_Syn_EProduction :: (Seq Error), fromToStates_Syn_EProduction :: (Map VisitIdentifier (Int,Int)), genProdIO_Syn_EProduction :: (IO ()), imports_Syn_EProduction :: ([PP_Doc]), semFunBndDefs_Syn_EProduction :: (Seq PP_Doc), semFunBndTps_Syn_EProduction :: (Seq PP_Doc), sem_nt_Syn_EProduction :: (PP_Doc), sem_prod_Syn_EProduction :: (PP_Doc), t_visits_Syn_EProduction :: (PP_Doc), visitKinds_Syn_EProduction :: (Map VisitIdentifier VisitKind), visitdefs_Syn_EProduction :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_EProduction :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_EProduction #-} wrap_EProduction :: T_EProduction -> Inh_EProduction -> (Syn_EProduction ) wrap_EProduction (T_EProduction act) (Inh_EProduction _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIpragmaBlocks _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do sem <- act let arg13 = T_EProduction_vIn13 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIpragmaBlocks _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks (T_EProduction_vOut13 _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_EProduction_s14 sem arg13) return (Syn_EProduction _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# INLINE sem_EProduction #-} sem_EProduction :: EProduction -> T_EProduction sem_EProduction ( EProduction con_ params_ constraints_ rules_ children_ visits_ ) = sem_EProduction_EProduction con_ params_ constraints_ ( sem_ERules rules_ ) ( sem_EChildren children_ ) ( sem_Visits visits_ ) -- semantic domain newtype T_EProduction = T_EProduction { attach_T_EProduction :: Identity (T_EProduction_s14 ) } newtype T_EProduction_s14 = C_EProduction_s14 { inv_EProduction_s14 :: (T_EProduction_v13 ) } data T_EProduction_s15 = C_EProduction_s15 type T_EProduction_v13 = (T_EProduction_vIn13 ) -> (T_EProduction_vOut13 ) data T_EProduction_vIn13 = T_EProduction_vIn13 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Attributes) (Map NontermIdent Int) (Map NontermIdent Attributes) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Set StateIdentifier) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (ClassContext) (PP_Doc) (Attributes) (StateIdentifier) (Map ConstructorIdent (Map Identifier Type)) (String) (String) (String -> String -> String -> Bool -> String) (Map StateIdentifier StateCtx) (NontermIdent) (Type) (Options) ([Identifier]) (String) (Map StateIdentifier StateCtx) (Bool) (Attributes) (PP_Doc) data T_EProduction_vOut13 = T_EProduction_vOut13 ([VisitStateState]) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Int) (PP_Doc) (Seq Error) (Map VisitIdentifier (Int,Int)) (IO ()) ([PP_Doc]) (Seq PP_Doc) (Seq PP_Doc) (PP_Doc) (PP_Doc) (PP_Doc) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_EProduction_EProduction #-} sem_EProduction_EProduction :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_ERules -> T_EChildren -> T_Visits -> T_EProduction sem_EProduction_EProduction arg_con_ arg_params_ arg_constraints_ arg_rules_ arg_children_ arg_visits_ = T_EProduction (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_EProduction_v13 v13 = \ (T_EProduction_vIn13 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIpragmaBlocks _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks) -> ( let _rulesX23 = Control.Monad.Identity.runIdentity (attach_T_ERules (arg_rules_)) _childrenX5 = Control.Monad.Identity.runIdentity (attach_T_EChildren (arg_children_)) _visitsX56 = Control.Monad.Identity.runIdentity (attach_T_Visits (arg_visits_)) (T_ERules_vOut22 _rulesIerrors _rulesImrules _rulesIruledefs _rulesIruleuses _rulesIsem_rules _rulesIusedArgs) = inv_ERules_s23 _rulesX23 (T_ERules_vIn22 _rulesOallInhmap _rulesOallSynmap _rulesOchildTypes _rulesOcon _rulesOimportBlocks _rulesOinhmap _rulesOlazyIntras _rulesOlocalAttrTypes _rulesOmainFile _rulesOmainName _rulesOmoduleHeader _rulesOnt _rulesOoptions _rulesOpragmaBlocks _rulesOruleKinds _rulesOsynmap _rulesOtextBlocks _rulesOusageInfo) (T_EChildren_vOut4 _childrenIargnamesw _childrenIargpats _childrenIargtps _childrenIchildTypes _childrenIchildintros _childrenIdatatype _childrenIterminaldefs _childrenIusedArgs) = inv_EChildren_s5 _childrenX5 (T_EChildren_vIn4 _childrenOallInitStates _childrenOcon _childrenOimportBlocks _childrenOmainFile _childrenOmainName _childrenOmoduleHeader _childrenOnt _childrenOoptions _childrenOpragmaBlocks _childrenOtextBlocks) (T_Visits_vOut55 _visitsIallvisits _visitsIchildvisit _visitsIerrors _visitsIfromToStates _visitsIintramap _visitsIlazyIntras _visitsIruleKinds _visitsIruleUsage _visitsIsem_visit _visitsIt_visits _visitsIusedArgs _visitsIvisitKinds _visitsIvisitdefs _visitsIvisituses) = inv_Visits_s56 _visitsX56 (T_Visits_vIn55 _visitsOallFromToStates _visitsOallInhmap _visitsOallInitStates _visitsOallSynmap _visitsOallVisitKinds _visitsOallchildvisit _visitsOallintramap _visitsOavisitdefs _visitsOavisituses _visitsOchildTypes _visitsOchildintros _visitsOcon _visitsOinhmap _visitsOmrules _visitsOnextVisits _visitsOnt _visitsOoptions _visitsOparams _visitsOprevVisits _visitsOruledefs _visitsOruleuses _visitsOsynmap _visitsOterminaldefs) _childrenOcon = rule225 arg_con_ _rulesOcon = rule226 arg_con_ _visitsOcon = rule227 arg_con_ _lhsOdatatype :: PP_Doc _lhsOdatatype = rule228 _childrenIdatatype _classPP1 _lhsInt _lhsIoptions _lhsIrename _quantPP1 arg_con_ _classPP1 = rule229 arg_constraints_ _quantPP1 = rule230 arg_params_ _lhsOcount :: Int _lhsOcount = rule231 () _lhsOsem_nt :: PP_Doc _lhsOsem_nt = rule232 _childrenIargnamesw _childrenIargpats _lhsInt _lhsIrename arg_con_ _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule233 _semFunBndDef _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule234 _semFunBndTp _semFunBndDef = rule235 _semFunBndNm _semname _semFunBndTp = rule236 _semFunBndNm _sem_tp _semFunBndNm = rule237 _lhsInt arg_con_ _t_type = rule238 _lhsInt _t_params = rule239 _lhsIparams _usedArgs = rule240 _childrenIusedArgs _rulesIusedArgs _visitsIusedArgs _args = rule241 _childrenIargpats _usedArgs _semname = rule242 _lhsInt arg_con_ _sem_tp = rule243 _childrenIargtps _classPP2 _quantPP2 _t_params _t_type _classPP2 = rule244 _lhsIclassCtxs arg_constraints_ _quantPP2 = rule245 _lhsIparams arg_params_ _sem_prod = rule246 _args _lhsIinitial _mbInitializer _mkSemBody _outerlet _scc _semInlinePragma _sem_tp _semname _t_type _mkSemBody = rule247 () _mbInitializer = rule248 _lhsIoptions _scc = rule249 _lhsIoptions _semname _semInlinePragma = rule250 _lhsIoptions _semname _outerlet = rule251 _rulesIsem_rules _statefns _statefns = rule252 _genstfn _lhsIallstates _genstfn = rule253 _addbang _lhsIinitial _lhsInextVisits _lhsInt _lhsIoptions _lhsIprevVisits _stargs _stks _stvs _stargs = rule254 _addbang _childTypes _lazyIntras _lhsIallInhmap _lhsIallSynmap _lhsIoptions _localAttrTypes _visitsIintramap _stks = rule255 _lhsInt _lhsIoptions _stvisits _t_params _stvisits = rule256 _visitsIallvisits _stvs = rule257 _visitsIsem_visit _visitsOmrules = rule258 _rulesImrules _visitsOchildintros = rule259 _childrenIchildintros _rulesOusageInfo = rule260 _visitsIruleUsage _rulesOruleKinds = rule261 _visitsIruleKinds _visitsOallintramap = rule262 _visitsIintramap _visitsOterminaldefs = rule263 _childrenIterminaldefs _visitsOruledefs = rule264 _rulesIruledefs _visitsOruleuses = rule265 _rulesIruleuses _lazyIntras = rule266 _visitsIlazyIntras _lhsOimports :: [PP_Doc] _lhsOimports = rule267 _moduleName _moduleName = rule268 _lhsImainName _suffix _suffix = rule269 _lhsInt arg_con_ _outputfile = rule270 _lhsImainFile _suffix _ppMonadImports = rule271 _lhsIoptions _lhsOgenProdIO :: IO () _lhsOgenProdIO = rule272 _lhsIimportBlocks _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _outputfile _ppMonadImports _sem_prod _semname _suffix _addbang = rule273 _lhsIoptions _childTypes = rule274 _childrenIchildTypes _lhsIntType _localAttrTypes = rule275 _lhsIlocalAttrTypes arg_con_ _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule276 _visitsIchildvisit _lhsOerrors :: Seq Error _lhsOerrors = rule277 _rulesIerrors _visitsIerrors _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule278 _visitsIfromToStates _lhsOt_visits :: PP_Doc _lhsOt_visits = rule279 _visitsIt_visits _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule280 _visitsIvisitKinds _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule281 _visitsIvisitdefs _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule282 _visitsIvisituses _lhsOallvisits :: [VisitStateState] _lhsOallvisits = rule283 _visitsIallvisits _lhsOsem_prod :: PP_Doc _lhsOsem_prod = rule284 _sem_prod _rulesOallInhmap = rule285 _lhsIallInhmap _rulesOallSynmap = rule286 _lhsIallSynmap _rulesOchildTypes = rule287 _childTypes _rulesOimportBlocks = rule288 _lhsIimportBlocks _rulesOinhmap = rule289 _lhsIinhmap _rulesOlazyIntras = rule290 _lazyIntras _rulesOlocalAttrTypes = rule291 _localAttrTypes _rulesOmainFile = rule292 _lhsImainFile _rulesOmainName = rule293 _lhsImainName _rulesOmoduleHeader = rule294 _lhsImoduleHeader _rulesOnt = rule295 _lhsInt _rulesOoptions = rule296 _lhsIoptions _rulesOpragmaBlocks = rule297 _lhsIpragmaBlocks _rulesOsynmap = rule298 _lhsIsynmap _rulesOtextBlocks = rule299 _lhsItextBlocks _childrenOallInitStates = rule300 _lhsIallInitStates _childrenOimportBlocks = rule301 _lhsIimportBlocks _childrenOmainFile = rule302 _lhsImainFile _childrenOmainName = rule303 _lhsImainName _childrenOmoduleHeader = rule304 _lhsImoduleHeader _childrenOnt = rule305 _lhsInt _childrenOoptions = rule306 _lhsIoptions _childrenOpragmaBlocks = rule307 _lhsIpragmaBlocks _childrenOtextBlocks = rule308 _lhsItextBlocks _visitsOallFromToStates = rule309 _lhsIallFromToStates _visitsOallInhmap = rule310 _lhsIallInhmap _visitsOallInitStates = rule311 _lhsIallInitStates _visitsOallSynmap = rule312 _lhsIallSynmap _visitsOallVisitKinds = rule313 _lhsIallVisitKinds _visitsOallchildvisit = rule314 _lhsIallchildvisit _visitsOavisitdefs = rule315 _lhsIavisitdefs _visitsOavisituses = rule316 _lhsIavisituses _visitsOchildTypes = rule317 _childTypes _visitsOinhmap = rule318 _lhsIinhmap _visitsOnextVisits = rule319 _lhsInextVisits _visitsOnt = rule320 _lhsInt _visitsOoptions = rule321 _lhsIoptions _visitsOparams = rule322 _lhsIparams _visitsOprevVisits = rule323 _lhsIprevVisits _visitsOsynmap = rule324 _lhsIsynmap __result_ = T_EProduction_vOut13 _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_EProduction_s14 v13 {-# INLINE rule225 #-} {-# LINE 71 "src-ag/ExecutionPlan2Hs.ag" #-} rule225 = \ con_ -> {-# LINE 71 "src-ag/ExecutionPlan2Hs.ag" #-} con_ {-# LINE 2198 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule226 #-} {-# LINE 72 "src-ag/ExecutionPlan2Hs.ag" #-} rule226 = \ con_ -> {-# LINE 72 "src-ag/ExecutionPlan2Hs.ag" #-} con_ {-# LINE 2204 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule227 #-} {-# LINE 73 "src-ag/ExecutionPlan2Hs.ag" #-} rule227 = \ con_ -> {-# LINE 73 "src-ag/ExecutionPlan2Hs.ag" #-} con_ {-# LINE 2210 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule228 #-} {-# LINE 186 "src-ag/ExecutionPlan2Hs.ag" #-} rule228 = \ ((_childrenIdatatype) :: [PP_Doc]) _classPP1 ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) ((_lhsIrename) :: Bool) _quantPP1 con_ -> {-# LINE 186 "src-ag/ExecutionPlan2Hs.ag" #-} _quantPP1 >#< _classPP1 >#< conname _lhsIrename _lhsInt con_ >#< ppConFields (dataRecords _lhsIoptions) _childrenIdatatype {-# LINE 2218 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule229 #-} {-# LINE 189 "src-ag/ExecutionPlan2Hs.ag" #-} rule229 = \ constraints_ -> {-# LINE 189 "src-ag/ExecutionPlan2Hs.ag" #-} ppClasses (classConstrsToDocs constraints_) {-# LINE 2224 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule230 #-} {-# LINE 190 "src-ag/ExecutionPlan2Hs.ag" #-} rule230 = \ params_ -> {-# LINE 190 "src-ag/ExecutionPlan2Hs.ag" #-} ppQuants params_ {-# LINE 2230 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule231 #-} {-# LINE 288 "src-ag/ExecutionPlan2Hs.ag" #-} rule231 = \ (_ :: ()) -> {-# LINE 288 "src-ag/ExecutionPlan2Hs.ag" #-} 1 {-# LINE 2236 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule232 #-} {-# LINE 293 "src-ag/ExecutionPlan2Hs.ag" #-} rule232 = \ ((_childrenIargnamesw) :: [PP_Doc]) ((_childrenIargpats) :: [PP_Doc] ) ((_lhsInt) :: NontermIdent) ((_lhsIrename) :: Bool) con_ -> {-# LINE 293 "src-ag/ExecutionPlan2Hs.ag" #-} "sem_" >|< _lhsInt >#< "(" >#< conname _lhsIrename _lhsInt con_ >#< ppSpaced _childrenIargpats >#< ")" >#< "=" >#< "sem_" >|< _lhsInt >|< "_" >|< con_ >#< ppSpaced _childrenIargnamesw {-# LINE 2243 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule233 #-} {-# LINE 534 "src-ag/ExecutionPlan2Hs.ag" #-} rule233 = \ _semFunBndDef -> {-# LINE 534 "src-ag/ExecutionPlan2Hs.ag" #-} Seq.singleton _semFunBndDef {-# LINE 2249 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule234 #-} {-# LINE 535 "src-ag/ExecutionPlan2Hs.ag" #-} rule234 = \ _semFunBndTp -> {-# LINE 535 "src-ag/ExecutionPlan2Hs.ag" #-} Seq.singleton _semFunBndTp {-# LINE 2255 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule235 #-} {-# LINE 536 "src-ag/ExecutionPlan2Hs.ag" #-} rule235 = \ _semFunBndNm _semname -> {-# LINE 536 "src-ag/ExecutionPlan2Hs.ag" #-} _semFunBndNm >#< "=" >#< _semname {-# LINE 2261 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule236 #-} {-# LINE 537 "src-ag/ExecutionPlan2Hs.ag" #-} rule236 = \ _semFunBndNm _sem_tp -> {-# LINE 537 "src-ag/ExecutionPlan2Hs.ag" #-} _semFunBndNm >#< "::" >#< _sem_tp {-# LINE 2267 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule237 #-} {-# LINE 538 "src-ag/ExecutionPlan2Hs.ag" #-} rule237 = \ ((_lhsInt) :: NontermIdent) con_ -> {-# LINE 538 "src-ag/ExecutionPlan2Hs.ag" #-} lateSemConLabel _lhsInt con_ {-# LINE 2273 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule238 #-} {-# LINE 596 "src-ag/ExecutionPlan2Hs.ag" #-} rule238 = \ ((_lhsInt) :: NontermIdent) -> {-# LINE 596 "src-ag/ExecutionPlan2Hs.ag" #-} "T_" >|< _lhsInt {-# LINE 2279 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule239 #-} {-# LINE 597 "src-ag/ExecutionPlan2Hs.ag" #-} rule239 = \ ((_lhsIparams) :: [Identifier]) -> {-# LINE 597 "src-ag/ExecutionPlan2Hs.ag" #-} ppSpaced _lhsIparams {-# LINE 2285 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule240 #-} {-# LINE 598 "src-ag/ExecutionPlan2Hs.ag" #-} rule240 = \ ((_childrenIusedArgs) :: Set String) ((_rulesIusedArgs) :: Set String) ((_visitsIusedArgs) :: Set String) -> {-# LINE 598 "src-ag/ExecutionPlan2Hs.ag" #-} _childrenIusedArgs `Set.union` _visitsIusedArgs `Set.union` _rulesIusedArgs {-# LINE 2291 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule241 #-} {-# LINE 601 "src-ag/ExecutionPlan2Hs.ag" #-} rule241 = \ ((_childrenIargpats) :: [PP_Doc] ) _usedArgs -> {-# LINE 601 "src-ag/ExecutionPlan2Hs.ag" #-} map (\x -> let (name,arg) = case show x of "" -> ("", empty) '!':name -> ("arg_" ++ name, "!arg_" >|< name) name -> ("arg_" ++ name, "arg_" >|< name) in if null name || name `Set.member` _usedArgs then arg else text "_") _childrenIargpats {-# LINE 2303 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule242 #-} {-# LINE 608 "src-ag/ExecutionPlan2Hs.ag" #-} rule242 = \ ((_lhsInt) :: NontermIdent) con_ -> {-# LINE 608 "src-ag/ExecutionPlan2Hs.ag" #-} "sem_" ++ show _lhsInt ++ "_" ++ show con_ {-# LINE 2309 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule243 #-} {-# LINE 609 "src-ag/ExecutionPlan2Hs.ag" #-} rule243 = \ ((_childrenIargtps) :: [PP_Doc] ) _classPP2 _quantPP2 _t_params _t_type -> {-# LINE 609 "src-ag/ExecutionPlan2Hs.ag" #-} _quantPP2 >#< _classPP2 >#< ppSpaced _childrenIargtps >#< _t_type >#< _t_params {-# LINE 2315 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule244 #-} {-# LINE 610 "src-ag/ExecutionPlan2Hs.ag" #-} rule244 = \ ((_lhsIclassCtxs) :: ClassContext) constraints_ -> {-# LINE 610 "src-ag/ExecutionPlan2Hs.ag" #-} ppClasses (classCtxsToDocs _lhsIclassCtxs ++ classConstrsToDocs constraints_) {-# LINE 2321 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule245 #-} {-# LINE 611 "src-ag/ExecutionPlan2Hs.ag" #-} rule245 = \ ((_lhsIparams) :: [Identifier]) params_ -> {-# LINE 611 "src-ag/ExecutionPlan2Hs.ag" #-} ppQuants (_lhsIparams ++ params_) {-# LINE 2327 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule246 #-} {-# LINE 612 "src-ag/ExecutionPlan2Hs.ag" #-} rule246 = \ _args ((_lhsIinitial) :: StateIdentifier) _mbInitializer _mkSemBody _outerlet _scc _semInlinePragma _sem_tp _semname _t_type -> {-# LINE 612 "src-ag/ExecutionPlan2Hs.ag" #-} _semInlinePragma >-< _semname >#< "::" >#< _sem_tp >-< _mkSemBody (_semname >#< ppSpaced _args >#< "=" >#< _scc >#< _t_type ) _mbInitializer _outerlet ("return" >#< "st" >|< _lhsIinitial) {-# LINE 2336 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule247 #-} {-# LINE 616 "src-ag/ExecutionPlan2Hs.ag" #-} rule247 = \ (_ :: ()) -> {-# LINE 616 "src-ag/ExecutionPlan2Hs.ag" #-} \prefix mbInit outerlet ret -> case mbInit of Nothing -> prefix >#< pp_parens ret >#< "where" >-< indent 3 outerlet Just m -> prefix >#< "(" >#< "do" >-< indent 1 ( m >-< "let" >-< indent 2 outerlet >-< ret ) >-< indent 1 ")" {-# LINE 2352 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule248 #-} {-# LINE 628 "src-ag/ExecutionPlan2Hs.ag" #-} rule248 = \ ((_lhsIoptions) :: Options) -> {-# LINE 628 "src-ag/ExecutionPlan2Hs.ag" #-} if parallelInvoke _lhsIoptions then (Nothing :: Maybe PP_Doc) else Nothing {-# LINE 2360 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule249 #-} {-# LINE 634 "src-ag/ExecutionPlan2Hs.ag" #-} rule249 = \ ((_lhsIoptions) :: Options) _semname -> {-# LINE 634 "src-ag/ExecutionPlan2Hs.ag" #-} if genCostCentres _lhsIoptions then ppCostCentre _semname else empty {-# LINE 2368 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule250 #-} {-# LINE 637 "src-ag/ExecutionPlan2Hs.ag" #-} rule250 = \ ((_lhsIoptions) :: Options) _semname -> {-# LINE 637 "src-ag/ExecutionPlan2Hs.ag" #-} if noInlinePragmas _lhsIoptions then empty else ppNoInline _semname {-# LINE 2376 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule251 #-} {-# LINE 640 "src-ag/ExecutionPlan2Hs.ag" #-} rule251 = \ ((_rulesIsem_rules) :: PP_Doc) _statefns -> {-# LINE 640 "src-ag/ExecutionPlan2Hs.ag" #-} vlist _statefns >-< _rulesIsem_rules {-# LINE 2382 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule252 #-} {-# LINE 641 "src-ag/ExecutionPlan2Hs.ag" #-} rule252 = \ _genstfn ((_lhsIallstates) :: Set StateIdentifier) -> {-# LINE 641 "src-ag/ExecutionPlan2Hs.ag" #-} map _genstfn $ Set.toList _lhsIallstates {-# LINE 2388 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule253 #-} {-# LINE 642 "src-ag/ExecutionPlan2Hs.ag" #-} rule253 = \ _addbang ((_lhsIinitial) :: StateIdentifier) ((_lhsInextVisits) :: Map StateIdentifier StateCtx) ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) _stargs _stks _stvs -> {-# LINE 642 "src-ag/ExecutionPlan2Hs.ag" #-} \st -> let nextVisitInfo = Map.findWithDefault ManyVis st _lhsInextVisits prevVisitInfo = Map.findWithDefault ManyVis st _lhsIprevVisits stNm = "st" >|< st lhs = pragma >-< bang stNm >#< "=" >#< ( if st == _lhsIinitial then empty else "\\" >#< _stargs st >#< "->" ) pragma = if noInlinePragmas _lhsIoptions then empty else if helpInlining _lhsIoptions then case prevVisitInfo of ManyVis -> ppNoInline stNm OneVis _ -> if aggressiveInlinePragmas _lhsIoptions then ppInline stNm else ppInlinable stNm NoneVis -> if st /= _lhsIinitial then error ("State " ++ show st ++ " is not reachable from the initial state.") else if aggressiveInlinePragmas _lhsIoptions then ppInline stNm else ppInlinable stNm else ppNoInline stNm cCon = "C_" >|< _lhsInt >|< "_s" >|< st bang | st == _lhsIinitial = _addbang | otherwise = id in case nextVisitInfo of NoneVis -> if st == _lhsIinitial then lhs >#< cCon else empty OneVis vId -> mklet lhs (_stvs st False) (cCon >#< "v" >|< vId) ManyVis -> mklet lhs (_stks st >-< _stvs st True) (cCon >#< "k" >|< st) {-# LINE 2426 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule254 #-} {-# LINE 684 "src-ag/ExecutionPlan2Hs.ag" #-} rule254 = \ _addbang _childTypes _lazyIntras ((_lhsIallInhmap) :: Map NontermIdent Attributes) ((_lhsIallSynmap) :: Map NontermIdent Attributes) ((_lhsIoptions) :: Options) _localAttrTypes ((_visitsIintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> {-# LINE 684 "src-ag/ExecutionPlan2Hs.ag" #-} \st -> let attrs = maybe Map.empty id $ Map.lookup st _visitsIintramap in ppSpaced [ let match | str `Set.member` _lazyIntras = pp str | otherwise = _addbang (pp str) in case mbAttr of Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs _lhsIoptions) -> case Map.lookup nm _localAttrTypes of Just tp -> pp_parens (pp_parens match >#< "::" >#< ppTp tp) Nothing -> match Just attr | not (noPerStateTypeSigs _lhsIoptions) -> case lookupAttrType attr _lhsIallInhmap _lhsIallSynmap _childTypes of Just tpDoc -> pp_parens (pp_parens match >#< "::" >#< tpDoc) Nothing -> match _ -> match | (str,mbAttr) <- Map.assocs attrs ] >#< dummyPat _lhsIoptions (Map.null attrs) {-# LINE 2446 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule255 #-} {-# LINE 700 "src-ag/ExecutionPlan2Hs.ag" #-} rule255 = \ ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) _stvisits _t_params -> {-# LINE 700 "src-ag/ExecutionPlan2Hs.ag" #-} \st -> if null (_stvisits st) then empty else ( if not (noInlinePragmas _lhsIoptions) && helpInlining _lhsIoptions then ppNoInline ("k" >|< st) else empty ) >-< "k" >|< st >#< "::" >#< "K_" >|< _lhsInt >|< "_s" >|< st >#< _t_params >#< "t" >#< "->" >#< "t" >-< vlist (map (\(v,f,t) -> "k" >|< st >#< "K_" >|< _lhsInt >|< "_v" >|< v >#< "=" >#< "v" >|< v) $ _stvisits st) {-# LINE 2460 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule256 #-} {-# LINE 709 "src-ag/ExecutionPlan2Hs.ag" #-} rule256 = \ ((_visitsIallvisits) :: [VisitStateState]) -> {-# LINE 709 "src-ag/ExecutionPlan2Hs.ag" #-} \st -> filter (\(v,f,t) -> f == st) _visitsIallvisits {-# LINE 2466 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule257 #-} {-# LINE 710 "src-ag/ExecutionPlan2Hs.ag" #-} rule257 = \ ((_visitsIsem_visit) :: [(StateIdentifier,Bool -> PP_Doc)] ) -> {-# LINE 710 "src-ag/ExecutionPlan2Hs.ag" #-} \st inlinePragma -> vlist [ppf inlinePragma | (f,ppf) <- _visitsIsem_visit, f == st] {-# LINE 2472 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule258 #-} {-# LINE 711 "src-ag/ExecutionPlan2Hs.ag" #-} rule258 = \ ((_rulesImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> {-# LINE 711 "src-ag/ExecutionPlan2Hs.ag" #-} _rulesImrules {-# LINE 2478 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule259 #-} {-# LINE 926 "src-ag/ExecutionPlan2Hs.ag" #-} rule259 = \ ((_childrenIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> {-# LINE 926 "src-ag/ExecutionPlan2Hs.ag" #-} _childrenIchildintros {-# LINE 2484 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule260 #-} {-# LINE 1281 "src-ag/ExecutionPlan2Hs.ag" #-} rule260 = \ ((_visitsIruleUsage) :: Map Identifier Int) -> {-# LINE 1281 "src-ag/ExecutionPlan2Hs.ag" #-} _visitsIruleUsage {-# LINE 2490 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule261 #-} {-# LINE 1296 "src-ag/ExecutionPlan2Hs.ag" #-} rule261 = \ ((_visitsIruleKinds) :: Map Identifier (Set VisitKind)) -> {-# LINE 1296 "src-ag/ExecutionPlan2Hs.ag" #-} _visitsIruleKinds {-# LINE 2496 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule262 #-} {-# LINE 1325 "src-ag/ExecutionPlan2Hs.ag" #-} rule262 = \ ((_visitsIintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> {-# LINE 1325 "src-ag/ExecutionPlan2Hs.ag" #-} _visitsIintramap {-# LINE 2502 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule263 #-} {-# LINE 1326 "src-ag/ExecutionPlan2Hs.ag" #-} rule263 = \ ((_childrenIterminaldefs) :: Set String) -> {-# LINE 1326 "src-ag/ExecutionPlan2Hs.ag" #-} _childrenIterminaldefs {-# LINE 2508 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule264 #-} {-# LINE 1350 "src-ag/ExecutionPlan2Hs.ag" #-} rule264 = \ ((_rulesIruledefs) :: Map Identifier (Set String)) -> {-# LINE 1350 "src-ag/ExecutionPlan2Hs.ag" #-} _rulesIruledefs {-# LINE 2514 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule265 #-} {-# LINE 1351 "src-ag/ExecutionPlan2Hs.ag" #-} rule265 = \ ((_rulesIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> {-# LINE 1351 "src-ag/ExecutionPlan2Hs.ag" #-} _rulesIruleuses {-# LINE 2520 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule266 #-} {-# LINE 1405 "src-ag/ExecutionPlan2Hs.ag" #-} rule266 = \ ((_visitsIlazyIntras) :: Set String) -> {-# LINE 1405 "src-ag/ExecutionPlan2Hs.ag" #-} _visitsIlazyIntras {-# LINE 2526 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule267 #-} {-# LINE 1502 "src-ag/ExecutionPlan2Hs.ag" #-} rule267 = \ _moduleName -> {-# LINE 1502 "src-ag/ExecutionPlan2Hs.ag" #-} [pp $ "import " ++ _moduleName ] {-# LINE 2532 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule268 #-} {-# LINE 1503 "src-ag/ExecutionPlan2Hs.ag" #-} rule268 = \ ((_lhsImainName) :: String) _suffix -> {-# LINE 1503 "src-ag/ExecutionPlan2Hs.ag" #-} _lhsImainName ++ _suffix {-# LINE 2538 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule269 #-} {-# LINE 1504 "src-ag/ExecutionPlan2Hs.ag" #-} rule269 = \ ((_lhsInt) :: NontermIdent) con_ -> {-# LINE 1504 "src-ag/ExecutionPlan2Hs.ag" #-} "_" ++ show _lhsInt ++ "_" ++ show con_ {-# LINE 2544 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule270 #-} {-# LINE 1505 "src-ag/ExecutionPlan2Hs.ag" #-} rule270 = \ ((_lhsImainFile) :: String) _suffix -> {-# LINE 1505 "src-ag/ExecutionPlan2Hs.ag" #-} replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ _suffix ) {-# LINE 2550 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule271 #-} {-# LINE 1506 "src-ag/ExecutionPlan2Hs.ag" #-} rule271 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1506 "src-ag/ExecutionPlan2Hs.ag" #-} if parallelInvoke _lhsIoptions then pp "import qualified System.IO.Unsafe(unsafePerformIO)" >-< pp "import System.IO(IO)" >-< pp "import Control.Concurrent(newEmptyMVar,forkIO,putMVar,takeMVar)" else pp "import Control.Monad.Identity" {-# LINE 2560 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule272 #-} {-# LINE 1511 "src-ag/ExecutionPlan2Hs.ag" #-} rule272 = \ ((_lhsIimportBlocks) :: PP_Doc) ((_lhsImainName) :: String) ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIoptions) :: Options) ((_lhsIpragmaBlocks) :: String) _outputfile _ppMonadImports _sem_prod _semname _suffix -> {-# LINE 1511 "src-ag/ExecutionPlan2Hs.ag" #-} writeModule _outputfile [ warrenFlagsPP _lhsIoptions , pp $ _lhsIpragmaBlocks , pp $ _lhsImoduleHeader _lhsImainName _suffix _semname True , _lhsIimportBlocks , _ppMonadImports , ( if tupleAsDummyToken _lhsIoptions then empty else pp "import GHC.Prim" ) , pp $ "import " ++ _lhsImainName ++ "_common" , _sem_prod ] {-# LINE 2578 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule273 #-} {-# LINE 1552 "src-ag/ExecutionPlan2Hs.ag" #-} rule273 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1552 "src-ag/ExecutionPlan2Hs.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 2584 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule274 #-} {-# LINE 1602 "src-ag/ExecutionPlan2Hs.ag" #-} rule274 = \ ((_childrenIchildTypes) :: Map Identifier Type) ((_lhsIntType) :: Type) -> {-# LINE 1602 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton _LHS _lhsIntType `Map.union` _childrenIchildTypes {-# LINE 2590 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule275 #-} {-# LINE 1619 "src-ag/ExecutionPlan2Hs.ag" #-} rule275 = \ ((_lhsIlocalAttrTypes) :: Map ConstructorIdent (Map Identifier Type)) con_ -> {-# LINE 1619 "src-ag/ExecutionPlan2Hs.ag" #-} Map.findWithDefault Map.empty con_ _lhsIlocalAttrTypes {-# LINE 2596 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule276 #-} rule276 = \ ((_visitsIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _visitsIchildvisit {-# INLINE rule277 #-} rule277 = \ ((_rulesIerrors) :: Seq Error) ((_visitsIerrors) :: Seq Error) -> _rulesIerrors Seq.>< _visitsIerrors {-# INLINE rule278 #-} rule278 = \ ((_visitsIfromToStates) :: Map VisitIdentifier (Int,Int)) -> _visitsIfromToStates {-# INLINE rule279 #-} rule279 = \ ((_visitsIt_visits) :: PP_Doc) -> _visitsIt_visits {-# INLINE rule280 #-} rule280 = \ ((_visitsIvisitKinds) :: Map VisitIdentifier VisitKind) -> _visitsIvisitKinds {-# INLINE rule281 #-} rule281 = \ ((_visitsIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _visitsIvisitdefs {-# INLINE rule282 #-} rule282 = \ ((_visitsIvisituses) :: Map VisitIdentifier (Set Identifier)) -> _visitsIvisituses {-# INLINE rule283 #-} rule283 = \ ((_visitsIallvisits) :: [VisitStateState]) -> _visitsIallvisits {-# INLINE rule284 #-} rule284 = \ _sem_prod -> _sem_prod {-# INLINE rule285 #-} rule285 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule286 #-} rule286 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule287 #-} rule287 = \ _childTypes -> _childTypes {-# INLINE rule288 #-} rule288 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule289 #-} rule289 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule290 #-} rule290 = \ _lazyIntras -> _lazyIntras {-# INLINE rule291 #-} rule291 = \ _localAttrTypes -> _localAttrTypes {-# INLINE rule292 #-} rule292 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule293 #-} rule293 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule294 #-} rule294 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule295 #-} rule295 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule296 #-} rule296 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule297 #-} rule297 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule298 #-} rule298 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule299 #-} rule299 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule300 #-} rule300 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule301 #-} rule301 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule302 #-} rule302 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule303 #-} rule303 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule304 #-} rule304 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule305 #-} rule305 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule306 #-} rule306 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule307 #-} rule307 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule308 #-} rule308 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule309 #-} rule309 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule310 #-} rule310 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule311 #-} rule311 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule312 #-} rule312 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule313 #-} rule313 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule314 #-} rule314 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule315 #-} rule315 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule316 #-} rule316 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule317 #-} rule317 = \ _childTypes -> _childTypes {-# INLINE rule318 #-} rule318 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule319 #-} rule319 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) -> _lhsInextVisits {-# INLINE rule320 #-} rule320 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule321 #-} rule321 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule322 #-} rule322 = \ ((_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule323 #-} rule323 = \ ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) -> _lhsIprevVisits {-# INLINE rule324 #-} rule324 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap -- EProductions ------------------------------------------------ -- wrapper data Inh_EProductions = Inh_EProductions { allFromToStates_Inh_EProductions :: (Map VisitIdentifier (Int,Int)), allInhmap_Inh_EProductions :: (Map NontermIdent Attributes), allInitStates_Inh_EProductions :: (Map NontermIdent Int), allSynmap_Inh_EProductions :: (Map NontermIdent Attributes), allVisitKinds_Inh_EProductions :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_EProductions :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), allstates_Inh_EProductions :: (Set StateIdentifier), avisitdefs_Inh_EProductions :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_EProductions :: (Map VisitIdentifier (Set Identifier)), classCtxs_Inh_EProductions :: (ClassContext), importBlocks_Inh_EProductions :: (PP_Doc), inhmap_Inh_EProductions :: (Attributes), initial_Inh_EProductions :: (StateIdentifier), localAttrTypes_Inh_EProductions :: (Map ConstructorIdent (Map Identifier Type)), mainFile_Inh_EProductions :: (String), mainName_Inh_EProductions :: (String), moduleHeader_Inh_EProductions :: (String -> String -> String -> Bool -> String), nextVisits_Inh_EProductions :: (Map StateIdentifier StateCtx), nt_Inh_EProductions :: (NontermIdent), ntType_Inh_EProductions :: (Type), options_Inh_EProductions :: (Options), params_Inh_EProductions :: ([Identifier]), pragmaBlocks_Inh_EProductions :: (String), prevVisits_Inh_EProductions :: (Map StateIdentifier StateCtx), rename_Inh_EProductions :: (Bool), synmap_Inh_EProductions :: (Attributes), textBlocks_Inh_EProductions :: (PP_Doc) } data Syn_EProductions = Syn_EProductions { allvisits_Syn_EProductions :: ([VisitStateState]), childvisit_Syn_EProductions :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), count_Syn_EProductions :: (Int), datatype_Syn_EProductions :: ([PP_Doc]), errors_Syn_EProductions :: (Seq Error), fromToStates_Syn_EProductions :: (Map VisitIdentifier (Int,Int)), genProdIO_Syn_EProductions :: (IO ()), imports_Syn_EProductions :: ([PP_Doc]), semFunBndDefs_Syn_EProductions :: (Seq PP_Doc), semFunBndTps_Syn_EProductions :: (Seq PP_Doc), sem_nt_Syn_EProductions :: (PP_Doc), sem_prod_Syn_EProductions :: (PP_Doc), t_visits_Syn_EProductions :: (PP_Doc), visitKinds_Syn_EProductions :: (Map VisitIdentifier VisitKind), visitdefs_Syn_EProductions :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_EProductions :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_EProductions #-} wrap_EProductions :: T_EProductions -> Inh_EProductions -> (Syn_EProductions ) wrap_EProductions (T_EProductions act) (Inh_EProductions _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIpragmaBlocks _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do sem <- act let arg16 = T_EProductions_vIn16 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIpragmaBlocks _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks (T_EProductions_vOut16 _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_EProductions_s17 sem arg16) return (Syn_EProductions _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# NOINLINE sem_EProductions #-} sem_EProductions :: EProductions -> T_EProductions sem_EProductions list = Prelude.foldr sem_EProductions_Cons sem_EProductions_Nil (Prelude.map sem_EProduction list) -- semantic domain newtype T_EProductions = T_EProductions { attach_T_EProductions :: Identity (T_EProductions_s17 ) } newtype T_EProductions_s17 = C_EProductions_s17 { inv_EProductions_s17 :: (T_EProductions_v16 ) } data T_EProductions_s18 = C_EProductions_s18 type T_EProductions_v16 = (T_EProductions_vIn16 ) -> (T_EProductions_vOut16 ) data T_EProductions_vIn16 = T_EProductions_vIn16 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Attributes) (Map NontermIdent Int) (Map NontermIdent Attributes) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Set StateIdentifier) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (ClassContext) (PP_Doc) (Attributes) (StateIdentifier) (Map ConstructorIdent (Map Identifier Type)) (String) (String) (String -> String -> String -> Bool -> String) (Map StateIdentifier StateCtx) (NontermIdent) (Type) (Options) ([Identifier]) (String) (Map StateIdentifier StateCtx) (Bool) (Attributes) (PP_Doc) data T_EProductions_vOut16 = T_EProductions_vOut16 ([VisitStateState]) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Int) ([PP_Doc]) (Seq Error) (Map VisitIdentifier (Int,Int)) (IO ()) ([PP_Doc]) (Seq PP_Doc) (Seq PP_Doc) (PP_Doc) (PP_Doc) (PP_Doc) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_EProductions_Cons #-} sem_EProductions_Cons :: T_EProduction -> T_EProductions -> T_EProductions sem_EProductions_Cons arg_hd_ arg_tl_ = T_EProductions (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_EProductions_v16 v16 = \ (T_EProductions_vIn16 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIpragmaBlocks _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_EProduction (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_EProductions (arg_tl_)) (T_EProduction_vOut13 _hdIallvisits _hdIchildvisit _hdIcount _hdIdatatype _hdIerrors _hdIfromToStates _hdIgenProdIO _hdIimports _hdIsemFunBndDefs _hdIsemFunBndTps _hdIsem_nt _hdIsem_prod _hdIt_visits _hdIvisitKinds _hdIvisitdefs _hdIvisituses) = inv_EProduction_s14 _hdX14 (T_EProduction_vIn13 _hdOallFromToStates _hdOallInhmap _hdOallInitStates _hdOallSynmap _hdOallVisitKinds _hdOallchildvisit _hdOallstates _hdOavisitdefs _hdOavisituses _hdOclassCtxs _hdOimportBlocks _hdOinhmap _hdOinitial _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnextVisits _hdOnt _hdOntType _hdOoptions _hdOparams _hdOpragmaBlocks _hdOprevVisits _hdOrename _hdOsynmap _hdOtextBlocks) (T_EProductions_vOut16 _tlIallvisits _tlIchildvisit _tlIcount _tlIdatatype _tlIerrors _tlIfromToStates _tlIgenProdIO _tlIimports _tlIsemFunBndDefs _tlIsemFunBndTps _tlIsem_nt _tlIsem_prod _tlIt_visits _tlIvisitKinds _tlIvisitdefs _tlIvisituses) = inv_EProductions_s17 _tlX17 (T_EProductions_vIn16 _tlOallFromToStates _tlOallInhmap _tlOallInitStates _tlOallSynmap _tlOallVisitKinds _tlOallchildvisit _tlOallstates _tlOavisitdefs _tlOavisituses _tlOclassCtxs _tlOimportBlocks _tlOinhmap _tlOinitial _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnextVisits _tlOnt _tlOntType _tlOoptions _tlOparams _tlOpragmaBlocks _tlOprevVisits _tlOrename _tlOsynmap _tlOtextBlocks) _lhsOallvisits :: [VisitStateState] _lhsOallvisits = rule325 _hdIallvisits _lhsOt_visits :: PP_Doc _lhsOt_visits = rule326 _hdIt_visits _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule327 _hdIchildvisit _tlIchildvisit _lhsOcount :: Int _lhsOcount = rule328 _hdIcount _tlIcount _lhsOdatatype :: [PP_Doc] _lhsOdatatype = rule329 _hdIdatatype _tlIdatatype _lhsOerrors :: Seq Error _lhsOerrors = rule330 _hdIerrors _tlIerrors _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule331 _hdIfromToStates _tlIfromToStates _lhsOgenProdIO :: IO () _lhsOgenProdIO = rule332 _hdIgenProdIO _tlIgenProdIO _lhsOimports :: [PP_Doc] _lhsOimports = rule333 _hdIimports _tlIimports _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule334 _hdIsemFunBndDefs _tlIsemFunBndDefs _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule335 _hdIsemFunBndTps _tlIsemFunBndTps _lhsOsem_nt :: PP_Doc _lhsOsem_nt = rule336 _hdIsem_nt _tlIsem_nt _lhsOsem_prod :: PP_Doc _lhsOsem_prod = rule337 _hdIsem_prod _tlIsem_prod _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule338 _hdIvisitKinds _tlIvisitKinds _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule339 _hdIvisitdefs _tlIvisitdefs _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule340 _hdIvisituses _tlIvisituses _hdOallFromToStates = rule341 _lhsIallFromToStates _hdOallInhmap = rule342 _lhsIallInhmap _hdOallInitStates = rule343 _lhsIallInitStates _hdOallSynmap = rule344 _lhsIallSynmap _hdOallVisitKinds = rule345 _lhsIallVisitKinds _hdOallchildvisit = rule346 _lhsIallchildvisit _hdOallstates = rule347 _lhsIallstates _hdOavisitdefs = rule348 _lhsIavisitdefs _hdOavisituses = rule349 _lhsIavisituses _hdOclassCtxs = rule350 _lhsIclassCtxs _hdOimportBlocks = rule351 _lhsIimportBlocks _hdOinhmap = rule352 _lhsIinhmap _hdOinitial = rule353 _lhsIinitial _hdOlocalAttrTypes = rule354 _lhsIlocalAttrTypes _hdOmainFile = rule355 _lhsImainFile _hdOmainName = rule356 _lhsImainName _hdOmoduleHeader = rule357 _lhsImoduleHeader _hdOnextVisits = rule358 _lhsInextVisits _hdOnt = rule359 _lhsInt _hdOntType = rule360 _lhsIntType _hdOoptions = rule361 _lhsIoptions _hdOparams = rule362 _lhsIparams _hdOpragmaBlocks = rule363 _lhsIpragmaBlocks _hdOprevVisits = rule364 _lhsIprevVisits _hdOrename = rule365 _lhsIrename _hdOsynmap = rule366 _lhsIsynmap _hdOtextBlocks = rule367 _lhsItextBlocks _tlOallFromToStates = rule368 _lhsIallFromToStates _tlOallInhmap = rule369 _lhsIallInhmap _tlOallInitStates = rule370 _lhsIallInitStates _tlOallSynmap = rule371 _lhsIallSynmap _tlOallVisitKinds = rule372 _lhsIallVisitKinds _tlOallchildvisit = rule373 _lhsIallchildvisit _tlOallstates = rule374 _lhsIallstates _tlOavisitdefs = rule375 _lhsIavisitdefs _tlOavisituses = rule376 _lhsIavisituses _tlOclassCtxs = rule377 _lhsIclassCtxs _tlOimportBlocks = rule378 _lhsIimportBlocks _tlOinhmap = rule379 _lhsIinhmap _tlOinitial = rule380 _lhsIinitial _tlOlocalAttrTypes = rule381 _lhsIlocalAttrTypes _tlOmainFile = rule382 _lhsImainFile _tlOmainName = rule383 _lhsImainName _tlOmoduleHeader = rule384 _lhsImoduleHeader _tlOnextVisits = rule385 _lhsInextVisits _tlOnt = rule386 _lhsInt _tlOntType = rule387 _lhsIntType _tlOoptions = rule388 _lhsIoptions _tlOparams = rule389 _lhsIparams _tlOpragmaBlocks = rule390 _lhsIpragmaBlocks _tlOprevVisits = rule391 _lhsIprevVisits _tlOrename = rule392 _lhsIrename _tlOsynmap = rule393 _lhsIsynmap _tlOtextBlocks = rule394 _lhsItextBlocks __result_ = T_EProductions_vOut16 _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_EProductions_s17 v16 {-# INLINE rule325 #-} {-# LINE 343 "src-ag/ExecutionPlan2Hs.ag" #-} rule325 = \ ((_hdIallvisits) :: [VisitStateState]) -> {-# LINE 343 "src-ag/ExecutionPlan2Hs.ag" #-} _hdIallvisits {-# LINE 2880 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule326 #-} {-# LINE 396 "src-ag/ExecutionPlan2Hs.ag" #-} rule326 = \ ((_hdIt_visits) :: PP_Doc) -> {-# LINE 396 "src-ag/ExecutionPlan2Hs.ag" #-} _hdIt_visits {-# LINE 2886 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule327 #-} rule327 = \ ((_hdIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) ((_tlIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _hdIchildvisit `Map.union` _tlIchildvisit {-# INLINE rule328 #-} rule328 = \ ((_hdIcount) :: Int) ((_tlIcount) :: Int) -> _hdIcount + _tlIcount {-# INLINE rule329 #-} rule329 = \ ((_hdIdatatype) :: PP_Doc) ((_tlIdatatype) :: [PP_Doc]) -> _hdIdatatype : _tlIdatatype {-# INLINE rule330 #-} rule330 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule331 #-} rule331 = \ ((_hdIfromToStates) :: Map VisitIdentifier (Int,Int)) ((_tlIfromToStates) :: Map VisitIdentifier (Int,Int)) -> _hdIfromToStates `mappend` _tlIfromToStates {-# INLINE rule332 #-} rule332 = \ ((_hdIgenProdIO) :: IO ()) ((_tlIgenProdIO) :: IO ()) -> _hdIgenProdIO >> _tlIgenProdIO {-# INLINE rule333 #-} rule333 = \ ((_hdIimports) :: [PP_Doc]) ((_tlIimports) :: [PP_Doc]) -> _hdIimports ++ _tlIimports {-# INLINE rule334 #-} rule334 = \ ((_hdIsemFunBndDefs) :: Seq PP_Doc) ((_tlIsemFunBndDefs) :: Seq PP_Doc) -> _hdIsemFunBndDefs Seq.>< _tlIsemFunBndDefs {-# INLINE rule335 #-} rule335 = \ ((_hdIsemFunBndTps) :: Seq PP_Doc) ((_tlIsemFunBndTps) :: Seq PP_Doc) -> _hdIsemFunBndTps Seq.>< _tlIsemFunBndTps {-# INLINE rule336 #-} rule336 = \ ((_hdIsem_nt) :: PP_Doc) ((_tlIsem_nt) :: PP_Doc) -> _hdIsem_nt >-< _tlIsem_nt {-# INLINE rule337 #-} rule337 = \ ((_hdIsem_prod) :: PP_Doc) ((_tlIsem_prod) :: PP_Doc) -> _hdIsem_prod >-< _tlIsem_prod {-# INLINE rule338 #-} rule338 = \ ((_hdIvisitKinds) :: Map VisitIdentifier VisitKind) ((_tlIvisitKinds) :: Map VisitIdentifier VisitKind) -> _hdIvisitKinds `mappend` _tlIvisitKinds {-# INLINE rule339 #-} rule339 = \ ((_hdIvisitdefs) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisitdefs `uwSetUnion` _tlIvisitdefs {-# INLINE rule340 #-} rule340 = \ ((_hdIvisituses) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisituses) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisituses `uwSetUnion` _tlIvisituses {-# INLINE rule341 #-} rule341 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule342 #-} rule342 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule343 #-} rule343 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule344 #-} rule344 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule345 #-} rule345 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule346 #-} rule346 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule347 #-} rule347 = \ ((_lhsIallstates) :: Set StateIdentifier) -> _lhsIallstates {-# INLINE rule348 #-} rule348 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule349 #-} rule349 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule350 #-} rule350 = \ ((_lhsIclassCtxs) :: ClassContext) -> _lhsIclassCtxs {-# INLINE rule351 #-} rule351 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule352 #-} rule352 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule353 #-} rule353 = \ ((_lhsIinitial) :: StateIdentifier) -> _lhsIinitial {-# INLINE rule354 #-} rule354 = \ ((_lhsIlocalAttrTypes) :: Map ConstructorIdent (Map Identifier Type)) -> _lhsIlocalAttrTypes {-# INLINE rule355 #-} rule355 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule356 #-} rule356 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule357 #-} rule357 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule358 #-} rule358 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) -> _lhsInextVisits {-# INLINE rule359 #-} rule359 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule360 #-} rule360 = \ ((_lhsIntType) :: Type) -> _lhsIntType {-# INLINE rule361 #-} rule361 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule362 #-} rule362 = \ ((_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule363 #-} rule363 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule364 #-} rule364 = \ ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) -> _lhsIprevVisits {-# INLINE rule365 #-} rule365 = \ ((_lhsIrename) :: Bool) -> _lhsIrename {-# INLINE rule366 #-} rule366 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule367 #-} rule367 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule368 #-} rule368 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule369 #-} rule369 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule370 #-} rule370 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule371 #-} rule371 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule372 #-} rule372 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule373 #-} rule373 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule374 #-} rule374 = \ ((_lhsIallstates) :: Set StateIdentifier) -> _lhsIallstates {-# INLINE rule375 #-} rule375 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule376 #-} rule376 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule377 #-} rule377 = \ ((_lhsIclassCtxs) :: ClassContext) -> _lhsIclassCtxs {-# INLINE rule378 #-} rule378 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule379 #-} rule379 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule380 #-} rule380 = \ ((_lhsIinitial) :: StateIdentifier) -> _lhsIinitial {-# INLINE rule381 #-} rule381 = \ ((_lhsIlocalAttrTypes) :: Map ConstructorIdent (Map Identifier Type)) -> _lhsIlocalAttrTypes {-# INLINE rule382 #-} rule382 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule383 #-} rule383 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule384 #-} rule384 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule385 #-} rule385 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) -> _lhsInextVisits {-# INLINE rule386 #-} rule386 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule387 #-} rule387 = \ ((_lhsIntType) :: Type) -> _lhsIntType {-# INLINE rule388 #-} rule388 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule389 #-} rule389 = \ ((_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule390 #-} rule390 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule391 #-} rule391 = \ ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) -> _lhsIprevVisits {-# INLINE rule392 #-} rule392 = \ ((_lhsIrename) :: Bool) -> _lhsIrename {-# INLINE rule393 #-} rule393 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule394 #-} rule394 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# NOINLINE sem_EProductions_Nil #-} sem_EProductions_Nil :: T_EProductions sem_EProductions_Nil = T_EProductions (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_EProductions_v16 v16 = \ (T_EProductions_vIn16 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIclassCtxs _lhsIimportBlocks _lhsIinhmap _lhsIinitial _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInextVisits _lhsInt _lhsIntType _lhsIoptions _lhsIparams _lhsIpragmaBlocks _lhsIprevVisits _lhsIrename _lhsIsynmap _lhsItextBlocks) -> ( let _lhsOallvisits :: [VisitStateState] _lhsOallvisits = rule395 () _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule396 () _lhsOcount :: Int _lhsOcount = rule397 () _lhsOdatatype :: [PP_Doc] _lhsOdatatype = rule398 () _lhsOerrors :: Seq Error _lhsOerrors = rule399 () _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule400 () _lhsOgenProdIO :: IO () _lhsOgenProdIO = rule401 () _lhsOimports :: [PP_Doc] _lhsOimports = rule402 () _lhsOsemFunBndDefs :: Seq PP_Doc _lhsOsemFunBndDefs = rule403 () _lhsOsemFunBndTps :: Seq PP_Doc _lhsOsemFunBndTps = rule404 () _lhsOsem_nt :: PP_Doc _lhsOsem_nt = rule405 () _lhsOsem_prod :: PP_Doc _lhsOsem_prod = rule406 () _lhsOt_visits :: PP_Doc _lhsOt_visits = rule407 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule408 () _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule409 () _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule410 () __result_ = T_EProductions_vOut16 _lhsOallvisits _lhsOchildvisit _lhsOcount _lhsOdatatype _lhsOerrors _lhsOfromToStates _lhsOgenProdIO _lhsOimports _lhsOsemFunBndDefs _lhsOsemFunBndTps _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_EProductions_s17 v16 {-# INLINE rule395 #-} {-# LINE 344 "src-ag/ExecutionPlan2Hs.ag" #-} rule395 = \ (_ :: ()) -> {-# LINE 344 "src-ag/ExecutionPlan2Hs.ag" #-} error "Every nonterminal should have at least 1 production" {-# LINE 3138 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule396 #-} rule396 = \ (_ :: ()) -> Map.empty {-# INLINE rule397 #-} rule397 = \ (_ :: ()) -> 0 {-# INLINE rule398 #-} rule398 = \ (_ :: ()) -> [] {-# INLINE rule399 #-} rule399 = \ (_ :: ()) -> Seq.empty {-# INLINE rule400 #-} rule400 = \ (_ :: ()) -> mempty {-# INLINE rule401 #-} rule401 = \ (_ :: ()) -> return () {-# INLINE rule402 #-} rule402 = \ (_ :: ()) -> [] {-# INLINE rule403 #-} rule403 = \ (_ :: ()) -> Seq.empty {-# INLINE rule404 #-} rule404 = \ (_ :: ()) -> Seq.empty {-# INLINE rule405 #-} rule405 = \ (_ :: ()) -> empty {-# INLINE rule406 #-} rule406 = \ (_ :: ()) -> empty {-# INLINE rule407 #-} rule407 = \ (_ :: ()) -> empty {-# INLINE rule408 #-} rule408 = \ (_ :: ()) -> mempty {-# INLINE rule409 #-} rule409 = \ (_ :: ()) -> Map.empty {-# INLINE rule410 #-} rule410 = \ (_ :: ()) -> Map.empty -- ERule ------------------------------------------------------- -- wrapper data Inh_ERule = Inh_ERule { allInhmap_Inh_ERule :: (Map NontermIdent Attributes), allSynmap_Inh_ERule :: (Map NontermIdent Attributes), childTypes_Inh_ERule :: (Map Identifier Type), con_Inh_ERule :: (ConstructorIdent), importBlocks_Inh_ERule :: (PP_Doc), inhmap_Inh_ERule :: (Attributes), lazyIntras_Inh_ERule :: (Set String), localAttrTypes_Inh_ERule :: (Map Identifier Type), mainFile_Inh_ERule :: (String), mainName_Inh_ERule :: (String), moduleHeader_Inh_ERule :: (String -> String -> String -> Bool -> String), nt_Inh_ERule :: (NontermIdent), options_Inh_ERule :: (Options), pragmaBlocks_Inh_ERule :: (String), ruleKinds_Inh_ERule :: (Map Identifier (Set VisitKind)), synmap_Inh_ERule :: (Attributes), textBlocks_Inh_ERule :: (PP_Doc), usageInfo_Inh_ERule :: (Map Identifier Int) } data Syn_ERule = Syn_ERule { errors_Syn_ERule :: (Seq Error), mrules_Syn_ERule :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)), ruledefs_Syn_ERule :: (Map Identifier (Set String)), ruleuses_Syn_ERule :: (Map Identifier (Map String (Maybe NonLocalAttr))), sem_rules_Syn_ERule :: (PP_Doc), usedArgs_Syn_ERule :: (Set String) } {-# INLINABLE wrap_ERule #-} wrap_ERule :: T_ERule -> Inh_ERule -> (Syn_ERule ) wrap_ERule (T_ERule act) (Inh_ERule _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo) = Control.Monad.Identity.runIdentity ( do sem <- act let arg19 = T_ERule_vIn19 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo (T_ERule_vOut19 _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules _lhsOusedArgs) <- return (inv_ERule_s20 sem arg19) return (Syn_ERule _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules _lhsOusedArgs) ) -- cata {-# INLINE sem_ERule #-} sem_ERule :: ERule -> T_ERule sem_ERule ( ERule name_ pattern_ rhs_ owrt_ origin_ explicit_ pure_ mbError_ ) = sem_ERule_ERule name_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ mbError_ -- semantic domain newtype T_ERule = T_ERule { attach_T_ERule :: Identity (T_ERule_s20 ) } newtype T_ERule_s20 = C_ERule_s20 { inv_ERule_s20 :: (T_ERule_v19 ) } data T_ERule_s21 = C_ERule_s21 type T_ERule_v19 = (T_ERule_vIn19 ) -> (T_ERule_vOut19 ) data T_ERule_vIn19 = T_ERule_vIn19 (Map NontermIdent Attributes) (Map NontermIdent Attributes) (Map Identifier Type) (ConstructorIdent) (PP_Doc) (Attributes) (Set String) (Map Identifier Type) (String) (String) (String -> String -> String -> Bool -> String) (NontermIdent) (Options) (String) (Map Identifier (Set VisitKind)) (Attributes) (PP_Doc) (Map Identifier Int) data T_ERule_vOut19 = T_ERule_vOut19 (Seq Error) (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (PP_Doc) (Set String) {-# NOINLINE sem_ERule_ERule #-} sem_ERule_ERule :: (Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Maybe Error) -> T_ERule sem_ERule_ERule arg_name_ arg_pattern_ arg_rhs_ _ _ arg_explicit_ arg_pure_ arg_mbError_ = T_ERule (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_ERule_v19 v19 = \ (T_ERule_vIn19 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo) -> ( let _patternX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) _rhsX29 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) (T_Pattern_vOut40 _patternIattrTypes _patternIattrs _patternIcopy _patternIisUnderscore _patternIsem_lhs) = inv_Pattern_s41 _patternX41 (T_Pattern_vIn40 _patternOallInhmap _patternOallSynmap _patternOanyLazyKind _patternOinhmap _patternOlocalAttrTypes _patternOoptions _patternOsynmap) (T_Expression_vOut28 _rhsIattrs _rhsIpos _rhsIsemfunc _rhsItks) = inv_Expression_s29 _rhsX29 (T_Expression_vIn28 _rhsOoptions) _lhsOusedArgs :: Set String _lhsOusedArgs = rule411 _usedArgs_augmented_f1 _usedArgs_augmented_syn _usedArgs_augmented_f1 = rule412 _rhsIattrs _lhsOsem_rules :: PP_Doc _lhsOsem_rules = rule413 _rulePragma _rulecode _used _rulecode = rule414 _endpragma _genpragma _lambda _pragma _rhsIpos _rhsIsemfunc _scc _rulePragma = rule415 _lhsIoptions _used arg_explicit_ arg_name_ _scc = rule416 _lhsIcon _lhsInt _lhsIoptions _rhsIpos arg_explicit_ arg_name_ arg_pure_ _pragma = rule417 _rhsIpos _endpragma = rule418 _lhsImainFile _genpragma = rule419 _haspos _lhsIoptions arg_explicit_ _haspos = rule420 _rhsIpos _lambda = rule421 _argPats _lhsIoptions _rhsIattrs arg_name_ _argPats = rule422 _addbang1 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIlazyIntras _lhsIlocalAttrTypes _lhsIoptions _rhsIattrs _argExprs = rule423 _rhsIattrs _stepcode = rule424 _argExprs _lhsIoptions _patternIattrTypes _patternIsem_lhs _rhsIattrs arg_name_ arg_pure_ _lhsOmrules :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc) _lhsOmrules = rule425 _stepcode arg_name_ _used = rule426 _lhsIusageInfo arg_name_ _kinds = rule427 _lhsIruleKinds arg_name_ _anyLazyKind = rule428 _kinds _lhsOruledefs :: Map Identifier (Set String) _lhsOruledefs = rule429 _patternIattrs arg_name_ _lhsOruleuses :: Map Identifier (Map String (Maybe NonLocalAttr)) _lhsOruleuses = rule430 _rhsIattrs arg_name_ _addbang = rule431 _lhsIoptions _addbang1 = rule432 _addbang _anyLazyKind _lhsOerrors :: Seq Error _lhsOerrors = rule433 _used arg_mbError_ _usedArgs_augmented_syn = rule434 () _patternOallInhmap = rule435 _lhsIallInhmap _patternOallSynmap = rule436 _lhsIallSynmap _patternOanyLazyKind = rule437 _anyLazyKind _patternOinhmap = rule438 _lhsIinhmap _patternOlocalAttrTypes = rule439 _lhsIlocalAttrTypes _patternOoptions = rule440 _lhsIoptions _patternOsynmap = rule441 _lhsIsynmap _rhsOoptions = rule442 _lhsIoptions __result_ = T_ERule_vOut19 _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules _lhsOusedArgs in __result_ ) in C_ERule_s20 v19 {-# INLINE rule411 #-} rule411 = \ _usedArgs_augmented_f1 _usedArgs_augmented_syn -> foldr ($) _usedArgs_augmented_syn [_usedArgs_augmented_f1] {-# INLINE rule412 #-} rule412 = \ ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) -> Set.union $ Map.keysSet $ Map.mapKeys (\a -> "arg_" ++ a) $ Map.filter isNothing _rhsIattrs {-# INLINE rule413 #-} {-# LINE 995 "src-ag/ExecutionPlan2Hs.ag" #-} rule413 = \ _rulePragma _rulecode _used -> {-# LINE 995 "src-ag/ExecutionPlan2Hs.ag" #-} if _used == 0 then empty else _rulePragma >-< _rulecode {-# LINE 3280 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule414 #-} {-# LINE 998 "src-ag/ExecutionPlan2Hs.ag" #-} rule414 = \ _endpragma _genpragma _lambda _pragma ((_rhsIpos) :: Pos) ((_rhsIsemfunc) :: PP_Doc) _scc -> {-# LINE 998 "src-ag/ExecutionPlan2Hs.ag" #-} ( if _genpragma then _pragma else empty ) >-< _lambda >#< _scc >-< indent ((column _rhsIpos - 2) `max` 2) ( if _genpragma then _pragma >-< _rhsIsemfunc >-< _endpragma else _rhsIsemfunc ) {-# LINE 3295 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule415 #-} {-# LINE 1010 "src-ag/ExecutionPlan2Hs.ag" #-} rule415 = \ ((_lhsIoptions) :: Options) _used explicit_ name_ -> {-# LINE 1010 "src-ag/ExecutionPlan2Hs.ag" #-} ( let reallyInlineStr = "INLINE" reallyNoInlineStr = "NOINLINE" in if noInlinePragmas _lhsIoptions then empty else if _used == 1 then ppPragmaBinding reallyInlineStr name_ else if helpInlining _lhsIoptions then if not explicit_ && _used <= reallyOftenUsedThreshold then ppPragmaBinding "INLINE[1]" name_ else if _used > ruleInlineThresholdSoft && explicit_ then if _used > ruleInlineThresholdHard then ppPragmaBinding reallyNoInlineStr name_ else if aggressiveInlinePragmas _lhsIoptions then ppPragmaBinding "NOINLINE[2]" name_ else ppNoInline name_ else if aggressiveInlinePragmas _lhsIoptions then ppPragmaBinding "NOINLINE[1]" name_ else ppNoInline name_ else if not explicit_ || _used <= ruleInlineThresholdSoft then ppPragmaBinding "NOINLINE[1]" name_ else ppNoInline name_ ) {-# LINE 3322 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule416 #-} {-# LINE 1032 "src-ag/ExecutionPlan2Hs.ag" #-} rule416 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) ((_rhsIpos) :: Pos) explicit_ name_ pure_ -> {-# LINE 1032 "src-ag/ExecutionPlan2Hs.ag" #-} if genCostCentres _lhsIoptions && explicit_ && pure_ && not (noPerRuleCostCentres _lhsIoptions) then ppCostCentre (name_ >|< "_" >|< line _rhsIpos >|< "_" >|< _lhsInt >|< "_" >|< _lhsIcon) else empty {-# LINE 3330 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule417 #-} {-# LINE 1035 "src-ag/ExecutionPlan2Hs.ag" #-} rule417 = \ ((_rhsIpos) :: Pos) -> {-# LINE 1035 "src-ag/ExecutionPlan2Hs.ag" #-} "{-# LINE" >#< show (line _rhsIpos) >#< show (file _rhsIpos) >#< "#-}" {-# LINE 3336 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule418 #-} {-# LINE 1036 "src-ag/ExecutionPlan2Hs.ag" #-} rule418 = \ ((_lhsImainFile) :: String) -> {-# LINE 1036 "src-ag/ExecutionPlan2Hs.ag" #-} ppWithLineNr (\ln -> "{-# LINE " ++ show (ln+1) ++ " " ++ show _lhsImainFile ++ "#-}") {-# LINE 3342 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule419 #-} {-# LINE 1037 "src-ag/ExecutionPlan2Hs.ag" #-} rule419 = \ _haspos ((_lhsIoptions) :: Options) explicit_ -> {-# LINE 1037 "src-ag/ExecutionPlan2Hs.ag" #-} genLinePragmas _lhsIoptions && explicit_ && _haspos {-# LINE 3348 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule420 #-} {-# LINE 1038 "src-ag/ExecutionPlan2Hs.ag" #-} rule420 = \ ((_rhsIpos) :: Pos) -> {-# LINE 1038 "src-ag/ExecutionPlan2Hs.ag" #-} line _rhsIpos > 0 && column _rhsIpos >= 0 && not (null (file _rhsIpos)) {-# LINE 3354 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule421 #-} {-# LINE 1047 "src-ag/ExecutionPlan2Hs.ag" #-} rule421 = \ _argPats ((_lhsIoptions) :: Options) ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) name_ -> {-# LINE 1047 "src-ag/ExecutionPlan2Hs.ag" #-} name_ >#< "=" >#< "\\" >#< _argPats >#< dummyPat _lhsIoptions (Map.null _rhsIattrs) >#< "->" {-# LINE 3360 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule422 #-} {-# LINE 1049 "src-ag/ExecutionPlan2Hs.ag" #-} rule422 = \ _addbang1 ((_lhsIallInhmap) :: Map NontermIdent Attributes) ((_lhsIallSynmap) :: Map NontermIdent Attributes) ((_lhsIchildTypes) :: Map Identifier Type) ((_lhsIlazyIntras) :: Set String) ((_lhsIlocalAttrTypes) :: Map Identifier Type) ((_lhsIoptions) :: Options) ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) -> {-# LINE 1049 "src-ag/ExecutionPlan2Hs.ag" #-} ppSpaced [ let match | str `Set.member` _lhsIlazyIntras = pp str | otherwise = _addbang1 (pp str) in case mbAttr of Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs _lhsIoptions) -> case Map.lookup nm _lhsIlocalAttrTypes of Just tp -> pp_parens (pp_parens match >#< "::" >#< ppTp tp) Nothing -> match Just attr | not (noPerRuleTypeSigs _lhsIoptions) -> case lookupAttrType attr _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes of Just tpDoc -> pp_parens (pp_parens match >#< "::" >#< tpDoc) Nothing -> match _ -> match | (str,mbAttr) <- Map.assocs _rhsIattrs ] {-# LINE 3379 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule423 #-} {-# LINE 1063 "src-ag/ExecutionPlan2Hs.ag" #-} rule423 = \ ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) -> {-# LINE 1063 "src-ag/ExecutionPlan2Hs.ag" #-} ppSpaced [ case mbAttr of Nothing -> "arg_" >|< str _ -> text str | (str,mbAttr) <- Map.assocs _rhsIattrs ] {-# LINE 3389 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule424 #-} {-# LINE 1068 "src-ag/ExecutionPlan2Hs.ag" #-} rule424 = \ _argExprs ((_lhsIoptions) :: Options) ((_patternIattrTypes) :: PP_Doc) ((_patternIsem_lhs) :: PP_Doc ) ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) name_ pure_ -> {-# LINE 1068 "src-ag/ExecutionPlan2Hs.ag" #-} \kind fmtMode -> if kind `compatibleRule` pure_ then Right $ let oper | pure_ = "=" | otherwise = "<-" decl = _patternIsem_lhs >#< oper >#< name_ >#< _argExprs >#< dummyArg _lhsIoptions (Map.null _rhsIattrs) tp = if pure_ && not (noPerRuleTypeSigs _lhsIoptions) then _patternIattrTypes else empty in fmtDecl pure_ fmtMode (tp >-< decl) else Left $ IncompatibleRuleKind name_ kind {-# LINE 3403 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule425 #-} {-# LINE 1078 "src-ag/ExecutionPlan2Hs.ag" #-} rule425 = \ _stepcode name_ -> {-# LINE 1078 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton name_ _stepcode {-# LINE 3409 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule426 #-} {-# LINE 1283 "src-ag/ExecutionPlan2Hs.ag" #-} rule426 = \ ((_lhsIusageInfo) :: Map Identifier Int) name_ -> {-# LINE 1283 "src-ag/ExecutionPlan2Hs.ag" #-} Map.findWithDefault 0 name_ _lhsIusageInfo {-# LINE 3415 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule427 #-} {-# LINE 1299 "src-ag/ExecutionPlan2Hs.ag" #-} rule427 = \ ((_lhsIruleKinds) :: Map Identifier (Set VisitKind)) name_ -> {-# LINE 1299 "src-ag/ExecutionPlan2Hs.ag" #-} Map.findWithDefault Set.empty name_ _lhsIruleKinds {-# LINE 3421 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule428 #-} {-# LINE 1300 "src-ag/ExecutionPlan2Hs.ag" #-} rule428 = \ _kinds -> {-# LINE 1300 "src-ag/ExecutionPlan2Hs.ag" #-} Set.fold (\k r -> isLazyKind k || r) False _kinds {-# LINE 3427 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule429 #-} {-# LINE 1346 "src-ag/ExecutionPlan2Hs.ag" #-} rule429 = \ ((_patternIattrs) :: Set String) name_ -> {-# LINE 1346 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton name_ _patternIattrs {-# LINE 3433 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule430 #-} {-# LINE 1347 "src-ag/ExecutionPlan2Hs.ag" #-} rule430 = \ ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) name_ -> {-# LINE 1347 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton name_ _rhsIattrs {-# LINE 3439 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule431 #-} {-# LINE 1549 "src-ag/ExecutionPlan2Hs.ag" #-} rule431 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1549 "src-ag/ExecutionPlan2Hs.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 3445 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule432 #-} {-# LINE 1560 "src-ag/ExecutionPlan2Hs.ag" #-} rule432 = \ _addbang _anyLazyKind -> {-# LINE 1560 "src-ag/ExecutionPlan2Hs.ag" #-} if _anyLazyKind then id else _addbang {-# LINE 3451 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule433 #-} {-# LINE 1666 "src-ag/ExecutionPlan2Hs.ag" #-} rule433 = \ _used mbError_ -> {-# LINE 1666 "src-ag/ExecutionPlan2Hs.ag" #-} case mbError_ of Just e | _used > 0 -> Seq.singleton e _ -> Seq.empty {-# LINE 3459 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule434 #-} rule434 = \ (_ :: ()) -> Set.empty {-# INLINE rule435 #-} rule435 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule436 #-} rule436 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule437 #-} rule437 = \ _anyLazyKind -> _anyLazyKind {-# INLINE rule438 #-} rule438 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule439 #-} rule439 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule440 #-} rule440 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule441 #-} rule441 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule442 #-} rule442 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- ERules ------------------------------------------------------ -- wrapper data Inh_ERules = Inh_ERules { allInhmap_Inh_ERules :: (Map NontermIdent Attributes), allSynmap_Inh_ERules :: (Map NontermIdent Attributes), childTypes_Inh_ERules :: (Map Identifier Type), con_Inh_ERules :: (ConstructorIdent), importBlocks_Inh_ERules :: (PP_Doc), inhmap_Inh_ERules :: (Attributes), lazyIntras_Inh_ERules :: (Set String), localAttrTypes_Inh_ERules :: (Map Identifier Type), mainFile_Inh_ERules :: (String), mainName_Inh_ERules :: (String), moduleHeader_Inh_ERules :: (String -> String -> String -> Bool -> String), nt_Inh_ERules :: (NontermIdent), options_Inh_ERules :: (Options), pragmaBlocks_Inh_ERules :: (String), ruleKinds_Inh_ERules :: (Map Identifier (Set VisitKind)), synmap_Inh_ERules :: (Attributes), textBlocks_Inh_ERules :: (PP_Doc), usageInfo_Inh_ERules :: (Map Identifier Int) } data Syn_ERules = Syn_ERules { errors_Syn_ERules :: (Seq Error), mrules_Syn_ERules :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)), ruledefs_Syn_ERules :: (Map Identifier (Set String)), ruleuses_Syn_ERules :: (Map Identifier (Map String (Maybe NonLocalAttr))), sem_rules_Syn_ERules :: (PP_Doc), usedArgs_Syn_ERules :: (Set String) } {-# INLINABLE wrap_ERules #-} wrap_ERules :: T_ERules -> Inh_ERules -> (Syn_ERules ) wrap_ERules (T_ERules act) (Inh_ERules _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo) = Control.Monad.Identity.runIdentity ( do sem <- act let arg22 = T_ERules_vIn22 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo (T_ERules_vOut22 _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules _lhsOusedArgs) <- return (inv_ERules_s23 sem arg22) return (Syn_ERules _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules _lhsOusedArgs) ) -- cata {-# NOINLINE sem_ERules #-} sem_ERules :: ERules -> T_ERules sem_ERules list = Prelude.foldr sem_ERules_Cons sem_ERules_Nil (Prelude.map sem_ERule list) -- semantic domain newtype T_ERules = T_ERules { attach_T_ERules :: Identity (T_ERules_s23 ) } newtype T_ERules_s23 = C_ERules_s23 { inv_ERules_s23 :: (T_ERules_v22 ) } data T_ERules_s24 = C_ERules_s24 type T_ERules_v22 = (T_ERules_vIn22 ) -> (T_ERules_vOut22 ) data T_ERules_vIn22 = T_ERules_vIn22 (Map NontermIdent Attributes) (Map NontermIdent Attributes) (Map Identifier Type) (ConstructorIdent) (PP_Doc) (Attributes) (Set String) (Map Identifier Type) (String) (String) (String -> String -> String -> Bool -> String) (NontermIdent) (Options) (String) (Map Identifier (Set VisitKind)) (Attributes) (PP_Doc) (Map Identifier Int) data T_ERules_vOut22 = T_ERules_vOut22 (Seq Error) (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (PP_Doc) (Set String) {-# NOINLINE sem_ERules_Cons #-} sem_ERules_Cons :: T_ERule -> T_ERules -> T_ERules sem_ERules_Cons arg_hd_ arg_tl_ = T_ERules (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_ERules_v22 v22 = \ (T_ERules_vIn22 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo) -> ( let _hdX20 = Control.Monad.Identity.runIdentity (attach_T_ERule (arg_hd_)) _tlX23 = Control.Monad.Identity.runIdentity (attach_T_ERules (arg_tl_)) (T_ERule_vOut19 _hdIerrors _hdImrules _hdIruledefs _hdIruleuses _hdIsem_rules _hdIusedArgs) = inv_ERule_s20 _hdX20 (T_ERule_vIn19 _hdOallInhmap _hdOallSynmap _hdOchildTypes _hdOcon _hdOimportBlocks _hdOinhmap _hdOlazyIntras _hdOlocalAttrTypes _hdOmainFile _hdOmainName _hdOmoduleHeader _hdOnt _hdOoptions _hdOpragmaBlocks _hdOruleKinds _hdOsynmap _hdOtextBlocks _hdOusageInfo) (T_ERules_vOut22 _tlIerrors _tlImrules _tlIruledefs _tlIruleuses _tlIsem_rules _tlIusedArgs) = inv_ERules_s23 _tlX23 (T_ERules_vIn22 _tlOallInhmap _tlOallSynmap _tlOchildTypes _tlOcon _tlOimportBlocks _tlOinhmap _tlOlazyIntras _tlOlocalAttrTypes _tlOmainFile _tlOmainName _tlOmoduleHeader _tlOnt _tlOoptions _tlOpragmaBlocks _tlOruleKinds _tlOsynmap _tlOtextBlocks _tlOusageInfo) _lhsOerrors :: Seq Error _lhsOerrors = rule443 _hdIerrors _tlIerrors _lhsOmrules :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc) _lhsOmrules = rule444 _hdImrules _tlImrules _lhsOruledefs :: Map Identifier (Set String) _lhsOruledefs = rule445 _hdIruledefs _tlIruledefs _lhsOruleuses :: Map Identifier (Map String (Maybe NonLocalAttr)) _lhsOruleuses = rule446 _hdIruleuses _tlIruleuses _lhsOsem_rules :: PP_Doc _lhsOsem_rules = rule447 _hdIsem_rules _tlIsem_rules _lhsOusedArgs :: Set String _lhsOusedArgs = rule448 _hdIusedArgs _tlIusedArgs _hdOallInhmap = rule449 _lhsIallInhmap _hdOallSynmap = rule450 _lhsIallSynmap _hdOchildTypes = rule451 _lhsIchildTypes _hdOcon = rule452 _lhsIcon _hdOimportBlocks = rule453 _lhsIimportBlocks _hdOinhmap = rule454 _lhsIinhmap _hdOlazyIntras = rule455 _lhsIlazyIntras _hdOlocalAttrTypes = rule456 _lhsIlocalAttrTypes _hdOmainFile = rule457 _lhsImainFile _hdOmainName = rule458 _lhsImainName _hdOmoduleHeader = rule459 _lhsImoduleHeader _hdOnt = rule460 _lhsInt _hdOoptions = rule461 _lhsIoptions _hdOpragmaBlocks = rule462 _lhsIpragmaBlocks _hdOruleKinds = rule463 _lhsIruleKinds _hdOsynmap = rule464 _lhsIsynmap _hdOtextBlocks = rule465 _lhsItextBlocks _hdOusageInfo = rule466 _lhsIusageInfo _tlOallInhmap = rule467 _lhsIallInhmap _tlOallSynmap = rule468 _lhsIallSynmap _tlOchildTypes = rule469 _lhsIchildTypes _tlOcon = rule470 _lhsIcon _tlOimportBlocks = rule471 _lhsIimportBlocks _tlOinhmap = rule472 _lhsIinhmap _tlOlazyIntras = rule473 _lhsIlazyIntras _tlOlocalAttrTypes = rule474 _lhsIlocalAttrTypes _tlOmainFile = rule475 _lhsImainFile _tlOmainName = rule476 _lhsImainName _tlOmoduleHeader = rule477 _lhsImoduleHeader _tlOnt = rule478 _lhsInt _tlOoptions = rule479 _lhsIoptions _tlOpragmaBlocks = rule480 _lhsIpragmaBlocks _tlOruleKinds = rule481 _lhsIruleKinds _tlOsynmap = rule482 _lhsIsynmap _tlOtextBlocks = rule483 _lhsItextBlocks _tlOusageInfo = rule484 _lhsIusageInfo __result_ = T_ERules_vOut22 _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules _lhsOusedArgs in __result_ ) in C_ERules_s23 v22 {-# INLINE rule443 #-} rule443 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule444 #-} rule444 = \ ((_hdImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) ((_tlImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _hdImrules `Map.union` _tlImrules {-# INLINE rule445 #-} rule445 = \ ((_hdIruledefs) :: Map Identifier (Set String)) ((_tlIruledefs) :: Map Identifier (Set String)) -> _hdIruledefs `uwSetUnion` _tlIruledefs {-# INLINE rule446 #-} rule446 = \ ((_hdIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) ((_tlIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _hdIruleuses `uwMapUnion` _tlIruleuses {-# INLINE rule447 #-} rule447 = \ ((_hdIsem_rules) :: PP_Doc) ((_tlIsem_rules) :: PP_Doc) -> _hdIsem_rules >-< _tlIsem_rules {-# INLINE rule448 #-} rule448 = \ ((_hdIusedArgs) :: Set String) ((_tlIusedArgs) :: Set String) -> _hdIusedArgs `Set.union` _tlIusedArgs {-# INLINE rule449 #-} rule449 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule450 #-} rule450 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule451 #-} rule451 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule452 #-} rule452 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule453 #-} rule453 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule454 #-} rule454 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule455 #-} rule455 = \ ((_lhsIlazyIntras) :: Set String) -> _lhsIlazyIntras {-# INLINE rule456 #-} rule456 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule457 #-} rule457 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule458 #-} rule458 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule459 #-} rule459 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule460 #-} rule460 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule461 #-} rule461 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule462 #-} rule462 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule463 #-} rule463 = \ ((_lhsIruleKinds) :: Map Identifier (Set VisitKind)) -> _lhsIruleKinds {-# INLINE rule464 #-} rule464 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule465 #-} rule465 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule466 #-} rule466 = \ ((_lhsIusageInfo) :: Map Identifier Int) -> _lhsIusageInfo {-# INLINE rule467 #-} rule467 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule468 #-} rule468 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule469 #-} rule469 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule470 #-} rule470 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule471 #-} rule471 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule472 #-} rule472 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule473 #-} rule473 = \ ((_lhsIlazyIntras) :: Set String) -> _lhsIlazyIntras {-# INLINE rule474 #-} rule474 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule475 #-} rule475 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule476 #-} rule476 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule477 #-} rule477 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule478 #-} rule478 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule479 #-} rule479 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule480 #-} rule480 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule481 #-} rule481 = \ ((_lhsIruleKinds) :: Map Identifier (Set VisitKind)) -> _lhsIruleKinds {-# INLINE rule482 #-} rule482 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule483 #-} rule483 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks {-# INLINE rule484 #-} rule484 = \ ((_lhsIusageInfo) :: Map Identifier Int) -> _lhsIusageInfo {-# NOINLINE sem_ERules_Nil #-} sem_ERules_Nil :: T_ERules sem_ERules_Nil = T_ERules (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_ERules_v22 v22 = \ (T_ERules_vIn22 _lhsIallInhmap _lhsIallSynmap _lhsIchildTypes _lhsIcon _lhsIimportBlocks _lhsIinhmap _lhsIlazyIntras _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsInt _lhsIoptions _lhsIpragmaBlocks _lhsIruleKinds _lhsIsynmap _lhsItextBlocks _lhsIusageInfo) -> ( let _lhsOerrors :: Seq Error _lhsOerrors = rule485 () _lhsOmrules :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc) _lhsOmrules = rule486 () _lhsOruledefs :: Map Identifier (Set String) _lhsOruledefs = rule487 () _lhsOruleuses :: Map Identifier (Map String (Maybe NonLocalAttr)) _lhsOruleuses = rule488 () _lhsOsem_rules :: PP_Doc _lhsOsem_rules = rule489 () _lhsOusedArgs :: Set String _lhsOusedArgs = rule490 () __result_ = T_ERules_vOut22 _lhsOerrors _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules _lhsOusedArgs in __result_ ) in C_ERules_s23 v22 {-# INLINE rule485 #-} rule485 = \ (_ :: ()) -> Seq.empty {-# INLINE rule486 #-} rule486 = \ (_ :: ()) -> Map.empty {-# INLINE rule487 #-} rule487 = \ (_ :: ()) -> Map.empty {-# INLINE rule488 #-} rule488 = \ (_ :: ()) -> Map.empty {-# INLINE rule489 #-} rule489 = \ (_ :: ()) -> empty {-# INLINE rule490 #-} rule490 = \ (_ :: ()) -> Set.empty -- ExecutionPlan ----------------------------------------------- -- wrapper data Inh_ExecutionPlan = Inh_ExecutionPlan { importBlocks_Inh_ExecutionPlan :: (PP_Doc), inhmap_Inh_ExecutionPlan :: (Map NontermIdent Attributes), localAttrTypes_Inh_ExecutionPlan :: (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))), mainBlocksDoc_Inh_ExecutionPlan :: (PP_Doc), mainFile_Inh_ExecutionPlan :: (String), mainName_Inh_ExecutionPlan :: (String), moduleHeader_Inh_ExecutionPlan :: (String -> String -> String -> Bool -> String), options_Inh_ExecutionPlan :: (Options), pragmaBlocks_Inh_ExecutionPlan :: (String), synmap_Inh_ExecutionPlan :: (Map NontermIdent Attributes), textBlockMap_Inh_ExecutionPlan :: (Map BlockInfo PP_Doc), textBlocks_Inh_ExecutionPlan :: (PP_Doc) } data Syn_ExecutionPlan = Syn_ExecutionPlan { errors_Syn_ExecutionPlan :: (Seq Error), genIO_Syn_ExecutionPlan :: (IO ()), output_Syn_ExecutionPlan :: (PP_Doc) } {-# INLINABLE wrap_ExecutionPlan #-} wrap_ExecutionPlan :: T_ExecutionPlan -> Inh_ExecutionPlan -> (Syn_ExecutionPlan ) wrap_ExecutionPlan (T_ExecutionPlan act) (Inh_ExecutionPlan _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlockMap _lhsItextBlocks) = Control.Monad.Identity.runIdentity ( do sem <- act let arg25 = T_ExecutionPlan_vIn25 _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlockMap _lhsItextBlocks (T_ExecutionPlan_vOut25 _lhsOerrors _lhsOgenIO _lhsOoutput) <- return (inv_ExecutionPlan_s26 sem arg25) return (Syn_ExecutionPlan _lhsOerrors _lhsOgenIO _lhsOoutput) ) -- cata {-# INLINE sem_ExecutionPlan #-} sem_ExecutionPlan :: ExecutionPlan -> T_ExecutionPlan sem_ExecutionPlan ( ExecutionPlan nonts_ typeSyns_ wrappers_ derivings_ ) = sem_ExecutionPlan_ExecutionPlan ( sem_ENonterminals nonts_ ) typeSyns_ wrappers_ derivings_ -- semantic domain newtype T_ExecutionPlan = T_ExecutionPlan { attach_T_ExecutionPlan :: Identity (T_ExecutionPlan_s26 ) } newtype T_ExecutionPlan_s26 = C_ExecutionPlan_s26 { inv_ExecutionPlan_s26 :: (T_ExecutionPlan_v25 ) } data T_ExecutionPlan_s27 = C_ExecutionPlan_s27 type T_ExecutionPlan_v25 = (T_ExecutionPlan_vIn25 ) -> (T_ExecutionPlan_vOut25 ) data T_ExecutionPlan_vIn25 = T_ExecutionPlan_vIn25 (PP_Doc) (Map NontermIdent Attributes) (Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) (PP_Doc) (String) (String) (String -> String -> String -> Bool -> String) (Options) (String) (Map NontermIdent Attributes) (Map BlockInfo PP_Doc) (PP_Doc) data T_ExecutionPlan_vOut25 = T_ExecutionPlan_vOut25 (Seq Error) (IO ()) (PP_Doc) {-# NOINLINE sem_ExecutionPlan_ExecutionPlan #-} sem_ExecutionPlan_ExecutionPlan :: T_ENonterminals -> (TypeSyns) -> (Set NontermIdent) -> (Derivings) -> T_ExecutionPlan sem_ExecutionPlan_ExecutionPlan arg_nonts_ arg_typeSyns_ arg_wrappers_ arg_derivings_ = T_ExecutionPlan (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_ExecutionPlan_v25 v25 = \ (T_ExecutionPlan_vIn25 _lhsIimportBlocks _lhsIinhmap _lhsIlocalAttrTypes _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlockMap _lhsItextBlocks) -> ( let _nontsX11 = Control.Monad.Identity.runIdentity (attach_T_ENonterminals (arg_nonts_)) (T_ENonterminals_vOut10 _nontsIappendCommon _nontsIappendMain _nontsIchildvisit _nontsIerrors _nontsIfromToStates _nontsIgenProdIO _nontsIimports _nontsIinitStates _nontsIoutput _nontsIsemFunBndDefs _nontsIsemFunBndTps _nontsIvisitKinds _nontsIvisitdefs _nontsIvisituses) = inv_ENonterminals_s11 _nontsX11 (T_ENonterminals_vIn10 _nontsOallFromToStates _nontsOallInitStates _nontsOallVisitKinds _nontsOallchildvisit _nontsOavisitdefs _nontsOavisituses _nontsOderivings _nontsOimportBlocks _nontsOinhmap _nontsOlocalAttrTypes _nontsOmainFile _nontsOmainName _nontsOmoduleHeader _nontsOoptions _nontsOpragmaBlocks _nontsOsynmap _nontsOtextBlocks _nontsOtypeSyns _nontsOwrappers) _lhsOoutput :: PP_Doc _lhsOoutput = rule491 _commonExtra _nontsIoutput _wrappersExtra _nontsOwrappers = rule492 arg_wrappers_ _nontsOtypeSyns = rule493 arg_typeSyns_ _nontsOderivings = rule494 arg_derivings_ _wrappersExtra = rule495 _lateSemBndDef _lhsIoptions _commonExtra = rule496 _lateSemBndTp _lhsIoptions _lateSemBndTp = rule497 _lhsImainName _nontsIsemFunBndTps _lateSemBndDef = rule498 _lhsImainName _lhsIoptions _nontsIsemFunBndDefs arg_wrappers_ _nontsOallchildvisit = rule499 _nontsIchildvisit _nontsOavisitdefs = rule500 _nontsIvisitdefs _nontsOavisituses = rule501 _nontsIvisituses _lhsOgenIO :: IO () _lhsOgenIO = rule502 _genCommonModule _genMainModule _nontsIgenProdIO _mainModuleFile = rule503 _lhsImainFile _ppMonadImports = rule504 _lhsIoptions _genMainModule = rule505 _lhsImainBlocksDoc _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _mainModuleFile _nontsIappendMain _nontsIimports _ppMonadImports _wrappersExtra _commonFile = rule506 _lhsImainFile _genCommonModule = rule507 _commonExtra _commonFile _lhsIimportBlocks _lhsImainName _lhsImoduleHeader _lhsIpragmaBlocks _lhsItextBlocks _nontsIappendCommon _ppMonadImports _nontsOallFromToStates = rule508 _nontsIfromToStates _nontsOallVisitKinds = rule509 _nontsIvisitKinds _nontsOallInitStates = rule510 _nontsIinitStates _lhsOerrors :: Seq Error _lhsOerrors = rule511 _nontsIerrors _nontsOimportBlocks = rule512 _lhsIimportBlocks _nontsOinhmap = rule513 _lhsIinhmap _nontsOlocalAttrTypes = rule514 _lhsIlocalAttrTypes _nontsOmainFile = rule515 _lhsImainFile _nontsOmainName = rule516 _lhsImainName _nontsOmoduleHeader = rule517 _lhsImoduleHeader _nontsOoptions = rule518 _lhsIoptions _nontsOpragmaBlocks = rule519 _lhsIpragmaBlocks _nontsOsynmap = rule520 _lhsIsynmap _nontsOtextBlocks = rule521 _lhsItextBlocks __result_ = T_ExecutionPlan_vOut25 _lhsOerrors _lhsOgenIO _lhsOoutput in __result_ ) in C_ExecutionPlan_s26 v25 {-# INLINE rule491 #-} {-# LINE 89 "src-ag/ExecutionPlan2Hs.ag" #-} rule491 = \ _commonExtra ((_nontsIoutput) :: PP_Doc) _wrappersExtra -> {-# LINE 89 "src-ag/ExecutionPlan2Hs.ag" #-} _nontsIoutput >-< _commonExtra >-< _wrappersExtra {-# LINE 3828 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule492 #-} {-# LINE 95 "src-ag/ExecutionPlan2Hs.ag" #-} rule492 = \ wrappers_ -> {-# LINE 95 "src-ag/ExecutionPlan2Hs.ag" #-} wrappers_ {-# LINE 3834 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule493 #-} {-# LINE 134 "src-ag/ExecutionPlan2Hs.ag" #-} rule493 = \ typeSyns_ -> {-# LINE 134 "src-ag/ExecutionPlan2Hs.ag" #-} typeSyns_ {-# LINE 3840 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule494 #-} {-# LINE 135 "src-ag/ExecutionPlan2Hs.ag" #-} rule494 = \ derivings_ -> {-# LINE 135 "src-ag/ExecutionPlan2Hs.ag" #-} derivings_ {-# LINE 3846 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule495 #-} {-# LINE 542 "src-ag/ExecutionPlan2Hs.ag" #-} rule495 = \ _lateSemBndDef ((_lhsIoptions) :: Options) -> {-# LINE 542 "src-ag/ExecutionPlan2Hs.ag" #-} if lateHigherOrderBinding _lhsIoptions then _lateSemBndDef else empty {-# LINE 3854 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule496 #-} {-# LINE 545 "src-ag/ExecutionPlan2Hs.ag" #-} rule496 = \ _lateSemBndTp ((_lhsIoptions) :: Options) -> {-# LINE 545 "src-ag/ExecutionPlan2Hs.ag" #-} if lateHigherOrderBinding _lhsIoptions then _lateSemBndTp else empty {-# LINE 3862 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule497 #-} {-# LINE 548 "src-ag/ExecutionPlan2Hs.ag" #-} rule497 = \ ((_lhsImainName) :: String) ((_nontsIsemFunBndTps) :: Seq PP_Doc) -> {-# LINE 548 "src-ag/ExecutionPlan2Hs.ag" #-} "data" >#< lateBindingTypeNm _lhsImainName >#< "=" >#< lateBindingTypeNm _lhsImainName >-< (indent 2 $ pp_block "{" "}" "," $ toList _nontsIsemFunBndTps) {-# LINE 3869 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule498 #-} {-# LINE 550 "src-ag/ExecutionPlan2Hs.ag" #-} rule498 = \ ((_lhsImainName) :: String) ((_lhsIoptions) :: Options) ((_nontsIsemFunBndDefs) :: Seq PP_Doc) wrappers_ -> {-# LINE 550 "src-ag/ExecutionPlan2Hs.ag" #-} ( if noInlinePragmas _lhsIoptions then empty else if helpInlining _lhsIoptions && Set.size wrappers_ == 1 then ppInline $ lateBindingFieldNm _lhsImainName else ppNoInline $ lateBindingFieldNm _lhsImainName ) >-< lateBindingFieldNm _lhsImainName >#< "::" >#< lateBindingTypeNm _lhsImainName >-< lateBindingFieldNm _lhsImainName >#< "=" >#< lateBindingTypeNm _lhsImainName >-< (indent 2 $ pp_block "{" "}" "," $ toList _nontsIsemFunBndDefs ) {-# LINE 3883 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule499 #-} {-# LINE 1227 "src-ag/ExecutionPlan2Hs.ag" #-} rule499 = \ ((_nontsIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> {-# LINE 1227 "src-ag/ExecutionPlan2Hs.ag" #-} _nontsIchildvisit {-# LINE 3889 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule500 #-} {-# LINE 1371 "src-ag/ExecutionPlan2Hs.ag" #-} rule500 = \ ((_nontsIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> {-# LINE 1371 "src-ag/ExecutionPlan2Hs.ag" #-} _nontsIvisitdefs {-# LINE 3895 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule501 #-} {-# LINE 1372 "src-ag/ExecutionPlan2Hs.ag" #-} rule501 = \ ((_nontsIvisituses) :: Map VisitIdentifier (Set Identifier)) -> {-# LINE 1372 "src-ag/ExecutionPlan2Hs.ag" #-} _nontsIvisituses {-# LINE 3901 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule502 #-} {-# LINE 1443 "src-ag/ExecutionPlan2Hs.ag" #-} rule502 = \ _genCommonModule _genMainModule ((_nontsIgenProdIO) :: IO ()) -> {-# LINE 1443 "src-ag/ExecutionPlan2Hs.ag" #-} do _genMainModule _genCommonModule _nontsIgenProdIO {-# LINE 3909 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule503 #-} {-# LINE 1446 "src-ag/ExecutionPlan2Hs.ag" #-} rule503 = \ ((_lhsImainFile) :: String) -> {-# LINE 1446 "src-ag/ExecutionPlan2Hs.ag" #-} _lhsImainFile {-# LINE 3915 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule504 #-} {-# LINE 1447 "src-ag/ExecutionPlan2Hs.ag" #-} rule504 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1447 "src-ag/ExecutionPlan2Hs.ag" #-} ( if tupleAsDummyToken _lhsIoptions then empty else pp "import GHC.Prim" ) >-< if parallelInvoke _lhsIoptions then pp "import qualified System.IO.Unsafe(unsafePerformIO)" >-< pp "import System.IO(IO)" >-< pp "import Control.Concurrent(newEmptyMVar,forkIO,putMVar,takeMVar)" else pp "import Control.Monad.Identity" {-# LINE 3929 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule505 #-} {-# LINE 1456 "src-ag/ExecutionPlan2Hs.ag" #-} rule505 = \ ((_lhsImainBlocksDoc) :: PP_Doc) ((_lhsImainName) :: String) ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIoptions) :: Options) ((_lhsIpragmaBlocks) :: String) _mainModuleFile ((_nontsIappendMain) :: [PP_Doc]) ((_nontsIimports) :: [PP_Doc]) _ppMonadImports _wrappersExtra -> {-# LINE 1456 "src-ag/ExecutionPlan2Hs.ag" #-} writeModule _mainModuleFile ( [ warrenFlagsPP _lhsIoptions , pp $ _lhsIpragmaBlocks , pp $ _lhsImoduleHeader _lhsImainName "" "" False , _ppMonadImports , pp $ "import " ++ _lhsImainName ++ "_common" ] ++ _nontsIimports ++ [_lhsImainBlocksDoc] ++ [_wrappersExtra ] ++ _nontsIappendMain ) {-# LINE 3946 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule506 #-} {-# LINE 1468 "src-ag/ExecutionPlan2Hs.ag" #-} rule506 = \ ((_lhsImainFile) :: String) -> {-# LINE 1468 "src-ag/ExecutionPlan2Hs.ag" #-} replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ "_common") {-# LINE 3952 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule507 #-} {-# LINE 1469 "src-ag/ExecutionPlan2Hs.ag" #-} rule507 = \ _commonExtra _commonFile ((_lhsIimportBlocks) :: PP_Doc) ((_lhsImainName) :: String) ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIpragmaBlocks) :: String) ((_lhsItextBlocks) :: PP_Doc) ((_nontsIappendCommon) :: [PP_Doc]) _ppMonadImports -> {-# LINE 1469 "src-ag/ExecutionPlan2Hs.ag" #-} writeModule _commonFile ( [ pp $ "{-# LANGUAGE Rank2Types, GADTs #-}" , pp $ _lhsIpragmaBlocks , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True , _ppMonadImports , _lhsIimportBlocks , _lhsItextBlocks , _commonExtra ] ++ _nontsIappendCommon ) {-# LINE 3968 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule508 #-} {-# LINE 1588 "src-ag/ExecutionPlan2Hs.ag" #-} rule508 = \ ((_nontsIfromToStates) :: Map VisitIdentifier (Int,Int)) -> {-# LINE 1588 "src-ag/ExecutionPlan2Hs.ag" #-} _nontsIfromToStates {-# LINE 3974 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule509 #-} {-# LINE 1632 "src-ag/ExecutionPlan2Hs.ag" #-} rule509 = \ ((_nontsIvisitKinds) :: Map VisitIdentifier VisitKind) -> {-# LINE 1632 "src-ag/ExecutionPlan2Hs.ag" #-} _nontsIvisitKinds {-# LINE 3980 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule510 #-} {-# LINE 1646 "src-ag/ExecutionPlan2Hs.ag" #-} rule510 = \ ((_nontsIinitStates) :: Map NontermIdent Int) -> {-# LINE 1646 "src-ag/ExecutionPlan2Hs.ag" #-} _nontsIinitStates {-# LINE 3986 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule511 #-} rule511 = \ ((_nontsIerrors) :: Seq Error) -> _nontsIerrors {-# INLINE rule512 #-} rule512 = \ ((_lhsIimportBlocks) :: PP_Doc) -> _lhsIimportBlocks {-# INLINE rule513 #-} rule513 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) -> _lhsIinhmap {-# INLINE rule514 #-} rule514 = \ ((_lhsIlocalAttrTypes) :: Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) -> _lhsIlocalAttrTypes {-# INLINE rule515 #-} rule515 = \ ((_lhsImainFile) :: String) -> _lhsImainFile {-# INLINE rule516 #-} rule516 = \ ((_lhsImainName) :: String) -> _lhsImainName {-# INLINE rule517 #-} rule517 = \ ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) -> _lhsImoduleHeader {-# INLINE rule518 #-} rule518 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule519 #-} rule519 = \ ((_lhsIpragmaBlocks) :: String) -> _lhsIpragmaBlocks {-# INLINE rule520 #-} rule520 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) -> _lhsIsynmap {-# INLINE rule521 #-} rule521 = \ ((_lhsItextBlocks) :: PP_Doc) -> _lhsItextBlocks -- Expression -------------------------------------------------- -- wrapper data Inh_Expression = Inh_Expression { options_Inh_Expression :: (Options) } data Syn_Expression = Syn_Expression { attrs_Syn_Expression :: (Map String (Maybe NonLocalAttr)), pos_Syn_Expression :: (Pos), semfunc_Syn_Expression :: (PP_Doc), tks_Syn_Expression :: ([HsToken]) } {-# INLINABLE wrap_Expression #-} wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) wrap_Expression (T_Expression act) (Inh_Expression _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg28 = T_Expression_vIn28 _lhsIoptions (T_Expression_vOut28 _lhsOattrs _lhsOpos _lhsOsemfunc _lhsOtks) <- return (inv_Expression_s29 sem arg28) return (Syn_Expression _lhsOattrs _lhsOpos _lhsOsemfunc _lhsOtks) ) -- cata {-# INLINE sem_Expression #-} sem_Expression :: Expression -> T_Expression sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_ -- semantic domain newtype T_Expression = T_Expression { attach_T_Expression :: Identity (T_Expression_s29 ) } newtype T_Expression_s29 = C_Expression_s29 { inv_Expression_s29 :: (T_Expression_v28 ) } data T_Expression_s30 = C_Expression_s30 type T_Expression_v28 = (T_Expression_vIn28 ) -> (T_Expression_vOut28 ) data T_Expression_vIn28 = T_Expression_vIn28 (Options) data T_Expression_vOut28 = T_Expression_vOut28 (Map String (Maybe NonLocalAttr)) (Pos) (PP_Doc) ([HsToken]) {-# NOINLINE sem_Expression_Expression #-} sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression sem_Expression_Expression arg_pos_ arg_tks_ = T_Expression (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Expression_v28 v28 = \ (T_Expression_vIn28 _lhsIoptions) -> ( let _lhsOtks :: [HsToken] _lhsOtks = rule522 arg_tks_ _lhsOpos :: Pos _lhsOpos = rule523 arg_pos_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule524 _inhhstoken arg_tks_ _lhsOsemfunc :: PP_Doc _lhsOsemfunc = rule525 _inhhstoken arg_tks_ _inhhstoken = rule526 _lhsIoptions __result_ = T_Expression_vOut28 _lhsOattrs _lhsOpos _lhsOsemfunc _lhsOtks in __result_ ) in C_Expression_s29 v28 {-# INLINE rule522 #-} {-# LINE 1082 "src-ag/ExecutionPlan2Hs.ag" #-} rule522 = \ tks_ -> {-# LINE 1082 "src-ag/ExecutionPlan2Hs.ag" #-} tks_ {-# LINE 4075 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule523 #-} {-# LINE 1125 "src-ag/ExecutionPlan2Hs.ag" #-} rule523 = \ pos_ -> {-# LINE 1125 "src-ag/ExecutionPlan2Hs.ag" #-} pos_ {-# LINE 4081 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule524 #-} {-# LINE 1211 "src-ag/ExecutionPlan2Hs.ag" #-} rule524 = \ _inhhstoken tks_ -> {-# LINE 1211 "src-ag/ExecutionPlan2Hs.ag" #-} Map.unions $ map (\tok -> attrs_Syn_HsToken (wrap_HsToken (sem_HsToken tok) _inhhstoken )) tks_ {-# LINE 4087 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule525 #-} {-# LINE 1212 "src-ag/ExecutionPlan2Hs.ag" #-} rule525 = \ _inhhstoken tks_ -> {-# LINE 1212 "src-ag/ExecutionPlan2Hs.ag" #-} vlist $ showTokens $ map (\tok -> tok_Syn_HsToken (wrap_HsToken (sem_HsToken tok) _inhhstoken )) tks_ {-# LINE 4093 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule526 #-} {-# LINE 1213 "src-ag/ExecutionPlan2Hs.ag" #-} rule526 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1213 "src-ag/ExecutionPlan2Hs.ag" #-} Inh_HsToken _lhsIoptions {-# LINE 4099 "dist/build/ExecutionPlan2Hs.hs"#-} -- HsToken ----------------------------------------------------- -- wrapper data Inh_HsToken = Inh_HsToken { options_Inh_HsToken :: (Options) } data Syn_HsToken = Syn_HsToken { attrs_Syn_HsToken :: (Map String (Maybe NonLocalAttr)), tok_Syn_HsToken :: ((Pos,String)) } {-# INLINABLE wrap_HsToken #-} wrap_HsToken :: T_HsToken -> Inh_HsToken -> (Syn_HsToken ) wrap_HsToken (T_HsToken act) (Inh_HsToken _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg31 = T_HsToken_vIn31 _lhsIoptions (T_HsToken_vOut31 _lhsOattrs _lhsOtok) <- return (inv_HsToken_s32 sem arg31) return (Syn_HsToken _lhsOattrs _lhsOtok) ) -- cata {-# NOINLINE sem_HsToken #-} sem_HsToken :: HsToken -> T_HsToken sem_HsToken ( AGLocal var_ pos_ rdesc_ ) = sem_HsToken_AGLocal var_ pos_ rdesc_ sem_HsToken ( AGField field_ attr_ pos_ rdesc_ ) = sem_HsToken_AGField field_ attr_ pos_ rdesc_ sem_HsToken ( HsToken value_ pos_ ) = sem_HsToken_HsToken value_ pos_ sem_HsToken ( CharToken value_ pos_ ) = sem_HsToken_CharToken value_ pos_ sem_HsToken ( StrToken value_ pos_ ) = sem_HsToken_StrToken value_ pos_ sem_HsToken ( Err mesg_ pos_ ) = sem_HsToken_Err mesg_ pos_ -- semantic domain newtype T_HsToken = T_HsToken { attach_T_HsToken :: Identity (T_HsToken_s32 ) } newtype T_HsToken_s32 = C_HsToken_s32 { inv_HsToken_s32 :: (T_HsToken_v31 ) } data T_HsToken_s33 = C_HsToken_s33 type T_HsToken_v31 = (T_HsToken_vIn31 ) -> (T_HsToken_vOut31 ) data T_HsToken_vIn31 = T_HsToken_vIn31 (Options) data T_HsToken_vOut31 = T_HsToken_vOut31 (Map String (Maybe NonLocalAttr)) ((Pos,String)) {-# NOINLINE sem_HsToken_AGLocal #-} sem_HsToken_AGLocal :: (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGLocal arg_var_ arg_pos_ _ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule527 arg_var_ _tok = rule528 arg_pos_ arg_var_ _lhsOtok :: (Pos,String) _lhsOtok = rule529 _tok __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule527 #-} {-# LINE 1170 "src-ag/ExecutionPlan2Hs.ag" #-} rule527 = \ var_ -> {-# LINE 1170 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton (fieldname var_) Nothing {-# LINE 4156 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule528 #-} {-# LINE 1416 "src-ag/ExecutionPlan2Hs.ag" #-} rule528 = \ pos_ var_ -> {-# LINE 1416 "src-ag/ExecutionPlan2Hs.ag" #-} (pos_,fieldname var_) {-# LINE 4162 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule529 #-} rule529 = \ _tok -> _tok {-# NOINLINE sem_HsToken_AGField #-} sem_HsToken_AGField :: (Identifier) -> (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGField arg_field_ arg_attr_ arg_pos_ arg_rdesc_ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _mbAttr = rule530 arg_attr_ arg_field_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule531 _lhsIoptions _mbAttr arg_attr_ arg_field_ _addTrace = rule532 arg_attr_ arg_field_ arg_rdesc_ _lhsOtok :: (Pos,String) _lhsOtok = rule533 _addTrace _lhsIoptions arg_attr_ arg_field_ arg_pos_ __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule530 #-} {-# LINE 1171 "src-ag/ExecutionPlan2Hs.ag" #-} rule530 = \ attr_ field_ -> {-# LINE 1171 "src-ag/ExecutionPlan2Hs.ag" #-} if field_ == _INST || field_ == _FIELD || field_ == _INST' then Nothing else Just $ mkNonLocalAttr (field_ == _LHS) field_ attr_ {-# LINE 4189 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule531 #-} {-# LINE 1174 "src-ag/ExecutionPlan2Hs.ag" #-} rule531 = \ ((_lhsIoptions) :: Options) _mbAttr attr_ field_ -> {-# LINE 1174 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton (attrname _lhsIoptions True field_ attr_) _mbAttr {-# LINE 4195 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule532 #-} {-# LINE 1420 "src-ag/ExecutionPlan2Hs.ag" #-} rule532 = \ attr_ field_ rdesc_ -> {-# LINE 1420 "src-ag/ExecutionPlan2Hs.ag" #-} case rdesc_ of Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))" Nothing -> id {-# LINE 4203 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule533 #-} {-# LINE 1423 "src-ag/ExecutionPlan2Hs.ag" #-} rule533 = \ _addTrace ((_lhsIoptions) :: Options) attr_ field_ pos_ -> {-# LINE 1423 "src-ag/ExecutionPlan2Hs.ag" #-} (pos_, _addTrace $ attrname _lhsIoptions True field_ attr_) {-# LINE 4209 "dist/build/ExecutionPlan2Hs.hs"#-} {-# NOINLINE sem_HsToken_HsToken #-} sem_HsToken_HsToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_HsToken arg_value_ arg_pos_ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _lhsOtok :: (Pos,String) _lhsOtok = rule534 arg_pos_ arg_value_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule535 () __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule534 #-} {-# LINE 1425 "src-ag/ExecutionPlan2Hs.ag" #-} rule534 = \ pos_ value_ -> {-# LINE 1425 "src-ag/ExecutionPlan2Hs.ag" #-} (pos_, value_) {-# LINE 4229 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule535 #-} rule535 = \ (_ :: ()) -> Map.empty {-# NOINLINE sem_HsToken_CharToken #-} sem_HsToken_CharToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_CharToken arg_value_ arg_pos_ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _lhsOtok :: (Pos,String) _lhsOtok = rule536 arg_pos_ arg_value_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule537 () __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule536 #-} {-# LINE 1427 "src-ag/ExecutionPlan2Hs.ag" #-} rule536 = \ pos_ value_ -> {-# LINE 1427 "src-ag/ExecutionPlan2Hs.ag" #-} (pos_, if null value_ then "" else showCharShort (head value_) ) {-# LINE 4255 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule537 #-} rule537 = \ (_ :: ()) -> Map.empty {-# NOINLINE sem_HsToken_StrToken #-} sem_HsToken_StrToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_StrToken arg_value_ arg_pos_ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _lhsOtok :: (Pos,String) _lhsOtok = rule538 arg_pos_ arg_value_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule539 () __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule538 #-} {-# LINE 1432 "src-ag/ExecutionPlan2Hs.ag" #-} rule538 = \ pos_ value_ -> {-# LINE 1432 "src-ag/ExecutionPlan2Hs.ag" #-} (pos_, showStrShort value_) {-# LINE 4278 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule539 #-} rule539 = \ (_ :: ()) -> Map.empty {-# NOINLINE sem_HsToken_Err #-} sem_HsToken_Err :: (String) -> (Pos) -> T_HsToken sem_HsToken_Err _ arg_pos_ = T_HsToken (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_HsToken_v31 v31 = \ (T_HsToken_vIn31 _lhsIoptions) -> ( let _lhsOtok :: (Pos,String) _lhsOtok = rule540 arg_pos_ _lhsOattrs :: Map String (Maybe NonLocalAttr) _lhsOattrs = rule541 () __result_ = T_HsToken_vOut31 _lhsOattrs _lhsOtok in __result_ ) in C_HsToken_s32 v31 {-# INLINE rule540 #-} {-# LINE 1433 "src-ag/ExecutionPlan2Hs.ag" #-} rule540 = \ pos_ -> {-# LINE 1433 "src-ag/ExecutionPlan2Hs.ag" #-} (pos_, "") {-# LINE 4301 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule541 #-} rule541 = \ (_ :: ()) -> Map.empty -- HsTokens ---------------------------------------------------- -- wrapper data Inh_HsTokens = Inh_HsTokens { options_Inh_HsTokens :: (Options) } data Syn_HsTokens = Syn_HsTokens { tks_Syn_HsTokens :: ([(Pos,String)]) } {-# INLINABLE wrap_HsTokens #-} wrap_HsTokens :: T_HsTokens -> Inh_HsTokens -> (Syn_HsTokens ) wrap_HsTokens (T_HsTokens act) (Inh_HsTokens _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg34 = T_HsTokens_vIn34 _lhsIoptions (T_HsTokens_vOut34 _lhsOtks) <- return (inv_HsTokens_s35 sem arg34) return (Syn_HsTokens _lhsOtks) ) -- cata {-# NOINLINE sem_HsTokens #-} sem_HsTokens :: HsTokens -> T_HsTokens sem_HsTokens list = Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) -- semantic domain newtype T_HsTokens = T_HsTokens { attach_T_HsTokens :: Identity (T_HsTokens_s35 ) } newtype T_HsTokens_s35 = C_HsTokens_s35 { inv_HsTokens_s35 :: (T_HsTokens_v34 ) } data T_HsTokens_s36 = C_HsTokens_s36 type T_HsTokens_v34 = (T_HsTokens_vIn34 ) -> (T_HsTokens_vOut34 ) data T_HsTokens_vIn34 = T_HsTokens_vIn34 (Options) data T_HsTokens_vOut34 = T_HsTokens_vOut34 ([(Pos,String)]) {-# NOINLINE sem_HsTokens_Cons #-} sem_HsTokens_Cons :: T_HsToken -> T_HsTokens -> T_HsTokens sem_HsTokens_Cons arg_hd_ arg_tl_ = T_HsTokens (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_HsTokens_v34 v34 = \ (T_HsTokens_vIn34 _lhsIoptions) -> ( let _hdX32 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_)) _tlX35 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_)) (T_HsToken_vOut31 _hdIattrs _hdItok) = inv_HsToken_s32 _hdX32 (T_HsToken_vIn31 _hdOoptions) (T_HsTokens_vOut34 _tlItks) = inv_HsTokens_s35 _tlX35 (T_HsTokens_vIn34 _tlOoptions) _lhsOtks :: [(Pos,String)] _lhsOtks = rule542 _hdItok _tlItks _hdOoptions = rule543 _lhsIoptions _tlOoptions = rule544 _lhsIoptions __result_ = T_HsTokens_vOut34 _lhsOtks in __result_ ) in C_HsTokens_s35 v34 {-# INLINE rule542 #-} {-# LINE 1412 "src-ag/ExecutionPlan2Hs.ag" #-} rule542 = \ ((_hdItok) :: (Pos,String)) ((_tlItks) :: [(Pos,String)]) -> {-# LINE 1412 "src-ag/ExecutionPlan2Hs.ag" #-} _hdItok : _tlItks {-# LINE 4359 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule543 #-} rule543 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule544 #-} rule544 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_HsTokens_Nil #-} sem_HsTokens_Nil :: T_HsTokens sem_HsTokens_Nil = T_HsTokens (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_HsTokens_v34 v34 = \ (T_HsTokens_vIn34 _lhsIoptions) -> ( let _lhsOtks :: [(Pos,String)] _lhsOtks = rule545 () __result_ = T_HsTokens_vOut34 _lhsOtks in __result_ ) in C_HsTokens_s35 v34 {-# INLINE rule545 #-} {-# LINE 1413 "src-ag/ExecutionPlan2Hs.ag" #-} rule545 = \ (_ :: ()) -> {-# LINE 1413 "src-ag/ExecutionPlan2Hs.ag" #-} [] {-# LINE 4383 "dist/build/ExecutionPlan2Hs.hs"#-} -- HsTokensRoot ------------------------------------------------ -- wrapper data Inh_HsTokensRoot = Inh_HsTokensRoot { options_Inh_HsTokensRoot :: (Options) } data Syn_HsTokensRoot = Syn_HsTokensRoot { } {-# INLINABLE wrap_HsTokensRoot #-} wrap_HsTokensRoot :: T_HsTokensRoot -> Inh_HsTokensRoot -> (Syn_HsTokensRoot ) wrap_HsTokensRoot (T_HsTokensRoot act) (Inh_HsTokensRoot _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg37 = T_HsTokensRoot_vIn37 _lhsIoptions (T_HsTokensRoot_vOut37 ) <- return (inv_HsTokensRoot_s38 sem arg37) return (Syn_HsTokensRoot ) ) -- cata {-# INLINE sem_HsTokensRoot #-} sem_HsTokensRoot :: HsTokensRoot -> T_HsTokensRoot sem_HsTokensRoot ( HsTokensRoot tokens_ ) = sem_HsTokensRoot_HsTokensRoot ( sem_HsTokens tokens_ ) -- semantic domain newtype T_HsTokensRoot = T_HsTokensRoot { attach_T_HsTokensRoot :: Identity (T_HsTokensRoot_s38 ) } newtype T_HsTokensRoot_s38 = C_HsTokensRoot_s38 { inv_HsTokensRoot_s38 :: (T_HsTokensRoot_v37 ) } data T_HsTokensRoot_s39 = C_HsTokensRoot_s39 type T_HsTokensRoot_v37 = (T_HsTokensRoot_vIn37 ) -> (T_HsTokensRoot_vOut37 ) data T_HsTokensRoot_vIn37 = T_HsTokensRoot_vIn37 (Options) data T_HsTokensRoot_vOut37 = T_HsTokensRoot_vOut37 {-# NOINLINE sem_HsTokensRoot_HsTokensRoot #-} sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> T_HsTokensRoot sem_HsTokensRoot_HsTokensRoot arg_tokens_ = T_HsTokensRoot (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_HsTokensRoot_v37 v37 = \ (T_HsTokensRoot_vIn37 _lhsIoptions) -> ( let _tokensX35 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tokens_)) (T_HsTokens_vOut34 _tokensItks) = inv_HsTokens_s35 _tokensX35 (T_HsTokens_vIn34 _tokensOoptions) _tokensOoptions = rule546 _lhsIoptions __result_ = T_HsTokensRoot_vOut37 in __result_ ) in C_HsTokensRoot_s38 v37 {-# INLINE rule546 #-} rule546 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { allInhmap_Inh_Pattern :: (Map NontermIdent Attributes), allSynmap_Inh_Pattern :: (Map NontermIdent Attributes), anyLazyKind_Inh_Pattern :: (Bool), inhmap_Inh_Pattern :: (Attributes), localAttrTypes_Inh_Pattern :: (Map Identifier Type), options_Inh_Pattern :: (Options), synmap_Inh_Pattern :: (Attributes) } data Syn_Pattern = Syn_Pattern { attrTypes_Syn_Pattern :: (PP_Doc), attrs_Syn_Pattern :: (Set String), copy_Syn_Pattern :: (Pattern), isUnderscore_Syn_Pattern :: (Bool), sem_lhs_Syn_Pattern :: ( PP_Doc ) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern (T_Pattern act) (Inh_Pattern _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg40 = T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap (T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs) <- return (inv_Pattern_s41 sem arg40) return (Syn_Pattern _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s41 ) } newtype T_Pattern_s41 = C_Pattern_s41 { inv_Pattern_s41 :: (T_Pattern_v40 ) } data T_Pattern_s42 = C_Pattern_s42 type T_Pattern_v40 = (T_Pattern_vIn40 ) -> (T_Pattern_vOut40 ) data T_Pattern_vIn40 = T_Pattern_vIn40 (Map NontermIdent Attributes) (Map NontermIdent Attributes) (Bool) (Attributes) (Map Identifier Type) (Options) (Attributes) data T_Pattern_vOut40 = T_Pattern_vOut40 (PP_Doc) (Set String) (Pattern) (Bool) ( PP_Doc ) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIattrTypes _patsIattrs _patsIcopy _patsIsem_lhs) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 _patsOallInhmap _patsOallSynmap _patsOanyLazyKind _patsOinhmap _patsOlocalAttrTypes _patsOoptions _patsOsynmap) _lhsOsem_lhs :: PP_Doc _lhsOsem_lhs = rule547 _addbang1 _patsIsem_lhs arg_name_ _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule548 () _addbang = rule549 _lhsIoptions _addbang1 = rule550 _addbang _lhsIanyLazyKind _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule551 _patsIattrTypes _lhsOattrs :: Set String _lhsOattrs = rule552 _patsIattrs _copy = rule553 _patsIcopy arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule554 _copy _patsOallInhmap = rule555 _lhsIallInhmap _patsOallSynmap = rule556 _lhsIallSynmap _patsOanyLazyKind = rule557 _lhsIanyLazyKind _patsOinhmap = rule558 _lhsIinhmap _patsOlocalAttrTypes = rule559 _lhsIlocalAttrTypes _patsOoptions = rule560 _lhsIoptions _patsOsynmap = rule561 _lhsIsynmap __result_ = T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule547 #-} {-# LINE 1139 "src-ag/ExecutionPlan2Hs.ag" #-} rule547 = \ _addbang1 ((_patsIsem_lhs) :: [PP_Doc]) name_ -> {-# LINE 1139 "src-ag/ExecutionPlan2Hs.ag" #-} _addbang1 $ pp_parens $ name_ >#< hv_sp _patsIsem_lhs {-# LINE 4503 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule548 #-} {-# LINE 1146 "src-ag/ExecutionPlan2Hs.ag" #-} rule548 = \ (_ :: ()) -> {-# LINE 1146 "src-ag/ExecutionPlan2Hs.ag" #-} False {-# LINE 4509 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule549 #-} {-# LINE 1556 "src-ag/ExecutionPlan2Hs.ag" #-} rule549 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1556 "src-ag/ExecutionPlan2Hs.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 4515 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule550 #-} {-# LINE 1561 "src-ag/ExecutionPlan2Hs.ag" #-} rule550 = \ _addbang ((_lhsIanyLazyKind) :: Bool) -> {-# LINE 1561 "src-ag/ExecutionPlan2Hs.ag" #-} if _lhsIanyLazyKind then id else _addbang {-# LINE 4521 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule551 #-} rule551 = \ ((_patsIattrTypes) :: PP_Doc) -> _patsIattrTypes {-# INLINE rule552 #-} rule552 = \ ((_patsIattrs) :: Set String) -> _patsIattrs {-# INLINE rule553 #-} rule553 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule554 #-} rule554 = \ _copy -> _copy {-# INLINE rule555 #-} rule555 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule556 #-} rule556 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule557 #-} rule557 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule558 #-} rule558 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule559 #-} rule559 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule560 #-} rule560 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule561 #-} rule561 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIattrTypes _patsIattrs _patsIcopy _patsIsem_lhs) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 _patsOallInhmap _patsOallSynmap _patsOanyLazyKind _patsOinhmap _patsOlocalAttrTypes _patsOoptions _patsOsynmap) _lhsOsem_lhs :: PP_Doc _lhsOsem_lhs = rule562 _addbang1 _patsIsem_lhs _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule563 () _addbang = rule564 _lhsIoptions _addbang1 = rule565 _addbang _lhsIanyLazyKind _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule566 _patsIattrTypes _lhsOattrs :: Set String _lhsOattrs = rule567 _patsIattrs _copy = rule568 _patsIcopy arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule569 _copy _patsOallInhmap = rule570 _lhsIallInhmap _patsOallSynmap = rule571 _lhsIallSynmap _patsOanyLazyKind = rule572 _lhsIanyLazyKind _patsOinhmap = rule573 _lhsIinhmap _patsOlocalAttrTypes = rule574 _lhsIlocalAttrTypes _patsOoptions = rule575 _lhsIoptions _patsOsynmap = rule576 _lhsIsynmap __result_ = T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule562 #-} {-# LINE 1138 "src-ag/ExecutionPlan2Hs.ag" #-} rule562 = \ _addbang1 ((_patsIsem_lhs) :: [PP_Doc]) -> {-# LINE 1138 "src-ag/ExecutionPlan2Hs.ag" #-} _addbang1 $ pp_block "(" ")" "," _patsIsem_lhs {-# LINE 4592 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule563 #-} {-# LINE 1147 "src-ag/ExecutionPlan2Hs.ag" #-} rule563 = \ (_ :: ()) -> {-# LINE 1147 "src-ag/ExecutionPlan2Hs.ag" #-} False {-# LINE 4598 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule564 #-} {-# LINE 1556 "src-ag/ExecutionPlan2Hs.ag" #-} rule564 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1556 "src-ag/ExecutionPlan2Hs.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 4604 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule565 #-} {-# LINE 1561 "src-ag/ExecutionPlan2Hs.ag" #-} rule565 = \ _addbang ((_lhsIanyLazyKind) :: Bool) -> {-# LINE 1561 "src-ag/ExecutionPlan2Hs.ag" #-} if _lhsIanyLazyKind then id else _addbang {-# LINE 4610 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule566 #-} rule566 = \ ((_patsIattrTypes) :: PP_Doc) -> _patsIattrTypes {-# INLINE rule567 #-} rule567 = \ ((_patsIattrs) :: Set String) -> _patsIattrs {-# INLINE rule568 #-} rule568 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule569 #-} rule569 = \ _copy -> _copy {-# INLINE rule570 #-} rule570 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule571 #-} rule571 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule572 #-} rule572 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule573 #-} rule573 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule574 #-} rule574 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule575 #-} rule575 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule576 #-} rule576 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIattrTypes _patIattrs _patIcopy _patIisUnderscore _patIsem_lhs) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 _patOallInhmap _patOallSynmap _patOanyLazyKind _patOinhmap _patOlocalAttrTypes _patOoptions _patOsynmap) _varPat = rule577 _lhsIoptions arg_attr_ arg_field_ _patExpr = rule578 _patIisUnderscore _patIsem_lhs _varPat _lhsOsem_lhs :: PP_Doc _lhsOsem_lhs = rule579 _addbang1 _patExpr _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule580 () _lhsOattrs :: Set String _lhsOattrs = rule581 _lhsIoptions _patIattrs arg_attr_ arg_field_ _mbTp = rule582 _lhsIlocalAttrTypes _lhsIsynmap arg_attr_ arg_field_ _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule583 _lhsIoptions _mbTp _patIattrTypes arg_attr_ arg_field_ _addbang = rule584 _lhsIoptions _addbang1 = rule585 _addbang _lhsIanyLazyKind _copy = rule586 _patIcopy arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule587 _copy _patOallInhmap = rule588 _lhsIallInhmap _patOallSynmap = rule589 _lhsIallSynmap _patOanyLazyKind = rule590 _lhsIanyLazyKind _patOinhmap = rule591 _lhsIinhmap _patOlocalAttrTypes = rule592 _lhsIlocalAttrTypes _patOoptions = rule593 _lhsIoptions _patOsynmap = rule594 _lhsIsynmap __result_ = T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule577 #-} {-# LINE 1133 "src-ag/ExecutionPlan2Hs.ag" #-} rule577 = \ ((_lhsIoptions) :: Options) attr_ field_ -> {-# LINE 1133 "src-ag/ExecutionPlan2Hs.ag" #-} text $ attrname _lhsIoptions False field_ attr_ {-# LINE 4684 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule578 #-} {-# LINE 1134 "src-ag/ExecutionPlan2Hs.ag" #-} rule578 = \ ((_patIisUnderscore) :: Bool) ((_patIsem_lhs) :: PP_Doc ) _varPat -> {-# LINE 1134 "src-ag/ExecutionPlan2Hs.ag" #-} if _patIisUnderscore then _varPat else _varPat >|< "@" >|< _patIsem_lhs {-# LINE 4692 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule579 #-} {-# LINE 1137 "src-ag/ExecutionPlan2Hs.ag" #-} rule579 = \ _addbang1 _patExpr -> {-# LINE 1137 "src-ag/ExecutionPlan2Hs.ag" #-} _addbang1 _patExpr {-# LINE 4698 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule580 #-} {-# LINE 1148 "src-ag/ExecutionPlan2Hs.ag" #-} rule580 = \ (_ :: ()) -> {-# LINE 1148 "src-ag/ExecutionPlan2Hs.ag" #-} False {-# LINE 4704 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule581 #-} {-# LINE 1154 "src-ag/ExecutionPlan2Hs.ag" #-} rule581 = \ ((_lhsIoptions) :: Options) ((_patIattrs) :: Set String) attr_ field_ -> {-# LINE 1154 "src-ag/ExecutionPlan2Hs.ag" #-} Set.insert (attrname _lhsIoptions False field_ attr_) _patIattrs {-# LINE 4710 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule582 #-} {-# LINE 1159 "src-ag/ExecutionPlan2Hs.ag" #-} rule582 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) ((_lhsIsynmap) :: Attributes) attr_ field_ -> {-# LINE 1159 "src-ag/ExecutionPlan2Hs.ag" #-} if field_ == _LHS then Map.lookup attr_ _lhsIsynmap else if field_ == _LOC then Map.lookup attr_ _lhsIlocalAttrTypes else Nothing {-# LINE 4720 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule583 #-} {-# LINE 1164 "src-ag/ExecutionPlan2Hs.ag" #-} rule583 = \ ((_lhsIoptions) :: Options) _mbTp ((_patIattrTypes) :: PP_Doc) attr_ field_ -> {-# LINE 1164 "src-ag/ExecutionPlan2Hs.ag" #-} maybe empty (\tp -> (attrname _lhsIoptions False field_ attr_) >#< "::" >#< ppTp tp) _mbTp >-< _patIattrTypes {-# LINE 4727 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule584 #-} {-# LINE 1556 "src-ag/ExecutionPlan2Hs.ag" #-} rule584 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1556 "src-ag/ExecutionPlan2Hs.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 4733 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule585 #-} {-# LINE 1561 "src-ag/ExecutionPlan2Hs.ag" #-} rule585 = \ _addbang ((_lhsIanyLazyKind) :: Bool) -> {-# LINE 1561 "src-ag/ExecutionPlan2Hs.ag" #-} if _lhsIanyLazyKind then id else _addbang {-# LINE 4739 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule586 #-} rule586 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule587 #-} rule587 = \ _copy -> _copy {-# INLINE rule588 #-} rule588 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule589 #-} rule589 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule590 #-} rule590 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule591 #-} rule591 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule592 #-} rule592 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule593 #-} rule593 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule594 #-} rule594 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIattrTypes _patIattrs _patIcopy _patIisUnderscore _patIsem_lhs) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 _patOallInhmap _patOallSynmap _patOanyLazyKind _patOinhmap _patOlocalAttrTypes _patOoptions _patOsynmap) _lhsOsem_lhs :: PP_Doc _lhsOsem_lhs = rule595 _patIsem_lhs _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule596 _patIattrTypes _lhsOattrs :: Set String _lhsOattrs = rule597 _patIattrs _copy = rule598 _patIcopy _lhsOcopy :: Pattern _lhsOcopy = rule599 _copy _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule600 _patIisUnderscore _patOallInhmap = rule601 _lhsIallInhmap _patOallSynmap = rule602 _lhsIallSynmap _patOanyLazyKind = rule603 _lhsIanyLazyKind _patOinhmap = rule604 _lhsIinhmap _patOlocalAttrTypes = rule605 _lhsIlocalAttrTypes _patOoptions = rule606 _lhsIoptions _patOsynmap = rule607 _lhsIsynmap __result_ = T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule595 #-} {-# LINE 1141 "src-ag/ExecutionPlan2Hs.ag" #-} rule595 = \ ((_patIsem_lhs) :: PP_Doc ) -> {-# LINE 1141 "src-ag/ExecutionPlan2Hs.ag" #-} text "~" >|< pp_parens _patIsem_lhs {-# LINE 4802 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule596 #-} rule596 = \ ((_patIattrTypes) :: PP_Doc) -> _patIattrTypes {-# INLINE rule597 #-} rule597 = \ ((_patIattrs) :: Set String) -> _patIattrs {-# INLINE rule598 #-} rule598 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule599 #-} rule599 = \ _copy -> _copy {-# INLINE rule600 #-} rule600 = \ ((_patIisUnderscore) :: Bool) -> _patIisUnderscore {-# INLINE rule601 #-} rule601 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule602 #-} rule602 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule603 #-} rule603 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule604 #-} rule604 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule605 #-} rule605 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule606 #-} rule606 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule607 #-} rule607 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore arg_pos_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _lhsOsem_lhs :: PP_Doc _lhsOsem_lhs = rule608 () _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule609 () _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule610 () _lhsOattrs :: Set String _lhsOattrs = rule611 () _copy = rule612 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule613 _copy __result_ = T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule608 #-} {-# LINE 1140 "src-ag/ExecutionPlan2Hs.ag" #-} rule608 = \ (_ :: ()) -> {-# LINE 1140 "src-ag/ExecutionPlan2Hs.ag" #-} text "_" {-# LINE 4865 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule609 #-} {-# LINE 1149 "src-ag/ExecutionPlan2Hs.ag" #-} rule609 = \ (_ :: ()) -> {-# LINE 1149 "src-ag/ExecutionPlan2Hs.ag" #-} True {-# LINE 4871 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule610 #-} rule610 = \ (_ :: ()) -> empty {-# INLINE rule611 #-} rule611 = \ (_ :: ()) -> Set.empty {-# INLINE rule612 #-} rule612 = \ pos_ -> Underscore pos_ {-# INLINE rule613 #-} rule613 = \ _copy -> _copy -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { allInhmap_Inh_Patterns :: (Map NontermIdent Attributes), allSynmap_Inh_Patterns :: (Map NontermIdent Attributes), anyLazyKind_Inh_Patterns :: (Bool), inhmap_Inh_Patterns :: (Attributes), localAttrTypes_Inh_Patterns :: (Map Identifier Type), options_Inh_Patterns :: (Options), synmap_Inh_Patterns :: (Attributes) } data Syn_Patterns = Syn_Patterns { attrTypes_Syn_Patterns :: (PP_Doc), attrs_Syn_Patterns :: (Set String), copy_Syn_Patterns :: (Patterns), sem_lhs_Syn_Patterns :: ([PP_Doc]) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns (T_Patterns act) (Inh_Patterns _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg43 = T_Patterns_vIn43 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap (T_Patterns_vOut43 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOsem_lhs) <- return (inv_Patterns_s44 sem arg43) return (Syn_Patterns _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOsem_lhs) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s44 ) } newtype T_Patterns_s44 = C_Patterns_s44 { inv_Patterns_s44 :: (T_Patterns_v43 ) } data T_Patterns_s45 = C_Patterns_s45 type T_Patterns_v43 = (T_Patterns_vIn43 ) -> (T_Patterns_vOut43 ) data T_Patterns_vIn43 = T_Patterns_vIn43 (Map NontermIdent Attributes) (Map NontermIdent Attributes) (Bool) (Attributes) (Map Identifier Type) (Options) (Attributes) data T_Patterns_vOut43 = T_Patterns_vOut43 (PP_Doc) (Set String) (Patterns) ([PP_Doc]) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_Patterns_v43 v43 = \ (T_Patterns_vIn43 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut40 _hdIattrTypes _hdIattrs _hdIcopy _hdIisUnderscore _hdIsem_lhs) = inv_Pattern_s41 _hdX41 (T_Pattern_vIn40 _hdOallInhmap _hdOallSynmap _hdOanyLazyKind _hdOinhmap _hdOlocalAttrTypes _hdOoptions _hdOsynmap) (T_Patterns_vOut43 _tlIattrTypes _tlIattrs _tlIcopy _tlIsem_lhs) = inv_Patterns_s44 _tlX44 (T_Patterns_vIn43 _tlOallInhmap _tlOallSynmap _tlOanyLazyKind _tlOinhmap _tlOlocalAttrTypes _tlOoptions _tlOsynmap) _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule614 _hdIattrTypes _tlIattrTypes _lhsOattrs :: Set String _lhsOattrs = rule615 _hdIattrs _tlIattrs _lhsOsem_lhs :: [PP_Doc] _lhsOsem_lhs = rule616 _hdIsem_lhs _tlIsem_lhs _copy = rule617 _hdIcopy _tlIcopy _lhsOcopy :: Patterns _lhsOcopy = rule618 _copy _hdOallInhmap = rule619 _lhsIallInhmap _hdOallSynmap = rule620 _lhsIallSynmap _hdOanyLazyKind = rule621 _lhsIanyLazyKind _hdOinhmap = rule622 _lhsIinhmap _hdOlocalAttrTypes = rule623 _lhsIlocalAttrTypes _hdOoptions = rule624 _lhsIoptions _hdOsynmap = rule625 _lhsIsynmap _tlOallInhmap = rule626 _lhsIallInhmap _tlOallSynmap = rule627 _lhsIallSynmap _tlOanyLazyKind = rule628 _lhsIanyLazyKind _tlOinhmap = rule629 _lhsIinhmap _tlOlocalAttrTypes = rule630 _lhsIlocalAttrTypes _tlOoptions = rule631 _lhsIoptions _tlOsynmap = rule632 _lhsIsynmap __result_ = T_Patterns_vOut43 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOsem_lhs in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule614 #-} rule614 = \ ((_hdIattrTypes) :: PP_Doc) ((_tlIattrTypes) :: PP_Doc) -> _hdIattrTypes >-< _tlIattrTypes {-# INLINE rule615 #-} rule615 = \ ((_hdIattrs) :: Set String) ((_tlIattrs) :: Set String) -> _hdIattrs `Set.union` _tlIattrs {-# INLINE rule616 #-} rule616 = \ ((_hdIsem_lhs) :: PP_Doc ) ((_tlIsem_lhs) :: [PP_Doc]) -> _hdIsem_lhs : _tlIsem_lhs {-# INLINE rule617 #-} rule617 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule618 #-} rule618 = \ _copy -> _copy {-# INLINE rule619 #-} rule619 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule620 #-} rule620 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule621 #-} rule621 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule622 #-} rule622 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule623 #-} rule623 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule624 #-} rule624 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule625 #-} rule625 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule626 #-} rule626 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule627 #-} rule627 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule628 #-} rule628 = \ ((_lhsIanyLazyKind) :: Bool) -> _lhsIanyLazyKind {-# INLINE rule629 #-} rule629 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule630 #-} rule630 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) -> _lhsIlocalAttrTypes {-# INLINE rule631 #-} rule631 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule632 #-} rule632 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_Patterns_v43 v43 = \ (T_Patterns_vIn43 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap) -> ( let _lhsOattrTypes :: PP_Doc _lhsOattrTypes = rule633 () _lhsOattrs :: Set String _lhsOattrs = rule634 () _lhsOsem_lhs :: [PP_Doc] _lhsOsem_lhs = rule635 () _copy = rule636 () _lhsOcopy :: Patterns _lhsOcopy = rule637 _copy __result_ = T_Patterns_vOut43 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOsem_lhs in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule633 #-} rule633 = \ (_ :: ()) -> empty {-# INLINE rule634 #-} rule634 = \ (_ :: ()) -> Set.empty {-# INLINE rule635 #-} rule635 = \ (_ :: ()) -> [] {-# INLINE rule636 #-} rule636 = \ (_ :: ()) -> [] {-# INLINE rule637 #-} rule637 = \ _copy -> _copy -- Visit ------------------------------------------------------- -- wrapper data Inh_Visit = Inh_Visit { allFromToStates_Inh_Visit :: (Map VisitIdentifier (Int,Int)), allInhmap_Inh_Visit :: (Map NontermIdent Attributes), allInitStates_Inh_Visit :: (Map NontermIdent Int), allSynmap_Inh_Visit :: (Map NontermIdent Attributes), allVisitKinds_Inh_Visit :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_Visit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), allintramap_Inh_Visit :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))), avisitdefs_Inh_Visit :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_Visit :: (Map VisitIdentifier (Set Identifier)), childTypes_Inh_Visit :: (Map Identifier Type), childintros_Inh_Visit :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), con_Inh_Visit :: (ConstructorIdent), inhmap_Inh_Visit :: (Attributes), mrules_Inh_Visit :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)), nextVisits_Inh_Visit :: (Map StateIdentifier StateCtx), nt_Inh_Visit :: (NontermIdent), options_Inh_Visit :: (Options), params_Inh_Visit :: ([Identifier]), prevVisits_Inh_Visit :: (Map StateIdentifier StateCtx), ruledefs_Inh_Visit :: (Map Identifier (Set String)), ruleuses_Inh_Visit :: (Map Identifier (Map String (Maybe NonLocalAttr))), synmap_Inh_Visit :: (Attributes), terminaldefs_Inh_Visit :: (Set String) } data Syn_Visit = Syn_Visit { allvisits_Syn_Visit :: ( VisitStateState ), childvisit_Syn_Visit :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), errors_Syn_Visit :: (Seq Error), fromToStates_Syn_Visit :: (Map VisitIdentifier (Int,Int)), intramap_Syn_Visit :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))), lazyIntras_Syn_Visit :: (Set String), ruleKinds_Syn_Visit :: (Map Identifier (Set VisitKind)), ruleUsage_Syn_Visit :: (Map Identifier Int), sem_visit_Syn_Visit :: ( (StateIdentifier,Bool -> PP_Doc) ), t_visits_Syn_Visit :: (PP_Doc), usedArgs_Syn_Visit :: (Set String), visitKinds_Syn_Visit :: (Map VisitIdentifier VisitKind), visitdefs_Syn_Visit :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_Visit :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_Visit #-} wrap_Visit :: T_Visit -> Inh_Visit -> (Syn_Visit ) wrap_Visit (T_Visit act) (Inh_Visit _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) = Control.Monad.Identity.runIdentity ( do sem <- act let arg46 = T_Visit_vIn46 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs (T_Visit_vOut46 _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOusedArgs _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_Visit_s47 sem arg46) return (Syn_Visit _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOusedArgs _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# INLINE sem_Visit #-} sem_Visit :: Visit -> T_Visit sem_Visit ( Visit ident_ from_ to_ inh_ syn_ steps_ kind_ ) = sem_Visit_Visit ident_ from_ to_ inh_ syn_ ( sem_VisitSteps steps_ ) kind_ -- semantic domain newtype T_Visit = T_Visit { attach_T_Visit :: Identity (T_Visit_s47 ) } newtype T_Visit_s47 = C_Visit_s47 { inv_Visit_s47 :: (T_Visit_v46 ) } data T_Visit_s48 = C_Visit_s48 type T_Visit_v46 = (T_Visit_vIn46 ) -> (T_Visit_vOut46 ) data T_Visit_vIn46 = T_Visit_vIn46 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Attributes) (Map NontermIdent Int) (Map NontermIdent Attributes) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Map StateIdentifier (Map String (Maybe NonLocalAttr))) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map Identifier Type) (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) (ConstructorIdent) (Attributes) (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) (Map StateIdentifier StateCtx) (NontermIdent) (Options) ([Identifier]) (Map StateIdentifier StateCtx) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (Attributes) (Set String) data T_Visit_vOut46 = T_Visit_vOut46 ( VisitStateState ) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Seq Error) (Map VisitIdentifier (Int,Int)) (Map StateIdentifier (Map String (Maybe NonLocalAttr))) (Set String) (Map Identifier (Set VisitKind)) (Map Identifier Int) ( (StateIdentifier,Bool -> PP_Doc) ) (PP_Doc) (Set String) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_Visit_Visit #-} sem_Visit_Visit :: (VisitIdentifier) -> (StateIdentifier) -> (StateIdentifier) -> (Set Identifier) -> (Set Identifier) -> T_VisitSteps -> (VisitKind) -> T_Visit sem_Visit_Visit arg_ident_ arg_from_ arg_to_ arg_inh_ arg_syn_ arg_steps_ arg_kind_ = T_Visit (return st47) where {-# NOINLINE st47 #-} st47 = let v46 :: T_Visit_v46 v46 = \ (T_Visit_vIn46 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) -> ( let _stepsX53 = Control.Monad.Identity.runIdentity (attach_T_VisitSteps (arg_steps_)) (T_VisitSteps_vOut52 _stepsIdefs _stepsIerrors _stepsIindex _stepsIisLast _stepsIlazyIntras _stepsIprevMaxSimRefs _stepsIruleKinds _stepsIruleUsage _stepsIsem_steps _stepsIsize _stepsIsync_steps _stepsIusedArgs _stepsIuses _stepsIvisitKinds) = inv_VisitSteps_s53 _stepsX53 (T_VisitSteps_vIn52 _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfmtMode _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOprevMaxSimRefs _stepsOruledefs _stepsOruleuses _stepsOuseParallel) _lhsOallvisits :: VisitStateState _lhsOallvisits = rule638 arg_from_ arg_ident_ arg_to_ _nameT_visit = rule639 _lhsInt arg_ident_ _nameTIn_visit = rule640 _lhsInt arg_ident_ _nameTOut_visit = rule641 _lhsInt arg_ident_ _nameTNext_visit = rule642 _lhsInt arg_to_ _nextVisitInfo = rule643 _lhsInextVisits arg_to_ _typecon = rule644 _lhsIoptions arg_kind_ _t_params = rule645 _lhsIparams _lhsOt_visits :: PP_Doc _lhsOt_visits = rule646 _addbang1 _inhpart _lhsIoptions _nameTIn_visit _nameTNext_visit _nameTOut_visit _nameT_visit _nextVisitInfo _synpart _t_params _typecon _inhpart = rule647 _lhsIinhmap _ppTypeList arg_inh_ _synpart = rule648 _lhsIsynmap _ppTypeList arg_syn_ _ppTypeList = rule649 _addbang1 _lhsOsem_visit :: (StateIdentifier,Bool -> PP_Doc) _lhsOsem_visit = rule650 _addbang _inhpats _lhsIcon _lhsInt _lhsIoptions _nameTIn_visit _nameT_visit _stepsClosing _stepsInitial _stepsIsem_steps _t_params _vname arg_from_ arg_ident_ _stepsInitial = rule651 arg_kind_ _stepsClosing = rule652 _addbang _nextStBuild _resultval arg_kind_ _vname = rule653 arg_ident_ _inhpats = rule654 _lhsIoptions arg_inh_ _inhargs = rule655 _lhsIoptions arg_inh_ _synargs = rule656 _lhsIoptions arg_syn_ _nextargsMp = rule657 _lhsIallintramap arg_to_ _nextargs = rule658 _nextargsMp _nextst = rule659 _lhsIoptions _nextargs _nextargsMp arg_to_ _resultval = rule660 _nameTOut_visit _nextStRef _synargs (_nextStBuild,_nextStRef) = rule661 _addbang _nextVisitInfo _nextst _stepsOkind = rule662 arg_kind_ _stepsOfmtMode = rule663 arg_kind_ _stepsOindex = rule664 () _stepsOprevMaxSimRefs = rule665 () _stepsOuseParallel = rule666 () _prevVisitInfo = rule667 _lhsInextVisits arg_from_ _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule668 _invokecode arg_ident_ _invokecode = rule669 _addbang _inhargs _lhsInt _lhsIoptions _nameTIn_visit _nameTOut_visit _nextVisitInfo _prevVisitInfo arg_from_ arg_ident_ arg_kind_ arg_syn_ arg_to_ _thisintra = rule670 _defsAsMap _nextintra _uses _lhsOintramap :: Map StateIdentifier (Map String (Maybe NonLocalAttr)) _lhsOintramap = rule671 _thisintra arg_from_ _nextintra = rule672 _lhsIallintramap arg_to_ _uses = rule673 _lhsIoptions _stepsIuses arg_syn_ _inhVarNms = rule674 _lhsIoptions arg_inh_ _defs = rule675 _inhVarNms _lhsIterminaldefs _stepsIdefs _defsAsMap = rule676 _defs _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule677 arg_ident_ arg_syn_ _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule678 arg_ident_ arg_inh_ _lazyIntrasInh = rule679 _inhVarNms _stepsIdefs arg_kind_ _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule680 _lazyIntrasInh _stepsIlazyIntras _addbang = rule681 _lhsIoptions _addbang1 = rule682 _addbang arg_kind_ _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule683 arg_from_ arg_ident_ arg_to_ _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule684 arg_ident_ arg_kind_ _lhsOerrors :: Seq Error _lhsOerrors = rule685 _stepsIerrors _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule686 _stepsIruleKinds _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule687 _stepsIruleUsage _lhsOusedArgs :: Set String _lhsOusedArgs = rule688 _stepsIusedArgs _stepsOallFromToStates = rule689 _lhsIallFromToStates _stepsOallInitStates = rule690 _lhsIallInitStates _stepsOallVisitKinds = rule691 _lhsIallVisitKinds _stepsOallchildvisit = rule692 _lhsIallchildvisit _stepsOavisitdefs = rule693 _lhsIavisitdefs _stepsOavisituses = rule694 _lhsIavisituses _stepsOchildTypes = rule695 _lhsIchildTypes _stepsOchildintros = rule696 _lhsIchildintros _stepsOmrules = rule697 _lhsImrules _stepsOoptions = rule698 _lhsIoptions _stepsOruledefs = rule699 _lhsIruledefs _stepsOruleuses = rule700 _lhsIruleuses __result_ = T_Visit_vOut46 _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOusedArgs _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_Visit_s47 v46 {-# INLINE rule638 #-} {-# LINE 340 "src-ag/ExecutionPlan2Hs.ag" #-} rule638 = \ from_ ident_ to_ -> {-# LINE 340 "src-ag/ExecutionPlan2Hs.ag" #-} (ident_, from_, to_) {-# LINE 5168 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule639 #-} {-# LINE 399 "src-ag/ExecutionPlan2Hs.ag" #-} rule639 = \ ((_lhsInt) :: NontermIdent) ident_ -> {-# LINE 399 "src-ag/ExecutionPlan2Hs.ag" #-} conNmTVisit _lhsInt ident_ {-# LINE 5174 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule640 #-} {-# LINE 400 "src-ag/ExecutionPlan2Hs.ag" #-} rule640 = \ ((_lhsInt) :: NontermIdent) ident_ -> {-# LINE 400 "src-ag/ExecutionPlan2Hs.ag" #-} conNmTVisitIn _lhsInt ident_ {-# LINE 5180 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule641 #-} {-# LINE 401 "src-ag/ExecutionPlan2Hs.ag" #-} rule641 = \ ((_lhsInt) :: NontermIdent) ident_ -> {-# LINE 401 "src-ag/ExecutionPlan2Hs.ag" #-} conNmTVisitOut _lhsInt ident_ {-# LINE 5186 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule642 #-} {-# LINE 402 "src-ag/ExecutionPlan2Hs.ag" #-} rule642 = \ ((_lhsInt) :: NontermIdent) to_ -> {-# LINE 402 "src-ag/ExecutionPlan2Hs.ag" #-} conNmTNextVisit _lhsInt to_ {-# LINE 5192 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule643 #-} {-# LINE 404 "src-ag/ExecutionPlan2Hs.ag" #-} rule643 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) to_ -> {-# LINE 404 "src-ag/ExecutionPlan2Hs.ag" #-} Map.findWithDefault ManyVis to_ _lhsInextVisits {-# LINE 5198 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule644 #-} {-# LINE 405 "src-ag/ExecutionPlan2Hs.ag" #-} rule644 = \ ((_lhsIoptions) :: Options) kind_ -> {-# LINE 405 "src-ag/ExecutionPlan2Hs.ag" #-} case kind_ of VisitPure _ -> empty VisitMonadic -> ppMonadType _lhsIoptions {-# LINE 5206 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule645 #-} {-# LINE 409 "src-ag/ExecutionPlan2Hs.ag" #-} rule645 = \ ((_lhsIparams) :: [Identifier]) -> {-# LINE 409 "src-ag/ExecutionPlan2Hs.ag" #-} ppSpaced _lhsIparams {-# LINE 5212 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule646 #-} {-# LINE 410 "src-ag/ExecutionPlan2Hs.ag" #-} rule646 = \ _addbang1 _inhpart ((_lhsIoptions) :: Options) _nameTIn_visit _nameTNext_visit _nameTOut_visit _nameT_visit _nextVisitInfo _synpart _t_params _typecon -> {-# LINE 410 "src-ag/ExecutionPlan2Hs.ag" #-} "type" >#< _nameT_visit >#< _t_params >#< "=" >#< pp_parens (_nameTIn_visit >#< _t_params ) >#< ( if dummyTokenVisit _lhsIoptions then "->" >#< dummyType _lhsIoptions True else empty ) >#< "->" >#< _typecon >#< pp_parens (_nameTOut_visit >#< _t_params ) >-< "data" >#< _nameTIn_visit >#< _t_params >#< "=" >#< _nameTIn_visit >#< _inhpart >-< "data" >#< _nameTOut_visit >#< _t_params >#< "=" >#< _nameTOut_visit >#< _synpart >#< case _nextVisitInfo of NoneVis -> empty _ -> _addbang1 $ pp_parens (_nameTNext_visit >#< _t_params ) {-# LINE 5230 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule647 #-} {-# LINE 423 "src-ag/ExecutionPlan2Hs.ag" #-} rule647 = \ ((_lhsIinhmap) :: Attributes) _ppTypeList inh_ -> {-# LINE 423 "src-ag/ExecutionPlan2Hs.ag" #-} _ppTypeList inh_ _lhsIinhmap {-# LINE 5236 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule648 #-} {-# LINE 424 "src-ag/ExecutionPlan2Hs.ag" #-} rule648 = \ ((_lhsIsynmap) :: Attributes) _ppTypeList syn_ -> {-# LINE 424 "src-ag/ExecutionPlan2Hs.ag" #-} _ppTypeList syn_ _lhsIsynmap {-# LINE 5242 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule649 #-} {-# LINE 425 "src-ag/ExecutionPlan2Hs.ag" #-} rule649 = \ _addbang1 -> {-# LINE 425 "src-ag/ExecutionPlan2Hs.ag" #-} \s m -> ppSpaced $ map (\i -> _addbang1 $ pp_parens $ case Map.lookup i m of Just tp -> ppTp tp ) $ Set.toList s {-# LINE 5249 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule650 #-} {-# LINE 728 "src-ag/ExecutionPlan2Hs.ag" #-} rule650 = \ _addbang _inhpats ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) _nameTIn_visit _nameT_visit _stepsClosing _stepsInitial ((_stepsIsem_steps) :: PP_Doc) _t_params _vname from_ ident_ -> {-# LINE 728 "src-ag/ExecutionPlan2Hs.ag" #-} ( from_ , \addInlinePragma -> ( if noInlinePragmas _lhsIoptions then empty else if addInlinePragma && aggressiveInlinePragmas _lhsIoptions then ppInline _vname else if helpInlining _lhsIoptions then ppNoInline _vname else empty ) >-< "v" >|< ident_ >#< "::" >#< _nameT_visit >#< _t_params >-< "v" >|< ident_ >#< "=" >#< "\\" >#< (_addbang $ pp_parens (_nameTIn_visit >#< _inhpats )) >#< ( if dummyTokenVisit _lhsIoptions then pp $ dummyPat _lhsIoptions True else empty ) >#< "->" >#< ( if genCostCentres _lhsIoptions then ppCostCentre (_vname >|< "_" >|< _lhsInt >|< "_" >|< _lhsIcon) else empty ) >#< "(" >#< _stepsInitial >-< indent 3 (_stepsIsem_steps >-< _stepsClosing >#< ")") ) {-# LINE 5277 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule651 #-} {-# LINE 753 "src-ag/ExecutionPlan2Hs.ag" #-} rule651 = \ kind_ -> {-# LINE 753 "src-ag/ExecutionPlan2Hs.ag" #-} case kind_ of VisitPure False -> text "let" VisitPure True -> empty VisitMonadic -> text "do" {-# LINE 5286 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule652 #-} {-# LINE 757 "src-ag/ExecutionPlan2Hs.ag" #-} rule652 = \ _addbang _nextStBuild _resultval kind_ -> {-# LINE 757 "src-ag/ExecutionPlan2Hs.ag" #-} let decls = _nextStBuild >-< _addbang (pp resultValName) >#< "=" >#< _resultval in case kind_ of VisitPure False -> decls >-< "in" >#< resultValName VisitPure True -> "let" >#< decls >-< indent 1 ("in" >#< resultValName) VisitMonadic -> "let" >#< decls >-< "return" >#< resultValName {-# LINE 5300 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule653 #-} {-# LINE 766 "src-ag/ExecutionPlan2Hs.ag" #-} rule653 = \ ident_ -> {-# LINE 766 "src-ag/ExecutionPlan2Hs.ag" #-} "v" >|< ident_ {-# LINE 5306 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule654 #-} {-# LINE 767 "src-ag/ExecutionPlan2Hs.ag" #-} rule654 = \ ((_lhsIoptions) :: Options) inh_ -> {-# LINE 767 "src-ag/ExecutionPlan2Hs.ag" #-} ppSpaced $ map (\arg -> pp $ attrname _lhsIoptions True _LHS arg) $ Set.toList inh_ {-# LINE 5312 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule655 #-} {-# LINE 768 "src-ag/ExecutionPlan2Hs.ag" #-} rule655 = \ ((_lhsIoptions) :: Options) inh_ -> {-# LINE 768 "src-ag/ExecutionPlan2Hs.ag" #-} \chn -> ppSpaced $ map (attrname _lhsIoptions False chn) $ Set.toList inh_ {-# LINE 5318 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule656 #-} {-# LINE 769 "src-ag/ExecutionPlan2Hs.ag" #-} rule656 = \ ((_lhsIoptions) :: Options) syn_ -> {-# LINE 769 "src-ag/ExecutionPlan2Hs.ag" #-} ppSpaced $ map (\arg -> attrname _lhsIoptions False _LHS arg) $ Set.toList syn_ {-# LINE 5324 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule657 #-} {-# LINE 770 "src-ag/ExecutionPlan2Hs.ag" #-} rule657 = \ ((_lhsIallintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) to_ -> {-# LINE 770 "src-ag/ExecutionPlan2Hs.ag" #-} maybe Map.empty id $ Map.lookup to_ _lhsIallintramap {-# LINE 5330 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule658 #-} {-# LINE 771 "src-ag/ExecutionPlan2Hs.ag" #-} rule658 = \ _nextargsMp -> {-# LINE 771 "src-ag/ExecutionPlan2Hs.ag" #-} ppSpaced $ Map.keys $ _nextargsMp {-# LINE 5336 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule659 #-} {-# LINE 772 "src-ag/ExecutionPlan2Hs.ag" #-} rule659 = \ ((_lhsIoptions) :: Options) _nextargs _nextargsMp to_ -> {-# LINE 772 "src-ag/ExecutionPlan2Hs.ag" #-} "st" >|< to_ >#< _nextargs >#< dummyArg _lhsIoptions (Map.null _nextargsMp ) {-# LINE 5342 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule660 #-} {-# LINE 773 "src-ag/ExecutionPlan2Hs.ag" #-} rule660 = \ _nameTOut_visit _nextStRef _synargs -> {-# LINE 773 "src-ag/ExecutionPlan2Hs.ag" #-} _nameTOut_visit >#< _synargs >#< _nextStRef {-# LINE 5348 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule661 #-} {-# LINE 775 "src-ag/ExecutionPlan2Hs.ag" #-} rule661 = \ _addbang _nextVisitInfo _nextst -> {-# LINE 775 "src-ag/ExecutionPlan2Hs.ag" #-} case _nextVisitInfo of NoneVis -> (empty, empty) _ -> (_addbang (pp nextStName) >#< "=" >#< _nextst , pp nextStName) {-# LINE 5356 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule662 #-} {-# LINE 789 "src-ag/ExecutionPlan2Hs.ag" #-} rule662 = \ kind_ -> {-# LINE 789 "src-ag/ExecutionPlan2Hs.ag" #-} kind_ {-# LINE 5362 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule663 #-} {-# LINE 840 "src-ag/ExecutionPlan2Hs.ag" #-} rule663 = \ kind_ -> {-# LINE 840 "src-ag/ExecutionPlan2Hs.ag" #-} case kind_ of VisitPure False -> FormatLetDecl VisitPure True -> FormatLetLine VisitMonadic -> FormatDo {-# LINE 5371 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule664 #-} {-# LINE 889 "src-ag/ExecutionPlan2Hs.ag" #-} rule664 = \ (_ :: ()) -> {-# LINE 889 "src-ag/ExecutionPlan2Hs.ag" #-} 0 {-# LINE 5377 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule665 #-} {-# LINE 896 "src-ag/ExecutionPlan2Hs.ag" #-} rule665 = \ (_ :: ()) -> {-# LINE 896 "src-ag/ExecutionPlan2Hs.ag" #-} 0 {-# LINE 5383 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule666 #-} {-# LINE 912 "src-ag/ExecutionPlan2Hs.ag" #-} rule666 = \ (_ :: ()) -> {-# LINE 912 "src-ag/ExecutionPlan2Hs.ag" #-} False {-# LINE 5389 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule667 #-} {-# LINE 1231 "src-ag/ExecutionPlan2Hs.ag" #-} rule667 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) from_ -> {-# LINE 1231 "src-ag/ExecutionPlan2Hs.ag" #-} Map.findWithDefault ManyVis from_ _lhsInextVisits {-# LINE 5395 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule668 #-} {-# LINE 1232 "src-ag/ExecutionPlan2Hs.ag" #-} rule668 = \ _invokecode ident_ -> {-# LINE 1232 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton ident_ _invokecode {-# LINE 5401 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule669 #-} {-# LINE 1233 "src-ag/ExecutionPlan2Hs.ag" #-} rule669 = \ _addbang _inhargs ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) _nameTIn_visit _nameTOut_visit _nextVisitInfo _prevVisitInfo from_ ident_ kind_ syn_ to_ -> {-# LINE 1233 "src-ag/ExecutionPlan2Hs.ag" #-} \chn kind -> if kind `compatibleKind` kind_ then Right $ let pat | isLazyKind kind_ = pat0 | otherwise = _addbang pat0 pat0 = pp_parens pat1 pat1 = _nameTOut_visit >#< (ppSpaced $ map (attrname _lhsIoptions True chn) $ Set.toList syn_) >#< cont cont = case _nextVisitInfo of NoneVis -> empty _ -> ch1 ch0 = text $ stname chn from_ ch1 = text $ stname chn to_ expr = case (kind, kind_) of (VisitPure _, VisitPure _) -> expr0 (VisitPure _, VisitMonadic) -> unMon _lhsIoptions >#< expr0 (VisitMonadic, VisitPure _) -> "return" >#< expr0 (VisitMonadic, VisitMonadic) -> expr0 expr0 = case _prevVisitInfo of NoneVis -> error "error: invocation of a visit from a state that has no next visits" OneVis _ -> "inv_" >|< _lhsInt >|< "_s" >|< from_ >#< ch0 >#< args ManyVis -> "inv_" >|< _lhsInt >|< "_s" >|< from_ >#< ch0 >#< "K_" >|< _lhsInt >|< "_v" >|< ident_ >#< args args = pp_parens args0 >#< args1 args0 = _nameTIn_visit >#< _inhargs chn args1 | dummyTokenVisit _lhsIoptions = pp $ dummyArg _lhsIoptions True | otherwise = empty in (pat, expr) else Left $ IncompatibleVisitKind chn ident_ kind kind_ {-# LINE 5435 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule670 #-} {-# LINE 1329 "src-ag/ExecutionPlan2Hs.ag" #-} rule670 = \ _defsAsMap _nextintra _uses -> {-# LINE 1329 "src-ag/ExecutionPlan2Hs.ag" #-} (_uses `Map.union` _nextintra ) `Map.difference` _defsAsMap {-# LINE 5441 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule671 #-} {-# LINE 1330 "src-ag/ExecutionPlan2Hs.ag" #-} rule671 = \ _thisintra from_ -> {-# LINE 1330 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton from_ _thisintra {-# LINE 5447 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule672 #-} {-# LINE 1331 "src-ag/ExecutionPlan2Hs.ag" #-} rule672 = \ ((_lhsIallintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) to_ -> {-# LINE 1331 "src-ag/ExecutionPlan2Hs.ag" #-} maybe Map.empty id $ Map.lookup to_ _lhsIallintramap {-# LINE 5453 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule673 #-} {-# LINE 1332 "src-ag/ExecutionPlan2Hs.ag" #-} rule673 = \ ((_lhsIoptions) :: Options) ((_stepsIuses) :: Map String (Maybe NonLocalAttr)) syn_ -> {-# LINE 1332 "src-ag/ExecutionPlan2Hs.ag" #-} let mp1 = _stepsIuses mp2 = Map.fromList [ (lhsname _lhsIoptions False i, Just (AttrSyn _LHS i)) | i <- Set.elems syn_ ] in mp1 `Map.union` mp2 {-# LINE 5461 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule674 #-} {-# LINE 1335 "src-ag/ExecutionPlan2Hs.ag" #-} rule674 = \ ((_lhsIoptions) :: Options) inh_ -> {-# LINE 1335 "src-ag/ExecutionPlan2Hs.ag" #-} Set.map (lhsname _lhsIoptions True) inh_ {-# LINE 5467 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule675 #-} {-# LINE 1336 "src-ag/ExecutionPlan2Hs.ag" #-} rule675 = \ _inhVarNms ((_lhsIterminaldefs) :: Set String) ((_stepsIdefs) :: Set String) -> {-# LINE 1336 "src-ag/ExecutionPlan2Hs.ag" #-} _stepsIdefs `Set.union` _inhVarNms `Set.union` _lhsIterminaldefs {-# LINE 5473 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule676 #-} {-# LINE 1337 "src-ag/ExecutionPlan2Hs.ag" #-} rule676 = \ _defs -> {-# LINE 1337 "src-ag/ExecutionPlan2Hs.ag" #-} Map.fromList [ (a, Nothing) | a <- Set.elems _defs ] {-# LINE 5479 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule677 #-} {-# LINE 1361 "src-ag/ExecutionPlan2Hs.ag" #-} rule677 = \ ident_ syn_ -> {-# LINE 1361 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton ident_ syn_ {-# LINE 5485 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule678 #-} {-# LINE 1362 "src-ag/ExecutionPlan2Hs.ag" #-} rule678 = \ ident_ inh_ -> {-# LINE 1362 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton ident_ inh_ {-# LINE 5491 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule679 #-} {-# LINE 1394 "src-ag/ExecutionPlan2Hs.ag" #-} rule679 = \ _inhVarNms ((_stepsIdefs) :: Set String) kind_ -> {-# LINE 1394 "src-ag/ExecutionPlan2Hs.ag" #-} case kind_ of VisitPure False -> _inhVarNms `Set.union` _stepsIdefs _ -> Set.empty {-# LINE 5499 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule680 #-} {-# LINE 1397 "src-ag/ExecutionPlan2Hs.ag" #-} rule680 = \ _lazyIntrasInh ((_stepsIlazyIntras) :: Set String) -> {-# LINE 1397 "src-ag/ExecutionPlan2Hs.ag" #-} _lazyIntrasInh `Set.union` _stepsIlazyIntras {-# LINE 5505 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule681 #-} {-# LINE 1550 "src-ag/ExecutionPlan2Hs.ag" #-} rule681 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1550 "src-ag/ExecutionPlan2Hs.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 5511 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule682 #-} {-# LINE 1558 "src-ag/ExecutionPlan2Hs.ag" #-} rule682 = \ _addbang kind_ -> {-# LINE 1558 "src-ag/ExecutionPlan2Hs.ag" #-} if isLazyKind kind_ then id else _addbang {-# LINE 5517 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule683 #-} {-# LINE 1585 "src-ag/ExecutionPlan2Hs.ag" #-} rule683 = \ from_ ident_ to_ -> {-# LINE 1585 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton ident_ (from_, to_) {-# LINE 5523 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule684 #-} {-# LINE 1629 "src-ag/ExecutionPlan2Hs.ag" #-} rule684 = \ ident_ kind_ -> {-# LINE 1629 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton ident_ kind_ {-# LINE 5529 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule685 #-} rule685 = \ ((_stepsIerrors) :: Seq Error) -> _stepsIerrors {-# INLINE rule686 #-} rule686 = \ ((_stepsIruleKinds) :: Map Identifier (Set VisitKind)) -> _stepsIruleKinds {-# INLINE rule687 #-} rule687 = \ ((_stepsIruleUsage) :: Map Identifier Int) -> _stepsIruleUsage {-# INLINE rule688 #-} rule688 = \ ((_stepsIusedArgs) :: Set String) -> _stepsIusedArgs {-# INLINE rule689 #-} rule689 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule690 #-} rule690 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule691 #-} rule691 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule692 #-} rule692 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule693 #-} rule693 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule694 #-} rule694 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule695 #-} rule695 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule696 #-} rule696 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule697 #-} rule697 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule698 #-} rule698 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule699 #-} rule699 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule700 #-} rule700 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses -- VisitStep --------------------------------------------------- -- wrapper data Inh_VisitStep = Inh_VisitStep { allFromToStates_Inh_VisitStep :: (Map VisitIdentifier (Int,Int)), allInitStates_Inh_VisitStep :: (Map NontermIdent Int), allVisitKinds_Inh_VisitStep :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_VisitStep :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), avisitdefs_Inh_VisitStep :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_VisitStep :: (Map VisitIdentifier (Set Identifier)), childTypes_Inh_VisitStep :: (Map Identifier Type), childintros_Inh_VisitStep :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), fmtMode_Inh_VisitStep :: (FormatMode), index_Inh_VisitStep :: (Int), isLast_Inh_VisitStep :: (Bool), kind_Inh_VisitStep :: (VisitKind), mrules_Inh_VisitStep :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)), options_Inh_VisitStep :: (Options), prevMaxSimRefs_Inh_VisitStep :: (Int), ruledefs_Inh_VisitStep :: (Map Identifier (Set String)), ruleuses_Inh_VisitStep :: (Map Identifier (Map String (Maybe NonLocalAttr))), useParallel_Inh_VisitStep :: (Bool) } data Syn_VisitStep = Syn_VisitStep { defs_Syn_VisitStep :: (Set String), errors_Syn_VisitStep :: (Seq Error), index_Syn_VisitStep :: (Int), isLast_Syn_VisitStep :: (Bool), lazyIntras_Syn_VisitStep :: (Set String), prevMaxSimRefs_Syn_VisitStep :: (Int), ruleKinds_Syn_VisitStep :: (Map Identifier (Set VisitKind)), ruleUsage_Syn_VisitStep :: (Map Identifier Int), sem_steps_Syn_VisitStep :: (PP_Doc), sync_steps_Syn_VisitStep :: (PP_Doc), usedArgs_Syn_VisitStep :: (Set String), uses_Syn_VisitStep :: (Map String (Maybe NonLocalAttr)), visitKinds_Syn_VisitStep :: (Map VisitIdentifier VisitKind) } {-# INLINABLE wrap_VisitStep #-} wrap_VisitStep :: T_VisitStep -> Inh_VisitStep -> (Syn_VisitStep ) wrap_VisitStep (T_VisitStep act) (Inh_VisitStep _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) = Control.Monad.Identity.runIdentity ( do sem <- act let arg49 = T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel (T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsync_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds) <- return (inv_VisitStep_s50 sem arg49) return (Syn_VisitStep _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsync_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds) ) -- cata {-# NOINLINE sem_VisitStep #-} sem_VisitStep :: VisitStep -> T_VisitStep sem_VisitStep ( Sem name_ ) = sem_VisitStep_Sem name_ sem_VisitStep ( ChildVisit child_ nonterm_ visit_ ) = sem_VisitStep_ChildVisit child_ nonterm_ visit_ sem_VisitStep ( PureGroup steps_ ordered_ ) = sem_VisitStep_PureGroup ( sem_VisitSteps steps_ ) ordered_ sem_VisitStep ( Sim steps_ ) = sem_VisitStep_Sim ( sem_VisitSteps steps_ ) sem_VisitStep ( ChildIntro child_ ) = sem_VisitStep_ChildIntro child_ -- semantic domain newtype T_VisitStep = T_VisitStep { attach_T_VisitStep :: Identity (T_VisitStep_s50 ) } newtype T_VisitStep_s50 = C_VisitStep_s50 { inv_VisitStep_s50 :: (T_VisitStep_v49 ) } data T_VisitStep_s51 = C_VisitStep_s51 type T_VisitStep_v49 = (T_VisitStep_vIn49 ) -> (T_VisitStep_vOut49 ) data T_VisitStep_vIn49 = T_VisitStep_vIn49 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Int) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map Identifier Type) (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) (FormatMode) (Int) (Bool) (VisitKind) (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) (Options) (Int) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (Bool) data T_VisitStep_vOut49 = T_VisitStep_vOut49 (Set String) (Seq Error) (Int) (Bool) (Set String) (Int) (Map Identifier (Set VisitKind)) (Map Identifier Int) (PP_Doc) (PP_Doc) (Set String) (Map String (Maybe NonLocalAttr)) (Map VisitIdentifier VisitKind) {-# NOINLINE sem_VisitStep_Sem #-} sem_VisitStep_Sem :: (Identifier) -> T_VisitStep sem_VisitStep_Sem arg_name_ = T_VisitStep (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_VisitStep_v49 v49 = \ (T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) -> ( let _ruleItf = rule701 _lhsImrules arg_name_ _lhsOerrors :: Seq Error (_lhsOerrors,_sem_steps) = rule702 _lhsIfmtMode _lhsIkind _ruleItf _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule703 arg_name_ _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule704 _lhsIkind arg_name_ _lhsOdefs :: Set String _lhsOdefs = rule705 _lhsIruledefs arg_name_ _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule706 _lhsIruleuses arg_name_ _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule707 () _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule708 _sem_steps _lhsOsync_steps :: PP_Doc _lhsOsync_steps = rule709 () _lhsOusedArgs :: Set String _lhsOusedArgs = rule710 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule711 () _lhsOindex :: Int _lhsOindex = rule712 _lhsIindex _lhsOisLast :: Bool _lhsOisLast = rule713 _lhsIisLast _lhsOprevMaxSimRefs :: Int _lhsOprevMaxSimRefs = rule714 _lhsIprevMaxSimRefs __result_ = T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsync_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitStep_s50 v49 {-# INLINE rule701 #-} {-# LINE 798 "src-ag/ExecutionPlan2Hs.ag" #-} rule701 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) name_ -> {-# LINE 798 "src-ag/ExecutionPlan2Hs.ag" #-} Map.findWithDefault (error $ "Rule " ++ show name_ ++ " not found") name_ _lhsImrules {-# LINE 5655 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule702 #-} {-# LINE 799 "src-ag/ExecutionPlan2Hs.ag" #-} rule702 = \ ((_lhsIfmtMode) :: FormatMode) ((_lhsIkind) :: VisitKind) _ruleItf -> {-# LINE 799 "src-ag/ExecutionPlan2Hs.ag" #-} case _ruleItf _lhsIkind _lhsIfmtMode of Left e -> (Seq.singleton e, empty) Right stmt -> (Seq.empty, stmt) {-# LINE 5663 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule703 #-} {-# LINE 1282 "src-ag/ExecutionPlan2Hs.ag" #-} rule703 = \ name_ -> {-# LINE 1282 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton name_ 1 {-# LINE 5669 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule704 #-} {-# LINE 1292 "src-ag/ExecutionPlan2Hs.ag" #-} rule704 = \ ((_lhsIkind) :: VisitKind) name_ -> {-# LINE 1292 "src-ag/ExecutionPlan2Hs.ag" #-} Map.singleton name_ (Set.singleton _lhsIkind) {-# LINE 5675 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule705 #-} {-# LINE 1377 "src-ag/ExecutionPlan2Hs.ag" #-} rule705 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) name_ -> {-# LINE 1377 "src-ag/ExecutionPlan2Hs.ag" #-} maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruledefs {-# LINE 5681 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule706 #-} {-# LINE 1378 "src-ag/ExecutionPlan2Hs.ag" #-} rule706 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) name_ -> {-# LINE 1378 "src-ag/ExecutionPlan2Hs.ag" #-} maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruleuses {-# LINE 5687 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule707 #-} rule707 = \ (_ :: ()) -> Set.empty {-# INLINE rule708 #-} rule708 = \ _sem_steps -> _sem_steps {-# INLINE rule709 #-} rule709 = \ (_ :: ()) -> empty {-# INLINE rule710 #-} rule710 = \ (_ :: ()) -> Set.empty {-# INLINE rule711 #-} rule711 = \ (_ :: ()) -> mempty {-# INLINE rule712 #-} rule712 = \ ((_lhsIindex) :: Int) -> _lhsIindex {-# INLINE rule713 #-} rule713 = \ ((_lhsIisLast) :: Bool) -> _lhsIisLast {-# INLINE rule714 #-} rule714 = \ ((_lhsIprevMaxSimRefs) :: Int) -> _lhsIprevMaxSimRefs {-# NOINLINE sem_VisitStep_ChildVisit #-} sem_VisitStep_ChildVisit :: (Identifier) -> (NontermIdent) -> (VisitIdentifier) -> T_VisitStep sem_VisitStep_ChildVisit arg_child_ _ arg_visit_ = T_VisitStep (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_VisitStep_v49 v49 = \ (T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) -> ( let _visitItf = rule715 _lhsIallchildvisit arg_visit_ _lhsOerrors :: Seq Error (_lhsOerrors,_patPP,_exprPP) = rule716 _lhsIkind _visitItf arg_child_ _useParallel = rule717 _lhsIisLast _lhsIuseParallel _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule718 _addbang _convToMonad _exprPP _lhsIfmtMode _lhsIindex _lhsIkind _patPP _useParallel _convToMonad = rule719 _callKind _callKind = rule720 _lhsIallVisitKinds arg_visit_ _lhsOsync_steps :: PP_Doc _lhsOsync_steps = rule721 _lhsIindex _patPP _useParallel _lhsOdefs :: Set String _lhsOdefs = rule722 _lhsIavisitdefs _lhsIoptions _to arg_child_ arg_visit_ _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule723 _from _lhsIavisituses _lhsIoptions arg_child_ arg_visit_ _addbang = rule724 _lhsIoptions (_from,_to) = rule725 _lhsIallFromToStates arg_visit_ _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule726 () _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule727 () _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule728 () _lhsOusedArgs :: Set String _lhsOusedArgs = rule729 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule730 () _lhsOindex :: Int _lhsOindex = rule731 _lhsIindex _lhsOisLast :: Bool _lhsOisLast = rule732 _lhsIisLast _lhsOprevMaxSimRefs :: Int _lhsOprevMaxSimRefs = rule733 _lhsIprevMaxSimRefs __result_ = T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsync_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitStep_s50 v49 {-# INLINE rule715 #-} {-# LINE 807 "src-ag/ExecutionPlan2Hs.ag" #-} rule715 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) visit_ -> {-# LINE 807 "src-ag/ExecutionPlan2Hs.ag" #-} Map.findWithDefault (error $ "Visit " ++ show visit_ ++ " not found") visit_ _lhsIallchildvisit {-# LINE 5759 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule716 #-} {-# LINE 808 "src-ag/ExecutionPlan2Hs.ag" #-} rule716 = \ ((_lhsIkind) :: VisitKind) _visitItf child_ -> {-# LINE 808 "src-ag/ExecutionPlan2Hs.ag" #-} case _visitItf child_ _lhsIkind of Left e -> (Seq.singleton e, empty, empty) Right (pat,expr) -> (Seq.empty, pat, expr) {-# LINE 5767 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule717 #-} {-# LINE 812 "src-ag/ExecutionPlan2Hs.ag" #-} rule717 = \ ((_lhsIisLast) :: Bool) ((_lhsIuseParallel) :: Bool) -> {-# LINE 812 "src-ag/ExecutionPlan2Hs.ag" #-} _lhsIuseParallel && not _lhsIisLast {-# LINE 5773 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule718 #-} {-# LINE 813 "src-ag/ExecutionPlan2Hs.ag" #-} rule718 = \ _addbang _convToMonad _exprPP ((_lhsIfmtMode) :: FormatMode) ((_lhsIindex) :: Int) ((_lhsIkind) :: VisitKind) _patPP _useParallel -> {-# LINE 813 "src-ag/ExecutionPlan2Hs.ag" #-} if _useParallel then _addbang ("sync_" >|< _lhsIindex) >#< "<- newEmptyMVar" >-< "forkIO" >#< pp_parens (_convToMonad >#< pp_parens _exprPP >#< ">>= \\" >#< _addbang (pp parResultName) >#< " -> putMVar sync_" >|< _lhsIindex >#< parResultName) else let decl = case _lhsIkind of VisitPure _ -> _patPP >#< "=" >#< _exprPP VisitMonadic -> _patPP >#< "<-" >#< _exprPP in fmtDecl False _lhsIfmtMode decl {-# LINE 5785 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule719 #-} {-# LINE 820 "src-ag/ExecutionPlan2Hs.ag" #-} rule719 = \ _callKind -> {-# LINE 820 "src-ag/ExecutionPlan2Hs.ag" #-} case _callKind of VisitPure _ -> text "return" VisitMonadic -> empty {-# LINE 5793 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule720 #-} {-# LINE 823 "src-ag/ExecutionPlan2Hs.ag" #-} rule720 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) visit_ -> {-# LINE 823 "src-ag/ExecutionPlan2Hs.ag" #-} Map.findWithDefault (error "visit kind should be in the map") visit_ _lhsIallVisitKinds {-# LINE 5799 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule721 #-} {-# LINE 831 "src-ag/ExecutionPlan2Hs.ag" #-} rule721 = \ ((_lhsIindex) :: Int) _patPP _useParallel -> {-# LINE 831 "src-ag/ExecutionPlan2Hs.ag" #-} if _useParallel then _patPP >#< "<-" >#< "takeMVar sync_" >|< _lhsIindex else empty {-# LINE 5807 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule722 #-} {-# LINE 1379 "src-ag/ExecutionPlan2Hs.ag" #-} rule722 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) ((_lhsIoptions) :: Options) _to child_ visit_ -> {-# LINE 1379 "src-ag/ExecutionPlan2Hs.ag" #-} Set.insert (stname child_ _to) $ maybe (error "Visit not found") (Set.map $ attrname _lhsIoptions True child_) $ Map.lookup visit_ _lhsIavisitdefs {-# LINE 5813 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule723 #-} {-# LINE 1380 "src-ag/ExecutionPlan2Hs.ag" #-} rule723 = \ _from ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) ((_lhsIoptions) :: Options) child_ visit_ -> {-# LINE 1380 "src-ag/ExecutionPlan2Hs.ag" #-} let convert attrs = Map.fromList [ (attrname _lhsIoptions False child_ attr, Just $ mkNonLocalAttr True child_ attr) | attr <- Set.elems attrs ] in Map.insert (stname child_ _from) Nothing $ convert $ maybe (error "Visit not found") id $ Map.lookup visit_ _lhsIavisituses {-# LINE 5821 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule724 #-} {-# LINE 1555 "src-ag/ExecutionPlan2Hs.ag" #-} rule724 = \ ((_lhsIoptions) :: Options) -> {-# LINE 1555 "src-ag/ExecutionPlan2Hs.ag" #-} \x -> if bangpats _lhsIoptions then "!" >|< x else x {-# LINE 5827 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule725 #-} {-# LINE 1591 "src-ag/ExecutionPlan2Hs.ag" #-} rule725 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) visit_ -> {-# LINE 1591 "src-ag/ExecutionPlan2Hs.ag" #-} Map.findWithDefault (error "visit not in allFromToStates") visit_ _lhsIallFromToStates {-# LINE 5833 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule726 #-} rule726 = \ (_ :: ()) -> Set.empty {-# INLINE rule727 #-} rule727 = \ (_ :: ()) -> Map.empty {-# INLINE rule728 #-} rule728 = \ (_ :: ()) -> Map.empty {-# INLINE rule729 #-} rule729 = \ (_ :: ()) -> Set.empty {-# INLINE rule730 #-} rule730 = \ (_ :: ()) -> mempty {-# INLINE rule731 #-} rule731 = \ ((_lhsIindex) :: Int) -> _lhsIindex {-# INLINE rule732 #-} rule732 = \ ((_lhsIisLast) :: Bool) -> _lhsIisLast {-# INLINE rule733 #-} rule733 = \ ((_lhsIprevMaxSimRefs) :: Int) -> _lhsIprevMaxSimRefs {-# NOINLINE sem_VisitStep_PureGroup #-} sem_VisitStep_PureGroup :: T_VisitSteps -> (Bool) -> T_VisitStep sem_VisitStep_PureGroup arg_steps_ arg_ordered_ = T_VisitStep (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_VisitStep_v49 v49 = \ (T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) -> ( let _stepsX53 = Control.Monad.Identity.runIdentity (attach_T_VisitSteps (arg_steps_)) (T_VisitSteps_vOut52 _stepsIdefs _stepsIerrors _stepsIindex _stepsIisLast _stepsIlazyIntras _stepsIprevMaxSimRefs _stepsIruleKinds _stepsIruleUsage _stepsIsem_steps _stepsIsize _stepsIsync_steps _stepsIusedArgs _stepsIuses _stepsIvisitKinds) = inv_VisitSteps_s53 _stepsX53 (T_VisitSteps_vIn52 _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfmtMode _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOprevMaxSimRefs _stepsOruledefs _stepsOruleuses _stepsOuseParallel) _stepsOkind = rule734 arg_ordered_ _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule735 _lhsIfmtMode _stepsIsem_steps _stepsOfmtMode = rule736 _lhsIfmtMode _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule737 _stepsIdefs _stepsIlazyIntras arg_ordered_ _lhsOdefs :: Set String _lhsOdefs = rule738 _stepsIdefs _lhsOerrors :: Seq Error _lhsOerrors = rule739 _stepsIerrors _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule740 _stepsIruleKinds _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule741 _stepsIruleUsage _lhsOsync_steps :: PP_Doc _lhsOsync_steps = rule742 _stepsIsync_steps _lhsOusedArgs :: Set String _lhsOusedArgs = rule743 _stepsIusedArgs _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule744 _stepsIuses _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule745 _stepsIvisitKinds _lhsOindex :: Int _lhsOindex = rule746 _stepsIindex _lhsOisLast :: Bool _lhsOisLast = rule747 _stepsIisLast _lhsOprevMaxSimRefs :: Int _lhsOprevMaxSimRefs = rule748 _stepsIprevMaxSimRefs _stepsOallFromToStates = rule749 _lhsIallFromToStates _stepsOallInitStates = rule750 _lhsIallInitStates _stepsOallVisitKinds = rule751 _lhsIallVisitKinds _stepsOallchildvisit = rule752 _lhsIallchildvisit _stepsOavisitdefs = rule753 _lhsIavisitdefs _stepsOavisituses = rule754 _lhsIavisituses _stepsOchildTypes = rule755 _lhsIchildTypes _stepsOchildintros = rule756 _lhsIchildintros _stepsOindex = rule757 _lhsIindex _stepsOmrules = rule758 _lhsImrules _stepsOoptions = rule759 _lhsIoptions _stepsOprevMaxSimRefs = rule760 _lhsIprevMaxSimRefs _stepsOruledefs = rule761 _lhsIruledefs _stepsOruleuses = rule762 _lhsIruleuses _stepsOuseParallel = rule763 _lhsIuseParallel __result_ = T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsync_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitStep_s50 v49 {-# INLINE rule734 #-} {-# LINE 793 "src-ag/ExecutionPlan2Hs.ag" #-} rule734 = \ ordered_ -> {-# LINE 793 "src-ag/ExecutionPlan2Hs.ag" #-} VisitPure ordered_ {-# LINE 5918 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule735 #-} {-# LINE 825 "src-ag/ExecutionPlan2Hs.ag" #-} rule735 = \ ((_lhsIfmtMode) :: FormatMode) ((_stepsIsem_steps) :: PP_Doc) -> {-# LINE 825 "src-ag/ExecutionPlan2Hs.ag" #-} case _lhsIfmtMode of FormatDo -> "let" >#< _stepsIsem_steps _ -> _stepsIsem_steps {-# LINE 5926 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule736 #-} {-# LINE 846 "src-ag/ExecutionPlan2Hs.ag" #-} rule736 = \ ((_lhsIfmtMode) :: FormatMode) -> {-# LINE 846 "src-ag/ExecutionPlan2Hs.ag" #-} case _lhsIfmtMode of FormatDo -> FormatLetDecl mode -> mode {-# LINE 5934 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule737 #-} {-# LINE 1400 "src-ag/ExecutionPlan2Hs.ag" #-} rule737 = \ ((_stepsIdefs) :: Set String) ((_stepsIlazyIntras) :: Set String) ordered_ -> {-# LINE 1400 "src-ag/ExecutionPlan2Hs.ag" #-} if ordered_ then _stepsIlazyIntras else _stepsIdefs {-# LINE 5942 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule738 #-} rule738 = \ ((_stepsIdefs) :: Set String) -> _stepsIdefs {-# INLINE rule739 #-} rule739 = \ ((_stepsIerrors) :: Seq Error) -> _stepsIerrors {-# INLINE rule740 #-} rule740 = \ ((_stepsIruleKinds) :: Map Identifier (Set VisitKind)) -> _stepsIruleKinds {-# INLINE rule741 #-} rule741 = \ ((_stepsIruleUsage) :: Map Identifier Int) -> _stepsIruleUsage {-# INLINE rule742 #-} rule742 = \ ((_stepsIsync_steps) :: PP_Doc) -> _stepsIsync_steps {-# INLINE rule743 #-} rule743 = \ ((_stepsIusedArgs) :: Set String) -> _stepsIusedArgs {-# INLINE rule744 #-} rule744 = \ ((_stepsIuses) :: Map String (Maybe NonLocalAttr)) -> _stepsIuses {-# INLINE rule745 #-} rule745 = \ ((_stepsIvisitKinds) :: Map VisitIdentifier VisitKind) -> _stepsIvisitKinds {-# INLINE rule746 #-} rule746 = \ ((_stepsIindex) :: Int) -> _stepsIindex {-# INLINE rule747 #-} rule747 = \ ((_stepsIisLast) :: Bool) -> _stepsIisLast {-# INLINE rule748 #-} rule748 = \ ((_stepsIprevMaxSimRefs) :: Int) -> _stepsIprevMaxSimRefs {-# INLINE rule749 #-} rule749 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule750 #-} rule750 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule751 #-} rule751 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule752 #-} rule752 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule753 #-} rule753 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule754 #-} rule754 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule755 #-} rule755 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule756 #-} rule756 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule757 #-} rule757 = \ ((_lhsIindex) :: Int) -> _lhsIindex {-# INLINE rule758 #-} rule758 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule759 #-} rule759 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule760 #-} rule760 = \ ((_lhsIprevMaxSimRefs) :: Int) -> _lhsIprevMaxSimRefs {-# INLINE rule761 #-} rule761 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule762 #-} rule762 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# INLINE rule763 #-} rule763 = \ ((_lhsIuseParallel) :: Bool) -> _lhsIuseParallel {-# NOINLINE sem_VisitStep_Sim #-} sem_VisitStep_Sim :: T_VisitSteps -> T_VisitStep sem_VisitStep_Sim arg_steps_ = T_VisitStep (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_VisitStep_v49 v49 = \ (T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) -> ( let _stepsX53 = Control.Monad.Identity.runIdentity (attach_T_VisitSteps (arg_steps_)) (T_VisitSteps_vOut52 _stepsIdefs _stepsIerrors _stepsIindex _stepsIisLast _stepsIlazyIntras _stepsIprevMaxSimRefs _stepsIruleKinds _stepsIruleUsage _stepsIsem_steps _stepsIsize _stepsIsync_steps _stepsIusedArgs _stepsIuses _stepsIvisitKinds) = inv_VisitSteps_s53 _stepsX53 (T_VisitSteps_vIn52 _stepsOallFromToStates _stepsOallInitStates _stepsOallVisitKinds _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildTypes _stepsOchildintros _stepsOfmtMode _stepsOindex _stepsOkind _stepsOmrules _stepsOoptions _stepsOprevMaxSimRefs _stepsOruledefs _stepsOruleuses _stepsOuseParallel) _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule764 _stepsIsem_steps _stepsIsync_steps _stepsOindex = rule765 () _lhsOindex :: Int _lhsOindex = rule766 _lhsIindex _lhsOprevMaxSimRefs :: Int _lhsOprevMaxSimRefs = rule767 _lhsIprevMaxSimRefs _stepsIindex _useParallel _useParallel = rule768 _isMonadic _lhsIoptions _stepsIsize _isMonadic = rule769 _lhsIkind _lhsOdefs :: Set String _lhsOdefs = rule770 _stepsIdefs _lhsOerrors :: Seq Error _lhsOerrors = rule771 _stepsIerrors _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule772 _stepsIlazyIntras _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule773 _stepsIruleKinds _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule774 _stepsIruleUsage _lhsOsync_steps :: PP_Doc _lhsOsync_steps = rule775 _stepsIsync_steps _lhsOusedArgs :: Set String _lhsOusedArgs = rule776 _stepsIusedArgs _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule777 _stepsIuses _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule778 _stepsIvisitKinds _lhsOisLast :: Bool _lhsOisLast = rule779 _stepsIisLast _stepsOallFromToStates = rule780 _lhsIallFromToStates _stepsOallInitStates = rule781 _lhsIallInitStates _stepsOallVisitKinds = rule782 _lhsIallVisitKinds _stepsOallchildvisit = rule783 _lhsIallchildvisit _stepsOavisitdefs = rule784 _lhsIavisitdefs _stepsOavisituses = rule785 _lhsIavisituses _stepsOchildTypes = rule786 _lhsIchildTypes _stepsOchildintros = rule787 _lhsIchildintros _stepsOfmtMode = rule788 _lhsIfmtMode _stepsOkind = rule789 _lhsIkind _stepsOmrules = rule790 _lhsImrules _stepsOoptions = rule791 _lhsIoptions _stepsOprevMaxSimRefs = rule792 _lhsIprevMaxSimRefs _stepsOruledefs = rule793 _lhsIruledefs _stepsOruleuses = rule794 _lhsIruleuses _stepsOuseParallel = rule795 _useParallel __result_ = T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsync_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitStep_s50 v49 {-# INLINE rule764 #-} {-# LINE 824 "src-ag/ExecutionPlan2Hs.ag" #-} rule764 = \ ((_stepsIsem_steps) :: PP_Doc) ((_stepsIsync_steps) :: PP_Doc) -> {-# LINE 824 "src-ag/ExecutionPlan2Hs.ag" #-} _stepsIsem_steps >-< _stepsIsync_steps {-# LINE 6083 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule765 #-} {-# LINE 890 "src-ag/ExecutionPlan2Hs.ag" #-} rule765 = \ (_ :: ()) -> {-# LINE 890 "src-ag/ExecutionPlan2Hs.ag" #-} 0 {-# LINE 6089 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule766 #-} {-# LINE 891 "src-ag/ExecutionPlan2Hs.ag" #-} rule766 = \ ((_lhsIindex) :: Int) -> {-# LINE 891 "src-ag/ExecutionPlan2Hs.ag" #-} _lhsIindex {-# LINE 6095 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule767 #-} {-# LINE 898 "src-ag/ExecutionPlan2Hs.ag" #-} rule767 = \ ((_lhsIprevMaxSimRefs) :: Int) ((_stepsIindex) :: Int) _useParallel -> {-# LINE 898 "src-ag/ExecutionPlan2Hs.ag" #-} if _useParallel then _lhsIprevMaxSimRefs `max` (_stepsIindex - 1) else _lhsIprevMaxSimRefs {-# LINE 6103 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule768 #-} {-# LINE 913 "src-ag/ExecutionPlan2Hs.ag" #-} rule768 = \ _isMonadic ((_lhsIoptions) :: Options) ((_stepsIsize) :: Int) -> {-# LINE 913 "src-ag/ExecutionPlan2Hs.ag" #-} parallelInvoke _lhsIoptions && _stepsIsize > 1 && _isMonadic {-# LINE 6109 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule769 #-} {-# LINE 914 "src-ag/ExecutionPlan2Hs.ag" #-} rule769 = \ ((_lhsIkind) :: VisitKind) -> {-# LINE 914 "src-ag/ExecutionPlan2Hs.ag" #-} case _lhsIkind of VisitMonadic -> True _ -> False {-# LINE 6117 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule770 #-} rule770 = \ ((_stepsIdefs) :: Set String) -> _stepsIdefs {-# INLINE rule771 #-} rule771 = \ ((_stepsIerrors) :: Seq Error) -> _stepsIerrors {-# INLINE rule772 #-} rule772 = \ ((_stepsIlazyIntras) :: Set String) -> _stepsIlazyIntras {-# INLINE rule773 #-} rule773 = \ ((_stepsIruleKinds) :: Map Identifier (Set VisitKind)) -> _stepsIruleKinds {-# INLINE rule774 #-} rule774 = \ ((_stepsIruleUsage) :: Map Identifier Int) -> _stepsIruleUsage {-# INLINE rule775 #-} rule775 = \ ((_stepsIsync_steps) :: PP_Doc) -> _stepsIsync_steps {-# INLINE rule776 #-} rule776 = \ ((_stepsIusedArgs) :: Set String) -> _stepsIusedArgs {-# INLINE rule777 #-} rule777 = \ ((_stepsIuses) :: Map String (Maybe NonLocalAttr)) -> _stepsIuses {-# INLINE rule778 #-} rule778 = \ ((_stepsIvisitKinds) :: Map VisitIdentifier VisitKind) -> _stepsIvisitKinds {-# INLINE rule779 #-} rule779 = \ ((_stepsIisLast) :: Bool) -> _stepsIisLast {-# INLINE rule780 #-} rule780 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule781 #-} rule781 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule782 #-} rule782 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule783 #-} rule783 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule784 #-} rule784 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule785 #-} rule785 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule786 #-} rule786 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule787 #-} rule787 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule788 #-} rule788 = \ ((_lhsIfmtMode) :: FormatMode) -> _lhsIfmtMode {-# INLINE rule789 #-} rule789 = \ ((_lhsIkind) :: VisitKind) -> _lhsIkind {-# INLINE rule790 #-} rule790 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule791 #-} rule791 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule792 #-} rule792 = \ ((_lhsIprevMaxSimRefs) :: Int) -> _lhsIprevMaxSimRefs {-# INLINE rule793 #-} rule793 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule794 #-} rule794 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# INLINE rule795 #-} rule795 = \ _useParallel -> _useParallel {-# NOINLINE sem_VisitStep_ChildIntro #-} sem_VisitStep_ChildIntro :: (Identifier) -> T_VisitStep sem_VisitStep_ChildIntro arg_child_ = T_VisitStep (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_VisitStep_v49 v49 = \ (T_VisitStep_vIn49 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIisLast _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) -> ( let _attachItf = rule796 _lhsIchildintros arg_child_ _lhsOerrors :: Seq Error _lhsOsem_steps :: PP_Doc _lhsOdefs :: Set String _lhsOuses :: Map String (Maybe NonLocalAttr) (_lhsOerrors,_lhsOsem_steps,_lhsOdefs,_lhsOuses) = rule797 _attachItf _lhsIfmtMode _lhsIkind _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule798 () _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule799 () _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule800 () _lhsOsync_steps :: PP_Doc _lhsOsync_steps = rule801 () _lhsOusedArgs :: Set String _lhsOusedArgs = rule802 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule803 () _lhsOindex :: Int _lhsOindex = rule804 _lhsIindex _lhsOisLast :: Bool _lhsOisLast = rule805 _lhsIisLast _lhsOprevMaxSimRefs :: Int _lhsOprevMaxSimRefs = rule806 _lhsIprevMaxSimRefs __result_ = T_VisitStep_vOut49 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsync_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitStep_s50 v49 {-# INLINE rule796 #-} {-# LINE 802 "src-ag/ExecutionPlan2Hs.ag" #-} rule796 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) child_ -> {-# LINE 802 "src-ag/ExecutionPlan2Hs.ag" #-} Map.findWithDefault (error $ "Child " ++ show child_ ++ " not found") child_ _lhsIchildintros {-# LINE 6235 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule797 #-} {-# LINE 804 "src-ag/ExecutionPlan2Hs.ag" #-} rule797 = \ _attachItf ((_lhsIfmtMode) :: FormatMode) ((_lhsIkind) :: VisitKind) -> {-# LINE 804 "src-ag/ExecutionPlan2Hs.ag" #-} case _attachItf _lhsIkind _lhsIfmtMode of Left e -> (Seq.singleton e, empty, Set.empty, Map.empty) Right (code, defs, uses) -> (Seq.empty, code, defs, uses) {-# LINE 6243 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule798 #-} rule798 = \ (_ :: ()) -> Set.empty {-# INLINE rule799 #-} rule799 = \ (_ :: ()) -> Map.empty {-# INLINE rule800 #-} rule800 = \ (_ :: ()) -> Map.empty {-# INLINE rule801 #-} rule801 = \ (_ :: ()) -> empty {-# INLINE rule802 #-} rule802 = \ (_ :: ()) -> Set.empty {-# INLINE rule803 #-} rule803 = \ (_ :: ()) -> mempty {-# INLINE rule804 #-} rule804 = \ ((_lhsIindex) :: Int) -> _lhsIindex {-# INLINE rule805 #-} rule805 = \ ((_lhsIisLast) :: Bool) -> _lhsIisLast {-# INLINE rule806 #-} rule806 = \ ((_lhsIprevMaxSimRefs) :: Int) -> _lhsIprevMaxSimRefs -- VisitSteps -------------------------------------------------- -- wrapper data Inh_VisitSteps = Inh_VisitSteps { allFromToStates_Inh_VisitSteps :: (Map VisitIdentifier (Int,Int)), allInitStates_Inh_VisitSteps :: (Map NontermIdent Int), allVisitKinds_Inh_VisitSteps :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_VisitSteps :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), avisitdefs_Inh_VisitSteps :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_VisitSteps :: (Map VisitIdentifier (Set Identifier)), childTypes_Inh_VisitSteps :: (Map Identifier Type), childintros_Inh_VisitSteps :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), fmtMode_Inh_VisitSteps :: (FormatMode), index_Inh_VisitSteps :: (Int), kind_Inh_VisitSteps :: (VisitKind), mrules_Inh_VisitSteps :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)), options_Inh_VisitSteps :: (Options), prevMaxSimRefs_Inh_VisitSteps :: (Int), ruledefs_Inh_VisitSteps :: (Map Identifier (Set String)), ruleuses_Inh_VisitSteps :: (Map Identifier (Map String (Maybe NonLocalAttr))), useParallel_Inh_VisitSteps :: (Bool) } data Syn_VisitSteps = Syn_VisitSteps { defs_Syn_VisitSteps :: (Set String), errors_Syn_VisitSteps :: (Seq Error), index_Syn_VisitSteps :: (Int), isLast_Syn_VisitSteps :: (Bool), lazyIntras_Syn_VisitSteps :: (Set String), prevMaxSimRefs_Syn_VisitSteps :: (Int), ruleKinds_Syn_VisitSteps :: (Map Identifier (Set VisitKind)), ruleUsage_Syn_VisitSteps :: (Map Identifier Int), sem_steps_Syn_VisitSteps :: (PP_Doc), size_Syn_VisitSteps :: (Int), sync_steps_Syn_VisitSteps :: (PP_Doc), usedArgs_Syn_VisitSteps :: (Set String), uses_Syn_VisitSteps :: (Map String (Maybe NonLocalAttr)), visitKinds_Syn_VisitSteps :: (Map VisitIdentifier VisitKind) } {-# INLINABLE wrap_VisitSteps #-} wrap_VisitSteps :: T_VisitSteps -> Inh_VisitSteps -> (Syn_VisitSteps ) wrap_VisitSteps (T_VisitSteps act) (Inh_VisitSteps _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) = Control.Monad.Identity.runIdentity ( do sem <- act let arg52 = T_VisitSteps_vIn52 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel (T_VisitSteps_vOut52 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsize _lhsOsync_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds) <- return (inv_VisitSteps_s53 sem arg52) return (Syn_VisitSteps _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsize _lhsOsync_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds) ) -- cata {-# NOINLINE sem_VisitSteps #-} sem_VisitSteps :: VisitSteps -> T_VisitSteps sem_VisitSteps list = Prelude.foldr sem_VisitSteps_Cons sem_VisitSteps_Nil (Prelude.map sem_VisitStep list) -- semantic domain newtype T_VisitSteps = T_VisitSteps { attach_T_VisitSteps :: Identity (T_VisitSteps_s53 ) } newtype T_VisitSteps_s53 = C_VisitSteps_s53 { inv_VisitSteps_s53 :: (T_VisitSteps_v52 ) } data T_VisitSteps_s54 = C_VisitSteps_s54 type T_VisitSteps_v52 = (T_VisitSteps_vIn52 ) -> (T_VisitSteps_vOut52 ) data T_VisitSteps_vIn52 = T_VisitSteps_vIn52 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Int) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map Identifier Type) (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) (FormatMode) (Int) (VisitKind) (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) (Options) (Int) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (Bool) data T_VisitSteps_vOut52 = T_VisitSteps_vOut52 (Set String) (Seq Error) (Int) (Bool) (Set String) (Int) (Map Identifier (Set VisitKind)) (Map Identifier Int) (PP_Doc) (Int) (PP_Doc) (Set String) (Map String (Maybe NonLocalAttr)) (Map VisitIdentifier VisitKind) {-# NOINLINE sem_VisitSteps_Cons #-} sem_VisitSteps_Cons :: T_VisitStep -> T_VisitSteps -> T_VisitSteps sem_VisitSteps_Cons arg_hd_ arg_tl_ = T_VisitSteps (return st53) where {-# NOINLINE st53 #-} st53 = let v52 :: T_VisitSteps_v52 v52 = \ (T_VisitSteps_vIn52 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) -> ( let _hdX50 = Control.Monad.Identity.runIdentity (attach_T_VisitStep (arg_hd_)) _tlX53 = Control.Monad.Identity.runIdentity (attach_T_VisitSteps (arg_tl_)) (T_VisitStep_vOut49 _hdIdefs _hdIerrors _hdIindex _hdIisLast _hdIlazyIntras _hdIprevMaxSimRefs _hdIruleKinds _hdIruleUsage _hdIsem_steps _hdIsync_steps _hdIusedArgs _hdIuses _hdIvisitKinds) = inv_VisitStep_s50 _hdX50 (T_VisitStep_vIn49 _hdOallFromToStates _hdOallInitStates _hdOallVisitKinds _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOchildTypes _hdOchildintros _hdOfmtMode _hdOindex _hdOisLast _hdOkind _hdOmrules _hdOoptions _hdOprevMaxSimRefs _hdOruledefs _hdOruleuses _hdOuseParallel) (T_VisitSteps_vOut52 _tlIdefs _tlIerrors _tlIindex _tlIisLast _tlIlazyIntras _tlIprevMaxSimRefs _tlIruleKinds _tlIruleUsage _tlIsem_steps _tlIsize _tlIsync_steps _tlIusedArgs _tlIuses _tlIvisitKinds) = inv_VisitSteps_s53 _tlX53 (T_VisitSteps_vIn52 _tlOallFromToStates _tlOallInitStates _tlOallVisitKinds _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOchildTypes _tlOchildintros _tlOfmtMode _tlOindex _tlOkind _tlOmrules _tlOoptions _tlOprevMaxSimRefs _tlOruledefs _tlOruleuses _tlOuseParallel) _lhsOsize :: Int _lhsOsize = rule807 _tlIsize _hdOindex = rule808 _lhsIindex _tlOindex = rule809 _lhsIindex _lhsOindex :: Int _lhsOindex = rule810 _tlIindex _lhsOisLast :: Bool _lhsOisLast = rule811 () _hdOisLast = rule812 _tlIisLast _lhsOdefs :: Set String _lhsOdefs = rule813 _hdIdefs _tlIdefs _lhsOerrors :: Seq Error _lhsOerrors = rule814 _hdIerrors _tlIerrors _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule815 _hdIlazyIntras _tlIlazyIntras _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule816 _hdIruleKinds _tlIruleKinds _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule817 _hdIruleUsage _tlIruleUsage _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule818 _hdIsem_steps _tlIsem_steps _lhsOsync_steps :: PP_Doc _lhsOsync_steps = rule819 _hdIsync_steps _tlIsync_steps _lhsOusedArgs :: Set String _lhsOusedArgs = rule820 _hdIusedArgs _tlIusedArgs _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule821 _hdIuses _tlIuses _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule822 _hdIvisitKinds _tlIvisitKinds _lhsOprevMaxSimRefs :: Int _lhsOprevMaxSimRefs = rule823 _tlIprevMaxSimRefs _hdOallFromToStates = rule824 _lhsIallFromToStates _hdOallInitStates = rule825 _lhsIallInitStates _hdOallVisitKinds = rule826 _lhsIallVisitKinds _hdOallchildvisit = rule827 _lhsIallchildvisit _hdOavisitdefs = rule828 _lhsIavisitdefs _hdOavisituses = rule829 _lhsIavisituses _hdOchildTypes = rule830 _lhsIchildTypes _hdOchildintros = rule831 _lhsIchildintros _hdOfmtMode = rule832 _lhsIfmtMode _hdOkind = rule833 _lhsIkind _hdOmrules = rule834 _lhsImrules _hdOoptions = rule835 _lhsIoptions _hdOprevMaxSimRefs = rule836 _lhsIprevMaxSimRefs _hdOruledefs = rule837 _lhsIruledefs _hdOruleuses = rule838 _lhsIruleuses _hdOuseParallel = rule839 _lhsIuseParallel _tlOallFromToStates = rule840 _lhsIallFromToStates _tlOallInitStates = rule841 _lhsIallInitStates _tlOallVisitKinds = rule842 _lhsIallVisitKinds _tlOallchildvisit = rule843 _lhsIallchildvisit _tlOavisitdefs = rule844 _lhsIavisitdefs _tlOavisituses = rule845 _lhsIavisituses _tlOchildTypes = rule846 _lhsIchildTypes _tlOchildintros = rule847 _lhsIchildintros _tlOfmtMode = rule848 _lhsIfmtMode _tlOkind = rule849 _lhsIkind _tlOmrules = rule850 _lhsImrules _tlOoptions = rule851 _lhsIoptions _tlOprevMaxSimRefs = rule852 _hdIprevMaxSimRefs _tlOruledefs = rule853 _lhsIruledefs _tlOruleuses = rule854 _lhsIruleuses _tlOuseParallel = rule855 _lhsIuseParallel __result_ = T_VisitSteps_vOut52 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsize _lhsOsync_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitSteps_s53 v52 {-# INLINE rule807 #-} {-# LINE 881 "src-ag/ExecutionPlan2Hs.ag" #-} rule807 = \ ((_tlIsize) :: Int) -> {-# LINE 881 "src-ag/ExecutionPlan2Hs.ag" #-} 1 + _tlIsize {-# LINE 6384 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule808 #-} {-# LINE 886 "src-ag/ExecutionPlan2Hs.ag" #-} rule808 = \ ((_lhsIindex) :: Int) -> {-# LINE 886 "src-ag/ExecutionPlan2Hs.ag" #-} _lhsIindex {-# LINE 6390 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule809 #-} {-# LINE 887 "src-ag/ExecutionPlan2Hs.ag" #-} rule809 = \ ((_lhsIindex) :: Int) -> {-# LINE 887 "src-ag/ExecutionPlan2Hs.ag" #-} 1 + _lhsIindex {-# LINE 6396 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule810 #-} {-# LINE 888 "src-ag/ExecutionPlan2Hs.ag" #-} rule810 = \ ((_tlIindex) :: Int) -> {-# LINE 888 "src-ag/ExecutionPlan2Hs.ag" #-} _tlIindex {-# LINE 6402 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule811 #-} {-# LINE 907 "src-ag/ExecutionPlan2Hs.ag" #-} rule811 = \ (_ :: ()) -> {-# LINE 907 "src-ag/ExecutionPlan2Hs.ag" #-} False {-# LINE 6408 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule812 #-} {-# LINE 908 "src-ag/ExecutionPlan2Hs.ag" #-} rule812 = \ ((_tlIisLast) :: Bool) -> {-# LINE 908 "src-ag/ExecutionPlan2Hs.ag" #-} _tlIisLast {-# LINE 6414 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule813 #-} rule813 = \ ((_hdIdefs) :: Set String) ((_tlIdefs) :: Set String) -> _hdIdefs `Set.union` _tlIdefs {-# INLINE rule814 #-} rule814 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule815 #-} rule815 = \ ((_hdIlazyIntras) :: Set String) ((_tlIlazyIntras) :: Set String) -> _hdIlazyIntras `Set.union` _tlIlazyIntras {-# INLINE rule816 #-} rule816 = \ ((_hdIruleKinds) :: Map Identifier (Set VisitKind)) ((_tlIruleKinds) :: Map Identifier (Set VisitKind)) -> _hdIruleKinds `unionWithMappend` _tlIruleKinds {-# INLINE rule817 #-} rule817 = \ ((_hdIruleUsage) :: Map Identifier Int) ((_tlIruleUsage) :: Map Identifier Int) -> _hdIruleUsage `unionWithSum` _tlIruleUsage {-# INLINE rule818 #-} rule818 = \ ((_hdIsem_steps) :: PP_Doc) ((_tlIsem_steps) :: PP_Doc) -> _hdIsem_steps >-< _tlIsem_steps {-# INLINE rule819 #-} rule819 = \ ((_hdIsync_steps) :: PP_Doc) ((_tlIsync_steps) :: PP_Doc) -> _hdIsync_steps >-< _tlIsync_steps {-# INLINE rule820 #-} rule820 = \ ((_hdIusedArgs) :: Set String) ((_tlIusedArgs) :: Set String) -> _hdIusedArgs `Set.union` _tlIusedArgs {-# INLINE rule821 #-} rule821 = \ ((_hdIuses) :: Map String (Maybe NonLocalAttr)) ((_tlIuses) :: Map String (Maybe NonLocalAttr)) -> _hdIuses `Map.union` _tlIuses {-# INLINE rule822 #-} rule822 = \ ((_hdIvisitKinds) :: Map VisitIdentifier VisitKind) ((_tlIvisitKinds) :: Map VisitIdentifier VisitKind) -> _hdIvisitKinds `mappend` _tlIvisitKinds {-# INLINE rule823 #-} rule823 = \ ((_tlIprevMaxSimRefs) :: Int) -> _tlIprevMaxSimRefs {-# INLINE rule824 #-} rule824 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule825 #-} rule825 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule826 #-} rule826 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule827 #-} rule827 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule828 #-} rule828 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule829 #-} rule829 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule830 #-} rule830 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule831 #-} rule831 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule832 #-} rule832 = \ ((_lhsIfmtMode) :: FormatMode) -> _lhsIfmtMode {-# INLINE rule833 #-} rule833 = \ ((_lhsIkind) :: VisitKind) -> _lhsIkind {-# INLINE rule834 #-} rule834 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule835 #-} rule835 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule836 #-} rule836 = \ ((_lhsIprevMaxSimRefs) :: Int) -> _lhsIprevMaxSimRefs {-# INLINE rule837 #-} rule837 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule838 #-} rule838 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# INLINE rule839 #-} rule839 = \ ((_lhsIuseParallel) :: Bool) -> _lhsIuseParallel {-# INLINE rule840 #-} rule840 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule841 #-} rule841 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule842 #-} rule842 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule843 #-} rule843 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule844 #-} rule844 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule845 #-} rule845 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule846 #-} rule846 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule847 #-} rule847 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule848 #-} rule848 = \ ((_lhsIfmtMode) :: FormatMode) -> _lhsIfmtMode {-# INLINE rule849 #-} rule849 = \ ((_lhsIkind) :: VisitKind) -> _lhsIkind {-# INLINE rule850 #-} rule850 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule851 #-} rule851 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule852 #-} rule852 = \ ((_hdIprevMaxSimRefs) :: Int) -> _hdIprevMaxSimRefs {-# INLINE rule853 #-} rule853 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule854 #-} rule854 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# INLINE rule855 #-} rule855 = \ ((_lhsIuseParallel) :: Bool) -> _lhsIuseParallel {-# NOINLINE sem_VisitSteps_Nil #-} sem_VisitSteps_Nil :: T_VisitSteps sem_VisitSteps_Nil = T_VisitSteps (return st53) where {-# NOINLINE st53 #-} st53 = let v52 :: T_VisitSteps_v52 v52 = \ (T_VisitSteps_vIn52 _lhsIallFromToStates _lhsIallInitStates _lhsIallVisitKinds _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIfmtMode _lhsIindex _lhsIkind _lhsImrules _lhsIoptions _lhsIprevMaxSimRefs _lhsIruledefs _lhsIruleuses _lhsIuseParallel) -> ( let _lhsOsize :: Int _lhsOsize = rule856 () _lhsOisLast :: Bool _lhsOisLast = rule857 () _lhsOdefs :: Set String _lhsOdefs = rule858 () _lhsOerrors :: Seq Error _lhsOerrors = rule859 () _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule860 () _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule861 () _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule862 () _lhsOsem_steps :: PP_Doc _lhsOsem_steps = rule863 () _lhsOsync_steps :: PP_Doc _lhsOsync_steps = rule864 () _lhsOusedArgs :: Set String _lhsOusedArgs = rule865 () _lhsOuses :: Map String (Maybe NonLocalAttr) _lhsOuses = rule866 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule867 () _lhsOindex :: Int _lhsOindex = rule868 _lhsIindex _lhsOprevMaxSimRefs :: Int _lhsOprevMaxSimRefs = rule869 _lhsIprevMaxSimRefs __result_ = T_VisitSteps_vOut52 _lhsOdefs _lhsOerrors _lhsOindex _lhsOisLast _lhsOlazyIntras _lhsOprevMaxSimRefs _lhsOruleKinds _lhsOruleUsage _lhsOsem_steps _lhsOsize _lhsOsync_steps _lhsOusedArgs _lhsOuses _lhsOvisitKinds in __result_ ) in C_VisitSteps_s53 v52 {-# INLINE rule856 #-} {-# LINE 880 "src-ag/ExecutionPlan2Hs.ag" #-} rule856 = \ (_ :: ()) -> {-# LINE 880 "src-ag/ExecutionPlan2Hs.ag" #-} 0 {-# LINE 6587 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule857 #-} {-# LINE 906 "src-ag/ExecutionPlan2Hs.ag" #-} rule857 = \ (_ :: ()) -> {-# LINE 906 "src-ag/ExecutionPlan2Hs.ag" #-} True {-# LINE 6593 "dist/build/ExecutionPlan2Hs.hs"#-} {-# INLINE rule858 #-} rule858 = \ (_ :: ()) -> Set.empty {-# INLINE rule859 #-} rule859 = \ (_ :: ()) -> Seq.empty {-# INLINE rule860 #-} rule860 = \ (_ :: ()) -> Set.empty {-# INLINE rule861 #-} rule861 = \ (_ :: ()) -> Map.empty {-# INLINE rule862 #-} rule862 = \ (_ :: ()) -> Map.empty {-# INLINE rule863 #-} rule863 = \ (_ :: ()) -> empty {-# INLINE rule864 #-} rule864 = \ (_ :: ()) -> empty {-# INLINE rule865 #-} rule865 = \ (_ :: ()) -> Set.empty {-# INLINE rule866 #-} rule866 = \ (_ :: ()) -> Map.empty {-# INLINE rule867 #-} rule867 = \ (_ :: ()) -> mempty {-# INLINE rule868 #-} rule868 = \ ((_lhsIindex) :: Int) -> _lhsIindex {-# INLINE rule869 #-} rule869 = \ ((_lhsIprevMaxSimRefs) :: Int) -> _lhsIprevMaxSimRefs -- Visits ------------------------------------------------------ -- wrapper data Inh_Visits = Inh_Visits { allFromToStates_Inh_Visits :: (Map VisitIdentifier (Int,Int)), allInhmap_Inh_Visits :: (Map NontermIdent Attributes), allInitStates_Inh_Visits :: (Map NontermIdent Int), allSynmap_Inh_Visits :: (Map NontermIdent Attributes), allVisitKinds_Inh_Visits :: (Map VisitIdentifier VisitKind), allchildvisit_Inh_Visits :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), allintramap_Inh_Visits :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))), avisitdefs_Inh_Visits :: (Map VisitIdentifier (Set Identifier)), avisituses_Inh_Visits :: (Map VisitIdentifier (Set Identifier)), childTypes_Inh_Visits :: (Map Identifier Type), childintros_Inh_Visits :: (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))), con_Inh_Visits :: (ConstructorIdent), inhmap_Inh_Visits :: (Attributes), mrules_Inh_Visits :: (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)), nextVisits_Inh_Visits :: (Map StateIdentifier StateCtx), nt_Inh_Visits :: (NontermIdent), options_Inh_Visits :: (Options), params_Inh_Visits :: ([Identifier]), prevVisits_Inh_Visits :: (Map StateIdentifier StateCtx), ruledefs_Inh_Visits :: (Map Identifier (Set String)), ruleuses_Inh_Visits :: (Map Identifier (Map String (Maybe NonLocalAttr))), synmap_Inh_Visits :: (Attributes), terminaldefs_Inh_Visits :: (Set String) } data Syn_Visits = Syn_Visits { allvisits_Syn_Visits :: ([VisitStateState]), childvisit_Syn_Visits :: (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))), errors_Syn_Visits :: (Seq Error), fromToStates_Syn_Visits :: (Map VisitIdentifier (Int,Int)), intramap_Syn_Visits :: (Map StateIdentifier (Map String (Maybe NonLocalAttr))), lazyIntras_Syn_Visits :: (Set String), ruleKinds_Syn_Visits :: (Map Identifier (Set VisitKind)), ruleUsage_Syn_Visits :: (Map Identifier Int), sem_visit_Syn_Visits :: ( [(StateIdentifier,Bool -> PP_Doc)] ), t_visits_Syn_Visits :: (PP_Doc), usedArgs_Syn_Visits :: (Set String), visitKinds_Syn_Visits :: (Map VisitIdentifier VisitKind), visitdefs_Syn_Visits :: (Map VisitIdentifier (Set Identifier)), visituses_Syn_Visits :: (Map VisitIdentifier (Set Identifier)) } {-# INLINABLE wrap_Visits #-} wrap_Visits :: T_Visits -> Inh_Visits -> (Syn_Visits ) wrap_Visits (T_Visits act) (Inh_Visits _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) = Control.Monad.Identity.runIdentity ( do sem <- act let arg55 = T_Visits_vIn55 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs (T_Visits_vOut55 _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOusedArgs _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) <- return (inv_Visits_s56 sem arg55) return (Syn_Visits _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOusedArgs _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses) ) -- cata {-# NOINLINE sem_Visits #-} sem_Visits :: Visits -> T_Visits sem_Visits list = Prelude.foldr sem_Visits_Cons sem_Visits_Nil (Prelude.map sem_Visit list) -- semantic domain newtype T_Visits = T_Visits { attach_T_Visits :: Identity (T_Visits_s56 ) } newtype T_Visits_s56 = C_Visits_s56 { inv_Visits_s56 :: (T_Visits_v55 ) } data T_Visits_s57 = C_Visits_s57 type T_Visits_v55 = (T_Visits_vIn55 ) -> (T_Visits_vOut55 ) data T_Visits_vIn55 = T_Visits_vIn55 (Map VisitIdentifier (Int,Int)) (Map NontermIdent Attributes) (Map NontermIdent Int) (Map NontermIdent Attributes) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Map StateIdentifier (Map String (Maybe NonLocalAttr))) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) (Map Identifier Type) (Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) (ConstructorIdent) (Attributes) (Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) (Map StateIdentifier StateCtx) (NontermIdent) (Options) ([Identifier]) (Map StateIdentifier StateCtx) (Map Identifier (Set String)) (Map Identifier (Map String (Maybe NonLocalAttr))) (Attributes) (Set String) data T_Visits_vOut55 = T_Visits_vOut55 ([VisitStateState]) (Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) (Seq Error) (Map VisitIdentifier (Int,Int)) (Map StateIdentifier (Map String (Maybe NonLocalAttr))) (Set String) (Map Identifier (Set VisitKind)) (Map Identifier Int) ( [(StateIdentifier,Bool -> PP_Doc)] ) (PP_Doc) (Set String) (Map VisitIdentifier VisitKind) (Map VisitIdentifier (Set Identifier)) (Map VisitIdentifier (Set Identifier)) {-# NOINLINE sem_Visits_Cons #-} sem_Visits_Cons :: T_Visit -> T_Visits -> T_Visits sem_Visits_Cons arg_hd_ arg_tl_ = T_Visits (return st56) where {-# NOINLINE st56 #-} st56 = let v55 :: T_Visits_v55 v55 = \ (T_Visits_vIn55 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) -> ( let _hdX47 = Control.Monad.Identity.runIdentity (attach_T_Visit (arg_hd_)) _tlX56 = Control.Monad.Identity.runIdentity (attach_T_Visits (arg_tl_)) (T_Visit_vOut46 _hdIallvisits _hdIchildvisit _hdIerrors _hdIfromToStates _hdIintramap _hdIlazyIntras _hdIruleKinds _hdIruleUsage _hdIsem_visit _hdIt_visits _hdIusedArgs _hdIvisitKinds _hdIvisitdefs _hdIvisituses) = inv_Visit_s47 _hdX47 (T_Visit_vIn46 _hdOallFromToStates _hdOallInhmap _hdOallInitStates _hdOallSynmap _hdOallVisitKinds _hdOallchildvisit _hdOallintramap _hdOavisitdefs _hdOavisituses _hdOchildTypes _hdOchildintros _hdOcon _hdOinhmap _hdOmrules _hdOnextVisits _hdOnt _hdOoptions _hdOparams _hdOprevVisits _hdOruledefs _hdOruleuses _hdOsynmap _hdOterminaldefs) (T_Visits_vOut55 _tlIallvisits _tlIchildvisit _tlIerrors _tlIfromToStates _tlIintramap _tlIlazyIntras _tlIruleKinds _tlIruleUsage _tlIsem_visit _tlIt_visits _tlIusedArgs _tlIvisitKinds _tlIvisitdefs _tlIvisituses) = inv_Visits_s56 _tlX56 (T_Visits_vIn55 _tlOallFromToStates _tlOallInhmap _tlOallInitStates _tlOallSynmap _tlOallVisitKinds _tlOallchildvisit _tlOallintramap _tlOavisitdefs _tlOavisituses _tlOchildTypes _tlOchildintros _tlOcon _tlOinhmap _tlOmrules _tlOnextVisits _tlOnt _tlOoptions _tlOparams _tlOprevVisits _tlOruledefs _tlOruleuses _tlOsynmap _tlOterminaldefs) _lhsOallvisits :: [VisitStateState] _lhsOallvisits = rule870 _hdIallvisits _tlIallvisits _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule871 _hdIchildvisit _tlIchildvisit _lhsOerrors :: Seq Error _lhsOerrors = rule872 _hdIerrors _tlIerrors _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule873 _hdIfromToStates _tlIfromToStates _lhsOintramap :: Map StateIdentifier (Map String (Maybe NonLocalAttr)) _lhsOintramap = rule874 _hdIintramap _tlIintramap _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule875 _hdIlazyIntras _tlIlazyIntras _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule876 _hdIruleKinds _tlIruleKinds _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule877 _hdIruleUsage _tlIruleUsage _lhsOsem_visit :: [(StateIdentifier,Bool -> PP_Doc)] _lhsOsem_visit = rule878 _hdIsem_visit _tlIsem_visit _lhsOt_visits :: PP_Doc _lhsOt_visits = rule879 _hdIt_visits _tlIt_visits _lhsOusedArgs :: Set String _lhsOusedArgs = rule880 _hdIusedArgs _tlIusedArgs _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule881 _hdIvisitKinds _tlIvisitKinds _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule882 _hdIvisitdefs _tlIvisitdefs _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule883 _hdIvisituses _tlIvisituses _hdOallFromToStates = rule884 _lhsIallFromToStates _hdOallInhmap = rule885 _lhsIallInhmap _hdOallInitStates = rule886 _lhsIallInitStates _hdOallSynmap = rule887 _lhsIallSynmap _hdOallVisitKinds = rule888 _lhsIallVisitKinds _hdOallchildvisit = rule889 _lhsIallchildvisit _hdOallintramap = rule890 _lhsIallintramap _hdOavisitdefs = rule891 _lhsIavisitdefs _hdOavisituses = rule892 _lhsIavisituses _hdOchildTypes = rule893 _lhsIchildTypes _hdOchildintros = rule894 _lhsIchildintros _hdOcon = rule895 _lhsIcon _hdOinhmap = rule896 _lhsIinhmap _hdOmrules = rule897 _lhsImrules _hdOnextVisits = rule898 _lhsInextVisits _hdOnt = rule899 _lhsInt _hdOoptions = rule900 _lhsIoptions _hdOparams = rule901 _lhsIparams _hdOprevVisits = rule902 _lhsIprevVisits _hdOruledefs = rule903 _lhsIruledefs _hdOruleuses = rule904 _lhsIruleuses _hdOsynmap = rule905 _lhsIsynmap _hdOterminaldefs = rule906 _lhsIterminaldefs _tlOallFromToStates = rule907 _lhsIallFromToStates _tlOallInhmap = rule908 _lhsIallInhmap _tlOallInitStates = rule909 _lhsIallInitStates _tlOallSynmap = rule910 _lhsIallSynmap _tlOallVisitKinds = rule911 _lhsIallVisitKinds _tlOallchildvisit = rule912 _lhsIallchildvisit _tlOallintramap = rule913 _lhsIallintramap _tlOavisitdefs = rule914 _lhsIavisitdefs _tlOavisituses = rule915 _lhsIavisituses _tlOchildTypes = rule916 _lhsIchildTypes _tlOchildintros = rule917 _lhsIchildintros _tlOcon = rule918 _lhsIcon _tlOinhmap = rule919 _lhsIinhmap _tlOmrules = rule920 _lhsImrules _tlOnextVisits = rule921 _lhsInextVisits _tlOnt = rule922 _lhsInt _tlOoptions = rule923 _lhsIoptions _tlOparams = rule924 _lhsIparams _tlOprevVisits = rule925 _lhsIprevVisits _tlOruledefs = rule926 _lhsIruledefs _tlOruleuses = rule927 _lhsIruleuses _tlOsynmap = rule928 _lhsIsynmap _tlOterminaldefs = rule929 _lhsIterminaldefs __result_ = T_Visits_vOut55 _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOusedArgs _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_Visits_s56 v55 {-# INLINE rule870 #-} rule870 = \ ((_hdIallvisits) :: VisitStateState ) ((_tlIallvisits) :: [VisitStateState]) -> _hdIallvisits : _tlIallvisits {-# INLINE rule871 #-} rule871 = \ ((_hdIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) ((_tlIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _hdIchildvisit `Map.union` _tlIchildvisit {-# INLINE rule872 #-} rule872 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule873 #-} rule873 = \ ((_hdIfromToStates) :: Map VisitIdentifier (Int,Int)) ((_tlIfromToStates) :: Map VisitIdentifier (Int,Int)) -> _hdIfromToStates `mappend` _tlIfromToStates {-# INLINE rule874 #-} rule874 = \ ((_hdIintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) ((_tlIintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> _hdIintramap `uwMapUnion` _tlIintramap {-# INLINE rule875 #-} rule875 = \ ((_hdIlazyIntras) :: Set String) ((_tlIlazyIntras) :: Set String) -> _hdIlazyIntras `Set.union` _tlIlazyIntras {-# INLINE rule876 #-} rule876 = \ ((_hdIruleKinds) :: Map Identifier (Set VisitKind)) ((_tlIruleKinds) :: Map Identifier (Set VisitKind)) -> _hdIruleKinds `unionWithMappend` _tlIruleKinds {-# INLINE rule877 #-} rule877 = \ ((_hdIruleUsage) :: Map Identifier Int) ((_tlIruleUsage) :: Map Identifier Int) -> _hdIruleUsage `unionWithSum` _tlIruleUsage {-# INLINE rule878 #-} rule878 = \ ((_hdIsem_visit) :: (StateIdentifier,Bool -> PP_Doc) ) ((_tlIsem_visit) :: [(StateIdentifier,Bool -> PP_Doc)] ) -> _hdIsem_visit : _tlIsem_visit {-# INLINE rule879 #-} rule879 = \ ((_hdIt_visits) :: PP_Doc) ((_tlIt_visits) :: PP_Doc) -> _hdIt_visits >-< _tlIt_visits {-# INLINE rule880 #-} rule880 = \ ((_hdIusedArgs) :: Set String) ((_tlIusedArgs) :: Set String) -> _hdIusedArgs `Set.union` _tlIusedArgs {-# INLINE rule881 #-} rule881 = \ ((_hdIvisitKinds) :: Map VisitIdentifier VisitKind) ((_tlIvisitKinds) :: Map VisitIdentifier VisitKind) -> _hdIvisitKinds `mappend` _tlIvisitKinds {-# INLINE rule882 #-} rule882 = \ ((_hdIvisitdefs) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisitdefs `uwSetUnion` _tlIvisitdefs {-# INLINE rule883 #-} rule883 = \ ((_hdIvisituses) :: Map VisitIdentifier (Set Identifier)) ((_tlIvisituses) :: Map VisitIdentifier (Set Identifier)) -> _hdIvisituses `uwSetUnion` _tlIvisituses {-# INLINE rule884 #-} rule884 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule885 #-} rule885 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule886 #-} rule886 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule887 #-} rule887 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule888 #-} rule888 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule889 #-} rule889 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule890 #-} rule890 = \ ((_lhsIallintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> _lhsIallintramap {-# INLINE rule891 #-} rule891 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule892 #-} rule892 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule893 #-} rule893 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule894 #-} rule894 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule895 #-} rule895 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule896 #-} rule896 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule897 #-} rule897 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule898 #-} rule898 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) -> _lhsInextVisits {-# INLINE rule899 #-} rule899 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule900 #-} rule900 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule901 #-} rule901 = \ ((_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule902 #-} rule902 = \ ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) -> _lhsIprevVisits {-# INLINE rule903 #-} rule903 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule904 #-} rule904 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# INLINE rule905 #-} rule905 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule906 #-} rule906 = \ ((_lhsIterminaldefs) :: Set String) -> _lhsIterminaldefs {-# INLINE rule907 #-} rule907 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) -> _lhsIallFromToStates {-# INLINE rule908 #-} rule908 = \ ((_lhsIallInhmap) :: Map NontermIdent Attributes) -> _lhsIallInhmap {-# INLINE rule909 #-} rule909 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) -> _lhsIallInitStates {-# INLINE rule910 #-} rule910 = \ ((_lhsIallSynmap) :: Map NontermIdent Attributes) -> _lhsIallSynmap {-# INLINE rule911 #-} rule911 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) -> _lhsIallVisitKinds {-# INLINE rule912 #-} rule912 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> _lhsIallchildvisit {-# INLINE rule913 #-} rule913 = \ ((_lhsIallintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> _lhsIallintramap {-# INLINE rule914 #-} rule914 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisitdefs {-# INLINE rule915 #-} rule915 = \ ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) -> _lhsIavisituses {-# INLINE rule916 #-} rule916 = \ ((_lhsIchildTypes) :: Map Identifier Type) -> _lhsIchildTypes {-# INLINE rule917 #-} rule917 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> _lhsIchildintros {-# INLINE rule918 #-} rule918 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule919 #-} rule919 = \ ((_lhsIinhmap) :: Attributes) -> _lhsIinhmap {-# INLINE rule920 #-} rule920 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> _lhsImrules {-# INLINE rule921 #-} rule921 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) -> _lhsInextVisits {-# INLINE rule922 #-} rule922 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule923 #-} rule923 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule924 #-} rule924 = \ ((_lhsIparams) :: [Identifier]) -> _lhsIparams {-# INLINE rule925 #-} rule925 = \ ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) -> _lhsIprevVisits {-# INLINE rule926 #-} rule926 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) -> _lhsIruledefs {-# INLINE rule927 #-} rule927 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> _lhsIruleuses {-# INLINE rule928 #-} rule928 = \ ((_lhsIsynmap) :: Attributes) -> _lhsIsynmap {-# INLINE rule929 #-} rule929 = \ ((_lhsIterminaldefs) :: Set String) -> _lhsIterminaldefs {-# NOINLINE sem_Visits_Nil #-} sem_Visits_Nil :: T_Visits sem_Visits_Nil = T_Visits (return st56) where {-# NOINLINE st56 #-} st56 = let v55 :: T_Visits_v55 v55 = \ (T_Visits_vIn55 _lhsIallFromToStates _lhsIallInhmap _lhsIallInitStates _lhsIallSynmap _lhsIallVisitKinds _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildTypes _lhsIchildintros _lhsIcon _lhsIinhmap _lhsImrules _lhsInextVisits _lhsInt _lhsIoptions _lhsIparams _lhsIprevVisits _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs) -> ( let _lhsOallvisits :: [VisitStateState] _lhsOallvisits = rule930 () _lhsOchildvisit :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc)) _lhsOchildvisit = rule931 () _lhsOerrors :: Seq Error _lhsOerrors = rule932 () _lhsOfromToStates :: Map VisitIdentifier (Int,Int) _lhsOfromToStates = rule933 () _lhsOintramap :: Map StateIdentifier (Map String (Maybe NonLocalAttr)) _lhsOintramap = rule934 () _lhsOlazyIntras :: Set String _lhsOlazyIntras = rule935 () _lhsOruleKinds :: Map Identifier (Set VisitKind) _lhsOruleKinds = rule936 () _lhsOruleUsage :: Map Identifier Int _lhsOruleUsage = rule937 () _lhsOsem_visit :: [(StateIdentifier,Bool -> PP_Doc)] _lhsOsem_visit = rule938 () _lhsOt_visits :: PP_Doc _lhsOt_visits = rule939 () _lhsOusedArgs :: Set String _lhsOusedArgs = rule940 () _lhsOvisitKinds :: Map VisitIdentifier VisitKind _lhsOvisitKinds = rule941 () _lhsOvisitdefs :: Map VisitIdentifier (Set Identifier) _lhsOvisitdefs = rule942 () _lhsOvisituses :: Map VisitIdentifier (Set Identifier) _lhsOvisituses = rule943 () __result_ = T_Visits_vOut55 _lhsOallvisits _lhsOchildvisit _lhsOerrors _lhsOfromToStates _lhsOintramap _lhsOlazyIntras _lhsOruleKinds _lhsOruleUsage _lhsOsem_visit _lhsOt_visits _lhsOusedArgs _lhsOvisitKinds _lhsOvisitdefs _lhsOvisituses in __result_ ) in C_Visits_s56 v55 {-# INLINE rule930 #-} rule930 = \ (_ :: ()) -> [] {-# INLINE rule931 #-} rule931 = \ (_ :: ()) -> Map.empty {-# INLINE rule932 #-} rule932 = \ (_ :: ()) -> Seq.empty {-# INLINE rule933 #-} rule933 = \ (_ :: ()) -> mempty {-# INLINE rule934 #-} rule934 = \ (_ :: ()) -> Map.empty {-# INLINE rule935 #-} rule935 = \ (_ :: ()) -> Set.empty {-# INLINE rule936 #-} rule936 = \ (_ :: ()) -> Map.empty {-# INLINE rule937 #-} rule937 = \ (_ :: ()) -> Map.empty {-# INLINE rule938 #-} rule938 = \ (_ :: ()) -> [] {-# INLINE rule939 #-} rule939 = \ (_ :: ()) -> empty {-# INLINE rule940 #-} rule940 = \ (_ :: ()) -> Set.empty {-# INLINE rule941 #-} rule941 = \ (_ :: ()) -> mempty {-# INLINE rule942 #-} rule942 = \ (_ :: ()) -> Map.empty {-# INLINE rule943 #-} rule943 = \ (_ :: ()) -> Map.empty uuagc-0.9.52.2/src-generated/Expression.hs0000644000000000000000000000067213433540502016463 0ustar0000000000000000 -- UUAGC 0.9.51 (src-ag/Expression.ag) module Expression where {-# LINE 2 "src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken {-# LINE 10 "dist/build/Expression.hs" #-} -- Expression -------------------------------------------------- {- alternatives: alternative Expression: child pos : {Pos} child tks : {[HsToken]} -} data Expression = Expression (Pos) (([HsToken]))uuagc-0.9.52.2/src-generated/InterfacesRules.hs0000644000000000000000000017500713433540502017427 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} module InterfacesRules where {-# LINE 2 "src-ag/Interfaces.ag" #-} import CommonTypes import SequentialTypes {-# LINE 11 "dist/build/InterfacesRules.hs" #-} {-# LINE 10 "src-ag/InterfacesRules.lag" #-} import Interfaces import CodeSyntax import GrammarInfo import qualified Data.Sequence as Seq import Data.Sequence(Seq) import qualified Data.Map as Map import Data.Map(Map) import Data.Tree(Tree(Node), Forest) import Data.Graph(Graph, dfs, edges, buildG, transposeG) import Data.Maybe (fromJust) import Data.List (partition,transpose,(\\),nub,findIndex) import Data.Array ((!),inRange,bounds,assocs) import Data.Foldable(toList) {-# LINE 29 "dist/build/InterfacesRules.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 53 "src-ag/InterfacesRules.lag" #-} type VisitSS = [Vertex] {-# LINE 35 "dist/build/InterfacesRules.hs" #-} {-# LINE 88 "src-ag/InterfacesRules.lag" #-} gather :: Info -> [Vertex] -> [[Vertex]] gather info = eqClasses comp where comp a b = isEqualField (ruleTable info ! a) (ruleTable info ! b) {-# LINE 42 "dist/build/InterfacesRules.hs" #-} {-# LINE 129 "src-ag/InterfacesRules.lag" #-} -- Only non-empty syn will ever be forced, because visits with empty syn are never performed -- Right hand side synthesized attributes always have a field cv :: (Vertex -> CRule) -> Int -> Vertex -> ([Vertex],[Vertex]) -> (Vertex,ChildVisit) cv look n v (inh,syn) = let fld = getField (look (head syn)) rnt = fromJust (getRhsNt (look (head syn))) d = ChildVisit fld rnt n inh syn in (v,d) {-# LINE 53 "dist/build/InterfacesRules.hs" #-} {-# LINE 152 "src-ag/InterfacesRules.lag" #-} ed :: Vertex -> ([Vertex], [Vertex]) -> [(Vertex, Vertex)] ed v (inh,syn) = map (\i -> (i,v)) inh ++ map (\s -> (v,s)) syn {-# LINE 59 "dist/build/InterfacesRules.hs" #-} {-# LINE 240 "src-ag/InterfacesRules.lag" #-} postorder :: Tree a -> [a] postorder (Node a ts) = postorderF ts ++ [a] postorderF :: Forest a -> [a] postorderF = concatMap postorder postOrd :: Graph -> [Vertex] -> [Vertex] postOrd g = postorderF . dfs g topSort' :: Graph -> [Vertex] -> [Vertex] topSort' g = postOrd g {-# LINE 71 "dist/build/InterfacesRules.hs" #-} {-# LINE 323 "src-ag/InterfacesRules.lag" #-} type IntraVisit = [Vertex] {-# LINE 76 "dist/build/InterfacesRules.hs" #-} {-# LINE 345 "src-ag/InterfacesRules.lag" #-} swap :: (a,b) -> (b,a) swap (a,b) = (b,a) {-# LINE 82 "dist/build/InterfacesRules.hs" #-} {-# LINE 420 "src-ag/InterfacesRules.lag" #-} ccv :: Identifier -> NontermIdent -> Int -> CInterfaceMap -> CRule ccv name nt n table = CChildVisit name nt n inh syn lst where CInterface segs = Map.findWithDefault (error ("InterfacesRules::ccv::interfaces not in table for nt: " ++ show nt)) nt table (seg:remain) = drop n segs CSegment inh syn = seg lst = null remain {-# LINE 93 "dist/build/InterfacesRules.hs" #-} -- IRoot ------------------------------------------------------- -- wrapper data Inh_IRoot = Inh_IRoot { dpr_Inh_IRoot :: !([Edge]), info_Inh_IRoot :: !(Info), tdp_Inh_IRoot :: !(Graph) } data Syn_IRoot = Syn_IRoot { edp_Syn_IRoot :: !([Edge]), inters_Syn_IRoot :: !(CInterfaceMap), visits_Syn_IRoot :: !(CVisitsMap) } {-# INLINABLE wrap_IRoot #-} wrap_IRoot :: T_IRoot -> Inh_IRoot -> (Syn_IRoot ) wrap_IRoot !(T_IRoot act) !(Inh_IRoot _lhsIdpr _lhsIinfo _lhsItdp) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg1 = T_IRoot_vIn1 _lhsIdpr _lhsIinfo _lhsItdp !(T_IRoot_vOut1 _lhsOedp _lhsOinters _lhsOvisits) <- return (inv_IRoot_s2 sem arg1) return (Syn_IRoot _lhsOedp _lhsOinters _lhsOvisits) ) -- cata {-# INLINE sem_IRoot #-} sem_IRoot :: IRoot -> T_IRoot sem_IRoot ( IRoot inters_ ) = sem_IRoot_IRoot ( sem_Interfaces inters_ ) -- semantic domain newtype T_IRoot = T_IRoot { attach_T_IRoot :: Identity (T_IRoot_s2 ) } newtype T_IRoot_s2 = C_IRoot_s2 { inv_IRoot_s2 :: (T_IRoot_v1 ) } data T_IRoot_s3 = C_IRoot_s3 type T_IRoot_v1 = (T_IRoot_vIn1 ) -> (T_IRoot_vOut1 ) data T_IRoot_vIn1 = T_IRoot_vIn1 ([Edge]) (Info) (Graph) data T_IRoot_vOut1 = T_IRoot_vOut1 ([Edge]) (CInterfaceMap) (CVisitsMap) {-# NOINLINE sem_IRoot_IRoot #-} sem_IRoot_IRoot :: T_Interfaces -> T_IRoot sem_IRoot_IRoot arg_inters_ = T_IRoot (return st2) where {-# NOINLINE st2 #-} !st2 = let v1 :: T_IRoot_v1 v1 = \ !(T_IRoot_vIn1 _lhsIdpr _lhsIinfo _lhsItdp) -> ( let _intersX8 = Control.Monad.Identity.runIdentity (attach_T_Interfaces (arg_inters_)) (T_Interfaces_vOut7 _intersIdescr _intersIedp _intersIfirstvisitvertices _intersIinters _intersInewedges _intersIv _intersIvisits) = inv_Interfaces_s8 _intersX8 (T_Interfaces_vIn7 _intersOallInters _intersOddp _intersOinfo _intersOprev _intersOv _intersOvisitDescr _intersOvssGraph) _newedges = rule0 _intersInewedges _visitssGraph = rule1 _intersIv _lhsItdp _newedges _intersOv = rule2 _lhsItdp _intersOvisitDescr = rule3 _descr _descr = rule4 _intersIdescr _intersOvssGraph = rule5 _visitssGraph _intersOprev = rule6 _intersIfirstvisitvertices _lhsIinfo _intersOddp = rule7 _intersIv _lhsIdpr _newedges _intersOallInters = rule8 _intersIinters _lhsOedp :: [Edge] _lhsOedp = rule9 _intersIedp _lhsOinters :: CInterfaceMap _lhsOinters = rule10 _intersIinters _lhsOvisits :: CVisitsMap _lhsOvisits = rule11 _intersIvisits _intersOinfo = rule12 _lhsIinfo !__result_ = T_IRoot_vOut1 _lhsOedp _lhsOinters _lhsOvisits in __result_ ) in C_IRoot_s2 v1 {-# INLINE rule0 #-} {-# LINE 66 "src-ag/InterfacesRules.lag" #-} rule0 = \ ((_intersInewedges) :: Seq Edge ) -> {-# LINE 66 "src-ag/InterfacesRules.lag" #-} toList _intersInewedges {-# LINE 157 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule1 #-} {-# LINE 67 "src-ag/InterfacesRules.lag" #-} rule1 = \ ((_intersIv) :: Vertex) ((_lhsItdp) :: Graph) _newedges -> {-# LINE 67 "src-ag/InterfacesRules.lag" #-} let graph = buildG (0,_intersIv-1) es es = _newedges ++ edges _lhsItdp in transposeG graph {-# LINE 165 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule2 #-} {-# LINE 80 "src-ag/InterfacesRules.lag" #-} rule2 = \ ((_lhsItdp) :: Graph) -> {-# LINE 80 "src-ag/InterfacesRules.lag" #-} snd (bounds _lhsItdp) + 1 {-# LINE 171 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule3 #-} {-# LINE 122 "src-ag/InterfacesRules.lag" #-} rule3 = \ _descr -> {-# LINE 122 "src-ag/InterfacesRules.lag" #-} Map.fromList _descr {-# LINE 177 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule4 #-} {-# LINE 142 "src-ag/InterfacesRules.lag" #-} rule4 = \ ((_intersIdescr) :: Seq (Vertex,ChildVisit)) -> {-# LINE 142 "src-ag/InterfacesRules.lag" #-} toList _intersIdescr {-# LINE 183 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule5 #-} {-# LINE 214 "src-ag/InterfacesRules.lag" #-} rule5 = \ _visitssGraph -> {-# LINE 214 "src-ag/InterfacesRules.lag" #-} _visitssGraph {-# LINE 189 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule6 #-} {-# LINE 260 "src-ag/InterfacesRules.lag" #-} rule6 = \ ((_intersIfirstvisitvertices) :: [Vertex]) ((_lhsIinfo) :: Info) -> {-# LINE 260 "src-ag/InterfacesRules.lag" #-} let terminals = [ v | (v,cr) <- assocs (ruleTable _lhsIinfo), not (getHasCode cr), isLocal cr ] in _intersIfirstvisitvertices ++ terminals {-# LINE 196 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule7 #-} {-# LINE 343 "src-ag/InterfacesRules.lag" #-} rule7 = \ ((_intersIv) :: Vertex) ((_lhsIdpr) :: [Edge]) _newedges -> {-# LINE 343 "src-ag/InterfacesRules.lag" #-} buildG (0,_intersIv-1) (map swap (_lhsIdpr ++ _newedges)) {-# LINE 202 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule8 #-} {-# LINE 381 "src-ag/InterfacesRules.lag" #-} rule8 = \ ((_intersIinters) :: CInterfaceMap) -> {-# LINE 381 "src-ag/InterfacesRules.lag" #-} _intersIinters {-# LINE 208 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule9 #-} {-# LINE 443 "src-ag/InterfacesRules.lag" #-} rule9 = \ ((_intersIedp) :: Seq Edge) -> {-# LINE 443 "src-ag/InterfacesRules.lag" #-} toList _intersIedp {-# LINE 214 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule10 #-} rule10 = \ ((_intersIinters) :: CInterfaceMap) -> _intersIinters {-# INLINE rule11 #-} rule11 = \ ((_intersIvisits) :: CVisitsMap) -> _intersIvisits {-# INLINE rule12 #-} rule12 = \ ((_lhsIinfo) :: Info) -> _lhsIinfo -- Interface --------------------------------------------------- -- wrapper data Inh_Interface = Inh_Interface { allInters_Inh_Interface :: !(CInterfaceMap), ddp_Inh_Interface :: !(Graph), info_Inh_Interface :: !(Info), prev_Inh_Interface :: !([Vertex]), v_Inh_Interface :: !(Vertex), visitDescr_Inh_Interface :: !(Map Vertex ChildVisit), vssGraph_Inh_Interface :: !(Graph) } data Syn_Interface = Syn_Interface { descr_Syn_Interface :: !(Seq (Vertex,ChildVisit)), edp_Syn_Interface :: !(Seq Edge), firstvisitvertices_Syn_Interface :: !([Vertex]), inter_Syn_Interface :: !(CInterface), newedges_Syn_Interface :: !(Seq Edge ), nt_Syn_Interface :: !(NontermIdent), v_Syn_Interface :: !(Vertex), visits_Syn_Interface :: !(Map ConstructorIdent CVisits) } {-# INLINABLE wrap_Interface #-} wrap_Interface :: T_Interface -> Inh_Interface -> (Syn_Interface ) wrap_Interface !(T_Interface act) !(Inh_Interface _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg4 = T_Interface_vIn4 _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph !(T_Interface_vOut4 _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinter _lhsOnewedges _lhsOnt _lhsOv _lhsOvisits) <- return (inv_Interface_s5 sem arg4) return (Syn_Interface _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinter _lhsOnewedges _lhsOnt _lhsOv _lhsOvisits) ) -- cata {-# INLINE sem_Interface #-} sem_Interface :: Interface -> T_Interface sem_Interface ( Interface !nt_ !cons_ seg_ ) = sem_Interface_Interface nt_ cons_ ( sem_Segments seg_ ) -- semantic domain newtype T_Interface = T_Interface { attach_T_Interface :: Identity (T_Interface_s5 ) } newtype T_Interface_s5 = C_Interface_s5 { inv_Interface_s5 :: (T_Interface_v4 ) } data T_Interface_s6 = C_Interface_s6 type T_Interface_v4 = (T_Interface_vIn4 ) -> (T_Interface_vOut4 ) data T_Interface_vIn4 = T_Interface_vIn4 (CInterfaceMap) (Graph) (Info) ([Vertex]) (Vertex) (Map Vertex ChildVisit) (Graph) data T_Interface_vOut4 = T_Interface_vOut4 (Seq (Vertex,ChildVisit)) (Seq Edge) ([Vertex]) (CInterface) (Seq Edge ) (NontermIdent) (Vertex) (Map ConstructorIdent CVisits) {-# NOINLINE sem_Interface_Interface #-} sem_Interface_Interface :: (NontermIdent) -> ([ConstructorIdent]) -> T_Segments -> T_Interface sem_Interface_Interface !arg_nt_ !arg_cons_ arg_seg_ = T_Interface (return st5) where {-# NOINLINE st5 #-} !st5 = let v4 :: T_Interface_v4 v4 = \ !(T_Interface_vIn4 _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) -> ( let _segX14 = Control.Monad.Identity.runIdentity (attach_T_Segments (arg_seg_)) (T_Segments_vOut13 _segIcvisits _segIdescr _segIedp _segIfirstInh _segIgroups _segIhdIntravisits _segInewedges _segInewvertices _segIprev _segIsegs _segIv) = inv_Segments_s14 _segX14 (T_Segments_vIn13 _segOallInters _segOcons _segOddp _segOfromLhs _segOinfo _segOisFirst _segOn _segOprev _segOv _segOvisitDescr _segOvssGraph) _segOv = rule13 _lhsIv _v = rule14 _segInewvertices _segIv _lhsOv :: Vertex _lhsOv = rule15 _v _firstvisitvertices = rule16 _segIv _v _newedges = rule17 _firstvisitvertices _segInewvertices _lhsOnewedges :: Seq Edge _lhsOnewedges = rule18 _newedges _segInewedges _look :: Vertex -> CRule _look = rule19 _lhsIinfo _descr = rule20 _firstvisitvertices _look _segIgroups _lhsOdescr :: Seq (Vertex,ChildVisit) _lhsOdescr = rule21 _descr _segIdescr _segOn = rule22 () _segOcons = rule23 arg_cons_ _segOisFirst = rule24 () _segOfromLhs = rule25 _lhsIprev _lhsOnt :: NontermIdent _lhsOnt = rule26 arg_nt_ _lhsOinter :: CInterface _lhsOinter = rule27 _segIsegs _lhsOvisits :: Map ConstructorIdent CVisits _lhsOvisits = rule28 _segIcvisits arg_cons_ _lhsOedp :: Seq Edge _lhsOedp = rule29 _segIedp _lhsOfirstvisitvertices :: [Vertex] _lhsOfirstvisitvertices = rule30 _firstvisitvertices _segOallInters = rule31 _lhsIallInters _segOddp = rule32 _lhsIddp _segOinfo = rule33 _lhsIinfo _segOprev = rule34 _lhsIprev _segOvisitDescr = rule35 _lhsIvisitDescr _segOvssGraph = rule36 _lhsIvssGraph !__result_ = T_Interface_vOut4 _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinter _lhsOnewedges _lhsOnt _lhsOv _lhsOvisits in __result_ ) in C_Interface_s5 v4 {-# INLINE rule13 #-} {-# LINE 183 "src-ag/InterfacesRules.lag" #-} rule13 = \ ((_lhsIv) :: Vertex) -> {-# LINE 183 "src-ag/InterfacesRules.lag" #-} _lhsIv {-# LINE 305 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule14 #-} {-# LINE 184 "src-ag/InterfacesRules.lag" #-} rule14 = \ ((_segInewvertices) :: [Vertex]) ((_segIv) :: Vertex) -> {-# LINE 184 "src-ag/InterfacesRules.lag" #-} _segIv + length _segInewvertices {-# LINE 311 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule15 #-} {-# LINE 185 "src-ag/InterfacesRules.lag" #-} rule15 = \ _v -> {-# LINE 185 "src-ag/InterfacesRules.lag" #-} _v {-# LINE 317 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule16 #-} {-# LINE 186 "src-ag/InterfacesRules.lag" #-} rule16 = \ ((_segIv) :: Vertex) _v -> {-# LINE 186 "src-ag/InterfacesRules.lag" #-} [_segIv .. _v-1] {-# LINE 323 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule17 #-} {-# LINE 187 "src-ag/InterfacesRules.lag" #-} rule17 = \ _firstvisitvertices ((_segInewvertices) :: [Vertex]) -> {-# LINE 187 "src-ag/InterfacesRules.lag" #-} zip _firstvisitvertices _segInewvertices {-# LINE 329 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule18 #-} {-# LINE 188 "src-ag/InterfacesRules.lag" #-} rule18 = \ _newedges ((_segInewedges) :: Seq Edge ) -> {-# LINE 188 "src-ag/InterfacesRules.lag" #-} _segInewedges Seq.>< Seq.fromList _newedges {-# LINE 335 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule19 #-} {-# LINE 191 "src-ag/InterfacesRules.lag" #-} rule19 = \ ((_lhsIinfo) :: Info) -> {-# LINE 191 "src-ag/InterfacesRules.lag" #-} \a -> ruleTable _lhsIinfo ! a {-# LINE 341 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule20 #-} {-# LINE 192 "src-ag/InterfacesRules.lag" #-} rule20 = \ _firstvisitvertices ((_look) :: Vertex -> CRule) ((_segIgroups) :: [([Vertex],[Vertex])]) -> {-# LINE 192 "src-ag/InterfacesRules.lag" #-} zipWith (cv _look (-1)) _firstvisitvertices _segIgroups {-# LINE 347 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule21 #-} {-# LINE 193 "src-ag/InterfacesRules.lag" #-} rule21 = \ _descr ((_segIdescr) :: Seq (Vertex,ChildVisit)) -> {-# LINE 193 "src-ag/InterfacesRules.lag" #-} _segIdescr Seq.>< Seq.fromList _descr {-# LINE 353 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule22 #-} {-# LINE 201 "src-ag/InterfacesRules.lag" #-} rule22 = \ (_ :: ()) -> {-# LINE 201 "src-ag/InterfacesRules.lag" #-} 0 {-# LINE 359 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule23 #-} {-# LINE 233 "src-ag/InterfacesRules.lag" #-} rule23 = \ cons_ -> {-# LINE 233 "src-ag/InterfacesRules.lag" #-} cons_ {-# LINE 365 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule24 #-} {-# LINE 314 "src-ag/InterfacesRules.lag" #-} rule24 = \ (_ :: ()) -> {-# LINE 314 "src-ag/InterfacesRules.lag" #-} True {-# LINE 371 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule25 #-} {-# LINE 352 "src-ag/InterfacesRules.lag" #-} rule25 = \ ((_lhsIprev) :: [Vertex]) -> {-# LINE 352 "src-ag/InterfacesRules.lag" #-} _lhsIprev {-# LINE 377 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule26 #-} {-# LINE 392 "src-ag/InterfacesRules.lag" #-} rule26 = \ nt_ -> {-# LINE 392 "src-ag/InterfacesRules.lag" #-} nt_ {-# LINE 383 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule27 #-} {-# LINE 396 "src-ag/InterfacesRules.lag" #-} rule27 = \ ((_segIsegs) :: CSegments) -> {-# LINE 396 "src-ag/InterfacesRules.lag" #-} CInterface _segIsegs {-# LINE 389 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule28 #-} {-# LINE 397 "src-ag/InterfacesRules.lag" #-} rule28 = \ ((_segIcvisits) :: [[CVisit]]) cons_ -> {-# LINE 397 "src-ag/InterfacesRules.lag" #-} Map.fromList (zip cons_ (transpose _segIcvisits)) {-# LINE 395 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule29 #-} rule29 = \ ((_segIedp) :: Seq Edge) -> _segIedp {-# INLINE rule30 #-} rule30 = \ _firstvisitvertices -> _firstvisitvertices {-# INLINE rule31 #-} rule31 = \ ((_lhsIallInters) :: CInterfaceMap) -> _lhsIallInters {-# INLINE rule32 #-} rule32 = \ ((_lhsIddp) :: Graph) -> _lhsIddp {-# INLINE rule33 #-} rule33 = \ ((_lhsIinfo) :: Info) -> _lhsIinfo {-# INLINE rule34 #-} rule34 = \ ((_lhsIprev) :: [Vertex]) -> _lhsIprev {-# INLINE rule35 #-} rule35 = \ ((_lhsIvisitDescr) :: Map Vertex ChildVisit) -> _lhsIvisitDescr {-# INLINE rule36 #-} rule36 = \ ((_lhsIvssGraph) :: Graph) -> _lhsIvssGraph -- Interfaces -------------------------------------------------- -- wrapper data Inh_Interfaces = Inh_Interfaces { allInters_Inh_Interfaces :: !(CInterfaceMap), ddp_Inh_Interfaces :: !(Graph), info_Inh_Interfaces :: !(Info), prev_Inh_Interfaces :: !([Vertex]), v_Inh_Interfaces :: !(Vertex), visitDescr_Inh_Interfaces :: !(Map Vertex ChildVisit), vssGraph_Inh_Interfaces :: !(Graph) } data Syn_Interfaces = Syn_Interfaces { descr_Syn_Interfaces :: !(Seq (Vertex,ChildVisit)), edp_Syn_Interfaces :: !(Seq Edge), firstvisitvertices_Syn_Interfaces :: !([Vertex]), inters_Syn_Interfaces :: !(CInterfaceMap), newedges_Syn_Interfaces :: !(Seq Edge ), v_Syn_Interfaces :: !(Vertex), visits_Syn_Interfaces :: !(CVisitsMap) } {-# INLINABLE wrap_Interfaces #-} wrap_Interfaces :: T_Interfaces -> Inh_Interfaces -> (Syn_Interfaces ) wrap_Interfaces !(T_Interfaces act) !(Inh_Interfaces _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg7 = T_Interfaces_vIn7 _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph !(T_Interfaces_vOut7 _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinters _lhsOnewedges _lhsOv _lhsOvisits) <- return (inv_Interfaces_s8 sem arg7) return (Syn_Interfaces _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinters _lhsOnewedges _lhsOv _lhsOvisits) ) -- cata {-# NOINLINE sem_Interfaces #-} sem_Interfaces :: Interfaces -> T_Interfaces sem_Interfaces list = Prelude.foldr sem_Interfaces_Cons sem_Interfaces_Nil (Prelude.map sem_Interface list) -- semantic domain newtype T_Interfaces = T_Interfaces { attach_T_Interfaces :: Identity (T_Interfaces_s8 ) } newtype T_Interfaces_s8 = C_Interfaces_s8 { inv_Interfaces_s8 :: (T_Interfaces_v7 ) } data T_Interfaces_s9 = C_Interfaces_s9 type T_Interfaces_v7 = (T_Interfaces_vIn7 ) -> (T_Interfaces_vOut7 ) data T_Interfaces_vIn7 = T_Interfaces_vIn7 (CInterfaceMap) (Graph) (Info) ([Vertex]) (Vertex) (Map Vertex ChildVisit) (Graph) data T_Interfaces_vOut7 = T_Interfaces_vOut7 (Seq (Vertex,ChildVisit)) (Seq Edge) ([Vertex]) (CInterfaceMap) (Seq Edge ) (Vertex) (CVisitsMap) {-# NOINLINE sem_Interfaces_Cons #-} sem_Interfaces_Cons :: T_Interface -> T_Interfaces -> T_Interfaces sem_Interfaces_Cons arg_hd_ arg_tl_ = T_Interfaces (return st8) where {-# NOINLINE st8 #-} !st8 = let v7 :: T_Interfaces_v7 v7 = \ !(T_Interfaces_vIn7 _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) -> ( let _hdX5 = Control.Monad.Identity.runIdentity (attach_T_Interface (arg_hd_)) _tlX8 = Control.Monad.Identity.runIdentity (attach_T_Interfaces (arg_tl_)) (T_Interface_vOut4 _hdIdescr _hdIedp _hdIfirstvisitvertices _hdIinter _hdInewedges _hdInt _hdIv _hdIvisits) = inv_Interface_s5 _hdX5 (T_Interface_vIn4 _hdOallInters _hdOddp _hdOinfo _hdOprev _hdOv _hdOvisitDescr _hdOvssGraph) (T_Interfaces_vOut7 _tlIdescr _tlIedp _tlIfirstvisitvertices _tlIinters _tlInewedges _tlIv _tlIvisits) = inv_Interfaces_s8 _tlX8 (T_Interfaces_vIn7 _tlOallInters _tlOddp _tlOinfo _tlOprev _tlOv _tlOvisitDescr _tlOvssGraph) _lhsOinters :: CInterfaceMap _lhsOinters = rule37 _hdIinter _hdInt _tlIinters _lhsOvisits :: CVisitsMap _lhsOvisits = rule38 _hdInt _hdIvisits _tlIvisits _lhsOdescr :: Seq (Vertex,ChildVisit) _lhsOdescr = rule39 _hdIdescr _tlIdescr _lhsOedp :: Seq Edge _lhsOedp = rule40 _hdIedp _tlIedp _lhsOfirstvisitvertices :: [Vertex] _lhsOfirstvisitvertices = rule41 _hdIfirstvisitvertices _tlIfirstvisitvertices _lhsOnewedges :: Seq Edge _lhsOnewedges = rule42 _hdInewedges _tlInewedges _lhsOv :: Vertex _lhsOv = rule43 _tlIv _hdOallInters = rule44 _lhsIallInters _hdOddp = rule45 _lhsIddp _hdOinfo = rule46 _lhsIinfo _hdOprev = rule47 _lhsIprev _hdOv = rule48 _lhsIv _hdOvisitDescr = rule49 _lhsIvisitDescr _hdOvssGraph = rule50 _lhsIvssGraph _tlOallInters = rule51 _lhsIallInters _tlOddp = rule52 _lhsIddp _tlOinfo = rule53 _lhsIinfo _tlOprev = rule54 _lhsIprev _tlOv = rule55 _hdIv _tlOvisitDescr = rule56 _lhsIvisitDescr _tlOvssGraph = rule57 _lhsIvssGraph !__result_ = T_Interfaces_vOut7 _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinters _lhsOnewedges _lhsOv _lhsOvisits in __result_ ) in C_Interfaces_s8 v7 {-# INLINE rule37 #-} {-# LINE 386 "src-ag/InterfacesRules.lag" #-} rule37 = \ ((_hdIinter) :: CInterface) ((_hdInt) :: NontermIdent) ((_tlIinters) :: CInterfaceMap) -> {-# LINE 386 "src-ag/InterfacesRules.lag" #-} Map.insert _hdInt _hdIinter _tlIinters {-# LINE 498 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule38 #-} {-# LINE 387 "src-ag/InterfacesRules.lag" #-} rule38 = \ ((_hdInt) :: NontermIdent) ((_hdIvisits) :: Map ConstructorIdent CVisits) ((_tlIvisits) :: CVisitsMap) -> {-# LINE 387 "src-ag/InterfacesRules.lag" #-} Map.insert _hdInt _hdIvisits _tlIvisits {-# LINE 504 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule39 #-} rule39 = \ ((_hdIdescr) :: Seq (Vertex,ChildVisit)) ((_tlIdescr) :: Seq (Vertex,ChildVisit)) -> _hdIdescr Seq.>< _tlIdescr {-# INLINE rule40 #-} rule40 = \ ((_hdIedp) :: Seq Edge) ((_tlIedp) :: Seq Edge) -> _hdIedp Seq.>< _tlIedp {-# INLINE rule41 #-} rule41 = \ ((_hdIfirstvisitvertices) :: [Vertex]) ((_tlIfirstvisitvertices) :: [Vertex]) -> _hdIfirstvisitvertices ++ _tlIfirstvisitvertices {-# INLINE rule42 #-} rule42 = \ ((_hdInewedges) :: Seq Edge ) ((_tlInewedges) :: Seq Edge ) -> _hdInewedges Seq.>< _tlInewedges {-# INLINE rule43 #-} rule43 = \ ((_tlIv) :: Vertex) -> _tlIv {-# INLINE rule44 #-} rule44 = \ ((_lhsIallInters) :: CInterfaceMap) -> _lhsIallInters {-# INLINE rule45 #-} rule45 = \ ((_lhsIddp) :: Graph) -> _lhsIddp {-# INLINE rule46 #-} rule46 = \ ((_lhsIinfo) :: Info) -> _lhsIinfo {-# INLINE rule47 #-} rule47 = \ ((_lhsIprev) :: [Vertex]) -> _lhsIprev {-# INLINE rule48 #-} rule48 = \ ((_lhsIv) :: Vertex) -> _lhsIv {-# INLINE rule49 #-} rule49 = \ ((_lhsIvisitDescr) :: Map Vertex ChildVisit) -> _lhsIvisitDescr {-# INLINE rule50 #-} rule50 = \ ((_lhsIvssGraph) :: Graph) -> _lhsIvssGraph {-# INLINE rule51 #-} rule51 = \ ((_lhsIallInters) :: CInterfaceMap) -> _lhsIallInters {-# INLINE rule52 #-} rule52 = \ ((_lhsIddp) :: Graph) -> _lhsIddp {-# INLINE rule53 #-} rule53 = \ ((_lhsIinfo) :: Info) -> _lhsIinfo {-# INLINE rule54 #-} rule54 = \ ((_lhsIprev) :: [Vertex]) -> _lhsIprev {-# INLINE rule55 #-} rule55 = \ ((_hdIv) :: Vertex) -> _hdIv {-# INLINE rule56 #-} rule56 = \ ((_lhsIvisitDescr) :: Map Vertex ChildVisit) -> _lhsIvisitDescr {-# INLINE rule57 #-} rule57 = \ ((_lhsIvssGraph) :: Graph) -> _lhsIvssGraph {-# NOINLINE sem_Interfaces_Nil #-} sem_Interfaces_Nil :: T_Interfaces sem_Interfaces_Nil = T_Interfaces (return st8) where {-# NOINLINE st8 #-} !st8 = let v7 :: T_Interfaces_v7 v7 = \ !(T_Interfaces_vIn7 _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) -> ( let _lhsOinters :: CInterfaceMap _lhsOinters = rule58 () _lhsOvisits :: CVisitsMap _lhsOvisits = rule59 () _lhsOdescr :: Seq (Vertex,ChildVisit) _lhsOdescr = rule60 () _lhsOedp :: Seq Edge _lhsOedp = rule61 () _lhsOfirstvisitvertices :: [Vertex] _lhsOfirstvisitvertices = rule62 () _lhsOnewedges :: Seq Edge _lhsOnewedges = rule63 () _lhsOv :: Vertex _lhsOv = rule64 _lhsIv !__result_ = T_Interfaces_vOut7 _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinters _lhsOnewedges _lhsOv _lhsOvisits in __result_ ) in C_Interfaces_s8 v7 {-# INLINE rule58 #-} {-# LINE 388 "src-ag/InterfacesRules.lag" #-} rule58 = \ (_ :: ()) -> {-# LINE 388 "src-ag/InterfacesRules.lag" #-} Map.empty {-# LINE 591 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule59 #-} {-# LINE 389 "src-ag/InterfacesRules.lag" #-} rule59 = \ (_ :: ()) -> {-# LINE 389 "src-ag/InterfacesRules.lag" #-} Map.empty {-# LINE 597 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule60 #-} rule60 = \ (_ :: ()) -> Seq.empty {-# INLINE rule61 #-} rule61 = \ (_ :: ()) -> Seq.empty {-# INLINE rule62 #-} rule62 = \ (_ :: ()) -> [] {-# INLINE rule63 #-} rule63 = \ (_ :: ()) -> Seq.empty {-# INLINE rule64 #-} rule64 = \ ((_lhsIv) :: Vertex) -> _lhsIv -- Segment ----------------------------------------------------- -- wrapper data Inh_Segment = Inh_Segment { allInters_Inh_Segment :: !(CInterfaceMap), cons_Inh_Segment :: !([ConstructorIdent]), ddp_Inh_Segment :: !(Graph), fromLhs_Inh_Segment :: !([Vertex]), info_Inh_Segment :: !(Info), isFirst_Inh_Segment :: !(Bool), n_Inh_Segment :: !(Int), nextInh_Inh_Segment :: !([Vertex]), nextIntravisits_Inh_Segment :: !([IntraVisit]), nextNewvertices_Inh_Segment :: !([Vertex]), prev_Inh_Segment :: !([Vertex]), v_Inh_Segment :: !(Vertex), visitDescr_Inh_Segment :: !(Map Vertex ChildVisit), vssGraph_Inh_Segment :: !(Graph) } data Syn_Segment = Syn_Segment { cvisits_Syn_Segment :: !([CVisit]), descr_Syn_Segment :: !(Seq (Vertex,ChildVisit)), edp_Syn_Segment :: !(Seq Edge), groups_Syn_Segment :: !([([Vertex],[Vertex])]), inh_Syn_Segment :: !([Vertex]), intravisits_Syn_Segment :: !([IntraVisit]), newedges_Syn_Segment :: !(Seq Edge ), newvertices_Syn_Segment :: !([Vertex]), prev_Syn_Segment :: !([Vertex]), seg_Syn_Segment :: !(CSegment), v_Syn_Segment :: !(Vertex), visitss_Syn_Segment :: !([VisitSS]) } {-# INLINABLE wrap_Segment #-} wrap_Segment :: T_Segment -> Inh_Segment -> (Syn_Segment ) wrap_Segment !(T_Segment act) !(Inh_Segment _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsInextInh _lhsInextIntravisits _lhsInextNewvertices _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg10 = T_Segment_vIn10 _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsInextInh _lhsInextIntravisits _lhsInextNewvertices _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph !(T_Segment_vOut10 _lhsOcvisits _lhsOdescr _lhsOedp _lhsOgroups _lhsOinh _lhsOintravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOseg _lhsOv _lhsOvisitss) <- return (inv_Segment_s11 sem arg10) return (Syn_Segment _lhsOcvisits _lhsOdescr _lhsOedp _lhsOgroups _lhsOinh _lhsOintravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOseg _lhsOv _lhsOvisitss) ) -- cata {-# INLINE sem_Segment #-} sem_Segment :: Segment -> T_Segment sem_Segment ( Segment !inh_ !syn_ ) = sem_Segment_Segment inh_ syn_ -- semantic domain newtype T_Segment = T_Segment { attach_T_Segment :: Identity (T_Segment_s11 ) } newtype T_Segment_s11 = C_Segment_s11 { inv_Segment_s11 :: (T_Segment_v10 ) } data T_Segment_s12 = C_Segment_s12 type T_Segment_v10 = (T_Segment_vIn10 ) -> (T_Segment_vOut10 ) data T_Segment_vIn10 = T_Segment_vIn10 (CInterfaceMap) ([ConstructorIdent]) (Graph) ([Vertex]) (Info) (Bool) (Int) ([Vertex]) ([IntraVisit]) ([Vertex]) ([Vertex]) (Vertex) (Map Vertex ChildVisit) (Graph) data T_Segment_vOut10 = T_Segment_vOut10 ([CVisit]) (Seq (Vertex,ChildVisit)) (Seq Edge) ([([Vertex],[Vertex])]) ([Vertex]) ([IntraVisit]) (Seq Edge ) ([Vertex]) ([Vertex]) (CSegment) (Vertex) ([VisitSS]) {-# NOINLINE sem_Segment_Segment #-} sem_Segment_Segment :: ([Vertex]) -> ([Vertex]) -> T_Segment sem_Segment_Segment !arg_inh_ !arg_syn_ = T_Segment (return st11) where {-# NOINLINE st11 #-} !st11 = let v10 :: T_Segment_v10 v10 = \ !(T_Segment_vIn10 _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsInextInh _lhsInextIntravisits _lhsInextNewvertices _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) -> ( let _look :: Vertex -> CRule _look = rule65 _lhsIinfo _occurAs :: (CRule -> Bool) -> [Vertex] -> [Vertex] _occurAs = rule66 _lhsIinfo _look _groups :: [([Vertex],[Vertex])] _groups = rule67 _lhsIinfo _look _occurAs arg_inh_ arg_syn_ _v :: Int _v = rule68 _groups _lhsIv _newvertices = rule69 _lhsIv _v _lhsOdescr :: Seq (Vertex,ChildVisit) _lhsOdescr = rule70 _groups _lhsIn _look _newvertices _attredges = rule71 _groups _newvertices _visitedges = rule72 _lhsInextNewvertices _newvertices _lhsOnewedges :: Seq Edge _lhsOnewedges = rule73 _attredges _visitedges _synOccur = rule74 _lhsIinfo _occurAs arg_syn_ _vss = rule75 _lhsIcons _lhsIinfo _lhsIvssGraph _synOccur arg_syn_ _visitss' = rule76 _lhsIprev _vss _defined = rule77 _lhsIvisitDescr _visitss _lhsOprev :: [Vertex] _lhsOprev = rule78 _defined _lhsIprev _visitss :: [[Vertex]] _visitss = rule79 _lhsIinfo _visitss' _fromLhs = rule80 _lhsIfromLhs _occurAs arg_inh_ _computed = rule81 _lhsIinfo _lhsIvisitDescr _visitss _intravisits = rule82 _iv _lhsInextIntravisits _visitss _iv = rule83 _computed _fromLhs _lhsIddp _lhsOseg :: CSegment _lhsOseg = rule84 _inhmap _lhsIprev _lhsIvisitDescr _lhsIvssGraph _synmap _inhmap :: Map Identifier Type _synmap :: Map Identifier Type (_inhmap,_synmap) = rule85 _lhsIinfo arg_inh_ arg_syn_ _lhsOcvisits :: [CVisit] _lhsOcvisits = rule86 _inhmap _intravisits _lhsIallInters _lhsIinfo _lhsIvisitDescr _synmap _visitss _lhsOedp :: Seq Edge _lhsOedp = rule87 _lhsInextInh arg_inh_ arg_syn_ _lhsOinh :: [Vertex] _lhsOinh = rule88 arg_inh_ _lhsOgroups :: [([Vertex],[Vertex])] _lhsOgroups = rule89 _groups _lhsOintravisits :: [IntraVisit] _lhsOintravisits = rule90 _intravisits _lhsOnewvertices :: [Vertex] _lhsOnewvertices = rule91 _newvertices _lhsOv :: Vertex _lhsOv = rule92 _v _lhsOvisitss :: [VisitSS] _lhsOvisitss = rule93 _visitss !__result_ = T_Segment_vOut10 _lhsOcvisits _lhsOdescr _lhsOedp _lhsOgroups _lhsOinh _lhsOintravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOseg _lhsOv _lhsOvisitss in __result_ ) in C_Segment_s11 v10 {-# INLINE rule65 #-} {-# LINE 101 "src-ag/InterfacesRules.lag" #-} rule65 = \ ((_lhsIinfo) :: Info) -> {-# LINE 101 "src-ag/InterfacesRules.lag" #-} \a -> ruleTable _lhsIinfo ! a {-# LINE 707 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule66 #-} {-# LINE 104 "src-ag/InterfacesRules.lag" #-} rule66 = \ ((_lhsIinfo) :: Info) ((_look) :: Vertex -> CRule) -> {-# LINE 104 "src-ag/InterfacesRules.lag" #-} \p us -> [ a | u <- us , a <- tdsToTdp _lhsIinfo ! u , p (_look a)] {-# LINE 715 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule67 #-} {-# LINE 108 "src-ag/InterfacesRules.lag" #-} rule67 = \ ((_lhsIinfo) :: Info) ((_look) :: Vertex -> CRule) ((_occurAs) :: (CRule -> Bool) -> [Vertex] -> [Vertex]) inh_ syn_ -> {-# LINE 108 "src-ag/InterfacesRules.lag" #-} let group as = gather _lhsIinfo (_occurAs isRhs as) in map (partition (isInh . _look)) (group (inh_ ++ syn_)) {-# LINE 722 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule68 #-} {-# LINE 111 "src-ag/InterfacesRules.lag" #-} rule68 = \ ((_groups) :: [([Vertex],[Vertex])]) ((_lhsIv) :: Vertex) -> {-# LINE 111 "src-ag/InterfacesRules.lag" #-} _lhsIv + length _groups {-# LINE 728 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule69 #-} {-# LINE 112 "src-ag/InterfacesRules.lag" #-} rule69 = \ ((_lhsIv) :: Vertex) ((_v) :: Int) -> {-# LINE 112 "src-ag/InterfacesRules.lag" #-} [_lhsIv .. _v -1] {-# LINE 734 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule70 #-} {-# LINE 127 "src-ag/InterfacesRules.lag" #-} rule70 = \ ((_groups) :: [([Vertex],[Vertex])]) ((_lhsIn) :: Int) ((_look) :: Vertex -> CRule) _newvertices -> {-# LINE 127 "src-ag/InterfacesRules.lag" #-} Seq.fromList $ zipWith (cv _look _lhsIn) _newvertices _groups {-# LINE 740 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule71 #-} {-# LINE 150 "src-ag/InterfacesRules.lag" #-} rule71 = \ ((_groups) :: [([Vertex],[Vertex])]) _newvertices -> {-# LINE 150 "src-ag/InterfacesRules.lag" #-} concat (zipWith ed _newvertices _groups) {-# LINE 746 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule72 #-} {-# LINE 170 "src-ag/InterfacesRules.lag" #-} rule72 = \ ((_lhsInextNewvertices) :: [Vertex]) _newvertices -> {-# LINE 170 "src-ag/InterfacesRules.lag" #-} zip _newvertices _lhsInextNewvertices {-# LINE 752 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule73 #-} {-# LINE 171 "src-ag/InterfacesRules.lag" #-} rule73 = \ _attredges _visitedges -> {-# LINE 171 "src-ag/InterfacesRules.lag" #-} Seq.fromList _attredges Seq.>< Seq.fromList _visitedges {-# LINE 758 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule74 #-} {-# LINE 225 "src-ag/InterfacesRules.lag" #-} rule74 = \ ((_lhsIinfo) :: Info) ((_occurAs) :: (CRule -> Bool) -> [Vertex] -> [Vertex]) syn_ -> {-# LINE 225 "src-ag/InterfacesRules.lag" #-} gather _lhsIinfo (_occurAs isLhs syn_) {-# LINE 764 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule75 #-} {-# LINE 226 "src-ag/InterfacesRules.lag" #-} rule75 = \ ((_lhsIcons) :: [ConstructorIdent]) ((_lhsIinfo) :: Info) ((_lhsIvssGraph) :: Graph) _synOccur syn_ -> {-# LINE 226 "src-ag/InterfacesRules.lag" #-} let hasCode' v | inRange (bounds (ruleTable _lhsIinfo)) v = getHasCode (ruleTable _lhsIinfo ! v) | otherwise = True in if null syn_ then replicate (length _lhsIcons) [] else map (filter hasCode' . topSort' _lhsIvssGraph) _synOccur {-# LINE 774 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule76 #-} {-# LINE 270 "src-ag/InterfacesRules.lag" #-} rule76 = \ ((_lhsIprev) :: [Vertex]) _vss -> {-# LINE 270 "src-ag/InterfacesRules.lag" #-} map (\\ _lhsIprev) _vss {-# LINE 780 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule77 #-} {-# LINE 271 "src-ag/InterfacesRules.lag" #-} rule77 = \ ((_lhsIvisitDescr) :: Map Vertex ChildVisit) ((_visitss) :: [[Vertex]]) -> {-# LINE 271 "src-ag/InterfacesRules.lag" #-} let defines v = case Map.lookup v _lhsIvisitDescr of Nothing -> [v] Just (ChildVisit _ _ _ inh _) -> v:inh in concatMap (concatMap defines) _visitss {-# LINE 789 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule78 #-} {-# LINE 275 "src-ag/InterfacesRules.lag" #-} rule78 = \ _defined ((_lhsIprev) :: [Vertex]) -> {-# LINE 275 "src-ag/InterfacesRules.lag" #-} _lhsIprev ++ _defined {-# LINE 795 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule79 #-} {-# LINE 284 "src-ag/InterfacesRules.lag" #-} rule79 = \ ((_lhsIinfo) :: Info) _visitss' -> {-# LINE 284 "src-ag/InterfacesRules.lag" #-} let rem' :: [(Identifier,Identifier,Maybe Type)] -> [Vertex] -> [Vertex] rem' _ [] = [] rem' prev (v:vs) | inRange (bounds table) v = let cr = table ! v addV = case findIndex cmp prev of Just _ -> id _ -> (v:) cmp (fld,attr,tp) = getField cr == fld && getAttr cr == attr && sameNT (getType cr) tp sameNT (Just (NT ntA _ _)) (Just (NT ntB _ _)) = ntA == ntB sameNT _ _ = False def = Map.elems (getDefines cr) in addV (rem' (def ++ prev) vs) | otherwise = v:rem' prev vs table = ruleTable _lhsIinfo in map (rem' []) _visitss' {-# LINE 816 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule80 #-} {-# LINE 357 "src-ag/InterfacesRules.lag" #-} rule80 = \ ((_lhsIfromLhs) :: [Vertex]) ((_occurAs) :: (CRule -> Bool) -> [Vertex] -> [Vertex]) inh_ -> {-# LINE 357 "src-ag/InterfacesRules.lag" #-} _occurAs isLhs inh_ ++ _lhsIfromLhs {-# LINE 822 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule81 #-} {-# LINE 358 "src-ag/InterfacesRules.lag" #-} rule81 = \ ((_lhsIinfo) :: Info) ((_lhsIvisitDescr) :: Map Vertex ChildVisit) ((_visitss) :: [[Vertex]]) -> {-# LINE 358 "src-ag/InterfacesRules.lag" #-} let computes v = case Map.lookup v _lhsIvisitDescr of Nothing -> Map.keys (getDefines (ruleTable _lhsIinfo ! v)) Just (ChildVisit _ _ _ _ syn) -> v:syn in concatMap (concatMap computes) _visitss {-# LINE 831 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule82 #-} {-# LINE 362 "src-ag/InterfacesRules.lag" #-} rule82 = \ _iv ((_lhsInextIntravisits) :: [IntraVisit]) ((_visitss) :: [[Vertex]]) -> {-# LINE 362 "src-ag/InterfacesRules.lag" #-} zipWith _iv _visitss _lhsInextIntravisits {-# LINE 837 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule83 #-} {-# LINE 363 "src-ag/InterfacesRules.lag" #-} rule83 = \ _computed _fromLhs ((_lhsIddp) :: Graph) -> {-# LINE 363 "src-ag/InterfacesRules.lag" #-} \vs next -> let needed = concatMap (_lhsIddp !) vs in nub (needed ++ next) \\ (_fromLhs ++ _computed) {-# LINE 845 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule84 #-} {-# LINE 406 "src-ag/InterfacesRules.lag" #-} rule84 = \ ((_inhmap) :: Map Identifier Type) ((_lhsIprev) :: [Vertex]) ((_lhsIvisitDescr) :: Map Vertex ChildVisit) ((_lhsIvssGraph) :: Graph) ((_synmap) :: Map Identifier Type) -> {-# LINE 406 "src-ag/InterfacesRules.lag" #-} if False then undefined _lhsIvssGraph _lhsIvisitDescr _lhsIprev else CSegment _inhmap _synmap {-# LINE 851 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule85 #-} {-# LINE 410 "src-ag/InterfacesRules.lag" #-} rule85 = \ ((_lhsIinfo) :: Info) inh_ syn_ -> {-# LINE 410 "src-ag/InterfacesRules.lag" #-} let makemap = Map.fromList . map findType findType v = getNtaNameType (attrTable _lhsIinfo ! v) in (makemap inh_,makemap syn_) {-# LINE 859 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule86 #-} {-# LINE 413 "src-ag/InterfacesRules.lag" #-} rule86 = \ ((_inhmap) :: Map Identifier Type) _intravisits ((_lhsIallInters) :: CInterfaceMap) ((_lhsIinfo) :: Info) ((_lhsIvisitDescr) :: Map Vertex ChildVisit) ((_synmap) :: Map Identifier Type) ((_visitss) :: [[Vertex]]) -> {-# LINE 413 "src-ag/InterfacesRules.lag" #-} let mkVisit vss intra = CVisit _inhmap _synmap (mkSequence vss) (mkSequence intra) True mkSequence = map mkRule mkRule v = case Map.lookup v _lhsIvisitDescr of Nothing -> ruleTable _lhsIinfo ! v Just (ChildVisit name nt n _ _) -> ccv name nt n _lhsIallInters in zipWith mkVisit _visitss _intravisits {-# LINE 870 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule87 #-} {-# LINE 440 "src-ag/InterfacesRules.lag" #-} rule87 = \ ((_lhsInextInh) :: [Vertex]) inh_ syn_ -> {-# LINE 440 "src-ag/InterfacesRules.lag" #-} Seq.fromList [(i,s) | i <- inh_, s <- syn_] Seq.>< Seq.fromList [(s,i) | s <- syn_, i <- _lhsInextInh ] {-# LINE 877 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule88 #-} {-# LINE 445 "src-ag/InterfacesRules.lag" #-} rule88 = \ inh_ -> {-# LINE 445 "src-ag/InterfacesRules.lag" #-} inh_ {-# LINE 883 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule89 #-} rule89 = \ ((_groups) :: [([Vertex],[Vertex])]) -> _groups {-# INLINE rule90 #-} rule90 = \ _intravisits -> _intravisits {-# INLINE rule91 #-} rule91 = \ _newvertices -> _newvertices {-# INLINE rule92 #-} rule92 = \ ((_v) :: Int) -> _v {-# INLINE rule93 #-} rule93 = \ ((_visitss) :: [[Vertex]]) -> _visitss -- Segments ---------------------------------------------------- -- wrapper data Inh_Segments = Inh_Segments { allInters_Inh_Segments :: !(CInterfaceMap), cons_Inh_Segments :: !([ConstructorIdent]), ddp_Inh_Segments :: !(Graph), fromLhs_Inh_Segments :: !([Vertex]), info_Inh_Segments :: !(Info), isFirst_Inh_Segments :: !(Bool), n_Inh_Segments :: !(Int), prev_Inh_Segments :: !([Vertex]), v_Inh_Segments :: !(Vertex), visitDescr_Inh_Segments :: !(Map Vertex ChildVisit), vssGraph_Inh_Segments :: !(Graph) } data Syn_Segments = Syn_Segments { cvisits_Syn_Segments :: !([[CVisit]]), descr_Syn_Segments :: !(Seq (Vertex,ChildVisit)), edp_Syn_Segments :: !(Seq Edge), firstInh_Syn_Segments :: !([Vertex]), groups_Syn_Segments :: !([([Vertex],[Vertex])]), hdIntravisits_Syn_Segments :: !([IntraVisit]), newedges_Syn_Segments :: !(Seq Edge ), newvertices_Syn_Segments :: !([Vertex]), prev_Syn_Segments :: !([Vertex]), segs_Syn_Segments :: !(CSegments), v_Syn_Segments :: !(Vertex) } {-# INLINABLE wrap_Segments #-} wrap_Segments :: T_Segments -> Inh_Segments -> (Syn_Segments ) wrap_Segments !(T_Segments act) !(Inh_Segments _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg13 = T_Segments_vIn13 _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph !(T_Segments_vOut13 _lhsOcvisits _lhsOdescr _lhsOedp _lhsOfirstInh _lhsOgroups _lhsOhdIntravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOsegs _lhsOv) <- return (inv_Segments_s14 sem arg13) return (Syn_Segments _lhsOcvisits _lhsOdescr _lhsOedp _lhsOfirstInh _lhsOgroups _lhsOhdIntravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOsegs _lhsOv) ) -- cata {-# NOINLINE sem_Segments #-} sem_Segments :: Segments -> T_Segments sem_Segments list = Prelude.foldr sem_Segments_Cons sem_Segments_Nil (Prelude.map sem_Segment list) -- semantic domain newtype T_Segments = T_Segments { attach_T_Segments :: Identity (T_Segments_s14 ) } newtype T_Segments_s14 = C_Segments_s14 { inv_Segments_s14 :: (T_Segments_v13 ) } data T_Segments_s15 = C_Segments_s15 type T_Segments_v13 = (T_Segments_vIn13 ) -> (T_Segments_vOut13 ) data T_Segments_vIn13 = T_Segments_vIn13 (CInterfaceMap) ([ConstructorIdent]) (Graph) ([Vertex]) (Info) (Bool) (Int) ([Vertex]) (Vertex) (Map Vertex ChildVisit) (Graph) data T_Segments_vOut13 = T_Segments_vOut13 ([[CVisit]]) (Seq (Vertex,ChildVisit)) (Seq Edge) ([Vertex]) ([([Vertex],[Vertex])]) ([IntraVisit]) (Seq Edge ) ([Vertex]) ([Vertex]) (CSegments) (Vertex) {-# NOINLINE sem_Segments_Cons #-} sem_Segments_Cons :: T_Segment -> T_Segments -> T_Segments sem_Segments_Cons arg_hd_ arg_tl_ = T_Segments (return st14) where {-# NOINLINE st14 #-} !st14 = let v13 :: T_Segments_v13 v13 = \ !(T_Segments_vIn13 _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) -> ( let _hdX11 = Control.Monad.Identity.runIdentity (attach_T_Segment (arg_hd_)) _tlX14 = Control.Monad.Identity.runIdentity (attach_T_Segments (arg_tl_)) (T_Segment_vOut10 _hdIcvisits _hdIdescr _hdIedp _hdIgroups _hdIinh _hdIintravisits _hdInewedges _hdInewvertices _hdIprev _hdIseg _hdIv _hdIvisitss) = inv_Segment_s11 _hdX11 (T_Segment_vIn10 _hdOallInters _hdOcons _hdOddp _hdOfromLhs _hdOinfo _hdOisFirst _hdOn _hdOnextInh _hdOnextIntravisits _hdOnextNewvertices _hdOprev _hdOv _hdOvisitDescr _hdOvssGraph) (T_Segments_vOut13 _tlIcvisits _tlIdescr _tlIedp _tlIfirstInh _tlIgroups _tlIhdIntravisits _tlInewedges _tlInewvertices _tlIprev _tlIsegs _tlIv) = inv_Segments_s14 _tlX14 (T_Segments_vIn13 _tlOallInters _tlOcons _tlOddp _tlOfromLhs _tlOinfo _tlOisFirst _tlOn _tlOprev _tlOv _tlOvisitDescr _tlOvssGraph) _hdOnextNewvertices = rule94 _tlInewvertices _lhsOnewvertices :: [Vertex] _lhsOnewvertices = rule95 _hdInewvertices _lhsOgroups :: [([Vertex],[Vertex])] _lhsOgroups = rule96 _hdIgroups _tlOn = rule97 _lhsIn _tlOisFirst = rule98 () _hdOnextIntravisits = rule99 _tlIhdIntravisits _lhsOhdIntravisits :: [IntraVisit] _lhsOhdIntravisits = rule100 _hdIintravisits _hdOfromLhs = rule101 _lhsIfromLhs _tlOfromLhs = rule102 () _lhsOsegs :: CSegments _lhsOsegs = rule103 _hdIseg _tlIsegs _hdOnextInh = rule104 _tlIfirstInh _lhsOfirstInh :: [Vertex] _lhsOfirstInh = rule105 _hdIinh _lhsOcvisits :: [[CVisit]] _lhsOcvisits = rule106 _hdIcvisits _tlIcvisits _lhsOdescr :: Seq (Vertex,ChildVisit) _lhsOdescr = rule107 _hdIdescr _tlIdescr _lhsOedp :: Seq Edge _lhsOedp = rule108 _hdIedp _tlIedp _lhsOnewedges :: Seq Edge _lhsOnewedges = rule109 _hdInewedges _tlInewedges _lhsOprev :: [Vertex] _lhsOprev = rule110 _tlIprev _lhsOv :: Vertex _lhsOv = rule111 _tlIv _hdOallInters = rule112 _lhsIallInters _hdOcons = rule113 _lhsIcons _hdOddp = rule114 _lhsIddp _hdOinfo = rule115 _lhsIinfo _hdOisFirst = rule116 _lhsIisFirst _hdOn = rule117 _lhsIn _hdOprev = rule118 _lhsIprev _hdOv = rule119 _lhsIv _hdOvisitDescr = rule120 _lhsIvisitDescr _hdOvssGraph = rule121 _lhsIvssGraph _tlOallInters = rule122 _lhsIallInters _tlOcons = rule123 _lhsIcons _tlOddp = rule124 _lhsIddp _tlOinfo = rule125 _lhsIinfo _tlOprev = rule126 _hdIprev _tlOv = rule127 _hdIv _tlOvisitDescr = rule128 _lhsIvisitDescr _tlOvssGraph = rule129 _lhsIvssGraph !__result_ = T_Segments_vOut13 _lhsOcvisits _lhsOdescr _lhsOedp _lhsOfirstInh _lhsOgroups _lhsOhdIntravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOsegs _lhsOv in __result_ ) in C_Segments_s14 v13 {-# INLINE rule94 #-} {-# LINE 165 "src-ag/InterfacesRules.lag" #-} rule94 = \ ((_tlInewvertices) :: [Vertex]) -> {-# LINE 165 "src-ag/InterfacesRules.lag" #-} _tlInewvertices {-# LINE 996 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule95 #-} {-# LINE 166 "src-ag/InterfacesRules.lag" #-} rule95 = \ ((_hdInewvertices) :: [Vertex]) -> {-# LINE 166 "src-ag/InterfacesRules.lag" #-} _hdInewvertices {-# LINE 1002 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule96 #-} {-# LINE 180 "src-ag/InterfacesRules.lag" #-} rule96 = \ ((_hdIgroups) :: [([Vertex],[Vertex])]) -> {-# LINE 180 "src-ag/InterfacesRules.lag" #-} _hdIgroups {-# LINE 1008 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule97 #-} {-# LINE 203 "src-ag/InterfacesRules.lag" #-} rule97 = \ ((_lhsIn) :: Int) -> {-# LINE 203 "src-ag/InterfacesRules.lag" #-} _lhsIn + 1 {-# LINE 1014 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule98 #-} {-# LINE 316 "src-ag/InterfacesRules.lag" #-} rule98 = \ (_ :: ()) -> {-# LINE 316 "src-ag/InterfacesRules.lag" #-} False {-# LINE 1020 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule99 #-} {-# LINE 329 "src-ag/InterfacesRules.lag" #-} rule99 = \ ((_tlIhdIntravisits) :: [IntraVisit]) -> {-# LINE 329 "src-ag/InterfacesRules.lag" #-} _tlIhdIntravisits {-# LINE 1026 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule100 #-} {-# LINE 330 "src-ag/InterfacesRules.lag" #-} rule100 = \ ((_hdIintravisits) :: [IntraVisit]) -> {-# LINE 330 "src-ag/InterfacesRules.lag" #-} _hdIintravisits {-# LINE 1032 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule101 #-} {-# LINE 354 "src-ag/InterfacesRules.lag" #-} rule101 = \ ((_lhsIfromLhs) :: [Vertex]) -> {-# LINE 354 "src-ag/InterfacesRules.lag" #-} _lhsIfromLhs {-# LINE 1038 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule102 #-} {-# LINE 355 "src-ag/InterfacesRules.lag" #-} rule102 = \ (_ :: ()) -> {-# LINE 355 "src-ag/InterfacesRules.lag" #-} [] {-# LINE 1044 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule103 #-} {-# LINE 401 "src-ag/InterfacesRules.lag" #-} rule103 = \ ((_hdIseg) :: CSegment) ((_tlIsegs) :: CSegments) -> {-# LINE 401 "src-ag/InterfacesRules.lag" #-} _hdIseg : _tlIsegs {-# LINE 1050 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule104 #-} {-# LINE 447 "src-ag/InterfacesRules.lag" #-} rule104 = \ ((_tlIfirstInh) :: [Vertex]) -> {-# LINE 447 "src-ag/InterfacesRules.lag" #-} _tlIfirstInh {-# LINE 1056 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule105 #-} {-# LINE 448 "src-ag/InterfacesRules.lag" #-} rule105 = \ ((_hdIinh) :: [Vertex]) -> {-# LINE 448 "src-ag/InterfacesRules.lag" #-} _hdIinh {-# LINE 1062 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule106 #-} rule106 = \ ((_hdIcvisits) :: [CVisit]) ((_tlIcvisits) :: [[CVisit]]) -> _hdIcvisits : _tlIcvisits {-# INLINE rule107 #-} rule107 = \ ((_hdIdescr) :: Seq (Vertex,ChildVisit)) ((_tlIdescr) :: Seq (Vertex,ChildVisit)) -> _hdIdescr Seq.>< _tlIdescr {-# INLINE rule108 #-} rule108 = \ ((_hdIedp) :: Seq Edge) ((_tlIedp) :: Seq Edge) -> _hdIedp Seq.>< _tlIedp {-# INLINE rule109 #-} rule109 = \ ((_hdInewedges) :: Seq Edge ) ((_tlInewedges) :: Seq Edge ) -> _hdInewedges Seq.>< _tlInewedges {-# INLINE rule110 #-} rule110 = \ ((_tlIprev) :: [Vertex]) -> _tlIprev {-# INLINE rule111 #-} rule111 = \ ((_tlIv) :: Vertex) -> _tlIv {-# INLINE rule112 #-} rule112 = \ ((_lhsIallInters) :: CInterfaceMap) -> _lhsIallInters {-# INLINE rule113 #-} rule113 = \ ((_lhsIcons) :: [ConstructorIdent]) -> _lhsIcons {-# INLINE rule114 #-} rule114 = \ ((_lhsIddp) :: Graph) -> _lhsIddp {-# INLINE rule115 #-} rule115 = \ ((_lhsIinfo) :: Info) -> _lhsIinfo {-# INLINE rule116 #-} rule116 = \ ((_lhsIisFirst) :: Bool) -> _lhsIisFirst {-# INLINE rule117 #-} rule117 = \ ((_lhsIn) :: Int) -> _lhsIn {-# INLINE rule118 #-} rule118 = \ ((_lhsIprev) :: [Vertex]) -> _lhsIprev {-# INLINE rule119 #-} rule119 = \ ((_lhsIv) :: Vertex) -> _lhsIv {-# INLINE rule120 #-} rule120 = \ ((_lhsIvisitDescr) :: Map Vertex ChildVisit) -> _lhsIvisitDescr {-# INLINE rule121 #-} rule121 = \ ((_lhsIvssGraph) :: Graph) -> _lhsIvssGraph {-# INLINE rule122 #-} rule122 = \ ((_lhsIallInters) :: CInterfaceMap) -> _lhsIallInters {-# INLINE rule123 #-} rule123 = \ ((_lhsIcons) :: [ConstructorIdent]) -> _lhsIcons {-# INLINE rule124 #-} rule124 = \ ((_lhsIddp) :: Graph) -> _lhsIddp {-# INLINE rule125 #-} rule125 = \ ((_lhsIinfo) :: Info) -> _lhsIinfo {-# INLINE rule126 #-} rule126 = \ ((_hdIprev) :: [Vertex]) -> _hdIprev {-# INLINE rule127 #-} rule127 = \ ((_hdIv) :: Vertex) -> _hdIv {-# INLINE rule128 #-} rule128 = \ ((_lhsIvisitDescr) :: Map Vertex ChildVisit) -> _lhsIvisitDescr {-# INLINE rule129 #-} rule129 = \ ((_lhsIvssGraph) :: Graph) -> _lhsIvssGraph {-# NOINLINE sem_Segments_Nil #-} sem_Segments_Nil :: T_Segments sem_Segments_Nil = T_Segments (return st14) where {-# NOINLINE st14 #-} !st14 = let v13 :: T_Segments_v13 v13 = \ !(T_Segments_vIn13 _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) -> ( let _lhsOnewvertices :: [Vertex] _lhsOnewvertices = rule130 () _lhsOgroups :: [([Vertex],[Vertex])] _lhsOgroups = rule131 () _lhsOhdIntravisits :: [IntraVisit] _lhsOhdIntravisits = rule132 () _lhsOsegs :: CSegments _lhsOsegs = rule133 () _lhsOfirstInh :: [Vertex] _lhsOfirstInh = rule134 () _lhsOcvisits :: [[CVisit]] _lhsOcvisits = rule135 () _lhsOdescr :: Seq (Vertex,ChildVisit) _lhsOdescr = rule136 () _lhsOedp :: Seq Edge _lhsOedp = rule137 () _lhsOnewedges :: Seq Edge _lhsOnewedges = rule138 () _lhsOprev :: [Vertex] _lhsOprev = rule139 _lhsIprev _lhsOv :: Vertex _lhsOv = rule140 _lhsIv !__result_ = T_Segments_vOut13 _lhsOcvisits _lhsOdescr _lhsOedp _lhsOfirstInh _lhsOgroups _lhsOhdIntravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOsegs _lhsOv in __result_ ) in C_Segments_s14 v13 {-# INLINE rule130 #-} {-# LINE 167 "src-ag/InterfacesRules.lag" #-} rule130 = \ (_ :: ()) -> {-# LINE 167 "src-ag/InterfacesRules.lag" #-} [] {-# LINE 1172 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule131 #-} {-# LINE 181 "src-ag/InterfacesRules.lag" #-} rule131 = \ (_ :: ()) -> {-# LINE 181 "src-ag/InterfacesRules.lag" #-} [] {-# LINE 1178 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule132 #-} {-# LINE 331 "src-ag/InterfacesRules.lag" #-} rule132 = \ (_ :: ()) -> {-# LINE 331 "src-ag/InterfacesRules.lag" #-} repeat [] {-# LINE 1184 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule133 #-} {-# LINE 402 "src-ag/InterfacesRules.lag" #-} rule133 = \ (_ :: ()) -> {-# LINE 402 "src-ag/InterfacesRules.lag" #-} [] {-# LINE 1190 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule134 #-} {-# LINE 449 "src-ag/InterfacesRules.lag" #-} rule134 = \ (_ :: ()) -> {-# LINE 449 "src-ag/InterfacesRules.lag" #-} [] {-# LINE 1196 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule135 #-} rule135 = \ (_ :: ()) -> [] {-# INLINE rule136 #-} rule136 = \ (_ :: ()) -> Seq.empty {-# INLINE rule137 #-} rule137 = \ (_ :: ()) -> Seq.empty {-# INLINE rule138 #-} rule138 = \ (_ :: ()) -> Seq.empty {-# INLINE rule139 #-} rule139 = \ ((_lhsIprev) :: [Vertex]) -> _lhsIprev {-# INLINE rule140 #-} rule140 = \ ((_lhsIv) :: Vertex) -> _lhsIv uuagc-0.9.52.2/src-generated/DeclBlocks.hs0000644000000000000000000000152213433540502016324 0ustar0000000000000000 -- UUAGC 0.9.51 (src-ag/DeclBlocks.ag) module DeclBlocks where {-# LINE 2 "src-ag/DeclBlocks.ag" #-} import Code (Decl,Expr) {-# LINE 9 "dist/build/DeclBlocks.hs" #-} -- DeclBlocks -------------------------------------------------- {- alternatives: alternative DeclBlock: child defs : {[Decl]} child visit : {Decl} child next : DeclBlocks alternative DeclTerminator: child defs : {[Decl]} child result : {Expr} -} data DeclBlocks = DeclBlock (([Decl])) (Decl) (DeclBlocks) | DeclTerminator (([Decl])) (Expr) -- DeclBlocksRoot ---------------------------------------------- {- alternatives: alternative DeclBlocksRoot: child blocks : DeclBlocks -} data DeclBlocksRoot = DeclBlocksRoot (DeclBlocks)uuagc-0.9.52.2/src-generated/VisagePatterns.hs0000644000000000000000000000263213433540502017261 0ustar0000000000000000 -- UUAGC 0.9.51 (src-ag/VisagePatterns.ag) module VisagePatterns where {-# LINE 2 "src-ag/VisagePatterns.ag" #-} import UU.Scanner.Position(Pos) import CommonTypes {-# LINE 10 "dist/build/VisagePatterns.hs" #-} -- VisagePattern ----------------------------------------------- {- alternatives: alternative VConstr: child name : {ConstructorIdent} child pats : VisagePatterns alternative VProduct: child pos : {Pos} child pats : VisagePatterns alternative VVar: child field : {Identifier} child attr : {Identifier} alternative VAlias: child field : {Identifier} child attr : {Identifier} child pat : VisagePattern alternative VUnderscore: child pos : {Pos} -} data VisagePattern = VConstr (ConstructorIdent) (VisagePatterns) | VProduct (Pos) (VisagePatterns) | VVar (Identifier) (Identifier) | VAlias (Identifier) (Identifier) (VisagePattern) | VUnderscore (Pos) -- VisagePatterns ---------------------------------------------- {- alternatives: alternative Cons: child hd : VisagePattern child tl : VisagePatterns alternative Nil: -} type VisagePatterns = [VisagePattern]uuagc-0.9.52.2/src-generated/PrintOcamlCode.hs0000644000000000000000000034562213433540502017176 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} module PrintOcamlCode where {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 12 "dist/build/PrintOcamlCode.hs" #-} {-# LINE 2 "src-ag/Code.ag" #-} import Patterns import Data.Set(Set) import qualified Data.Set as Set import Data.Map(Map) import qualified Data.Map as Map {-# LINE 21 "dist/build/PrintOcamlCode.hs" #-} {-# LINE 10 "src-ag/PrintOcamlCode.ag" #-} import Pretty import Code import Patterns import Options import CommonTypes hiding (List,Type,Map,Maybe,IntMap,Either) import Data.List(intersperse,intercalate) import Data.Char(toLower) {-# LINE 32 "dist/build/PrintOcamlCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 146 "src-ag/Code.ag" #-} -- Unboxed tuples -- unbox Whether unboxed tuples are wanted or not -- inh The inherited attributes. -- If there are none, no unboxing can take place, -- because in that case the semantic function (a top-level identifier) would have an unboxed type. -- Of course we can't have an unboxed 1-tuple mkTupleExpr :: Bool -> Bool -> Exprs -> Expr mkTupleExpr unbox' noInh exprs | not unbox' || noInh || length exprs == 1 = TupleExpr exprs | otherwise = UnboxedTupleExpr exprs mkTupleType :: Bool -> Bool -> Types -> Type mkTupleType unbox' noInh tps | not unbox' || noInh || length tps == 1 = TupleType tps | otherwise = UnboxedTupleType tps mkTupleLhs :: Bool -> Bool -> [String] -> Lhs mkTupleLhs unbox' noInh comps | not unbox' || noInh || length comps == 1 = TupleLhs comps | otherwise = UnboxedTupleLhs comps {-# LINE 52 "dist/build/PrintOcamlCode.hs" #-} {-# LINE 21 "src-ag/PrintOcamlCode.ag" #-} type PP_Docs = [PP_Doc] ppMultiSeqH :: [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeqH = ppMultiSeq' (>#<) ppMultiSeqV :: [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeqV = ppMultiSeq' (>-<) ppMultiSeq' :: (PP_Doc -> PP_Doc -> PP_Doc) -> [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeq' next strictArgs expr = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs ppTuple :: Bool -> [PP_Doc] -> PP_Doc ppTuple True pps = "(" >|< pp_block " " (replicate (length pps `max` 1) ')') ",(" pps ppTuple False pps = "(" >|< pp_block " " ")" "," pps {-# LINE 71 "dist/build/PrintOcamlCode.hs" #-} {-# LINE 177 "src-ag/PrintOcamlCode.ag" #-} toOcamlTC :: String -> String toOcamlTC (c:cs) = toLower c : cs toOcamlTC xs = xs {-# LINE 78 "dist/build/PrintOcamlCode.hs" #-} -- CaseAlt ----------------------------------------------------- -- wrapper data Inh_CaseAlt = Inh_CaseAlt { options_Inh_CaseAlt :: !(Options) } data Syn_CaseAlt = Syn_CaseAlt { pp_Syn_CaseAlt :: !(PP_Doc) } {-# INLINABLE wrap_CaseAlt #-} wrap_CaseAlt :: T_CaseAlt -> Inh_CaseAlt -> (Syn_CaseAlt ) wrap_CaseAlt !(T_CaseAlt act) !(Inh_CaseAlt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg1 = T_CaseAlt_vIn1 _lhsIoptions !(T_CaseAlt_vOut1 _lhsOpp) <- return (inv_CaseAlt_s2 sem arg1) return (Syn_CaseAlt _lhsOpp) ) -- cata {-# NOINLINE sem_CaseAlt #-} sem_CaseAlt :: CaseAlt -> T_CaseAlt sem_CaseAlt ( CaseAlt left_ expr_ ) = sem_CaseAlt_CaseAlt ( sem_Lhs left_ ) ( sem_Expr expr_ ) -- semantic domain newtype T_CaseAlt = T_CaseAlt { attach_T_CaseAlt :: Identity (T_CaseAlt_s2 ) } newtype T_CaseAlt_s2 = C_CaseAlt_s2 { inv_CaseAlt_s2 :: (T_CaseAlt_v1 ) } data T_CaseAlt_s3 = C_CaseAlt_s3 type T_CaseAlt_v1 = (T_CaseAlt_vIn1 ) -> (T_CaseAlt_vOut1 ) data T_CaseAlt_vIn1 = T_CaseAlt_vIn1 (Options) data T_CaseAlt_vOut1 = T_CaseAlt_vOut1 (PP_Doc) {-# NOINLINE sem_CaseAlt_CaseAlt #-} sem_CaseAlt_CaseAlt :: T_Lhs -> T_Expr -> T_CaseAlt sem_CaseAlt_CaseAlt arg_left_ arg_expr_ = T_CaseAlt (return st2) where {-# NOINLINE st2 #-} !st2 = let v1 :: T_CaseAlt_v1 v1 = \ !(T_CaseAlt_vIn1 _lhsIoptions) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOoptions) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule0 _exprIpp _leftIpp _leftOoptions = rule1 _lhsIoptions _exprOoptions = rule2 _lhsIoptions !__result_ = T_CaseAlt_vOut1 _lhsOpp in __result_ ) in C_CaseAlt_s2 v1 {-# INLINE rule0 #-} {-# LINE 184 "src-ag/PrintOcamlCode.ag" #-} rule0 = \ ((_exprIpp) :: PP_Doc) ((_leftIpp) :: PP_Doc) -> {-# LINE 184 "src-ag/PrintOcamlCode.ag" #-} _leftIpp >#< "->" >#< _exprIpp {-# LINE 132 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule1 #-} rule1 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule2 #-} rule2 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- CaseAlts ---------------------------------------------------- -- wrapper data Inh_CaseAlts = Inh_CaseAlts { options_Inh_CaseAlts :: !(Options) } data Syn_CaseAlts = Syn_CaseAlts { pps_Syn_CaseAlts :: !(PP_Docs) } {-# INLINABLE wrap_CaseAlts #-} wrap_CaseAlts :: T_CaseAlts -> Inh_CaseAlts -> (Syn_CaseAlts ) wrap_CaseAlts !(T_CaseAlts act) !(Inh_CaseAlts _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg4 = T_CaseAlts_vIn4 _lhsIoptions !(T_CaseAlts_vOut4 _lhsOpps) <- return (inv_CaseAlts_s5 sem arg4) return (Syn_CaseAlts _lhsOpps) ) -- cata {-# NOINLINE sem_CaseAlts #-} sem_CaseAlts :: CaseAlts -> T_CaseAlts sem_CaseAlts list = Prelude.foldr sem_CaseAlts_Cons sem_CaseAlts_Nil (Prelude.map sem_CaseAlt list) -- semantic domain newtype T_CaseAlts = T_CaseAlts { attach_T_CaseAlts :: Identity (T_CaseAlts_s5 ) } newtype T_CaseAlts_s5 = C_CaseAlts_s5 { inv_CaseAlts_s5 :: (T_CaseAlts_v4 ) } data T_CaseAlts_s6 = C_CaseAlts_s6 type T_CaseAlts_v4 = (T_CaseAlts_vIn4 ) -> (T_CaseAlts_vOut4 ) data T_CaseAlts_vIn4 = T_CaseAlts_vIn4 (Options) data T_CaseAlts_vOut4 = T_CaseAlts_vOut4 (PP_Docs) {-# NOINLINE sem_CaseAlts_Cons #-} sem_CaseAlts_Cons :: T_CaseAlt -> T_CaseAlts -> T_CaseAlts sem_CaseAlts_Cons arg_hd_ arg_tl_ = T_CaseAlts (return st5) where {-# NOINLINE st5 #-} !st5 = let v4 :: T_CaseAlts_v4 v4 = \ !(T_CaseAlts_vIn4 _lhsIoptions) -> ( let _hdX2 = Control.Monad.Identity.runIdentity (attach_T_CaseAlt (arg_hd_)) _tlX5 = Control.Monad.Identity.runIdentity (attach_T_CaseAlts (arg_tl_)) (T_CaseAlt_vOut1 _hdIpp) = inv_CaseAlt_s2 _hdX2 (T_CaseAlt_vIn1 _hdOoptions) (T_CaseAlts_vOut4 _tlIpps) = inv_CaseAlts_s5 _tlX5 (T_CaseAlts_vIn4 _tlOoptions) _lhsOpps :: PP_Docs _lhsOpps = rule3 _hdIpp _tlIpps _hdOoptions = rule4 _lhsIoptions _tlOoptions = rule5 _lhsIoptions !__result_ = T_CaseAlts_vOut4 _lhsOpps in __result_ ) in C_CaseAlts_s5 v4 {-# INLINE rule3 #-} {-# LINE 65 "src-ag/PrintOcamlCode.ag" #-} rule3 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 65 "src-ag/PrintOcamlCode.ag" #-} _hdIpp : _tlIpps {-# LINE 193 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule4 #-} rule4 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule5 #-} rule5 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_CaseAlts_Nil #-} sem_CaseAlts_Nil :: T_CaseAlts sem_CaseAlts_Nil = T_CaseAlts (return st5) where {-# NOINLINE st5 #-} !st5 = let v4 :: T_CaseAlts_v4 v4 = \ !(T_CaseAlts_vIn4 _lhsIoptions) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule6 () !__result_ = T_CaseAlts_vOut4 _lhsOpps in __result_ ) in C_CaseAlts_s5 v4 {-# INLINE rule6 #-} {-# LINE 66 "src-ag/PrintOcamlCode.ag" #-} rule6 = \ (_ :: ()) -> {-# LINE 66 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 217 "dist/build/PrintOcamlCode.hs"#-} -- Chunk ------------------------------------------------------- -- wrapper data Inh_Chunk = Inh_Chunk { isToplevel_Inh_Chunk :: !(Bool), options_Inh_Chunk :: !(Options), textBlockMap_Inh_Chunk :: !(Map BlockInfo PP_Doc) } data Syn_Chunk = Syn_Chunk { pps_Syn_Chunk :: !(PP_Docs) } {-# INLINABLE wrap_Chunk #-} wrap_Chunk :: T_Chunk -> Inh_Chunk -> (Syn_Chunk ) wrap_Chunk !(T_Chunk act) !(Inh_Chunk _lhsIisToplevel _lhsIoptions _lhsItextBlockMap) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg7 = T_Chunk_vIn7 _lhsIisToplevel _lhsIoptions _lhsItextBlockMap !(T_Chunk_vOut7 _lhsOpps) <- return (inv_Chunk_s8 sem arg7) return (Syn_Chunk _lhsOpps) ) -- cata {-# INLINE sem_Chunk #-} sem_Chunk :: Chunk -> T_Chunk sem_Chunk ( Chunk !name_ comment_ info_ dataDef_ cataFun_ semDom_ semWrapper_ semFunctions_ !semNames_ ) = sem_Chunk_Chunk name_ ( sem_Decl comment_ ) ( sem_Decls info_ ) ( sem_Decls dataDef_ ) ( sem_Decls cataFun_ ) ( sem_Decls semDom_ ) ( sem_Decls semWrapper_ ) ( sem_Decls semFunctions_ ) semNames_ -- semantic domain newtype T_Chunk = T_Chunk { attach_T_Chunk :: Identity (T_Chunk_s8 ) } newtype T_Chunk_s8 = C_Chunk_s8 { inv_Chunk_s8 :: (T_Chunk_v7 ) } data T_Chunk_s9 = C_Chunk_s9 type T_Chunk_v7 = (T_Chunk_vIn7 ) -> (T_Chunk_vOut7 ) data T_Chunk_vIn7 = T_Chunk_vIn7 (Bool) (Options) (Map BlockInfo PP_Doc) data T_Chunk_vOut7 = T_Chunk_vOut7 (PP_Docs) {-# NOINLINE sem_Chunk_Chunk #-} sem_Chunk_Chunk :: (String) -> T_Decl -> T_Decls -> T_Decls -> T_Decls -> T_Decls -> T_Decls -> T_Decls -> ([String]) -> T_Chunk sem_Chunk_Chunk !arg_name_ arg_comment_ arg_info_ arg_dataDef_ arg_cataFun_ arg_semDom_ arg_semWrapper_ arg_semFunctions_ _ = T_Chunk (return st8) where {-# NOINLINE st8 #-} !st8 = let v7 :: T_Chunk_v7 v7 = \ !(T_Chunk_vIn7 _lhsIisToplevel _lhsIoptions _lhsItextBlockMap) -> ( let _commentX20 = Control.Monad.Identity.runIdentity (attach_T_Decl (arg_comment_)) _infoX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_info_)) _dataDefX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_dataDef_)) _cataFunX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_cataFun_)) _semDomX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_semDom_)) _semWrapperX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_semWrapper_)) _semFunctionsX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_semFunctions_)) (T_Decl_vOut19 _commentIpp) = inv_Decl_s20 _commentX20 (T_Decl_vIn19 _commentOisToplevel _commentOoptions) (T_Decls_vOut22 _infoIpps) = inv_Decls_s23 _infoX23 (T_Decls_vIn22 _infoOisToplevel _infoOoptions) (T_Decls_vOut22 _dataDefIpps) = inv_Decls_s23 _dataDefX23 (T_Decls_vIn22 _dataDefOisToplevel _dataDefOoptions) (T_Decls_vOut22 _cataFunIpps) = inv_Decls_s23 _cataFunX23 (T_Decls_vIn22 _cataFunOisToplevel _cataFunOoptions) (T_Decls_vOut22 _semDomIpps) = inv_Decls_s23 _semDomX23 (T_Decls_vIn22 _semDomOisToplevel _semDomOoptions) (T_Decls_vOut22 _semWrapperIpps) = inv_Decls_s23 _semWrapperX23 (T_Decls_vIn22 _semWrapperOisToplevel _semWrapperOoptions) (T_Decls_vOut22 _semFunctionsIpps) = inv_Decls_s23 _semFunctionsX23 (T_Decls_vIn22 _semFunctionsOisToplevel _semFunctionsOoptions) _lhsOpps :: PP_Docs _lhsOpps = rule7 _cataFunIpps _commentIpp _dataDefIpps _infoIpps _lhsItextBlockMap _semDomIpps _semFunctionsIpps _semWrapperIpps arg_name_ _commentOisToplevel = rule8 _lhsIisToplevel _commentOoptions = rule9 _lhsIoptions _infoOisToplevel = rule10 _lhsIisToplevel _infoOoptions = rule11 _lhsIoptions _dataDefOisToplevel = rule12 _lhsIisToplevel _dataDefOoptions = rule13 _lhsIoptions _cataFunOisToplevel = rule14 _lhsIisToplevel _cataFunOoptions = rule15 _lhsIoptions _semDomOisToplevel = rule16 _lhsIisToplevel _semDomOoptions = rule17 _lhsIoptions _semWrapperOisToplevel = rule18 _lhsIisToplevel _semWrapperOoptions = rule19 _lhsIoptions _semFunctionsOisToplevel = rule20 _lhsIisToplevel _semFunctionsOoptions = rule21 _lhsIoptions !__result_ = T_Chunk_vOut7 _lhsOpps in __result_ ) in C_Chunk_s8 v7 {-# INLINE rule7 #-} {-# LINE 97 "src-ag/PrintOcamlCode.ag" #-} rule7 = \ ((_cataFunIpps) :: PP_Docs) ((_commentIpp) :: PP_Doc) ((_dataDefIpps) :: PP_Docs) ((_infoIpps) :: PP_Docs) ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) ((_semDomIpps) :: PP_Docs) ((_semFunctionsIpps) :: PP_Docs) ((_semWrapperIpps) :: PP_Docs) name_ -> {-# LINE 97 "src-ag/PrintOcamlCode.ag" #-} _commentIpp : _infoIpps ++ _dataDefIpps ++ _semDomIpps ++ _semFunctionsIpps ++ _semWrapperIpps ++ _cataFunIpps ++ [Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap] {-# LINE 301 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule8 #-} rule8 = \ ((_lhsIisToplevel) :: Bool) -> _lhsIisToplevel {-# INLINE rule9 #-} rule9 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule10 #-} rule10 = \ ((_lhsIisToplevel) :: Bool) -> _lhsIisToplevel {-# INLINE rule11 #-} rule11 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule12 #-} rule12 = \ ((_lhsIisToplevel) :: Bool) -> _lhsIisToplevel {-# INLINE rule13 #-} rule13 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule14 #-} rule14 = \ ((_lhsIisToplevel) :: Bool) -> _lhsIisToplevel {-# INLINE rule15 #-} rule15 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule16 #-} rule16 = \ ((_lhsIisToplevel) :: Bool) -> _lhsIisToplevel {-# INLINE rule17 #-} rule17 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule18 #-} rule18 = \ ((_lhsIisToplevel) :: Bool) -> _lhsIisToplevel {-# INLINE rule19 #-} rule19 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule20 #-} rule20 = \ ((_lhsIisToplevel) :: Bool) -> _lhsIisToplevel {-# INLINE rule21 #-} rule21 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- Chunks ------------------------------------------------------ -- wrapper data Inh_Chunks = Inh_Chunks { isToplevel_Inh_Chunks :: !(Bool), options_Inh_Chunks :: !(Options), textBlockMap_Inh_Chunks :: !(Map BlockInfo PP_Doc) } data Syn_Chunks = Syn_Chunks { pps_Syn_Chunks :: !(PP_Docs) } {-# INLINABLE wrap_Chunks #-} wrap_Chunks :: T_Chunks -> Inh_Chunks -> (Syn_Chunks ) wrap_Chunks !(T_Chunks act) !(Inh_Chunks _lhsIisToplevel _lhsIoptions _lhsItextBlockMap) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg10 = T_Chunks_vIn10 _lhsIisToplevel _lhsIoptions _lhsItextBlockMap !(T_Chunks_vOut10 _lhsOpps) <- return (inv_Chunks_s11 sem arg10) return (Syn_Chunks _lhsOpps) ) -- cata {-# NOINLINE sem_Chunks #-} sem_Chunks :: Chunks -> T_Chunks sem_Chunks list = Prelude.foldr sem_Chunks_Cons sem_Chunks_Nil (Prelude.map sem_Chunk list) -- semantic domain newtype T_Chunks = T_Chunks { attach_T_Chunks :: Identity (T_Chunks_s11 ) } newtype T_Chunks_s11 = C_Chunks_s11 { inv_Chunks_s11 :: (T_Chunks_v10 ) } data T_Chunks_s12 = C_Chunks_s12 type T_Chunks_v10 = (T_Chunks_vIn10 ) -> (T_Chunks_vOut10 ) data T_Chunks_vIn10 = T_Chunks_vIn10 (Bool) (Options) (Map BlockInfo PP_Doc) data T_Chunks_vOut10 = T_Chunks_vOut10 (PP_Docs) {-# NOINLINE sem_Chunks_Cons #-} sem_Chunks_Cons :: T_Chunk -> T_Chunks -> T_Chunks sem_Chunks_Cons arg_hd_ arg_tl_ = T_Chunks (return st11) where {-# NOINLINE st11 #-} !st11 = let v10 :: T_Chunks_v10 v10 = \ !(T_Chunks_vIn10 _lhsIisToplevel _lhsIoptions _lhsItextBlockMap) -> ( let _hdX8 = Control.Monad.Identity.runIdentity (attach_T_Chunk (arg_hd_)) _tlX11 = Control.Monad.Identity.runIdentity (attach_T_Chunks (arg_tl_)) (T_Chunk_vOut7 _hdIpps) = inv_Chunk_s8 _hdX8 (T_Chunk_vIn7 _hdOisToplevel _hdOoptions _hdOtextBlockMap) (T_Chunks_vOut10 _tlIpps) = inv_Chunks_s11 _tlX11 (T_Chunks_vIn10 _tlOisToplevel _tlOoptions _tlOtextBlockMap) _lhsOpps :: PP_Docs _lhsOpps = rule22 _hdIpps _tlIpps _hdOisToplevel = rule23 _lhsIisToplevel _hdOoptions = rule24 _lhsIoptions _hdOtextBlockMap = rule25 _lhsItextBlockMap _tlOisToplevel = rule26 _lhsIisToplevel _tlOoptions = rule27 _lhsIoptions _tlOtextBlockMap = rule28 _lhsItextBlockMap !__result_ = T_Chunks_vOut10 _lhsOpps in __result_ ) in C_Chunks_s11 v10 {-# INLINE rule22 #-} {-# LINE 85 "src-ag/PrintOcamlCode.ag" #-} rule22 = \ ((_hdIpps) :: PP_Docs) ((_tlIpps) :: PP_Docs) -> {-# LINE 85 "src-ag/PrintOcamlCode.ag" #-} _hdIpps ++ _tlIpps {-# LINE 402 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule23 #-} rule23 = \ ((_lhsIisToplevel) :: Bool) -> _lhsIisToplevel {-# INLINE rule24 #-} rule24 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule25 #-} rule25 = \ ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) -> _lhsItextBlockMap {-# INLINE rule26 #-} rule26 = \ ((_lhsIisToplevel) :: Bool) -> _lhsIisToplevel {-# INLINE rule27 #-} rule27 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule28 #-} rule28 = \ ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) -> _lhsItextBlockMap {-# NOINLINE sem_Chunks_Nil #-} sem_Chunks_Nil :: T_Chunks sem_Chunks_Nil = T_Chunks (return st11) where {-# NOINLINE st11 #-} !st11 = let v10 :: T_Chunks_v10 v10 = \ !(T_Chunks_vIn10 _lhsIisToplevel _lhsIoptions _lhsItextBlockMap) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule29 () !__result_ = T_Chunks_vOut10 _lhsOpps in __result_ ) in C_Chunks_s11 v10 {-# INLINE rule29 #-} {-# LINE 86 "src-ag/PrintOcamlCode.ag" #-} rule29 = \ (_ :: ()) -> {-# LINE 86 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 438 "dist/build/PrintOcamlCode.hs"#-} -- DataAlt ----------------------------------------------------- -- wrapper data Inh_DataAlt = Inh_DataAlt { } data Syn_DataAlt = Syn_DataAlt { pp_Syn_DataAlt :: !(PP_Doc) } {-# INLINABLE wrap_DataAlt #-} wrap_DataAlt :: T_DataAlt -> Inh_DataAlt -> (Syn_DataAlt ) wrap_DataAlt !(T_DataAlt act) !(Inh_DataAlt ) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg13 = T_DataAlt_vIn13 !(T_DataAlt_vOut13 _lhsOpp) <- return (inv_DataAlt_s14 sem arg13) return (Syn_DataAlt _lhsOpp) ) -- cata {-# NOINLINE sem_DataAlt #-} sem_DataAlt :: DataAlt -> T_DataAlt sem_DataAlt ( DataAlt !name_ args_ ) = sem_DataAlt_DataAlt name_ ( sem_Types args_ ) sem_DataAlt ( Record !name_ args_ ) = sem_DataAlt_Record name_ ( sem_NamedTypes args_ ) -- semantic domain newtype T_DataAlt = T_DataAlt { attach_T_DataAlt :: Identity (T_DataAlt_s14 ) } newtype T_DataAlt_s14 = C_DataAlt_s14 { inv_DataAlt_s14 :: (T_DataAlt_v13 ) } data T_DataAlt_s15 = C_DataAlt_s15 type T_DataAlt_v13 = (T_DataAlt_vIn13 ) -> (T_DataAlt_vOut13 ) data T_DataAlt_vIn13 = T_DataAlt_vIn13 data T_DataAlt_vOut13 = T_DataAlt_vOut13 (PP_Doc) {-# NOINLINE sem_DataAlt_DataAlt #-} sem_DataAlt_DataAlt :: (String) -> T_Types -> T_DataAlt sem_DataAlt_DataAlt !arg_name_ arg_args_ = T_DataAlt (return st14) where {-# NOINLINE st14 #-} !st14 = let v13 :: T_DataAlt_v13 v13 = \ !(T_DataAlt_vIn13 ) -> ( let _argsX53 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_args_)) (T_Types_vOut52 _argsIpps) = inv_Types_s53 _argsX53 (T_Types_vIn52 ) _lhsOpp :: PP_Doc _lhsOpp = rule30 _argsIpps arg_name_ !__result_ = T_DataAlt_vOut13 _lhsOpp in __result_ ) in C_DataAlt_s14 v13 {-# INLINE rule30 #-} {-# LINE 187 "src-ag/PrintOcamlCode.ag" #-} rule30 = \ ((_argsIpps) :: PP_Docs) name_ -> {-# LINE 187 "src-ag/PrintOcamlCode.ag" #-} name_ >#< "of" >#< pp_block "" "" " * " (map pp_parens _argsIpps) {-# LINE 490 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_DataAlt_Record #-} sem_DataAlt_Record :: (String) -> T_NamedTypes -> T_DataAlt sem_DataAlt_Record _ arg_args_ = T_DataAlt (return st14) where {-# NOINLINE st14 #-} !st14 = let v13 :: T_DataAlt_v13 v13 = \ !(T_DataAlt_vIn13 ) -> ( let _argsX38 = Control.Monad.Identity.runIdentity (attach_T_NamedTypes (arg_args_)) (T_NamedTypes_vOut37 _argsIpps) = inv_NamedTypes_s38 _argsX38 (T_NamedTypes_vIn37 ) _lhsOpp :: PP_Doc _lhsOpp = rule31 _argsIpps !__result_ = T_DataAlt_vOut13 _lhsOpp in __result_ ) in C_DataAlt_s14 v13 {-# INLINE rule31 #-} {-# LINE 188 "src-ag/PrintOcamlCode.ag" #-} rule31 = \ ((_argsIpps) :: PP_Docs) -> {-# LINE 188 "src-ag/PrintOcamlCode.ag" #-} pp_block "{" "}" ";" _argsIpps {-# LINE 510 "dist/build/PrintOcamlCode.hs"#-} -- DataAlts ---------------------------------------------------- -- wrapper data Inh_DataAlts = Inh_DataAlts { } data Syn_DataAlts = Syn_DataAlts { pps_Syn_DataAlts :: !(PP_Docs) } {-# INLINABLE wrap_DataAlts #-} wrap_DataAlts :: T_DataAlts -> Inh_DataAlts -> (Syn_DataAlts ) wrap_DataAlts !(T_DataAlts act) !(Inh_DataAlts ) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg16 = T_DataAlts_vIn16 !(T_DataAlts_vOut16 _lhsOpps) <- return (inv_DataAlts_s17 sem arg16) return (Syn_DataAlts _lhsOpps) ) -- cata {-# NOINLINE sem_DataAlts #-} sem_DataAlts :: DataAlts -> T_DataAlts sem_DataAlts list = Prelude.foldr sem_DataAlts_Cons sem_DataAlts_Nil (Prelude.map sem_DataAlt list) -- semantic domain newtype T_DataAlts = T_DataAlts { attach_T_DataAlts :: Identity (T_DataAlts_s17 ) } newtype T_DataAlts_s17 = C_DataAlts_s17 { inv_DataAlts_s17 :: (T_DataAlts_v16 ) } data T_DataAlts_s18 = C_DataAlts_s18 type T_DataAlts_v16 = (T_DataAlts_vIn16 ) -> (T_DataAlts_vOut16 ) data T_DataAlts_vIn16 = T_DataAlts_vIn16 data T_DataAlts_vOut16 = T_DataAlts_vOut16 (PP_Docs) {-# NOINLINE sem_DataAlts_Cons #-} sem_DataAlts_Cons :: T_DataAlt -> T_DataAlts -> T_DataAlts sem_DataAlts_Cons arg_hd_ arg_tl_ = T_DataAlts (return st17) where {-# NOINLINE st17 #-} !st17 = let v16 :: T_DataAlts_v16 v16 = \ !(T_DataAlts_vIn16 ) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_DataAlt (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_DataAlts (arg_tl_)) (T_DataAlt_vOut13 _hdIpp) = inv_DataAlt_s14 _hdX14 (T_DataAlt_vIn13 ) (T_DataAlts_vOut16 _tlIpps) = inv_DataAlts_s17 _tlX17 (T_DataAlts_vIn16 ) _lhsOpps :: PP_Docs _lhsOpps = rule32 _hdIpp _tlIpps !__result_ = T_DataAlts_vOut16 _lhsOpps in __result_ ) in C_DataAlts_s17 v16 {-# INLINE rule32 #-} {-# LINE 69 "src-ag/PrintOcamlCode.ag" #-} rule32 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 69 "src-ag/PrintOcamlCode.ag" #-} _hdIpp : _tlIpps {-# LINE 563 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_DataAlts_Nil #-} sem_DataAlts_Nil :: T_DataAlts sem_DataAlts_Nil = T_DataAlts (return st17) where {-# NOINLINE st17 #-} !st17 = let v16 :: T_DataAlts_v16 v16 = \ !(T_DataAlts_vIn16 ) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule33 () !__result_ = T_DataAlts_vOut16 _lhsOpps in __result_ ) in C_DataAlts_s17 v16 {-# INLINE rule33 #-} {-# LINE 70 "src-ag/PrintOcamlCode.ag" #-} rule33 = \ (_ :: ()) -> {-# LINE 70 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 581 "dist/build/PrintOcamlCode.hs"#-} -- Decl -------------------------------------------------------- -- wrapper data Inh_Decl = Inh_Decl { isToplevel_Inh_Decl :: !(Bool), options_Inh_Decl :: !(Options) } data Syn_Decl = Syn_Decl { pp_Syn_Decl :: !(PP_Doc) } {-# INLINABLE wrap_Decl #-} wrap_Decl :: T_Decl -> Inh_Decl -> (Syn_Decl ) wrap_Decl !(T_Decl act) !(Inh_Decl _lhsIisToplevel _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg19 = T_Decl_vIn19 _lhsIisToplevel _lhsIoptions !(T_Decl_vOut19 _lhsOpp) <- return (inv_Decl_s20 sem arg19) return (Syn_Decl _lhsOpp) ) -- cata {-# NOINLINE sem_Decl #-} sem_Decl :: Decl -> T_Decl sem_Decl ( Decl left_ rhs_ !binds_ !uses_ ) = sem_Decl_Decl ( sem_Lhs left_ ) ( sem_Expr rhs_ ) binds_ uses_ sem_Decl ( Bind left_ rhs_ ) = sem_Decl_Bind ( sem_Lhs left_ ) ( sem_Expr rhs_ ) sem_Decl ( BindLet left_ rhs_ ) = sem_Decl_BindLet ( sem_Lhs left_ ) ( sem_Expr rhs_ ) sem_Decl ( Data !name_ !params_ alts_ !strict_ !derivings_ ) = sem_Decl_Data name_ params_ ( sem_DataAlts alts_ ) strict_ derivings_ sem_Decl ( NewType !name_ !params_ !con_ tp_ ) = sem_Decl_NewType name_ params_ con_ ( sem_Type tp_ ) sem_Decl ( Type !name_ !params_ tp_ ) = sem_Decl_Type name_ params_ ( sem_Type tp_ ) sem_Decl ( TSig !name_ tp_ ) = sem_Decl_TSig name_ ( sem_Type tp_ ) sem_Decl ( Comment !txt_ ) = sem_Decl_Comment txt_ sem_Decl ( PragmaDecl !txt_ ) = sem_Decl_PragmaDecl txt_ sem_Decl ( Resume !monadic_ !nt_ left_ rhs_ ) = sem_Decl_Resume monadic_ nt_ ( sem_Lhs left_ ) ( sem_Expr rhs_ ) sem_Decl ( EvalDecl !nt_ left_ rhs_ ) = sem_Decl_EvalDecl nt_ ( sem_Lhs left_ ) ( sem_Expr rhs_ ) -- semantic domain newtype T_Decl = T_Decl { attach_T_Decl :: Identity (T_Decl_s20 ) } newtype T_Decl_s20 = C_Decl_s20 { inv_Decl_s20 :: (T_Decl_v19 ) } data T_Decl_s21 = C_Decl_s21 type T_Decl_v19 = (T_Decl_vIn19 ) -> (T_Decl_vOut19 ) data T_Decl_vIn19 = T_Decl_vIn19 (Bool) (Options) data T_Decl_vOut19 = T_Decl_vOut19 (PP_Doc) {-# NOINLINE sem_Decl_Decl #-} sem_Decl_Decl :: T_Lhs -> T_Expr -> (Set String) -> (Set String) -> T_Decl sem_Decl_Decl arg_left_ arg_rhs_ _ _ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisToplevel _lhsIoptions) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOoptions) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule34 _leftIpp _lhsIisToplevel _rhsIpp _leftOoptions = rule35 _lhsIoptions _rhsOoptions = rule36 _lhsIoptions !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule34 #-} {-# LINE 107 "src-ag/PrintOcamlCode.ag" #-} rule34 = \ ((_leftIpp) :: PP_Doc) ((_lhsIisToplevel) :: Bool) ((_rhsIpp) :: PP_Doc) -> {-# LINE 107 "src-ag/PrintOcamlCode.ag" #-} if _lhsIisToplevel then "let" >#< _leftIpp >#< "=" >-< indent 4 _rhsIpp >#< ";;" else "let" >#< _leftIpp >#< "=" >-< indent 4 _rhsIpp >#< "in" {-# LINE 650 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule35 #-} rule35 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule36 #-} rule36 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Decl_Bind #-} sem_Decl_Bind :: T_Lhs -> T_Expr -> T_Decl sem_Decl_Bind arg_left_ arg_rhs_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisToplevel _lhsIoptions) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOoptions) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule37 () _leftOoptions = rule38 _lhsIoptions _rhsOoptions = rule39 _lhsIoptions !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule37 #-} {-# LINE 112 "src-ag/PrintOcamlCode.ag" #-} rule37 = \ (_ :: ()) -> {-# LINE 112 "src-ag/PrintOcamlCode.ag" #-} error "pp of Decl.Bind not supported" {-# LINE 680 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule38 #-} rule38 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule39 #-} rule39 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Decl_BindLet #-} sem_Decl_BindLet :: T_Lhs -> T_Expr -> T_Decl sem_Decl_BindLet arg_left_ arg_rhs_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisToplevel _lhsIoptions) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOoptions) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule40 () _leftOoptions = rule41 _lhsIoptions _rhsOoptions = rule42 _lhsIoptions !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule40 #-} {-# LINE 113 "src-ag/PrintOcamlCode.ag" #-} rule40 = \ (_ :: ()) -> {-# LINE 113 "src-ag/PrintOcamlCode.ag" #-} error "pp of Decl.BindLet not supported" {-# LINE 710 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule41 #-} rule41 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule42 #-} rule42 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Decl_Data #-} sem_Decl_Data :: (String) -> ([String]) -> T_DataAlts -> (Bool) -> ([String]) -> T_Decl sem_Decl_Data !arg_name_ !arg_params_ arg_alts_ _ _ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisToplevel _lhsIoptions) -> ( let _altsX17 = Control.Monad.Identity.runIdentity (attach_T_DataAlts (arg_alts_)) (T_DataAlts_vOut16 _altsIpps) = inv_DataAlts_s17 _altsX17 (T_DataAlts_vIn16 ) _lhsOpp :: PP_Doc _lhsOpp = rule43 _altsIpps arg_name_ arg_params_ !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule43 #-} {-# LINE 114 "src-ag/PrintOcamlCode.ag" #-} rule43 = \ ((_altsIpps) :: PP_Docs) name_ params_ -> {-# LINE 114 "src-ag/PrintOcamlCode.ag" #-} "type" >#< hv_sp (map (\p -> "'" >|< p) params_ ++ [text $ toOcamlTC name_]) >#< ( case _altsIpps of [] -> empty (x:xs) -> "=" >#< x >-< vlist (map ("|" >#<) xs) ) >#< ";;" {-# LINE 742 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Decl_NewType #-} sem_Decl_NewType :: (String) -> ([String]) -> (String) -> T_Type -> T_Decl sem_Decl_NewType _ _ _ arg_tp_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisToplevel _lhsIoptions) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIpp) = inv_Type_s50 _tpX50 (T_Type_vIn49 ) _lhsOpp :: PP_Doc _lhsOpp = rule44 () !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule44 #-} {-# LINE 121 "src-ag/PrintOcamlCode.ag" #-} rule44 = \ (_ :: ()) -> {-# LINE 121 "src-ag/PrintOcamlCode.ag" #-} error "pp of Decl.NewType not supported" {-# LINE 762 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Decl_Type #-} sem_Decl_Type :: (String) -> ([String]) -> T_Type -> T_Decl sem_Decl_Type !arg_name_ !arg_params_ arg_tp_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisToplevel _lhsIoptions) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIpp) = inv_Type_s50 _tpX50 (T_Type_vIn49 ) _lhsOpp :: PP_Doc _lhsOpp = rule45 _tpIpp arg_name_ arg_params_ !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule45 #-} {-# LINE 122 "src-ag/PrintOcamlCode.ag" #-} rule45 = \ ((_tpIpp) :: PP_Doc) name_ params_ -> {-# LINE 122 "src-ag/PrintOcamlCode.ag" #-} "type" >#< hv_sp (map (\p -> "'" >|< p) params_ ++ [text $ toOcamlTC name_]) >#< "=" >#< _tpIpp >#< ";;" {-# LINE 782 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Decl_TSig #-} sem_Decl_TSig :: (String) -> T_Type -> T_Decl sem_Decl_TSig !arg_name_ arg_tp_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisToplevel _lhsIoptions) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIpp) = inv_Type_s50 _tpX50 (T_Type_vIn49 ) _lhsOpp :: PP_Doc _lhsOpp = rule46 _tpIpp arg_name_ !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule46 #-} {-# LINE 123 "src-ag/PrintOcamlCode.ag" #-} rule46 = \ ((_tpIpp) :: PP_Doc) name_ -> {-# LINE 123 "src-ag/PrintOcamlCode.ag" #-} "(*" >#< name_ >#< ":" >#< _tpIpp >#< "*)" {-# LINE 802 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Decl_Comment #-} sem_Decl_Comment :: (String) -> T_Decl sem_Decl_Comment !arg_txt_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisToplevel _lhsIoptions) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule47 arg_txt_ !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule47 #-} {-# LINE 124 "src-ag/PrintOcamlCode.ag" #-} rule47 = \ txt_ -> {-# LINE 124 "src-ag/PrintOcamlCode.ag" #-} if '\n' `elem` txt_ then "(* " >-< vlist (lines txt_) >-< "*)" else "(*" >#< txt_ >#< "*)" {-# LINE 822 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Decl_PragmaDecl #-} sem_Decl_PragmaDecl :: (String) -> T_Decl sem_Decl_PragmaDecl _ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisToplevel _lhsIoptions) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule48 () !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule48 #-} {-# LINE 127 "src-ag/PrintOcamlCode.ag" #-} rule48 = \ (_ :: ()) -> {-# LINE 127 "src-ag/PrintOcamlCode.ag" #-} error "pp of Decl.PragmaDecl not supported" {-# LINE 840 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Decl_Resume #-} sem_Decl_Resume :: (Bool) -> (String) -> T_Lhs -> T_Expr -> T_Decl sem_Decl_Resume _ _ arg_left_ arg_rhs_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisToplevel _lhsIoptions) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOoptions) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule49 _rhsIpp _leftOoptions = rule50 _lhsIoptions _rhsOoptions = rule51 _lhsIoptions !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule49 #-} rule49 = \ ((_rhsIpp) :: PP_Doc) -> _rhsIpp {-# INLINE rule50 #-} rule50 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule51 #-} rule51 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Decl_EvalDecl #-} sem_Decl_EvalDecl :: (String) -> T_Lhs -> T_Expr -> T_Decl sem_Decl_EvalDecl _ arg_left_ arg_rhs_ = T_Decl (return st20) where {-# NOINLINE st20 #-} !st20 = let v19 :: T_Decl_v19 v19 = \ !(T_Decl_vIn19 _lhsIisToplevel _lhsIoptions) -> ( let _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOoptions) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule52 _rhsIpp _leftOoptions = rule53 _lhsIoptions _rhsOoptions = rule54 _lhsIoptions !__result_ = T_Decl_vOut19 _lhsOpp in __result_ ) in C_Decl_s20 v19 {-# INLINE rule52 #-} rule52 = \ ((_rhsIpp) :: PP_Doc) -> _rhsIpp {-# INLINE rule53 #-} rule53 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule54 #-} rule54 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- Decls ------------------------------------------------------- -- wrapper data Inh_Decls = Inh_Decls { isToplevel_Inh_Decls :: !(Bool), options_Inh_Decls :: !(Options) } data Syn_Decls = Syn_Decls { pps_Syn_Decls :: !(PP_Docs) } {-# INLINABLE wrap_Decls #-} wrap_Decls :: T_Decls -> Inh_Decls -> (Syn_Decls ) wrap_Decls !(T_Decls act) !(Inh_Decls _lhsIisToplevel _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg22 = T_Decls_vIn22 _lhsIisToplevel _lhsIoptions !(T_Decls_vOut22 _lhsOpps) <- return (inv_Decls_s23 sem arg22) return (Syn_Decls _lhsOpps) ) -- cata {-# NOINLINE sem_Decls #-} sem_Decls :: Decls -> T_Decls sem_Decls list = Prelude.foldr sem_Decls_Cons sem_Decls_Nil (Prelude.map sem_Decl list) -- semantic domain newtype T_Decls = T_Decls { attach_T_Decls :: Identity (T_Decls_s23 ) } newtype T_Decls_s23 = C_Decls_s23 { inv_Decls_s23 :: (T_Decls_v22 ) } data T_Decls_s24 = C_Decls_s24 type T_Decls_v22 = (T_Decls_vIn22 ) -> (T_Decls_vOut22 ) data T_Decls_vIn22 = T_Decls_vIn22 (Bool) (Options) data T_Decls_vOut22 = T_Decls_vOut22 (PP_Docs) {-# NOINLINE sem_Decls_Cons #-} sem_Decls_Cons :: T_Decl -> T_Decls -> T_Decls sem_Decls_Cons arg_hd_ arg_tl_ = T_Decls (return st23) where {-# NOINLINE st23 #-} !st23 = let v22 :: T_Decls_v22 v22 = \ !(T_Decls_vIn22 _lhsIisToplevel _lhsIoptions) -> ( let _hdX20 = Control.Monad.Identity.runIdentity (attach_T_Decl (arg_hd_)) _tlX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_tl_)) (T_Decl_vOut19 _hdIpp) = inv_Decl_s20 _hdX20 (T_Decl_vIn19 _hdOisToplevel _hdOoptions) (T_Decls_vOut22 _tlIpps) = inv_Decls_s23 _tlX23 (T_Decls_vIn22 _tlOisToplevel _tlOoptions) _lhsOpps :: PP_Docs _lhsOpps = rule55 _hdIpp _tlIpps _hdOisToplevel = rule56 _lhsIisToplevel _hdOoptions = rule57 _lhsIoptions _tlOisToplevel = rule58 _lhsIisToplevel _tlOoptions = rule59 _lhsIoptions !__result_ = T_Decls_vOut22 _lhsOpps in __result_ ) in C_Decls_s23 v22 {-# INLINE rule55 #-} {-# LINE 81 "src-ag/PrintOcamlCode.ag" #-} rule55 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 81 "src-ag/PrintOcamlCode.ag" #-} _hdIpp : _tlIpps {-# LINE 951 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule56 #-} rule56 = \ ((_lhsIisToplevel) :: Bool) -> _lhsIisToplevel {-# INLINE rule57 #-} rule57 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule58 #-} rule58 = \ ((_lhsIisToplevel) :: Bool) -> _lhsIisToplevel {-# INLINE rule59 #-} rule59 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Decls_Nil #-} sem_Decls_Nil :: T_Decls sem_Decls_Nil = T_Decls (return st23) where {-# NOINLINE st23 #-} !st23 = let v22 :: T_Decls_v22 v22 = \ !(T_Decls_vIn22 _lhsIisToplevel _lhsIoptions) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule60 () !__result_ = T_Decls_vOut22 _lhsOpps in __result_ ) in C_Decls_s23 v22 {-# INLINE rule60 #-} {-# LINE 82 "src-ag/PrintOcamlCode.ag" #-} rule60 = \ (_ :: ()) -> {-# LINE 82 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 981 "dist/build/PrintOcamlCode.hs"#-} -- Expr -------------------------------------------------------- -- wrapper data Inh_Expr = Inh_Expr { options_Inh_Expr :: !(Options) } data Syn_Expr = Syn_Expr { pp_Syn_Expr :: !(PP_Doc) } {-# INLINABLE wrap_Expr #-} wrap_Expr :: T_Expr -> Inh_Expr -> (Syn_Expr ) wrap_Expr !(T_Expr act) !(Inh_Expr _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg25 = T_Expr_vIn25 _lhsIoptions !(T_Expr_vOut25 _lhsOpp) <- return (inv_Expr_s26 sem arg25) return (Syn_Expr _lhsOpp) ) -- cata {-# NOINLINE sem_Expr #-} sem_Expr :: Expr -> T_Expr sem_Expr ( Let decls_ body_ ) = sem_Expr_Let ( sem_Decls decls_ ) ( sem_Expr body_ ) sem_Expr ( Case expr_ alts_ ) = sem_Expr_Case ( sem_Expr expr_ ) ( sem_CaseAlts alts_ ) sem_Expr ( Do stmts_ body_ ) = sem_Expr_Do ( sem_Decls stmts_ ) ( sem_Expr body_ ) sem_Expr ( Lambda args_ body_ ) = sem_Expr_Lambda ( sem_Exprs args_ ) ( sem_Expr body_ ) sem_Expr ( TupleExpr exprs_ ) = sem_Expr_TupleExpr ( sem_Exprs exprs_ ) sem_Expr ( UnboxedTupleExpr exprs_ ) = sem_Expr_UnboxedTupleExpr ( sem_Exprs exprs_ ) sem_Expr ( App !name_ args_ ) = sem_Expr_App name_ ( sem_Exprs args_ ) sem_Expr ( SimpleExpr !txt_ ) = sem_Expr_SimpleExpr txt_ sem_Expr ( TextExpr !lns_ ) = sem_Expr_TextExpr lns_ sem_Expr ( Trace !txt_ expr_ ) = sem_Expr_Trace txt_ ( sem_Expr expr_ ) sem_Expr ( PragmaExpr !onLeftSide_ !onNewLine_ !txt_ expr_ ) = sem_Expr_PragmaExpr onLeftSide_ onNewLine_ txt_ ( sem_Expr expr_ ) sem_Expr ( LineExpr expr_ ) = sem_Expr_LineExpr ( sem_Expr expr_ ) sem_Expr ( TypedExpr expr_ tp_ ) = sem_Expr_TypedExpr ( sem_Expr expr_ ) ( sem_Type tp_ ) sem_Expr ( ResultExpr !nt_ expr_ ) = sem_Expr_ResultExpr nt_ ( sem_Expr expr_ ) sem_Expr ( InvokeExpr !nt_ expr_ args_ ) = sem_Expr_InvokeExpr nt_ ( sem_Expr expr_ ) ( sem_Exprs args_ ) sem_Expr ( ResumeExpr !nt_ expr_ left_ rhs_ ) = sem_Expr_ResumeExpr nt_ ( sem_Expr expr_ ) ( sem_Lhs left_ ) ( sem_Expr rhs_ ) sem_Expr ( SemFun !nt_ args_ body_ ) = sem_Expr_SemFun nt_ ( sem_Exprs args_ ) ( sem_Expr body_ ) -- semantic domain newtype T_Expr = T_Expr { attach_T_Expr :: Identity (T_Expr_s26 ) } newtype T_Expr_s26 = C_Expr_s26 { inv_Expr_s26 :: (T_Expr_v25 ) } data T_Expr_s27 = C_Expr_s27 type T_Expr_v25 = (T_Expr_vIn25 ) -> (T_Expr_vOut25 ) data T_Expr_vIn25 = T_Expr_vIn25 (Options) data T_Expr_vOut25 = T_Expr_vOut25 (PP_Doc) {-# NOINLINE sem_Expr_Let #-} sem_Expr_Let :: T_Decls -> T_Expr -> T_Expr sem_Expr_Let arg_decls_ arg_body_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _declsX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_decls_)) _bodyX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_body_)) (T_Decls_vOut22 _declsIpps) = inv_Decls_s23 _declsX23 (T_Decls_vIn22 _declsOisToplevel _declsOoptions) (T_Expr_vOut25 _bodyIpp) = inv_Expr_s26 _bodyX26 (T_Expr_vIn25 _bodyOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule61 _bodyIpp _declsIpps _declsOisToplevel = rule62 () _declsOoptions = rule63 _lhsIoptions _bodyOoptions = rule64 _lhsIoptions !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule61 #-} {-# LINE 131 "src-ag/PrintOcamlCode.ag" #-} rule61 = \ ((_bodyIpp) :: PP_Doc) ((_declsIpps) :: PP_Docs) -> {-# LINE 131 "src-ag/PrintOcamlCode.ag" #-} pp_parens $ vlist (_declsIpps ++ [_bodyIpp]) {-# LINE 1053 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule62 #-} {-# LINE 220 "src-ag/PrintOcamlCode.ag" #-} rule62 = \ (_ :: ()) -> {-# LINE 220 "src-ag/PrintOcamlCode.ag" #-} False {-# LINE 1059 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule63 #-} rule63 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule64 #-} rule64 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Expr_Case #-} sem_Expr_Case :: T_Expr -> T_CaseAlts -> T_Expr sem_Expr_Case arg_expr_ arg_alts_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) _altsX5 = Control.Monad.Identity.runIdentity (attach_T_CaseAlts (arg_alts_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOoptions) (T_CaseAlts_vOut4 _altsIpps) = inv_CaseAlts_s5 _altsX5 (T_CaseAlts_vIn4 _altsOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule65 _altsIpps _exprIpp _exprOoptions = rule66 _lhsIoptions _altsOoptions = rule67 _lhsIoptions !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule65 #-} {-# LINE 132 "src-ag/PrintOcamlCode.ag" #-} rule65 = \ ((_altsIpps) :: PP_Docs) ((_exprIpp) :: PP_Doc) -> {-# LINE 132 "src-ag/PrintOcamlCode.ag" #-} pp_parens ( "match" >#< _exprIpp >#< "with" >-< indent 2 ( case _altsIpps of [] -> empty (x:xs) -> " " >#< x >-< vlist (map ("|" >#<) xs) ) ) {-# LINE 1095 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule66 #-} rule66 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule67 #-} rule67 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Expr_Do #-} sem_Expr_Do :: T_Decls -> T_Expr -> T_Expr sem_Expr_Do arg_stmts_ arg_body_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _stmtsX23 = Control.Monad.Identity.runIdentity (attach_T_Decls (arg_stmts_)) _bodyX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_body_)) (T_Decls_vOut22 _stmtsIpps) = inv_Decls_s23 _stmtsX23 (T_Decls_vIn22 _stmtsOisToplevel _stmtsOoptions) (T_Expr_vOut25 _bodyIpp) = inv_Expr_s26 _bodyX26 (T_Expr_vIn25 _bodyOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule68 () _stmtsOisToplevel = rule69 () _stmtsOoptions = rule70 _lhsIoptions _bodyOoptions = rule71 _lhsIoptions !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule68 #-} {-# LINE 139 "src-ag/PrintOcamlCode.ag" #-} rule68 = \ (_ :: ()) -> {-# LINE 139 "src-ag/PrintOcamlCode.ag" #-} error "pp of Expr.Do not supported" {-# LINE 1126 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule69 #-} {-# LINE 222 "src-ag/PrintOcamlCode.ag" #-} rule69 = \ (_ :: ()) -> {-# LINE 222 "src-ag/PrintOcamlCode.ag" #-} False {-# LINE 1132 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule70 #-} rule70 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule71 #-} rule71 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Expr_Lambda #-} sem_Expr_Lambda :: T_Exprs -> T_Expr -> T_Expr sem_Expr_Lambda arg_args_ arg_body_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _argsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_args_)) _bodyX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_body_)) (T_Exprs_vOut28 _argsIpps) = inv_Exprs_s29 _argsX29 (T_Exprs_vIn28 _argsOoptions) (T_Expr_vOut25 _bodyIpp) = inv_Expr_s26 _bodyX26 (T_Expr_vIn25 _bodyOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule72 _argsIpps _bodyIpp _argsOoptions = rule73 _lhsIoptions _bodyOoptions = rule74 _lhsIoptions !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule72 #-} {-# LINE 140 "src-ag/PrintOcamlCode.ag" #-} rule72 = \ ((_argsIpps) :: PP_Docs) ((_bodyIpp) :: PP_Doc) -> {-# LINE 140 "src-ag/PrintOcamlCode.ag" #-} pp_parens ( pp "fun" >#< hv_sp _argsIpps >#< "->" >-< indent 2 _bodyIpp ) {-# LINE 1163 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule73 #-} rule73 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule74 #-} rule74 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Expr_TupleExpr #-} sem_Expr_TupleExpr :: T_Exprs -> T_Expr sem_Expr_TupleExpr arg_exprs_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _exprsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_exprs_)) (T_Exprs_vOut28 _exprsIpps) = inv_Exprs_s29 _exprsX29 (T_Exprs_vIn28 _exprsOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule75 _exprsIpps _exprsOoptions = rule76 _lhsIoptions !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule75 #-} {-# LINE 142 "src-ag/PrintOcamlCode.ag" #-} rule75 = \ ((_exprsIpps) :: PP_Docs) -> {-# LINE 142 "src-ag/PrintOcamlCode.ag" #-} ppTuple False _exprsIpps {-# LINE 1190 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule76 #-} rule76 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Expr_UnboxedTupleExpr #-} sem_Expr_UnboxedTupleExpr :: T_Exprs -> T_Expr sem_Expr_UnboxedTupleExpr arg_exprs_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _exprsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_exprs_)) (T_Exprs_vOut28 _exprsIpps) = inv_Exprs_s29 _exprsX29 (T_Exprs_vIn28 _exprsOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule77 () _exprsOoptions = rule78 _lhsIoptions !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule77 #-} {-# LINE 143 "src-ag/PrintOcamlCode.ag" #-} rule77 = \ (_ :: ()) -> {-# LINE 143 "src-ag/PrintOcamlCode.ag" #-} error "pp of Expr.UnboxedTupleExpr not supported" {-# LINE 1214 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule78 #-} rule78 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Expr_App #-} sem_Expr_App :: (String) -> T_Exprs -> T_Expr sem_Expr_App !arg_name_ arg_args_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _argsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_args_)) (T_Exprs_vOut28 _argsIpps) = inv_Exprs_s29 _argsX29 (T_Exprs_vIn28 _argsOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule79 _argsIpps arg_name_ _argsOoptions = rule80 _lhsIoptions !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule79 #-} {-# LINE 144 "src-ag/PrintOcamlCode.ag" #-} rule79 = \ ((_argsIpps) :: PP_Docs) name_ -> {-# LINE 144 "src-ag/PrintOcamlCode.ag" #-} pp_parens $ name_ >#< hv_sp _argsIpps {-# LINE 1238 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule80 #-} rule80 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Expr_SimpleExpr #-} sem_Expr_SimpleExpr :: (String) -> T_Expr sem_Expr_SimpleExpr !arg_txt_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule81 arg_txt_ !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule81 #-} {-# LINE 145 "src-ag/PrintOcamlCode.ag" #-} rule81 = \ txt_ -> {-# LINE 145 "src-ag/PrintOcamlCode.ag" #-} text txt_ {-# LINE 1259 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Expr_TextExpr #-} sem_Expr_TextExpr :: ([String]) -> T_Expr sem_Expr_TextExpr !arg_lns_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule82 arg_lns_ !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule82 #-} {-# LINE 146 "src-ag/PrintOcamlCode.ag" #-} rule82 = \ lns_ -> {-# LINE 146 "src-ag/PrintOcamlCode.ag" #-} vlist (map text lns_) {-# LINE 1277 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Expr_Trace #-} sem_Expr_Trace :: (String) -> T_Expr -> T_Expr sem_Expr_Trace _ arg_expr_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule83 _exprIpp _exprOoptions = rule84 _lhsIoptions !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule83 #-} {-# LINE 147 "src-ag/PrintOcamlCode.ag" #-} rule83 = \ ((_exprIpp) :: PP_Doc) -> {-# LINE 147 "src-ag/PrintOcamlCode.ag" #-} _exprIpp {-# LINE 1298 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule84 #-} rule84 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Expr_PragmaExpr #-} sem_Expr_PragmaExpr :: (Bool) -> (Bool) -> (String) -> T_Expr -> T_Expr sem_Expr_PragmaExpr _ _ _ arg_expr_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule85 _exprIpp _exprOoptions = rule86 _lhsIoptions !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule85 #-} {-# LINE 148 "src-ag/PrintOcamlCode.ag" #-} rule85 = \ ((_exprIpp) :: PP_Doc) -> {-# LINE 148 "src-ag/PrintOcamlCode.ag" #-} _exprIpp {-# LINE 1322 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule86 #-} rule86 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Expr_LineExpr #-} sem_Expr_LineExpr :: T_Expr -> T_Expr sem_Expr_LineExpr arg_expr_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule87 _exprIpp _exprOoptions = rule88 _lhsIoptions !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule87 #-} {-# LINE 149 "src-ag/PrintOcamlCode.ag" #-} rule87 = \ ((_exprIpp) :: PP_Doc) -> {-# LINE 149 "src-ag/PrintOcamlCode.ag" #-} _exprIpp {-# LINE 1346 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule88 #-} rule88 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Expr_TypedExpr #-} sem_Expr_TypedExpr :: T_Expr -> T_Type -> T_Expr sem_Expr_TypedExpr arg_expr_ arg_tp_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOoptions) (T_Type_vOut49 _tpIpp) = inv_Type_s50 _tpX50 (T_Type_vIn49 ) _lhsOpp :: PP_Doc _lhsOpp = rule89 _exprIpp _exprOoptions = rule90 _lhsIoptions !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule89 #-} {-# LINE 150 "src-ag/PrintOcamlCode.ag" #-} rule89 = \ ((_exprIpp) :: PP_Doc) -> {-# LINE 150 "src-ag/PrintOcamlCode.ag" #-} _exprIpp {-# LINE 1372 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule90 #-} rule90 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Expr_ResultExpr #-} sem_Expr_ResultExpr :: (String) -> T_Expr -> T_Expr sem_Expr_ResultExpr _ arg_expr_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule91 _exprIpp _exprOoptions = rule92 _lhsIoptions !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule91 #-} rule91 = \ ((_exprIpp) :: PP_Doc) -> _exprIpp {-# INLINE rule92 #-} rule92 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Expr_InvokeExpr #-} sem_Expr_InvokeExpr :: (String) -> T_Expr -> T_Exprs -> T_Expr sem_Expr_InvokeExpr _ arg_expr_ arg_args_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) _argsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_args_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOoptions) (T_Exprs_vOut28 _argsIpps) = inv_Exprs_s29 _argsX29 (T_Exprs_vIn28 _argsOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule93 _exprIpp _exprOoptions = rule94 _lhsIoptions _argsOoptions = rule95 _lhsIoptions !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule93 #-} rule93 = \ ((_exprIpp) :: PP_Doc) -> _exprIpp {-# INLINE rule94 #-} rule94 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule95 #-} rule95 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Expr_ResumeExpr #-} sem_Expr_ResumeExpr :: (String) -> T_Expr -> T_Lhs -> T_Expr -> T_Expr sem_Expr_ResumeExpr _ arg_expr_ arg_left_ arg_rhs_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _exprX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_expr_)) _leftX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_left_)) _rhsX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_rhs_)) (T_Expr_vOut25 _exprIpp) = inv_Expr_s26 _exprX26 (T_Expr_vIn25 _exprOoptions) (T_Lhs_vOut31 _leftIpp) = inv_Lhs_s32 _leftX32 (T_Lhs_vIn31 _leftOoptions) (T_Expr_vOut25 _rhsIpp) = inv_Expr_s26 _rhsX26 (T_Expr_vIn25 _rhsOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule96 _rhsIpp _exprOoptions = rule97 _lhsIoptions _leftOoptions = rule98 _lhsIoptions _rhsOoptions = rule99 _lhsIoptions !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule96 #-} rule96 = \ ((_rhsIpp) :: PP_Doc) -> _rhsIpp {-# INLINE rule97 #-} rule97 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule98 #-} rule98 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule99 #-} rule99 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Expr_SemFun #-} sem_Expr_SemFun :: (String) -> T_Exprs -> T_Expr -> T_Expr sem_Expr_SemFun _ arg_args_ arg_body_ = T_Expr (return st26) where {-# NOINLINE st26 #-} !st26 = let v25 :: T_Expr_v25 v25 = \ !(T_Expr_vIn25 _lhsIoptions) -> ( let _argsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_args_)) _bodyX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_body_)) (T_Exprs_vOut28 _argsIpps) = inv_Exprs_s29 _argsX29 (T_Exprs_vIn28 _argsOoptions) (T_Expr_vOut25 _bodyIpp) = inv_Expr_s26 _bodyX26 (T_Expr_vIn25 _bodyOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule100 _bodyIpp _argsOoptions = rule101 _lhsIoptions _bodyOoptions = rule102 _lhsIoptions !__result_ = T_Expr_vOut25 _lhsOpp in __result_ ) in C_Expr_s26 v25 {-# INLINE rule100 #-} rule100 = \ ((_bodyIpp) :: PP_Doc) -> _bodyIpp {-# INLINE rule101 #-} rule101 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule102 #-} rule102 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- Exprs ------------------------------------------------------- -- wrapper data Inh_Exprs = Inh_Exprs { options_Inh_Exprs :: !(Options) } data Syn_Exprs = Syn_Exprs { pps_Syn_Exprs :: !(PP_Docs) } {-# INLINABLE wrap_Exprs #-} wrap_Exprs :: T_Exprs -> Inh_Exprs -> (Syn_Exprs ) wrap_Exprs !(T_Exprs act) !(Inh_Exprs _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg28 = T_Exprs_vIn28 _lhsIoptions !(T_Exprs_vOut28 _lhsOpps) <- return (inv_Exprs_s29 sem arg28) return (Syn_Exprs _lhsOpps) ) -- cata {-# NOINLINE sem_Exprs #-} sem_Exprs :: Exprs -> T_Exprs sem_Exprs list = Prelude.foldr sem_Exprs_Cons sem_Exprs_Nil (Prelude.map sem_Expr list) -- semantic domain newtype T_Exprs = T_Exprs { attach_T_Exprs :: Identity (T_Exprs_s29 ) } newtype T_Exprs_s29 = C_Exprs_s29 { inv_Exprs_s29 :: (T_Exprs_v28 ) } data T_Exprs_s30 = C_Exprs_s30 type T_Exprs_v28 = (T_Exprs_vIn28 ) -> (T_Exprs_vOut28 ) data T_Exprs_vIn28 = T_Exprs_vIn28 (Options) data T_Exprs_vOut28 = T_Exprs_vOut28 (PP_Docs) {-# NOINLINE sem_Exprs_Cons #-} sem_Exprs_Cons :: T_Expr -> T_Exprs -> T_Exprs sem_Exprs_Cons arg_hd_ arg_tl_ = T_Exprs (return st29) where {-# NOINLINE st29 #-} !st29 = let v28 :: T_Exprs_v28 v28 = \ !(T_Exprs_vIn28 _lhsIoptions) -> ( let _hdX26 = Control.Monad.Identity.runIdentity (attach_T_Expr (arg_hd_)) _tlX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_tl_)) (T_Expr_vOut25 _hdIpp) = inv_Expr_s26 _hdX26 (T_Expr_vIn25 _hdOoptions) (T_Exprs_vOut28 _tlIpps) = inv_Exprs_s29 _tlX29 (T_Exprs_vIn28 _tlOoptions) _lhsOpps :: PP_Docs _lhsOpps = rule103 _hdIpp _tlIpps _hdOoptions = rule104 _lhsIoptions _tlOoptions = rule105 _lhsIoptions !__result_ = T_Exprs_vOut28 _lhsOpps in __result_ ) in C_Exprs_s29 v28 {-# INLINE rule103 #-} {-# LINE 61 "src-ag/PrintOcamlCode.ag" #-} rule103 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 61 "src-ag/PrintOcamlCode.ag" #-} _hdIpp : _tlIpps {-# LINE 1538 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule104 #-} rule104 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule105 #-} rule105 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Exprs_Nil #-} sem_Exprs_Nil :: T_Exprs sem_Exprs_Nil = T_Exprs (return st29) where {-# NOINLINE st29 #-} !st29 = let v28 :: T_Exprs_v28 v28 = \ !(T_Exprs_vIn28 _lhsIoptions) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule106 () !__result_ = T_Exprs_vOut28 _lhsOpps in __result_ ) in C_Exprs_s29 v28 {-# INLINE rule106 #-} {-# LINE 62 "src-ag/PrintOcamlCode.ag" #-} rule106 = \ (_ :: ()) -> {-# LINE 62 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 1562 "dist/build/PrintOcamlCode.hs"#-} -- Lhs --------------------------------------------------------- -- wrapper data Inh_Lhs = Inh_Lhs { options_Inh_Lhs :: !(Options) } data Syn_Lhs = Syn_Lhs { pp_Syn_Lhs :: !(PP_Doc) } {-# INLINABLE wrap_Lhs #-} wrap_Lhs :: T_Lhs -> Inh_Lhs -> (Syn_Lhs ) wrap_Lhs !(T_Lhs act) !(Inh_Lhs _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg31 = T_Lhs_vIn31 _lhsIoptions !(T_Lhs_vOut31 _lhsOpp) <- return (inv_Lhs_s32 sem arg31) return (Syn_Lhs _lhsOpp) ) -- cata {-# NOINLINE sem_Lhs #-} sem_Lhs :: Lhs -> T_Lhs sem_Lhs ( Pattern3 pat3_ ) = sem_Lhs_Pattern3 ( sem_Pattern pat3_ ) sem_Lhs ( Pattern3SM pat3_ ) = sem_Lhs_Pattern3SM ( sem_Pattern pat3_ ) sem_Lhs ( TupleLhs !comps_ ) = sem_Lhs_TupleLhs comps_ sem_Lhs ( UnboxedTupleLhs !comps_ ) = sem_Lhs_UnboxedTupleLhs comps_ sem_Lhs ( Fun !name_ args_ ) = sem_Lhs_Fun name_ ( sem_Exprs args_ ) sem_Lhs ( Unwrap !name_ sub_ ) = sem_Lhs_Unwrap name_ ( sem_Lhs sub_ ) -- semantic domain newtype T_Lhs = T_Lhs { attach_T_Lhs :: Identity (T_Lhs_s32 ) } newtype T_Lhs_s32 = C_Lhs_s32 { inv_Lhs_s32 :: (T_Lhs_v31 ) } data T_Lhs_s33 = C_Lhs_s33 type T_Lhs_v31 = (T_Lhs_vIn31 ) -> (T_Lhs_vOut31 ) data T_Lhs_vIn31 = T_Lhs_vIn31 (Options) data T_Lhs_vOut31 = T_Lhs_vOut31 (PP_Doc) {-# NOINLINE sem_Lhs_Pattern3 #-} sem_Lhs_Pattern3 :: T_Pattern -> T_Lhs sem_Lhs_Pattern3 arg_pat3_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIoptions) -> ( let _pat3X41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat3_)) (T_Pattern_vOut40 _pat3Icopy _pat3IisUnderscore _pat3Ipp) = inv_Pattern_s41 _pat3X41 (T_Pattern_vIn40 _pat3Ooptions) _lhsOpp :: PP_Doc _lhsOpp = rule107 _pat3Ipp _pat3Ooptions = rule108 _lhsIoptions !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule107 #-} {-# LINE 153 "src-ag/PrintOcamlCode.ag" #-} rule107 = \ ((_pat3Ipp) :: PP_Doc) -> {-# LINE 153 "src-ag/PrintOcamlCode.ag" #-} _pat3Ipp {-# LINE 1619 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule108 #-} rule108 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Lhs_Pattern3SM #-} sem_Lhs_Pattern3SM :: T_Pattern -> T_Lhs sem_Lhs_Pattern3SM arg_pat3_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIoptions) -> ( let _pat3X41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat3_)) (T_Pattern_vOut40 _pat3Icopy _pat3IisUnderscore _pat3Ipp) = inv_Pattern_s41 _pat3X41 (T_Pattern_vIn40 _pat3Ooptions) _lhsOpp :: PP_Doc _lhsOpp = rule109 () _pat3Ooptions = rule110 _lhsIoptions !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule109 #-} {-# LINE 154 "src-ag/PrintOcamlCode.ag" #-} rule109 = \ (_ :: ()) -> {-# LINE 154 "src-ag/PrintOcamlCode.ag" #-} error "pp of Lhs.Pattern3SM not supported" {-# LINE 1643 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule110 #-} rule110 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Lhs_TupleLhs #-} sem_Lhs_TupleLhs :: ([String]) -> T_Lhs sem_Lhs_TupleLhs !arg_comps_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIoptions) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule111 arg_comps_ !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule111 #-} {-# LINE 155 "src-ag/PrintOcamlCode.ag" #-} rule111 = \ comps_ -> {-# LINE 155 "src-ag/PrintOcamlCode.ag" #-} ppTuple False (map text comps_) {-# LINE 1664 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Lhs_UnboxedTupleLhs #-} sem_Lhs_UnboxedTupleLhs :: ([String]) -> T_Lhs sem_Lhs_UnboxedTupleLhs _ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIoptions) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule112 () !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule112 #-} {-# LINE 156 "src-ag/PrintOcamlCode.ag" #-} rule112 = \ (_ :: ()) -> {-# LINE 156 "src-ag/PrintOcamlCode.ag" #-} error "pp of Lhs.UnboxedTupleLhs not supported" {-# LINE 1682 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Lhs_Fun #-} sem_Lhs_Fun :: (String) -> T_Exprs -> T_Lhs sem_Lhs_Fun !arg_name_ arg_args_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIoptions) -> ( let _argsX29 = Control.Monad.Identity.runIdentity (attach_T_Exprs (arg_args_)) (T_Exprs_vOut28 _argsIpps) = inv_Exprs_s29 _argsX29 (T_Exprs_vIn28 _argsOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule113 _argsIpps arg_name_ _argsOoptions = rule114 _lhsIoptions !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule113 #-} {-# LINE 157 "src-ag/PrintOcamlCode.ag" #-} rule113 = \ ((_argsIpps) :: PP_Docs) name_ -> {-# LINE 157 "src-ag/PrintOcamlCode.ag" #-} name_ >#< hv_sp _argsIpps {-# LINE 1703 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule114 #-} rule114 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Lhs_Unwrap #-} sem_Lhs_Unwrap :: (String) -> T_Lhs -> T_Lhs sem_Lhs_Unwrap !arg_name_ arg_sub_ = T_Lhs (return st32) where {-# NOINLINE st32 #-} !st32 = let v31 :: T_Lhs_v31 v31 = \ !(T_Lhs_vIn31 _lhsIoptions) -> ( let _subX32 = Control.Monad.Identity.runIdentity (attach_T_Lhs (arg_sub_)) (T_Lhs_vOut31 _subIpp) = inv_Lhs_s32 _subX32 (T_Lhs_vIn31 _subOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule115 _subIpp arg_name_ _subOoptions = rule116 _lhsIoptions !__result_ = T_Lhs_vOut31 _lhsOpp in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule115 #-} {-# LINE 158 "src-ag/PrintOcamlCode.ag" #-} rule115 = \ ((_subIpp) :: PP_Doc) name_ -> {-# LINE 158 "src-ag/PrintOcamlCode.ag" #-} pp_parens (name_ >#< _subIpp) {-# LINE 1727 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule116 #-} rule116 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- NamedType --------------------------------------------------- -- wrapper data Inh_NamedType = Inh_NamedType { } data Syn_NamedType = Syn_NamedType { pp_Syn_NamedType :: !(PP_Doc) } {-# INLINABLE wrap_NamedType #-} wrap_NamedType :: T_NamedType -> Inh_NamedType -> (Syn_NamedType ) wrap_NamedType !(T_NamedType act) !(Inh_NamedType ) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg34 = T_NamedType_vIn34 !(T_NamedType_vOut34 _lhsOpp) <- return (inv_NamedType_s35 sem arg34) return (Syn_NamedType _lhsOpp) ) -- cata {-# INLINE sem_NamedType #-} sem_NamedType :: NamedType -> T_NamedType sem_NamedType ( Named !strict_ !name_ tp_ ) = sem_NamedType_Named strict_ name_ ( sem_Type tp_ ) -- semantic domain newtype T_NamedType = T_NamedType { attach_T_NamedType :: Identity (T_NamedType_s35 ) } newtype T_NamedType_s35 = C_NamedType_s35 { inv_NamedType_s35 :: (T_NamedType_v34 ) } data T_NamedType_s36 = C_NamedType_s36 type T_NamedType_v34 = (T_NamedType_vIn34 ) -> (T_NamedType_vOut34 ) data T_NamedType_vIn34 = T_NamedType_vIn34 data T_NamedType_vOut34 = T_NamedType_vOut34 (PP_Doc) {-# NOINLINE sem_NamedType_Named #-} sem_NamedType_Named :: (Bool) -> (String) -> T_Type -> T_NamedType sem_NamedType_Named _ !arg_name_ arg_tp_ = T_NamedType (return st35) where {-# NOINLINE st35 #-} !st35 = let v34 :: T_NamedType_v34 v34 = \ !(T_NamedType_vIn34 ) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIpp) = inv_Type_s50 _tpX50 (T_Type_vIn49 ) _lhsOpp :: PP_Doc _lhsOpp = rule117 _tpIpp arg_name_ !__result_ = T_NamedType_vOut34 _lhsOpp in __result_ ) in C_NamedType_s35 v34 {-# INLINE rule117 #-} {-# LINE 191 "src-ag/PrintOcamlCode.ag" #-} rule117 = \ ((_tpIpp) :: PP_Doc) name_ -> {-# LINE 191 "src-ag/PrintOcamlCode.ag" #-} name_ >#< ":" >#< _tpIpp {-# LINE 1781 "dist/build/PrintOcamlCode.hs"#-} -- NamedTypes -------------------------------------------------- -- wrapper data Inh_NamedTypes = Inh_NamedTypes { } data Syn_NamedTypes = Syn_NamedTypes { pps_Syn_NamedTypes :: !(PP_Docs) } {-# INLINABLE wrap_NamedTypes #-} wrap_NamedTypes :: T_NamedTypes -> Inh_NamedTypes -> (Syn_NamedTypes ) wrap_NamedTypes !(T_NamedTypes act) !(Inh_NamedTypes ) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg37 = T_NamedTypes_vIn37 !(T_NamedTypes_vOut37 _lhsOpps) <- return (inv_NamedTypes_s38 sem arg37) return (Syn_NamedTypes _lhsOpps) ) -- cata {-# NOINLINE sem_NamedTypes #-} sem_NamedTypes :: NamedTypes -> T_NamedTypes sem_NamedTypes list = Prelude.foldr sem_NamedTypes_Cons sem_NamedTypes_Nil (Prelude.map sem_NamedType list) -- semantic domain newtype T_NamedTypes = T_NamedTypes { attach_T_NamedTypes :: Identity (T_NamedTypes_s38 ) } newtype T_NamedTypes_s38 = C_NamedTypes_s38 { inv_NamedTypes_s38 :: (T_NamedTypes_v37 ) } data T_NamedTypes_s39 = C_NamedTypes_s39 type T_NamedTypes_v37 = (T_NamedTypes_vIn37 ) -> (T_NamedTypes_vOut37 ) data T_NamedTypes_vIn37 = T_NamedTypes_vIn37 data T_NamedTypes_vOut37 = T_NamedTypes_vOut37 (PP_Docs) {-# NOINLINE sem_NamedTypes_Cons #-} sem_NamedTypes_Cons :: T_NamedType -> T_NamedTypes -> T_NamedTypes sem_NamedTypes_Cons arg_hd_ arg_tl_ = T_NamedTypes (return st38) where {-# NOINLINE st38 #-} !st38 = let v37 :: T_NamedTypes_v37 v37 = \ !(T_NamedTypes_vIn37 ) -> ( let _hdX35 = Control.Monad.Identity.runIdentity (attach_T_NamedType (arg_hd_)) _tlX38 = Control.Monad.Identity.runIdentity (attach_T_NamedTypes (arg_tl_)) (T_NamedType_vOut34 _hdIpp) = inv_NamedType_s35 _hdX35 (T_NamedType_vIn34 ) (T_NamedTypes_vOut37 _tlIpps) = inv_NamedTypes_s38 _tlX38 (T_NamedTypes_vIn37 ) _lhsOpps :: PP_Docs _lhsOpps = rule118 _hdIpp _tlIpps !__result_ = T_NamedTypes_vOut37 _lhsOpps in __result_ ) in C_NamedTypes_s38 v37 {-# INLINE rule118 #-} {-# LINE 77 "src-ag/PrintOcamlCode.ag" #-} rule118 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 77 "src-ag/PrintOcamlCode.ag" #-} _hdIpp : _tlIpps {-# LINE 1834 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_NamedTypes_Nil #-} sem_NamedTypes_Nil :: T_NamedTypes sem_NamedTypes_Nil = T_NamedTypes (return st38) where {-# NOINLINE st38 #-} !st38 = let v37 :: T_NamedTypes_v37 v37 = \ !(T_NamedTypes_vIn37 ) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule119 () !__result_ = T_NamedTypes_vOut37 _lhsOpps in __result_ ) in C_NamedTypes_s38 v37 {-# INLINE rule119 #-} {-# LINE 78 "src-ag/PrintOcamlCode.ag" #-} rule119 = \ (_ :: ()) -> {-# LINE 78 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 1852 "dist/build/PrintOcamlCode.hs"#-} -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { options_Inh_Pattern :: !(Options) } data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: !(Pattern), isUnderscore_Syn_Pattern :: !(Bool), pp_Syn_Pattern :: !(PP_Doc) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern !(T_Pattern act) !(Inh_Pattern _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg40 = T_Pattern_vIn40 _lhsIoptions !(T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp) <- return (inv_Pattern_s41 sem arg40) return (Syn_Pattern _lhsOcopy _lhsOisUnderscore _lhsOpp) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr !name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product !pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias !field_ !attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore !pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s41 ) } newtype T_Pattern_s41 = C_Pattern_s41 { inv_Pattern_s41 :: (T_Pattern_v40 ) } data T_Pattern_s42 = C_Pattern_s42 type T_Pattern_v40 = (T_Pattern_vIn40 ) -> (T_Pattern_vOut40 ) data T_Pattern_vIn40 = T_Pattern_vIn40 (Options) data T_Pattern_vOut40 = T_Pattern_vOut40 (Pattern) (Bool) (PP_Doc) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr !arg_name_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} !st41 = let v40 :: T_Pattern_v40 v40 = \ !(T_Pattern_vIn40 _lhsIoptions) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIcopy _patsIpps) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 _patsOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule120 _patsIpps arg_name_ _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule121 () _copy = rule122 _patsIcopy arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule123 _copy _patsOoptions = rule124 _lhsIoptions !__result_ = T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule120 #-} {-# LINE 194 "src-ag/PrintOcamlCode.ag" #-} rule120 = \ ((_patsIpps) :: PP_Docs) name_ -> {-# LINE 194 "src-ag/PrintOcamlCode.ag" #-} pp_parens $ name_ >#< hv_sp _patsIpps {-# LINE 1913 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule121 #-} {-# LINE 204 "src-ag/PrintOcamlCode.ag" #-} rule121 = \ (_ :: ()) -> {-# LINE 204 "src-ag/PrintOcamlCode.ag" #-} False {-# LINE 1919 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule122 #-} rule122 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule123 #-} rule123 = \ _copy -> _copy {-# INLINE rule124 #-} rule124 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product !arg_pos_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} !st41 = let v40 :: T_Pattern_v40 v40 = \ !(T_Pattern_vIn40 _lhsIoptions) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIcopy _patsIpps) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 _patsOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule125 _patsIpps _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule126 () _copy = rule127 _patsIcopy arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule128 _copy _patsOoptions = rule129 _lhsIoptions !__result_ = T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule125 #-} {-# LINE 195 "src-ag/PrintOcamlCode.ag" #-} rule125 = \ ((_patsIpps) :: PP_Docs) -> {-# LINE 195 "src-ag/PrintOcamlCode.ag" #-} pp_block "(" ")" "," _patsIpps {-# LINE 1954 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule126 #-} {-# LINE 205 "src-ag/PrintOcamlCode.ag" #-} rule126 = \ (_ :: ()) -> {-# LINE 205 "src-ag/PrintOcamlCode.ag" #-} False {-# LINE 1960 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule127 #-} rule127 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule128 #-} rule128 = \ _copy -> _copy {-# INLINE rule129 #-} rule129 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias !arg_field_ !arg_attr_ arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} !st41 = let v40 :: T_Pattern_v40 v40 = \ !(T_Pattern_vIn40 _lhsIoptions) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIcopy _patIisUnderscore _patIpp) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 _patOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule130 _lhsIoptions _patIisUnderscore arg_attr_ arg_field_ _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule131 () _copy = rule132 _patIcopy arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule133 _copy _patOoptions = rule134 _lhsIoptions !__result_ = T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule130 #-} {-# LINE 197 "src-ag/PrintOcamlCode.ag" #-} rule130 = \ ((_lhsIoptions) :: Options) ((_patIisUnderscore) :: Bool) attr_ field_ -> {-# LINE 197 "src-ag/PrintOcamlCode.ag" #-} if _patIisUnderscore then pp (attrname _lhsIoptions False field_ attr_) else error "pp of Pattern.Alias is only supported in the form (x@_)" {-# LINE 1997 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule131 #-} {-# LINE 206 "src-ag/PrintOcamlCode.ag" #-} rule131 = \ (_ :: ()) -> {-# LINE 206 "src-ag/PrintOcamlCode.ag" #-} False {-# LINE 2003 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule132 #-} rule132 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule133 #-} rule133 = \ _copy -> _copy {-# INLINE rule134 #-} rule134 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} !st41 = let v40 :: T_Pattern_v40 v40 = \ !(T_Pattern_vIn40 _lhsIoptions) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIcopy _patIisUnderscore _patIpp) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 _patOoptions) _lhsOpp :: PP_Doc _lhsOpp = rule135 () _copy = rule136 _patIcopy _lhsOcopy :: Pattern _lhsOcopy = rule137 _copy _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule138 _patIisUnderscore _patOoptions = rule139 _lhsIoptions !__result_ = T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule135 #-} {-# LINE 200 "src-ag/PrintOcamlCode.ag" #-} rule135 = \ (_ :: ()) -> {-# LINE 200 "src-ag/PrintOcamlCode.ag" #-} error "pp of Pattern.Irrefutable not supported" {-# LINE 2038 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule136 #-} rule136 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule137 #-} rule137 = \ _copy -> _copy {-# INLINE rule138 #-} rule138 = \ ((_patIisUnderscore) :: Bool) -> _patIisUnderscore {-# INLINE rule139 #-} rule139 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore !arg_pos_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} !st41 = let v40 :: T_Pattern_v40 v40 = \ !(T_Pattern_vIn40 _lhsIoptions) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule140 () _lhsOisUnderscore :: Bool _lhsOisUnderscore = rule141 () _copy = rule142 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule143 _copy !__result_ = T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule140 #-} {-# LINE 201 "src-ag/PrintOcamlCode.ag" #-} rule140 = \ (_ :: ()) -> {-# LINE 201 "src-ag/PrintOcamlCode.ag" #-} text "_" {-# LINE 2073 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule141 #-} {-# LINE 207 "src-ag/PrintOcamlCode.ag" #-} rule141 = \ (_ :: ()) -> {-# LINE 207 "src-ag/PrintOcamlCode.ag" #-} True {-# LINE 2079 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule142 #-} rule142 = \ pos_ -> Underscore pos_ {-# INLINE rule143 #-} rule143 = \ _copy -> _copy -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { options_Inh_Patterns :: !(Options) } data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: !(Patterns), pps_Syn_Patterns :: !(PP_Docs) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns !(T_Patterns act) !(Inh_Patterns _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg43 = T_Patterns_vIn43 _lhsIoptions !(T_Patterns_vOut43 _lhsOcopy _lhsOpps) <- return (inv_Patterns_s44 sem arg43) return (Syn_Patterns _lhsOcopy _lhsOpps) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s44 ) } newtype T_Patterns_s44 = C_Patterns_s44 { inv_Patterns_s44 :: (T_Patterns_v43 ) } data T_Patterns_s45 = C_Patterns_s45 type T_Patterns_v43 = (T_Patterns_vIn43 ) -> (T_Patterns_vOut43 ) data T_Patterns_vIn43 = T_Patterns_vIn43 (Options) data T_Patterns_vOut43 = T_Patterns_vOut43 (Patterns) (PP_Docs) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st44) where {-# NOINLINE st44 #-} !st44 = let v43 :: T_Patterns_v43 v43 = \ !(T_Patterns_vIn43 _lhsIoptions) -> ( let _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut40 _hdIcopy _hdIisUnderscore _hdIpp) = inv_Pattern_s41 _hdX41 (T_Pattern_vIn40 _hdOoptions) (T_Patterns_vOut43 _tlIcopy _tlIpps) = inv_Patterns_s44 _tlX44 (T_Patterns_vIn43 _tlOoptions) _lhsOpps :: PP_Docs _lhsOpps = rule144 _hdIpp _tlIpps _copy = rule145 _hdIcopy _tlIcopy _lhsOcopy :: Patterns _lhsOcopy = rule146 _copy _hdOoptions = rule147 _lhsIoptions _tlOoptions = rule148 _lhsIoptions !__result_ = T_Patterns_vOut43 _lhsOcopy _lhsOpps in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule144 #-} {-# LINE 89 "src-ag/PrintOcamlCode.ag" #-} rule144 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 89 "src-ag/PrintOcamlCode.ag" #-} _hdIpp : _tlIpps {-# LINE 2143 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule145 #-} rule145 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule146 #-} rule146 = \ _copy -> _copy {-# INLINE rule147 #-} rule147 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule148 #-} rule148 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st44) where {-# NOINLINE st44 #-} !st44 = let v43 :: T_Patterns_v43 v43 = \ !(T_Patterns_vIn43 _lhsIoptions) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule149 () _copy = rule150 () _lhsOcopy :: Patterns _lhsOcopy = rule151 _copy !__result_ = T_Patterns_vOut43 _lhsOcopy _lhsOpps in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule149 #-} {-# LINE 90 "src-ag/PrintOcamlCode.ag" #-} rule149 = \ (_ :: ()) -> {-# LINE 90 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 2176 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule150 #-} rule150 = \ (_ :: ()) -> [] {-# INLINE rule151 #-} rule151 = \ _copy -> _copy -- Program ----------------------------------------------------- -- wrapper data Inh_Program = Inh_Program { options_Inh_Program :: !(Options), textBlockMap_Inh_Program :: !(Map BlockInfo PP_Doc) } data Syn_Program = Syn_Program { output_Syn_Program :: !(PP_Docs) } {-# INLINABLE wrap_Program #-} wrap_Program :: T_Program -> Inh_Program -> (Syn_Program ) wrap_Program !(T_Program act) !(Inh_Program _lhsIoptions _lhsItextBlockMap) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg46 = T_Program_vIn46 _lhsIoptions _lhsItextBlockMap !(T_Program_vOut46 _lhsOoutput) <- return (inv_Program_s47 sem arg46) return (Syn_Program _lhsOoutput) ) -- cata {-# INLINE sem_Program #-} sem_Program :: Program -> T_Program sem_Program ( Program chunks_ !ordered_ ) = sem_Program_Program ( sem_Chunks chunks_ ) ordered_ -- semantic domain newtype T_Program = T_Program { attach_T_Program :: Identity (T_Program_s47 ) } newtype T_Program_s47 = C_Program_s47 { inv_Program_s47 :: (T_Program_v46 ) } data T_Program_s48 = C_Program_s48 type T_Program_v46 = (T_Program_vIn46 ) -> (T_Program_vOut46 ) data T_Program_vIn46 = T_Program_vIn46 (Options) (Map BlockInfo PP_Doc) data T_Program_vOut46 = T_Program_vOut46 (PP_Docs) {-# NOINLINE sem_Program_Program #-} sem_Program_Program :: T_Chunks -> (Bool) -> T_Program sem_Program_Program arg_chunks_ _ = T_Program (return st47) where {-# NOINLINE st47 #-} !st47 = let v46 :: T_Program_v46 v46 = \ !(T_Program_vIn46 _lhsIoptions _lhsItextBlockMap) -> ( let _chunksX11 = Control.Monad.Identity.runIdentity (attach_T_Chunks (arg_chunks_)) (T_Chunks_vOut10 _chunksIpps) = inv_Chunks_s11 _chunksX11 (T_Chunks_vIn10 _chunksOisToplevel _chunksOoptions _chunksOtextBlockMap) _lhsOoutput :: PP_Docs _lhsOoutput = rule152 _chunksIpps _chunksOisToplevel = rule153 () _chunksOoptions = rule154 _lhsIoptions _chunksOtextBlockMap = rule155 _lhsItextBlockMap !__result_ = T_Program_vOut46 _lhsOoutput in __result_ ) in C_Program_s47 v46 {-# INLINE rule152 #-} {-# LINE 58 "src-ag/PrintOcamlCode.ag" #-} rule152 = \ ((_chunksIpps) :: PP_Docs) -> {-# LINE 58 "src-ag/PrintOcamlCode.ag" #-} _chunksIpps {-# LINE 2236 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule153 #-} {-# LINE 216 "src-ag/PrintOcamlCode.ag" #-} rule153 = \ (_ :: ()) -> {-# LINE 216 "src-ag/PrintOcamlCode.ag" #-} True {-# LINE 2242 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule154 #-} rule154 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule155 #-} rule155 = \ ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) -> _lhsItextBlockMap -- Type -------------------------------------------------------- -- wrapper data Inh_Type = Inh_Type { } data Syn_Type = Syn_Type { pp_Syn_Type :: !(PP_Doc) } {-# INLINABLE wrap_Type #-} wrap_Type :: T_Type -> Inh_Type -> (Syn_Type ) wrap_Type !(T_Type act) !(Inh_Type ) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg49 = T_Type_vIn49 !(T_Type_vOut49 _lhsOpp) <- return (inv_Type_s50 sem arg49) return (Syn_Type _lhsOpp) ) -- cata {-# NOINLINE sem_Type #-} sem_Type :: Type -> T_Type sem_Type ( Arr left_ right_ ) = sem_Type_Arr ( sem_Type left_ ) ( sem_Type right_ ) sem_Type ( CtxApp !left_ right_ ) = sem_Type_CtxApp left_ ( sem_Type right_ ) sem_Type ( QuantApp !left_ right_ ) = sem_Type_QuantApp left_ ( sem_Type right_ ) sem_Type ( TypeApp func_ args_ ) = sem_Type_TypeApp ( sem_Type func_ ) ( sem_Types args_ ) sem_Type ( TupleType tps_ ) = sem_Type_TupleType ( sem_Types tps_ ) sem_Type ( UnboxedTupleType tps_ ) = sem_Type_UnboxedTupleType ( sem_Types tps_ ) sem_Type ( List tp_ ) = sem_Type_List ( sem_Type tp_ ) sem_Type ( SimpleType !txt_ ) = sem_Type_SimpleType txt_ sem_Type ( NontermType !name_ !params_ !deforested_ ) = sem_Type_NontermType name_ params_ deforested_ sem_Type ( TMaybe tp_ ) = sem_Type_TMaybe ( sem_Type tp_ ) sem_Type ( TEither left_ right_ ) = sem_Type_TEither ( sem_Type left_ ) ( sem_Type right_ ) sem_Type ( TMap key_ value_ ) = sem_Type_TMap ( sem_Type key_ ) ( sem_Type value_ ) sem_Type ( TIntMap value_ ) = sem_Type_TIntMap ( sem_Type value_ ) sem_Type ( TSet tp_ ) = sem_Type_TSet ( sem_Type tp_ ) sem_Type ( TIntSet ) = sem_Type_TIntSet -- semantic domain newtype T_Type = T_Type { attach_T_Type :: Identity (T_Type_s50 ) } newtype T_Type_s50 = C_Type_s50 { inv_Type_s50 :: (T_Type_v49 ) } data T_Type_s51 = C_Type_s51 type T_Type_v49 = (T_Type_vIn49 ) -> (T_Type_vOut49 ) data T_Type_vIn49 = T_Type_vIn49 data T_Type_vOut49 = T_Type_vOut49 (PP_Doc) {-# NOINLINE sem_Type_Arr #-} sem_Type_Arr :: T_Type -> T_Type -> T_Type sem_Type_Arr arg_left_ arg_right_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 ) -> ( let _leftX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_left_)) _rightX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_right_)) (T_Type_vOut49 _leftIpp) = inv_Type_s50 _leftX50 (T_Type_vIn49 ) (T_Type_vOut49 _rightIpp) = inv_Type_s50 _rightX50 (T_Type_vIn49 ) _lhsOpp :: PP_Doc _lhsOpp = rule156 _leftIpp _rightIpp !__result_ = T_Type_vOut49 _lhsOpp in __result_ ) in C_Type_s50 v49 {-# INLINE rule156 #-} {-# LINE 161 "src-ag/PrintOcamlCode.ag" #-} rule156 = \ ((_leftIpp) :: PP_Doc) ((_rightIpp) :: PP_Doc) -> {-# LINE 161 "src-ag/PrintOcamlCode.ag" #-} pp_parens (_leftIpp >#< "->" >#< _rightIpp) {-# LINE 2315 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_CtxApp #-} sem_Type_CtxApp :: ([(String, [String])]) -> T_Type -> T_Type sem_Type_CtxApp _ arg_right_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 ) -> ( let _rightX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_right_)) (T_Type_vOut49 _rightIpp) = inv_Type_s50 _rightX50 (T_Type_vIn49 ) _lhsOpp :: PP_Doc _lhsOpp = rule157 () !__result_ = T_Type_vOut49 _lhsOpp in __result_ ) in C_Type_s50 v49 {-# INLINE rule157 #-} {-# LINE 162 "src-ag/PrintOcamlCode.ag" #-} rule157 = \ (_ :: ()) -> {-# LINE 162 "src-ag/PrintOcamlCode.ag" #-} error "pp of Type.CtxApp not supported" {-# LINE 2335 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_QuantApp #-} sem_Type_QuantApp :: (String) -> T_Type -> T_Type sem_Type_QuantApp _ arg_right_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 ) -> ( let _rightX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_right_)) (T_Type_vOut49 _rightIpp) = inv_Type_s50 _rightX50 (T_Type_vIn49 ) _lhsOpp :: PP_Doc _lhsOpp = rule158 _rightIpp !__result_ = T_Type_vOut49 _lhsOpp in __result_ ) in C_Type_s50 v49 {-# INLINE rule158 #-} rule158 = \ ((_rightIpp) :: PP_Doc) -> _rightIpp {-# NOINLINE sem_Type_TypeApp #-} sem_Type_TypeApp :: T_Type -> T_Types -> T_Type sem_Type_TypeApp arg_func_ arg_args_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 ) -> ( let _funcX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_func_)) _argsX53 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_args_)) (T_Type_vOut49 _funcIpp) = inv_Type_s50 _funcX50 (T_Type_vIn49 ) (T_Types_vOut52 _argsIpps) = inv_Types_s53 _argsX53 (T_Types_vIn52 ) _lhsOpp :: PP_Doc _lhsOpp = rule159 _argsIpps _funcIpp !__result_ = T_Type_vOut49 _lhsOpp in __result_ ) in C_Type_s50 v49 {-# INLINE rule159 #-} {-# LINE 163 "src-ag/PrintOcamlCode.ag" #-} rule159 = \ ((_argsIpps) :: PP_Docs) ((_funcIpp) :: PP_Doc) -> {-# LINE 163 "src-ag/PrintOcamlCode.ag" #-} pp_parens (hv_sp (_argsIpps ++ [_funcIpp])) {-# LINE 2374 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TupleType #-} sem_Type_TupleType :: T_Types -> T_Type sem_Type_TupleType arg_tps_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 ) -> ( let _tpsX53 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tps_)) (T_Types_vOut52 _tpsIpps) = inv_Types_s53 _tpsX53 (T_Types_vIn52 ) _lhsOpp :: PP_Doc _lhsOpp = rule160 _tpsIpps !__result_ = T_Type_vOut49 _lhsOpp in __result_ ) in C_Type_s50 v49 {-# INLINE rule160 #-} {-# LINE 164 "src-ag/PrintOcamlCode.ag" #-} rule160 = \ ((_tpsIpps) :: PP_Docs) -> {-# LINE 164 "src-ag/PrintOcamlCode.ag" #-} pp_block "(" ")" "," _tpsIpps {-# LINE 2394 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_UnboxedTupleType #-} sem_Type_UnboxedTupleType :: T_Types -> T_Type sem_Type_UnboxedTupleType arg_tps_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 ) -> ( let _tpsX53 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tps_)) (T_Types_vOut52 _tpsIpps) = inv_Types_s53 _tpsX53 (T_Types_vIn52 ) _lhsOpp :: PP_Doc _lhsOpp = rule161 () !__result_ = T_Type_vOut49 _lhsOpp in __result_ ) in C_Type_s50 v49 {-# INLINE rule161 #-} {-# LINE 166 "src-ag/PrintOcamlCode.ag" #-} rule161 = \ (_ :: ()) -> {-# LINE 166 "src-ag/PrintOcamlCode.ag" #-} error "pp of Type.UnboxedTupleType is not supported" {-# LINE 2414 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_List #-} sem_Type_List :: T_Type -> T_Type sem_Type_List arg_tp_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 ) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIpp) = inv_Type_s50 _tpX50 (T_Type_vIn49 ) _lhsOpp :: PP_Doc _lhsOpp = rule162 _tpIpp !__result_ = T_Type_vOut49 _lhsOpp in __result_ ) in C_Type_s50 v49 {-# INLINE rule162 #-} {-# LINE 167 "src-ag/PrintOcamlCode.ag" #-} rule162 = \ ((_tpIpp) :: PP_Doc) -> {-# LINE 167 "src-ag/PrintOcamlCode.ag" #-} _tpIpp >#< "list" {-# LINE 2434 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_SimpleType #-} sem_Type_SimpleType :: (String) -> T_Type sem_Type_SimpleType !arg_txt_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 ) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule163 arg_txt_ !__result_ = T_Type_vOut49 _lhsOpp in __result_ ) in C_Type_s50 v49 {-# INLINE rule163 #-} {-# LINE 168 "src-ag/PrintOcamlCode.ag" #-} rule163 = \ txt_ -> {-# LINE 168 "src-ag/PrintOcamlCode.ag" #-} text txt_ {-# LINE 2452 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_NontermType #-} sem_Type_NontermType :: (String) -> ([String]) -> (Bool) -> T_Type sem_Type_NontermType !arg_name_ !arg_params_ _ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 ) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule164 arg_name_ arg_params_ !__result_ = T_Type_vOut49 _lhsOpp in __result_ ) in C_Type_s50 v49 {-# INLINE rule164 #-} {-# LINE 169 "src-ag/PrintOcamlCode.ag" #-} rule164 = \ name_ params_ -> {-# LINE 169 "src-ag/PrintOcamlCode.ag" #-} pp_block "(" ")" " " (map text params_ ++ [text $ toOcamlTC name_]) {-# LINE 2470 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TMaybe #-} sem_Type_TMaybe :: T_Type -> T_Type sem_Type_TMaybe arg_tp_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 ) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIpp) = inv_Type_s50 _tpX50 (T_Type_vIn49 ) _lhsOpp :: PP_Doc _lhsOpp = rule165 _tpIpp !__result_ = T_Type_vOut49 _lhsOpp in __result_ ) in C_Type_s50 v49 {-# INLINE rule165 #-} {-# LINE 170 "src-ag/PrintOcamlCode.ag" #-} rule165 = \ ((_tpIpp) :: PP_Doc) -> {-# LINE 170 "src-ag/PrintOcamlCode.ag" #-} _tpIpp >#< "opt" {-# LINE 2490 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TEither #-} sem_Type_TEither :: T_Type -> T_Type -> T_Type sem_Type_TEither arg_left_ arg_right_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 ) -> ( let _leftX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_left_)) _rightX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_right_)) (T_Type_vOut49 _leftIpp) = inv_Type_s50 _leftX50 (T_Type_vIn49 ) (T_Type_vOut49 _rightIpp) = inv_Type_s50 _rightX50 (T_Type_vIn49 ) _lhsOpp :: PP_Doc _lhsOpp = rule166 () !__result_ = T_Type_vOut49 _lhsOpp in __result_ ) in C_Type_s50 v49 {-# INLINE rule166 #-} {-# LINE 171 "src-ag/PrintOcamlCode.ag" #-} rule166 = \ (_ :: ()) -> {-# LINE 171 "src-ag/PrintOcamlCode.ag" #-} error "pp of Type.TEither is not supported" {-# LINE 2512 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TMap #-} sem_Type_TMap :: T_Type -> T_Type -> T_Type sem_Type_TMap arg_key_ arg_value_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 ) -> ( let _keyX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_key_)) _valueX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_value_)) (T_Type_vOut49 _keyIpp) = inv_Type_s50 _keyX50 (T_Type_vIn49 ) (T_Type_vOut49 _valueIpp) = inv_Type_s50 _valueX50 (T_Type_vIn49 ) _lhsOpp :: PP_Doc _lhsOpp = rule167 () !__result_ = T_Type_vOut49 _lhsOpp in __result_ ) in C_Type_s50 v49 {-# INLINE rule167 #-} {-# LINE 172 "src-ag/PrintOcamlCode.ag" #-} rule167 = \ (_ :: ()) -> {-# LINE 172 "src-ag/PrintOcamlCode.ag" #-} error "pp of Type.TMap is not supported" {-# LINE 2534 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TIntMap #-} sem_Type_TIntMap :: T_Type -> T_Type sem_Type_TIntMap arg_value_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 ) -> ( let _valueX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_value_)) (T_Type_vOut49 _valueIpp) = inv_Type_s50 _valueX50 (T_Type_vIn49 ) _lhsOpp :: PP_Doc _lhsOpp = rule168 () !__result_ = T_Type_vOut49 _lhsOpp in __result_ ) in C_Type_s50 v49 {-# INLINE rule168 #-} {-# LINE 173 "src-ag/PrintOcamlCode.ag" #-} rule168 = \ (_ :: ()) -> {-# LINE 173 "src-ag/PrintOcamlCode.ag" #-} error "pp of Type.TIntMap is not supported" {-# LINE 2554 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TSet #-} sem_Type_TSet :: T_Type -> T_Type sem_Type_TSet arg_tp_ = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 ) -> ( let _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_)) (T_Type_vOut49 _tpIpp) = inv_Type_s50 _tpX50 (T_Type_vIn49 ) _lhsOpp :: PP_Doc _lhsOpp = rule169 () !__result_ = T_Type_vOut49 _lhsOpp in __result_ ) in C_Type_s50 v49 {-# INLINE rule169 #-} {-# LINE 174 "src-ag/PrintOcamlCode.ag" #-} rule169 = \ (_ :: ()) -> {-# LINE 174 "src-ag/PrintOcamlCode.ag" #-} error "pp of Type.TSet is not supported" {-# LINE 2574 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TIntSet #-} sem_Type_TIntSet :: T_Type sem_Type_TIntSet = T_Type (return st50) where {-# NOINLINE st50 #-} !st50 = let v49 :: T_Type_v49 v49 = \ !(T_Type_vIn49 ) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule170 () !__result_ = T_Type_vOut49 _lhsOpp in __result_ ) in C_Type_s50 v49 {-# INLINE rule170 #-} {-# LINE 175 "src-ag/PrintOcamlCode.ag" #-} rule170 = \ (_ :: ()) -> {-# LINE 175 "src-ag/PrintOcamlCode.ag" #-} error "pp of Type.TIntSet is not supported" {-# LINE 2592 "dist/build/PrintOcamlCode.hs"#-} -- Types ------------------------------------------------------- -- wrapper data Inh_Types = Inh_Types { } data Syn_Types = Syn_Types { pps_Syn_Types :: !(PP_Docs) } {-# INLINABLE wrap_Types #-} wrap_Types :: T_Types -> Inh_Types -> (Syn_Types ) wrap_Types !(T_Types act) !(Inh_Types ) = Control.Monad.Identity.runIdentity ( do !sem <- act let arg52 = T_Types_vIn52 !(T_Types_vOut52 _lhsOpps) <- return (inv_Types_s53 sem arg52) return (Syn_Types _lhsOpps) ) -- cata {-# NOINLINE sem_Types #-} sem_Types :: Types -> T_Types sem_Types list = Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list) -- semantic domain newtype T_Types = T_Types { attach_T_Types :: Identity (T_Types_s53 ) } newtype T_Types_s53 = C_Types_s53 { inv_Types_s53 :: (T_Types_v52 ) } data T_Types_s54 = C_Types_s54 type T_Types_v52 = (T_Types_vIn52 ) -> (T_Types_vOut52 ) data T_Types_vIn52 = T_Types_vIn52 data T_Types_vOut52 = T_Types_vOut52 (PP_Docs) {-# NOINLINE sem_Types_Cons #-} sem_Types_Cons :: T_Type -> T_Types -> T_Types sem_Types_Cons arg_hd_ arg_tl_ = T_Types (return st53) where {-# NOINLINE st53 #-} !st53 = let v52 :: T_Types_v52 v52 = \ !(T_Types_vIn52 ) -> ( let _hdX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_hd_)) _tlX53 = Control.Monad.Identity.runIdentity (attach_T_Types (arg_tl_)) (T_Type_vOut49 _hdIpp) = inv_Type_s50 _hdX50 (T_Type_vIn49 ) (T_Types_vOut52 _tlIpps) = inv_Types_s53 _tlX53 (T_Types_vIn52 ) _lhsOpps :: PP_Docs _lhsOpps = rule171 _hdIpp _tlIpps !__result_ = T_Types_vOut52 _lhsOpps in __result_ ) in C_Types_s53 v52 {-# INLINE rule171 #-} {-# LINE 73 "src-ag/PrintOcamlCode.ag" #-} rule171 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 73 "src-ag/PrintOcamlCode.ag" #-} _hdIpp : _tlIpps {-# LINE 2645 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Types_Nil #-} sem_Types_Nil :: T_Types sem_Types_Nil = T_Types (return st53) where {-# NOINLINE st53 #-} !st53 = let v52 :: T_Types_v52 v52 = \ !(T_Types_vIn52 ) -> ( let _lhsOpps :: PP_Docs _lhsOpps = rule172 () !__result_ = T_Types_vOut52 _lhsOpps in __result_ ) in C_Types_s53 v52 {-# INLINE rule172 #-} {-# LINE 74 "src-ag/PrintOcamlCode.ag" #-} rule172 = \ (_ :: ()) -> {-# LINE 74 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 2663 "dist/build/PrintOcamlCode.hs"#-} uuagc-0.9.52.2/src-generated/PrintErrorMessages.hs0000644000000000000000000026516313433540502020132 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module PrintErrorMessages where {-# LINE 2 "src-ag/ErrorMessages.ag" #-} import UU.Scanner.Position(Pos) import Pretty import CodeSyntax import CommonTypes {-# LINE 12 "dist/build/PrintErrorMessages.hs" #-} {-# LINE 4 "src-ag/PrintErrorMessages.ag" #-} import UU.Scanner.Position(Pos(..), noPos) import ErrorMessages import Data.List(mapAccumL) import GrammarInfo import qualified Control.Monad.Error.Class as Err {-# LINE 21 "dist/build/PrintErrorMessages.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 13 "src-ag/PrintErrorMessages.ag" #-} instance Err.Error Error where noMsg = Err.strMsg "error" strMsg = CustomError False noPos . pp {-# LINE 29 "dist/build/PrintErrorMessages.hs" #-} {-# LINE 20 "src-ag/PrintErrorMessages.ag" #-} isError :: Options -> Error -> Bool isError _ (ParserError _ _ _ ) = True isError _ (DupAlt _ _ _ ) = False isError _ (DupSynonym _ _ ) = False isError _ (DupSet _ _ ) = False isError _ (DupInhAttr _ _ _ ) = True isError _ (DupSynAttr _ _ _ ) = True isError _ (DupChild _ _ _ _ ) = False isError _ (DupRule _ _ _ _ _) = True isError _ (DupSig _ _ _ ) = False isError _ (UndefNont _ ) = True isError _ (UndefAlt _ _ ) = True isError _ (UndefChild _ _ _ ) = True isError _ (MissingRule _ _ _ _ ) = False isError _ (SuperfluousRule _ _ _ _ ) = False isError _ (UndefLocal _ _ _ ) = True isError _ (ChildAsLocal _ _ _ ) = False isError _ (UndefAttr _ _ _ _ _) = True isError _ (CyclicSet _ ) = True isError _ (CustomError w _ _ ) = not w isError opts (LocalCirc _ _ _ _ _) = cycleIsDangerous opts isError opts (InstCirc _ _ _ _ _) = cycleIsDangerous opts isError opts (DirectCirc _ _ _ ) = cycleIsDangerous opts isError opts (InducedCirc _ _ _ ) = cycleIsDangerous opts isError _ (MissingTypeSig _ _ _ ) = False isError _ (MissingInstSig _ _ _ ) = True isError _ (DupUnique _ _ _ ) = False isError _ (MissingUnique _ _ ) = True isError _ (MissingSyn _ _ ) = True isError _ (MissingNamedRule _ _ _) = True isError _ (DupRuleName _ _ _) = True isError _ (HsParseError _ _) = True isError _ (Cyclic _ _ _) = True isError _ (IncompatibleVisitKind _ _ _ _) = True isError _ (IncompatibleRuleKind _ _) = True isError _ (IncompatibleAttachKind _ _) = True cycleIsDangerous :: Options -> Bool cycleIsDangerous opts = any ($ opts) [ wignore, bangpats, cases, strictCases, stricterCases, strictSems, withCycle ] {-# LINE 73 "dist/build/PrintErrorMessages.hs" #-} {-# LINE 548 "src-ag/PrintErrorMessages.ag" #-} toWidth :: Int -> String -> String toWidth n xs | k PP_Doc showEdge ((inh,syn),_,_) = text ("inherited attribute " ++ toWidth 20 (getName inh) ++ " with synthesized attribute " ++ getName syn) showEdgeLong :: ((Identifier,Identifier),[String],[String]) -> PP_Doc showEdgeLong ((inh,syn),path1,path2) = text ("inherited attribute " ++ getName inh ++ " is needed for " ++ "synthesized attribute " ++ getName syn) >-< indent 4 (vlist (map text path2)) >-< text "and back: " >-< indent 4 (vlist (map text path1)) attrText :: Identifier -> Identifier -> String attrText inh syn = if inh == syn then "threaded attribute " ++ getName inh else "inherited attribute " ++ getName inh ++ " and synthesized attribute " ++getName syn showLineNr :: Int -> String showLineNr i | i==(-1) = "CR" | otherwise = show i showAttrDef :: Identifier -> Identifier -> String showAttrDef f a | f == _LHS = "synthesized attribute " ++ getName a | f == _LOC = "local attribute " ++ getName a | f == _INST = "inst attribute " ++ getName a | otherwise = "inherited attribute " ++ getName a ++ " of field " ++ getName f showAttrUse :: Identifier -> Identifier -> String showAttrUse f a | f == _LHS = "inherited attribute " ++ getName a | f == _LOC = "local attribute " ++ getName a | f == _INST = "inst attribute " ++ getName a | otherwise = "synthesized attribute " ++ getName a ++ " of field " ++ getName f ppAttr :: Identifier -> Identifier -> PP_Doc ppAttr f a = text (getName f++"."++getName a) ppAttrUse :: Identifier -> Identifier -> PP_Doc ppAttrUse f a = "@" >|< ppAttr f a {-# LINE 119 "dist/build/PrintErrorMessages.hs" #-} {-# LINE 594 "src-ag/PrintErrorMessages.ag" #-} infixr 5 +#+ (+#+) :: String -> String -> String (+#+) s t = s ++ " " ++ t infixr 5 +.+ (+.+) :: Identifier -> Identifier -> String (+.+) s t = getName s ++ "." ++ getName t wfill :: [String] -> PP_Doc wfill = fill . addSpaces. concat . map words where addSpaces (x:xs) = x:map addSpace xs addSpaces [] = [] addSpace [x] | x `elem` ".,;:!?" = [x] addSpace xs = ' ':xs ppError :: Bool -- class of the error, True:error False:warning -> Pos -- source position -> PP_Doc -- error message -> PP_Doc -- pattern -> PP_Doc -- help, more info -> PP_Doc -- action taken by AG -> Bool -- verbose? show help and action? -> PP_Doc ppError isErr pos mesg pat hlp act verb = let position = case pos of Pos l c f | l >= 0 -> f >|< ":" >|< show l >|< ":" >|< show c | otherwise -> pp "uuagc" tp = if isErr then "error" else "warning" header = position >|< ":" >#< tp >|< ":" >#< mesg pattern = "pattern :" >#< pat help = "help :" >#< hlp action = "action :" >#< act in if verb then vlist [text "",header,pattern,help,action] else header {- -- old error reporting code = let cl = if isError then "ERROR" else "Warning" position = case pos of (Pos l c f) | l >= 0 -> f >|< ": line " >|< show l >|< ", column " >|< show c | otherwise -> empty header = "*** UU.AG" >#< cl >#< position >#< "***" message = "problem :" >#< mesg pattern = "pattern :" >#< pat help = "help :" >#< hlp action = "action :" >#< act in if verbose then vlist [text "",header,message,pattern,help,action] else vlist [text "",header,message] -} showPos :: Identifier -> String showPos = show . getPos ppInterface :: Show a => a -> PP_Doc ppInterface inter = wfill ["interface:", show inter] {-# LINE 183 "dist/build/PrintErrorMessages.hs" #-} -- Error ------------------------------------------------------- -- wrapper data Inh_Error = Inh_Error { options_Inh_Error :: (Options), verbose_Inh_Error :: (Bool) } data Syn_Error = Syn_Error { me_Syn_Error :: (Error), pp_Syn_Error :: (PP_Doc) } {-# INLINABLE wrap_Error #-} wrap_Error :: T_Error -> Inh_Error -> (Syn_Error ) wrap_Error (T_Error act) (Inh_Error _lhsIoptions _lhsIverbose) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_Error_vIn1 _lhsIoptions _lhsIverbose (T_Error_vOut1 _lhsOme _lhsOpp) <- return (inv_Error_s2 sem arg1) return (Syn_Error _lhsOme _lhsOpp) ) -- cata {-# NOINLINE sem_Error #-} sem_Error :: Error -> T_Error sem_Error ( ParserError pos_ problem_ action_ ) = sem_Error_ParserError pos_ problem_ action_ sem_Error ( HsParseError pos_ msg_ ) = sem_Error_HsParseError pos_ msg_ sem_Error ( DupAlt nt_ con_ occ1_ ) = sem_Error_DupAlt nt_ con_ occ1_ sem_Error ( DupSynonym nt_ occ1_ ) = sem_Error_DupSynonym nt_ occ1_ sem_Error ( DupSet name_ occ1_ ) = sem_Error_DupSet name_ occ1_ sem_Error ( DupInhAttr nt_ attr_ occ1_ ) = sem_Error_DupInhAttr nt_ attr_ occ1_ sem_Error ( DupSynAttr nt_ attr_ occ1_ ) = sem_Error_DupSynAttr nt_ attr_ occ1_ sem_Error ( DupChild nt_ con_ name_ occ1_ ) = sem_Error_DupChild nt_ con_ name_ occ1_ sem_Error ( DupRule nt_ con_ field_ attr_ occ1_ ) = sem_Error_DupRule nt_ con_ field_ attr_ occ1_ sem_Error ( DupRuleName nt_ con_ nm_ ) = sem_Error_DupRuleName nt_ con_ nm_ sem_Error ( DupSig nt_ con_ attr_ ) = sem_Error_DupSig nt_ con_ attr_ sem_Error ( UndefNont nt_ ) = sem_Error_UndefNont nt_ sem_Error ( UndefAlt nt_ con_ ) = sem_Error_UndefAlt nt_ con_ sem_Error ( UndefChild nt_ con_ name_ ) = sem_Error_UndefChild nt_ con_ name_ sem_Error ( MissingRule nt_ con_ field_ attr_ ) = sem_Error_MissingRule nt_ con_ field_ attr_ sem_Error ( MissingNamedRule nt_ con_ name_ ) = sem_Error_MissingNamedRule nt_ con_ name_ sem_Error ( SuperfluousRule nt_ con_ field_ attr_ ) = sem_Error_SuperfluousRule nt_ con_ field_ attr_ sem_Error ( UndefLocal nt_ con_ var_ ) = sem_Error_UndefLocal nt_ con_ var_ sem_Error ( ChildAsLocal nt_ con_ var_ ) = sem_Error_ChildAsLocal nt_ con_ var_ sem_Error ( UndefAttr nt_ con_ field_ attr_ isOut_ ) = sem_Error_UndefAttr nt_ con_ field_ attr_ isOut_ sem_Error ( Cyclic nt_ mbCon_ verts_ ) = sem_Error_Cyclic nt_ mbCon_ verts_ sem_Error ( CyclicSet name_ ) = sem_Error_CyclicSet name_ sem_Error ( CustomError isWarning_ pos_ mesg_ ) = sem_Error_CustomError isWarning_ pos_ mesg_ sem_Error ( LocalCirc nt_ con_ attr_ o_visit_ path_ ) = sem_Error_LocalCirc nt_ con_ attr_ o_visit_ path_ sem_Error ( InstCirc nt_ con_ attr_ o_visit_ path_ ) = sem_Error_InstCirc nt_ con_ attr_ o_visit_ path_ sem_Error ( DirectCirc nt_ o_visit_ cyclic_ ) = sem_Error_DirectCirc nt_ o_visit_ cyclic_ sem_Error ( InducedCirc nt_ cinter_ cyclic_ ) = sem_Error_InducedCirc nt_ cinter_ cyclic_ sem_Error ( MissingTypeSig nt_ con_ attr_ ) = sem_Error_MissingTypeSig nt_ con_ attr_ sem_Error ( MissingInstSig nt_ con_ attr_ ) = sem_Error_MissingInstSig nt_ con_ attr_ sem_Error ( DupUnique nt_ con_ attr_ ) = sem_Error_DupUnique nt_ con_ attr_ sem_Error ( MissingUnique nt_ attr_ ) = sem_Error_MissingUnique nt_ attr_ sem_Error ( MissingSyn nt_ attr_ ) = sem_Error_MissingSyn nt_ attr_ sem_Error ( IncompatibleVisitKind child_ vis_ from_ to_ ) = sem_Error_IncompatibleVisitKind child_ vis_ from_ to_ sem_Error ( IncompatibleRuleKind rule_ kind_ ) = sem_Error_IncompatibleRuleKind rule_ kind_ sem_Error ( IncompatibleAttachKind child_ kind_ ) = sem_Error_IncompatibleAttachKind child_ kind_ -- semantic domain newtype T_Error = T_Error { attach_T_Error :: Identity (T_Error_s2 ) } newtype T_Error_s2 = C_Error_s2 { inv_Error_s2 :: (T_Error_v1 ) } data T_Error_s3 = C_Error_s3 type T_Error_v1 = (T_Error_vIn1 ) -> (T_Error_vOut1 ) data T_Error_vIn1 = T_Error_vIn1 (Options) (Bool) data T_Error_vOut1 = T_Error_vOut1 (Error) (PP_Doc) {-# NOINLINE sem_Error_ParserError #-} sem_Error_ParserError :: (Pos) -> (String) -> (String) -> T_Error sem_Error_ParserError arg_pos_ arg_problem_ arg_action_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule0 _lhsIoptions _lhsIverbose _me arg_action_ arg_pos_ arg_problem_ _me = rule1 arg_action_ arg_pos_ arg_problem_ _lhsOme :: Error _lhsOme = rule2 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule0 #-} {-# LINE 87 "src-ag/PrintErrorMessages.ag" #-} rule0 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me action_ pos_ problem_ -> {-# LINE 87 "src-ag/PrintErrorMessages.ag" #-} let mesg = text ("parser expecting " ++ problem_) pat = text "" help = text "" act = text action_ in ppError (isError _lhsIoptions _me) pos_ mesg pat help act _lhsIverbose {-# LINE 272 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule1 #-} rule1 = \ action_ pos_ problem_ -> ParserError pos_ problem_ action_ {-# INLINE rule2 #-} rule2 = \ _me -> _me {-# NOINLINE sem_Error_HsParseError #-} sem_Error_HsParseError :: (Pos) -> (String) -> T_Error sem_Error_HsParseError arg_pos_ arg_msg_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule3 _lhsIverbose arg_msg_ arg_pos_ _me = rule4 arg_msg_ arg_pos_ _lhsOme :: Error _lhsOme = rule5 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule3 #-} {-# LINE 93 "src-ag/PrintErrorMessages.ag" #-} rule3 = \ ((_lhsIverbose) :: Bool) msg_ pos_ -> {-# LINE 93 "src-ag/PrintErrorMessages.ag" #-} ppError True pos_ (text msg_) (text "") (text "") (text "Correct the syntax of the Haskell code.") _lhsIverbose {-# LINE 299 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule4 #-} rule4 = \ msg_ pos_ -> HsParseError pos_ msg_ {-# INLINE rule5 #-} rule5 = \ _me -> _me {-# NOINLINE sem_Error_DupAlt #-} sem_Error_DupAlt :: (NontermIdent) -> (ConstructorIdent) -> (ConstructorIdent) -> T_Error sem_Error_DupAlt arg_nt_ arg_con_ arg_occ1_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule6 _lhsIoptions _lhsIverbose _me arg_con_ arg_nt_ arg_occ1_ _me = rule7 arg_con_ arg_nt_ arg_occ1_ _lhsOme :: Error _lhsOme = rule8 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule6 #-} {-# LINE 95 "src-ag/PrintErrorMessages.ag" #-} rule6 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ nt_ occ1_ -> {-# LINE 95 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Repeated definition for alternative", getName con_ ,"of nonterminal", getName nt_, "." ] >-< wfill ["First definition:", (showPos occ1_),"."] >-< wfill ["Other definition:", (showPos con_),"."] pat = "DATA" >#< getName nt_ >-< indent 2 ("|" >#< getName con_ >#< "...") >-< indent 2 ("|" >#< getName con_ >#< "...") help = wfill ["The nonterminal",getName nt_,"has more than one alternative that" ,"is labelled with the constructor name",getName con_,"." ,"You should either rename or remove enough of them to make all" ,"constructors of",getName nt_,"uniquely named." ] act = wfill [ "The first alternative of name",getName con_ ,"you have given for nonterminal",getName nt_ ,"is considered valid. All other alternatives have been discarded." ] in ppError (isError _lhsIoptions _me) (getPos con_) mesg pat help act _lhsIverbose {-# LINE 343 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule7 #-} rule7 = \ con_ nt_ occ1_ -> DupAlt nt_ con_ occ1_ {-# INLINE rule8 #-} rule8 = \ _me -> _me {-# NOINLINE sem_Error_DupSynonym #-} sem_Error_DupSynonym :: (NontermIdent) -> (NontermIdent) -> T_Error sem_Error_DupSynonym arg_nt_ arg_occ1_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule9 _lhsIoptions _lhsIverbose _me arg_nt_ arg_occ1_ _me = rule10 arg_nt_ arg_occ1_ _lhsOme :: Error _lhsOme = rule11 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule9 #-} {-# LINE 117 "src-ag/PrintErrorMessages.ag" #-} rule9 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me nt_ occ1_ -> {-# LINE 117 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Definition of type synonym", getName nt_, "clashes with another" ,"type synonym." ] >-< wfill ["First definition:", (showPos occ1_),"."] >-< wfill ["Type synonym :" , (showPos nt_),"."] pat = "DATA" >#< getName nt_ >-< indent 2 ("|" >#< "...") >-< "TYPE" >#< getName nt_ >#< "=" >#< "..." help = wfill ["A type synonym with name", getName nt_ ,"has been given while there already is TYPE" ,"definition with the same name." ,"You should either rename or remove the type synonym." ] act = wfill [ "The clashing type synonym will be ignored." ] in ppError (isError _lhsIoptions _me) (getPos nt_) mesg pat help act _lhsIverbose {-# LINE 385 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule10 #-} rule10 = \ nt_ occ1_ -> DupSynonym nt_ occ1_ {-# INLINE rule11 #-} rule11 = \ _me -> _me {-# NOINLINE sem_Error_DupSet #-} sem_Error_DupSet :: (NontermIdent) -> (NontermIdent) -> T_Error sem_Error_DupSet arg_name_ arg_occ1_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule12 _lhsIoptions _lhsIverbose _me arg_name_ arg_occ1_ _me = rule13 arg_name_ arg_occ1_ _lhsOme :: Error _lhsOme = rule14 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule12 #-} {-# LINE 134 "src-ag/PrintErrorMessages.ag" #-} rule12 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me name_ occ1_ -> {-# LINE 134 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Definition of nonterminal set", getName name_, "clashes with another" ,"set, a type synonym or a data definition." ] >-< wfill ["First definition:", (showPos occ1_),"."] >-< wfill ["Set definition:" , (showPos name_),"."] pat = "SET" >#< getName name_ >#< "=" >#< "..." >-< "SET" >#< getName name_ >#< "=" >#< "..." help = wfill ["A nonterminal set with name", getName name_ ,"has been given while there already is a SET, DATA, or TYPE" ,"definition with the same name." ,"You should either rename or remove the nonterminal set." ] act = wfill [ "The clashing nonterminal set will be ignored." ] in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose {-# LINE 426 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule13 #-} rule13 = \ name_ occ1_ -> DupSet name_ occ1_ {-# INLINE rule14 #-} rule14 = \ _me -> _me {-# NOINLINE sem_Error_DupInhAttr #-} sem_Error_DupInhAttr :: (NontermIdent) -> (Identifier) -> (Identifier) -> T_Error sem_Error_DupInhAttr arg_nt_ arg_attr_ arg_occ1_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule15 _lhsIoptions _lhsIverbose _me arg_attr_ arg_nt_ arg_occ1_ _me = rule16 arg_attr_ arg_nt_ arg_occ1_ _lhsOme :: Error _lhsOme = rule17 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule15 #-} {-# LINE 150 "src-ag/PrintErrorMessages.ag" #-} rule15 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ nt_ occ1_ -> {-# LINE 150 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Repeated declaration of inherited attribute", getName attr_ , "of nonterminal", getName nt_, "." ] >-< wfill ["First definition:", (showPos occ1_),"."] >-< wfill ["Other definition:", (showPos attr_),"."] pat = "ATTR" >#< getName nt_ >#< "[" >#< getName attr_ >|< ":...," >#< getName attr_ >|< ":... | | ]" help = wfill ["The identifier" , getName attr_ ,"has been declared" ,"as an inherited (or chained) attribute for nonterminal" ,getName nt_ , "more than once, with possibly different types." ,"Delete all but one or rename them to make them unique." ] act = wfill ["One declaration with its corresponding type is considered valid." ,"All others have been discarded. The generated program will probably not run." ] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose {-# LINE 468 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule16 #-} rule16 = \ attr_ nt_ occ1_ -> DupInhAttr nt_ attr_ occ1_ {-# INLINE rule17 #-} rule17 = \ _me -> _me {-# NOINLINE sem_Error_DupSynAttr #-} sem_Error_DupSynAttr :: (NontermIdent) -> (Identifier) -> (Identifier) -> T_Error sem_Error_DupSynAttr arg_nt_ arg_attr_ arg_occ1_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule18 _lhsIoptions _lhsIverbose _me arg_attr_ arg_nt_ arg_occ1_ _me = rule19 arg_attr_ arg_nt_ arg_occ1_ _lhsOme :: Error _lhsOme = rule20 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule18 #-} {-# LINE 169 "src-ag/PrintErrorMessages.ag" #-} rule18 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ nt_ occ1_ -> {-# LINE 169 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Repeated declaration of synthesized attribute", getName attr_ , "of nonterminal", getName nt_, "." ] >-< wfill ["First definition:", (showPos occ1_),"."] >-< wfill ["Other definition:", (showPos attr_),"."] pat = "ATTR" >#< getName nt_ >#< "[ | |" >#< getName attr_ >|< ":...," >#< getName attr_ >|< ":... ]" help = wfill ["The identifier" , getName attr_ ,"has been declared" ,"as a synthesized (or chained) attribute for nonterminal" ,getName nt_ , "more than once, with possibly different types." ,"Delete all but one or rename them to make them unique." ] act = wfill ["One declaration with its corresponding type is considered valid." ,"All others have been discarded. The generated program will probably not run." ] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose {-# LINE 510 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule19 #-} rule19 = \ attr_ nt_ occ1_ -> DupSynAttr nt_ attr_ occ1_ {-# INLINE rule20 #-} rule20 = \ _me -> _me {-# NOINLINE sem_Error_DupChild #-} sem_Error_DupChild :: (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> (Identifier) -> T_Error sem_Error_DupChild arg_nt_ arg_con_ arg_name_ arg_occ1_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule21 _lhsIoptions _lhsIverbose _me arg_con_ arg_name_ arg_nt_ arg_occ1_ _me = rule22 arg_con_ arg_name_ arg_nt_ arg_occ1_ _lhsOme :: Error _lhsOme = rule23 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule21 #-} {-# LINE 188 "src-ag/PrintErrorMessages.ag" #-} rule21 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ name_ nt_ occ1_ -> {-# LINE 188 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Repeated declaration for field", getName name_, "of alternative" ,getName con_, "of nonterminal", getName nt_, "." ] >-< wfill ["First definition:", (showPos occ1_),"."] >-< wfill ["Other definition:", (showPos name_),"."] pat = "DATA" >#< getName nt_ >-< indent 2 ("|" >#< getName con_ >#< (getName name_ >|< ":..." >-< getName name_ >|< ":...")) help = wfill ["The alternative" ,getName con_ , "of nonterminal" ,getName nt_ ,"has more than one field that is named" , getName name_ ++ ". Possibly they have different types." ,"You should either rename or remove enough of them to make all fields of" ,getName con_ , "for nonterminal " , getName nt_ , "uniquely named." ] act = wfill ["The last declaration with its corresponding type is considered valid." ,"All others have been discarded." ] in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose {-# LINE 553 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule22 #-} rule22 = \ con_ name_ nt_ occ1_ -> DupChild nt_ con_ name_ occ1_ {-# INLINE rule23 #-} rule23 = \ _me -> _me {-# NOINLINE sem_Error_DupRule #-} sem_Error_DupRule :: (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> (Identifier) -> (Identifier) -> T_Error sem_Error_DupRule arg_nt_ arg_con_ arg_field_ arg_attr_ arg_occ1_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule24 _lhsIoptions _lhsIverbose _me arg_attr_ arg_con_ arg_field_ arg_nt_ arg_occ1_ _me = rule25 arg_attr_ arg_con_ arg_field_ arg_nt_ arg_occ1_ _lhsOme :: Error _lhsOme = rule26 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule24 #-} {-# LINE 208 "src-ag/PrintErrorMessages.ag" #-} rule24 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ field_ nt_ occ1_ -> {-# LINE 208 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more rules for" ,showAttrDef field_ attr_,"." ] >-< wfill ["First rule:", (showPos occ1_),"."] >-< wfill ["Other rule:", (showPos attr_),"."] pat = "SEM" >#< getName nt_ >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_ ,", there is more than one rule for the" , showAttrDef field_ attr_ ,". You should either rename or remove enough of them to make all rules for alternative" ,getName con_ , "of nonterminal " ,getName nt_ , "uniquely named." ] act = wfill ["The last rule given is considered valid. All others have been discarded."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose {-# LINE 594 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule25 #-} rule25 = \ attr_ con_ field_ nt_ occ1_ -> DupRule nt_ con_ field_ attr_ occ1_ {-# INLINE rule26 #-} rule26 = \ _me -> _me {-# NOINLINE sem_Error_DupRuleName #-} sem_Error_DupRuleName :: (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> T_Error sem_Error_DupRuleName arg_nt_ arg_con_ arg_nm_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule27 _lhsIoptions _lhsIverbose _me arg_con_ arg_nm_ arg_nt_ _me = rule28 arg_con_ arg_nm_ arg_nt_ _lhsOme :: Error _lhsOme = rule29 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule27 #-} {-# LINE 226 "src-ag/PrintErrorMessages.ag" #-} rule27 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ nm_ nt_ -> {-# LINE 226 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more rule names for" ,show nm_,"." ] pat = "SEM" >#< getName nt_ >-< indent 2 ("|" >#< getName con_ >#< show nm_ >#< ": ... = ...") >-< indent 2 ("|" >#< getName con_ >#< show nm_ >#< ": ... = ...") help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_ ,", there is more than one rule name " , show nm_ ,". You should either rename or remove enough of them." ] act = wfill ["Compilation cannot continue."] in ppError (isError _lhsIoptions _me) (getPos nm_) mesg pat help act _lhsIverbose {-# LINE 632 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule28 #-} rule28 = \ con_ nm_ nt_ -> DupRuleName nt_ con_ nm_ {-# INLINE rule29 #-} rule29 = \ _me -> _me {-# NOINLINE sem_Error_DupSig #-} sem_Error_DupSig :: (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> T_Error sem_Error_DupSig arg_nt_ arg_con_ arg_attr_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule30 _lhsIoptions _lhsIverbose _me arg_attr_ arg_con_ arg_nt_ _me = rule31 arg_attr_ arg_con_ arg_nt_ _lhsOme :: Error _lhsOme = rule32 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule30 #-} {-# LINE 241 "src-ag/PrintErrorMessages.ag" #-} rule30 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ nt_ -> {-# LINE 241 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more typesignatures for" ,showAttrDef _LOC attr_,"." ] >-< wfill ["First signature:", (showPos attr_),"."] pat = "SEM" >#< getName nt_ >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< "= ...") >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< "= ...") help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_ ,", there is more than one rule for the" , showAttrDef _LOC attr_ ,". You should remove enough of them to make all typesignatures for alternative" ,getName con_ , "of nonterminal " ,getName nt_ , "unique." ] act = wfill ["The last typesignature given is considered valid. All others have been discarded."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose {-# LINE 672 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule31 #-} rule31 = \ attr_ con_ nt_ -> DupSig nt_ con_ attr_ {-# INLINE rule32 #-} rule32 = \ _me -> _me {-# NOINLINE sem_Error_UndefNont #-} sem_Error_UndefNont :: (NontermIdent) -> T_Error sem_Error_UndefNont arg_nt_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule33 _lhsIoptions _lhsIverbose _me arg_nt_ _me = rule34 arg_nt_ _lhsOme :: Error _lhsOme = rule35 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule33 #-} {-# LINE 258 "src-ag/PrintErrorMessages.ag" #-} rule33 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me nt_ -> {-# LINE 258 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Nonterminal", getName nt_, "is not defined." ] pat = "DATA" >#< getName nt_ >#< "..." help = wfill ["There are attributes and/or rules for nonterminal" , getName nt_ ,", but there is no definition" , "for" ,getName nt_, ". Maybe you misspelled it? Otherwise insert a definition." ] act = wfill ["Everything regarding the unknown nonterminal has been ignored."] in ppError (isError _lhsIoptions _me) (getPos nt_) mesg pat help act _lhsIverbose {-# LINE 706 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule34 #-} rule34 = \ nt_ -> UndefNont nt_ {-# INLINE rule35 #-} rule35 = \ _me -> _me {-# NOINLINE sem_Error_UndefAlt #-} sem_Error_UndefAlt :: (NontermIdent) -> (ConstructorIdent) -> T_Error sem_Error_UndefAlt arg_nt_ arg_con_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule36 _lhsIoptions _lhsIverbose _me arg_con_ arg_nt_ _me = rule37 arg_con_ arg_nt_ _lhsOme :: Error _lhsOme = rule38 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule36 #-} {-# LINE 268 "src-ag/PrintErrorMessages.ag" #-} rule36 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ nt_ -> {-# LINE 268 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_, "is not defined." ] pat = "DATA" >#< getName nt_ >-< indent 2 ("|" >#< getName con_ >#< "...") help = wfill ["There are rules for alternative", getName con_ , "of nonterminal" ,getName nt_ ,", but there is no definition for this alternative in the definitions of the" ,"nonterminal" , getName nt_, ". Maybe you misspelled it? Otherwise insert a definition." ] act = wfill ["All rules for the unknown alternative have been ignored."] in ppError (isError _lhsIoptions _me) (getPos con_) mesg pat help act _lhsIverbose {-# LINE 742 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule37 #-} rule37 = \ con_ nt_ -> UndefAlt nt_ con_ {-# INLINE rule38 #-} rule38 = \ _me -> _me {-# NOINLINE sem_Error_UndefChild #-} sem_Error_UndefChild :: (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> T_Error sem_Error_UndefChild arg_nt_ arg_con_ arg_name_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule39 _lhsIoptions _lhsIverbose _me arg_con_ arg_name_ arg_nt_ _me = rule40 arg_con_ arg_name_ arg_nt_ _lhsOme :: Error _lhsOme = rule41 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule39 #-} {-# LINE 280 "src-ag/PrintErrorMessages.ag" #-} rule39 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ name_ nt_ -> {-# LINE 280 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_ , "does not have a nontrivial field named", getName name_ , "." ] pat = "SEM" >#< nt_ >-< indent 2 ("|" >#< getName con_ >#< ppAttr name_ (identifier "") >#< "= ...") help = wfill ["There are rules that define or use attributes of field" , getName name_ ,"in alternative" , getName con_ , "of nonterminal" , getName nt_ ,", but there is no field with AG-type in the definition of the alternative." ,"Maybe you misspelled it? Otherwise insert the field into the definition," ,"or change its type from an HS-type to an AG-type." ] act = wfill ["All rules for the unknown field have been ignored."] in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose {-# LINE 781 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule40 #-} rule40 = \ con_ name_ nt_ -> UndefChild nt_ con_ name_ {-# INLINE rule41 #-} rule41 = \ _me -> _me {-# NOINLINE sem_Error_MissingRule #-} sem_Error_MissingRule :: (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> (Identifier) -> T_Error sem_Error_MissingRule arg_nt_ arg_con_ arg_field_ arg_attr_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule42 _lhsIoptions _lhsIverbose _me arg_attr_ arg_con_ arg_field_ arg_nt_ _me = rule43 arg_attr_ arg_con_ arg_field_ arg_nt_ _lhsOme :: Error _lhsOme = rule44 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule42 #-} {-# LINE 295 "src-ag/PrintErrorMessages.ag" #-} rule42 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ field_ nt_ -> {-# LINE 295 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Missing rule for", showAttrDef field_ attr_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"." ] pat = "SEM" >#< nt_ >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") help = wfill ["The", showAttrDef field_ attr_, "in alternative", getName con_ , "of nonterminal", getName nt_, "is missing and cannot be inferred" ,"by a copy rule, so you should add an appropriate rule." ] act = wfill ["The value of the attribute has been set to undefined."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose {-# LINE 818 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule43 #-} rule43 = \ attr_ con_ field_ nt_ -> MissingRule nt_ con_ field_ attr_ {-# INLINE rule44 #-} rule44 = \ _me -> _me {-# NOINLINE sem_Error_MissingNamedRule #-} sem_Error_MissingNamedRule :: (NontermIdent) -> (Identifier) -> (Identifier) -> T_Error sem_Error_MissingNamedRule arg_nt_ arg_con_ arg_name_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule45 _lhsIoptions _lhsIverbose _me arg_con_ arg_name_ arg_nt_ _me = rule46 arg_con_ arg_name_ arg_nt_ _lhsOme :: Error _lhsOme = rule47 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule45 #-} {-# LINE 308 "src-ag/PrintErrorMessages.ag" #-} rule45 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ name_ nt_ -> {-# LINE 308 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Missing rule name ", show name_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"." ] pat = "SEM" >#< nt_ >-< indent 2 ("|" >#< getName con_ >#< show name_ >#< ": ... = ...") help = wfill ["There is a dependency on a rule with name ", show name_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,", but no rule has been defined with this name. Maybe you misspelled it?" ] act = wfill ["Compilation cannot continue."] in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose {-# LINE 854 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule46 #-} rule46 = \ con_ name_ nt_ -> MissingNamedRule nt_ con_ name_ {-# INLINE rule47 #-} rule47 = \ _me -> _me {-# NOINLINE sem_Error_SuperfluousRule #-} sem_Error_SuperfluousRule :: (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> (Identifier) -> T_Error sem_Error_SuperfluousRule arg_nt_ arg_con_ arg_field_ arg_attr_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule48 _lhsIoptions _lhsIverbose _me arg_attr_ arg_con_ arg_field_ arg_nt_ _me = rule49 arg_attr_ arg_con_ arg_field_ arg_nt_ _lhsOme :: Error _lhsOme = rule50 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule48 #-} {-# LINE 320 "src-ag/PrintErrorMessages.ag" #-} rule48 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ field_ nt_ -> {-# LINE 320 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Rule for non-existing", showAttrDef field_ attr_ , "at alternative" , getName con_ , "of nonterminal",getName nt_, "." ] pat = "SEM" >#< getName nt_ >-< indent 2 ("|" >#< getName con_ >#< ppAttr field_ attr_ >#< "= ...") help = wfill ["There is a rule for" , showAttrDef field_ attr_ , "in the definitions for alternative" , getName con_ ,"of nonterminal" , getName nt_, ", but this attribute does not exist. Maybe you misspelled it?" ,"Otherwise either remove the rule or add an appropriate attribute definition." ] act = wfill ["The rule has been ignored."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose {-# LINE 891 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule49 #-} rule49 = \ attr_ con_ field_ nt_ -> SuperfluousRule nt_ con_ field_ attr_ {-# INLINE rule50 #-} rule50 = \ _me -> _me {-# NOINLINE sem_Error_UndefLocal #-} sem_Error_UndefLocal :: (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> T_Error sem_Error_UndefLocal arg_nt_ arg_con_ arg_var_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule51 _lhsIoptions _lhsIverbose _me arg_con_ arg_nt_ arg_var_ _me = rule52 arg_con_ arg_nt_ arg_var_ _lhsOme :: Error _lhsOme = rule53 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule51 #-} {-# LINE 334 "src-ag/PrintErrorMessages.ag" #-} rule51 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ nt_ var_ -> {-# LINE 334 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Undefined local variable or field",getName var_, "at constructor" , getName con_ , "of nonterminal",getName nt_, "." ] pat = "SEM" >#< getName nt_ >-< indent 2 ("|" >#< getName con_ >#< ". = " >#< "..." >#< "@" >|< getName var_ >#< "..." ) help = wfill ["A rule in the definitions for alternative" , getName con_ ,"of nonterminal" , getName nt_ , "contains a local variable or field name that is not defined. " ,"Maybe you misspelled it?" ,"Otherwise either remove the rule or add an appropriate definition." ] act = wfill ["The generated program will not run."] in ppError (isError _lhsIoptions _me) (getPos var_) mesg pat help act _lhsIverbose {-# LINE 930 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule52 #-} rule52 = \ con_ nt_ var_ -> UndefLocal nt_ con_ var_ {-# INLINE rule53 #-} rule53 = \ _me -> _me {-# NOINLINE sem_Error_ChildAsLocal #-} sem_Error_ChildAsLocal :: (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> T_Error sem_Error_ChildAsLocal arg_nt_ arg_con_ arg_var_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule54 _lhsIoptions _lhsIverbose _me arg_con_ arg_nt_ arg_var_ _me = rule55 arg_con_ arg_nt_ arg_var_ _lhsOme :: Error _lhsOme = rule56 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule54 #-} {-# LINE 349 "src-ag/PrintErrorMessages.ag" #-} rule54 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ nt_ var_ -> {-# LINE 349 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Nontrivial field ",getName var_, "is used as local at constructor" , getName con_ , "of nonterminal",getName nt_, "." ] pat = "SEM" >#< getName nt_ >-< indent 2 ("|" >#< getName con_ >#< "... = " >#< "..." >#< "@" >|< getName var_ >#< "..." ) help = wfill ["A rule in the definitions for alternative" , getName con_ ,"of nonterminal" , getName nt_ , "contains a nontrivial field name", getName var_, "." ,"You should use @", getName var_, ".self instead, where self is a SELF-attribute." ] act = wfill ["The generated program probably contains a type error or has undefined variables."] in ppError (isError _lhsIoptions _me) (getPos var_) mesg pat help act _lhsIverbose {-# LINE 968 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule55 #-} rule55 = \ con_ nt_ var_ -> ChildAsLocal nt_ con_ var_ {-# INLINE rule56 #-} rule56 = \ _me -> _me {-# NOINLINE sem_Error_UndefAttr #-} sem_Error_UndefAttr :: (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> (Identifier) -> (Bool) -> T_Error sem_Error_UndefAttr arg_nt_ arg_con_ arg_field_ arg_attr_ arg_isOut_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule57 _lhsIoptions _lhsIverbose _me arg_attr_ arg_con_ arg_field_ arg_isOut_ arg_nt_ _me = rule58 arg_attr_ arg_con_ arg_field_ arg_isOut_ arg_nt_ _lhsOme :: Error _lhsOme = rule59 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule57 #-} {-# LINE 363 "src-ag/PrintErrorMessages.ag" #-} rule57 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ field_ isOut_ nt_ -> {-# LINE 363 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Undefined" , if isOut_ then showAttrDef field_ attr_ else showAttrUse field_ attr_ , "at constructor" , getName con_ , "of nonterminal",getName nt_, "." ] pat = "SEM" >#< getName nt_ >-< indent 2 ("|" >#< getName con_ >#< ". = " >#< "..." >#< ppAttrUse field_ attr_ >#< "...") help = wfill ["A rule in the definitions for alternative" , getName con_ ,"of nonterminal" ,getName nt_ , "contains an attribute that is not defined" ,"Maybe you misspelled it?" ,"Otherwise either remove the rule or add an appropriate attribute definition." ] act = wfill ["The generated program will not run."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose {-# LINE 1011 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule58 #-} rule58 = \ attr_ con_ field_ isOut_ nt_ -> UndefAttr nt_ con_ field_ attr_ isOut_ {-# INLINE rule59 #-} rule59 = \ _me -> _me {-# NOINLINE sem_Error_Cyclic #-} sem_Error_Cyclic :: (NontermIdent) -> (Maybe ConstructorIdent) -> ([String]) -> T_Error sem_Error_Cyclic arg_nt_ arg_mbCon_ arg_verts_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule60 _lhsIoptions _me arg_mbCon_ arg_nt_ arg_verts_ _me = rule61 arg_mbCon_ arg_nt_ arg_verts_ _lhsOme :: Error _lhsOme = rule62 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule60 #-} {-# LINE 391 "src-ag/PrintErrorMessages.ag" #-} rule60 = \ ((_lhsIoptions) :: Options) _me mbCon_ nt_ verts_ -> {-# LINE 391 "src-ag/PrintErrorMessages.ag" #-} let pos = getPos nt_ mesg = text "Circular dependency for nonterminal" >#< getName nt_ >#< ( case mbCon_ of Nothing -> empty Just con -> text "and constructor" >#< con ) >#< ( case verts_ of v : _ -> text "including vertex" >#< text v _ -> empty ) pat = text "cyclic rule definition" help = hlist (text "The following attributes are all cyclic: " : map text verts_) act = wfill ["code cannot be generated until the cycle is removed."] in ppError (isError _lhsIoptions _me) pos mesg pat help act False {-# LINE 1051 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule61 #-} rule61 = \ mbCon_ nt_ verts_ -> Cyclic nt_ mbCon_ verts_ {-# INLINE rule62 #-} rule62 = \ _me -> _me {-# NOINLINE sem_Error_CyclicSet #-} sem_Error_CyclicSet :: (Identifier) -> T_Error sem_Error_CyclicSet arg_name_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule63 _lhsIoptions _lhsIverbose _me arg_name_ _me = rule64 arg_name_ _lhsOme :: Error _lhsOme = rule65 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule63 #-} {-# LINE 382 "src-ag/PrintErrorMessages.ag" #-} rule63 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me name_ -> {-# LINE 382 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Cyclic definition for nonterminal set", getName name_] pat = "SET" >#< getName name_ >#< "=" >#< "..." >#< getName name_ >#< "..." help = wfill ["The defintion for a nonterminal set named" , getName name_ ,"directly or indirectly refers to itself." ,"Adapt the definition of the nonterminal set, to remove the cyclic dependency." ] act = wfill ["The nonterminal set", getName name_, "is considered to be empty."] in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose {-# LINE 1085 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule64 #-} rule64 = \ name_ -> CyclicSet name_ {-# INLINE rule65 #-} rule65 = \ _me -> _me {-# NOINLINE sem_Error_CustomError #-} sem_Error_CustomError :: (Bool) -> (Pos) -> (PP_Doc) -> T_Error sem_Error_CustomError arg_isWarning_ arg_pos_ arg_mesg_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule66 _lhsIoptions _me arg_mesg_ arg_pos_ _me = rule67 arg_isWarning_ arg_mesg_ arg_pos_ _lhsOme :: Error _lhsOme = rule68 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule66 #-} {-# LINE 406 "src-ag/PrintErrorMessages.ag" #-} rule66 = \ ((_lhsIoptions) :: Options) _me mesg_ pos_ -> {-# LINE 406 "src-ag/PrintErrorMessages.ag" #-} let pat = text "unknown" help = wfill ["not available."] act = wfill ["unknown"] in ppError (isError _lhsIoptions _me) pos_ mesg_ pat help act False {-# LINE 1115 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule67 #-} rule67 = \ isWarning_ mesg_ pos_ -> CustomError isWarning_ pos_ mesg_ {-# INLINE rule68 #-} rule68 = \ _me -> _me {-# NOINLINE sem_Error_LocalCirc #-} sem_Error_LocalCirc :: (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> (Bool) -> ([String]) -> T_Error sem_Error_LocalCirc arg_nt_ arg_con_ arg_attr_ arg_o_visit_ arg_path_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule69 _lhsIoptions _lhsIverbose _me arg_attr_ arg_con_ arg_nt_ arg_o_visit_ arg_path_ _me = rule70 arg_attr_ arg_con_ arg_nt_ arg_o_visit_ arg_path_ _lhsOme :: Error _lhsOme = rule71 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule69 #-} {-# LINE 411 "src-ag/PrintErrorMessages.ag" #-} rule69 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ nt_ o_visit_ path_ -> {-# LINE 411 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Circular dependency for local attribute", getName attr_ , "of alternative", getName con_, "of nonterminal", getName nt_] pat = "SEM" >#< getName nt_ >-< indent 2 ("|" >#< getName con_ >#< "loc." >|< getName attr_ >#< "=" >#< "..." >#< "@loc." >|< getName attr_ >#< "...") help = if null path_ then text "the definition is directly circular" else hlist ("The following attributes are involved in the cycle:": path_) act | o_visit_ = text "An unoptimized version was generated. It might hang when run." | otherwise = text "The generated program might hang when run." in ppError (isError _lhsIoptions _me) (getPos (attr_)) mesg pat help act _lhsIverbose {-# LINE 1152 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule70 #-} rule70 = \ attr_ con_ nt_ o_visit_ path_ -> LocalCirc nt_ con_ attr_ o_visit_ path_ {-# INLINE rule71 #-} rule71 = \ _me -> _me {-# NOINLINE sem_Error_InstCirc #-} sem_Error_InstCirc :: (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> (Bool) -> ([String]) -> T_Error sem_Error_InstCirc arg_nt_ arg_con_ arg_attr_ arg_o_visit_ arg_path_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule72 _lhsIoptions _lhsIverbose _me arg_attr_ arg_con_ arg_nt_ arg_o_visit_ arg_path_ _me = rule73 arg_attr_ arg_con_ arg_nt_ arg_o_visit_ arg_path_ _lhsOme :: Error _lhsOme = rule74 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule72 #-} {-# LINE 423 "src-ag/PrintErrorMessages.ag" #-} rule72 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ nt_ o_visit_ path_ -> {-# LINE 423 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Circular dependency for inst attribute", getName attr_ , "of alternative", getName con_, "of nonterminal", getName nt_] pat = "SEM" >#< getName nt_ >-< indent 2 ("|" >#< getName con_ >#< "inst." >|< getName attr_ >#< "=" >#< "..." >#< "@s." >#< "...") help = if null path_ then text "the definition is directly circular" else hlist ("The following attributes are involved in the cycle:": path_) act | o_visit_ = text "An unoptimized version was generated. It might hang when run." | otherwise = text "The generated program might hang when run." in ppError (isError _lhsIoptions _me) (getPos (attr_)) mesg pat help act _lhsIverbose {-# LINE 1189 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule73 #-} rule73 = \ attr_ con_ nt_ o_visit_ path_ -> InstCirc nt_ con_ attr_ o_visit_ path_ {-# INLINE rule74 #-} rule74 = \ _me -> _me {-# NOINLINE sem_Error_DirectCirc #-} sem_Error_DirectCirc :: (NontermIdent) -> (Bool) -> ([((Identifier,Identifier),[String],[String])]) -> T_Error sem_Error_DirectCirc arg_nt_ arg_o_visit_ arg_cyclic_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule75 _lhsIoptions _lhsIverbose _me arg_cyclic_ arg_nt_ arg_o_visit_ _me = rule76 arg_cyclic_ arg_nt_ arg_o_visit_ _lhsOme :: Error _lhsOme = rule77 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule75 #-} {-# LINE 435 "src-ag/PrintErrorMessages.ag" #-} rule75 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me cyclic_ nt_ o_visit_ -> {-# LINE 435 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["In nonterminal", getName nt_, "synthesized and inherited attributes are mutually dependent" ] >-< vlist (map showEdge cyclic_) pat = text "" help = vlist (map showEdgeLong cyclic_) act | o_visit_ = text "An unoptimized version was generated. It might hang when run." | otherwise = text "The generated program might hang when run." in ppError (isError _lhsIoptions _me) noPos mesg pat help act _lhsIverbose {-# LINE 1222 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule76 #-} rule76 = \ cyclic_ nt_ o_visit_ -> DirectCirc nt_ o_visit_ cyclic_ {-# INLINE rule77 #-} rule77 = \ _me -> _me {-# NOINLINE sem_Error_InducedCirc #-} sem_Error_InducedCirc :: (NontermIdent) -> (CInterface) -> ([((Identifier,Identifier),[String],[String])]) -> T_Error sem_Error_InducedCirc arg_nt_ arg_cinter_ arg_cyclic_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule78 _lhsIoptions _lhsIverbose _me arg_cinter_ arg_cyclic_ arg_nt_ _me = rule79 arg_cinter_ arg_cyclic_ arg_nt_ _lhsOme :: Error _lhsOme = rule80 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule78 #-} {-# LINE 443 "src-ag/PrintErrorMessages.ag" #-} rule78 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me cinter_ cyclic_ nt_ -> {-# LINE 443 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["After scheduling, in nonterminal", getName nt_, "synthesized and inherited attributes have an INDUCED mutual dependency" ] >-< vlist (map showEdge cyclic_) pat = text "" showInter (CInterface segs) = concat (snd (mapAccumL (\i c -> (succ i :: Integer,("visit " ++ show i) : map ind (showsSegment c))) 0 segs)) help = vlist (("Interface for nonterminal " ++ getName nt_ ++ ":") : map ind (showInter cinter_)) >-< vlist (map showEdgeLong cyclic_) act = text "An unoptimized version was generated. It might hang when run." in ppError (isError _lhsIoptions _me) noPos mesg pat help act _lhsIverbose {-# LINE 1256 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule79 #-} rule79 = \ cinter_ cyclic_ nt_ -> InducedCirc nt_ cinter_ cyclic_ {-# INLINE rule80 #-} rule80 = \ _me -> _me {-# NOINLINE sem_Error_MissingTypeSig #-} sem_Error_MissingTypeSig :: (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> T_Error sem_Error_MissingTypeSig arg_nt_ arg_con_ arg_attr_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule81 _lhsIoptions _lhsIverbose _me arg_attr_ arg_con_ arg_nt_ _me = rule82 arg_attr_ arg_con_ arg_nt_ _lhsOme :: Error _lhsOme = rule83 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule81 #-} {-# LINE 452 "src-ag/PrintErrorMessages.ag" #-} rule81 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ nt_ -> {-# LINE 452 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Type signature needed, but not found for", showAttrDef _LOC attr_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"." ]>-< wfill ["Location:", (showPos attr_),"."] pat = "SEM" >#< nt_ >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< ": ...") help = wfill ["The", showAttrDef _LOC attr_, "in alternative", getName con_ ,"of nonterminal", getName nt_, "is needed in two separate visits to", getName nt_ ,"so its type is needed to generate type signatures." ,"Please supply its type." ] act = wfill ["The type signatures of semantic functions are not generated."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose {-# LINE 1295 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule82 #-} rule82 = \ attr_ con_ nt_ -> MissingTypeSig nt_ con_ attr_ {-# INLINE rule83 #-} rule83 = \ _me -> _me {-# NOINLINE sem_Error_MissingInstSig #-} sem_Error_MissingInstSig :: (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> T_Error sem_Error_MissingInstSig arg_nt_ arg_con_ arg_attr_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule84 _lhsIoptions _lhsIverbose _me arg_attr_ arg_con_ arg_nt_ _me = rule85 arg_attr_ arg_con_ arg_nt_ _lhsOme :: Error _lhsOme = rule86 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule84 #-} {-# LINE 466 "src-ag/PrintErrorMessages.ag" #-} rule84 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ nt_ -> {-# LINE 466 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Type signature needed, but not found for", showAttrDef _INST attr_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"." ]>-< wfill ["Location:", (showPos attr_),"."] pat = "SEM" >#< nt_ >-< indent 2 ("|" >#< getName con_ >#< ppAttr _INST attr_ >#< ": ...") help = wfill ["The", showAttrDef _INST attr_, "in alternative", getName con_ ,"of nonterminal", getName nt_, "is a non-terminal attribute, so " ,"its type is needed to attribute its value." ,"Please supply its type." ] act = wfill ["It is not possible to proceed without this signature."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose {-# LINE 1334 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule85 #-} rule85 = \ attr_ con_ nt_ -> MissingInstSig nt_ con_ attr_ {-# INLINE rule86 #-} rule86 = \ _me -> _me {-# NOINLINE sem_Error_DupUnique #-} sem_Error_DupUnique :: (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> T_Error sem_Error_DupUnique arg_nt_ arg_con_ arg_attr_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule87 _lhsIoptions _lhsIverbose _me arg_attr_ arg_con_ arg_nt_ _me = rule88 arg_attr_ arg_con_ arg_nt_ _lhsOme :: Error _lhsOme = rule89 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule87 #-} {-# LINE 496 "src-ag/PrintErrorMessages.ag" #-} rule87 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ nt_ -> {-# LINE 496 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more unique-attribute signatures for" ,showAttrDef _LOC attr_,"." ] >-< wfill ["First signature:", (showPos attr_),"."] pat = "SEM" >#< getName nt_ >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< " : UNIQUEREF ...") >-< indent 2 ("|" >#< getName con_ >#< ppAttr _LOC attr_ >#< " : UNIQUEREF ...") help = wfill ["In the rules for alternative" , getName con_ , "of nonterminal" , getName nt_ ,", there is more than one unique-attribute signature for the" , showAttrDef _LOC attr_ ,". You should remove enough of them to make all unique-signatures for alternative" ,getName con_ , "of nonterminal " ,getName nt_ , "unique." ] act = wfill ["Unpredicatable sharing of unique numbers may occur."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose {-# LINE 1374 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule88 #-} rule88 = \ attr_ con_ nt_ -> DupUnique nt_ con_ attr_ {-# INLINE rule89 #-} rule89 = \ _me -> _me {-# NOINLINE sem_Error_MissingUnique #-} sem_Error_MissingUnique :: (NontermIdent) -> (Identifier) -> T_Error sem_Error_MissingUnique arg_nt_ arg_attr_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule90 _lhsIoptions _lhsIverbose _me arg_attr_ arg_nt_ _me = rule91 arg_attr_ arg_nt_ _lhsOme :: Error _lhsOme = rule92 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule90 #-} {-# LINE 480 "src-ag/PrintErrorMessages.ag" #-} rule90 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ nt_ -> {-# LINE 480 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Missing unique counter (chained attribute)" , getName attr_ , "at nonterminal" , getName nt_, "." ] pat = "ATTR" >#< getName nt_ >#< "[ |" >#< getName attr_ >#< " : ... | ]" help = wfill ["A unique attribute signature in a constructor for nonterminal" , getName nt_ , "refers to an unique counter (chained attribute) named " , getName attr_ ,"Maybe you misspelled it?" ,"Otherwise either remove the signature or add an appropriate attribute definition." ] act = wfill ["It is not possible to proceed without this declaration."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose {-# LINE 1414 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule91 #-} rule91 = \ attr_ nt_ -> MissingUnique nt_ attr_ {-# INLINE rule92 #-} rule92 = \ _me -> _me {-# NOINLINE sem_Error_MissingSyn #-} sem_Error_MissingSyn :: (NontermIdent) -> (Identifier) -> T_Error sem_Error_MissingSyn arg_nt_ arg_attr_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule93 _lhsIoptions _lhsIverbose _me arg_attr_ arg_nt_ _me = rule94 arg_attr_ arg_nt_ _lhsOme :: Error _lhsOme = rule95 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule93 #-} {-# LINE 513 "src-ag/PrintErrorMessages.ag" #-} rule93 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ nt_ -> {-# LINE 513 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Missing synthesized attribute" , getName attr_ , "at nonterminal" , getName nt_, "." ] pat = "ATTR" >#< getName nt_ >#< "[ | | " >#< getName attr_ >#< " : ... ]" help = wfill ["An augment rule for a constructor for nonterminal" , getName nt_ , "refers to a synthesized attribute named " , getName attr_ ,"Maybe you misspelled it?" ,"Otherwise add an appropriate attribute definition." ] act = wfill ["It is not possible to proceed without this declaration."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose {-# LINE 1454 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule94 #-} rule94 = \ attr_ nt_ -> MissingSyn nt_ attr_ {-# INLINE rule95 #-} rule95 = \ _me -> _me {-# NOINLINE sem_Error_IncompatibleVisitKind #-} sem_Error_IncompatibleVisitKind :: (Identifier) -> (VisitIdentifier) -> (VisitKind) -> (VisitKind) -> T_Error sem_Error_IncompatibleVisitKind arg_child_ arg_vis_ arg_from_ arg_to_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule96 _lhsIoptions _lhsIverbose _me arg_child_ arg_from_ arg_to_ arg_vis_ _me = rule97 arg_child_ arg_from_ arg_to_ arg_vis_ _lhsOme :: Error _lhsOme = rule98 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule96 #-} {-# LINE 529 "src-ag/PrintErrorMessages.ag" #-} rule96 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me child_ from_ to_ vis_ -> {-# LINE 529 "src-ag/PrintErrorMessages.ag" #-} let mesg = "visit" >#< vis_ >#< "of child" >#< child_ >#< " with kind" >#< show to_ >#< " cannot be called from a visit with kind " >#< show from_ pat = empty help = empty act = text "It is not possible to proceed without fixing this kind error." in ppError (isError _lhsIoptions _me) (getPos child_) mesg pat help act _lhsIverbose {-# LINE 1485 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule97 #-} rule97 = \ child_ from_ to_ vis_ -> IncompatibleVisitKind child_ vis_ from_ to_ {-# INLINE rule98 #-} rule98 = \ _me -> _me {-# NOINLINE sem_Error_IncompatibleRuleKind #-} sem_Error_IncompatibleRuleKind :: (Identifier) -> (VisitKind) -> T_Error sem_Error_IncompatibleRuleKind arg_rule_ arg_kind_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule99 _lhsIoptions _lhsIverbose _me arg_kind_ arg_rule_ _me = rule100 arg_kind_ arg_rule_ _lhsOme :: Error _lhsOme = rule101 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule99 #-} {-# LINE 535 "src-ag/PrintErrorMessages.ag" #-} rule99 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me kind_ rule_ -> {-# LINE 535 "src-ag/PrintErrorMessages.ag" #-} let mesg = "rule" >#< rule_ >#< "cannot be called from a visit with kind " >#< show kind_ pat = empty help = empty act = text "It is not possible to proceed without fixing this kind error." in ppError (isError _lhsIoptions _me) (getPos rule_) mesg pat help act _lhsIverbose {-# LINE 1516 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule100 #-} rule100 = \ kind_ rule_ -> IncompatibleRuleKind rule_ kind_ {-# INLINE rule101 #-} rule101 = \ _me -> _me {-# NOINLINE sem_Error_IncompatibleAttachKind #-} sem_Error_IncompatibleAttachKind :: (Identifier) -> (VisitKind) -> T_Error sem_Error_IncompatibleAttachKind arg_child_ arg_kind_ = T_Error (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Error_v1 v1 = \ (T_Error_vIn1 _lhsIoptions _lhsIverbose) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule102 _lhsIoptions _lhsIverbose _me arg_child_ arg_kind_ _me = rule103 arg_child_ arg_kind_ _lhsOme :: Error _lhsOme = rule104 _me __result_ = T_Error_vOut1 _lhsOme _lhsOpp in __result_ ) in C_Error_s2 v1 {-# INLINE rule102 #-} {-# LINE 542 "src-ag/PrintErrorMessages.ag" #-} rule102 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me child_ kind_ -> {-# LINE 542 "src-ag/PrintErrorMessages.ag" #-} let mesg = "child" >#< child_ >#< "cannot be called from a visit with kind " >#< show kind_ pat = empty help = empty act = text "It is not possible to proceed without fixing this kind error." in ppError (isError _lhsIoptions _me) (getPos child_) mesg pat help act _lhsIverbose {-# LINE 1547 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule103 #-} rule103 = \ child_ kind_ -> IncompatibleAttachKind child_ kind_ {-# INLINE rule104 #-} rule104 = \ _me -> _me -- Errors ------------------------------------------------------ -- wrapper data Inh_Errors = Inh_Errors { dups_Inh_Errors :: ([String]), options_Inh_Errors :: (Options) } data Syn_Errors = Syn_Errors { pp_Syn_Errors :: (PP_Doc) } {-# INLINABLE wrap_Errors #-} wrap_Errors :: T_Errors -> Inh_Errors -> (Syn_Errors ) wrap_Errors (T_Errors act) (Inh_Errors _lhsIdups _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_Errors_vIn4 _lhsIdups _lhsIoptions (T_Errors_vOut4 _lhsOpp) <- return (inv_Errors_s5 sem arg4) return (Syn_Errors _lhsOpp) ) -- cata {-# NOINLINE sem_Errors #-} sem_Errors :: Errors -> T_Errors sem_Errors list = Prelude.foldr sem_Errors_Cons sem_Errors_Nil (Prelude.map sem_Error list) -- semantic domain newtype T_Errors = T_Errors { attach_T_Errors :: Identity (T_Errors_s5 ) } newtype T_Errors_s5 = C_Errors_s5 { inv_Errors_s5 :: (T_Errors_v4 ) } data T_Errors_s6 = C_Errors_s6 type T_Errors_v4 = (T_Errors_vIn4 ) -> (T_Errors_vOut4 ) data T_Errors_vIn4 = T_Errors_vIn4 ([String]) (Options) data T_Errors_vOut4 = T_Errors_vOut4 (PP_Doc) {-# NOINLINE sem_Errors_Cons #-} sem_Errors_Cons :: T_Error -> T_Errors -> T_Errors sem_Errors_Cons arg_hd_ arg_tl_ = T_Errors (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_Errors_v4 v4 = \ (T_Errors_vIn4 _lhsIdups _lhsIoptions) -> ( let _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Error (arg_hd_)) _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Errors (arg_tl_)) (T_Error_vOut1 _hdIme _hdIpp) = inv_Error_s2 _hdX2 (T_Error_vIn1 _hdOoptions _hdOverbose) (T_Errors_vOut4 _tlIpp) = inv_Errors_s5 _tlX5 (T_Errors_vIn4 _tlOdups _tlOoptions) _verbose = rule105 _lhsIoptions _str = rule106 _hdIpp _lhsOpp :: PP_Doc _lhsOpp = rule107 _hdIpp _lhsIdups _str _tlIpp _tlOdups = rule108 _lhsIdups _str _hdOoptions = rule109 _lhsIoptions _hdOverbose = rule110 _verbose _tlOoptions = rule111 _lhsIoptions __result_ = T_Errors_vOut4 _lhsOpp in __result_ ) in C_Errors_s5 v4 {-# INLINE rule105 #-} {-# LINE 76 "src-ag/PrintErrorMessages.ag" #-} rule105 = \ ((_lhsIoptions) :: Options) -> {-# LINE 76 "src-ag/PrintErrorMessages.ag" #-} verbose _lhsIoptions {-# LINE 1612 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule106 #-} {-# LINE 77 "src-ag/PrintErrorMessages.ag" #-} rule106 = \ ((_hdIpp) :: PP_Doc) -> {-# LINE 77 "src-ag/PrintErrorMessages.ag" #-} disp _hdIpp 5000 "" {-# LINE 1618 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule107 #-} {-# LINE 79 "src-ag/PrintErrorMessages.ag" #-} rule107 = \ ((_hdIpp) :: PP_Doc) ((_lhsIdups) :: [String]) _str ((_tlIpp) :: PP_Doc) -> {-# LINE 79 "src-ag/PrintErrorMessages.ag" #-} if _str `elem` _lhsIdups then _tlIpp else _hdIpp >-< _tlIpp {-# LINE 1626 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule108 #-} {-# LINE 82 "src-ag/PrintErrorMessages.ag" #-} rule108 = \ ((_lhsIdups) :: [String]) _str -> {-# LINE 82 "src-ag/PrintErrorMessages.ag" #-} _str : _lhsIdups {-# LINE 1632 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule109 #-} rule109 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule110 #-} rule110 = \ _verbose -> _verbose {-# INLINE rule111 #-} rule111 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_Errors_Nil #-} sem_Errors_Nil :: T_Errors sem_Errors_Nil = T_Errors (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_Errors_v4 v4 = \ (T_Errors_vIn4 _lhsIdups _lhsIoptions) -> ( let _verbose = rule112 _lhsIoptions _lhsOpp :: PP_Doc _lhsOpp = rule113 () __result_ = T_Errors_vOut4 _lhsOpp in __result_ ) in C_Errors_s5 v4 {-# INLINE rule112 #-} {-# LINE 76 "src-ag/PrintErrorMessages.ag" #-} rule112 = \ ((_lhsIoptions) :: Options) -> {-# LINE 76 "src-ag/PrintErrorMessages.ag" #-} verbose _lhsIoptions {-# LINE 1660 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule113 #-} {-# LINE 83 "src-ag/PrintErrorMessages.ag" #-} rule113 = \ (_ :: ()) -> {-# LINE 83 "src-ag/PrintErrorMessages.ag" #-} text "" {-# LINE 1666 "dist/build/PrintErrorMessages.hs"#-} uuagc-0.9.52.2/src-generated/AbstractSyntaxDump.hs0000644000000000000000000014337013433540502020127 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module AbstractSyntaxDump where {-# LINE 2 "src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken {-# LINE 10 "dist/build/AbstractSyntaxDump.hs" #-} {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 17 "dist/build/AbstractSyntaxDump.hs" #-} {-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) import Data.Map(Map) import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import Macro --marcos import CommonTypes import ErrorMessages {-# LINE 29 "dist/build/AbstractSyntaxDump.hs" #-} {-# LINE 6 "src-ag/AbstractSyntaxDump.ag" #-} import Data.List import qualified Data.Map as Map import Pretty import PPUtil import AbstractSyntax import TokenDef {-# LINE 41 "dist/build/AbstractSyntaxDump.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -- Child ------------------------------------------------------- -- wrapper data Inh_Child = Inh_Child { } data Syn_Child = Syn_Child { pp_Syn_Child :: (PP_Doc) } {-# INLINABLE wrap_Child #-} wrap_Child :: T_Child -> Inh_Child -> (Syn_Child ) wrap_Child (T_Child act) (Inh_Child ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_Child_vIn1 (T_Child_vOut1 _lhsOpp) <- return (inv_Child_s2 sem arg1) return (Syn_Child _lhsOpp) ) -- cata {-# INLINE sem_Child #-} sem_Child :: Child -> T_Child sem_Child ( Child name_ tp_ kind_ ) = sem_Child_Child name_ tp_ kind_ -- semantic domain newtype T_Child = T_Child { attach_T_Child :: Identity (T_Child_s2 ) } newtype T_Child_s2 = C_Child_s2 { inv_Child_s2 :: (T_Child_v1 ) } data T_Child_s3 = C_Child_s3 type T_Child_v1 = (T_Child_vIn1 ) -> (T_Child_vOut1 ) data T_Child_vIn1 = T_Child_vIn1 data T_Child_vOut1 = T_Child_vOut1 (PP_Doc) {-# NOINLINE sem_Child_Child #-} sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child sem_Child_Child arg_name_ arg_tp_ arg_kind_ = T_Child (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Child_v1 v1 = \ (T_Child_vIn1 ) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule0 arg_kind_ arg_name_ arg_tp_ __result_ = T_Child_vOut1 _lhsOpp in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} {-# LINE 35 "src-ag/AbstractSyntaxDump.ag" #-} rule0 = \ kind_ name_ tp_ -> {-# LINE 35 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Child","Child"] [pp name_, ppShow tp_] [ppF "kind" $ ppShow kind_] [] {-# LINE 91 "dist/build/AbstractSyntaxDump.hs"#-} -- Children ---------------------------------------------------- -- wrapper data Inh_Children = Inh_Children { } data Syn_Children = Syn_Children { pp_Syn_Children :: (PP_Doc), ppL_Syn_Children :: ([PP_Doc]) } {-# INLINABLE wrap_Children #-} wrap_Children :: T_Children -> Inh_Children -> (Syn_Children ) wrap_Children (T_Children act) (Inh_Children ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_Children_vIn4 (T_Children_vOut4 _lhsOpp _lhsOppL) <- return (inv_Children_s5 sem arg4) return (Syn_Children _lhsOpp _lhsOppL) ) -- cata {-# NOINLINE sem_Children #-} sem_Children :: Children -> T_Children sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) -- semantic domain newtype T_Children = T_Children { attach_T_Children :: Identity (T_Children_s5 ) } newtype T_Children_s5 = C_Children_s5 { inv_Children_s5 :: (T_Children_v4 ) } data T_Children_s6 = C_Children_s6 type T_Children_v4 = (T_Children_vIn4 ) -> (T_Children_vOut4 ) data T_Children_vIn4 = T_Children_vIn4 data T_Children_vOut4 = T_Children_vOut4 (PP_Doc) ([PP_Doc]) {-# NOINLINE sem_Children_Cons #-} sem_Children_Cons :: T_Child -> T_Children -> T_Children sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_Children_v4 v4 = \ (T_Children_vIn4 ) -> ( let _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) (T_Child_vOut1 _hdIpp) = inv_Child_s2 _hdX2 (T_Child_vIn1 ) (T_Children_vOut4 _tlIpp _tlIppL) = inv_Children_s5 _tlX5 (T_Children_vIn4 ) _lhsOppL :: [PP_Doc] _lhsOppL = rule1 _hdIpp _tlIppL _lhsOpp :: PP_Doc _lhsOpp = rule2 _hdIpp _tlIpp __result_ = T_Children_vOut4 _lhsOpp _lhsOppL in __result_ ) in C_Children_s5 v4 {-# INLINE rule1 #-} {-# LINE 67 "src-ag/AbstractSyntaxDump.ag" #-} rule1 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> {-# LINE 67 "src-ag/AbstractSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 146 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule2 #-} rule2 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) -> _hdIpp >-< _tlIpp {-# NOINLINE sem_Children_Nil #-} sem_Children_Nil :: T_Children sem_Children_Nil = T_Children (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_Children_v4 v4 = \ (T_Children_vIn4 ) -> ( let _lhsOppL :: [PP_Doc] _lhsOppL = rule3 () _lhsOpp :: PP_Doc _lhsOpp = rule4 () __result_ = T_Children_vOut4 _lhsOpp _lhsOppL in __result_ ) in C_Children_s5 v4 {-# INLINE rule3 #-} {-# LINE 68 "src-ag/AbstractSyntaxDump.ag" #-} rule3 = \ (_ :: ()) -> {-# LINE 68 "src-ag/AbstractSyntaxDump.ag" #-} [] {-# LINE 169 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule4 #-} rule4 = \ (_ :: ()) -> empty -- Expression -------------------------------------------------- -- wrapper data Inh_Expression = Inh_Expression { } data Syn_Expression = Syn_Expression { pp_Syn_Expression :: (PP_Doc) } {-# INLINABLE wrap_Expression #-} wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) wrap_Expression (T_Expression act) (Inh_Expression ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_Expression_vIn7 (T_Expression_vOut7 _lhsOpp) <- return (inv_Expression_s8 sem arg7) return (Syn_Expression _lhsOpp) ) -- cata {-# INLINE sem_Expression #-} sem_Expression :: Expression -> T_Expression sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_ -- semantic domain newtype T_Expression = T_Expression { attach_T_Expression :: Identity (T_Expression_s8 ) } newtype T_Expression_s8 = C_Expression_s8 { inv_Expression_s8 :: (T_Expression_v7 ) } data T_Expression_s9 = C_Expression_s9 type T_Expression_v7 = (T_Expression_vIn7 ) -> (T_Expression_vOut7 ) data T_Expression_vIn7 = T_Expression_vIn7 data T_Expression_vOut7 = T_Expression_vOut7 (PP_Doc) {-# NOINLINE sem_Expression_Expression #-} sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression sem_Expression_Expression arg_pos_ arg_tks_ = T_Expression (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_Expression_v7 v7 = \ (T_Expression_vIn7 ) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule5 arg_pos_ arg_tks_ __result_ = T_Expression_vOut7 _lhsOpp in __result_ ) in C_Expression_s8 v7 {-# INLINE rule5 #-} {-# LINE 50 "src-ag/AbstractSyntaxDump.ag" #-} rule5 = \ pos_ tks_ -> {-# LINE 50 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Expression","Expression"] [ppShow pos_] [ppF "txt" $ vlist . showTokens . tokensToStrings $ tks_] [] {-# LINE 221 "dist/build/AbstractSyntaxDump.hs"#-} -- Grammar ----------------------------------------------------- -- wrapper data Inh_Grammar = Inh_Grammar { } data Syn_Grammar = Syn_Grammar { pp_Syn_Grammar :: (PP_Doc) } {-# INLINABLE wrap_Grammar #-} wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar ) wrap_Grammar (T_Grammar act) (Inh_Grammar ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg10 = T_Grammar_vIn10 (T_Grammar_vOut10 _lhsOpp) <- return (inv_Grammar_s11 sem arg10) return (Syn_Grammar _lhsOpp) ) -- cata {-# INLINE sem_Grammar #-} sem_Grammar :: Grammar -> T_Grammar sem_Grammar ( Grammar typeSyns_ useMap_ derivings_ wrappers_ nonts_ pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ -- semantic domain newtype T_Grammar = T_Grammar { attach_T_Grammar :: Identity (T_Grammar_s11 ) } newtype T_Grammar_s11 = C_Grammar_s11 { inv_Grammar_s11 :: (T_Grammar_v10 ) } data T_Grammar_s12 = C_Grammar_s12 type T_Grammar_v10 = (T_Grammar_vIn10 ) -> (T_Grammar_vOut10 ) data T_Grammar_vIn10 = T_Grammar_vIn10 data T_Grammar_vOut10 = T_Grammar_vOut10 (PP_Doc) {-# NOINLINE sem_Grammar_Grammar #-} sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar sem_Grammar_Grammar arg_typeSyns_ arg_useMap_ arg_derivings_ arg_wrappers_ arg_nonts_ _ _ _ _ _ _ _ _ _ = T_Grammar (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_Grammar_v10 v10 = \ (T_Grammar_vIn10 ) -> ( let _nontsX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) (T_Nonterminals_vOut16 _nontsIpp _nontsIppL) = inv_Nonterminals_s17 _nontsX17 (T_Nonterminals_vIn16 ) _lhsOpp :: PP_Doc _lhsOpp = rule6 _nontsIppL arg_derivings_ arg_typeSyns_ arg_useMap_ arg_wrappers_ __result_ = T_Grammar_vOut10 _lhsOpp in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule6 #-} {-# LINE 20 "src-ag/AbstractSyntaxDump.ag" #-} rule6 = \ ((_nontsIppL) :: [PP_Doc]) derivings_ typeSyns_ useMap_ wrappers_ -> {-# LINE 20 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Grammar","Grammar"] [] [ ppF "typeSyns" $ ppAssocL typeSyns_ , ppF "useMap" $ ppMap $ Map.map ppMap $ useMap_ , ppF "derivings" $ ppMap $ derivings_ , ppF "wrappers" $ ppShow $ wrappers_ , ppF "nonts" $ ppVList _nontsIppL ] [] {-# LINE 278 "dist/build/AbstractSyntaxDump.hs"#-} -- Nonterminal ------------------------------------------------- -- wrapper data Inh_Nonterminal = Inh_Nonterminal { } data Syn_Nonterminal = Syn_Nonterminal { pp_Syn_Nonterminal :: (PP_Doc) } {-# INLINABLE wrap_Nonterminal #-} wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal ) wrap_Nonterminal (T_Nonterminal act) (Inh_Nonterminal ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg13 = T_Nonterminal_vIn13 (T_Nonterminal_vOut13 _lhsOpp) <- return (inv_Nonterminal_s14 sem arg13) return (Syn_Nonterminal _lhsOpp) ) -- cata {-# INLINE sem_Nonterminal #-} sem_Nonterminal :: Nonterminal -> T_Nonterminal sem_Nonterminal ( Nonterminal nt_ params_ inh_ syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ ) -- semantic domain newtype T_Nonterminal = T_Nonterminal { attach_T_Nonterminal :: Identity (T_Nonterminal_s14 ) } newtype T_Nonterminal_s14 = C_Nonterminal_s14 { inv_Nonterminal_s14 :: (T_Nonterminal_v13 ) } data T_Nonterminal_s15 = C_Nonterminal_s15 type T_Nonterminal_v13 = (T_Nonterminal_vIn13 ) -> (T_Nonterminal_vOut13 ) data T_Nonterminal_vIn13 = T_Nonterminal_vIn13 data T_Nonterminal_vOut13 = T_Nonterminal_vOut13 (PP_Doc) {-# NOINLINE sem_Nonterminal_Nonterminal #-} sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal sem_Nonterminal_Nonterminal arg_nt_ arg_params_ arg_inh_ arg_syn_ arg_prods_ = T_Nonterminal (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_Nonterminal_v13 v13 = \ (T_Nonterminal_vIn13 ) -> ( let _prodsX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) (T_Productions_vOut28 _prodsIpp _prodsIppL) = inv_Productions_s29 _prodsX29 (T_Productions_vIn28 ) _lhsOpp :: PP_Doc _lhsOpp = rule7 _prodsIppL arg_inh_ arg_nt_ arg_params_ arg_syn_ __result_ = T_Nonterminal_vOut13 _lhsOpp in __result_ ) in C_Nonterminal_s14 v13 {-# INLINE rule7 #-} {-# LINE 29 "src-ag/AbstractSyntaxDump.ag" #-} rule7 = \ ((_prodsIppL) :: [PP_Doc]) inh_ nt_ params_ syn_ -> {-# LINE 29 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Nonterminal","Nonterminal"] (pp nt_ : map pp params_) [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_, ppF "prods" $ ppVList _prodsIppL] [] {-# LINE 329 "dist/build/AbstractSyntaxDump.hs"#-} -- Nonterminals ------------------------------------------------ -- wrapper data Inh_Nonterminals = Inh_Nonterminals { } data Syn_Nonterminals = Syn_Nonterminals { pp_Syn_Nonterminals :: (PP_Doc), ppL_Syn_Nonterminals :: ([PP_Doc]) } {-# INLINABLE wrap_Nonterminals #-} wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals ) wrap_Nonterminals (T_Nonterminals act) (Inh_Nonterminals ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg16 = T_Nonterminals_vIn16 (T_Nonterminals_vOut16 _lhsOpp _lhsOppL) <- return (inv_Nonterminals_s17 sem arg16) return (Syn_Nonterminals _lhsOpp _lhsOppL) ) -- cata {-# NOINLINE sem_Nonterminals #-} sem_Nonterminals :: Nonterminals -> T_Nonterminals sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) -- semantic domain newtype T_Nonterminals = T_Nonterminals { attach_T_Nonterminals :: Identity (T_Nonterminals_s17 ) } newtype T_Nonterminals_s17 = C_Nonterminals_s17 { inv_Nonterminals_s17 :: (T_Nonterminals_v16 ) } data T_Nonterminals_s18 = C_Nonterminals_s18 type T_Nonterminals_v16 = (T_Nonterminals_vIn16 ) -> (T_Nonterminals_vOut16 ) data T_Nonterminals_vIn16 = T_Nonterminals_vIn16 data T_Nonterminals_vOut16 = T_Nonterminals_vOut16 (PP_Doc) ([PP_Doc]) {-# NOINLINE sem_Nonterminals_Cons #-} sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Nonterminals_v16 v16 = \ (T_Nonterminals_vIn16 ) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) (T_Nonterminal_vOut13 _hdIpp) = inv_Nonterminal_s14 _hdX14 (T_Nonterminal_vIn13 ) (T_Nonterminals_vOut16 _tlIpp _tlIppL) = inv_Nonterminals_s17 _tlX17 (T_Nonterminals_vIn16 ) _lhsOppL :: [PP_Doc] _lhsOppL = rule8 _hdIpp _tlIppL _lhsOpp :: PP_Doc _lhsOpp = rule9 _hdIpp _tlIpp __result_ = T_Nonterminals_vOut16 _lhsOpp _lhsOppL in __result_ ) in C_Nonterminals_s17 v16 {-# INLINE rule8 #-} {-# LINE 75 "src-ag/AbstractSyntaxDump.ag" #-} rule8 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> {-# LINE 75 "src-ag/AbstractSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 384 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule9 #-} rule9 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) -> _hdIpp >-< _tlIpp {-# NOINLINE sem_Nonterminals_Nil #-} sem_Nonterminals_Nil :: T_Nonterminals sem_Nonterminals_Nil = T_Nonterminals (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Nonterminals_v16 v16 = \ (T_Nonterminals_vIn16 ) -> ( let _lhsOppL :: [PP_Doc] _lhsOppL = rule10 () _lhsOpp :: PP_Doc _lhsOpp = rule11 () __result_ = T_Nonterminals_vOut16 _lhsOpp _lhsOppL in __result_ ) in C_Nonterminals_s17 v16 {-# INLINE rule10 #-} {-# LINE 76 "src-ag/AbstractSyntaxDump.ag" #-} rule10 = \ (_ :: ()) -> {-# LINE 76 "src-ag/AbstractSyntaxDump.ag" #-} [] {-# LINE 407 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule11 #-} rule11 = \ (_ :: ()) -> empty -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { } data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), pp_Syn_Pattern :: (PP_Doc) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg19 = T_Pattern_vIn19 (T_Pattern_vOut19 _lhsOcopy _lhsOpp) <- return (inv_Pattern_s20 sem arg19) return (Syn_Pattern _lhsOcopy _lhsOpp) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s20 ) } newtype T_Pattern_s20 = C_Pattern_s20 { inv_Pattern_s20 :: (T_Pattern_v19 ) } data T_Pattern_s21 = C_Pattern_s21 type T_Pattern_v19 = (T_Pattern_vIn19 ) -> (T_Pattern_vOut19 ) data T_Pattern_vIn19 = T_Pattern_vIn19 data T_Pattern_vOut19 = T_Pattern_vOut19 (Pattern) (PP_Doc) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 ) -> ( let _patsX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut22 _patsIcopy _patsIpp _patsIppL) = inv_Patterns_s23 _patsX23 (T_Patterns_vIn22 ) _lhsOpp :: PP_Doc _lhsOpp = rule12 _patsIppL arg_name_ _copy = rule13 _patsIcopy arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule14 _copy __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOpp in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule12 #-} {-# LINE 44 "src-ag/AbstractSyntaxDump.ag" #-} rule12 = \ ((_patsIppL) :: [PP_Doc]) name_ -> {-# LINE 44 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] [] {-# LINE 468 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule13 #-} rule13 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule14 #-} rule14 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 ) -> ( let _patsX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut22 _patsIcopy _patsIpp _patsIppL) = inv_Patterns_s23 _patsX23 (T_Patterns_vIn22 ) _lhsOpp :: PP_Doc _lhsOpp = rule15 _patsIppL arg_pos_ _copy = rule16 _patsIcopy arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule17 _copy __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOpp in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule15 #-} {-# LINE 45 "src-ag/AbstractSyntaxDump.ag" #-} rule15 = \ ((_patsIppL) :: [PP_Doc]) pos_ -> {-# LINE 45 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] [] {-# LINE 497 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule16 #-} rule16 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule17 #-} rule17 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 ) -> ( let _patX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut19 _patIcopy _patIpp) = inv_Pattern_s20 _patX20 (T_Pattern_vIn19 ) _lhsOpp :: PP_Doc _lhsOpp = rule18 _patIpp arg_attr_ arg_field_ _copy = rule19 _patIcopy arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule20 _copy __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOpp in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule18 #-} {-# LINE 46 "src-ag/AbstractSyntaxDump.ag" #-} rule18 = \ ((_patIpp) :: PP_Doc) attr_ field_ -> {-# LINE 46 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] [] {-# LINE 526 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule19 #-} rule19 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule20 #-} rule20 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 ) -> ( let _patX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut19 _patIcopy _patIpp) = inv_Pattern_s20 _patX20 (T_Pattern_vIn19 ) _lhsOpp :: PP_Doc _lhsOpp = rule21 _patIpp _copy = rule22 _patIcopy _lhsOcopy :: Pattern _lhsOcopy = rule23 _copy __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOpp in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule21 #-} rule21 = \ ((_patIpp) :: PP_Doc) -> _patIpp {-# INLINE rule22 #-} rule22 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule23 #-} rule23 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore arg_pos_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 ) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule24 arg_pos_ _copy = rule25 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule26 _copy __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOpp in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule24 #-} {-# LINE 47 "src-ag/AbstractSyntaxDump.ag" #-} rule24 = \ pos_ -> {-# LINE 47 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] [] {-# LINE 579 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule25 #-} rule25 = \ pos_ -> Underscore pos_ {-# INLINE rule26 #-} rule26 = \ _copy -> _copy -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { } data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns), pp_Syn_Patterns :: (PP_Doc), ppL_Syn_Patterns :: ([PP_Doc]) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg22 = T_Patterns_vIn22 (T_Patterns_vOut22 _lhsOcopy _lhsOpp _lhsOppL) <- return (inv_Patterns_s23 sem arg22) return (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s23 ) } newtype T_Patterns_s23 = C_Patterns_s23 { inv_Patterns_s23 :: (T_Patterns_v22 ) } data T_Patterns_s24 = C_Patterns_s24 type T_Patterns_v22 = (T_Patterns_vIn22 ) -> (T_Patterns_vOut22 ) data T_Patterns_vIn22 = T_Patterns_vIn22 data T_Patterns_vOut22 = T_Patterns_vOut22 (Patterns) (PP_Doc) ([PP_Doc]) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_Patterns_v22 v22 = \ (T_Patterns_vIn22 ) -> ( let _hdX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut19 _hdIcopy _hdIpp) = inv_Pattern_s20 _hdX20 (T_Pattern_vIn19 ) (T_Patterns_vOut22 _tlIcopy _tlIpp _tlIppL) = inv_Patterns_s23 _tlX23 (T_Patterns_vIn22 ) _lhsOppL :: [PP_Doc] _lhsOppL = rule27 _hdIpp _tlIppL _lhsOpp :: PP_Doc _lhsOpp = rule28 _hdIpp _tlIpp _copy = rule29 _hdIcopy _tlIcopy _lhsOcopy :: Patterns _lhsOcopy = rule30 _copy __result_ = T_Patterns_vOut22 _lhsOcopy _lhsOpp _lhsOppL in __result_ ) in C_Patterns_s23 v22 {-# INLINE rule27 #-} {-# LINE 55 "src-ag/AbstractSyntaxDump.ag" #-} rule27 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> {-# LINE 55 "src-ag/AbstractSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 643 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule28 #-} rule28 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) -> _hdIpp >-< _tlIpp {-# INLINE rule29 #-} rule29 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule30 #-} rule30 = \ _copy -> _copy {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_Patterns_v22 v22 = \ (T_Patterns_vIn22 ) -> ( let _lhsOppL :: [PP_Doc] _lhsOppL = rule31 () _lhsOpp :: PP_Doc _lhsOpp = rule32 () _copy = rule33 () _lhsOcopy :: Patterns _lhsOcopy = rule34 _copy __result_ = T_Patterns_vOut22 _lhsOcopy _lhsOpp _lhsOppL in __result_ ) in C_Patterns_s23 v22 {-# INLINE rule31 #-} {-# LINE 56 "src-ag/AbstractSyntaxDump.ag" #-} rule31 = \ (_ :: ()) -> {-# LINE 56 "src-ag/AbstractSyntaxDump.ag" #-} [] {-# LINE 675 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule32 #-} rule32 = \ (_ :: ()) -> empty {-# INLINE rule33 #-} rule33 = \ (_ :: ()) -> [] {-# INLINE rule34 #-} rule34 = \ _copy -> _copy -- Production -------------------------------------------------- -- wrapper data Inh_Production = Inh_Production { } data Syn_Production = Syn_Production { pp_Syn_Production :: (PP_Doc) } {-# INLINABLE wrap_Production #-} wrap_Production :: T_Production -> Inh_Production -> (Syn_Production ) wrap_Production (T_Production act) (Inh_Production ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg25 = T_Production_vIn25 (T_Production_vOut25 _lhsOpp) <- return (inv_Production_s26 sem arg25) return (Syn_Production _lhsOpp) ) -- cata {-# INLINE sem_Production #-} sem_Production :: Production -> T_Production sem_Production ( Production con_ params_ constraints_ children_ rules_ typeSigs_ macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_ -- semantic domain newtype T_Production = T_Production { attach_T_Production :: Identity (T_Production_s26 ) } newtype T_Production_s26 = C_Production_s26 { inv_Production_s26 :: (T_Production_v25 ) } data T_Production_s27 = C_Production_s27 type T_Production_v25 = (T_Production_vIn25 ) -> (T_Production_vOut25 ) data T_Production_vIn25 = T_Production_vIn25 data T_Production_vOut25 = T_Production_vOut25 (PP_Doc) {-# NOINLINE sem_Production_Production #-} sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production sem_Production_Production arg_con_ _ _ arg_children_ arg_rules_ arg_typeSigs_ _ = T_Production (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_Production_v25 v25 = \ (T_Production_vIn25 ) -> ( let _childrenX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) _rulesX35 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) _typeSigsX41 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) (T_Children_vOut4 _childrenIpp _childrenIppL) = inv_Children_s5 _childrenX5 (T_Children_vIn4 ) (T_Rules_vOut34 _rulesIpp _rulesIppL) = inv_Rules_s35 _rulesX35 (T_Rules_vIn34 ) (T_TypeSigs_vOut40 _typeSigsIpp _typeSigsIppL) = inv_TypeSigs_s41 _typeSigsX41 (T_TypeSigs_vIn40 ) _lhsOpp :: PP_Doc _lhsOpp = rule35 _childrenIppL _rulesIppL _typeSigsIppL arg_con_ __result_ = T_Production_vOut25 _lhsOpp in __result_ ) in C_Production_s26 v25 {-# INLINE rule35 #-} {-# LINE 32 "src-ag/AbstractSyntaxDump.ag" #-} rule35 = \ ((_childrenIppL) :: [PP_Doc]) ((_rulesIppL) :: [PP_Doc]) ((_typeSigsIppL) :: [PP_Doc]) con_ -> {-# LINE 32 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Production","Production"] [pp con_] [ppF "children" $ ppVList _childrenIppL,ppF "rules" $ ppVList _rulesIppL,ppF "typeSigs" $ ppVList _typeSigsIppL] [] {-# LINE 739 "dist/build/AbstractSyntaxDump.hs"#-} -- Productions ------------------------------------------------- -- wrapper data Inh_Productions = Inh_Productions { } data Syn_Productions = Syn_Productions { pp_Syn_Productions :: (PP_Doc), ppL_Syn_Productions :: ([PP_Doc]) } {-# INLINABLE wrap_Productions #-} wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions ) wrap_Productions (T_Productions act) (Inh_Productions ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg28 = T_Productions_vIn28 (T_Productions_vOut28 _lhsOpp _lhsOppL) <- return (inv_Productions_s29 sem arg28) return (Syn_Productions _lhsOpp _lhsOppL) ) -- cata {-# NOINLINE sem_Productions #-} sem_Productions :: Productions -> T_Productions sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) -- semantic domain newtype T_Productions = T_Productions { attach_T_Productions :: Identity (T_Productions_s29 ) } newtype T_Productions_s29 = C_Productions_s29 { inv_Productions_s29 :: (T_Productions_v28 ) } data T_Productions_s30 = C_Productions_s30 type T_Productions_v28 = (T_Productions_vIn28 ) -> (T_Productions_vOut28 ) data T_Productions_vIn28 = T_Productions_vIn28 data T_Productions_vOut28 = T_Productions_vOut28 (PP_Doc) ([PP_Doc]) {-# NOINLINE sem_Productions_Cons #-} sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Productions_v28 v28 = \ (T_Productions_vIn28 ) -> ( let _hdX26 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) _tlX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) (T_Production_vOut25 _hdIpp) = inv_Production_s26 _hdX26 (T_Production_vIn25 ) (T_Productions_vOut28 _tlIpp _tlIppL) = inv_Productions_s29 _tlX29 (T_Productions_vIn28 ) _lhsOppL :: [PP_Doc] _lhsOppL = rule36 _hdIpp _tlIppL _lhsOpp :: PP_Doc _lhsOpp = rule37 _hdIpp _tlIpp __result_ = T_Productions_vOut28 _lhsOpp _lhsOppL in __result_ ) in C_Productions_s29 v28 {-# INLINE rule36 #-} {-# LINE 71 "src-ag/AbstractSyntaxDump.ag" #-} rule36 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> {-# LINE 71 "src-ag/AbstractSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 794 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule37 #-} rule37 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) -> _hdIpp >-< _tlIpp {-# NOINLINE sem_Productions_Nil #-} sem_Productions_Nil :: T_Productions sem_Productions_Nil = T_Productions (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Productions_v28 v28 = \ (T_Productions_vIn28 ) -> ( let _lhsOppL :: [PP_Doc] _lhsOppL = rule38 () _lhsOpp :: PP_Doc _lhsOpp = rule39 () __result_ = T_Productions_vOut28 _lhsOpp _lhsOppL in __result_ ) in C_Productions_s29 v28 {-# INLINE rule38 #-} {-# LINE 72 "src-ag/AbstractSyntaxDump.ag" #-} rule38 = \ (_ :: ()) -> {-# LINE 72 "src-ag/AbstractSyntaxDump.ag" #-} [] {-# LINE 817 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule39 #-} rule39 = \ (_ :: ()) -> empty -- Rule -------------------------------------------------------- -- wrapper data Inh_Rule = Inh_Rule { } data Syn_Rule = Syn_Rule { pp_Syn_Rule :: (PP_Doc) } {-# INLINABLE wrap_Rule #-} wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule ) wrap_Rule (T_Rule act) (Inh_Rule ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg31 = T_Rule_vIn31 (T_Rule_vOut31 _lhsOpp) <- return (inv_Rule_s32 sem arg31) return (Syn_Rule _lhsOpp) ) -- cata {-# INLINE sem_Rule #-} sem_Rule :: Rule -> T_Rule sem_Rule ( Rule mbName_ pattern_ rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ -- semantic domain newtype T_Rule = T_Rule { attach_T_Rule :: Identity (T_Rule_s32 ) } newtype T_Rule_s32 = C_Rule_s32 { inv_Rule_s32 :: (T_Rule_v31 ) } data T_Rule_s33 = C_Rule_s33 type T_Rule_v31 = (T_Rule_vIn31 ) -> (T_Rule_vOut31 ) data T_Rule_vIn31 = T_Rule_vIn31 data T_Rule_vOut31 = T_Rule_vOut31 (PP_Doc) {-# NOINLINE sem_Rule_Rule #-} sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule sem_Rule_Rule _ arg_pattern_ arg_rhs_ arg_owrt_ arg_origin_ _ _ _ _ _ = T_Rule (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_Rule_v31 v31 = \ (T_Rule_vIn31 ) -> ( let _patternX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) _rhsX8 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) (T_Pattern_vOut19 _patternIcopy _patternIpp) = inv_Pattern_s20 _patternX20 (T_Pattern_vIn19 ) (T_Expression_vOut7 _rhsIpp) = inv_Expression_s8 _rhsX8 (T_Expression_vIn7 ) _lhsOpp :: PP_Doc _lhsOpp = rule40 _patternIpp _rhsIpp arg_origin_ arg_owrt_ __result_ = T_Rule_vOut31 _lhsOpp in __result_ ) in C_Rule_s32 v31 {-# INLINE rule40 #-} {-# LINE 38 "src-ag/AbstractSyntaxDump.ag" #-} rule40 = \ ((_patternIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) origin_ owrt_ -> {-# LINE 38 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Rule","Rule"] [ppShow owrt_, pp origin_] [ppF "pattern" $ _patternIpp, ppF "rhs" $ _rhsIpp] [] {-# LINE 873 "dist/build/AbstractSyntaxDump.hs"#-} -- Rules ------------------------------------------------------- -- wrapper data Inh_Rules = Inh_Rules { } data Syn_Rules = Syn_Rules { pp_Syn_Rules :: (PP_Doc), ppL_Syn_Rules :: ([PP_Doc]) } {-# INLINABLE wrap_Rules #-} wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules ) wrap_Rules (T_Rules act) (Inh_Rules ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg34 = T_Rules_vIn34 (T_Rules_vOut34 _lhsOpp _lhsOppL) <- return (inv_Rules_s35 sem arg34) return (Syn_Rules _lhsOpp _lhsOppL) ) -- cata {-# NOINLINE sem_Rules #-} sem_Rules :: Rules -> T_Rules sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) -- semantic domain newtype T_Rules = T_Rules { attach_T_Rules :: Identity (T_Rules_s35 ) } newtype T_Rules_s35 = C_Rules_s35 { inv_Rules_s35 :: (T_Rules_v34 ) } data T_Rules_s36 = C_Rules_s36 type T_Rules_v34 = (T_Rules_vIn34 ) -> (T_Rules_vOut34 ) data T_Rules_vIn34 = T_Rules_vIn34 data T_Rules_vOut34 = T_Rules_vOut34 (PP_Doc) ([PP_Doc]) {-# NOINLINE sem_Rules_Cons #-} sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Rules_v34 v34 = \ (T_Rules_vIn34 ) -> ( let _hdX32 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) _tlX35 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) (T_Rule_vOut31 _hdIpp) = inv_Rule_s32 _hdX32 (T_Rule_vIn31 ) (T_Rules_vOut34 _tlIpp _tlIppL) = inv_Rules_s35 _tlX35 (T_Rules_vIn34 ) _lhsOppL :: [PP_Doc] _lhsOppL = rule41 _hdIpp _tlIppL _lhsOpp :: PP_Doc _lhsOpp = rule42 _hdIpp _tlIpp __result_ = T_Rules_vOut34 _lhsOpp _lhsOppL in __result_ ) in C_Rules_s35 v34 {-# INLINE rule41 #-} {-# LINE 63 "src-ag/AbstractSyntaxDump.ag" #-} rule41 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> {-# LINE 63 "src-ag/AbstractSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 928 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule42 #-} rule42 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) -> _hdIpp >-< _tlIpp {-# NOINLINE sem_Rules_Nil #-} sem_Rules_Nil :: T_Rules sem_Rules_Nil = T_Rules (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Rules_v34 v34 = \ (T_Rules_vIn34 ) -> ( let _lhsOppL :: [PP_Doc] _lhsOppL = rule43 () _lhsOpp :: PP_Doc _lhsOpp = rule44 () __result_ = T_Rules_vOut34 _lhsOpp _lhsOppL in __result_ ) in C_Rules_s35 v34 {-# INLINE rule43 #-} {-# LINE 64 "src-ag/AbstractSyntaxDump.ag" #-} rule43 = \ (_ :: ()) -> {-# LINE 64 "src-ag/AbstractSyntaxDump.ag" #-} [] {-# LINE 951 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule44 #-} rule44 = \ (_ :: ()) -> empty -- TypeSig ----------------------------------------------------- -- wrapper data Inh_TypeSig = Inh_TypeSig { } data Syn_TypeSig = Syn_TypeSig { pp_Syn_TypeSig :: (PP_Doc) } {-# INLINABLE wrap_TypeSig #-} wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig ) wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg37 = T_TypeSig_vIn37 (T_TypeSig_vOut37 _lhsOpp) <- return (inv_TypeSig_s38 sem arg37) return (Syn_TypeSig _lhsOpp) ) -- cata {-# INLINE sem_TypeSig #-} sem_TypeSig :: TypeSig -> T_TypeSig sem_TypeSig ( TypeSig name_ tp_ ) = sem_TypeSig_TypeSig name_ tp_ -- semantic domain newtype T_TypeSig = T_TypeSig { attach_T_TypeSig :: Identity (T_TypeSig_s38 ) } newtype T_TypeSig_s38 = C_TypeSig_s38 { inv_TypeSig_s38 :: (T_TypeSig_v37 ) } data T_TypeSig_s39 = C_TypeSig_s39 type T_TypeSig_v37 = (T_TypeSig_vIn37 ) -> (T_TypeSig_vOut37 ) data T_TypeSig_vIn37 = T_TypeSig_vIn37 data T_TypeSig_vOut37 = T_TypeSig_vOut37 (PP_Doc) {-# NOINLINE sem_TypeSig_TypeSig #-} sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig sem_TypeSig_TypeSig arg_name_ arg_tp_ = T_TypeSig (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_TypeSig_v37 v37 = \ (T_TypeSig_vIn37 ) -> ( let _lhsOpp :: PP_Doc _lhsOpp = rule45 arg_name_ arg_tp_ __result_ = T_TypeSig_vOut37 _lhsOpp in __result_ ) in C_TypeSig_s38 v37 {-# INLINE rule45 #-} {-# LINE 41 "src-ag/AbstractSyntaxDump.ag" #-} rule45 = \ name_ tp_ -> {-# LINE 41 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["TypeSig","TypeSig"] [pp name_, ppShow tp_] [] [] {-# LINE 1003 "dist/build/AbstractSyntaxDump.hs"#-} -- TypeSigs ---------------------------------------------------- -- wrapper data Inh_TypeSigs = Inh_TypeSigs { } data Syn_TypeSigs = Syn_TypeSigs { pp_Syn_TypeSigs :: (PP_Doc), ppL_Syn_TypeSigs :: ([PP_Doc]) } {-# INLINABLE wrap_TypeSigs #-} wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs ) wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg40 = T_TypeSigs_vIn40 (T_TypeSigs_vOut40 _lhsOpp _lhsOppL) <- return (inv_TypeSigs_s41 sem arg40) return (Syn_TypeSigs _lhsOpp _lhsOppL) ) -- cata {-# NOINLINE sem_TypeSigs #-} sem_TypeSigs :: TypeSigs -> T_TypeSigs sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) -- semantic domain newtype T_TypeSigs = T_TypeSigs { attach_T_TypeSigs :: Identity (T_TypeSigs_s41 ) } newtype T_TypeSigs_s41 = C_TypeSigs_s41 { inv_TypeSigs_s41 :: (T_TypeSigs_v40 ) } data T_TypeSigs_s42 = C_TypeSigs_s42 type T_TypeSigs_v40 = (T_TypeSigs_vIn40 ) -> (T_TypeSigs_vOut40 ) data T_TypeSigs_vIn40 = T_TypeSigs_vIn40 data T_TypeSigs_vOut40 = T_TypeSigs_vOut40 (PP_Doc) ([PP_Doc]) {-# NOINLINE sem_TypeSigs_Cons #-} sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_TypeSigs_v40 v40 = \ (T_TypeSigs_vIn40 ) -> ( let _hdX38 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_)) _tlX41 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_)) (T_TypeSig_vOut37 _hdIpp) = inv_TypeSig_s38 _hdX38 (T_TypeSig_vIn37 ) (T_TypeSigs_vOut40 _tlIpp _tlIppL) = inv_TypeSigs_s41 _tlX41 (T_TypeSigs_vIn40 ) _lhsOppL :: [PP_Doc] _lhsOppL = rule46 _hdIpp _tlIppL _lhsOpp :: PP_Doc _lhsOpp = rule47 _hdIpp _tlIpp __result_ = T_TypeSigs_vOut40 _lhsOpp _lhsOppL in __result_ ) in C_TypeSigs_s41 v40 {-# INLINE rule46 #-} {-# LINE 59 "src-ag/AbstractSyntaxDump.ag" #-} rule46 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> {-# LINE 59 "src-ag/AbstractSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 1058 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule47 #-} rule47 = \ ((_hdIpp) :: PP_Doc) ((_tlIpp) :: PP_Doc) -> _hdIpp >-< _tlIpp {-# NOINLINE sem_TypeSigs_Nil #-} sem_TypeSigs_Nil :: T_TypeSigs sem_TypeSigs_Nil = T_TypeSigs (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_TypeSigs_v40 v40 = \ (T_TypeSigs_vIn40 ) -> ( let _lhsOppL :: [PP_Doc] _lhsOppL = rule48 () _lhsOpp :: PP_Doc _lhsOpp = rule49 () __result_ = T_TypeSigs_vOut40 _lhsOpp _lhsOppL in __result_ ) in C_TypeSigs_s41 v40 {-# INLINE rule48 #-} {-# LINE 60 "src-ag/AbstractSyntaxDump.ag" #-} rule48 = \ (_ :: ()) -> {-# LINE 60 "src-ag/AbstractSyntaxDump.ag" #-} [] {-# LINE 1081 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule49 #-} rule49 = \ (_ :: ()) -> empty uuagc-0.9.52.2/src-generated/Patterns.hs0000644000000000000000000000352113433540502016120 0ustar0000000000000000 -- UUAGC 0.9.51 (src-ag/Patterns.ag) module Patterns where {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 11 "dist/build/Patterns.hs" #-} -- Pattern ----------------------------------------------------- {- visit 0: synthesized attribute: copy : Pattern alternatives: alternative Constr: child name : {ConstructorIdent} child pats : Patterns visit 0: local copy : _ alternative Product: child pos : {Pos} child pats : Patterns visit 0: local copy : _ alternative Alias: child field : {Identifier} child attr : {Identifier} child pat : Pattern visit 0: local copy : _ alternative Irrefutable: child pat : Pattern visit 0: local copy : _ alternative Underscore: child pos : {Pos} visit 0: local copy : _ -} data Pattern = Constr (ConstructorIdent) (Patterns) | Product (Pos) (Patterns) | Alias (Identifier) (Identifier) (Pattern) | Irrefutable (Pattern) | Underscore (Pos) deriving ( Show) -- Patterns ---------------------------------------------------- {- visit 0: synthesized attribute: copy : Patterns alternatives: alternative Cons: child hd : Pattern child tl : Patterns visit 0: local copy : _ alternative Nil: visit 0: local copy : _ -} type Patterns = [Pattern]uuagc-0.9.52.2/src-generated/GenerateCode.hs0000644000000000000000000111521413433540502016651 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module GenerateCode where {-# LINE 2 "src-ag/DeclBlocks.ag" #-} import Code (Decl,Expr) {-# LINE 9 "dist/build/GenerateCode.hs" #-} {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 16 "dist/build/GenerateCode.hs" #-} {-# LINE 2 "src-ag/CodeSyntax.ag" #-} import Patterns import CommonTypes import Data.Map(Map) import Data.Set(Set) {-# LINE 24 "dist/build/GenerateCode.hs" #-} {-# LINE 9 "src-ag/GenerateCode.ag" #-} import CommonTypes import SequentialTypes import Code hiding (Type) import qualified Code import Options import CodeSyntax import ErrorMessages import GrammarInfo import DeclBlocks import qualified Data.Map as Map import Data.Map(Map) import qualified Data.Set as Set import Data.Set(Set) import qualified Data.Sequence as Seq import Data.Sequence(Seq) import UU.Scanner.Position import TokenDef import HsToken import HsTokenScanner import Data.List(partition,intersperse) import Data.Maybe(fromJust,isJust) {-# LINE 52 "dist/build/GenerateCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 107 "src-ag/GenerateCode.ag" #-} -- remove possible @v references in the types of a data type. cleanupArg :: Options -> String -> String cleanupArg opts s = case idEvalType opts (SimpleType s) of SimpleType s' -> s' _ -> error "Only SimpleType supported" {-# LINE 63 "dist/build/GenerateCode.hs" #-} {-# LINE 123 "src-ag/GenerateCode.ag" #-} appContext :: ContextMap -> NontermIdent -> Code.Type -> Code.Type appContext mp nt tp = maybe tp (\ctx -> CtxApp (map (\(n,ns) -> (getName n, ns)) ctx) tp) $ Map.lookup nt mp appQuant :: QuantMap -> NontermIdent -> Code.Type -> Code.Type appQuant mp nt tp = foldr QuantApp tp $ Map.findWithDefault [] nt mp {-# LINE 74 "dist/build/GenerateCode.hs" #-} {-# LINE 248 "src-ag/GenerateCode.ag" #-} mkDecl :: Bool -> Lhs -> Expr -> Set String -> Set String -> Decl mkDecl True lhs rhs _ _ = Bind lhs rhs mkDecl False lhs rhs s1 s2 = Decl lhs rhs s1 s2 unwrapSem :: Bool -> NontermIdent -> Expr -> Expr unwrapSem False _ e = e unwrapSem True nm e = Case e alts where alts = [CaseAlt left right] left = Fun (typeName nm 0) [SimpleExpr "x"] right = SimpleExpr "x" {-# LINE 88 "dist/build/GenerateCode.hs" #-} {-# LINE 541 "src-ag/GenerateCode.ag" #-} mkLambdaArg :: String -> Maybe Code.Type -> Expr mkLambdaArg nm Nothing = SimpleExpr nm mkLambdaArg nm (Just tp) = TypedExpr (SimpleExpr nm) tp mkLambda :: Exprs -> Expr -> Expr mkLambda [] e = e mkLambda xs e = Lambda xs e mkSemFun :: Identifier -> Int -> Exprs -> Expr -> Expr mkSemFun nt nr xs e = SemFun (typeName nt nr) xs e typeAppStrs :: String -> [String] -> Code.Type typeAppStrs nm params = TypeApp (SimpleType nm) (map SimpleType params) isHigherOrder :: ChildKind -> Bool isHigherOrder ChildAttr = True isHigherOrder _ = False pickOrigType :: (Identifier, Type, ChildKind) -> (Identifier, Type, ChildKind) pickOrigType (nm, _, virt@(ChildReplace x)) = (nm, x, virt) pickOrigType x = x {-# LINE 113 "dist/build/GenerateCode.hs" #-} {-# LINE 638 "src-ag/GenerateCode.ag" #-} mkPartitionedFunction :: String -> Bool -> [Decl] -> [String] -> DeclBlocks -> ([Decl], Expr) mkPartitionedFunction prefix' optCase nextVisitDecls lastExprVars cpsTree = let inh = Inh_DeclBlocksRoot { prefix_Inh_DeclBlocksRoot = prefix' , optCase_Inh_DeclBlocksRoot = optCase , nextVisitDecls_Inh_DeclBlocksRoot = nextVisitDecls , lastExprVars_Inh_DeclBlocksRoot = lastExprVars } sem = sem_DeclBlocksRoot (DeclBlocksRoot cpsTree) syn = wrap_DeclBlocksRoot sem inh in (lambdas_Syn_DeclBlocksRoot syn, firstCall_Syn_DeclBlocksRoot syn) {-# LINE 127 "dist/build/GenerateCode.hs" #-} {-# LINE 688 "src-ag/GenerateCode.ag" #-} freevars :: [String] -> [Decl] -> [String] freevars additional decls = Set.toList (allused `Set.difference` alldefined) where allused = Set.unions (Set.fromList additional : map usedvars decls) alldefined = Set.unions (map definedvars decls) usedvars (Decl _ _ _ uses) = uses usedvars _ = Set.empty definedvars (Decl _ _ defs _) = defs definedvars _ = Set.empty mkBlockLambda :: Bool -> String -> [String] -> [Decl] -> Expr -> Decl mkBlockLambda optCase name args decls expr = Decl lhs rhs Set.empty Set.empty where lhs = Fun name (map SimpleExpr args) rhs = mkLet optCase decls expr {-# LINE 150 "dist/build/GenerateCode.hs" #-} {-# LINE 766 "src-ag/GenerateCode.ag" #-} typeToCodeType :: Maybe NontermIdent -> [String] -> Type -> Code.Type typeToCodeType _ _ tp = case tp of NT nt tps defor -> NontermType (getName nt) tps defor Haskell t -> SimpleType t Self -> error "Self type not allowed here." evalType :: Options -> (String -> String) -> Code.Type -> Code.Type evalType opts replf t' = chase t' where chase t = case t of Arr l r -> Arr (chase l) (chase r) TypeApp f as -> TypeApp (chase f) (map chase as) TupleType tps -> TupleType (map chase tps) UnboxedTupleType tps -> UnboxedTupleType (map chase tps) Code.List tp -> Code.List (chase tp) SimpleType txt -> let tks = lexTokens opts (initPos txt) txt tks' = map replaceTok tks txt' = unlines . showTokens . tokensToStrings $ tks' in SimpleType txt' TMaybe m -> TMaybe (chase m) TEither l r -> TEither (chase l) (chase r) TMap k v -> TMap (chase k) (chase v) TIntMap v -> TIntMap (chase v) TSet m -> TSet (chase m) _ -> t replaceTok t = case t of AGLocal v p _ -> HsToken (replf $ getName v) p _ -> t idEvalType :: Options -> Code.Type -> Code.Type idEvalType options = evalType options id {-# LINE 190 "dist/build/GenerateCode.hs" #-} {-# LINE 892 "src-ag/GenerateCode.ag" #-} -- for a virtual child that already existed as a child, returns isFirstOrder :: ChildKind -> Type -> Maybe Type isFirstOrder ChildSyntax tp = Just tp isFirstOrder ChildAttr _ = Nothing isFirstOrder (ChildReplace tp) _ = Just tp {-# LINE 199 "dist/build/GenerateCode.hs" #-} {-# LINE 913 "src-ag/GenerateCode.ag" #-} makeLocalComment :: Int -> String -> Identifier -> Maybe Type -> String makeLocalComment width what name tp = let x = getName name y = maybe "_" (\t -> case t of (NT nt tps _) -> getName nt ++ " " ++ unwords tps Haskell t' -> '{' : t' ++ "}" Self -> error "Self type not allowed here.") tp in ( what ++ " " ++ x ++ replicate ((width - length x) `max` 0) ' ' ++ " : " ++ y ) {-# LINE 211 "dist/build/GenerateCode.hs" #-} {-# LINE 947 "src-ag/GenerateCode.ag" #-} -- Lets or nested Cases? -- or even a do-expression? data DeclsType = DeclsLet | DeclsCase | DeclsDo mkDecls :: DeclsType -> Decls -> Expr -> Expr mkDecls DeclsLet = mkLet False mkDecls DeclsCase = mkLet True mkDecls DeclsDo = \decls -> Do (map toBind decls) where toBind (Decl lhs rhs _ _) = BindLet lhs rhs toBind d = d mkLet :: Bool -> Decls -> Expr -> Expr mkLet False decls body = Let decls body mkLet True decls body = foldr oneCase body decls oneCase :: Decl -> Expr -> Expr oneCase (Decl left rhs _ _) ex = Case rhs [CaseAlt left ex] oneCase (Resume _ nt left rhs) ex = ResumeExpr nt rhs left ex oneCase _ ex = ex -- Gives the name of the visit function funname :: Show a => a -> Int -> String funname field 0 = show field ++ "_" funname field nr = show field ++ "_" ++ show nr -- Gives the name of a semantic function seqSemname :: String -> NontermIdent -> ConstructorIdent -> Int -> String seqSemname pre nt con 0 = semname pre nt con seqSemname pre nt con nr = semname pre nt con ++ "_" ++ show nr -- Gives the name of a type typeName :: NontermIdent -> Int -> String typeName nt 0 = "T_" ++ show nt typeName nt n = "T_" ++ show nt ++ "_" ++ show n ntOfVisit :: NontermIdent -> Int -> NontermIdent ntOfVisit nt 0 = nt ntOfVisit nt n = Ident (show nt ++ "_" ++ show n) (getPos nt) -- Gives the name of a visit function visitname :: String -> NontermIdent -> Int -> String visitname pre nt n = pre ++ getName nt ++ "_" ++ show n {-# LINE 258 "dist/build/GenerateCode.hs" #-} {-# LINE 1038 "src-ag/GenerateCode.ag" #-} toNamedType :: Bool -> NontermIdent -> ConstructorIdent -> Identifier -> Code.Type -> Code.NamedType toNamedType genStrict nt con nm tp = Code.Named genStrict strNm tp where strNm = recordFieldname nt con nm {-# LINE 266 "dist/build/GenerateCode.hs" #-} -- CGrammar ---------------------------------------------------- -- wrapper data Inh_CGrammar = Inh_CGrammar { options_Inh_CGrammar :: (Options) } data Syn_CGrammar = Syn_CGrammar { errors_Syn_CGrammar :: (Seq Error), output_Syn_CGrammar :: (Program) } {-# INLINABLE wrap_CGrammar #-} wrap_CGrammar :: T_CGrammar -> Inh_CGrammar -> (Syn_CGrammar ) wrap_CGrammar (T_CGrammar act) (Inh_CGrammar _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_CGrammar_vIn1 _lhsIoptions (T_CGrammar_vOut1 _lhsOerrors _lhsOoutput) <- return (inv_CGrammar_s2 sem arg1) return (Syn_CGrammar _lhsOerrors _lhsOoutput) ) -- cata {-# INLINE sem_CGrammar #-} sem_CGrammar :: CGrammar -> T_CGrammar sem_CGrammar ( CGrammar typeSyns_ derivings_ wrappers_ nonts_ pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ ) = sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ ( sem_CNonterminals nonts_ ) pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ -- semantic domain newtype T_CGrammar = T_CGrammar { attach_T_CGrammar :: Identity (T_CGrammar_s2 ) } newtype T_CGrammar_s2 = C_CGrammar_s2 { inv_CGrammar_s2 :: (T_CGrammar_v1 ) } data T_CGrammar_s3 = C_CGrammar_s3 type T_CGrammar_v1 = (T_CGrammar_vIn1 ) -> (T_CGrammar_vOut1 ) data T_CGrammar_vIn1 = T_CGrammar_vIn1 (Options) data T_CGrammar_vOut1 = T_CGrammar_vOut1 (Seq Error) (Program) {-# NOINLINE sem_CGrammar_CGrammar #-} sem_CGrammar_CGrammar :: (TypeSyns) -> (Derivings) -> (Set NontermIdent) -> T_CNonterminals -> (PragmaMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> (Bool) -> T_CGrammar sem_CGrammar_CGrammar arg_typeSyns_ arg_derivings_ arg_wrappers_ arg_nonts_ arg_pragmas_ arg_paramMap_ arg_contextMap_ arg_quantMap_ arg_aroundsMap_ arg_mergeMap_ arg_multivisit_ = T_CGrammar (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_CGrammar_v1 v1 = \ (T_CGrammar_vIn1 _lhsIoptions) -> ( let _nontsX11 = Control.Monad.Identity.runIdentity (attach_T_CNonterminals (arg_nonts_)) (T_CNonterminals_vOut10 _nontsIchunks _nontsIgathNts _nontsIsemDomUnfoldGath) = inv_CNonterminals_s11 _nontsX11 (T_CNonterminals_vIn10 _nontsOallNts _nontsOallPragmas _nontsOaroundMap _nontsOcontextMap _nontsOderivings _nontsOmergeMap _nontsOo_case _nontsOo_cata _nontsOo_clean _nontsOo_costcentre _nontsOo_data _nontsOo_linePragmas _nontsOo_monadic _nontsOo_newtypes _nontsOo_pretty _nontsOo_rename _nontsOo_sem _nontsOo_sig _nontsOo_splitsems _nontsOo_strictwrap _nontsOo_traces _nontsOo_unbox _nontsOoptions _nontsOparamMap _nontsOprefix _nontsOquantMap _nontsOtypeSyns _nontsOunfoldSemDom _nontsOwith_sig _nontsOwrappers) _nontsOo_sig = rule0 _lhsIoptions _nontsOo_cata = rule1 _lhsIoptions _nontsOo_sem = rule2 _lhsIoptions _nontsOo_newtypes = rule3 _lhsIoptions _nontsOo_unbox = rule4 _lhsIoptions _nontsOo_case = rule5 _lhsIoptions _nontsOo_pretty = rule6 _lhsIoptions _nontsOo_rename = rule7 _lhsIoptions _nontsOo_strictwrap = rule8 _lhsIoptions _nontsOo_splitsems = rule9 _lhsIoptions _nontsOo_data = rule10 _lhsIoptions _nontsOprefix = rule11 _lhsIoptions _nontsOo_traces = rule12 _lhsIoptions _nontsOo_costcentre = rule13 _lhsIoptions _nontsOo_linePragmas = rule14 _lhsIoptions _nontsOo_monadic = rule15 _lhsIoptions _nontsOo_clean = rule16 _lhsIoptions _options = rule17 _lhsIoptions arg_multivisit_ _nontsOallPragmas = rule18 arg_pragmas_ _nontsOparamMap = rule19 arg_paramMap_ _nontsOcontextMap = rule20 arg_contextMap_ _nontsOquantMap = rule21 arg_quantMap_ _nontsOallNts = rule22 _nontsIgathNts _aroundMap = rule23 arg_aroundsMap_ _mergeMap = rule24 arg_mergeMap_ _unfoldSemDom = rule25 _lhsIoptions _nontsIsemDomUnfoldGath _nontsOwith_sig = rule26 _lhsIoptions _lhsOerrors :: Seq Error _lhsOerrors = rule27 () _lhsOoutput :: Program _lhsOoutput = rule28 _nontsIchunks arg_multivisit_ _nontsOtypeSyns = rule29 arg_typeSyns_ _nontsOderivings = rule30 arg_derivings_ _nontsOwrappers = rule31 arg_wrappers_ _nontsOaroundMap = rule32 _aroundMap _nontsOmergeMap = rule33 _mergeMap _nontsOoptions = rule34 _options _nontsOunfoldSemDom = rule35 _unfoldSemDom __result_ = T_CGrammar_vOut1 _lhsOerrors _lhsOoutput in __result_ ) in C_CGrammar_s2 v1 {-# INLINE rule0 #-} {-# LINE 52 "src-ag/GenerateCode.ag" #-} rule0 = \ ((_lhsIoptions) :: Options) -> {-# LINE 52 "src-ag/GenerateCode.ag" #-} typeSigs _lhsIoptions {-# LINE 352 "dist/build/GenerateCode.hs"#-} {-# INLINE rule1 #-} {-# LINE 53 "src-ag/GenerateCode.ag" #-} rule1 = \ ((_lhsIoptions) :: Options) -> {-# LINE 53 "src-ag/GenerateCode.ag" #-} folds _lhsIoptions {-# LINE 358 "dist/build/GenerateCode.hs"#-} {-# INLINE rule2 #-} {-# LINE 54 "src-ag/GenerateCode.ag" #-} rule2 = \ ((_lhsIoptions) :: Options) -> {-# LINE 54 "src-ag/GenerateCode.ag" #-} semfuns _lhsIoptions {-# LINE 364 "dist/build/GenerateCode.hs"#-} {-# INLINE rule3 #-} {-# LINE 55 "src-ag/GenerateCode.ag" #-} rule3 = \ ((_lhsIoptions) :: Options) -> {-# LINE 55 "src-ag/GenerateCode.ag" #-} newtypes _lhsIoptions {-# LINE 370 "dist/build/GenerateCode.hs"#-} {-# INLINE rule4 #-} {-# LINE 56 "src-ag/GenerateCode.ag" #-} rule4 = \ ((_lhsIoptions) :: Options) -> {-# LINE 56 "src-ag/GenerateCode.ag" #-} unbox _lhsIoptions {-# LINE 376 "dist/build/GenerateCode.hs"#-} {-# INLINE rule5 #-} {-# LINE 57 "src-ag/GenerateCode.ag" #-} rule5 = \ ((_lhsIoptions) :: Options) -> {-# LINE 57 "src-ag/GenerateCode.ag" #-} cases _lhsIoptions {-# LINE 382 "dist/build/GenerateCode.hs"#-} {-# INLINE rule6 #-} {-# LINE 58 "src-ag/GenerateCode.ag" #-} rule6 = \ ((_lhsIoptions) :: Options) -> {-# LINE 58 "src-ag/GenerateCode.ag" #-} attrInfo _lhsIoptions {-# LINE 388 "dist/build/GenerateCode.hs"#-} {-# INLINE rule7 #-} {-# LINE 59 "src-ag/GenerateCode.ag" #-} rule7 = \ ((_lhsIoptions) :: Options) -> {-# LINE 59 "src-ag/GenerateCode.ag" #-} rename _lhsIoptions {-# LINE 394 "dist/build/GenerateCode.hs"#-} {-# INLINE rule8 #-} {-# LINE 60 "src-ag/GenerateCode.ag" #-} rule8 = \ ((_lhsIoptions) :: Options) -> {-# LINE 60 "src-ag/GenerateCode.ag" #-} strictWrap _lhsIoptions {-# LINE 400 "dist/build/GenerateCode.hs"#-} {-# INLINE rule9 #-} {-# LINE 61 "src-ag/GenerateCode.ag" #-} rule9 = \ ((_lhsIoptions) :: Options) -> {-# LINE 61 "src-ag/GenerateCode.ag" #-} splitSems _lhsIoptions {-# LINE 406 "dist/build/GenerateCode.hs"#-} {-# INLINE rule10 #-} {-# LINE 62 "src-ag/GenerateCode.ag" #-} rule10 = \ ((_lhsIoptions) :: Options) -> {-# LINE 62 "src-ag/GenerateCode.ag" #-} if dataTypes _lhsIoptions then Just (strictData _lhsIoptions) else Nothing {-# LINE 412 "dist/build/GenerateCode.hs"#-} {-# INLINE rule11 #-} {-# LINE 63 "src-ag/GenerateCode.ag" #-} rule11 = \ ((_lhsIoptions) :: Options) -> {-# LINE 63 "src-ag/GenerateCode.ag" #-} prefix _lhsIoptions {-# LINE 418 "dist/build/GenerateCode.hs"#-} {-# INLINE rule12 #-} {-# LINE 64 "src-ag/GenerateCode.ag" #-} rule12 = \ ((_lhsIoptions) :: Options) -> {-# LINE 64 "src-ag/GenerateCode.ag" #-} genTraces _lhsIoptions {-# LINE 424 "dist/build/GenerateCode.hs"#-} {-# INLINE rule13 #-} {-# LINE 65 "src-ag/GenerateCode.ag" #-} rule13 = \ ((_lhsIoptions) :: Options) -> {-# LINE 65 "src-ag/GenerateCode.ag" #-} genCostCentres _lhsIoptions {-# LINE 430 "dist/build/GenerateCode.hs"#-} {-# INLINE rule14 #-} {-# LINE 66 "src-ag/GenerateCode.ag" #-} rule14 = \ ((_lhsIoptions) :: Options) -> {-# LINE 66 "src-ag/GenerateCode.ag" #-} genLinePragmas _lhsIoptions {-# LINE 436 "dist/build/GenerateCode.hs"#-} {-# INLINE rule15 #-} {-# LINE 67 "src-ag/GenerateCode.ag" #-} rule15 = \ ((_lhsIoptions) :: Options) -> {-# LINE 67 "src-ag/GenerateCode.ag" #-} monadic _lhsIoptions {-# LINE 442 "dist/build/GenerateCode.hs"#-} {-# INLINE rule16 #-} {-# LINE 68 "src-ag/GenerateCode.ag" #-} rule16 = \ ((_lhsIoptions) :: Options) -> {-# LINE 68 "src-ag/GenerateCode.ag" #-} clean _lhsIoptions {-# LINE 448 "dist/build/GenerateCode.hs"#-} {-# INLINE rule17 #-} {-# LINE 71 "src-ag/GenerateCode.ag" #-} rule17 = \ ((_lhsIoptions) :: Options) multivisit_ -> {-# LINE 71 "src-ag/GenerateCode.ag" #-} _lhsIoptions { breadthFirst = breadthFirst _lhsIoptions && visit _lhsIoptions && cases _lhsIoptions && multivisit_ } {-# LINE 454 "dist/build/GenerateCode.hs"#-} {-# INLINE rule18 #-} {-# LINE 76 "src-ag/GenerateCode.ag" #-} rule18 = \ pragmas_ -> {-# LINE 76 "src-ag/GenerateCode.ag" #-} pragmas_ {-# LINE 460 "dist/build/GenerateCode.hs"#-} {-# INLINE rule19 #-} {-# LINE 98 "src-ag/GenerateCode.ag" #-} rule19 = \ paramMap_ -> {-# LINE 98 "src-ag/GenerateCode.ag" #-} paramMap_ {-# LINE 466 "dist/build/GenerateCode.hs"#-} {-# INLINE rule20 #-} {-# LINE 120 "src-ag/GenerateCode.ag" #-} rule20 = \ contextMap_ -> {-# LINE 120 "src-ag/GenerateCode.ag" #-} contextMap_ {-# LINE 472 "dist/build/GenerateCode.hs"#-} {-# INLINE rule21 #-} {-# LINE 121 "src-ag/GenerateCode.ag" #-} rule21 = \ quantMap_ -> {-# LINE 121 "src-ag/GenerateCode.ag" #-} quantMap_ {-# LINE 478 "dist/build/GenerateCode.hs"#-} {-# INLINE rule22 #-} {-# LINE 137 "src-ag/GenerateCode.ag" #-} rule22 = \ ((_nontsIgathNts) :: Set NontermIdent) -> {-# LINE 137 "src-ag/GenerateCode.ag" #-} _nontsIgathNts {-# LINE 484 "dist/build/GenerateCode.hs"#-} {-# INLINE rule23 #-} {-# LINE 587 "src-ag/GenerateCode.ag" #-} rule23 = \ aroundsMap_ -> {-# LINE 587 "src-ag/GenerateCode.ag" #-} aroundsMap_ {-# LINE 490 "dist/build/GenerateCode.hs"#-} {-# INLINE rule24 #-} {-# LINE 603 "src-ag/GenerateCode.ag" #-} rule24 = \ mergeMap_ -> {-# LINE 603 "src-ag/GenerateCode.ag" #-} mergeMap_ {-# LINE 496 "dist/build/GenerateCode.hs"#-} {-# INLINE rule25 #-} {-# LINE 760 "src-ag/GenerateCode.ag" #-} rule25 = \ ((_lhsIoptions) :: Options) ((_nontsIsemDomUnfoldGath) :: Map (NontermIdent, Int) ([String], Code.Type)) -> {-# LINE 760 "src-ag/GenerateCode.ag" #-} \nt nr repl -> let (params, tp) = Map.findWithDefault (error ("No such semantic domain: " ++ show nt)) (nt, nr) _nontsIsemDomUnfoldGath replMap = Map.fromList (zip params repl) replace k = Map.findWithDefault ('@':k) k replMap in evalType _lhsIoptions replace tp {-# LINE 506 "dist/build/GenerateCode.hs"#-} {-# INLINE rule26 #-} {-# LINE 861 "src-ag/GenerateCode.ag" #-} rule26 = \ ((_lhsIoptions) :: Options) -> {-# LINE 861 "src-ag/GenerateCode.ag" #-} typeSigs _lhsIoptions {-# LINE 512 "dist/build/GenerateCode.hs"#-} {-# INLINE rule27 #-} {-# LINE 864 "src-ag/GenerateCode.ag" #-} rule27 = \ (_ :: ()) -> {-# LINE 864 "src-ag/GenerateCode.ag" #-} Seq.empty {-# LINE 518 "dist/build/GenerateCode.hs"#-} {-# INLINE rule28 #-} {-# LINE 933 "src-ag/GenerateCode.ag" #-} rule28 = \ ((_nontsIchunks) :: Chunks) multivisit_ -> {-# LINE 933 "src-ag/GenerateCode.ag" #-} Program _nontsIchunks multivisit_ {-# LINE 524 "dist/build/GenerateCode.hs"#-} {-# INLINE rule29 #-} {-# LINE 1001 "src-ag/GenerateCode.ag" #-} rule29 = \ typeSyns_ -> {-# LINE 1001 "src-ag/GenerateCode.ag" #-} typeSyns_ {-# LINE 530 "dist/build/GenerateCode.hs"#-} {-# INLINE rule30 #-} {-# LINE 1002 "src-ag/GenerateCode.ag" #-} rule30 = \ derivings_ -> {-# LINE 1002 "src-ag/GenerateCode.ag" #-} derivings_ {-# LINE 536 "dist/build/GenerateCode.hs"#-} {-# INLINE rule31 #-} {-# LINE 1003 "src-ag/GenerateCode.ag" #-} rule31 = \ wrappers_ -> {-# LINE 1003 "src-ag/GenerateCode.ag" #-} wrappers_ {-# LINE 542 "dist/build/GenerateCode.hs"#-} {-# INLINE rule32 #-} rule32 = \ _aroundMap -> _aroundMap {-# INLINE rule33 #-} rule33 = \ _mergeMap -> _mergeMap {-# INLINE rule34 #-} rule34 = \ _options -> _options {-# INLINE rule35 #-} rule35 = \ _unfoldSemDom -> _unfoldSemDom -- CInterface -------------------------------------------------- -- wrapper data Inh_CInterface = Inh_CInterface { inh_Inh_CInterface :: (Attributes), nt_Inh_CInterface :: (NontermIdent), o_case_Inh_CInterface :: (Bool), o_cata_Inh_CInterface :: (Bool), o_clean_Inh_CInterface :: (Bool), o_costcentre_Inh_CInterface :: (Bool), o_data_Inh_CInterface :: (Maybe Bool), o_linePragmas_Inh_CInterface :: (Bool), o_monadic_Inh_CInterface :: (Bool), o_newtypes_Inh_CInterface :: (Bool), o_pretty_Inh_CInterface :: (Bool), o_rename_Inh_CInterface :: (Bool), o_sem_Inh_CInterface :: (Bool), o_sig_Inh_CInterface :: (Bool), o_splitsems_Inh_CInterface :: (Bool), o_strictwrap_Inh_CInterface :: (Bool), o_traces_Inh_CInterface :: (Bool), o_unbox_Inh_CInterface :: (Bool), options_Inh_CInterface :: (Options), paramMap_Inh_CInterface :: (ParamMap), prefix_Inh_CInterface :: (String), syn_Inh_CInterface :: (Attributes) } data Syn_CInterface = Syn_CInterface { comments_Syn_CInterface :: ([String]), semDom_Syn_CInterface :: ([Decl]), semDomUnfoldGath_Syn_CInterface :: (Map (NontermIdent, Int) ([String], Code.Type)), wrapDecls_Syn_CInterface :: (Decls) } {-# INLINABLE wrap_CInterface #-} wrap_CInterface :: T_CInterface -> Inh_CInterface -> (Syn_CInterface ) wrap_CInterface (T_CInterface act) (Inh_CInterface _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_CInterface_vIn4 _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn (T_CInterface_vOut4 _lhsOcomments _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls) <- return (inv_CInterface_s5 sem arg4) return (Syn_CInterface _lhsOcomments _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls) ) -- cata {-# INLINE sem_CInterface #-} sem_CInterface :: CInterface -> T_CInterface sem_CInterface ( CInterface seg_ ) = sem_CInterface_CInterface ( sem_CSegments seg_ ) -- semantic domain newtype T_CInterface = T_CInterface { attach_T_CInterface :: Identity (T_CInterface_s5 ) } newtype T_CInterface_s5 = C_CInterface_s5 { inv_CInterface_s5 :: (T_CInterface_v4 ) } data T_CInterface_s6 = C_CInterface_s6 type T_CInterface_v4 = (T_CInterface_vIn4 ) -> (T_CInterface_vOut4 ) data T_CInterface_vIn4 = T_CInterface_vIn4 (Attributes) (NontermIdent) (Bool) (Bool) (Bool) (Bool) (Maybe Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (ParamMap) (String) (Attributes) data T_CInterface_vOut4 = T_CInterface_vOut4 ([String]) ([Decl]) (Map (NontermIdent, Int) ([String], Code.Type)) (Decls) {-# NOINLINE sem_CInterface_CInterface #-} sem_CInterface_CInterface :: T_CSegments -> T_CInterface sem_CInterface_CInterface arg_seg_ = T_CInterface (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_CInterface_v4 v4 = \ (T_CInterface_vIn4 _lhsIinh _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn) -> ( let _segX26 = Control.Monad.Identity.runIdentity (attach_T_CSegments (arg_seg_)) (T_CSegments_vOut25 _segIcomments _segIisNil _segIsemDom _segIsemDomUnfoldGath _segIwrapDecls) = inv_CSegments_s26 _segX26 (T_CSegments_vIn25 _segOinh _segOnr _segOnt _segOo_case _segOo_cata _segOo_clean _segOo_costcentre _segOo_data _segOo_linePragmas _segOo_monadic _segOo_newtypes _segOo_pretty _segOo_rename _segOo_sem _segOo_sig _segOo_splitsems _segOo_strictwrap _segOo_traces _segOo_unbox _segOoptions _segOparamMap _segOprefix _segOsyn) _segOnr = rule36 () _lhsOsemDom :: [Decl] _lhsOsemDom = rule37 _segIsemDom _lhsOcomments :: [String] _lhsOcomments = rule38 _segIcomments _lhsOsemDomUnfoldGath :: Map (NontermIdent, Int) ([String], Code.Type) _lhsOsemDomUnfoldGath = rule39 _segIsemDomUnfoldGath _lhsOwrapDecls :: Decls _lhsOwrapDecls = rule40 _segIwrapDecls _segOinh = rule41 _lhsIinh _segOnt = rule42 _lhsInt _segOo_case = rule43 _lhsIo_case _segOo_cata = rule44 _lhsIo_cata _segOo_clean = rule45 _lhsIo_clean _segOo_costcentre = rule46 _lhsIo_costcentre _segOo_data = rule47 _lhsIo_data _segOo_linePragmas = rule48 _lhsIo_linePragmas _segOo_monadic = rule49 _lhsIo_monadic _segOo_newtypes = rule50 _lhsIo_newtypes _segOo_pretty = rule51 _lhsIo_pretty _segOo_rename = rule52 _lhsIo_rename _segOo_sem = rule53 _lhsIo_sem _segOo_sig = rule54 _lhsIo_sig _segOo_splitsems = rule55 _lhsIo_splitsems _segOo_strictwrap = rule56 _lhsIo_strictwrap _segOo_traces = rule57 _lhsIo_traces _segOo_unbox = rule58 _lhsIo_unbox _segOoptions = rule59 _lhsIoptions _segOparamMap = rule60 _lhsIparamMap _segOprefix = rule61 _lhsIprefix _segOsyn = rule62 _lhsIsyn __result_ = T_CInterface_vOut4 _lhsOcomments _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls in __result_ ) in C_CInterface_s5 v4 {-# INLINE rule36 #-} {-# LINE 286 "src-ag/GenerateCode.ag" #-} rule36 = \ (_ :: ()) -> {-# LINE 286 "src-ag/GenerateCode.ag" #-} 0 {-# LINE 634 "dist/build/GenerateCode.hs"#-} {-# INLINE rule37 #-} {-# LINE 717 "src-ag/GenerateCode.ag" #-} rule37 = \ ((_segIsemDom) :: [Decl]) -> {-# LINE 717 "src-ag/GenerateCode.ag" #-} Comment "semantic domain" : _segIsemDom {-# LINE 640 "dist/build/GenerateCode.hs"#-} {-# INLINE rule38 #-} rule38 = \ ((_segIcomments) :: [String]) -> _segIcomments {-# INLINE rule39 #-} rule39 = \ ((_segIsemDomUnfoldGath) :: Map (NontermIdent, Int) ([String], Code.Type)) -> _segIsemDomUnfoldGath {-# INLINE rule40 #-} rule40 = \ ((_segIwrapDecls) :: Decls) -> _segIwrapDecls {-# INLINE rule41 #-} rule41 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule42 #-} rule42 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule43 #-} rule43 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule44 #-} rule44 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule45 #-} rule45 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule46 #-} rule46 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule47 #-} rule47 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule48 #-} rule48 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule49 #-} rule49 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule50 #-} rule50 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule51 #-} rule51 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule52 #-} rule52 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule53 #-} rule53 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule54 #-} rule54 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule55 #-} rule55 = \ ((_lhsIo_splitsems) :: Bool) -> _lhsIo_splitsems {-# INLINE rule56 #-} rule56 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule57 #-} rule57 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule58 #-} rule58 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule59 #-} rule59 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule60 #-} rule60 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule61 #-} rule61 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule62 #-} rule62 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn -- CNonterminal ------------------------------------------------ -- wrapper data Inh_CNonterminal = Inh_CNonterminal { allNts_Inh_CNonterminal :: (Set NontermIdent), allPragmas_Inh_CNonterminal :: (PragmaMap), aroundMap_Inh_CNonterminal :: (Map NontermIdent (Map ConstructorIdent (Set Identifier))), contextMap_Inh_CNonterminal :: (ContextMap), derivings_Inh_CNonterminal :: (Derivings), mergeMap_Inh_CNonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))), o_case_Inh_CNonterminal :: (Bool), o_cata_Inh_CNonterminal :: (Bool), o_clean_Inh_CNonterminal :: (Bool), o_costcentre_Inh_CNonterminal :: (Bool), o_data_Inh_CNonterminal :: (Maybe Bool), o_linePragmas_Inh_CNonterminal :: (Bool), o_monadic_Inh_CNonterminal :: (Bool), o_newtypes_Inh_CNonterminal :: (Bool), o_pretty_Inh_CNonterminal :: (Bool), o_rename_Inh_CNonterminal :: (Bool), o_sem_Inh_CNonterminal :: (Bool), o_sig_Inh_CNonterminal :: (Bool), o_splitsems_Inh_CNonterminal :: (Bool), o_strictwrap_Inh_CNonterminal :: (Bool), o_traces_Inh_CNonterminal :: (Bool), o_unbox_Inh_CNonterminal :: (Bool), options_Inh_CNonterminal :: (Options), paramMap_Inh_CNonterminal :: (ParamMap), prefix_Inh_CNonterminal :: (String), quantMap_Inh_CNonterminal :: (QuantMap), typeSyns_Inh_CNonterminal :: (TypeSyns), unfoldSemDom_Inh_CNonterminal :: (NontermIdent -> Int -> [String] -> Code.Type), with_sig_Inh_CNonterminal :: (Bool), wrappers_Inh_CNonterminal :: (Set NontermIdent) } data Syn_CNonterminal = Syn_CNonterminal { chunks_Syn_CNonterminal :: (Chunks), gathNts_Syn_CNonterminal :: (Set NontermIdent), semDomUnfoldGath_Syn_CNonterminal :: (Map (NontermIdent, Int) ([String], Code.Type)) } {-# INLINABLE wrap_CNonterminal #-} wrap_CNonterminal :: T_CNonterminal -> Inh_CNonterminal -> (Syn_CNonterminal ) wrap_CNonterminal (T_CNonterminal act) (Inh_CNonterminal _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIderivings _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_CNonterminal_vIn7 _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIderivings _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers (T_CNonterminal_vOut7 _lhsOchunks _lhsOgathNts _lhsOsemDomUnfoldGath) <- return (inv_CNonterminal_s8 sem arg7) return (Syn_CNonterminal _lhsOchunks _lhsOgathNts _lhsOsemDomUnfoldGath) ) -- cata {-# INLINE sem_CNonterminal #-} sem_CNonterminal :: CNonterminal -> T_CNonterminal sem_CNonterminal ( CNonterminal nt_ params_ inh_ syn_ prods_ inter_ ) = sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ ( sem_CProductions prods_ ) ( sem_CInterface inter_ ) -- semantic domain newtype T_CNonterminal = T_CNonterminal { attach_T_CNonterminal :: Identity (T_CNonterminal_s8 ) } newtype T_CNonterminal_s8 = C_CNonterminal_s8 { inv_CNonterminal_s8 :: (T_CNonterminal_v7 ) } data T_CNonterminal_s9 = C_CNonterminal_s9 type T_CNonterminal_v7 = (T_CNonterminal_vIn7 ) -> (T_CNonterminal_vOut7 ) data T_CNonterminal_vIn7 = T_CNonterminal_vIn7 (Set NontermIdent) (PragmaMap) (Map NontermIdent (Map ConstructorIdent (Set Identifier))) (ContextMap) (Derivings) (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) (Bool) (Bool) (Bool) (Bool) (Maybe Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (ParamMap) (String) (QuantMap) (TypeSyns) (NontermIdent -> Int -> [String] -> Code.Type) (Bool) (Set NontermIdent) data T_CNonterminal_vOut7 = T_CNonterminal_vOut7 (Chunks) (Set NontermIdent) (Map (NontermIdent, Int) ([String], Code.Type)) {-# NOINLINE sem_CNonterminal_CNonterminal #-} sem_CNonterminal_CNonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_CProductions -> T_CInterface -> T_CNonterminal sem_CNonterminal_CNonterminal arg_nt_ arg_params_ arg_inh_ arg_syn_ arg_prods_ arg_inter_ = T_CNonterminal (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_CNonterminal_v7 v7 = \ (T_CNonterminal_vIn7 _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIderivings _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) -> ( let _prodsX17 = Control.Monad.Identity.runIdentity (attach_T_CProductions (arg_prods_)) _interX5 = Control.Monad.Identity.runIdentity (attach_T_CInterface (arg_inter_)) (T_CProductions_vOut16 _prodsIcataAlts _prodsIcomments _prodsIdataAlts _prodsIdecls _prodsIsemNames) = inv_CProductions_s17 _prodsX17 (T_CProductions_vIn16 _prodsOallNts _prodsOallPragmas _prodsOaroundMap _prodsOcontextMap _prodsOinh _prodsOmergeMap _prodsOnt _prodsOo_case _prodsOo_cata _prodsOo_clean _prodsOo_costcentre _prodsOo_data _prodsOo_linePragmas _prodsOo_monadic _prodsOo_newtypes _prodsOo_pretty _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_splitsems _prodsOo_strictwrap _prodsOo_traces _prodsOo_unbox _prodsOoptions _prodsOparamMap _prodsOprefix _prodsOquantMap _prodsOsyn _prodsOunfoldSemDom _prodsOwith_sig _prodsOwrappers) (T_CInterface_vOut4 _interIcomments _interIsemDom _interIsemDomUnfoldGath _interIwrapDecls) = inv_CInterface_s5 _interX5 (T_CInterface_vIn4 _interOinh _interOnt _interOo_case _interOo_cata _interOo_clean _interOo_costcentre _interOo_data _interOo_linePragmas _interOo_monadic _interOo_newtypes _interOo_pretty _interOo_rename _interOo_sem _interOo_sig _interOo_splitsems _interOo_strictwrap _interOo_traces _interOo_unbox _interOoptions _interOparamMap _interOprefix _interOsyn) (_interOinh,_interOsyn,_interOnt) = rule63 arg_inh_ arg_nt_ arg_syn_ (_prodsOinh,_prodsOsyn,_prodsOnt) = rule64 arg_inh_ arg_nt_ arg_syn_ _lhsOgathNts :: Set NontermIdent _lhsOgathNts = rule65 arg_nt_ _aroundMap = rule66 _lhsIaroundMap arg_nt_ _mergeMap = rule67 _lhsImergeMap arg_nt_ _semWrapper = rule68 _interIwrapDecls _lhsIo_newtypes _lhsIo_strictwrap _lhsIoptions arg_inh_ arg_nt_ arg_params_ arg_syn_ _comment = rule69 _interIcomments _prodsIcomments _lhsOchunks :: Chunks _lhsOchunks = rule70 _cataFun _comment _dataDef _genCata _interIsemDom _lhsIo_cata _lhsIo_data _lhsIo_pretty _lhsIo_sem _lhsIo_sig _lhsIwrappers _prodsIdecls _prodsIsemNames _semWrapper arg_nt_ _dataDef = rule71 _lhsIderivings _lhsIo_data _lhsIoptions _lhsItypeSyns _prodsIdataAlts arg_nt_ arg_params_ _genCata = rule72 _lhsIoptions arg_nt_ _cataFun = rule73 _lhsIcontextMap _lhsIo_sig _lhsIoptions _lhsIprefix _lhsIquantMap _lhsItypeSyns _prodsIcataAlts arg_nt_ arg_params_ _lhsOsemDomUnfoldGath :: Map (NontermIdent, Int) ([String], Code.Type) _lhsOsemDomUnfoldGath = rule74 _interIsemDomUnfoldGath _prodsOallNts = rule75 _lhsIallNts _prodsOallPragmas = rule76 _lhsIallPragmas _prodsOaroundMap = rule77 _aroundMap _prodsOcontextMap = rule78 _lhsIcontextMap _prodsOmergeMap = rule79 _mergeMap _prodsOo_case = rule80 _lhsIo_case _prodsOo_cata = rule81 _lhsIo_cata _prodsOo_clean = rule82 _lhsIo_clean _prodsOo_costcentre = rule83 _lhsIo_costcentre _prodsOo_data = rule84 _lhsIo_data _prodsOo_linePragmas = rule85 _lhsIo_linePragmas _prodsOo_monadic = rule86 _lhsIo_monadic _prodsOo_newtypes = rule87 _lhsIo_newtypes _prodsOo_pretty = rule88 _lhsIo_pretty _prodsOo_rename = rule89 _lhsIo_rename _prodsOo_sem = rule90 _lhsIo_sem _prodsOo_sig = rule91 _lhsIo_sig _prodsOo_splitsems = rule92 _lhsIo_splitsems _prodsOo_strictwrap = rule93 _lhsIo_strictwrap _prodsOo_traces = rule94 _lhsIo_traces _prodsOo_unbox = rule95 _lhsIo_unbox _prodsOoptions = rule96 _lhsIoptions _prodsOparamMap = rule97 _lhsIparamMap _prodsOprefix = rule98 _lhsIprefix _prodsOquantMap = rule99 _lhsIquantMap _prodsOunfoldSemDom = rule100 _lhsIunfoldSemDom _prodsOwith_sig = rule101 _lhsIwith_sig _prodsOwrappers = rule102 _lhsIwrappers _interOo_case = rule103 _lhsIo_case _interOo_cata = rule104 _lhsIo_cata _interOo_clean = rule105 _lhsIo_clean _interOo_costcentre = rule106 _lhsIo_costcentre _interOo_data = rule107 _lhsIo_data _interOo_linePragmas = rule108 _lhsIo_linePragmas _interOo_monadic = rule109 _lhsIo_monadic _interOo_newtypes = rule110 _lhsIo_newtypes _interOo_pretty = rule111 _lhsIo_pretty _interOo_rename = rule112 _lhsIo_rename _interOo_sem = rule113 _lhsIo_sem _interOo_sig = rule114 _lhsIo_sig _interOo_splitsems = rule115 _lhsIo_splitsems _interOo_strictwrap = rule116 _lhsIo_strictwrap _interOo_traces = rule117 _lhsIo_traces _interOo_unbox = rule118 _lhsIo_unbox _interOoptions = rule119 _lhsIoptions _interOparamMap = rule120 _lhsIparamMap _interOprefix = rule121 _lhsIprefix __result_ = T_CNonterminal_vOut7 _lhsOchunks _lhsOgathNts _lhsOsemDomUnfoldGath in __result_ ) in C_CNonterminal_s8 v7 {-# INLINE rule63 #-} {-# LINE 86 "src-ag/GenerateCode.ag" #-} rule63 = \ inh_ nt_ syn_ -> {-# LINE 86 "src-ag/GenerateCode.ag" #-} (inh_,syn_,nt_) {-# LINE 828 "dist/build/GenerateCode.hs"#-} {-# INLINE rule64 #-} {-# LINE 87 "src-ag/GenerateCode.ag" #-} rule64 = \ inh_ nt_ syn_ -> {-# LINE 87 "src-ag/GenerateCode.ag" #-} (inh_,syn_,nt_) {-# LINE 834 "dist/build/GenerateCode.hs"#-} {-# INLINE rule65 #-} {-# LINE 143 "src-ag/GenerateCode.ag" #-} rule65 = \ nt_ -> {-# LINE 143 "src-ag/GenerateCode.ag" #-} Set.singleton nt_ {-# LINE 840 "dist/build/GenerateCode.hs"#-} {-# INLINE rule66 #-} {-# LINE 588 "src-ag/GenerateCode.ag" #-} rule66 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Set Identifier))) nt_ -> {-# LINE 588 "src-ag/GenerateCode.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIaroundMap {-# LINE 846 "dist/build/GenerateCode.hs"#-} {-# INLINE rule67 #-} {-# LINE 604 "src-ag/GenerateCode.ag" #-} rule67 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) nt_ -> {-# LINE 604 "src-ag/GenerateCode.ag" #-} Map.findWithDefault Map.empty nt_ _lhsImergeMap {-# LINE 852 "dist/build/GenerateCode.hs"#-} {-# INLINE rule68 #-} {-# LINE 810 "src-ag/GenerateCode.ag" #-} rule68 = \ ((_interIwrapDecls) :: Decls) ((_lhsIo_newtypes) :: Bool) ((_lhsIo_strictwrap) :: Bool) ((_lhsIoptions) :: Options) inh_ nt_ params_ syn_ -> {-# LINE 810 "src-ag/GenerateCode.ag" #-} let params' = map getName params_ inhAttrs = Map.toList inh_ synAttrs = Map.toList syn_ inhVars = [ SimpleExpr (attrname _lhsIoptions True _LHS a) | (a,_) <- inhAttrs ] synVars = [ SimpleExpr (attrname _lhsIoptions False _LHS a) | (a,_) <- synAttrs ] var = "sem" wrapNT = "wrap" ++ "_" ++ getName nt_ inhNT = "Inh" ++ "_" ++ getName nt_ synNT = "Syn" ++ "_" ++ getName nt_ varPat = if _lhsIo_newtypes then App (sdtype nt_) [SimpleExpr var] else SimpleExpr var evalTp | null params' = id | otherwise = idEvalType _lhsIoptions appParams nm = TypeApp (SimpleType nm) (map SimpleType params') typeSig = TSig wrapNT (evalTp $ appParams (sdtype nt_) `Arr` (appParams inhNT `Arr` appParams synNT)) mkstrict = Named _lhsIo_strictwrap mkdata n attrs = Data n params' [Record n [mkstrict (getName f++"_"++n) $ evalTp $ typeToCodeType (Just nt_) params' t | (f,t) <- attrs]] False [] datas = [mkdata inhNT inhAttrs, mkdata synNT synAttrs] in datas ++ [ typeSig , Decl (Fun wrapNT [varPat, App inhNT inhVars]) (Let _interIwrapDecls (App synNT synVars)) Set.empty Set.empty ] {-# LINE 881 "dist/build/GenerateCode.hs"#-} {-# INLINE rule69 #-} {-# LINE 871 "src-ag/GenerateCode.ag" #-} rule69 = \ ((_interIcomments) :: [String]) ((_prodsIcomments) :: [String]) -> {-# LINE 871 "src-ag/GenerateCode.ag" #-} Comment . unlines . map ind $ ( _interIcomments ++ ("alternatives:" : map ind _prodsIcomments) ) {-# LINE 887 "dist/build/GenerateCode.hs"#-} {-# INLINE rule70 #-} {-# LINE 936 "src-ag/GenerateCode.ag" #-} rule70 = \ _cataFun _comment _dataDef _genCata ((_interIsemDom) :: [Decl]) ((_lhsIo_cata) :: Bool) ((_lhsIo_data) :: Maybe Bool) ((_lhsIo_pretty) :: Bool) ((_lhsIo_sem) :: Bool) ((_lhsIo_sig) :: Bool) ((_lhsIwrappers) :: Set NontermIdent) ((_prodsIdecls) :: Decls) ((_prodsIsemNames) :: [String]) _semWrapper nt_ -> {-# LINE 936 "src-ag/GenerateCode.ag" #-} [ Chunk (getName nt_) (Comment (getName nt_ ++ " " ++ replicate (60 - length (getName nt_)) '-')) (if _lhsIo_pretty then [_comment ] else []) (if isJust _lhsIo_data then [_dataDef ] else []) (if _lhsIo_cata && _genCata then _cataFun else []) (if _lhsIo_sig then _interIsemDom else []) (if nt_ `Set.member` _lhsIwrappers then _semWrapper else []) (if _lhsIo_sem then _prodsIdecls else []) (if _lhsIo_sem then _prodsIsemNames else []) ] {-# LINE 902 "dist/build/GenerateCode.hs"#-} {-# INLINE rule71 #-} {-# LINE 1006 "src-ag/GenerateCode.ag" #-} rule71 = \ ((_lhsIderivings) :: Derivings) ((_lhsIo_data) :: Maybe Bool) ((_lhsIoptions) :: Options) ((_lhsItypeSyns) :: TypeSyns) ((_prodsIdataAlts) :: DataAlts) nt_ params_ -> {-# LINE 1006 "src-ag/GenerateCode.ag" #-} let params' = map getName params_ typeSyn tp = let theType = case tp of CommonTypes.Maybe t -> TMaybe $ typeToCodeType (Just nt_) params' t CommonTypes.Either t1 t2 -> TEither (typeToCodeType (Just nt_) params' t1) (typeToCodeType (Just nt_) params' t2) CommonTypes.Map t1 t2 -> TMap (typeToCodeType (Just nt_) params' t1) (typeToCodeType (Just nt_) params' t2) CommonTypes.IntMap t -> TIntMap $ typeToCodeType (Just nt_) params' t CommonTypes.List t -> Code.List $ typeToCodeType (Just nt_) params' t CommonTypes.Tuple ts -> Code.TupleType [typeToCodeType (Just nt_) params' t | (_,t) <- ts ] CommonTypes.OrdSet t -> TSet $ typeToCodeType (Just nt_) params' t CommonTypes.IntSet -> TIntSet in Code.Type (getName nt_) params' (idEvalType _lhsIoptions theType) derivings = maybe [] (map getName . Set.toList) (Map.lookup nt_ _lhsIderivings) dataDef = Data (getName nt_) (map getName params_) _prodsIdataAlts (maybe False id _lhsIo_data) derivings in maybe dataDef typeSyn $ lookup nt_ _lhsItypeSyns {-# LINE 922 "dist/build/GenerateCode.hs"#-} {-# INLINE rule72 #-} {-# LINE 1050 "src-ag/GenerateCode.ag" #-} rule72 = \ ((_lhsIoptions) :: Options) nt_ -> {-# LINE 1050 "src-ag/GenerateCode.ag" #-} not (nt_ `Set.member` nocatas _lhsIoptions) {-# LINE 928 "dist/build/GenerateCode.hs"#-} {-# INLINE rule73 #-} {-# LINE 1051 "src-ag/GenerateCode.ag" #-} rule73 = \ ((_lhsIcontextMap) :: ContextMap) ((_lhsIo_sig) :: Bool) ((_lhsIoptions) :: Options) ((_lhsIprefix) :: String) ((_lhsIquantMap) :: QuantMap) ((_lhsItypeSyns) :: TypeSyns) ((_prodsIcataAlts) :: Decls) nt_ params_ -> {-# LINE 1051 "src-ag/GenerateCode.ag" #-} let appParams nm = TypeApp (SimpleType nm) (map SimpleType (map getName params_)) evalTp | null params_ = id | otherwise = idEvalType _lhsIoptions tSig = TSig (cataname _lhsIprefix nt_) (appQuant _lhsIquantMap nt_ $ appContext _lhsIcontextMap nt_ $ evalTp $ appParams (getName nt_) `Arr` appParams (sdtype nt_)) special typ = case typ of CommonTypes.List tp -> let cons = SimpleExpr (semname _lhsIprefix nt_ (identifier "Cons")) nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil" )) arg = SimpleExpr "list" rarg = case tp of NT t _ _ -> let t' = maybe t id (deforestedNt t) in SimpleExpr ("(Prelude.map " ++ (cataname _lhsIprefix t') ++ " list)") _ -> arg lhs = Fun (cataname _lhsIprefix nt_) [arg] rhs = (App "Prelude.foldr" [cons,nil,rarg]) in [Decl lhs rhs Set.empty Set.empty] CommonTypes.Maybe tp -> let just = semname _lhsIprefix nt_ (identifier "Just") nothing = semname _lhsIprefix nt_ (identifier "Nothing" ) arg = SimpleExpr "x" rarg = case tp of NT t _ _ -> let t' = maybe t id (deforestedNt t) in App (cataname _lhsIprefix t') [arg] _ -> arg lhs a = Fun (cataname _lhsIprefix nt_) [a] in [Decl (lhs (App "Prelude.Just" [arg])) (App just [rarg]) Set.empty Set.empty ,Decl (lhs (SimpleExpr "Prelude.Nothing")) (SimpleExpr nothing) Set.empty Set.empty ] CommonTypes.Either tp1 tp2 -> let left = semname _lhsIprefix nt_ (identifier "Left") right = semname _lhsIprefix nt_ (identifier "Right" ) arg = SimpleExpr "x" rarg0 = case tp1 of NT t _ _ -> let t' = maybe t id (deforestedNt t) in App (cataname _lhsIprefix t') [arg] _ -> arg rarg1 = case tp2 of NT t _ _ -> let t' = maybe t id (deforestedNt t) in App (cataname _lhsIprefix t') [arg] _ -> arg lhs a = Fun (cataname _lhsIprefix nt_) [a] in [Decl (lhs (App "Prelude.Left" [arg])) (App left [rarg0]) Set.empty Set.empty ,Decl (lhs (App "Prelude.Right" [arg])) (App right [rarg1]) Set.empty Set.empty ] CommonTypes.Map _ tp -> let entry = SimpleExpr (semname _lhsIprefix nt_ (identifier "Entry")) nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil")) arg = SimpleExpr "m" rarg = case tp of NT t _ _ -> let t' = maybe t id (deforestedNt t) in App "Data.Map.map" [SimpleExpr $ cataname _lhsIprefix t', arg] _ -> arg lhs = Fun (cataname _lhsIprefix nt_) [arg] rhs = App "Data.Map.foldrWithKey" [entry,nil,rarg] in [Decl lhs rhs Set.empty Set.empty] CommonTypes.IntMap tp -> let entry = SimpleExpr (semname _lhsIprefix nt_ (identifier "Entry")) nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil")) arg = SimpleExpr "m" rarg = case tp of NT t _ _ -> let t' = maybe t id (deforestedNt t) in App "Data.IntMap.map" [SimpleExpr $ cataname _lhsIprefix t', arg] _ -> arg lhs = Fun (cataname _lhsIprefix nt_) [arg] rhs = App "Data.IntMap.foldWithKey" [entry,nil,rarg] in [Decl lhs rhs Set.empty Set.empty] CommonTypes.Tuple tps -> let con = semname _lhsIprefix nt_ (identifier "Tuple") tps' = [ (SimpleExpr (getName x),y) | (x,y) <- tps] rargs = map rarg tps' rarg (n, tp) = case tp of NT t _ _ -> let t' = maybe t id (deforestedNt t) in App (cataname _lhsIprefix t') [n] _ -> n lhs = Fun (cataname _lhsIprefix nt_) [TupleExpr (map fst tps')] rhs = App con rargs in [Decl lhs rhs Set.empty Set.empty] CommonTypes.OrdSet tp -> let entry = SimpleExpr (semname _lhsIprefix nt_ (identifier "Entry")) nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil" )) arg = SimpleExpr "set" rentry = case tp of NT t _ _ -> let t' = maybe t id (deforestedNt t) in App "(.)" [entry, SimpleExpr $ cataname _lhsIprefix t'] _ -> entry lhs = Fun (cataname _lhsIprefix nt_) [arg] rhs = (App "Data.Set.foldr" [rentry,nil,arg]) in [Decl lhs rhs Set.empty Set.empty] CommonTypes.IntSet -> let entry = SimpleExpr (semname _lhsIprefix nt_ (identifier "Entry")) nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil" )) arg = SimpleExpr "set" lhs = Fun (cataname _lhsIprefix nt_) [arg] rhs = (App "Data.IntSet.foldr" [entry,nil,arg]) in [Decl lhs rhs Set.empty Set.empty] in Comment "cata" : (if _lhsIo_sig then [tSig] else []) ++ maybe _prodsIcataAlts special (lookup nt_ _lhsItypeSyns) {-# LINE 1032 "dist/build/GenerateCode.hs"#-} {-# INLINE rule74 #-} rule74 = \ ((_interIsemDomUnfoldGath) :: Map (NontermIdent, Int) ([String], Code.Type)) -> _interIsemDomUnfoldGath {-# INLINE rule75 #-} rule75 = \ ((_lhsIallNts) :: Set NontermIdent) -> _lhsIallNts {-# INLINE rule76 #-} rule76 = \ ((_lhsIallPragmas) :: PragmaMap) -> _lhsIallPragmas {-# INLINE rule77 #-} rule77 = \ _aroundMap -> _aroundMap {-# INLINE rule78 #-} rule78 = \ ((_lhsIcontextMap) :: ContextMap) -> _lhsIcontextMap {-# INLINE rule79 #-} rule79 = \ _mergeMap -> _mergeMap {-# INLINE rule80 #-} rule80 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule81 #-} rule81 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule82 #-} rule82 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule83 #-} rule83 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule84 #-} rule84 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule85 #-} rule85 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule86 #-} rule86 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule87 #-} rule87 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule88 #-} rule88 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule89 #-} rule89 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule90 #-} rule90 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule91 #-} rule91 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule92 #-} rule92 = \ ((_lhsIo_splitsems) :: Bool) -> _lhsIo_splitsems {-# INLINE rule93 #-} rule93 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule94 #-} rule94 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule95 #-} rule95 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule96 #-} rule96 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule97 #-} rule97 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule98 #-} rule98 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule99 #-} rule99 = \ ((_lhsIquantMap) :: QuantMap) -> _lhsIquantMap {-# INLINE rule100 #-} rule100 = \ ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) -> _lhsIunfoldSemDom {-# INLINE rule101 #-} rule101 = \ ((_lhsIwith_sig) :: Bool) -> _lhsIwith_sig {-# INLINE rule102 #-} rule102 = \ ((_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# INLINE rule103 #-} rule103 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule104 #-} rule104 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule105 #-} rule105 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule106 #-} rule106 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule107 #-} rule107 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule108 #-} rule108 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule109 #-} rule109 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule110 #-} rule110 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule111 #-} rule111 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule112 #-} rule112 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule113 #-} rule113 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule114 #-} rule114 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule115 #-} rule115 = \ ((_lhsIo_splitsems) :: Bool) -> _lhsIo_splitsems {-# INLINE rule116 #-} rule116 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule117 #-} rule117 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule118 #-} rule118 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule119 #-} rule119 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule120 #-} rule120 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule121 #-} rule121 = \ ((_lhsIprefix) :: String) -> _lhsIprefix -- CNonterminals ----------------------------------------------- -- wrapper data Inh_CNonterminals = Inh_CNonterminals { allNts_Inh_CNonterminals :: (Set NontermIdent), allPragmas_Inh_CNonterminals :: (PragmaMap), aroundMap_Inh_CNonterminals :: (Map NontermIdent (Map ConstructorIdent (Set Identifier))), contextMap_Inh_CNonterminals :: (ContextMap), derivings_Inh_CNonterminals :: (Derivings), mergeMap_Inh_CNonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))), o_case_Inh_CNonterminals :: (Bool), o_cata_Inh_CNonterminals :: (Bool), o_clean_Inh_CNonterminals :: (Bool), o_costcentre_Inh_CNonterminals :: (Bool), o_data_Inh_CNonterminals :: (Maybe Bool), o_linePragmas_Inh_CNonterminals :: (Bool), o_monadic_Inh_CNonterminals :: (Bool), o_newtypes_Inh_CNonterminals :: (Bool), o_pretty_Inh_CNonterminals :: (Bool), o_rename_Inh_CNonterminals :: (Bool), o_sem_Inh_CNonterminals :: (Bool), o_sig_Inh_CNonterminals :: (Bool), o_splitsems_Inh_CNonterminals :: (Bool), o_strictwrap_Inh_CNonterminals :: (Bool), o_traces_Inh_CNonterminals :: (Bool), o_unbox_Inh_CNonterminals :: (Bool), options_Inh_CNonterminals :: (Options), paramMap_Inh_CNonterminals :: (ParamMap), prefix_Inh_CNonterminals :: (String), quantMap_Inh_CNonterminals :: (QuantMap), typeSyns_Inh_CNonterminals :: (TypeSyns), unfoldSemDom_Inh_CNonterminals :: (NontermIdent -> Int -> [String] -> Code.Type), with_sig_Inh_CNonterminals :: (Bool), wrappers_Inh_CNonterminals :: (Set NontermIdent) } data Syn_CNonterminals = Syn_CNonterminals { chunks_Syn_CNonterminals :: (Chunks), gathNts_Syn_CNonterminals :: (Set NontermIdent), semDomUnfoldGath_Syn_CNonterminals :: (Map (NontermIdent, Int) ([String], Code.Type)) } {-# INLINABLE wrap_CNonterminals #-} wrap_CNonterminals :: T_CNonterminals -> Inh_CNonterminals -> (Syn_CNonterminals ) wrap_CNonterminals (T_CNonterminals act) (Inh_CNonterminals _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIderivings _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do sem <- act let arg10 = T_CNonterminals_vIn10 _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIderivings _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers (T_CNonterminals_vOut10 _lhsOchunks _lhsOgathNts _lhsOsemDomUnfoldGath) <- return (inv_CNonterminals_s11 sem arg10) return (Syn_CNonterminals _lhsOchunks _lhsOgathNts _lhsOsemDomUnfoldGath) ) -- cata {-# NOINLINE sem_CNonterminals #-} sem_CNonterminals :: CNonterminals -> T_CNonterminals sem_CNonterminals list = Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list) -- semantic domain newtype T_CNonterminals = T_CNonterminals { attach_T_CNonterminals :: Identity (T_CNonterminals_s11 ) } newtype T_CNonterminals_s11 = C_CNonterminals_s11 { inv_CNonterminals_s11 :: (T_CNonterminals_v10 ) } data T_CNonterminals_s12 = C_CNonterminals_s12 type T_CNonterminals_v10 = (T_CNonterminals_vIn10 ) -> (T_CNonterminals_vOut10 ) data T_CNonterminals_vIn10 = T_CNonterminals_vIn10 (Set NontermIdent) (PragmaMap) (Map NontermIdent (Map ConstructorIdent (Set Identifier))) (ContextMap) (Derivings) (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) (Bool) (Bool) (Bool) (Bool) (Maybe Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (ParamMap) (String) (QuantMap) (TypeSyns) (NontermIdent -> Int -> [String] -> Code.Type) (Bool) (Set NontermIdent) data T_CNonterminals_vOut10 = T_CNonterminals_vOut10 (Chunks) (Set NontermIdent) (Map (NontermIdent, Int) ([String], Code.Type)) {-# NOINLINE sem_CNonterminals_Cons #-} sem_CNonterminals_Cons :: T_CNonterminal -> T_CNonterminals -> T_CNonterminals sem_CNonterminals_Cons arg_hd_ arg_tl_ = T_CNonterminals (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_CNonterminals_v10 v10 = \ (T_CNonterminals_vIn10 _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIderivings _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) -> ( let _hdX8 = Control.Monad.Identity.runIdentity (attach_T_CNonterminal (arg_hd_)) _tlX11 = Control.Monad.Identity.runIdentity (attach_T_CNonterminals (arg_tl_)) (T_CNonterminal_vOut7 _hdIchunks _hdIgathNts _hdIsemDomUnfoldGath) = inv_CNonterminal_s8 _hdX8 (T_CNonterminal_vIn7 _hdOallNts _hdOallPragmas _hdOaroundMap _hdOcontextMap _hdOderivings _hdOmergeMap _hdOo_case _hdOo_cata _hdOo_clean _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_monadic _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOoptions _hdOparamMap _hdOprefix _hdOquantMap _hdOtypeSyns _hdOunfoldSemDom _hdOwith_sig _hdOwrappers) (T_CNonterminals_vOut10 _tlIchunks _tlIgathNts _tlIsemDomUnfoldGath) = inv_CNonterminals_s11 _tlX11 (T_CNonterminals_vIn10 _tlOallNts _tlOallPragmas _tlOaroundMap _tlOcontextMap _tlOderivings _tlOmergeMap _tlOo_case _tlOo_cata _tlOo_clean _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_monadic _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOoptions _tlOparamMap _tlOprefix _tlOquantMap _tlOtypeSyns _tlOunfoldSemDom _tlOwith_sig _tlOwrappers) _lhsOchunks :: Chunks _lhsOchunks = rule122 _hdIchunks _tlIchunks _lhsOgathNts :: Set NontermIdent _lhsOgathNts = rule123 _hdIgathNts _tlIgathNts _lhsOsemDomUnfoldGath :: Map (NontermIdent, Int) ([String], Code.Type) _lhsOsemDomUnfoldGath = rule124 _hdIsemDomUnfoldGath _tlIsemDomUnfoldGath _hdOallNts = rule125 _lhsIallNts _hdOallPragmas = rule126 _lhsIallPragmas _hdOaroundMap = rule127 _lhsIaroundMap _hdOcontextMap = rule128 _lhsIcontextMap _hdOderivings = rule129 _lhsIderivings _hdOmergeMap = rule130 _lhsImergeMap _hdOo_case = rule131 _lhsIo_case _hdOo_cata = rule132 _lhsIo_cata _hdOo_clean = rule133 _lhsIo_clean _hdOo_costcentre = rule134 _lhsIo_costcentre _hdOo_data = rule135 _lhsIo_data _hdOo_linePragmas = rule136 _lhsIo_linePragmas _hdOo_monadic = rule137 _lhsIo_monadic _hdOo_newtypes = rule138 _lhsIo_newtypes _hdOo_pretty = rule139 _lhsIo_pretty _hdOo_rename = rule140 _lhsIo_rename _hdOo_sem = rule141 _lhsIo_sem _hdOo_sig = rule142 _lhsIo_sig _hdOo_splitsems = rule143 _lhsIo_splitsems _hdOo_strictwrap = rule144 _lhsIo_strictwrap _hdOo_traces = rule145 _lhsIo_traces _hdOo_unbox = rule146 _lhsIo_unbox _hdOoptions = rule147 _lhsIoptions _hdOparamMap = rule148 _lhsIparamMap _hdOprefix = rule149 _lhsIprefix _hdOquantMap = rule150 _lhsIquantMap _hdOtypeSyns = rule151 _lhsItypeSyns _hdOunfoldSemDom = rule152 _lhsIunfoldSemDom _hdOwith_sig = rule153 _lhsIwith_sig _hdOwrappers = rule154 _lhsIwrappers _tlOallNts = rule155 _lhsIallNts _tlOallPragmas = rule156 _lhsIallPragmas _tlOaroundMap = rule157 _lhsIaroundMap _tlOcontextMap = rule158 _lhsIcontextMap _tlOderivings = rule159 _lhsIderivings _tlOmergeMap = rule160 _lhsImergeMap _tlOo_case = rule161 _lhsIo_case _tlOo_cata = rule162 _lhsIo_cata _tlOo_clean = rule163 _lhsIo_clean _tlOo_costcentre = rule164 _lhsIo_costcentre _tlOo_data = rule165 _lhsIo_data _tlOo_linePragmas = rule166 _lhsIo_linePragmas _tlOo_monadic = rule167 _lhsIo_monadic _tlOo_newtypes = rule168 _lhsIo_newtypes _tlOo_pretty = rule169 _lhsIo_pretty _tlOo_rename = rule170 _lhsIo_rename _tlOo_sem = rule171 _lhsIo_sem _tlOo_sig = rule172 _lhsIo_sig _tlOo_splitsems = rule173 _lhsIo_splitsems _tlOo_strictwrap = rule174 _lhsIo_strictwrap _tlOo_traces = rule175 _lhsIo_traces _tlOo_unbox = rule176 _lhsIo_unbox _tlOoptions = rule177 _lhsIoptions _tlOparamMap = rule178 _lhsIparamMap _tlOprefix = rule179 _lhsIprefix _tlOquantMap = rule180 _lhsIquantMap _tlOtypeSyns = rule181 _lhsItypeSyns _tlOunfoldSemDom = rule182 _lhsIunfoldSemDom _tlOwith_sig = rule183 _lhsIwith_sig _tlOwrappers = rule184 _lhsIwrappers __result_ = T_CNonterminals_vOut10 _lhsOchunks _lhsOgathNts _lhsOsemDomUnfoldGath in __result_ ) in C_CNonterminals_s11 v10 {-# INLINE rule122 #-} rule122 = \ ((_hdIchunks) :: Chunks) ((_tlIchunks) :: Chunks) -> _hdIchunks ++ _tlIchunks {-# INLINE rule123 #-} rule123 = \ ((_hdIgathNts) :: Set NontermIdent) ((_tlIgathNts) :: Set NontermIdent) -> _hdIgathNts `Set.union` _tlIgathNts {-# INLINE rule124 #-} rule124 = \ ((_hdIsemDomUnfoldGath) :: Map (NontermIdent, Int) ([String], Code.Type)) ((_tlIsemDomUnfoldGath) :: Map (NontermIdent, Int) ([String], Code.Type)) -> _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath {-# INLINE rule125 #-} rule125 = \ ((_lhsIallNts) :: Set NontermIdent) -> _lhsIallNts {-# INLINE rule126 #-} rule126 = \ ((_lhsIallPragmas) :: PragmaMap) -> _lhsIallPragmas {-# INLINE rule127 #-} rule127 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> _lhsIaroundMap {-# INLINE rule128 #-} rule128 = \ ((_lhsIcontextMap) :: ContextMap) -> _lhsIcontextMap {-# INLINE rule129 #-} rule129 = \ ((_lhsIderivings) :: Derivings) -> _lhsIderivings {-# INLINE rule130 #-} rule130 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) -> _lhsImergeMap {-# INLINE rule131 #-} rule131 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule132 #-} rule132 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule133 #-} rule133 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule134 #-} rule134 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule135 #-} rule135 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule136 #-} rule136 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule137 #-} rule137 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule138 #-} rule138 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule139 #-} rule139 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule140 #-} rule140 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule141 #-} rule141 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule142 #-} rule142 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule143 #-} rule143 = \ ((_lhsIo_splitsems) :: Bool) -> _lhsIo_splitsems {-# INLINE rule144 #-} rule144 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule145 #-} rule145 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule146 #-} rule146 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule147 #-} rule147 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule148 #-} rule148 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule149 #-} rule149 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule150 #-} rule150 = \ ((_lhsIquantMap) :: QuantMap) -> _lhsIquantMap {-# INLINE rule151 #-} rule151 = \ ((_lhsItypeSyns) :: TypeSyns) -> _lhsItypeSyns {-# INLINE rule152 #-} rule152 = \ ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) -> _lhsIunfoldSemDom {-# INLINE rule153 #-} rule153 = \ ((_lhsIwith_sig) :: Bool) -> _lhsIwith_sig {-# INLINE rule154 #-} rule154 = \ ((_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# INLINE rule155 #-} rule155 = \ ((_lhsIallNts) :: Set NontermIdent) -> _lhsIallNts {-# INLINE rule156 #-} rule156 = \ ((_lhsIallPragmas) :: PragmaMap) -> _lhsIallPragmas {-# INLINE rule157 #-} rule157 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> _lhsIaroundMap {-# INLINE rule158 #-} rule158 = \ ((_lhsIcontextMap) :: ContextMap) -> _lhsIcontextMap {-# INLINE rule159 #-} rule159 = \ ((_lhsIderivings) :: Derivings) -> _lhsIderivings {-# INLINE rule160 #-} rule160 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) -> _lhsImergeMap {-# INLINE rule161 #-} rule161 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule162 #-} rule162 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule163 #-} rule163 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule164 #-} rule164 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule165 #-} rule165 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule166 #-} rule166 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule167 #-} rule167 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule168 #-} rule168 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule169 #-} rule169 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule170 #-} rule170 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule171 #-} rule171 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule172 #-} rule172 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule173 #-} rule173 = \ ((_lhsIo_splitsems) :: Bool) -> _lhsIo_splitsems {-# INLINE rule174 #-} rule174 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule175 #-} rule175 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule176 #-} rule176 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule177 #-} rule177 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule178 #-} rule178 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule179 #-} rule179 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule180 #-} rule180 = \ ((_lhsIquantMap) :: QuantMap) -> _lhsIquantMap {-# INLINE rule181 #-} rule181 = \ ((_lhsItypeSyns) :: TypeSyns) -> _lhsItypeSyns {-# INLINE rule182 #-} rule182 = \ ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) -> _lhsIunfoldSemDom {-# INLINE rule183 #-} rule183 = \ ((_lhsIwith_sig) :: Bool) -> _lhsIwith_sig {-# INLINE rule184 #-} rule184 = \ ((_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# NOINLINE sem_CNonterminals_Nil #-} sem_CNonterminals_Nil :: T_CNonterminals sem_CNonterminals_Nil = T_CNonterminals (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_CNonterminals_v10 v10 = \ (T_CNonterminals_vIn10 _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIderivings _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsItypeSyns _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) -> ( let _lhsOchunks :: Chunks _lhsOchunks = rule185 () _lhsOgathNts :: Set NontermIdent _lhsOgathNts = rule186 () _lhsOsemDomUnfoldGath :: Map (NontermIdent, Int) ([String], Code.Type) _lhsOsemDomUnfoldGath = rule187 () __result_ = T_CNonterminals_vOut10 _lhsOchunks _lhsOgathNts _lhsOsemDomUnfoldGath in __result_ ) in C_CNonterminals_s11 v10 {-# INLINE rule185 #-} rule185 = \ (_ :: ()) -> [] {-# INLINE rule186 #-} rule186 = \ (_ :: ()) -> Set.empty {-# INLINE rule187 #-} rule187 = \ (_ :: ()) -> Map.empty -- CProduction ------------------------------------------------- -- wrapper data Inh_CProduction = Inh_CProduction { allNts_Inh_CProduction :: (Set NontermIdent), allPragmas_Inh_CProduction :: (PragmaMap), aroundMap_Inh_CProduction :: (Map ConstructorIdent (Set Identifier)), contextMap_Inh_CProduction :: (ContextMap), inh_Inh_CProduction :: (Attributes), mergeMap_Inh_CProduction :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))), nt_Inh_CProduction :: (NontermIdent), o_case_Inh_CProduction :: (Bool), o_cata_Inh_CProduction :: (Bool), o_clean_Inh_CProduction :: (Bool), o_costcentre_Inh_CProduction :: (Bool), o_data_Inh_CProduction :: (Maybe Bool), o_linePragmas_Inh_CProduction :: (Bool), o_monadic_Inh_CProduction :: (Bool), o_newtypes_Inh_CProduction :: (Bool), o_pretty_Inh_CProduction :: (Bool), o_rename_Inh_CProduction :: (Bool), o_sem_Inh_CProduction :: (Bool), o_sig_Inh_CProduction :: (Bool), o_splitsems_Inh_CProduction :: (Bool), o_strictwrap_Inh_CProduction :: (Bool), o_traces_Inh_CProduction :: (Bool), o_unbox_Inh_CProduction :: (Bool), options_Inh_CProduction :: (Options), paramMap_Inh_CProduction :: (ParamMap), prefix_Inh_CProduction :: (String), quantMap_Inh_CProduction :: (QuantMap), syn_Inh_CProduction :: (Attributes), unfoldSemDom_Inh_CProduction :: (NontermIdent -> Int -> [String] -> Code.Type), with_sig_Inh_CProduction :: (Bool), wrappers_Inh_CProduction :: (Set NontermIdent) } data Syn_CProduction = Syn_CProduction { cataAlt_Syn_CProduction :: (Decl), comments_Syn_CProduction :: ([String]), dataAlt_Syn_CProduction :: (DataAlt), decls_Syn_CProduction :: (Decls), semNames_Syn_CProduction :: ([String]) } {-# INLINABLE wrap_CProduction #-} wrap_CProduction :: T_CProduction -> Inh_CProduction -> (Syn_CProduction ) wrap_CProduction (T_CProduction act) (Inh_CProduction _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIinh _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do sem <- act let arg13 = T_CProduction_vIn13 _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIinh _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers (T_CProduction_vOut13 _lhsOcataAlt _lhsOcomments _lhsOdataAlt _lhsOdecls _lhsOsemNames) <- return (inv_CProduction_s14 sem arg13) return (Syn_CProduction _lhsOcataAlt _lhsOcomments _lhsOdataAlt _lhsOdecls _lhsOsemNames) ) -- cata {-# INLINE sem_CProduction #-} sem_CProduction :: CProduction -> T_CProduction sem_CProduction ( CProduction con_ visits_ children_ terminals_ ) = sem_CProduction_CProduction con_ ( sem_CVisits visits_ ) children_ terminals_ -- semantic domain newtype T_CProduction = T_CProduction { attach_T_CProduction :: Identity (T_CProduction_s14 ) } newtype T_CProduction_s14 = C_CProduction_s14 { inv_CProduction_s14 :: (T_CProduction_v13 ) } data T_CProduction_s15 = C_CProduction_s15 type T_CProduction_v13 = (T_CProduction_vIn13 ) -> (T_CProduction_vOut13 ) data T_CProduction_vIn13 = T_CProduction_vIn13 (Set NontermIdent) (PragmaMap) (Map ConstructorIdent (Set Identifier)) (ContextMap) (Attributes) (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) (NontermIdent) (Bool) (Bool) (Bool) (Bool) (Maybe Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (ParamMap) (String) (QuantMap) (Attributes) (NontermIdent -> Int -> [String] -> Code.Type) (Bool) (Set NontermIdent) data T_CProduction_vOut13 = T_CProduction_vOut13 (Decl) ([String]) (DataAlt) (Decls) ([String]) {-# NOINLINE sem_CProduction_CProduction #-} sem_CProduction_CProduction :: (ConstructorIdent) -> T_CVisits -> ([(Identifier,Type,ChildKind)]) -> ([Identifier]) -> T_CProduction sem_CProduction_CProduction arg_con_ arg_visits_ arg_children_ arg_terminals_ = T_CProduction (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_CProduction_v13 v13 = \ (T_CProduction_vIn13 _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIinh _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) -> ( let _visitsX32 = Control.Monad.Identity.runIdentity (attach_T_CVisits (arg_visits_)) (T_CVisits_vOut31 _visitsIcomments _visitsIdecls _visitsIgatherInstVisitNrs _visitsIintra _visitsIintraVars _visitsIisNil _visitsIsemNames _visitsIvisitedSet) = inv_CVisits_s32 _visitsX32 (T_CVisits_vIn31 _visitsOallNts _visitsOallPragmas _visitsOaroundMap _visitsOchildren _visitsOcon _visitsOcontextMap _visitsOinh _visitsOinstVisitNrs _visitsOmergeMap _visitsOnr _visitsOnt _visitsOo_case _visitsOo_cata _visitsOo_clean _visitsOo_costcentre _visitsOo_data _visitsOo_linePragmas _visitsOo_monadic _visitsOo_newtypes _visitsOo_pretty _visitsOo_rename _visitsOo_sem _visitsOo_sig _visitsOo_splitsems _visitsOo_strictwrap _visitsOo_traces _visitsOo_unbox _visitsOoptions _visitsOparamInstMap _visitsOparamMap _visitsOprefix _visitsOquantMap _visitsOsyn _visitsOterminals _visitsOunfoldSemDom _visitsOvisitedSet _visitsOwith_sig _visitsOwrappers) _visitsOcon = rule188 arg_con_ _visitsOterminals = rule189 arg_terminals_ _paramInstMap = rule190 _lhsIoptions arg_children_ _visitsOvisitedSet = rule191 () _visitsOnr = rule192 () _visitsOchildren = rule193 arg_children_ _visitsOinstVisitNrs = rule194 _visitsIgatherInstVisitNrs _aroundMap = rule195 _lhsIaroundMap arg_con_ _mergeMap = rule196 _lhsImergeMap arg_con_ _firstOrderChildren = rule197 arg_children_ _lhsOcomments :: [String] _lhsOcomments = rule198 _firstOrderChildren _visitsIcomments arg_con_ _params = rule199 _lhsInt _lhsIparamMap _lhsOdataAlt :: DataAlt _lhsOdataAlt = rule200 _firstOrderChildren _lhsInt _lhsIo_rename _lhsIoptions _params arg_con_ _lhsOcataAlt :: Decl _lhsOcataAlt = rule201 _firstOrderChildren _lhsInt _lhsIo_rename _lhsIoptions _lhsIprefix arg_con_ _lhsOdecls :: Decls _lhsOdecls = rule202 _visitsIdecls _lhsOsemNames :: [String] _lhsOsemNames = rule203 _visitsIsemNames _visitsOallNts = rule204 _lhsIallNts _visitsOallPragmas = rule205 _lhsIallPragmas _visitsOaroundMap = rule206 _aroundMap _visitsOcontextMap = rule207 _lhsIcontextMap _visitsOinh = rule208 _lhsIinh _visitsOmergeMap = rule209 _mergeMap _visitsOnt = rule210 _lhsInt _visitsOo_case = rule211 _lhsIo_case _visitsOo_cata = rule212 _lhsIo_cata _visitsOo_clean = rule213 _lhsIo_clean _visitsOo_costcentre = rule214 _lhsIo_costcentre _visitsOo_data = rule215 _lhsIo_data _visitsOo_linePragmas = rule216 _lhsIo_linePragmas _visitsOo_monadic = rule217 _lhsIo_monadic _visitsOo_newtypes = rule218 _lhsIo_newtypes _visitsOo_pretty = rule219 _lhsIo_pretty _visitsOo_rename = rule220 _lhsIo_rename _visitsOo_sem = rule221 _lhsIo_sem _visitsOo_sig = rule222 _lhsIo_sig _visitsOo_splitsems = rule223 _lhsIo_splitsems _visitsOo_strictwrap = rule224 _lhsIo_strictwrap _visitsOo_traces = rule225 _lhsIo_traces _visitsOo_unbox = rule226 _lhsIo_unbox _visitsOoptions = rule227 _lhsIoptions _visitsOparamInstMap = rule228 _paramInstMap _visitsOparamMap = rule229 _lhsIparamMap _visitsOprefix = rule230 _lhsIprefix _visitsOquantMap = rule231 _lhsIquantMap _visitsOsyn = rule232 _lhsIsyn _visitsOunfoldSemDom = rule233 _lhsIunfoldSemDom _visitsOwith_sig = rule234 _lhsIwith_sig _visitsOwrappers = rule235 _lhsIwrappers __result_ = T_CProduction_vOut13 _lhsOcataAlt _lhsOcomments _lhsOdataAlt _lhsOdecls _lhsOsemNames in __result_ ) in C_CProduction_s14 v13 {-# INLINE rule188 #-} {-# LINE 92 "src-ag/GenerateCode.ag" #-} rule188 = \ con_ -> {-# LINE 92 "src-ag/GenerateCode.ag" #-} con_ {-# LINE 1603 "dist/build/GenerateCode.hs"#-} {-# INLINE rule189 #-} {-# LINE 93 "src-ag/GenerateCode.ag" #-} rule189 = \ terminals_ -> {-# LINE 93 "src-ag/GenerateCode.ag" #-} terminals_ {-# LINE 1609 "dist/build/GenerateCode.hs"#-} {-# INLINE rule190 #-} {-# LINE 105 "src-ag/GenerateCode.ag" #-} rule190 = \ ((_lhsIoptions) :: Options) children_ -> {-# LINE 105 "src-ag/GenerateCode.ag" #-} Map.fromList [(nm, (extractNonterminal tp, tps)) | (nm,tp,_) <- children_, let tps = map (cleanupArg _lhsIoptions) $ nontermArgs tp, not (null tps) ] {-# LINE 1615 "dist/build/GenerateCode.hs"#-} {-# INLINE rule191 #-} {-# LINE 147 "src-ag/GenerateCode.ag" #-} rule191 = \ (_ :: ()) -> {-# LINE 147 "src-ag/GenerateCode.ag" #-} Set.empty {-# LINE 1621 "dist/build/GenerateCode.hs"#-} {-# INLINE rule192 #-} {-# LINE 282 "src-ag/GenerateCode.ag" #-} rule192 = \ (_ :: ()) -> {-# LINE 282 "src-ag/GenerateCode.ag" #-} 0 {-# LINE 1627 "dist/build/GenerateCode.hs"#-} {-# INLINE rule193 #-} {-# LINE 414 "src-ag/GenerateCode.ag" #-} rule193 = \ children_ -> {-# LINE 414 "src-ag/GenerateCode.ag" #-} children_ {-# LINE 1633 "dist/build/GenerateCode.hs"#-} {-# INLINE rule194 #-} {-# LINE 569 "src-ag/GenerateCode.ag" #-} rule194 = \ ((_visitsIgatherInstVisitNrs) :: Map Identifier Int) -> {-# LINE 569 "src-ag/GenerateCode.ag" #-} _visitsIgatherInstVisitNrs {-# LINE 1639 "dist/build/GenerateCode.hs"#-} {-# INLINE rule195 #-} {-# LINE 589 "src-ag/GenerateCode.ag" #-} rule195 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Set Identifier)) con_ -> {-# LINE 589 "src-ag/GenerateCode.ag" #-} Map.findWithDefault Set.empty con_ _lhsIaroundMap {-# LINE 1645 "dist/build/GenerateCode.hs"#-} {-# INLINE rule196 #-} {-# LINE 605 "src-ag/GenerateCode.ag" #-} rule196 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) con_ -> {-# LINE 605 "src-ag/GenerateCode.ag" #-} Map.findWithDefault Map.empty con_ _lhsImergeMap {-# LINE 1651 "dist/build/GenerateCode.hs"#-} {-# INLINE rule197 #-} {-# LINE 886 "src-ag/GenerateCode.ag" #-} rule197 = \ children_ -> {-# LINE 886 "src-ag/GenerateCode.ag" #-} [ (nm,fromJust mb,virt) | (nm,tp,virt) <- children_, let mb = isFirstOrder virt tp, isJust mb ] {-# LINE 1657 "dist/build/GenerateCode.hs"#-} {-# INLINE rule198 #-} {-# LINE 887 "src-ag/GenerateCode.ag" #-} rule198 = \ _firstOrderChildren ((_visitsIcomments) :: [String]) con_ -> {-# LINE 887 "src-ag/GenerateCode.ag" #-} ("alternative " ++ getName con_ ++ ":") : map ind ( map (\(x,y,_) -> makeLocalComment 14 "child" x (Just y)) _firstOrderChildren ++ _visitsIcomments ) {-# LINE 1666 "dist/build/GenerateCode.hs"#-} {-# INLINE rule199 #-} {-# LINE 1030 "src-ag/GenerateCode.ag" #-} rule199 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) -> {-# LINE 1030 "src-ag/GenerateCode.ag" #-} map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap {-# LINE 1672 "dist/build/GenerateCode.hs"#-} {-# INLINE rule200 #-} {-# LINE 1031 "src-ag/GenerateCode.ag" #-} rule200 = \ _firstOrderChildren ((_lhsInt) :: NontermIdent) ((_lhsIo_rename) :: Bool) ((_lhsIoptions) :: Options) _params con_ -> {-# LINE 1031 "src-ag/GenerateCode.ag" #-} let conNm = conname _lhsIo_rename _lhsInt con_ mkFields :: (NontermIdent -> ConstructorIdent -> Identifier -> Code.Type -> a) -> [a] mkFields f = map (\(nm,t,_) -> f _lhsInt con_ nm (typeToCodeType (Just _lhsInt) _params $ removeDeforested t)) _firstOrderChildren in if dataRecords _lhsIoptions then Record conNm $ mkFields $ toNamedType (strictData _lhsIoptions) else DataAlt conNm $ mkFields $ \_ _ _ t -> t {-# LINE 1683 "dist/build/GenerateCode.hs"#-} {-# INLINE rule201 #-} {-# LINE 1161 "src-ag/GenerateCode.ag" #-} rule201 = \ _firstOrderChildren ((_lhsInt) :: NontermIdent) ((_lhsIo_rename) :: Bool) ((_lhsIoptions) :: Options) ((_lhsIprefix) :: String) con_ -> {-# LINE 1161 "src-ag/GenerateCode.ag" #-} let lhs = Fun (cataname _lhsIprefix _lhsInt) [lhs_pat] lhs_pat = App (conname _lhsIo_rename _lhsInt con_) (map (\(n,_,_) -> SimpleExpr $ locname _lhsIoptions $ n) _firstOrderChildren ) rhs = App (semname _lhsIprefix _lhsInt con_) (map argument _firstOrderChildren ) argument (nm,NT tp _ _,_) = App (cataname _lhsIprefix tp) [SimpleExpr (locname _lhsIoptions nm)] argument (nm, _,_) = SimpleExpr (locname _lhsIoptions nm) in Decl lhs rhs Set.empty Set.empty {-# LINE 1697 "dist/build/GenerateCode.hs"#-} {-# INLINE rule202 #-} rule202 = \ ((_visitsIdecls) :: Decls) -> _visitsIdecls {-# INLINE rule203 #-} rule203 = \ ((_visitsIsemNames) :: [String]) -> _visitsIsemNames {-# INLINE rule204 #-} rule204 = \ ((_lhsIallNts) :: Set NontermIdent) -> _lhsIallNts {-# INLINE rule205 #-} rule205 = \ ((_lhsIallPragmas) :: PragmaMap) -> _lhsIallPragmas {-# INLINE rule206 #-} rule206 = \ _aroundMap -> _aroundMap {-# INLINE rule207 #-} rule207 = \ ((_lhsIcontextMap) :: ContextMap) -> _lhsIcontextMap {-# INLINE rule208 #-} rule208 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule209 #-} rule209 = \ _mergeMap -> _mergeMap {-# INLINE rule210 #-} rule210 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule211 #-} rule211 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule212 #-} rule212 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule213 #-} rule213 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule214 #-} rule214 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule215 #-} rule215 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule216 #-} rule216 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule217 #-} rule217 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule218 #-} rule218 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule219 #-} rule219 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule220 #-} rule220 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule221 #-} rule221 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule222 #-} rule222 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule223 #-} rule223 = \ ((_lhsIo_splitsems) :: Bool) -> _lhsIo_splitsems {-# INLINE rule224 #-} rule224 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule225 #-} rule225 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule226 #-} rule226 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule227 #-} rule227 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule228 #-} rule228 = \ _paramInstMap -> _paramInstMap {-# INLINE rule229 #-} rule229 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule230 #-} rule230 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule231 #-} rule231 = \ ((_lhsIquantMap) :: QuantMap) -> _lhsIquantMap {-# INLINE rule232 #-} rule232 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule233 #-} rule233 = \ ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) -> _lhsIunfoldSemDom {-# INLINE rule234 #-} rule234 = \ ((_lhsIwith_sig) :: Bool) -> _lhsIwith_sig {-# INLINE rule235 #-} rule235 = \ ((_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers -- CProductions ------------------------------------------------ -- wrapper data Inh_CProductions = Inh_CProductions { allNts_Inh_CProductions :: (Set NontermIdent), allPragmas_Inh_CProductions :: (PragmaMap), aroundMap_Inh_CProductions :: (Map ConstructorIdent (Set Identifier)), contextMap_Inh_CProductions :: (ContextMap), inh_Inh_CProductions :: (Attributes), mergeMap_Inh_CProductions :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))), nt_Inh_CProductions :: (NontermIdent), o_case_Inh_CProductions :: (Bool), o_cata_Inh_CProductions :: (Bool), o_clean_Inh_CProductions :: (Bool), o_costcentre_Inh_CProductions :: (Bool), o_data_Inh_CProductions :: (Maybe Bool), o_linePragmas_Inh_CProductions :: (Bool), o_monadic_Inh_CProductions :: (Bool), o_newtypes_Inh_CProductions :: (Bool), o_pretty_Inh_CProductions :: (Bool), o_rename_Inh_CProductions :: (Bool), o_sem_Inh_CProductions :: (Bool), o_sig_Inh_CProductions :: (Bool), o_splitsems_Inh_CProductions :: (Bool), o_strictwrap_Inh_CProductions :: (Bool), o_traces_Inh_CProductions :: (Bool), o_unbox_Inh_CProductions :: (Bool), options_Inh_CProductions :: (Options), paramMap_Inh_CProductions :: (ParamMap), prefix_Inh_CProductions :: (String), quantMap_Inh_CProductions :: (QuantMap), syn_Inh_CProductions :: (Attributes), unfoldSemDom_Inh_CProductions :: (NontermIdent -> Int -> [String] -> Code.Type), with_sig_Inh_CProductions :: (Bool), wrappers_Inh_CProductions :: (Set NontermIdent) } data Syn_CProductions = Syn_CProductions { cataAlts_Syn_CProductions :: (Decls), comments_Syn_CProductions :: ([String]), dataAlts_Syn_CProductions :: (DataAlts), decls_Syn_CProductions :: (Decls), semNames_Syn_CProductions :: ([String]) } {-# INLINABLE wrap_CProductions #-} wrap_CProductions :: T_CProductions -> Inh_CProductions -> (Syn_CProductions ) wrap_CProductions (T_CProductions act) (Inh_CProductions _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIinh _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do sem <- act let arg16 = T_CProductions_vIn16 _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIinh _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers (T_CProductions_vOut16 _lhsOcataAlts _lhsOcomments _lhsOdataAlts _lhsOdecls _lhsOsemNames) <- return (inv_CProductions_s17 sem arg16) return (Syn_CProductions _lhsOcataAlts _lhsOcomments _lhsOdataAlts _lhsOdecls _lhsOsemNames) ) -- cata {-# NOINLINE sem_CProductions #-} sem_CProductions :: CProductions -> T_CProductions sem_CProductions list = Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list) -- semantic domain newtype T_CProductions = T_CProductions { attach_T_CProductions :: Identity (T_CProductions_s17 ) } newtype T_CProductions_s17 = C_CProductions_s17 { inv_CProductions_s17 :: (T_CProductions_v16 ) } data T_CProductions_s18 = C_CProductions_s18 type T_CProductions_v16 = (T_CProductions_vIn16 ) -> (T_CProductions_vOut16 ) data T_CProductions_vIn16 = T_CProductions_vIn16 (Set NontermIdent) (PragmaMap) (Map ConstructorIdent (Set Identifier)) (ContextMap) (Attributes) (Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) (NontermIdent) (Bool) (Bool) (Bool) (Bool) (Maybe Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (ParamMap) (String) (QuantMap) (Attributes) (NontermIdent -> Int -> [String] -> Code.Type) (Bool) (Set NontermIdent) data T_CProductions_vOut16 = T_CProductions_vOut16 (Decls) ([String]) (DataAlts) (Decls) ([String]) {-# NOINLINE sem_CProductions_Cons #-} sem_CProductions_Cons :: T_CProduction -> T_CProductions -> T_CProductions sem_CProductions_Cons arg_hd_ arg_tl_ = T_CProductions (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_CProductions_v16 v16 = \ (T_CProductions_vIn16 _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIinh _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_CProduction (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_CProductions (arg_tl_)) (T_CProduction_vOut13 _hdIcataAlt _hdIcomments _hdIdataAlt _hdIdecls _hdIsemNames) = inv_CProduction_s14 _hdX14 (T_CProduction_vIn13 _hdOallNts _hdOallPragmas _hdOaroundMap _hdOcontextMap _hdOinh _hdOmergeMap _hdOnt _hdOo_case _hdOo_cata _hdOo_clean _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_monadic _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOoptions _hdOparamMap _hdOprefix _hdOquantMap _hdOsyn _hdOunfoldSemDom _hdOwith_sig _hdOwrappers) (T_CProductions_vOut16 _tlIcataAlts _tlIcomments _tlIdataAlts _tlIdecls _tlIsemNames) = inv_CProductions_s17 _tlX17 (T_CProductions_vIn16 _tlOallNts _tlOallPragmas _tlOaroundMap _tlOcontextMap _tlOinh _tlOmergeMap _tlOnt _tlOo_case _tlOo_cata _tlOo_clean _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_monadic _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOoptions _tlOparamMap _tlOprefix _tlOquantMap _tlOsyn _tlOunfoldSemDom _tlOwith_sig _tlOwrappers) _lhsOdataAlts :: DataAlts _lhsOdataAlts = rule236 _hdIdataAlt _tlIdataAlts _lhsOcataAlts :: Decls _lhsOcataAlts = rule237 _hdIcataAlt _tlIcataAlts _lhsOcomments :: [String] _lhsOcomments = rule238 _hdIcomments _tlIcomments _lhsOdecls :: Decls _lhsOdecls = rule239 _hdIdecls _tlIdecls _lhsOsemNames :: [String] _lhsOsemNames = rule240 _hdIsemNames _tlIsemNames _hdOallNts = rule241 _lhsIallNts _hdOallPragmas = rule242 _lhsIallPragmas _hdOaroundMap = rule243 _lhsIaroundMap _hdOcontextMap = rule244 _lhsIcontextMap _hdOinh = rule245 _lhsIinh _hdOmergeMap = rule246 _lhsImergeMap _hdOnt = rule247 _lhsInt _hdOo_case = rule248 _lhsIo_case _hdOo_cata = rule249 _lhsIo_cata _hdOo_clean = rule250 _lhsIo_clean _hdOo_costcentre = rule251 _lhsIo_costcentre _hdOo_data = rule252 _lhsIo_data _hdOo_linePragmas = rule253 _lhsIo_linePragmas _hdOo_monadic = rule254 _lhsIo_monadic _hdOo_newtypes = rule255 _lhsIo_newtypes _hdOo_pretty = rule256 _lhsIo_pretty _hdOo_rename = rule257 _lhsIo_rename _hdOo_sem = rule258 _lhsIo_sem _hdOo_sig = rule259 _lhsIo_sig _hdOo_splitsems = rule260 _lhsIo_splitsems _hdOo_strictwrap = rule261 _lhsIo_strictwrap _hdOo_traces = rule262 _lhsIo_traces _hdOo_unbox = rule263 _lhsIo_unbox _hdOoptions = rule264 _lhsIoptions _hdOparamMap = rule265 _lhsIparamMap _hdOprefix = rule266 _lhsIprefix _hdOquantMap = rule267 _lhsIquantMap _hdOsyn = rule268 _lhsIsyn _hdOunfoldSemDom = rule269 _lhsIunfoldSemDom _hdOwith_sig = rule270 _lhsIwith_sig _hdOwrappers = rule271 _lhsIwrappers _tlOallNts = rule272 _lhsIallNts _tlOallPragmas = rule273 _lhsIallPragmas _tlOaroundMap = rule274 _lhsIaroundMap _tlOcontextMap = rule275 _lhsIcontextMap _tlOinh = rule276 _lhsIinh _tlOmergeMap = rule277 _lhsImergeMap _tlOnt = rule278 _lhsInt _tlOo_case = rule279 _lhsIo_case _tlOo_cata = rule280 _lhsIo_cata _tlOo_clean = rule281 _lhsIo_clean _tlOo_costcentre = rule282 _lhsIo_costcentre _tlOo_data = rule283 _lhsIo_data _tlOo_linePragmas = rule284 _lhsIo_linePragmas _tlOo_monadic = rule285 _lhsIo_monadic _tlOo_newtypes = rule286 _lhsIo_newtypes _tlOo_pretty = rule287 _lhsIo_pretty _tlOo_rename = rule288 _lhsIo_rename _tlOo_sem = rule289 _lhsIo_sem _tlOo_sig = rule290 _lhsIo_sig _tlOo_splitsems = rule291 _lhsIo_splitsems _tlOo_strictwrap = rule292 _lhsIo_strictwrap _tlOo_traces = rule293 _lhsIo_traces _tlOo_unbox = rule294 _lhsIo_unbox _tlOoptions = rule295 _lhsIoptions _tlOparamMap = rule296 _lhsIparamMap _tlOprefix = rule297 _lhsIprefix _tlOquantMap = rule298 _lhsIquantMap _tlOsyn = rule299 _lhsIsyn _tlOunfoldSemDom = rule300 _lhsIunfoldSemDom _tlOwith_sig = rule301 _lhsIwith_sig _tlOwrappers = rule302 _lhsIwrappers __result_ = T_CProductions_vOut16 _lhsOcataAlts _lhsOcomments _lhsOdataAlts _lhsOdecls _lhsOsemNames in __result_ ) in C_CProductions_s17 v16 {-# INLINE rule236 #-} {-# LINE 1026 "src-ag/GenerateCode.ag" #-} rule236 = \ ((_hdIdataAlt) :: DataAlt) ((_tlIdataAlts) :: DataAlts) -> {-# LINE 1026 "src-ag/GenerateCode.ag" #-} _hdIdataAlt : _tlIdataAlts {-# LINE 1922 "dist/build/GenerateCode.hs"#-} {-# INLINE rule237 #-} {-# LINE 1157 "src-ag/GenerateCode.ag" #-} rule237 = \ ((_hdIcataAlt) :: Decl) ((_tlIcataAlts) :: Decls) -> {-# LINE 1157 "src-ag/GenerateCode.ag" #-} _hdIcataAlt : _tlIcataAlts {-# LINE 1928 "dist/build/GenerateCode.hs"#-} {-# INLINE rule238 #-} rule238 = \ ((_hdIcomments) :: [String]) ((_tlIcomments) :: [String]) -> _hdIcomments ++ _tlIcomments {-# INLINE rule239 #-} rule239 = \ ((_hdIdecls) :: Decls) ((_tlIdecls) :: Decls) -> _hdIdecls ++ _tlIdecls {-# INLINE rule240 #-} rule240 = \ ((_hdIsemNames) :: [String]) ((_tlIsemNames) :: [String]) -> _hdIsemNames ++ _tlIsemNames {-# INLINE rule241 #-} rule241 = \ ((_lhsIallNts) :: Set NontermIdent) -> _lhsIallNts {-# INLINE rule242 #-} rule242 = \ ((_lhsIallPragmas) :: PragmaMap) -> _lhsIallPragmas {-# INLINE rule243 #-} rule243 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Set Identifier)) -> _lhsIaroundMap {-# INLINE rule244 #-} rule244 = \ ((_lhsIcontextMap) :: ContextMap) -> _lhsIcontextMap {-# INLINE rule245 #-} rule245 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule246 #-} rule246 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) -> _lhsImergeMap {-# INLINE rule247 #-} rule247 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule248 #-} rule248 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule249 #-} rule249 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule250 #-} rule250 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule251 #-} rule251 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule252 #-} rule252 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule253 #-} rule253 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule254 #-} rule254 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule255 #-} rule255 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule256 #-} rule256 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule257 #-} rule257 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule258 #-} rule258 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule259 #-} rule259 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule260 #-} rule260 = \ ((_lhsIo_splitsems) :: Bool) -> _lhsIo_splitsems {-# INLINE rule261 #-} rule261 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule262 #-} rule262 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule263 #-} rule263 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule264 #-} rule264 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule265 #-} rule265 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule266 #-} rule266 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule267 #-} rule267 = \ ((_lhsIquantMap) :: QuantMap) -> _lhsIquantMap {-# INLINE rule268 #-} rule268 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule269 #-} rule269 = \ ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) -> _lhsIunfoldSemDom {-# INLINE rule270 #-} rule270 = \ ((_lhsIwith_sig) :: Bool) -> _lhsIwith_sig {-# INLINE rule271 #-} rule271 = \ ((_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# INLINE rule272 #-} rule272 = \ ((_lhsIallNts) :: Set NontermIdent) -> _lhsIallNts {-# INLINE rule273 #-} rule273 = \ ((_lhsIallPragmas) :: PragmaMap) -> _lhsIallPragmas {-# INLINE rule274 #-} rule274 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Set Identifier)) -> _lhsIaroundMap {-# INLINE rule275 #-} rule275 = \ ((_lhsIcontextMap) :: ContextMap) -> _lhsIcontextMap {-# INLINE rule276 #-} rule276 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule277 #-} rule277 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) -> _lhsImergeMap {-# INLINE rule278 #-} rule278 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule279 #-} rule279 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule280 #-} rule280 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule281 #-} rule281 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule282 #-} rule282 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule283 #-} rule283 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule284 #-} rule284 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule285 #-} rule285 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule286 #-} rule286 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule287 #-} rule287 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule288 #-} rule288 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule289 #-} rule289 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule290 #-} rule290 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule291 #-} rule291 = \ ((_lhsIo_splitsems) :: Bool) -> _lhsIo_splitsems {-# INLINE rule292 #-} rule292 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule293 #-} rule293 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule294 #-} rule294 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule295 #-} rule295 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule296 #-} rule296 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule297 #-} rule297 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule298 #-} rule298 = \ ((_lhsIquantMap) :: QuantMap) -> _lhsIquantMap {-# INLINE rule299 #-} rule299 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule300 #-} rule300 = \ ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) -> _lhsIunfoldSemDom {-# INLINE rule301 #-} rule301 = \ ((_lhsIwith_sig) :: Bool) -> _lhsIwith_sig {-# INLINE rule302 #-} rule302 = \ ((_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# NOINLINE sem_CProductions_Nil #-} sem_CProductions_Nil :: T_CProductions sem_CProductions_Nil = T_CProductions (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_CProductions_v16 v16 = \ (T_CProductions_vIn16 _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIcontextMap _lhsIinh _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIunfoldSemDom _lhsIwith_sig _lhsIwrappers) -> ( let _lhsOdataAlts :: DataAlts _lhsOdataAlts = rule303 () _lhsOcataAlts :: Decls _lhsOcataAlts = rule304 () _lhsOcomments :: [String] _lhsOcomments = rule305 () _lhsOdecls :: Decls _lhsOdecls = rule306 () _lhsOsemNames :: [String] _lhsOsemNames = rule307 () __result_ = T_CProductions_vOut16 _lhsOcataAlts _lhsOcomments _lhsOdataAlts _lhsOdecls _lhsOsemNames in __result_ ) in C_CProductions_s17 v16 {-# INLINE rule303 #-} {-# LINE 1027 "src-ag/GenerateCode.ag" #-} rule303 = \ (_ :: ()) -> {-# LINE 1027 "src-ag/GenerateCode.ag" #-} [] {-# LINE 2149 "dist/build/GenerateCode.hs"#-} {-# INLINE rule304 #-} {-# LINE 1158 "src-ag/GenerateCode.ag" #-} rule304 = \ (_ :: ()) -> {-# LINE 1158 "src-ag/GenerateCode.ag" #-} [] {-# LINE 2155 "dist/build/GenerateCode.hs"#-} {-# INLINE rule305 #-} rule305 = \ (_ :: ()) -> [] {-# INLINE rule306 #-} rule306 = \ (_ :: ()) -> [] {-# INLINE rule307 #-} rule307 = \ (_ :: ()) -> [] -- CRule ------------------------------------------------------- -- wrapper data Inh_CRule = Inh_CRule { allNts_Inh_CRule :: (Set NontermIdent), aroundMap_Inh_CRule :: (Set Identifier), children_Inh_CRule :: ([(Identifier,Type,ChildKind)]), con_Inh_CRule :: (ConstructorIdent), declsAbove_Inh_CRule :: ([Decl]), inh_Inh_CRule :: (Attributes), instVisitNrs_Inh_CRule :: (Map Identifier Int), mergeMap_Inh_CRule :: (Map Identifier (Identifier, [Identifier])), nr_Inh_CRule :: (Int), nt_Inh_CRule :: (NontermIdent), o_case_Inh_CRule :: (Bool), o_cata_Inh_CRule :: (Bool), o_clean_Inh_CRule :: (Bool), o_costcentre_Inh_CRule :: (Bool), o_data_Inh_CRule :: (Maybe Bool), o_linePragmas_Inh_CRule :: (Bool), o_monadic_Inh_CRule :: (Bool), o_newtypes_Inh_CRule :: (Bool), o_pretty_Inh_CRule :: (Bool), o_rename_Inh_CRule :: (Bool), o_sem_Inh_CRule :: (Bool), o_sig_Inh_CRule :: (Bool), o_splitsems_Inh_CRule :: (Bool), o_strictwrap_Inh_CRule :: (Bool), o_traces_Inh_CRule :: (Bool), o_unbox_Inh_CRule :: (Bool), options_Inh_CRule :: (Options), paramInstMap_Inh_CRule :: (Map Identifier (NontermIdent, [String])), paramMap_Inh_CRule :: (ParamMap), prefix_Inh_CRule :: (String), syn_Inh_CRule :: (Attributes), terminals_Inh_CRule :: ([Identifier]), unfoldSemDom_Inh_CRule :: (NontermIdent -> Int -> [String] -> Code.Type), visitedSet_Inh_CRule :: (Set Identifier), what_Inh_CRule :: (String) } data Syn_CRule = Syn_CRule { allTpsFound_Syn_CRule :: (Bool), bldBlocksFun_Syn_CRule :: (DeclBlocks -> DeclBlocks), comments_Syn_CRule :: ([String]), decls_Syn_CRule :: (Decls), declsAbove_Syn_CRule :: ([Decl]), definedInsts_Syn_CRule :: ([Identifier]), exprs_Syn_CRule :: (Exprs), tSigs_Syn_CRule :: ([Decl]), tps_Syn_CRule :: ([Type]), usedVars_Syn_CRule :: (Set String), visitedSet_Syn_CRule :: (Set Identifier) } {-# INLINABLE wrap_CRule #-} wrap_CRule :: T_CRule -> Inh_CRule -> (Syn_CRule ) wrap_CRule (T_CRule act) (Inh_CRule _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat) = Control.Monad.Identity.runIdentity ( do sem <- act let arg19 = T_CRule_vIn19 _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat (T_CRule_vOut19 _lhsOallTpsFound _lhsObldBlocksFun _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars _lhsOvisitedSet) <- return (inv_CRule_s20 sem arg19) return (Syn_CRule _lhsOallTpsFound _lhsObldBlocksFun _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars _lhsOvisitedSet) ) -- cata {-# NOINLINE sem_CRule #-} sem_CRule :: CRule -> T_CRule sem_CRule ( CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ pattern_ rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ ) = sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ ( sem_Pattern pattern_ ) rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ sem_CRule ( CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ ) = sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ -- semantic domain newtype T_CRule = T_CRule { attach_T_CRule :: Identity (T_CRule_s20 ) } newtype T_CRule_s20 = C_CRule_s20 { inv_CRule_s20 :: (T_CRule_v19 ) } data T_CRule_s21 = C_CRule_s21 type T_CRule_v19 = (T_CRule_vIn19 ) -> (T_CRule_vOut19 ) data T_CRule_vIn19 = T_CRule_vIn19 (Set NontermIdent) (Set Identifier) ([(Identifier,Type,ChildKind)]) (ConstructorIdent) ([Decl]) (Attributes) (Map Identifier Int) (Map Identifier (Identifier, [Identifier])) (Int) (NontermIdent) (Bool) (Bool) (Bool) (Bool) (Maybe Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (Map Identifier (NontermIdent, [String])) (ParamMap) (String) (Attributes) ([Identifier]) (NontermIdent -> Int -> [String] -> Code.Type) (Set Identifier) (String) data T_CRule_vOut19 = T_CRule_vOut19 (Bool) (DeclBlocks -> DeclBlocks) ([String]) (Decls) ([Decl]) ([Identifier]) (Exprs) ([Decl]) ([Type]) (Set String) (Set Identifier) {-# NOINLINE sem_CRule_CRule #-} sem_CRule_CRule :: (Identifier) -> (Bool) -> (Bool) -> (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> (Maybe NontermIdent) -> (Maybe Type) -> T_Pattern -> ([String]) -> (Map Int (Identifier,Identifier,Maybe Type)) -> (Bool) -> (String) -> (Set (Identifier, Identifier)) -> (Bool) -> (Maybe Identifier) -> T_CRule sem_CRule_CRule arg_name_ arg_isIn_ arg_hasCode_ arg_nt_ arg_con_ arg_field_ _ arg_tp_ arg_pattern_ arg_rhs_ arg_defines_ _ arg_origin_ arg_uses_ arg_explicit_ arg_mbNamed_ = T_CRule (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_CRule_v19 v19 = \ (T_CRule_vIn19 _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat) -> ( let _patternX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) (T_Pattern_vOut40 _patternIcopy _patternIdefinedInsts _patternIpatternAttributes) = inv_Pattern_s41 _patternX41 (T_Pattern_vIn40 ) _instTypes = rule308 _lhsIchildren _originComment = rule309 _lhsIo_pretty arg_origin_ _instDecls = rule310 _definedInsts _instTypes _lhsIo_monadic _lhsIo_newtypes _lhsIoptions _lhsIprefix _patDescr = rule311 _patternIpatternAttributes arg_isIn_ _traceDescr = rule312 _patDescr arg_con_ arg_mbNamed_ arg_nt_ _addTrace = rule313 _lhsIo_traces _traceDescr _costCentreDescr = rule314 _patDescr arg_con_ arg_nt_ _addCostCentre = rule315 _costCentreDescr _lhsIo_costcentre _addLinePragma = rule316 _lhsIo_linePragmas arg_name_ _decls = rule317 _addCostCentre _addLinePragma _addTrace _instDecls _lhsIo_monadic _lhsIoptions _originComment _patternIcopy arg_defines_ arg_explicit_ arg_hasCode_ arg_rhs_ arg_uses_ _definedInsts = rule318 _patternIdefinedInsts arg_isIn_ _rulename = rule319 _lhsIoptions _lhsIterminals arg_field_ arg_isIn_ arg_name_ _lhsOexprs :: Exprs _lhsOexprs = rule320 _rulename _lhsOusedVars :: Set String _lhsOusedVars = rule321 _rulename _mkTp = rule322 _lhsInt _orgParams _lhsOtSigs :: [Decl] _lhsOtSigs = rule323 _evalTp _lhsIchildren _lhsIoptions _mkTp arg_defines_ _orgParams = rule324 _lhsInt _lhsIparamMap _evalTp = rule325 _lhsInt _lhsIoptions _lhsIparamInstMap _lhsIparamMap _orgParams _lhsOtps :: [Type] _lhsOallTpsFound :: Bool (_lhsOtps,_lhsOallTpsFound) = rule326 arg_tp_ _lhsOdeclsAbove :: [Decl] _lhsOdeclsAbove = rule327 _decls _lhsIdeclsAbove _lhsObldBlocksFun :: DeclBlocks -> DeclBlocks _lhsObldBlocksFun = rule328 () _lhsOcomments :: [String] _lhsOcomments = rule329 _lhsIwhat arg_defines_ _lhsOdecls :: Decls _lhsOdecls = rule330 _decls _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule331 _definedInsts _lhsOvisitedSet :: Set Identifier _lhsOvisitedSet = rule332 _lhsIvisitedSet __result_ = T_CRule_vOut19 _lhsOallTpsFound _lhsObldBlocksFun _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars _lhsOvisitedSet in __result_ ) in C_CRule_s20 v19 {-# INLINE rule308 #-} {-# LINE 158 "src-ag/GenerateCode.ag" #-} rule308 = \ ((_lhsIchildren) :: [(Identifier,Type,ChildKind)]) -> {-# LINE 158 "src-ag/GenerateCode.ag" #-} [ (n, (t, mb, for)) | (n, NT t _ for, mb) <- _lhsIchildren ] {-# LINE 2250 "dist/build/GenerateCode.hs"#-} {-# INLINE rule309 #-} {-# LINE 159 "src-ag/GenerateCode.ag" #-} rule309 = \ ((_lhsIo_pretty) :: Bool) origin_ -> {-# LINE 159 "src-ag/GenerateCode.ag" #-} if _lhsIo_pretty then (Comment origin_:) else id {-# LINE 2258 "dist/build/GenerateCode.hs"#-} {-# INLINE rule310 #-} {-# LINE 162 "src-ag/GenerateCode.ag" #-} rule310 = \ _definedInsts _instTypes ((_lhsIo_monadic) :: Bool) ((_lhsIo_newtypes) :: Bool) ((_lhsIoptions) :: Options) ((_lhsIprefix) :: String) -> {-# LINE 162 "src-ag/GenerateCode.ag" #-} [ mkDecl _lhsIo_monadic (Pattern3 (Alias _INST' inst (Underscore (getPos inst)))) ( let (nm,mb,defor) = fromJust $ inst `lookup` _instTypes in unwrapSem _lhsIo_newtypes nm $ case mb of ChildReplace _ -> App instLocFieldName [SimpleExpr $ fieldname inst] _ -> if defor then SimpleExpr instLocFieldName else App (cataname _lhsIprefix nm) [SimpleExpr instLocFieldName] ) (Set.singleton instSemFieldName) (Set.singleton instLocFieldName) | inst <- _definedInsts , let instLocFieldName = attrname _lhsIoptions True _INST inst instSemFieldName = attrname _lhsIoptions False _INST' inst ] {-# LINE 2280 "dist/build/GenerateCode.hs"#-} {-# INLINE rule311 #-} {-# LINE 179 "src-ag/GenerateCode.ag" #-} rule311 = \ ((_patternIpatternAttributes) :: [(Identifier, Identifier)]) isIn_ -> {-# LINE 179 "src-ag/GenerateCode.ag" #-} if isIn_ then "_" else concat $ intersperse "," (map (\(f,a) -> show f ++ "." ++ show a) _patternIpatternAttributes) {-# LINE 2288 "dist/build/GenerateCode.hs"#-} {-# INLINE rule312 #-} {-# LINE 182 "src-ag/GenerateCode.ag" #-} rule312 = \ _patDescr con_ mbNamed_ nt_ -> {-# LINE 182 "src-ag/GenerateCode.ag" #-} (maybe "" (\nm -> show nm ++ ":") mbNamed_) ++ show nt_ ++ " :: " ++ show con_ ++ " :: " ++ _patDescr {-# LINE 2294 "dist/build/GenerateCode.hs"#-} {-# INLINE rule313 #-} {-# LINE 184 "src-ag/GenerateCode.ag" #-} rule313 = \ ((_lhsIo_traces) :: Bool) _traceDescr -> {-# LINE 184 "src-ag/GenerateCode.ag" #-} \v -> if _lhsIo_traces then Trace _traceDescr v else v {-# LINE 2302 "dist/build/GenerateCode.hs"#-} {-# INLINE rule314 #-} {-# LINE 187 "src-ag/GenerateCode.ag" #-} rule314 = \ _patDescr con_ nt_ -> {-# LINE 187 "src-ag/GenerateCode.ag" #-} show nt_ ++ ":" ++ show con_ ++ ":" ++ _patDescr {-# LINE 2308 "dist/build/GenerateCode.hs"#-} {-# INLINE rule315 #-} {-# LINE 188 "src-ag/GenerateCode.ag" #-} rule315 = \ _costCentreDescr ((_lhsIo_costcentre) :: Bool) -> {-# LINE 188 "src-ag/GenerateCode.ag" #-} \v -> if _lhsIo_costcentre then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v else v {-# LINE 2316 "dist/build/GenerateCode.hs"#-} {-# INLINE rule316 #-} {-# LINE 191 "src-ag/GenerateCode.ag" #-} rule316 = \ ((_lhsIo_linePragmas) :: Bool) name_ -> {-# LINE 191 "src-ag/GenerateCode.ag" #-} \v -> let p = getPos name_ hasPos = line p > 0 && column p >= 0 && not (null (file p)) in if _lhsIo_linePragmas && hasPos then PragmaExpr True True ("LINE " ++ show (line p) ++ " " ++ show (file p)) $ LineExpr $ v else v {-# LINE 2328 "dist/build/GenerateCode.hs"#-} {-# INLINE rule317 #-} {-# LINE 198 "src-ag/GenerateCode.ag" #-} rule317 = \ _addCostCentre _addLinePragma _addTrace _instDecls ((_lhsIo_monadic) :: Bool) ((_lhsIoptions) :: Options) _originComment ((_patternIcopy) :: Pattern) defines_ explicit_ hasCode_ rhs_ uses_ -> {-# LINE 198 "src-ag/GenerateCode.ag" #-} if hasCode_ then _originComment ( mkDecl (_lhsIo_monadic && explicit_) (Pattern3 _patternIcopy) (_addTrace $ _addCostCentre $ _addLinePragma $ (TextExpr rhs_)) (Set.fromList [attrname _lhsIoptions False fld nm | (fld,nm,_) <- Map.elems defines_]) (Set.fromList [attrname _lhsIoptions True fld nm | (fld,nm) <- Set.toList uses_]) : _instDecls ) else _instDecls {-# LINE 2339 "dist/build/GenerateCode.hs"#-} {-# INLINE rule318 #-} {-# LINE 268 "src-ag/GenerateCode.ag" #-} rule318 = \ ((_patternIdefinedInsts) :: [Identifier]) isIn_ -> {-# LINE 268 "src-ag/GenerateCode.ag" #-} if isIn_ then [] else _patternIdefinedInsts {-# LINE 2345 "dist/build/GenerateCode.hs"#-} {-# INLINE rule319 #-} {-# LINE 338 "src-ag/GenerateCode.ag" #-} rule319 = \ ((_lhsIoptions) :: Options) ((_lhsIterminals) :: [Identifier]) field_ isIn_ name_ -> {-# LINE 338 "src-ag/GenerateCode.ag" #-} if field_ == _LOC && name_ `elem` _lhsIterminals then funname name_ 0 else attrname _lhsIoptions isIn_ field_ name_ {-# LINE 2353 "dist/build/GenerateCode.hs"#-} {-# INLINE rule320 #-} {-# LINE 341 "src-ag/GenerateCode.ag" #-} rule320 = \ _rulename -> {-# LINE 341 "src-ag/GenerateCode.ag" #-} [SimpleExpr _rulename ] {-# LINE 2359 "dist/build/GenerateCode.hs"#-} {-# INLINE rule321 #-} {-# LINE 357 "src-ag/GenerateCode.ag" #-} rule321 = \ _rulename -> {-# LINE 357 "src-ag/GenerateCode.ag" #-} Set.singleton _rulename {-# LINE 2365 "dist/build/GenerateCode.hs"#-} {-# INLINE rule322 #-} {-# LINE 367 "src-ag/GenerateCode.ag" #-} rule322 = \ ((_lhsInt) :: NontermIdent) _orgParams -> {-# LINE 367 "src-ag/GenerateCode.ag" #-} typeToCodeType (Just _lhsInt) _orgParams {-# LINE 2371 "dist/build/GenerateCode.hs"#-} {-# INLINE rule323 #-} {-# LINE 368 "src-ag/GenerateCode.ag" #-} rule323 = \ _evalTp ((_lhsIchildren) :: [(Identifier,Type,ChildKind)]) ((_lhsIoptions) :: Options) _mkTp defines_ -> {-# LINE 368 "src-ag/GenerateCode.ag" #-} [ TSig (attrname _lhsIoptions False field attr) tp' | (field,attr,tp) <- Map.elems defines_, isJust tp , let tp1 = _evalTp field $ _mkTp (fromJust tp) tp' = case findOrigType attr _lhsIchildren of Just tp'' -> let tp2 = _evalTp field $ _mkTp tp'' in Arr tp2 tp1 Nothing -> tp1 findOrigType _ [] = Nothing findOrigType nm ((n,_,kind) : r) | nm == n = case kind of ChildReplace orig -> Just orig _ -> Nothing | otherwise = findOrigType nm r ] {-# LINE 2390 "dist/build/GenerateCode.hs"#-} {-# INLINE rule324 #-} {-# LINE 383 "src-ag/GenerateCode.ag" #-} rule324 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) -> {-# LINE 383 "src-ag/GenerateCode.ag" #-} map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap {-# LINE 2396 "dist/build/GenerateCode.hs"#-} {-# INLINE rule325 #-} {-# LINE 385 "src-ag/GenerateCode.ag" #-} rule325 = \ ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) ((_lhsIparamInstMap) :: Map Identifier (NontermIdent, [String])) ((_lhsIparamMap) :: ParamMap) _orgParams -> {-# LINE 385 "src-ag/GenerateCode.ag" #-} \field tp -> let orgFldParams = map getName $ Map.findWithDefault [] childNt _lhsIparamMap (childNt,instParams) = Map.findWithDefault (_lhsInt,[]) field _lhsIparamInstMap replMap = Map.fromList (zip orgFldParams instParams) replace k = Map.findWithDefault ('@':k) k replMap in if null instParams then if null _orgParams then tp else idEvalType _lhsIoptions tp else evalType _lhsIoptions replace tp {-# LINE 2410 "dist/build/GenerateCode.hs"#-} {-# INLINE rule326 #-} {-# LINE 420 "src-ag/GenerateCode.ag" #-} rule326 = \ tp_ -> {-# LINE 420 "src-ag/GenerateCode.ag" #-} maybe ([],False) (\tp -> ([tp],True)) tp_ {-# LINE 2416 "dist/build/GenerateCode.hs"#-} {-# INLINE rule327 #-} {-# LINE 621 "src-ag/GenerateCode.ag" #-} rule327 = \ _decls ((_lhsIdeclsAbove) :: [Decl]) -> {-# LINE 621 "src-ag/GenerateCode.ag" #-} _lhsIdeclsAbove ++ _decls {-# LINE 2422 "dist/build/GenerateCode.hs"#-} {-# INLINE rule328 #-} {-# LINE 634 "src-ag/GenerateCode.ag" #-} rule328 = \ (_ :: ()) -> {-# LINE 634 "src-ag/GenerateCode.ag" #-} id {-# LINE 2428 "dist/build/GenerateCode.hs"#-} {-# INLINE rule329 #-} {-# LINE 910 "src-ag/GenerateCode.ag" #-} rule329 = \ ((_lhsIwhat) :: String) defines_ -> {-# LINE 910 "src-ag/GenerateCode.ag" #-} [ makeLocalComment 11 _lhsIwhat name tp | (field,name,tp) <- Map.elems defines_, field == _LOC ] ++ [ makeLocalComment 11 "inst " name tp | (field,name,tp) <- Map.elems defines_, field == _INST ] {-# LINE 2435 "dist/build/GenerateCode.hs"#-} {-# INLINE rule330 #-} rule330 = \ _decls -> _decls {-# INLINE rule331 #-} rule331 = \ _definedInsts -> _definedInsts {-# INLINE rule332 #-} rule332 = \ ((_lhsIvisitedSet) :: Set Identifier) -> _lhsIvisitedSet {-# NOINLINE sem_CRule_CChildVisit #-} sem_CRule_CChildVisit :: (Identifier) -> (NontermIdent) -> (Int) -> (Attributes) -> (Attributes) -> (Bool) -> T_CRule sem_CRule_CChildVisit arg_name_ arg_nt_ arg_nr_ arg_inh_ arg_syn_ arg_isLast_ = T_CRule (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_CRule_v19 v19 = \ (T_CRule_vIn19 _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat) -> ( let _visitedSet = rule333 _lhsIvisitedSet arg_name_ _costCentreDescr = rule334 _lhsIcon _lhsInt arg_name_ arg_nr_ arg_nt_ _addCostCentre = rule335 _costCentreDescr _lhsIo_costcentre _decls = rule336 _addCostCentre _lhsIaroundMap _lhsIchildren _lhsImergeMap _lhsIo_monadic _lhsIo_newtypes _lhsIo_unbox _lhsIoptions _visitedSet arg_inh_ arg_isLast_ arg_name_ arg_nr_ arg_nt_ arg_syn_ _isSuperfluousHigherOrderIntra = rule337 _lhsIinstVisitNrs _lhsInr arg_name_ _names = rule338 _isSuperfluousHigherOrderIntra arg_name_ arg_nr_ _lhsOexprs :: Exprs _lhsOexprs = rule339 _instParams _lhsIo_newtypes _lhsIunfoldSemDom _names arg_nr_ arg_nt_ _lhsOusedVars :: Set String _lhsOusedVars = rule340 _names _mkTp = rule341 _evalTp _orgParams arg_nt_ _definedTps = rule342 _lhsIoptions _mkTp arg_name_ arg_syn_ _nextTp = rule343 arg_nr_ arg_nt_ _lhsOtSigs :: [Decl] _lhsOtSigs = rule344 _definedTps _instParams _nextTp arg_isLast_ arg_name_ arg_nr_ _orgParams = rule345 _lhsIparamMap arg_nt_ _instParams = rule346 _lhsIparamInstMap arg_name_ arg_nt_ _replParamMap = rule347 _instParams _orgParams _replace = rule348 _replParamMap _evalTp = rule349 _lhsIoptions _orgParams _replace _lhsOtps :: [Type] _lhsOtps = rule350 _instParams _isSuperfluousHigherOrderIntra arg_nr_ arg_nt_ _lhsOdeclsAbove :: [Decl] _lhsOdeclsAbove = rule351 () _lhsObldBlocksFun :: DeclBlocks -> DeclBlocks _lhsObldBlocksFun = rule352 _decls _lhsIdeclsAbove _lhsOallTpsFound :: Bool _lhsOallTpsFound = rule353 () _lhsOcomments :: [String] _lhsOcomments = rule354 () _lhsOdecls :: Decls _lhsOdecls = rule355 _decls _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule356 () _lhsOvisitedSet :: Set Identifier _lhsOvisitedSet = rule357 _visitedSet __result_ = T_CRule_vOut19 _lhsOallTpsFound _lhsObldBlocksFun _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars _lhsOvisitedSet in __result_ ) in C_CRule_s20 v19 {-# INLINE rule333 #-} {-# LINE 148 "src-ag/GenerateCode.ag" #-} rule333 = \ ((_lhsIvisitedSet) :: Set Identifier) name_ -> {-# LINE 148 "src-ag/GenerateCode.ag" #-} Set.insert name_ _lhsIvisitedSet {-# LINE 2496 "dist/build/GenerateCode.hs"#-} {-# INLINE rule334 #-} {-# LINE 204 "src-ag/GenerateCode.ag" #-} rule334 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) name_ nr_ nt_ -> {-# LINE 204 "src-ag/GenerateCode.ag" #-} show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show name_ ++ ":" ++ show nt_ ++ ":" ++ show nr_ {-# LINE 2502 "dist/build/GenerateCode.hs"#-} {-# INLINE rule335 #-} {-# LINE 205 "src-ag/GenerateCode.ag" #-} rule335 = \ _costCentreDescr ((_lhsIo_costcentre) :: Bool) -> {-# LINE 205 "src-ag/GenerateCode.ag" #-} \v -> if _lhsIo_costcentre then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v else v {-# LINE 2510 "dist/build/GenerateCode.hs"#-} {-# INLINE rule336 #-} {-# LINE 208 "src-ag/GenerateCode.ag" #-} rule336 = \ _addCostCentre ((_lhsIaroundMap) :: Set Identifier) ((_lhsIchildren) :: [(Identifier,Type,ChildKind)]) ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier])) ((_lhsIo_monadic) :: Bool) ((_lhsIo_newtypes) :: Bool) ((_lhsIo_unbox) :: Bool) ((_lhsIoptions) :: Options) _visitedSet inh_ isLast_ name_ nr_ nt_ syn_ -> {-# LINE 208 "src-ag/GenerateCode.ag" #-} let lhsVars = map (attrname _lhsIoptions True name_) (Map.keys syn_) ++ if isLast_ then [] else [unwrap ++ funname name_ (nr_+1)] rhsVars = map (attrname _lhsIoptions False name_) (Map.keys inh_) unwrap = if _lhsIo_newtypes then typeName nt_ (nr_ + 1) ++ " " else "" tuple | isMerging = TupleLhs [locname _lhsIoptions name_ ++ "_comp"] | otherwise = mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars rhs = _addCostCentre $ Code.InvokeExpr (typeName nt_ nr_) (SimpleExpr fun) (map SimpleExpr rhsVars) isVirtual _ [] = False isVirtual nm ((n,_,kind) : r) | nm == n = case kind of ChildAttr -> True _ -> False | otherwise = isVirtual nm r isMerged = name_ `Map.member` _lhsImergeMap isMerging = name_ `elem` concatMap (\(_,cs) -> cs) (Map.elems _lhsImergeMap) merges = [ (c,cs) | (c,(_,cs)) <- Map.assocs _lhsImergeMap, all (`Set.member` _visitedSet ) cs, name_ `elem` (c:cs) ] baseNm = if nr_ == 0 && isVirtual name_ _lhsIchildren then Ident (getName name_ ++ "_inst") (getPos name_) else name_ fun | nr_ == 0 && Set.member name_ _lhsIaroundMap = locname _lhsIoptions name_ ++ "_around " ++ funname baseNm 0 | otherwise = funname baseNm nr_ outDecls | isMerged = [] | otherwise = if isMerging then [mkDecl _lhsIo_monadic tuple rhs Set.empty Set.empty] else [Resume _lhsIo_monadic (typeName nt_ nr_) tuple rhs] outMerged | null merges || nr_ /= 0 = [] | otherwise = let (c,cs) = head merges tuple' = mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars' lhsVars' = map (attrname _lhsIoptions True c) (Map.keys syn_) ++ if isLast_ then [] else [unwrap ++ funname c (nr_+1)] rhsVars' = [ locname _lhsIoptions c' ++ "_comp" | c' <- cs ] fun' = locname _lhsIoptions c ++ "_merge" rhs' = App fun' (map SimpleExpr rhsVars') in [Resume _lhsIo_monadic (typeName nt_ nr_) tuple' rhs'] in (outDecls ++ outMerged) {-# LINE 2553 "dist/build/GenerateCode.hs"#-} {-# INLINE rule337 #-} {-# LINE 330 "src-ag/GenerateCode.ag" #-} rule337 = \ ((_lhsIinstVisitNrs) :: Map Identifier Int) ((_lhsInr) :: Int) name_ -> {-# LINE 330 "src-ag/GenerateCode.ag" #-} _lhsInr <= Map.findWithDefault (-1) name_ _lhsIinstVisitNrs {-# LINE 2559 "dist/build/GenerateCode.hs"#-} {-# INLINE rule338 #-} {-# LINE 343 "src-ag/GenerateCode.ag" #-} rule338 = \ _isSuperfluousHigherOrderIntra name_ nr_ -> {-# LINE 343 "src-ag/GenerateCode.ag" #-} if _isSuperfluousHigherOrderIntra then [] else [funname name_ (nr_+1)] {-# LINE 2567 "dist/build/GenerateCode.hs"#-} {-# INLINE rule339 #-} {-# LINE 347 "src-ag/GenerateCode.ag" #-} rule339 = \ _instParams ((_lhsIo_newtypes) :: Bool) ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) _names nr_ nt_ -> {-# LINE 347 "src-ag/GenerateCode.ag" #-} let wrap = if _lhsIo_newtypes then \x -> App (typeName nt_ (nr_ + 1)) [x] else id addType expr | null _instParams = expr | otherwise = TypedExpr expr (_lhsIunfoldSemDom nt_ (nr_+1) _instParams ) in map (wrap . addType . SimpleExpr) _names {-# LINE 2576 "dist/build/GenerateCode.hs"#-} {-# INLINE rule340 #-} {-# LINE 359 "src-ag/GenerateCode.ag" #-} rule340 = \ _names -> {-# LINE 359 "src-ag/GenerateCode.ag" #-} Set.fromList _names {-# LINE 2582 "dist/build/GenerateCode.hs"#-} {-# INLINE rule341 #-} {-# LINE 395 "src-ag/GenerateCode.ag" #-} rule341 = \ _evalTp _orgParams nt_ -> {-# LINE 395 "src-ag/GenerateCode.ag" #-} _evalTp . typeToCodeType (Just nt_) _orgParams {-# LINE 2588 "dist/build/GenerateCode.hs"#-} {-# INLINE rule342 #-} {-# LINE 396 "src-ag/GenerateCode.ag" #-} rule342 = \ ((_lhsIoptions) :: Options) _mkTp name_ syn_ -> {-# LINE 396 "src-ag/GenerateCode.ag" #-} [ TSig (attrname _lhsIoptions True name_ a) (_mkTp tp) | (a,tp) <- Map.toList syn_ ] {-# LINE 2594 "dist/build/GenerateCode.hs"#-} {-# INLINE rule343 #-} {-# LINE 397 "src-ag/GenerateCode.ag" #-} rule343 = \ nr_ nt_ -> {-# LINE 397 "src-ag/GenerateCode.ag" #-} typeName nt_ (nr_+1) {-# LINE 2600 "dist/build/GenerateCode.hs"#-} {-# INLINE rule344 #-} {-# LINE 398 "src-ag/GenerateCode.ag" #-} rule344 = \ _definedTps _instParams _nextTp isLast_ name_ nr_ -> {-# LINE 398 "src-ag/GenerateCode.ag" #-} (if isLast_ then id else (TSig (funname name_ (nr_+1)) (TypeApp (SimpleType _nextTp) (map SimpleType _instParams )) :)) _definedTps {-# LINE 2606 "dist/build/GenerateCode.hs"#-} {-# INLINE rule345 #-} {-# LINE 400 "src-ag/GenerateCode.ag" #-} rule345 = \ ((_lhsIparamMap) :: ParamMap) nt_ -> {-# LINE 400 "src-ag/GenerateCode.ag" #-} map getName $ Map.findWithDefault [] nt_ _lhsIparamMap {-# LINE 2612 "dist/build/GenerateCode.hs"#-} {-# INLINE rule346 #-} {-# LINE 401 "src-ag/GenerateCode.ag" #-} rule346 = \ ((_lhsIparamInstMap) :: Map Identifier (NontermIdent, [String])) name_ nt_ -> {-# LINE 401 "src-ag/GenerateCode.ag" #-} snd $ Map.findWithDefault (nt_,[]) name_ _lhsIparamInstMap {-# LINE 2618 "dist/build/GenerateCode.hs"#-} {-# INLINE rule347 #-} {-# LINE 402 "src-ag/GenerateCode.ag" #-} rule347 = \ _instParams _orgParams -> {-# LINE 402 "src-ag/GenerateCode.ag" #-} Map.fromList (zip _orgParams _instParams ) {-# LINE 2624 "dist/build/GenerateCode.hs"#-} {-# INLINE rule348 #-} {-# LINE 403 "src-ag/GenerateCode.ag" #-} rule348 = \ _replParamMap -> {-# LINE 403 "src-ag/GenerateCode.ag" #-} \k -> Map.findWithDefault k k _replParamMap {-# LINE 2630 "dist/build/GenerateCode.hs"#-} {-# INLINE rule349 #-} {-# LINE 404 "src-ag/GenerateCode.ag" #-} rule349 = \ ((_lhsIoptions) :: Options) _orgParams _replace -> {-# LINE 404 "src-ag/GenerateCode.ag" #-} if null _orgParams then id else evalType _lhsIoptions _replace {-# LINE 2636 "dist/build/GenerateCode.hs"#-} {-# INLINE rule350 #-} {-# LINE 421 "src-ag/GenerateCode.ag" #-} rule350 = \ _instParams _isSuperfluousHigherOrderIntra nr_ nt_ -> {-# LINE 421 "src-ag/GenerateCode.ag" #-} if _isSuperfluousHigherOrderIntra then [] else [NT (ntOfVisit nt_ (nr_+1)) _instParams False] {-# LINE 2644 "dist/build/GenerateCode.hs"#-} {-# INLINE rule351 #-} {-# LINE 623 "src-ag/GenerateCode.ag" #-} rule351 = \ (_ :: ()) -> {-# LINE 623 "src-ag/GenerateCode.ag" #-} [] {-# LINE 2650 "dist/build/GenerateCode.hs"#-} {-# INLINE rule352 #-} {-# LINE 636 "src-ag/GenerateCode.ag" #-} rule352 = \ _decls ((_lhsIdeclsAbove) :: [Decl]) -> {-# LINE 636 "src-ag/GenerateCode.ag" #-} DeclBlock _lhsIdeclsAbove (head _decls ) {-# LINE 2656 "dist/build/GenerateCode.hs"#-} {-# INLINE rule353 #-} rule353 = \ (_ :: ()) -> True {-# INLINE rule354 #-} rule354 = \ (_ :: ()) -> [] {-# INLINE rule355 #-} rule355 = \ _decls -> _decls {-# INLINE rule356 #-} rule356 = \ (_ :: ()) -> [] {-# INLINE rule357 #-} rule357 = \ _visitedSet -> _visitedSet -- CSegment ---------------------------------------------------- -- wrapper data Inh_CSegment = Inh_CSegment { inh_Inh_CSegment :: (Attributes), isLast_Inh_CSegment :: (Bool), nr_Inh_CSegment :: (Int), nt_Inh_CSegment :: (NontermIdent), o_case_Inh_CSegment :: (Bool), o_cata_Inh_CSegment :: (Bool), o_clean_Inh_CSegment :: (Bool), o_costcentre_Inh_CSegment :: (Bool), o_data_Inh_CSegment :: (Maybe Bool), o_linePragmas_Inh_CSegment :: (Bool), o_monadic_Inh_CSegment :: (Bool), o_newtypes_Inh_CSegment :: (Bool), o_pretty_Inh_CSegment :: (Bool), o_rename_Inh_CSegment :: (Bool), o_sem_Inh_CSegment :: (Bool), o_sig_Inh_CSegment :: (Bool), o_splitsems_Inh_CSegment :: (Bool), o_strictwrap_Inh_CSegment :: (Bool), o_traces_Inh_CSegment :: (Bool), o_unbox_Inh_CSegment :: (Bool), options_Inh_CSegment :: (Options), paramMap_Inh_CSegment :: (ParamMap), prefix_Inh_CSegment :: (String), syn_Inh_CSegment :: (Attributes) } data Syn_CSegment = Syn_CSegment { comments_Syn_CSegment :: ([String]), semDom_Syn_CSegment :: ([Decl]), semDomUnfoldGath_Syn_CSegment :: (Map (NontermIdent, Int) ([String], Code.Type)), wrapDecls_Syn_CSegment :: (Decls) } {-# INLINABLE wrap_CSegment #-} wrap_CSegment :: T_CSegment -> Inh_CSegment -> (Syn_CSegment ) wrap_CSegment (T_CSegment act) (Inh_CSegment _lhsIinh _lhsIisLast _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn) = Control.Monad.Identity.runIdentity ( do sem <- act let arg22 = T_CSegment_vIn22 _lhsIinh _lhsIisLast _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn (T_CSegment_vOut22 _lhsOcomments _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls) <- return (inv_CSegment_s23 sem arg22) return (Syn_CSegment _lhsOcomments _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls) ) -- cata {-# INLINE sem_CSegment #-} sem_CSegment :: CSegment -> T_CSegment sem_CSegment ( CSegment inh_ syn_ ) = sem_CSegment_CSegment inh_ syn_ -- semantic domain newtype T_CSegment = T_CSegment { attach_T_CSegment :: Identity (T_CSegment_s23 ) } newtype T_CSegment_s23 = C_CSegment_s23 { inv_CSegment_s23 :: (T_CSegment_v22 ) } data T_CSegment_s24 = C_CSegment_s24 type T_CSegment_v22 = (T_CSegment_vIn22 ) -> (T_CSegment_vOut22 ) data T_CSegment_vIn22 = T_CSegment_vIn22 (Attributes) (Bool) (Int) (NontermIdent) (Bool) (Bool) (Bool) (Bool) (Maybe Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (ParamMap) (String) (Attributes) data T_CSegment_vOut22 = T_CSegment_vOut22 ([String]) ([Decl]) (Map (NontermIdent, Int) ([String], Code.Type)) (Decls) {-# NOINLINE sem_CSegment_CSegment #-} sem_CSegment_CSegment :: (Attributes) -> (Attributes) -> T_CSegment sem_CSegment_CSegment arg_inh_ arg_syn_ = T_CSegment (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_CSegment_v22 v22 = \ (T_CSegment_vIn22 _lhsIinh _lhsIisLast _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn) -> ( let _altSemForm = rule358 _lhsIoptions _tp = rule359 _altSemForm _indexExpr _inhTps _synTps _inhTps = rule360 _lhsInt _params arg_inh_ _inhTup = rule361 _inhTps _lhsIo_unbox _synTps = rule362 _continuation _inhTps _lhsInt _lhsIo_unbox _params arg_syn_ _curTypeName = rule363 _lhsInr _lhsInt _nextTypeName = rule364 _lhsInr _lhsInt _indexName = rule365 _curTypeName _dataIndex = rule366 _indexName _params _indexExpr = rule367 _indexName _params _indexStr = rule368 _indexName _params _inhInstance = rule369 _indexStr _inhTup _lhsInr _lhsInt _synInstance = rule370 _indexStr _lhsInr _lhsInt _synTps _continuation = rule371 _lhsIisLast _nextTypeName _params _params = rule372 _lhsInt _lhsIparamMap _lhsOsemDom :: [Decl] _lhsOsemDom = rule373 _altSemForm _dataIndex _inhInstance _lhsInr _lhsInt _lhsIo_newtypes _lhsIoptions _params _synInstance _tp _lhsOsemDomUnfoldGath :: Map (NontermIdent, Int) ([String], Code.Type) _lhsOsemDomUnfoldGath = rule374 _lhsInr _lhsInt _params _tp _lhsOwrapDecls :: Decls _lhsOwrapDecls = rule375 _lhsIisLast _lhsInr _lhsInt _lhsIo_newtypes _lhsIo_unbox _lhsIoptions arg_inh_ arg_syn_ _lhsOcomments :: [String] _lhsOcomments = rule376 _lhsInr arg_inh_ arg_syn_ __result_ = T_CSegment_vOut22 _lhsOcomments _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls in __result_ ) in C_CSegment_s23 v22 {-# INLINE rule358 #-} {-# LINE 720 "src-ag/GenerateCode.ag" #-} rule358 = \ ((_lhsIoptions) :: Options) -> {-# LINE 720 "src-ag/GenerateCode.ag" #-} breadthFirst _lhsIoptions {-# LINE 2741 "dist/build/GenerateCode.hs"#-} {-# INLINE rule359 #-} {-# LINE 721 "src-ag/GenerateCode.ag" #-} rule359 = \ _altSemForm _indexExpr _inhTps _synTps -> {-# LINE 721 "src-ag/GenerateCode.ag" #-} if _altSemForm then TypeApp (SimpleType "Child") [SimpleType "EvalInfo", _indexExpr ] else foldr Arr _synTps _inhTps {-# LINE 2749 "dist/build/GenerateCode.hs"#-} {-# INLINE rule360 #-} {-# LINE 724 "src-ag/GenerateCode.ag" #-} rule360 = \ ((_lhsInt) :: NontermIdent) _params inh_ -> {-# LINE 724 "src-ag/GenerateCode.ag" #-} [typeToCodeType (Just _lhsInt) _params tp | tp <- Map.elems inh_] {-# LINE 2755 "dist/build/GenerateCode.hs"#-} {-# INLINE rule361 #-} {-# LINE 725 "src-ag/GenerateCode.ag" #-} rule361 = \ _inhTps ((_lhsIo_unbox) :: Bool) -> {-# LINE 725 "src-ag/GenerateCode.ag" #-} mkTupleType _lhsIo_unbox (null _inhTps ) _inhTps {-# LINE 2761 "dist/build/GenerateCode.hs"#-} {-# INLINE rule362 #-} {-# LINE 726 "src-ag/GenerateCode.ag" #-} rule362 = \ _continuation _inhTps ((_lhsInt) :: NontermIdent) ((_lhsIo_unbox) :: Bool) _params syn_ -> {-# LINE 726 "src-ag/GenerateCode.ag" #-} mkTupleType _lhsIo_unbox (null _inhTps ) ([typeToCodeType (Just _lhsInt) _params tp | tp <- Map.elems syn_] ++ _continuation ) {-# LINE 2767 "dist/build/GenerateCode.hs"#-} {-# INLINE rule363 #-} {-# LINE 727 "src-ag/GenerateCode.ag" #-} rule363 = \ ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) -> {-# LINE 727 "src-ag/GenerateCode.ag" #-} typeName _lhsInt _lhsInr {-# LINE 2773 "dist/build/GenerateCode.hs"#-} {-# INLINE rule364 #-} {-# LINE 728 "src-ag/GenerateCode.ag" #-} rule364 = \ ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) -> {-# LINE 728 "src-ag/GenerateCode.ag" #-} typeName _lhsInt (_lhsInr + 1) {-# LINE 2779 "dist/build/GenerateCode.hs"#-} {-# INLINE rule365 #-} {-# LINE 729 "src-ag/GenerateCode.ag" #-} rule365 = \ _curTypeName -> {-# LINE 729 "src-ag/GenerateCode.ag" #-} "I_" ++ _curTypeName {-# LINE 2785 "dist/build/GenerateCode.hs"#-} {-# INLINE rule366 #-} {-# LINE 730 "src-ag/GenerateCode.ag" #-} rule366 = \ _indexName _params -> {-# LINE 730 "src-ag/GenerateCode.ag" #-} Code.Data _indexName _params [DataAlt _indexName []] False [] {-# LINE 2791 "dist/build/GenerateCode.hs"#-} {-# INLINE rule367 #-} {-# LINE 731 "src-ag/GenerateCode.ag" #-} rule367 = \ _indexName _params -> {-# LINE 731 "src-ag/GenerateCode.ag" #-} TypeApp (SimpleType _indexName ) (map (SimpleType . ('@':)) _params ) {-# LINE 2797 "dist/build/GenerateCode.hs"#-} {-# INLINE rule368 #-} {-# LINE 732 "src-ag/GenerateCode.ag" #-} rule368 = \ _indexName _params -> {-# LINE 732 "src-ag/GenerateCode.ag" #-} "(" ++ _indexName ++ concatMap (\p -> " " ++ p) _params ++ ")" {-# LINE 2803 "dist/build/GenerateCode.hs"#-} {-# INLINE rule369 #-} {-# LINE 733 "src-ag/GenerateCode.ag" #-} rule369 = \ _indexStr _inhTup ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) -> {-# LINE 733 "src-ag/GenerateCode.ag" #-} Code.Data "instance Inh" [_indexStr ] [DataAlt (typeName _lhsInt _lhsInr ++ "_Inh") [_inhTup ] ] False [] {-# LINE 2809 "dist/build/GenerateCode.hs"#-} {-# INLINE rule370 #-} {-# LINE 734 "src-ag/GenerateCode.ag" #-} rule370 = \ _indexStr ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) _synTps -> {-# LINE 734 "src-ag/GenerateCode.ag" #-} Code.Data "instance Syn" [_indexStr ] [DataAlt (typeName _lhsInt _lhsInr ++ "_Syn") [_synTps ] ] False [] {-# LINE 2815 "dist/build/GenerateCode.hs"#-} {-# INLINE rule371 #-} {-# LINE 735 "src-ag/GenerateCode.ag" #-} rule371 = \ ((_lhsIisLast) :: Bool) _nextTypeName _params -> {-# LINE 735 "src-ag/GenerateCode.ag" #-} if _lhsIisLast then [] else [TypeApp (SimpleType _nextTypeName ) (map (SimpleType . ('@':)) _params )] {-# LINE 2823 "dist/build/GenerateCode.hs"#-} {-# INLINE rule372 #-} {-# LINE 738 "src-ag/GenerateCode.ag" #-} rule372 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) -> {-# LINE 738 "src-ag/GenerateCode.ag" #-} map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap {-# LINE 2829 "dist/build/GenerateCode.hs"#-} {-# INLINE rule373 #-} {-# LINE 739 "src-ag/GenerateCode.ag" #-} rule373 = \ _altSemForm _dataIndex _inhInstance ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIo_newtypes) :: Bool) ((_lhsIoptions) :: Options) _params _synInstance _tp -> {-# LINE 739 "src-ag/GenerateCode.ag" #-} let name = typeName _lhsInt _lhsInr evalTp | null _params = id | otherwise = idEvalType _lhsIoptions in ( if _lhsIo_newtypes then [ Code.NewType name _params name (evalTp _tp ) ] else [ Code.Type name _params (evalTp _tp ) ] ) ++ ( if _altSemForm then [_dataIndex , _inhInstance , _synInstance ] else [] ) {-# LINE 2843 "dist/build/GenerateCode.hs"#-} {-# INLINE rule374 #-} {-# LINE 753 "src-ag/GenerateCode.ag" #-} rule374 = \ ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) _params _tp -> {-# LINE 753 "src-ag/GenerateCode.ag" #-} Map.singleton (_lhsInt, _lhsInr) (_params , _tp ) {-# LINE 2849 "dist/build/GenerateCode.hs"#-} {-# INLINE rule375 #-} {-# LINE 838 "src-ag/GenerateCode.ag" #-} rule375 = \ ((_lhsIisLast) :: Bool) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIo_newtypes) :: Bool) ((_lhsIo_unbox) :: Bool) ((_lhsIoptions) :: Options) inh_ syn_ -> {-# LINE 838 "src-ag/GenerateCode.ag" #-} let lhsVars = map (lhsname _lhsIoptions False) (Map.keys syn_) ++ if _lhsIisLast then [] else [unwrap ++ sem (_lhsInr+1)] rhsVars = map (lhsname _lhsIoptions True) (Map.keys inh_) rhs = map SimpleExpr rhsVars unwrap = if _lhsIo_newtypes then typeName _lhsInt (_lhsInr + 1) ++ " " else "" var = "sem" sem 0 = var sem n = var ++ "_" ++ show n ntt = typeName _lhsInt _lhsInr in [ EvalDecl ntt (mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars) (InvokeExpr ntt (SimpleExpr $ sem _lhsInr) rhs) ] {-# LINE 2864 "dist/build/GenerateCode.hs"#-} {-# INLINE rule376 #-} {-# LINE 880 "src-ag/GenerateCode.ag" #-} rule376 = \ ((_lhsInr) :: Int) inh_ syn_ -> {-# LINE 880 "src-ag/GenerateCode.ag" #-} let body = map ind (showsSegment (CSegment inh_ syn_)) in if null body then [] else ("visit " ++ show _lhsInr ++ ":") : body {-# LINE 2873 "dist/build/GenerateCode.hs"#-} -- CSegments --------------------------------------------------- -- wrapper data Inh_CSegments = Inh_CSegments { inh_Inh_CSegments :: (Attributes), nr_Inh_CSegments :: (Int), nt_Inh_CSegments :: (NontermIdent), o_case_Inh_CSegments :: (Bool), o_cata_Inh_CSegments :: (Bool), o_clean_Inh_CSegments :: (Bool), o_costcentre_Inh_CSegments :: (Bool), o_data_Inh_CSegments :: (Maybe Bool), o_linePragmas_Inh_CSegments :: (Bool), o_monadic_Inh_CSegments :: (Bool), o_newtypes_Inh_CSegments :: (Bool), o_pretty_Inh_CSegments :: (Bool), o_rename_Inh_CSegments :: (Bool), o_sem_Inh_CSegments :: (Bool), o_sig_Inh_CSegments :: (Bool), o_splitsems_Inh_CSegments :: (Bool), o_strictwrap_Inh_CSegments :: (Bool), o_traces_Inh_CSegments :: (Bool), o_unbox_Inh_CSegments :: (Bool), options_Inh_CSegments :: (Options), paramMap_Inh_CSegments :: (ParamMap), prefix_Inh_CSegments :: (String), syn_Inh_CSegments :: (Attributes) } data Syn_CSegments = Syn_CSegments { comments_Syn_CSegments :: ([String]), isNil_Syn_CSegments :: (Bool), semDom_Syn_CSegments :: ([Decl]), semDomUnfoldGath_Syn_CSegments :: (Map (NontermIdent, Int) ([String], Code.Type)), wrapDecls_Syn_CSegments :: (Decls) } {-# INLINABLE wrap_CSegments #-} wrap_CSegments :: T_CSegments -> Inh_CSegments -> (Syn_CSegments ) wrap_CSegments (T_CSegments act) (Inh_CSegments _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn) = Control.Monad.Identity.runIdentity ( do sem <- act let arg25 = T_CSegments_vIn25 _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn (T_CSegments_vOut25 _lhsOcomments _lhsOisNil _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls) <- return (inv_CSegments_s26 sem arg25) return (Syn_CSegments _lhsOcomments _lhsOisNil _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls) ) -- cata {-# NOINLINE sem_CSegments #-} sem_CSegments :: CSegments -> T_CSegments sem_CSegments list = Prelude.foldr sem_CSegments_Cons sem_CSegments_Nil (Prelude.map sem_CSegment list) -- semantic domain newtype T_CSegments = T_CSegments { attach_T_CSegments :: Identity (T_CSegments_s26 ) } newtype T_CSegments_s26 = C_CSegments_s26 { inv_CSegments_s26 :: (T_CSegments_v25 ) } data T_CSegments_s27 = C_CSegments_s27 type T_CSegments_v25 = (T_CSegments_vIn25 ) -> (T_CSegments_vOut25 ) data T_CSegments_vIn25 = T_CSegments_vIn25 (Attributes) (Int) (NontermIdent) (Bool) (Bool) (Bool) (Bool) (Maybe Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (ParamMap) (String) (Attributes) data T_CSegments_vOut25 = T_CSegments_vOut25 ([String]) (Bool) ([Decl]) (Map (NontermIdent, Int) ([String], Code.Type)) (Decls) {-# NOINLINE sem_CSegments_Cons #-} sem_CSegments_Cons :: T_CSegment -> T_CSegments -> T_CSegments sem_CSegments_Cons arg_hd_ arg_tl_ = T_CSegments (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_CSegments_v25 v25 = \ (T_CSegments_vIn25 _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn) -> ( let _hdX23 = Control.Monad.Identity.runIdentity (attach_T_CSegment (arg_hd_)) _tlX26 = Control.Monad.Identity.runIdentity (attach_T_CSegments (arg_tl_)) (T_CSegment_vOut22 _hdIcomments _hdIsemDom _hdIsemDomUnfoldGath _hdIwrapDecls) = inv_CSegment_s23 _hdX23 (T_CSegment_vIn22 _hdOinh _hdOisLast _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_clean _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_monadic _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOoptions _hdOparamMap _hdOprefix _hdOsyn) (T_CSegments_vOut25 _tlIcomments _tlIisNil _tlIsemDom _tlIsemDomUnfoldGath _tlIwrapDecls) = inv_CSegments_s26 _tlX26 (T_CSegments_vIn25 _tlOinh _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_clean _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_monadic _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOoptions _tlOparamMap _tlOprefix _tlOsyn) _tlOnr = rule377 _lhsInr _lhsOisNil :: Bool _lhsOisNil = rule378 () _hdOisLast = rule379 _tlIisNil _lhsOcomments :: [String] _lhsOcomments = rule380 _hdIcomments _tlIcomments _lhsOsemDom :: [Decl] _lhsOsemDom = rule381 _hdIsemDom _tlIsemDom _lhsOsemDomUnfoldGath :: Map (NontermIdent, Int) ([String], Code.Type) _lhsOsemDomUnfoldGath = rule382 _hdIsemDomUnfoldGath _tlIsemDomUnfoldGath _lhsOwrapDecls :: Decls _lhsOwrapDecls = rule383 _hdIwrapDecls _tlIwrapDecls _hdOinh = rule384 _lhsIinh _hdOnr = rule385 _lhsInr _hdOnt = rule386 _lhsInt _hdOo_case = rule387 _lhsIo_case _hdOo_cata = rule388 _lhsIo_cata _hdOo_clean = rule389 _lhsIo_clean _hdOo_costcentre = rule390 _lhsIo_costcentre _hdOo_data = rule391 _lhsIo_data _hdOo_linePragmas = rule392 _lhsIo_linePragmas _hdOo_monadic = rule393 _lhsIo_monadic _hdOo_newtypes = rule394 _lhsIo_newtypes _hdOo_pretty = rule395 _lhsIo_pretty _hdOo_rename = rule396 _lhsIo_rename _hdOo_sem = rule397 _lhsIo_sem _hdOo_sig = rule398 _lhsIo_sig _hdOo_splitsems = rule399 _lhsIo_splitsems _hdOo_strictwrap = rule400 _lhsIo_strictwrap _hdOo_traces = rule401 _lhsIo_traces _hdOo_unbox = rule402 _lhsIo_unbox _hdOoptions = rule403 _lhsIoptions _hdOparamMap = rule404 _lhsIparamMap _hdOprefix = rule405 _lhsIprefix _hdOsyn = rule406 _lhsIsyn _tlOinh = rule407 _lhsIinh _tlOnt = rule408 _lhsInt _tlOo_case = rule409 _lhsIo_case _tlOo_cata = rule410 _lhsIo_cata _tlOo_clean = rule411 _lhsIo_clean _tlOo_costcentre = rule412 _lhsIo_costcentre _tlOo_data = rule413 _lhsIo_data _tlOo_linePragmas = rule414 _lhsIo_linePragmas _tlOo_monadic = rule415 _lhsIo_monadic _tlOo_newtypes = rule416 _lhsIo_newtypes _tlOo_pretty = rule417 _lhsIo_pretty _tlOo_rename = rule418 _lhsIo_rename _tlOo_sem = rule419 _lhsIo_sem _tlOo_sig = rule420 _lhsIo_sig _tlOo_splitsems = rule421 _lhsIo_splitsems _tlOo_strictwrap = rule422 _lhsIo_strictwrap _tlOo_traces = rule423 _lhsIo_traces _tlOo_unbox = rule424 _lhsIo_unbox _tlOoptions = rule425 _lhsIoptions _tlOparamMap = rule426 _lhsIparamMap _tlOprefix = rule427 _lhsIprefix _tlOsyn = rule428 _lhsIsyn __result_ = T_CSegments_vOut25 _lhsOcomments _lhsOisNil _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls in __result_ ) in C_CSegments_s26 v25 {-# INLINE rule377 #-} {-# LINE 288 "src-ag/GenerateCode.ag" #-} rule377 = \ ((_lhsInr) :: Int) -> {-# LINE 288 "src-ag/GenerateCode.ag" #-} _lhsInr + 1 {-# LINE 2981 "dist/build/GenerateCode.hs"#-} {-# INLINE rule378 #-} {-# LINE 301 "src-ag/GenerateCode.ag" #-} rule378 = \ (_ :: ()) -> {-# LINE 301 "src-ag/GenerateCode.ag" #-} False {-# LINE 2987 "dist/build/GenerateCode.hs"#-} {-# INLINE rule379 #-} {-# LINE 302 "src-ag/GenerateCode.ag" #-} rule379 = \ ((_tlIisNil) :: Bool) -> {-# LINE 302 "src-ag/GenerateCode.ag" #-} _tlIisNil {-# LINE 2993 "dist/build/GenerateCode.hs"#-} {-# INLINE rule380 #-} rule380 = \ ((_hdIcomments) :: [String]) ((_tlIcomments) :: [String]) -> _hdIcomments ++ _tlIcomments {-# INLINE rule381 #-} rule381 = \ ((_hdIsemDom) :: [Decl]) ((_tlIsemDom) :: [Decl]) -> _hdIsemDom ++ _tlIsemDom {-# INLINE rule382 #-} rule382 = \ ((_hdIsemDomUnfoldGath) :: Map (NontermIdent, Int) ([String], Code.Type)) ((_tlIsemDomUnfoldGath) :: Map (NontermIdent, Int) ([String], Code.Type)) -> _hdIsemDomUnfoldGath `Map.union` _tlIsemDomUnfoldGath {-# INLINE rule383 #-} rule383 = \ ((_hdIwrapDecls) :: Decls) ((_tlIwrapDecls) :: Decls) -> _hdIwrapDecls ++ _tlIwrapDecls {-# INLINE rule384 #-} rule384 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule385 #-} rule385 = \ ((_lhsInr) :: Int) -> _lhsInr {-# INLINE rule386 #-} rule386 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule387 #-} rule387 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule388 #-} rule388 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule389 #-} rule389 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule390 #-} rule390 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule391 #-} rule391 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule392 #-} rule392 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule393 #-} rule393 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule394 #-} rule394 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule395 #-} rule395 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule396 #-} rule396 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule397 #-} rule397 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule398 #-} rule398 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule399 #-} rule399 = \ ((_lhsIo_splitsems) :: Bool) -> _lhsIo_splitsems {-# INLINE rule400 #-} rule400 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule401 #-} rule401 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule402 #-} rule402 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule403 #-} rule403 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule404 #-} rule404 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule405 #-} rule405 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule406 #-} rule406 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule407 #-} rule407 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule408 #-} rule408 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule409 #-} rule409 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule410 #-} rule410 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule411 #-} rule411 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule412 #-} rule412 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule413 #-} rule413 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule414 #-} rule414 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule415 #-} rule415 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule416 #-} rule416 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule417 #-} rule417 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule418 #-} rule418 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule419 #-} rule419 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule420 #-} rule420 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule421 #-} rule421 = \ ((_lhsIo_splitsems) :: Bool) -> _lhsIo_splitsems {-# INLINE rule422 #-} rule422 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule423 #-} rule423 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule424 #-} rule424 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule425 #-} rule425 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule426 #-} rule426 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule427 #-} rule427 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule428 #-} rule428 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# NOINLINE sem_CSegments_Nil #-} sem_CSegments_Nil :: T_CSegments sem_CSegments_Nil = T_CSegments (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_CSegments_v25 v25 = \ (T_CSegments_vIn25 _lhsIinh _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamMap _lhsIprefix _lhsIsyn) -> ( let _lhsOisNil :: Bool _lhsOisNil = rule429 () _lhsOcomments :: [String] _lhsOcomments = rule430 () _lhsOsemDom :: [Decl] _lhsOsemDom = rule431 () _lhsOsemDomUnfoldGath :: Map (NontermIdent, Int) ([String], Code.Type) _lhsOsemDomUnfoldGath = rule432 () _lhsOwrapDecls :: Decls _lhsOwrapDecls = rule433 () __result_ = T_CSegments_vOut25 _lhsOcomments _lhsOisNil _lhsOsemDom _lhsOsemDomUnfoldGath _lhsOwrapDecls in __result_ ) in C_CSegments_s26 v25 {-# INLINE rule429 #-} {-# LINE 303 "src-ag/GenerateCode.ag" #-} rule429 = \ (_ :: ()) -> {-# LINE 303 "src-ag/GenerateCode.ag" #-} True {-# LINE 3166 "dist/build/GenerateCode.hs"#-} {-# INLINE rule430 #-} rule430 = \ (_ :: ()) -> [] {-# INLINE rule431 #-} rule431 = \ (_ :: ()) -> [] {-# INLINE rule432 #-} rule432 = \ (_ :: ()) -> Map.empty {-# INLINE rule433 #-} rule433 = \ (_ :: ()) -> [] -- CVisit ------------------------------------------------------ -- wrapper data Inh_CVisit = Inh_CVisit { allNts_Inh_CVisit :: (Set NontermIdent), allPragmas_Inh_CVisit :: (PragmaMap), aroundMap_Inh_CVisit :: (Set Identifier), children_Inh_CVisit :: ([(Identifier,Type, ChildKind)]), con_Inh_CVisit :: (ConstructorIdent), contextMap_Inh_CVisit :: (ContextMap), decls_Inh_CVisit :: (Decls), inh_Inh_CVisit :: (Attributes), instVisitNrs_Inh_CVisit :: (Map Identifier Int), isLast_Inh_CVisit :: (Bool), mergeMap_Inh_CVisit :: (Map Identifier (Identifier, [Identifier])), nextIntra_Inh_CVisit :: (Exprs), nextIntraVars_Inh_CVisit :: (Set String), nr_Inh_CVisit :: (Int), nt_Inh_CVisit :: (NontermIdent), o_case_Inh_CVisit :: (Bool), o_cata_Inh_CVisit :: (Bool), o_clean_Inh_CVisit :: (Bool), o_costcentre_Inh_CVisit :: (Bool), o_data_Inh_CVisit :: (Maybe Bool), o_linePragmas_Inh_CVisit :: (Bool), o_monadic_Inh_CVisit :: (Bool), o_newtypes_Inh_CVisit :: (Bool), o_pretty_Inh_CVisit :: (Bool), o_rename_Inh_CVisit :: (Bool), o_sem_Inh_CVisit :: (Bool), o_sig_Inh_CVisit :: (Bool), o_splitsems_Inh_CVisit :: (Bool), o_strictwrap_Inh_CVisit :: (Bool), o_traces_Inh_CVisit :: (Bool), o_unbox_Inh_CVisit :: (Bool), options_Inh_CVisit :: (Options), paramInstMap_Inh_CVisit :: (Map Identifier (NontermIdent, [String])), paramMap_Inh_CVisit :: (ParamMap), prefix_Inh_CVisit :: (String), quantMap_Inh_CVisit :: (QuantMap), syn_Inh_CVisit :: (Attributes), terminals_Inh_CVisit :: ([Identifier]), unfoldSemDom_Inh_CVisit :: (NontermIdent -> Int -> [String] -> Code.Type), visitedSet_Inh_CVisit :: (Set Identifier), with_sig_Inh_CVisit :: (Bool), wrappers_Inh_CVisit :: (Set NontermIdent) } data Syn_CVisit = Syn_CVisit { comments_Syn_CVisit :: ([String]), decls_Syn_CVisit :: (Decls), gatherInstVisitNrs_Syn_CVisit :: (Map Identifier Int), intra_Syn_CVisit :: (Exprs), intraVars_Syn_CVisit :: (Set String), semNames_Syn_CVisit :: ([String]), visitedSet_Syn_CVisit :: (Set Identifier) } {-# INLINABLE wrap_CVisit #-} wrap_CVisit :: T_CVisit -> Inh_CVisit -> (Syn_CVisit ) wrap_CVisit (T_CVisit act) (Inh_CVisit _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIdecls _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsImergeMap _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwith_sig _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do sem <- act let arg28 = T_CVisit_vIn28 _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIdecls _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsImergeMap _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwith_sig _lhsIwrappers (T_CVisit_vOut28 _lhsOcomments _lhsOdecls _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOsemNames _lhsOvisitedSet) <- return (inv_CVisit_s29 sem arg28) return (Syn_CVisit _lhsOcomments _lhsOdecls _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOsemNames _lhsOvisitedSet) ) -- cata {-# INLINE sem_CVisit #-} sem_CVisit :: CVisit -> T_CVisit sem_CVisit ( CVisit inh_ syn_ vss_ intra_ ordered_ ) = sem_CVisit_CVisit inh_ syn_ ( sem_Sequence vss_ ) ( sem_Sequence intra_ ) ordered_ -- semantic domain newtype T_CVisit = T_CVisit { attach_T_CVisit :: Identity (T_CVisit_s29 ) } newtype T_CVisit_s29 = C_CVisit_s29 { inv_CVisit_s29 :: (T_CVisit_v28 ) } data T_CVisit_s30 = C_CVisit_s30 type T_CVisit_v28 = (T_CVisit_vIn28 ) -> (T_CVisit_vOut28 ) data T_CVisit_vIn28 = T_CVisit_vIn28 (Set NontermIdent) (PragmaMap) (Set Identifier) ([(Identifier,Type, ChildKind)]) (ConstructorIdent) (ContextMap) (Decls) (Attributes) (Map Identifier Int) (Bool) (Map Identifier (Identifier, [Identifier])) (Exprs) (Set String) (Int) (NontermIdent) (Bool) (Bool) (Bool) (Bool) (Maybe Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (Map Identifier (NontermIdent, [String])) (ParamMap) (String) (QuantMap) (Attributes) ([Identifier]) (NontermIdent -> Int -> [String] -> Code.Type) (Set Identifier) (Bool) (Set NontermIdent) data T_CVisit_vOut28 = T_CVisit_vOut28 ([String]) (Decls) (Map Identifier Int) (Exprs) (Set String) ([String]) (Set Identifier) {-# NOINLINE sem_CVisit_CVisit #-} sem_CVisit_CVisit :: (Attributes) -> (Attributes) -> T_Sequence -> T_Sequence -> (Bool) -> T_CVisit sem_CVisit_CVisit arg_inh_ arg_syn_ arg_vss_ arg_intra_ arg_ordered_ = T_CVisit (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_CVisit_v28 v28 = \ (T_CVisit_vIn28 _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIdecls _lhsIinh _lhsIinstVisitNrs _lhsIisLast _lhsImergeMap _lhsInextIntra _lhsInextIntraVars _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwith_sig _lhsIwrappers) -> ( let _vssX47 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_vss_)) _intraX47 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_intra_)) (T_Sequence_vOut46 _vssIallTpsFound _vssIblockDecls _vssIcomments _vssIdecls _vssIdeclsAbove _vssIdefinedInsts _vssIexprs _vssItSigs _vssItps _vssIusedVars _vssIvisitedSet) = inv_Sequence_s47 _vssX47 (T_Sequence_vIn46 _vssOallNts _vssOaroundMap _vssOchildren _vssOcon _vssOdeclsAbove _vssOinh _vssOinstVisitNrs _vssOlastExpr _vssOmergeMap _vssOnr _vssOnt _vssOo_case _vssOo_cata _vssOo_clean _vssOo_costcentre _vssOo_data _vssOo_linePragmas _vssOo_monadic _vssOo_newtypes _vssOo_pretty _vssOo_rename _vssOo_sem _vssOo_sig _vssOo_splitsems _vssOo_strictwrap _vssOo_traces _vssOo_unbox _vssOoptions _vssOparamInstMap _vssOparamMap _vssOprefix _vssOsyn _vssOterminals _vssOunfoldSemDom _vssOvisitedSet _vssOwhat) (T_Sequence_vOut46 _intraIallTpsFound _intraIblockDecls _intraIcomments _intraIdecls _intraIdeclsAbove _intraIdefinedInsts _intraIexprs _intraItSigs _intraItps _intraIusedVars _intraIvisitedSet) = inv_Sequence_s47 _intraX47 (T_Sequence_vIn46 _intraOallNts _intraOaroundMap _intraOchildren _intraOcon _intraOdeclsAbove _intraOinh _intraOinstVisitNrs _intraOlastExpr _intraOmergeMap _intraOnr _intraOnt _intraOo_case _intraOo_cata _intraOo_clean _intraOo_costcentre _intraOo_data _intraOo_linePragmas _intraOo_monadic _intraOo_newtypes _intraOo_pretty _intraOo_rename _intraOo_sem _intraOo_sig _intraOo_splitsems _intraOo_strictwrap _intraOo_traces _intraOo_unbox _intraOoptions _intraOparamInstMap _intraOparamMap _intraOprefix _intraOsyn _intraOterminals _intraOunfoldSemDom _intraOvisitedSet _intraOwhat) _lhsOintra :: Exprs _lhsOintra = rule434 _intraIexprs _lhsOintraVars :: Set String _lhsOintraVars = rule435 _intraIusedVars (_higherOrderChildren,_firstOrderChildren) = rule436 _lhsIchildren _firstOrderOrig = rule437 _firstOrderChildren _funcname = rule438 _lhsIcon _lhsInr _lhsInt _lhsIprefix _nextVisitName = rule439 _lhsIisLast _lhsInr _lhsInt _lhsIprefix _nextVisitDecl = rule440 _lhsIcon _lhsIdecls _lhsIisLast _lhsInextIntraVars _lhsInr _lhsInt _lhsIprefix _nextVisitName _isOneVisit = rule441 _lhsIisLast _lhsInr _hasWrappers = rule442 _lhsInt _lhsIwrappers _refDecls = rule443 _hasWrappers _isOneVisit _lhsInt _lhsIoptions arg_syn_ _decls = rule444 _lhsIo_clean _nextVisitDecl _refDecls _typeSigs _vssIdecls _vssOlastExpr = rule445 _lhsIo_unbox _lhsIoptions _nextVisitName arg_inh_ arg_syn_ _intraOlastExpr = rule446 () _lastExprVars = rule447 _lhsIoptions _nextVisitName arg_syn_ (_blockFunDecls,_blockFirstFunCall) = rule448 _funcname _lastExprVars _nextVisitDecl _o_case _vssIblockDecls _costCentreDescr = rule449 _lhsIcon _lhsInr _lhsInt _addCostCentre = rule450 _costCentreDescr _lhsIo_costcentre _params = rule451 _lhsInt _lhsIparamMap _semFun = rule452 _addCostCentre _blockFirstFunCall _decls _declsType _firstOrderOrig _funcname _lhsInr _lhsInt _lhsIo_newtypes _lhsIo_unbox _lhsIoptions _lhsIunfoldSemDom _nextVisitName _o_splitsems _params arg_inh_ arg_ordered_ arg_syn_ _tsig = rule453 _funcname _semType _semType = rule454 _firstOrderOrig _lhsIcontextMap _lhsInr _lhsInt _lhsIoptions _lhsIquantMap _params _lhsOdecls :: Decls _lhsOdecls = rule455 _blockFunDecls _lhsIwith_sig _o_splitsems _semFun _tsig arg_ordered_ _typeSigs = rule456 _lhsIo_sig _o_case _vssItSigs _o_do = rule457 _lhsIo_monadic arg_ordered_ _o_case = rule458 _lhsIallPragmas _lhsIcon _lhsInt _lhsIo_case _o_do arg_ordered_ _declsType = rule459 _o_case _o_do _o_splitsems = rule460 _lhsIo_splitsems arg_ordered_ _lhsOgatherInstVisitNrs :: Map Identifier Int _lhsOgatherInstVisitNrs = rule461 _lhsInr _vssIdefinedInsts _vssOdeclsAbove = rule462 () _intraOdeclsAbove = rule463 () _lhsOcomments :: [String] _lhsOcomments = rule464 _intraIcomments _lhsInr _vssIcomments _vssOwhat = rule465 () _intraOwhat = rule466 () _lhsOsemNames :: [String] _lhsOsemNames = rule467 _funcname _lhsOvisitedSet :: Set Identifier _lhsOvisitedSet = rule468 _intraIvisitedSet _vssOallNts = rule469 _lhsIallNts _vssOaroundMap = rule470 _lhsIaroundMap _vssOchildren = rule471 _lhsIchildren _vssOcon = rule472 _lhsIcon _vssOinh = rule473 _lhsIinh _vssOinstVisitNrs = rule474 _lhsIinstVisitNrs _vssOmergeMap = rule475 _lhsImergeMap _vssOnr = rule476 _lhsInr _vssOnt = rule477 _lhsInt _vssOo_case = rule478 _o_case _vssOo_cata = rule479 _lhsIo_cata _vssOo_clean = rule480 _lhsIo_clean _vssOo_costcentre = rule481 _lhsIo_costcentre _vssOo_data = rule482 _lhsIo_data _vssOo_linePragmas = rule483 _lhsIo_linePragmas _vssOo_monadic = rule484 _lhsIo_monadic _vssOo_newtypes = rule485 _lhsIo_newtypes _vssOo_pretty = rule486 _lhsIo_pretty _vssOo_rename = rule487 _lhsIo_rename _vssOo_sem = rule488 _lhsIo_sem _vssOo_sig = rule489 _lhsIo_sig _vssOo_splitsems = rule490 _o_splitsems _vssOo_strictwrap = rule491 _lhsIo_strictwrap _vssOo_traces = rule492 _lhsIo_traces _vssOo_unbox = rule493 _lhsIo_unbox _vssOoptions = rule494 _lhsIoptions _vssOparamInstMap = rule495 _lhsIparamInstMap _vssOparamMap = rule496 _lhsIparamMap _vssOprefix = rule497 _lhsIprefix _vssOsyn = rule498 _lhsIsyn _vssOterminals = rule499 _lhsIterminals _vssOunfoldSemDom = rule500 _lhsIunfoldSemDom _vssOvisitedSet = rule501 _lhsIvisitedSet _intraOallNts = rule502 _lhsIallNts _intraOaroundMap = rule503 _lhsIaroundMap _intraOchildren = rule504 _lhsIchildren _intraOcon = rule505 _lhsIcon _intraOinh = rule506 _lhsIinh _intraOinstVisitNrs = rule507 _lhsIinstVisitNrs _intraOmergeMap = rule508 _lhsImergeMap _intraOnr = rule509 _lhsInr _intraOnt = rule510 _lhsInt _intraOo_case = rule511 _o_case _intraOo_cata = rule512 _lhsIo_cata _intraOo_clean = rule513 _lhsIo_clean _intraOo_costcentre = rule514 _lhsIo_costcentre _intraOo_data = rule515 _lhsIo_data _intraOo_linePragmas = rule516 _lhsIo_linePragmas _intraOo_monadic = rule517 _lhsIo_monadic _intraOo_newtypes = rule518 _lhsIo_newtypes _intraOo_pretty = rule519 _lhsIo_pretty _intraOo_rename = rule520 _lhsIo_rename _intraOo_sem = rule521 _lhsIo_sem _intraOo_sig = rule522 _lhsIo_sig _intraOo_splitsems = rule523 _o_splitsems _intraOo_strictwrap = rule524 _lhsIo_strictwrap _intraOo_traces = rule525 _lhsIo_traces _intraOo_unbox = rule526 _lhsIo_unbox _intraOoptions = rule527 _lhsIoptions _intraOparamInstMap = rule528 _lhsIparamInstMap _intraOparamMap = rule529 _lhsIparamMap _intraOprefix = rule530 _lhsIprefix _intraOsyn = rule531 _lhsIsyn _intraOterminals = rule532 _lhsIterminals _intraOunfoldSemDom = rule533 _lhsIunfoldSemDom _intraOvisitedSet = rule534 _vssIvisitedSet __result_ = T_CVisit_vOut28 _lhsOcomments _lhsOdecls _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOsemNames _lhsOvisitedSet in __result_ ) in C_CVisit_s29 v28 {-# INLINE rule434 #-} {-# LINE 312 "src-ag/GenerateCode.ag" #-} rule434 = \ ((_intraIexprs) :: Exprs) -> {-# LINE 312 "src-ag/GenerateCode.ag" #-} _intraIexprs {-# LINE 3337 "dist/build/GenerateCode.hs"#-} {-# INLINE rule435 #-} {-# LINE 313 "src-ag/GenerateCode.ag" #-} rule435 = \ ((_intraIusedVars) :: Set String) -> {-# LINE 313 "src-ag/GenerateCode.ag" #-} _intraIusedVars {-# LINE 3343 "dist/build/GenerateCode.hs"#-} {-# INLINE rule436 #-} {-# LINE 443 "src-ag/GenerateCode.ag" #-} rule436 = \ ((_lhsIchildren) :: [(Identifier,Type, ChildKind)]) -> {-# LINE 443 "src-ag/GenerateCode.ag" #-} partition (\(_,_,virt) -> isHigherOrder virt) _lhsIchildren {-# LINE 3349 "dist/build/GenerateCode.hs"#-} {-# INLINE rule437 #-} {-# LINE 444 "src-ag/GenerateCode.ag" #-} rule437 = \ _firstOrderChildren -> {-# LINE 444 "src-ag/GenerateCode.ag" #-} map pickOrigType _firstOrderChildren {-# LINE 3355 "dist/build/GenerateCode.hs"#-} {-# INLINE rule438 #-} {-# LINE 445 "src-ag/GenerateCode.ag" #-} rule438 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIprefix) :: String) -> {-# LINE 445 "src-ag/GenerateCode.ag" #-} seqSemname _lhsIprefix _lhsInt _lhsIcon _lhsInr {-# LINE 3361 "dist/build/GenerateCode.hs"#-} {-# INLINE rule439 #-} {-# LINE 446 "src-ag/GenerateCode.ag" #-} rule439 = \ ((_lhsIisLast) :: Bool) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIprefix) :: String) -> {-# LINE 446 "src-ag/GenerateCode.ag" #-} if _lhsIisLast then [] else [visitname _lhsIprefix _lhsInt (_lhsInr+1)] {-# LINE 3367 "dist/build/GenerateCode.hs"#-} {-# INLINE rule440 #-} {-# LINE 447 "src-ag/GenerateCode.ag" #-} rule440 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsIdecls) :: Decls) ((_lhsIisLast) :: Bool) ((_lhsInextIntraVars) :: Set String) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIprefix) :: String) _nextVisitName -> {-# LINE 447 "src-ag/GenerateCode.ag" #-} let lhs = TupleLhs _nextVisitName rhs = Let _lhsIdecls (SimpleExpr fun) fun = seqSemname _lhsIprefix _lhsInt _lhsIcon (_lhsInr+1) in if _lhsIisLast then [] else [Decl lhs rhs (Set.fromList _nextVisitName) _lhsInextIntraVars] {-# LINE 3378 "dist/build/GenerateCode.hs"#-} {-# INLINE rule441 #-} {-# LINE 454 "src-ag/GenerateCode.ag" #-} rule441 = \ ((_lhsIisLast) :: Bool) ((_lhsInr) :: Int) -> {-# LINE 454 "src-ag/GenerateCode.ag" #-} _lhsIisLast && _lhsInr == 0 {-# LINE 3384 "dist/build/GenerateCode.hs"#-} {-# INLINE rule442 #-} {-# LINE 455 "src-ag/GenerateCode.ag" #-} rule442 = \ ((_lhsInt) :: NontermIdent) ((_lhsIwrappers) :: Set NontermIdent) -> {-# LINE 455 "src-ag/GenerateCode.ag" #-} _lhsInt `Set.member` _lhsIwrappers {-# LINE 3390 "dist/build/GenerateCode.hs"#-} {-# INLINE rule443 #-} {-# LINE 456 "src-ag/GenerateCode.ag" #-} rule443 = \ _hasWrappers _isOneVisit ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) syn_ -> {-# LINE 456 "src-ag/GenerateCode.ag" #-} if _isOneVisit && _hasWrappers && reference _lhsIoptions then let synAttrs = Map.toList syn_ synNT = "Syn" ++ "_" ++ getName _lhsInt synVars = [ SimpleExpr (attrname _lhsIoptions False _LHS a) | (a,_) <- synAttrs ] rhs = App synNT synVars lhs = Fun "___node" [] in [Decl lhs rhs Set.empty Set.empty] else [] {-# LINE 3403 "dist/build/GenerateCode.hs"#-} {-# INLINE rule444 #-} {-# LINE 464 "src-ag/GenerateCode.ag" #-} rule444 = \ ((_lhsIo_clean) :: Bool) _nextVisitDecl _refDecls _typeSigs ((_vssIdecls) :: Decls) -> {-# LINE 464 "src-ag/GenerateCode.ag" #-} if _lhsIo_clean then _vssIdecls ++ _nextVisitDecl ++ _refDecls else _typeSigs ++ _vssIdecls ++ _nextVisitDecl ++ _refDecls {-# LINE 3411 "dist/build/GenerateCode.hs"#-} {-# INLINE rule445 #-} {-# LINE 467 "src-ag/GenerateCode.ag" #-} rule445 = \ ((_lhsIo_unbox) :: Bool) ((_lhsIoptions) :: Options) _nextVisitName inh_ syn_ -> {-# LINE 467 "src-ag/GenerateCode.ag" #-} mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_) $ map (SimpleExpr . lhsname _lhsIoptions False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName {-# LINE 3417 "dist/build/GenerateCode.hs"#-} {-# INLINE rule446 #-} {-# LINE 468 "src-ag/GenerateCode.ag" #-} rule446 = \ (_ :: ()) -> {-# LINE 468 "src-ag/GenerateCode.ag" #-} error "lastExpr: not used here" {-# LINE 3423 "dist/build/GenerateCode.hs"#-} {-# INLINE rule447 #-} {-# LINE 469 "src-ag/GenerateCode.ag" #-} rule447 = \ ((_lhsIoptions) :: Options) _nextVisitName syn_ -> {-# LINE 469 "src-ag/GenerateCode.ag" #-} map (lhsname _lhsIoptions False) (Map.keys syn_) ++ _nextVisitName {-# LINE 3429 "dist/build/GenerateCode.hs"#-} {-# INLINE rule448 #-} {-# LINE 470 "src-ag/GenerateCode.ag" #-} rule448 = \ _funcname _lastExprVars _nextVisitDecl _o_case ((_vssIblockDecls) :: DeclBlocks) -> {-# LINE 470 "src-ag/GenerateCode.ag" #-} mkPartitionedFunction _funcname _o_case _nextVisitDecl _lastExprVars _vssIblockDecls {-# LINE 3435 "dist/build/GenerateCode.hs"#-} {-# INLINE rule449 #-} {-# LINE 472 "src-ag/GenerateCode.ag" #-} rule449 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) -> {-# LINE 472 "src-ag/GenerateCode.ag" #-} "b" ++ ":" ++ show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show _lhsInr {-# LINE 3441 "dist/build/GenerateCode.hs"#-} {-# INLINE rule450 #-} {-# LINE 473 "src-ag/GenerateCode.ag" #-} rule450 = \ _costCentreDescr ((_lhsIo_costcentre) :: Bool) -> {-# LINE 473 "src-ag/GenerateCode.ag" #-} \v -> if _lhsIo_costcentre then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v else v {-# LINE 3449 "dist/build/GenerateCode.hs"#-} {-# INLINE rule451 #-} {-# LINE 477 "src-ag/GenerateCode.ag" #-} rule451 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) -> {-# LINE 477 "src-ag/GenerateCode.ag" #-} map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap {-# LINE 3455 "dist/build/GenerateCode.hs"#-} {-# INLINE rule452 #-} {-# LINE 478 "src-ag/GenerateCode.ag" #-} rule452 = \ _addCostCentre _blockFirstFunCall _decls _declsType _firstOrderOrig _funcname ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIo_newtypes) :: Bool) ((_lhsIo_unbox) :: Bool) ((_lhsIoptions) :: Options) ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) _nextVisitName _o_splitsems _params inh_ ordered_ syn_ -> {-# LINE 478 "src-ag/GenerateCode.ag" #-} let lhs = Fun _funcname lhs_args lhs_args = if _lhsInr == 0 then map field _firstOrderOrig else [] field (name,NT tp tps _,_) = let unwrap | _lhsIo_newtypes = \x -> App (sdtype tp) [x] | otherwise = id addType expr | null tps = expr | otherwise = TypedExpr expr (_lhsIunfoldSemDom tp 0 tps) in unwrap $ addType $ SimpleExpr $ funname name 0 field (name,tp,_) = let expr = SimpleExpr (funname name 0) in if null _params then expr else TypedExpr expr (idEvalType _lhsIoptions $ typeToCodeType (Just _lhsInt) _params $ removeDeforested tp) mbEvalTp | null _params = const Nothing | otherwise = Just . (idEvalType _lhsIoptions) rhs = wrap . mkSemFun _lhsInt _lhsInr [mkLambdaArg (lhsname _lhsIoptions True nm) (mbEvalTp $ typeToCodeType (Just _lhsInt) _params $ removeDeforested tp) | (nm,tp) <- Map.assocs inh_] $ _addCostCentre $ if ordered_ && _o_splitsems then _blockFirstFunCall else mkDecls _declsType _decls . ResultExpr (typeName _lhsInt _lhsInr) . mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_) $ map (SimpleExpr . lhsname _lhsIoptions False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName wrap = if _lhsIo_newtypes then \x -> App (typeName _lhsInt _lhsInr) [x] else id in Decl lhs rhs Set.empty Set.empty {-# LINE 3486 "dist/build/GenerateCode.hs"#-} {-# INLINE rule453 #-} {-# LINE 509 "src-ag/GenerateCode.ag" #-} rule453 = \ _funcname _semType -> {-# LINE 509 "src-ag/GenerateCode.ag" #-} TSig _funcname _semType {-# LINE 3492 "dist/build/GenerateCode.hs"#-} {-# INLINE rule454 #-} {-# LINE 510 "src-ag/GenerateCode.ag" #-} rule454 = \ _firstOrderOrig ((_lhsIcontextMap) :: ContextMap) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) ((_lhsIquantMap) :: QuantMap) _params -> {-# LINE 510 "src-ag/GenerateCode.ag" #-} let argType (NT tp tps _) r | tp /= _SELF = typeAppStrs (sdtype tp) tps `Arr` r | tp == _SELF = error "GenerateCode: found an intra-type with type SELF, which should have been prevented by CRule.tps" argType (Haskell tp) r = SimpleType tp `Arr` r argType _ _ = error "Self type not allowed here" evalTp | null _params = id | otherwise = idEvalType _lhsIoptions in appQuant _lhsIquantMap _lhsInt $ appContext _lhsIcontextMap _lhsInt $ evalTp $ if _lhsInr == 0 then foldr argType (typeAppStrs (sdtype _lhsInt ) _params ) (map (\(_,t,_) -> t) _firstOrderOrig ) else foldr argType (typeAppStrs (typeName _lhsInt _lhsInr) _params ) [] {-# LINE 3507 "dist/build/GenerateCode.hs"#-} {-# INLINE rule455 #-} {-# LINE 521 "src-ag/GenerateCode.ag" #-} rule455 = \ _blockFunDecls ((_lhsIwith_sig) :: Bool) _o_splitsems _semFun _tsig ordered_ -> {-# LINE 521 "src-ag/GenerateCode.ag" #-} ( if _lhsIwith_sig then [_tsig, _semFun] else [_semFun] ) ++ ( if ordered_ && _o_splitsems then _blockFunDecls else [] ) {-# LINE 3520 "dist/build/GenerateCode.hs"#-} {-# INLINE rule456 #-} {-# LINE 529 "src-ag/GenerateCode.ag" #-} rule456 = \ ((_lhsIo_sig) :: Bool) _o_case ((_vssItSigs) :: [Decl]) -> {-# LINE 529 "src-ag/GenerateCode.ag" #-} if _lhsIo_sig && not _o_case then _vssItSigs else [] {-# LINE 3528 "dist/build/GenerateCode.hs"#-} {-# INLINE rule457 #-} {-# LINE 532 "src-ag/GenerateCode.ag" #-} rule457 = \ ((_lhsIo_monadic) :: Bool) ordered_ -> {-# LINE 532 "src-ag/GenerateCode.ag" #-} ordered_ && _lhsIo_monadic {-# LINE 3534 "dist/build/GenerateCode.hs"#-} {-# INLINE rule458 #-} {-# LINE 533 "src-ag/GenerateCode.ag" #-} rule458 = \ ((_lhsIallPragmas) :: PragmaMap) ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) ((_lhsIo_case) :: Bool) _o_do ordered_ -> {-# LINE 533 "src-ag/GenerateCode.ag" #-} not _o_do && _lhsIo_case && ordered_ && not (hasPragma _lhsIallPragmas _lhsInt _lhsIcon _NOCASE) {-# LINE 3540 "dist/build/GenerateCode.hs"#-} {-# INLINE rule459 #-} {-# LINE 534 "src-ag/GenerateCode.ag" #-} rule459 = \ _o_case _o_do -> {-# LINE 534 "src-ag/GenerateCode.ag" #-} if _o_do then DeclsDo else if _o_case then DeclsCase else DeclsLet {-# LINE 3550 "dist/build/GenerateCode.hs"#-} {-# INLINE rule460 #-} {-# LINE 539 "src-ag/GenerateCode.ag" #-} rule460 = \ ((_lhsIo_splitsems) :: Bool) ordered_ -> {-# LINE 539 "src-ag/GenerateCode.ag" #-} ordered_ && _lhsIo_splitsems {-# LINE 3556 "dist/build/GenerateCode.hs"#-} {-# INLINE rule461 #-} {-# LINE 573 "src-ag/GenerateCode.ag" #-} rule461 = \ ((_lhsInr) :: Int) ((_vssIdefinedInsts) :: [Identifier]) -> {-# LINE 573 "src-ag/GenerateCode.ag" #-} Map.fromList [(i,_lhsInr) | i <- _vssIdefinedInsts] {-# LINE 3562 "dist/build/GenerateCode.hs"#-} {-# INLINE rule462 #-} {-# LINE 616 "src-ag/GenerateCode.ag" #-} rule462 = \ (_ :: ()) -> {-# LINE 616 "src-ag/GenerateCode.ag" #-} [] {-# LINE 3568 "dist/build/GenerateCode.hs"#-} {-# INLINE rule463 #-} {-# LINE 617 "src-ag/GenerateCode.ag" #-} rule463 = \ (_ :: ()) -> {-# LINE 617 "src-ag/GenerateCode.ag" #-} error "declsAbove: not used here" {-# LINE 3574 "dist/build/GenerateCode.hs"#-} {-# INLINE rule464 #-} {-# LINE 901 "src-ag/GenerateCode.ag" #-} rule464 = \ ((_intraIcomments) :: [String]) ((_lhsInr) :: Int) ((_vssIcomments) :: [String]) -> {-# LINE 901 "src-ag/GenerateCode.ag" #-} let body = map ind (_vssIcomments ++ _intraIcomments) in if null body then [] else ("visit " ++ show _lhsInr ++ ":") : body {-# LINE 3583 "dist/build/GenerateCode.hs"#-} {-# INLINE rule465 #-} {-# LINE 905 "src-ag/GenerateCode.ag" #-} rule465 = \ (_ :: ()) -> {-# LINE 905 "src-ag/GenerateCode.ag" #-} "local" {-# LINE 3589 "dist/build/GenerateCode.hs"#-} {-# INLINE rule466 #-} {-# LINE 906 "src-ag/GenerateCode.ag" #-} rule466 = \ (_ :: ()) -> {-# LINE 906 "src-ag/GenerateCode.ag" #-} "intra" {-# LINE 3595 "dist/build/GenerateCode.hs"#-} {-# INLINE rule467 #-} {-# LINE 1186 "src-ag/GenerateCode.ag" #-} rule467 = \ _funcname -> {-# LINE 1186 "src-ag/GenerateCode.ag" #-} [_funcname ] {-# LINE 3601 "dist/build/GenerateCode.hs"#-} {-# INLINE rule468 #-} rule468 = \ ((_intraIvisitedSet) :: Set Identifier) -> _intraIvisitedSet {-# INLINE rule469 #-} rule469 = \ ((_lhsIallNts) :: Set NontermIdent) -> _lhsIallNts {-# INLINE rule470 #-} rule470 = \ ((_lhsIaroundMap) :: Set Identifier) -> _lhsIaroundMap {-# INLINE rule471 #-} rule471 = \ ((_lhsIchildren) :: [(Identifier,Type, ChildKind)]) -> _lhsIchildren {-# INLINE rule472 #-} rule472 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule473 #-} rule473 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule474 #-} rule474 = \ ((_lhsIinstVisitNrs) :: Map Identifier Int) -> _lhsIinstVisitNrs {-# INLINE rule475 #-} rule475 = \ ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier])) -> _lhsImergeMap {-# INLINE rule476 #-} rule476 = \ ((_lhsInr) :: Int) -> _lhsInr {-# INLINE rule477 #-} rule477 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule478 #-} rule478 = \ _o_case -> _o_case {-# INLINE rule479 #-} rule479 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule480 #-} rule480 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule481 #-} rule481 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule482 #-} rule482 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule483 #-} rule483 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule484 #-} rule484 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule485 #-} rule485 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule486 #-} rule486 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule487 #-} rule487 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule488 #-} rule488 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule489 #-} rule489 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule490 #-} rule490 = \ _o_splitsems -> _o_splitsems {-# INLINE rule491 #-} rule491 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule492 #-} rule492 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule493 #-} rule493 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule494 #-} rule494 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule495 #-} rule495 = \ ((_lhsIparamInstMap) :: Map Identifier (NontermIdent, [String])) -> _lhsIparamInstMap {-# INLINE rule496 #-} rule496 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule497 #-} rule497 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule498 #-} rule498 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule499 #-} rule499 = \ ((_lhsIterminals) :: [Identifier]) -> _lhsIterminals {-# INLINE rule500 #-} rule500 = \ ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) -> _lhsIunfoldSemDom {-# INLINE rule501 #-} rule501 = \ ((_lhsIvisitedSet) :: Set Identifier) -> _lhsIvisitedSet {-# INLINE rule502 #-} rule502 = \ ((_lhsIallNts) :: Set NontermIdent) -> _lhsIallNts {-# INLINE rule503 #-} rule503 = \ ((_lhsIaroundMap) :: Set Identifier) -> _lhsIaroundMap {-# INLINE rule504 #-} rule504 = \ ((_lhsIchildren) :: [(Identifier,Type, ChildKind)]) -> _lhsIchildren {-# INLINE rule505 #-} rule505 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule506 #-} rule506 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule507 #-} rule507 = \ ((_lhsIinstVisitNrs) :: Map Identifier Int) -> _lhsIinstVisitNrs {-# INLINE rule508 #-} rule508 = \ ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier])) -> _lhsImergeMap {-# INLINE rule509 #-} rule509 = \ ((_lhsInr) :: Int) -> _lhsInr {-# INLINE rule510 #-} rule510 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule511 #-} rule511 = \ _o_case -> _o_case {-# INLINE rule512 #-} rule512 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule513 #-} rule513 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule514 #-} rule514 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule515 #-} rule515 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule516 #-} rule516 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule517 #-} rule517 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule518 #-} rule518 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule519 #-} rule519 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule520 #-} rule520 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule521 #-} rule521 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule522 #-} rule522 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule523 #-} rule523 = \ _o_splitsems -> _o_splitsems {-# INLINE rule524 #-} rule524 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule525 #-} rule525 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule526 #-} rule526 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule527 #-} rule527 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule528 #-} rule528 = \ ((_lhsIparamInstMap) :: Map Identifier (NontermIdent, [String])) -> _lhsIparamInstMap {-# INLINE rule529 #-} rule529 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule530 #-} rule530 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule531 #-} rule531 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule532 #-} rule532 = \ ((_lhsIterminals) :: [Identifier]) -> _lhsIterminals {-# INLINE rule533 #-} rule533 = \ ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) -> _lhsIunfoldSemDom {-# INLINE rule534 #-} rule534 = \ ((_vssIvisitedSet) :: Set Identifier) -> _vssIvisitedSet -- CVisits ----------------------------------------------------- -- wrapper data Inh_CVisits = Inh_CVisits { allNts_Inh_CVisits :: (Set NontermIdent), allPragmas_Inh_CVisits :: (PragmaMap), aroundMap_Inh_CVisits :: (Set Identifier), children_Inh_CVisits :: ([(Identifier,Type, ChildKind)]), con_Inh_CVisits :: (ConstructorIdent), contextMap_Inh_CVisits :: (ContextMap), inh_Inh_CVisits :: (Attributes), instVisitNrs_Inh_CVisits :: (Map Identifier Int), mergeMap_Inh_CVisits :: (Map Identifier (Identifier, [Identifier])), nr_Inh_CVisits :: (Int), nt_Inh_CVisits :: (NontermIdent), o_case_Inh_CVisits :: (Bool), o_cata_Inh_CVisits :: (Bool), o_clean_Inh_CVisits :: (Bool), o_costcentre_Inh_CVisits :: (Bool), o_data_Inh_CVisits :: (Maybe Bool), o_linePragmas_Inh_CVisits :: (Bool), o_monadic_Inh_CVisits :: (Bool), o_newtypes_Inh_CVisits :: (Bool), o_pretty_Inh_CVisits :: (Bool), o_rename_Inh_CVisits :: (Bool), o_sem_Inh_CVisits :: (Bool), o_sig_Inh_CVisits :: (Bool), o_splitsems_Inh_CVisits :: (Bool), o_strictwrap_Inh_CVisits :: (Bool), o_traces_Inh_CVisits :: (Bool), o_unbox_Inh_CVisits :: (Bool), options_Inh_CVisits :: (Options), paramInstMap_Inh_CVisits :: (Map Identifier (NontermIdent, [String])), paramMap_Inh_CVisits :: (ParamMap), prefix_Inh_CVisits :: (String), quantMap_Inh_CVisits :: (QuantMap), syn_Inh_CVisits :: (Attributes), terminals_Inh_CVisits :: ([Identifier]), unfoldSemDom_Inh_CVisits :: (NontermIdent -> Int -> [String] -> Code.Type), visitedSet_Inh_CVisits :: (Set Identifier), with_sig_Inh_CVisits :: (Bool), wrappers_Inh_CVisits :: (Set NontermIdent) } data Syn_CVisits = Syn_CVisits { comments_Syn_CVisits :: ([String]), decls_Syn_CVisits :: (Decls), gatherInstVisitNrs_Syn_CVisits :: (Map Identifier Int), intra_Syn_CVisits :: (Exprs), intraVars_Syn_CVisits :: (Set String), isNil_Syn_CVisits :: (Bool), semNames_Syn_CVisits :: ([String]), visitedSet_Syn_CVisits :: (Set Identifier) } {-# INLINABLE wrap_CVisits #-} wrap_CVisits :: T_CVisits -> Inh_CVisits -> (Syn_CVisits ) wrap_CVisits (T_CVisits act) (Inh_CVisits _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwith_sig _lhsIwrappers) = Control.Monad.Identity.runIdentity ( do sem <- act let arg31 = T_CVisits_vIn31 _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwith_sig _lhsIwrappers (T_CVisits_vOut31 _lhsOcomments _lhsOdecls _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOisNil _lhsOsemNames _lhsOvisitedSet) <- return (inv_CVisits_s32 sem arg31) return (Syn_CVisits _lhsOcomments _lhsOdecls _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOisNil _lhsOsemNames _lhsOvisitedSet) ) -- cata {-# NOINLINE sem_CVisits #-} sem_CVisits :: CVisits -> T_CVisits sem_CVisits list = Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list) -- semantic domain newtype T_CVisits = T_CVisits { attach_T_CVisits :: Identity (T_CVisits_s32 ) } newtype T_CVisits_s32 = C_CVisits_s32 { inv_CVisits_s32 :: (T_CVisits_v31 ) } data T_CVisits_s33 = C_CVisits_s33 type T_CVisits_v31 = (T_CVisits_vIn31 ) -> (T_CVisits_vOut31 ) data T_CVisits_vIn31 = T_CVisits_vIn31 (Set NontermIdent) (PragmaMap) (Set Identifier) ([(Identifier,Type, ChildKind)]) (ConstructorIdent) (ContextMap) (Attributes) (Map Identifier Int) (Map Identifier (Identifier, [Identifier])) (Int) (NontermIdent) (Bool) (Bool) (Bool) (Bool) (Maybe Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (Map Identifier (NontermIdent, [String])) (ParamMap) (String) (QuantMap) (Attributes) ([Identifier]) (NontermIdent -> Int -> [String] -> Code.Type) (Set Identifier) (Bool) (Set NontermIdent) data T_CVisits_vOut31 = T_CVisits_vOut31 ([String]) (Decls) (Map Identifier Int) (Exprs) (Set String) (Bool) ([String]) (Set Identifier) {-# NOINLINE sem_CVisits_Cons #-} sem_CVisits_Cons :: T_CVisit -> T_CVisits -> T_CVisits sem_CVisits_Cons arg_hd_ arg_tl_ = T_CVisits (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_CVisits_v31 v31 = \ (T_CVisits_vIn31 _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwith_sig _lhsIwrappers) -> ( let _hdX29 = Control.Monad.Identity.runIdentity (attach_T_CVisit (arg_hd_)) _tlX32 = Control.Monad.Identity.runIdentity (attach_T_CVisits (arg_tl_)) (T_CVisit_vOut28 _hdIcomments _hdIdecls _hdIgatherInstVisitNrs _hdIintra _hdIintraVars _hdIsemNames _hdIvisitedSet) = inv_CVisit_s29 _hdX29 (T_CVisit_vIn28 _hdOallNts _hdOallPragmas _hdOaroundMap _hdOchildren _hdOcon _hdOcontextMap _hdOdecls _hdOinh _hdOinstVisitNrs _hdOisLast _hdOmergeMap _hdOnextIntra _hdOnextIntraVars _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_clean _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_monadic _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOoptions _hdOparamInstMap _hdOparamMap _hdOprefix _hdOquantMap _hdOsyn _hdOterminals _hdOunfoldSemDom _hdOvisitedSet _hdOwith_sig _hdOwrappers) (T_CVisits_vOut31 _tlIcomments _tlIdecls _tlIgatherInstVisitNrs _tlIintra _tlIintraVars _tlIisNil _tlIsemNames _tlIvisitedSet) = inv_CVisits_s32 _tlX32 (T_CVisits_vIn31 _tlOallNts _tlOallPragmas _tlOaroundMap _tlOchildren _tlOcon _tlOcontextMap _tlOinh _tlOinstVisitNrs _tlOmergeMap _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_clean _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_monadic _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOoptions _tlOparamInstMap _tlOparamMap _tlOprefix _tlOquantMap _tlOsyn _tlOterminals _tlOunfoldSemDom _tlOvisitedSet _tlOwith_sig _tlOwrappers) _tlOnr = rule535 _lhsInr _lhsOisNil :: Bool _lhsOisNil = rule536 () _hdOisLast = rule537 _tlIisNil _hdOnextIntra = rule538 _tlIintra _hdOnextIntraVars = rule539 _tlIintraVars _lhsOintra :: Exprs _lhsOintra = rule540 _hdIintra _lhsOintraVars :: Set String _lhsOintraVars = rule541 _hdIintraVars _lhsOdecls :: Decls _lhsOdecls = rule542 _hdIdecls _hdOdecls = rule543 _tlIdecls _lhsOcomments :: [String] _lhsOcomments = rule544 _hdIcomments _tlIcomments _lhsOgatherInstVisitNrs :: Map Identifier Int _lhsOgatherInstVisitNrs = rule545 _hdIgatherInstVisitNrs _tlIgatherInstVisitNrs _lhsOsemNames :: [String] _lhsOsemNames = rule546 _hdIsemNames _tlIsemNames _lhsOvisitedSet :: Set Identifier _lhsOvisitedSet = rule547 _tlIvisitedSet _hdOallNts = rule548 _lhsIallNts _hdOallPragmas = rule549 _lhsIallPragmas _hdOaroundMap = rule550 _lhsIaroundMap _hdOchildren = rule551 _lhsIchildren _hdOcon = rule552 _lhsIcon _hdOcontextMap = rule553 _lhsIcontextMap _hdOinh = rule554 _lhsIinh _hdOinstVisitNrs = rule555 _lhsIinstVisitNrs _hdOmergeMap = rule556 _lhsImergeMap _hdOnr = rule557 _lhsInr _hdOnt = rule558 _lhsInt _hdOo_case = rule559 _lhsIo_case _hdOo_cata = rule560 _lhsIo_cata _hdOo_clean = rule561 _lhsIo_clean _hdOo_costcentre = rule562 _lhsIo_costcentre _hdOo_data = rule563 _lhsIo_data _hdOo_linePragmas = rule564 _lhsIo_linePragmas _hdOo_monadic = rule565 _lhsIo_monadic _hdOo_newtypes = rule566 _lhsIo_newtypes _hdOo_pretty = rule567 _lhsIo_pretty _hdOo_rename = rule568 _lhsIo_rename _hdOo_sem = rule569 _lhsIo_sem _hdOo_sig = rule570 _lhsIo_sig _hdOo_splitsems = rule571 _lhsIo_splitsems _hdOo_strictwrap = rule572 _lhsIo_strictwrap _hdOo_traces = rule573 _lhsIo_traces _hdOo_unbox = rule574 _lhsIo_unbox _hdOoptions = rule575 _lhsIoptions _hdOparamInstMap = rule576 _lhsIparamInstMap _hdOparamMap = rule577 _lhsIparamMap _hdOprefix = rule578 _lhsIprefix _hdOquantMap = rule579 _lhsIquantMap _hdOsyn = rule580 _lhsIsyn _hdOterminals = rule581 _lhsIterminals _hdOunfoldSemDom = rule582 _lhsIunfoldSemDom _hdOvisitedSet = rule583 _lhsIvisitedSet _hdOwith_sig = rule584 _lhsIwith_sig _hdOwrappers = rule585 _lhsIwrappers _tlOallNts = rule586 _lhsIallNts _tlOallPragmas = rule587 _lhsIallPragmas _tlOaroundMap = rule588 _lhsIaroundMap _tlOchildren = rule589 _lhsIchildren _tlOcon = rule590 _lhsIcon _tlOcontextMap = rule591 _lhsIcontextMap _tlOinh = rule592 _lhsIinh _tlOinstVisitNrs = rule593 _lhsIinstVisitNrs _tlOmergeMap = rule594 _lhsImergeMap _tlOnt = rule595 _lhsInt _tlOo_case = rule596 _lhsIo_case _tlOo_cata = rule597 _lhsIo_cata _tlOo_clean = rule598 _lhsIo_clean _tlOo_costcentre = rule599 _lhsIo_costcentre _tlOo_data = rule600 _lhsIo_data _tlOo_linePragmas = rule601 _lhsIo_linePragmas _tlOo_monadic = rule602 _lhsIo_monadic _tlOo_newtypes = rule603 _lhsIo_newtypes _tlOo_pretty = rule604 _lhsIo_pretty _tlOo_rename = rule605 _lhsIo_rename _tlOo_sem = rule606 _lhsIo_sem _tlOo_sig = rule607 _lhsIo_sig _tlOo_splitsems = rule608 _lhsIo_splitsems _tlOo_strictwrap = rule609 _lhsIo_strictwrap _tlOo_traces = rule610 _lhsIo_traces _tlOo_unbox = rule611 _lhsIo_unbox _tlOoptions = rule612 _lhsIoptions _tlOparamInstMap = rule613 _lhsIparamInstMap _tlOparamMap = rule614 _lhsIparamMap _tlOprefix = rule615 _lhsIprefix _tlOquantMap = rule616 _lhsIquantMap _tlOsyn = rule617 _lhsIsyn _tlOterminals = rule618 _lhsIterminals _tlOunfoldSemDom = rule619 _lhsIunfoldSemDom _tlOvisitedSet = rule620 _hdIvisitedSet _tlOwith_sig = rule621 _lhsIwith_sig _tlOwrappers = rule622 _lhsIwrappers __result_ = T_CVisits_vOut31 _lhsOcomments _lhsOdecls _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOisNil _lhsOsemNames _lhsOvisitedSet in __result_ ) in C_CVisits_s32 v31 {-# INLINE rule535 #-} {-# LINE 284 "src-ag/GenerateCode.ag" #-} rule535 = \ ((_lhsInr) :: Int) -> {-# LINE 284 "src-ag/GenerateCode.ag" #-} _lhsInr + 1 {-# LINE 3949 "dist/build/GenerateCode.hs"#-} {-# INLINE rule536 #-} {-# LINE 297 "src-ag/GenerateCode.ag" #-} rule536 = \ (_ :: ()) -> {-# LINE 297 "src-ag/GenerateCode.ag" #-} False {-# LINE 3955 "dist/build/GenerateCode.hs"#-} {-# INLINE rule537 #-} {-# LINE 298 "src-ag/GenerateCode.ag" #-} rule537 = \ ((_tlIisNil) :: Bool) -> {-# LINE 298 "src-ag/GenerateCode.ag" #-} _tlIisNil {-# LINE 3961 "dist/build/GenerateCode.hs"#-} {-# INLINE rule538 #-} {-# LINE 315 "src-ag/GenerateCode.ag" #-} rule538 = \ ((_tlIintra) :: Exprs) -> {-# LINE 315 "src-ag/GenerateCode.ag" #-} _tlIintra {-# LINE 3967 "dist/build/GenerateCode.hs"#-} {-# INLINE rule539 #-} {-# LINE 316 "src-ag/GenerateCode.ag" #-} rule539 = \ ((_tlIintraVars) :: Set String) -> {-# LINE 316 "src-ag/GenerateCode.ag" #-} _tlIintraVars {-# LINE 3973 "dist/build/GenerateCode.hs"#-} {-# INLINE rule540 #-} {-# LINE 317 "src-ag/GenerateCode.ag" #-} rule540 = \ ((_hdIintra) :: Exprs) -> {-# LINE 317 "src-ag/GenerateCode.ag" #-} _hdIintra {-# LINE 3979 "dist/build/GenerateCode.hs"#-} {-# INLINE rule541 #-} {-# LINE 318 "src-ag/GenerateCode.ag" #-} rule541 = \ ((_hdIintraVars) :: Set String) -> {-# LINE 318 "src-ag/GenerateCode.ag" #-} _hdIintraVars {-# LINE 3985 "dist/build/GenerateCode.hs"#-} {-# INLINE rule542 #-} {-# LINE 433 "src-ag/GenerateCode.ag" #-} rule542 = \ ((_hdIdecls) :: Decls) -> {-# LINE 433 "src-ag/GenerateCode.ag" #-} _hdIdecls {-# LINE 3991 "dist/build/GenerateCode.hs"#-} {-# INLINE rule543 #-} {-# LINE 434 "src-ag/GenerateCode.ag" #-} rule543 = \ ((_tlIdecls) :: Decls) -> {-# LINE 434 "src-ag/GenerateCode.ag" #-} _tlIdecls {-# LINE 3997 "dist/build/GenerateCode.hs"#-} {-# INLINE rule544 #-} rule544 = \ ((_hdIcomments) :: [String]) ((_tlIcomments) :: [String]) -> _hdIcomments ++ _tlIcomments {-# INLINE rule545 #-} rule545 = \ ((_hdIgatherInstVisitNrs) :: Map Identifier Int) ((_tlIgatherInstVisitNrs) :: Map Identifier Int) -> _hdIgatherInstVisitNrs `Map.union` _tlIgatherInstVisitNrs {-# INLINE rule546 #-} rule546 = \ ((_hdIsemNames) :: [String]) ((_tlIsemNames) :: [String]) -> _hdIsemNames ++ _tlIsemNames {-# INLINE rule547 #-} rule547 = \ ((_tlIvisitedSet) :: Set Identifier) -> _tlIvisitedSet {-# INLINE rule548 #-} rule548 = \ ((_lhsIallNts) :: Set NontermIdent) -> _lhsIallNts {-# INLINE rule549 #-} rule549 = \ ((_lhsIallPragmas) :: PragmaMap) -> _lhsIallPragmas {-# INLINE rule550 #-} rule550 = \ ((_lhsIaroundMap) :: Set Identifier) -> _lhsIaroundMap {-# INLINE rule551 #-} rule551 = \ ((_lhsIchildren) :: [(Identifier,Type, ChildKind)]) -> _lhsIchildren {-# INLINE rule552 #-} rule552 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule553 #-} rule553 = \ ((_lhsIcontextMap) :: ContextMap) -> _lhsIcontextMap {-# INLINE rule554 #-} rule554 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule555 #-} rule555 = \ ((_lhsIinstVisitNrs) :: Map Identifier Int) -> _lhsIinstVisitNrs {-# INLINE rule556 #-} rule556 = \ ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier])) -> _lhsImergeMap {-# INLINE rule557 #-} rule557 = \ ((_lhsInr) :: Int) -> _lhsInr {-# INLINE rule558 #-} rule558 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule559 #-} rule559 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule560 #-} rule560 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule561 #-} rule561 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule562 #-} rule562 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule563 #-} rule563 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule564 #-} rule564 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule565 #-} rule565 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule566 #-} rule566 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule567 #-} rule567 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule568 #-} rule568 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule569 #-} rule569 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule570 #-} rule570 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule571 #-} rule571 = \ ((_lhsIo_splitsems) :: Bool) -> _lhsIo_splitsems {-# INLINE rule572 #-} rule572 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule573 #-} rule573 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule574 #-} rule574 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule575 #-} rule575 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule576 #-} rule576 = \ ((_lhsIparamInstMap) :: Map Identifier (NontermIdent, [String])) -> _lhsIparamInstMap {-# INLINE rule577 #-} rule577 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule578 #-} rule578 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule579 #-} rule579 = \ ((_lhsIquantMap) :: QuantMap) -> _lhsIquantMap {-# INLINE rule580 #-} rule580 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule581 #-} rule581 = \ ((_lhsIterminals) :: [Identifier]) -> _lhsIterminals {-# INLINE rule582 #-} rule582 = \ ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) -> _lhsIunfoldSemDom {-# INLINE rule583 #-} rule583 = \ ((_lhsIvisitedSet) :: Set Identifier) -> _lhsIvisitedSet {-# INLINE rule584 #-} rule584 = \ ((_lhsIwith_sig) :: Bool) -> _lhsIwith_sig {-# INLINE rule585 #-} rule585 = \ ((_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# INLINE rule586 #-} rule586 = \ ((_lhsIallNts) :: Set NontermIdent) -> _lhsIallNts {-# INLINE rule587 #-} rule587 = \ ((_lhsIallPragmas) :: PragmaMap) -> _lhsIallPragmas {-# INLINE rule588 #-} rule588 = \ ((_lhsIaroundMap) :: Set Identifier) -> _lhsIaroundMap {-# INLINE rule589 #-} rule589 = \ ((_lhsIchildren) :: [(Identifier,Type, ChildKind)]) -> _lhsIchildren {-# INLINE rule590 #-} rule590 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule591 #-} rule591 = \ ((_lhsIcontextMap) :: ContextMap) -> _lhsIcontextMap {-# INLINE rule592 #-} rule592 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule593 #-} rule593 = \ ((_lhsIinstVisitNrs) :: Map Identifier Int) -> _lhsIinstVisitNrs {-# INLINE rule594 #-} rule594 = \ ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier])) -> _lhsImergeMap {-# INLINE rule595 #-} rule595 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule596 #-} rule596 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule597 #-} rule597 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule598 #-} rule598 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule599 #-} rule599 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule600 #-} rule600 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule601 #-} rule601 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule602 #-} rule602 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule603 #-} rule603 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule604 #-} rule604 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule605 #-} rule605 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule606 #-} rule606 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule607 #-} rule607 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule608 #-} rule608 = \ ((_lhsIo_splitsems) :: Bool) -> _lhsIo_splitsems {-# INLINE rule609 #-} rule609 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule610 #-} rule610 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule611 #-} rule611 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule612 #-} rule612 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule613 #-} rule613 = \ ((_lhsIparamInstMap) :: Map Identifier (NontermIdent, [String])) -> _lhsIparamInstMap {-# INLINE rule614 #-} rule614 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule615 #-} rule615 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule616 #-} rule616 = \ ((_lhsIquantMap) :: QuantMap) -> _lhsIquantMap {-# INLINE rule617 #-} rule617 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule618 #-} rule618 = \ ((_lhsIterminals) :: [Identifier]) -> _lhsIterminals {-# INLINE rule619 #-} rule619 = \ ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) -> _lhsIunfoldSemDom {-# INLINE rule620 #-} rule620 = \ ((_hdIvisitedSet) :: Set Identifier) -> _hdIvisitedSet {-# INLINE rule621 #-} rule621 = \ ((_lhsIwith_sig) :: Bool) -> _lhsIwith_sig {-# INLINE rule622 #-} rule622 = \ ((_lhsIwrappers) :: Set NontermIdent) -> _lhsIwrappers {-# NOINLINE sem_CVisits_Nil #-} sem_CVisits_Nil :: T_CVisits sem_CVisits_Nil = T_CVisits (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_CVisits_v31 v31 = \ (T_CVisits_vIn31 _lhsIallNts _lhsIallPragmas _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIcontextMap _lhsIinh _lhsIinstVisitNrs _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIquantMap _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwith_sig _lhsIwrappers) -> ( let _lhsOisNil :: Bool _lhsOisNil = rule623 () _lhsOintra :: Exprs _lhsOintra = rule624 () _lhsOintraVars :: Set String _lhsOintraVars = rule625 () _lhsOdecls :: Decls _lhsOdecls = rule626 () _lhsOcomments :: [String] _lhsOcomments = rule627 () _lhsOgatherInstVisitNrs :: Map Identifier Int _lhsOgatherInstVisitNrs = rule628 () _lhsOsemNames :: [String] _lhsOsemNames = rule629 () _lhsOvisitedSet :: Set Identifier _lhsOvisitedSet = rule630 _lhsIvisitedSet __result_ = T_CVisits_vOut31 _lhsOcomments _lhsOdecls _lhsOgatherInstVisitNrs _lhsOintra _lhsOintraVars _lhsOisNil _lhsOsemNames _lhsOvisitedSet in __result_ ) in C_CVisits_s32 v31 {-# INLINE rule623 #-} {-# LINE 299 "src-ag/GenerateCode.ag" #-} rule623 = \ (_ :: ()) -> {-# LINE 299 "src-ag/GenerateCode.ag" #-} True {-# LINE 4266 "dist/build/GenerateCode.hs"#-} {-# INLINE rule624 #-} {-# LINE 319 "src-ag/GenerateCode.ag" #-} rule624 = \ (_ :: ()) -> {-# LINE 319 "src-ag/GenerateCode.ag" #-} [] {-# LINE 4272 "dist/build/GenerateCode.hs"#-} {-# INLINE rule625 #-} {-# LINE 320 "src-ag/GenerateCode.ag" #-} rule625 = \ (_ :: ()) -> {-# LINE 320 "src-ag/GenerateCode.ag" #-} Set.empty {-# LINE 4278 "dist/build/GenerateCode.hs"#-} {-# INLINE rule626 #-} {-# LINE 432 "src-ag/GenerateCode.ag" #-} rule626 = \ (_ :: ()) -> {-# LINE 432 "src-ag/GenerateCode.ag" #-} [] {-# LINE 4284 "dist/build/GenerateCode.hs"#-} {-# INLINE rule627 #-} rule627 = \ (_ :: ()) -> [] {-# INLINE rule628 #-} rule628 = \ (_ :: ()) -> Map.empty {-# INLINE rule629 #-} rule629 = \ (_ :: ()) -> [] {-# INLINE rule630 #-} rule630 = \ ((_lhsIvisitedSet) :: Set Identifier) -> _lhsIvisitedSet -- DeclBlocks -------------------------------------------------- -- wrapper data Inh_DeclBlocks = Inh_DeclBlocks { blockNr_Inh_DeclBlocks :: (Int), lastExprVars_Inh_DeclBlocks :: ([String]), nextVisitDecls_Inh_DeclBlocks :: ([Decl]), optCase_Inh_DeclBlocks :: (Bool), prefix_Inh_DeclBlocks :: (String) } data Syn_DeclBlocks = Syn_DeclBlocks { callExpr_Syn_DeclBlocks :: (Expr), decls_Syn_DeclBlocks :: ([Decl]), freeVars_Syn_DeclBlocks :: ([String]) } {-# INLINABLE wrap_DeclBlocks #-} wrap_DeclBlocks :: T_DeclBlocks -> Inh_DeclBlocks -> (Syn_DeclBlocks ) wrap_DeclBlocks (T_DeclBlocks act) (Inh_DeclBlocks _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix) = Control.Monad.Identity.runIdentity ( do sem <- act let arg34 = T_DeclBlocks_vIn34 _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix (T_DeclBlocks_vOut34 _lhsOcallExpr _lhsOdecls _lhsOfreeVars) <- return (inv_DeclBlocks_s35 sem arg34) return (Syn_DeclBlocks _lhsOcallExpr _lhsOdecls _lhsOfreeVars) ) -- cata {-# NOINLINE sem_DeclBlocks #-} sem_DeclBlocks :: DeclBlocks -> T_DeclBlocks sem_DeclBlocks ( DeclBlock defs_ visit_ next_ ) = sem_DeclBlocks_DeclBlock defs_ visit_ ( sem_DeclBlocks next_ ) sem_DeclBlocks ( DeclTerminator defs_ result_ ) = sem_DeclBlocks_DeclTerminator defs_ result_ -- semantic domain newtype T_DeclBlocks = T_DeclBlocks { attach_T_DeclBlocks :: Identity (T_DeclBlocks_s35 ) } newtype T_DeclBlocks_s35 = C_DeclBlocks_s35 { inv_DeclBlocks_s35 :: (T_DeclBlocks_v34 ) } data T_DeclBlocks_s36 = C_DeclBlocks_s36 type T_DeclBlocks_v34 = (T_DeclBlocks_vIn34 ) -> (T_DeclBlocks_vOut34 ) data T_DeclBlocks_vIn34 = T_DeclBlocks_vIn34 (Int) ([String]) ([Decl]) (Bool) (String) data T_DeclBlocks_vOut34 = T_DeclBlocks_vOut34 (Expr) ([Decl]) ([String]) {-# NOINLINE sem_DeclBlocks_DeclBlock #-} sem_DeclBlocks_DeclBlock :: ([Decl]) -> (Decl) -> T_DeclBlocks -> T_DeclBlocks sem_DeclBlocks_DeclBlock arg_defs_ arg_visit_ arg_next_ = T_DeclBlocks (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_DeclBlocks_v34 v34 = \ (T_DeclBlocks_vIn34 _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix) -> ( let _nextX35 = Control.Monad.Identity.runIdentity (attach_T_DeclBlocks (arg_next_)) (T_DeclBlocks_vOut34 _nextIcallExpr _nextIdecls _nextIfreeVars) = inv_DeclBlocks_s35 _nextX35 (T_DeclBlocks_vIn34 _nextOblockNr _nextOlastExprVars _nextOnextVisitDecls _nextOoptCase _nextOprefix) _nextOblockNr = rule631 _lhsIblockNr _lambdaName = rule632 _lhsIblockNr _lhsIprefix _pragmaDecl = rule633 _lambdaName _lhsOcallExpr :: Expr _lhsOcallExpr = rule634 _freeVars _lambdaName _freeVars = rule635 _nextIfreeVars arg_defs_ arg_visit_ _decl = rule636 _freeVars _lambdaName _lhsIoptCase _nextIcallExpr arg_defs_ arg_visit_ _lhsOdecls :: [Decl] _lhsOdecls = rule637 _decl _lhsIblockNr _nextIdecls _pragmaDecl _lhsOfreeVars :: [String] _lhsOfreeVars = rule638 _freeVars _nextOlastExprVars = rule639 _lhsIlastExprVars _nextOnextVisitDecls = rule640 _lhsInextVisitDecls _nextOoptCase = rule641 _lhsIoptCase _nextOprefix = rule642 _lhsIprefix __result_ = T_DeclBlocks_vOut34 _lhsOcallExpr _lhsOdecls _lhsOfreeVars in __result_ ) in C_DeclBlocks_s35 v34 {-# INLINE rule631 #-} {-# LINE 667 "src-ag/GenerateCode.ag" #-} rule631 = \ ((_lhsIblockNr) :: Int) -> {-# LINE 667 "src-ag/GenerateCode.ag" #-} _lhsIblockNr + 1 {-# LINE 4361 "dist/build/GenerateCode.hs"#-} {-# INLINE rule632 #-} {-# LINE 672 "src-ag/GenerateCode.ag" #-} rule632 = \ ((_lhsIblockNr) :: Int) ((_lhsIprefix) :: String) -> {-# LINE 672 "src-ag/GenerateCode.ag" #-} _lhsIprefix ++ "_block" ++ show _lhsIblockNr {-# LINE 4367 "dist/build/GenerateCode.hs"#-} {-# INLINE rule633 #-} {-# LINE 673 "src-ag/GenerateCode.ag" #-} rule633 = \ _lambdaName -> {-# LINE 673 "src-ag/GenerateCode.ag" #-} PragmaDecl ("NOINLINE " ++ _lambdaName ) {-# LINE 4373 "dist/build/GenerateCode.hs"#-} {-# INLINE rule634 #-} {-# LINE 674 "src-ag/GenerateCode.ag" #-} rule634 = \ _freeVars _lambdaName -> {-# LINE 674 "src-ag/GenerateCode.ag" #-} App _lambdaName (map SimpleExpr _freeVars ) {-# LINE 4379 "dist/build/GenerateCode.hs"#-} {-# INLINE rule635 #-} {-# LINE 678 "src-ag/GenerateCode.ag" #-} rule635 = \ ((_nextIfreeVars) :: [String]) defs_ visit_ -> {-# LINE 678 "src-ag/GenerateCode.ag" #-} freevars _nextIfreeVars (visit_ : defs_) {-# LINE 4385 "dist/build/GenerateCode.hs"#-} {-# INLINE rule636 #-} {-# LINE 685 "src-ag/GenerateCode.ag" #-} rule636 = \ _freeVars _lambdaName ((_lhsIoptCase) :: Bool) ((_nextIcallExpr) :: Expr) defs_ visit_ -> {-# LINE 685 "src-ag/GenerateCode.ag" #-} mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ [visit_]) _nextIcallExpr {-# LINE 4391 "dist/build/GenerateCode.hs"#-} {-# INLINE rule637 #-} {-# LINE 686 "src-ag/GenerateCode.ag" #-} rule637 = \ _decl ((_lhsIblockNr) :: Int) ((_nextIdecls) :: [Decl]) _pragmaDecl -> {-# LINE 686 "src-ag/GenerateCode.ag" #-} (if _lhsIblockNr > 1 then [_pragmaDecl ] else []) ++ [_decl ] ++ _nextIdecls {-# LINE 4397 "dist/build/GenerateCode.hs"#-} {-# INLINE rule638 #-} rule638 = \ _freeVars -> _freeVars {-# INLINE rule639 #-} rule639 = \ ((_lhsIlastExprVars) :: [String]) -> _lhsIlastExprVars {-# INLINE rule640 #-} rule640 = \ ((_lhsInextVisitDecls) :: [Decl]) -> _lhsInextVisitDecls {-# INLINE rule641 #-} rule641 = \ ((_lhsIoptCase) :: Bool) -> _lhsIoptCase {-# INLINE rule642 #-} rule642 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# NOINLINE sem_DeclBlocks_DeclTerminator #-} sem_DeclBlocks_DeclTerminator :: ([Decl]) -> (Expr) -> T_DeclBlocks sem_DeclBlocks_DeclTerminator arg_defs_ arg_result_ = T_DeclBlocks (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_DeclBlocks_v34 v34 = \ (T_DeclBlocks_vIn34 _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix) -> ( let _lambdaName = rule643 _lhsIblockNr _lhsIprefix _pragmaDecl = rule644 _lambdaName _lhsOcallExpr :: Expr _lhsOcallExpr = rule645 _freeVars _lambdaName _freeVars = rule646 _lhsIlastExprVars _lhsInextVisitDecls arg_defs_ _lhsOdecls :: [Decl] _lhsOdecls = rule647 _freeVars _lambdaName _lhsInextVisitDecls _lhsIoptCase arg_defs_ arg_result_ _lhsOfreeVars :: [String] _lhsOfreeVars = rule648 _freeVars __result_ = T_DeclBlocks_vOut34 _lhsOcallExpr _lhsOdecls _lhsOfreeVars in __result_ ) in C_DeclBlocks_s35 v34 {-# INLINE rule643 #-} {-# LINE 672 "src-ag/GenerateCode.ag" #-} rule643 = \ ((_lhsIblockNr) :: Int) ((_lhsIprefix) :: String) -> {-# LINE 672 "src-ag/GenerateCode.ag" #-} _lhsIprefix ++ "_block" ++ show _lhsIblockNr {-# LINE 4437 "dist/build/GenerateCode.hs"#-} {-# INLINE rule644 #-} {-# LINE 673 "src-ag/GenerateCode.ag" #-} rule644 = \ _lambdaName -> {-# LINE 673 "src-ag/GenerateCode.ag" #-} PragmaDecl ("NOINLINE " ++ _lambdaName ) {-# LINE 4443 "dist/build/GenerateCode.hs"#-} {-# INLINE rule645 #-} {-# LINE 674 "src-ag/GenerateCode.ag" #-} rule645 = \ _freeVars _lambdaName -> {-# LINE 674 "src-ag/GenerateCode.ag" #-} App _lambdaName (map SimpleExpr _freeVars ) {-# LINE 4449 "dist/build/GenerateCode.hs"#-} {-# INLINE rule646 #-} {-# LINE 676 "src-ag/GenerateCode.ag" #-} rule646 = \ ((_lhsIlastExprVars) :: [String]) ((_lhsInextVisitDecls) :: [Decl]) defs_ -> {-# LINE 676 "src-ag/GenerateCode.ag" #-} freevars _lhsIlastExprVars (defs_ ++ _lhsInextVisitDecls) {-# LINE 4455 "dist/build/GenerateCode.hs"#-} {-# INLINE rule647 #-} {-# LINE 683 "src-ag/GenerateCode.ag" #-} rule647 = \ _freeVars _lambdaName ((_lhsInextVisitDecls) :: [Decl]) ((_lhsIoptCase) :: Bool) defs_ result_ -> {-# LINE 683 "src-ag/GenerateCode.ag" #-} [ mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ _lhsInextVisitDecls) result_ ] {-# LINE 4461 "dist/build/GenerateCode.hs"#-} {-# INLINE rule648 #-} rule648 = \ _freeVars -> _freeVars -- DeclBlocksRoot ---------------------------------------------- -- wrapper data Inh_DeclBlocksRoot = Inh_DeclBlocksRoot { lastExprVars_Inh_DeclBlocksRoot :: ([String]), nextVisitDecls_Inh_DeclBlocksRoot :: ([Decl]), optCase_Inh_DeclBlocksRoot :: (Bool), prefix_Inh_DeclBlocksRoot :: (String) } data Syn_DeclBlocksRoot = Syn_DeclBlocksRoot { firstCall_Syn_DeclBlocksRoot :: (Expr), lambdas_Syn_DeclBlocksRoot :: ([Decl]) } {-# INLINABLE wrap_DeclBlocksRoot #-} wrap_DeclBlocksRoot :: T_DeclBlocksRoot -> Inh_DeclBlocksRoot -> (Syn_DeclBlocksRoot ) wrap_DeclBlocksRoot (T_DeclBlocksRoot act) (Inh_DeclBlocksRoot _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix) = Control.Monad.Identity.runIdentity ( do sem <- act let arg37 = T_DeclBlocksRoot_vIn37 _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix (T_DeclBlocksRoot_vOut37 _lhsOfirstCall _lhsOlambdas) <- return (inv_DeclBlocksRoot_s38 sem arg37) return (Syn_DeclBlocksRoot _lhsOfirstCall _lhsOlambdas) ) -- cata {-# INLINE sem_DeclBlocksRoot #-} sem_DeclBlocksRoot :: DeclBlocksRoot -> T_DeclBlocksRoot sem_DeclBlocksRoot ( DeclBlocksRoot blocks_ ) = sem_DeclBlocksRoot_DeclBlocksRoot ( sem_DeclBlocks blocks_ ) -- semantic domain newtype T_DeclBlocksRoot = T_DeclBlocksRoot { attach_T_DeclBlocksRoot :: Identity (T_DeclBlocksRoot_s38 ) } newtype T_DeclBlocksRoot_s38 = C_DeclBlocksRoot_s38 { inv_DeclBlocksRoot_s38 :: (T_DeclBlocksRoot_v37 ) } data T_DeclBlocksRoot_s39 = C_DeclBlocksRoot_s39 type T_DeclBlocksRoot_v37 = (T_DeclBlocksRoot_vIn37 ) -> (T_DeclBlocksRoot_vOut37 ) data T_DeclBlocksRoot_vIn37 = T_DeclBlocksRoot_vIn37 ([String]) ([Decl]) (Bool) (String) data T_DeclBlocksRoot_vOut37 = T_DeclBlocksRoot_vOut37 (Expr) ([Decl]) {-# NOINLINE sem_DeclBlocksRoot_DeclBlocksRoot #-} sem_DeclBlocksRoot_DeclBlocksRoot :: T_DeclBlocks -> T_DeclBlocksRoot sem_DeclBlocksRoot_DeclBlocksRoot arg_blocks_ = T_DeclBlocksRoot (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_DeclBlocksRoot_v37 v37 = \ (T_DeclBlocksRoot_vIn37 _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix) -> ( let _blocksX35 = Control.Monad.Identity.runIdentity (attach_T_DeclBlocks (arg_blocks_)) (T_DeclBlocks_vOut34 _blocksIcallExpr _blocksIdecls _blocksIfreeVars) = inv_DeclBlocks_s35 _blocksX35 (T_DeclBlocks_vIn34 _blocksOblockNr _blocksOlastExprVars _blocksOnextVisitDecls _blocksOoptCase _blocksOprefix) _lhsOlambdas :: [Decl] _lhsOlambdas = rule649 _blocksIdecls _lhsOfirstCall :: Expr _lhsOfirstCall = rule650 _blocksIcallExpr _blocksOblockNr = rule651 () _blocksOlastExprVars = rule652 _lhsIlastExprVars _blocksOnextVisitDecls = rule653 _lhsInextVisitDecls _blocksOoptCase = rule654 _lhsIoptCase _blocksOprefix = rule655 _lhsIprefix __result_ = T_DeclBlocksRoot_vOut37 _lhsOfirstCall _lhsOlambdas in __result_ ) in C_DeclBlocksRoot_s38 v37 {-# INLINE rule649 #-} {-# LINE 658 "src-ag/GenerateCode.ag" #-} rule649 = \ ((_blocksIdecls) :: [Decl]) -> {-# LINE 658 "src-ag/GenerateCode.ag" #-} _blocksIdecls {-# LINE 4522 "dist/build/GenerateCode.hs"#-} {-# INLINE rule650 #-} {-# LINE 659 "src-ag/GenerateCode.ag" #-} rule650 = \ ((_blocksIcallExpr) :: Expr) -> {-# LINE 659 "src-ag/GenerateCode.ag" #-} _blocksIcallExpr {-# LINE 4528 "dist/build/GenerateCode.hs"#-} {-# INLINE rule651 #-} {-# LINE 664 "src-ag/GenerateCode.ag" #-} rule651 = \ (_ :: ()) -> {-# LINE 664 "src-ag/GenerateCode.ag" #-} 1 {-# LINE 4534 "dist/build/GenerateCode.hs"#-} {-# INLINE rule652 #-} rule652 = \ ((_lhsIlastExprVars) :: [String]) -> _lhsIlastExprVars {-# INLINE rule653 #-} rule653 = \ ((_lhsInextVisitDecls) :: [Decl]) -> _lhsInextVisitDecls {-# INLINE rule654 #-} rule654 = \ ((_lhsIoptCase) :: Bool) -> _lhsIoptCase {-# INLINE rule655 #-} rule655 = \ ((_lhsIprefix) :: String) -> _lhsIprefix -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { } data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), definedInsts_Syn_Pattern :: ([Identifier]), patternAttributes_Syn_Pattern :: ([(Identifier, Identifier)]) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg40 = T_Pattern_vIn40 (T_Pattern_vOut40 _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes) <- return (inv_Pattern_s41 sem arg40) return (Syn_Pattern _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s41 ) } newtype T_Pattern_s41 = C_Pattern_s41 { inv_Pattern_s41 :: (T_Pattern_v40 ) } data T_Pattern_s42 = C_Pattern_s42 type T_Pattern_v40 = (T_Pattern_vIn40 ) -> (T_Pattern_vOut40 ) data T_Pattern_vIn40 = T_Pattern_vIn40 data T_Pattern_vOut40 = T_Pattern_vOut40 (Pattern) ([Identifier]) ([(Identifier, Identifier)]) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 ) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIcopy _patsIdefinedInsts _patsIpatternAttributes) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 ) _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule656 _patsIdefinedInsts _lhsOpatternAttributes :: [(Identifier, Identifier)] _lhsOpatternAttributes = rule657 _patsIpatternAttributes _copy = rule658 _patsIcopy arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule659 _copy __result_ = T_Pattern_vOut40 _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule656 #-} rule656 = \ ((_patsIdefinedInsts) :: [Identifier]) -> _patsIdefinedInsts {-# INLINE rule657 #-} rule657 = \ ((_patsIpatternAttributes) :: [(Identifier, Identifier)]) -> _patsIpatternAttributes {-# INLINE rule658 #-} rule658 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule659 #-} rule659 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 ) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIcopy _patsIdefinedInsts _patsIpatternAttributes) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 ) _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule660 _patsIdefinedInsts _lhsOpatternAttributes :: [(Identifier, Identifier)] _lhsOpatternAttributes = rule661 _patsIpatternAttributes _copy = rule662 _patsIcopy arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule663 _copy __result_ = T_Pattern_vOut40 _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule660 #-} rule660 = \ ((_patsIdefinedInsts) :: [Identifier]) -> _patsIdefinedInsts {-# INLINE rule661 #-} rule661 = \ ((_patsIpatternAttributes) :: [(Identifier, Identifier)]) -> _patsIpatternAttributes {-# INLINE rule662 #-} rule662 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule663 #-} rule663 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 ) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIcopy _patIdefinedInsts _patIpatternAttributes) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 ) _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule664 _patIdefinedInsts arg_attr_ arg_field_ _lhsOpatternAttributes :: [(Identifier, Identifier)] _lhsOpatternAttributes = rule665 _patIpatternAttributes arg_attr_ arg_field_ _copy = rule666 _patIcopy arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule667 _copy __result_ = T_Pattern_vOut40 _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule664 #-} {-# LINE 265 "src-ag/GenerateCode.ag" #-} rule664 = \ ((_patIdefinedInsts) :: [Identifier]) attr_ field_ -> {-# LINE 265 "src-ag/GenerateCode.ag" #-} (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts {-# LINE 4668 "dist/build/GenerateCode.hs"#-} {-# INLINE rule665 #-} {-# LINE 273 "src-ag/GenerateCode.ag" #-} rule665 = \ ((_patIpatternAttributes) :: [(Identifier, Identifier)]) attr_ field_ -> {-# LINE 273 "src-ag/GenerateCode.ag" #-} (field_,attr_) : _patIpatternAttributes {-# LINE 4674 "dist/build/GenerateCode.hs"#-} {-# INLINE rule666 #-} rule666 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule667 #-} rule667 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 ) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIcopy _patIdefinedInsts _patIpatternAttributes) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 ) _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule668 _patIdefinedInsts _lhsOpatternAttributes :: [(Identifier, Identifier)] _lhsOpatternAttributes = rule669 _patIpatternAttributes _copy = rule670 _patIcopy _lhsOcopy :: Pattern _lhsOcopy = rule671 _copy __result_ = T_Pattern_vOut40 _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule668 #-} rule668 = \ ((_patIdefinedInsts) :: [Identifier]) -> _patIdefinedInsts {-# INLINE rule669 #-} rule669 = \ ((_patIpatternAttributes) :: [(Identifier, Identifier)]) -> _patIpatternAttributes {-# INLINE rule670 #-} rule670 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule671 #-} rule671 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore arg_pos_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 ) -> ( let _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule672 () _lhsOpatternAttributes :: [(Identifier, Identifier)] _lhsOpatternAttributes = rule673 () _copy = rule674 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule675 _copy __result_ = T_Pattern_vOut40 _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule672 #-} rule672 = \ (_ :: ()) -> [] {-# INLINE rule673 #-} rule673 = \ (_ :: ()) -> [] {-# INLINE rule674 #-} rule674 = \ pos_ -> Underscore pos_ {-# INLINE rule675 #-} rule675 = \ _copy -> _copy -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { } data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns), definedInsts_Syn_Patterns :: ([Identifier]), patternAttributes_Syn_Patterns :: ([(Identifier, Identifier)]) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg43 = T_Patterns_vIn43 (T_Patterns_vOut43 _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes) <- return (inv_Patterns_s44 sem arg43) return (Syn_Patterns _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s44 ) } newtype T_Patterns_s44 = C_Patterns_s44 { inv_Patterns_s44 :: (T_Patterns_v43 ) } data T_Patterns_s45 = C_Patterns_s45 type T_Patterns_v43 = (T_Patterns_vIn43 ) -> (T_Patterns_vOut43 ) data T_Patterns_vIn43 = T_Patterns_vIn43 data T_Patterns_vOut43 = T_Patterns_vOut43 (Patterns) ([Identifier]) ([(Identifier, Identifier)]) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_Patterns_v43 v43 = \ (T_Patterns_vIn43 ) -> ( let _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut40 _hdIcopy _hdIdefinedInsts _hdIpatternAttributes) = inv_Pattern_s41 _hdX41 (T_Pattern_vIn40 ) (T_Patterns_vOut43 _tlIcopy _tlIdefinedInsts _tlIpatternAttributes) = inv_Patterns_s44 _tlX44 (T_Patterns_vIn43 ) _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule676 _hdIdefinedInsts _tlIdefinedInsts _lhsOpatternAttributes :: [(Identifier, Identifier)] _lhsOpatternAttributes = rule677 _hdIpatternAttributes _tlIpatternAttributes _copy = rule678 _hdIcopy _tlIcopy _lhsOcopy :: Patterns _lhsOcopy = rule679 _copy __result_ = T_Patterns_vOut43 _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule676 #-} rule676 = \ ((_hdIdefinedInsts) :: [Identifier]) ((_tlIdefinedInsts) :: [Identifier]) -> _hdIdefinedInsts ++ _tlIdefinedInsts {-# INLINE rule677 #-} rule677 = \ ((_hdIpatternAttributes) :: [(Identifier, Identifier)]) ((_tlIpatternAttributes) :: [(Identifier, Identifier)]) -> _hdIpatternAttributes ++ _tlIpatternAttributes {-# INLINE rule678 #-} rule678 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule679 #-} rule679 = \ _copy -> _copy {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_Patterns_v43 v43 = \ (T_Patterns_vIn43 ) -> ( let _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule680 () _lhsOpatternAttributes :: [(Identifier, Identifier)] _lhsOpatternAttributes = rule681 () _copy = rule682 () _lhsOcopy :: Patterns _lhsOcopy = rule683 _copy __result_ = T_Patterns_vOut43 _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule680 #-} rule680 = \ (_ :: ()) -> [] {-# INLINE rule681 #-} rule681 = \ (_ :: ()) -> [] {-# INLINE rule682 #-} rule682 = \ (_ :: ()) -> [] {-# INLINE rule683 #-} rule683 = \ _copy -> _copy -- Sequence ---------------------------------------------------- -- wrapper data Inh_Sequence = Inh_Sequence { allNts_Inh_Sequence :: (Set NontermIdent), aroundMap_Inh_Sequence :: (Set Identifier), children_Inh_Sequence :: ([(Identifier,Type,ChildKind)]), con_Inh_Sequence :: (ConstructorIdent), declsAbove_Inh_Sequence :: ([Decl]), inh_Inh_Sequence :: (Attributes), instVisitNrs_Inh_Sequence :: (Map Identifier Int), lastExpr_Inh_Sequence :: (Expr), mergeMap_Inh_Sequence :: (Map Identifier (Identifier, [Identifier])), nr_Inh_Sequence :: (Int), nt_Inh_Sequence :: (NontermIdent), o_case_Inh_Sequence :: (Bool), o_cata_Inh_Sequence :: (Bool), o_clean_Inh_Sequence :: (Bool), o_costcentre_Inh_Sequence :: (Bool), o_data_Inh_Sequence :: (Maybe Bool), o_linePragmas_Inh_Sequence :: (Bool), o_monadic_Inh_Sequence :: (Bool), o_newtypes_Inh_Sequence :: (Bool), o_pretty_Inh_Sequence :: (Bool), o_rename_Inh_Sequence :: (Bool), o_sem_Inh_Sequence :: (Bool), o_sig_Inh_Sequence :: (Bool), o_splitsems_Inh_Sequence :: (Bool), o_strictwrap_Inh_Sequence :: (Bool), o_traces_Inh_Sequence :: (Bool), o_unbox_Inh_Sequence :: (Bool), options_Inh_Sequence :: (Options), paramInstMap_Inh_Sequence :: (Map Identifier (NontermIdent, [String])), paramMap_Inh_Sequence :: (ParamMap), prefix_Inh_Sequence :: (String), syn_Inh_Sequence :: (Attributes), terminals_Inh_Sequence :: ([Identifier]), unfoldSemDom_Inh_Sequence :: (NontermIdent -> Int -> [String] -> Code.Type), visitedSet_Inh_Sequence :: (Set Identifier), what_Inh_Sequence :: (String) } data Syn_Sequence = Syn_Sequence { allTpsFound_Syn_Sequence :: (Bool), blockDecls_Syn_Sequence :: (DeclBlocks), comments_Syn_Sequence :: ([String]), decls_Syn_Sequence :: (Decls), declsAbove_Syn_Sequence :: ([Decl]), definedInsts_Syn_Sequence :: ([Identifier]), exprs_Syn_Sequence :: (Exprs), tSigs_Syn_Sequence :: ([Decl]), tps_Syn_Sequence :: ([Type]), usedVars_Syn_Sequence :: (Set String), visitedSet_Syn_Sequence :: (Set Identifier) } {-# INLINABLE wrap_Sequence #-} wrap_Sequence :: T_Sequence -> Inh_Sequence -> (Syn_Sequence ) wrap_Sequence (T_Sequence act) (Inh_Sequence _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat) = Control.Monad.Identity.runIdentity ( do sem <- act let arg46 = T_Sequence_vIn46 _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat (T_Sequence_vOut46 _lhsOallTpsFound _lhsOblockDecls _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars _lhsOvisitedSet) <- return (inv_Sequence_s47 sem arg46) return (Syn_Sequence _lhsOallTpsFound _lhsOblockDecls _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars _lhsOvisitedSet) ) -- cata {-# NOINLINE sem_Sequence #-} sem_Sequence :: Sequence -> T_Sequence sem_Sequence list = Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list) -- semantic domain newtype T_Sequence = T_Sequence { attach_T_Sequence :: Identity (T_Sequence_s47 ) } newtype T_Sequence_s47 = C_Sequence_s47 { inv_Sequence_s47 :: (T_Sequence_v46 ) } data T_Sequence_s48 = C_Sequence_s48 type T_Sequence_v46 = (T_Sequence_vIn46 ) -> (T_Sequence_vOut46 ) data T_Sequence_vIn46 = T_Sequence_vIn46 (Set NontermIdent) (Set Identifier) ([(Identifier,Type,ChildKind)]) (ConstructorIdent) ([Decl]) (Attributes) (Map Identifier Int) (Expr) (Map Identifier (Identifier, [Identifier])) (Int) (NontermIdent) (Bool) (Bool) (Bool) (Bool) (Maybe Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (Map Identifier (NontermIdent, [String])) (ParamMap) (String) (Attributes) ([Identifier]) (NontermIdent -> Int -> [String] -> Code.Type) (Set Identifier) (String) data T_Sequence_vOut46 = T_Sequence_vOut46 (Bool) (DeclBlocks) ([String]) (Decls) ([Decl]) ([Identifier]) (Exprs) ([Decl]) ([Type]) (Set String) (Set Identifier) {-# NOINLINE sem_Sequence_Cons #-} sem_Sequence_Cons :: T_CRule -> T_Sequence -> T_Sequence sem_Sequence_Cons arg_hd_ arg_tl_ = T_Sequence (return st47) where {-# NOINLINE st47 #-} st47 = let v46 :: T_Sequence_v46 v46 = \ (T_Sequence_vIn46 _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat) -> ( let _hdX20 = Control.Monad.Identity.runIdentity (attach_T_CRule (arg_hd_)) _tlX47 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_tl_)) (T_CRule_vOut19 _hdIallTpsFound _hdIbldBlocksFun _hdIcomments _hdIdecls _hdIdeclsAbove _hdIdefinedInsts _hdIexprs _hdItSigs _hdItps _hdIusedVars _hdIvisitedSet) = inv_CRule_s20 _hdX20 (T_CRule_vIn19 _hdOallNts _hdOaroundMap _hdOchildren _hdOcon _hdOdeclsAbove _hdOinh _hdOinstVisitNrs _hdOmergeMap _hdOnr _hdOnt _hdOo_case _hdOo_cata _hdOo_clean _hdOo_costcentre _hdOo_data _hdOo_linePragmas _hdOo_monadic _hdOo_newtypes _hdOo_pretty _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_splitsems _hdOo_strictwrap _hdOo_traces _hdOo_unbox _hdOoptions _hdOparamInstMap _hdOparamMap _hdOprefix _hdOsyn _hdOterminals _hdOunfoldSemDom _hdOvisitedSet _hdOwhat) (T_Sequence_vOut46 _tlIallTpsFound _tlIblockDecls _tlIcomments _tlIdecls _tlIdeclsAbove _tlIdefinedInsts _tlIexprs _tlItSigs _tlItps _tlIusedVars _tlIvisitedSet) = inv_Sequence_s47 _tlX47 (T_Sequence_vIn46 _tlOallNts _tlOaroundMap _tlOchildren _tlOcon _tlOdeclsAbove _tlOinh _tlOinstVisitNrs _tlOlastExpr _tlOmergeMap _tlOnr _tlOnt _tlOo_case _tlOo_cata _tlOo_clean _tlOo_costcentre _tlOo_data _tlOo_linePragmas _tlOo_monadic _tlOo_newtypes _tlOo_pretty _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_splitsems _tlOo_strictwrap _tlOo_traces _tlOo_unbox _tlOoptions _tlOparamInstMap _tlOparamMap _tlOprefix _tlOsyn _tlOterminals _tlOunfoldSemDom _tlOvisitedSet _tlOwhat) _lhsOblockDecls :: DeclBlocks _lhsOblockDecls = rule684 _hdIbldBlocksFun _tlIblockDecls _lhsOallTpsFound :: Bool _lhsOallTpsFound = rule685 _hdIallTpsFound _tlIallTpsFound _lhsOcomments :: [String] _lhsOcomments = rule686 _hdIcomments _tlIcomments _lhsOdecls :: Decls _lhsOdecls = rule687 _hdIdecls _tlIdecls _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule688 _hdIdefinedInsts _tlIdefinedInsts _lhsOexprs :: Exprs _lhsOexprs = rule689 _hdIexprs _tlIexprs _lhsOtSigs :: [Decl] _lhsOtSigs = rule690 _hdItSigs _tlItSigs _lhsOtps :: [Type] _lhsOtps = rule691 _hdItps _tlItps _lhsOusedVars :: Set String _lhsOusedVars = rule692 _hdIusedVars _tlIusedVars _lhsOdeclsAbove :: [Decl] _lhsOdeclsAbove = rule693 _tlIdeclsAbove _lhsOvisitedSet :: Set Identifier _lhsOvisitedSet = rule694 _tlIvisitedSet _hdOallNts = rule695 _lhsIallNts _hdOaroundMap = rule696 _lhsIaroundMap _hdOchildren = rule697 _lhsIchildren _hdOcon = rule698 _lhsIcon _hdOdeclsAbove = rule699 _lhsIdeclsAbove _hdOinh = rule700 _lhsIinh _hdOinstVisitNrs = rule701 _lhsIinstVisitNrs _hdOmergeMap = rule702 _lhsImergeMap _hdOnr = rule703 _lhsInr _hdOnt = rule704 _lhsInt _hdOo_case = rule705 _lhsIo_case _hdOo_cata = rule706 _lhsIo_cata _hdOo_clean = rule707 _lhsIo_clean _hdOo_costcentre = rule708 _lhsIo_costcentre _hdOo_data = rule709 _lhsIo_data _hdOo_linePragmas = rule710 _lhsIo_linePragmas _hdOo_monadic = rule711 _lhsIo_monadic _hdOo_newtypes = rule712 _lhsIo_newtypes _hdOo_pretty = rule713 _lhsIo_pretty _hdOo_rename = rule714 _lhsIo_rename _hdOo_sem = rule715 _lhsIo_sem _hdOo_sig = rule716 _lhsIo_sig _hdOo_splitsems = rule717 _lhsIo_splitsems _hdOo_strictwrap = rule718 _lhsIo_strictwrap _hdOo_traces = rule719 _lhsIo_traces _hdOo_unbox = rule720 _lhsIo_unbox _hdOoptions = rule721 _lhsIoptions _hdOparamInstMap = rule722 _lhsIparamInstMap _hdOparamMap = rule723 _lhsIparamMap _hdOprefix = rule724 _lhsIprefix _hdOsyn = rule725 _lhsIsyn _hdOterminals = rule726 _lhsIterminals _hdOunfoldSemDom = rule727 _lhsIunfoldSemDom _hdOvisitedSet = rule728 _lhsIvisitedSet _hdOwhat = rule729 _lhsIwhat _tlOallNts = rule730 _lhsIallNts _tlOaroundMap = rule731 _lhsIaroundMap _tlOchildren = rule732 _lhsIchildren _tlOcon = rule733 _lhsIcon _tlOdeclsAbove = rule734 _hdIdeclsAbove _tlOinh = rule735 _lhsIinh _tlOinstVisitNrs = rule736 _lhsIinstVisitNrs _tlOlastExpr = rule737 _lhsIlastExpr _tlOmergeMap = rule738 _lhsImergeMap _tlOnr = rule739 _lhsInr _tlOnt = rule740 _lhsInt _tlOo_case = rule741 _lhsIo_case _tlOo_cata = rule742 _lhsIo_cata _tlOo_clean = rule743 _lhsIo_clean _tlOo_costcentre = rule744 _lhsIo_costcentre _tlOo_data = rule745 _lhsIo_data _tlOo_linePragmas = rule746 _lhsIo_linePragmas _tlOo_monadic = rule747 _lhsIo_monadic _tlOo_newtypes = rule748 _lhsIo_newtypes _tlOo_pretty = rule749 _lhsIo_pretty _tlOo_rename = rule750 _lhsIo_rename _tlOo_sem = rule751 _lhsIo_sem _tlOo_sig = rule752 _lhsIo_sig _tlOo_splitsems = rule753 _lhsIo_splitsems _tlOo_strictwrap = rule754 _lhsIo_strictwrap _tlOo_traces = rule755 _lhsIo_traces _tlOo_unbox = rule756 _lhsIo_unbox _tlOoptions = rule757 _lhsIoptions _tlOparamInstMap = rule758 _lhsIparamInstMap _tlOparamMap = rule759 _lhsIparamMap _tlOprefix = rule760 _lhsIprefix _tlOsyn = rule761 _lhsIsyn _tlOterminals = rule762 _lhsIterminals _tlOunfoldSemDom = rule763 _lhsIunfoldSemDom _tlOvisitedSet = rule764 _hdIvisitedSet _tlOwhat = rule765 _lhsIwhat __result_ = T_Sequence_vOut46 _lhsOallTpsFound _lhsOblockDecls _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars _lhsOvisitedSet in __result_ ) in C_Sequence_s47 v46 {-# INLINE rule684 #-} {-# LINE 627 "src-ag/GenerateCode.ag" #-} rule684 = \ ((_hdIbldBlocksFun) :: DeclBlocks -> DeclBlocks) ((_tlIblockDecls) :: DeclBlocks) -> {-# LINE 627 "src-ag/GenerateCode.ag" #-} _hdIbldBlocksFun _tlIblockDecls {-# LINE 4977 "dist/build/GenerateCode.hs"#-} {-# INLINE rule685 #-} rule685 = \ ((_hdIallTpsFound) :: Bool) ((_tlIallTpsFound) :: Bool) -> _hdIallTpsFound && _tlIallTpsFound {-# INLINE rule686 #-} rule686 = \ ((_hdIcomments) :: [String]) ((_tlIcomments) :: [String]) -> _hdIcomments ++ _tlIcomments {-# INLINE rule687 #-} rule687 = \ ((_hdIdecls) :: Decls) ((_tlIdecls) :: Decls) -> _hdIdecls ++ _tlIdecls {-# INLINE rule688 #-} rule688 = \ ((_hdIdefinedInsts) :: [Identifier]) ((_tlIdefinedInsts) :: [Identifier]) -> _hdIdefinedInsts ++ _tlIdefinedInsts {-# INLINE rule689 #-} rule689 = \ ((_hdIexprs) :: Exprs) ((_tlIexprs) :: Exprs) -> _hdIexprs ++ _tlIexprs {-# INLINE rule690 #-} rule690 = \ ((_hdItSigs) :: [Decl]) ((_tlItSigs) :: [Decl]) -> _hdItSigs ++ _tlItSigs {-# INLINE rule691 #-} rule691 = \ ((_hdItps) :: [Type]) ((_tlItps) :: [Type]) -> _hdItps ++ _tlItps {-# INLINE rule692 #-} rule692 = \ ((_hdIusedVars) :: Set String) ((_tlIusedVars) :: Set String) -> _hdIusedVars `Set.union` _tlIusedVars {-# INLINE rule693 #-} rule693 = \ ((_tlIdeclsAbove) :: [Decl]) -> _tlIdeclsAbove {-# INLINE rule694 #-} rule694 = \ ((_tlIvisitedSet) :: Set Identifier) -> _tlIvisitedSet {-# INLINE rule695 #-} rule695 = \ ((_lhsIallNts) :: Set NontermIdent) -> _lhsIallNts {-# INLINE rule696 #-} rule696 = \ ((_lhsIaroundMap) :: Set Identifier) -> _lhsIaroundMap {-# INLINE rule697 #-} rule697 = \ ((_lhsIchildren) :: [(Identifier,Type,ChildKind)]) -> _lhsIchildren {-# INLINE rule698 #-} rule698 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule699 #-} rule699 = \ ((_lhsIdeclsAbove) :: [Decl]) -> _lhsIdeclsAbove {-# INLINE rule700 #-} rule700 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule701 #-} rule701 = \ ((_lhsIinstVisitNrs) :: Map Identifier Int) -> _lhsIinstVisitNrs {-# INLINE rule702 #-} rule702 = \ ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier])) -> _lhsImergeMap {-# INLINE rule703 #-} rule703 = \ ((_lhsInr) :: Int) -> _lhsInr {-# INLINE rule704 #-} rule704 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule705 #-} rule705 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule706 #-} rule706 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule707 #-} rule707 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule708 #-} rule708 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule709 #-} rule709 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule710 #-} rule710 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule711 #-} rule711 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule712 #-} rule712 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule713 #-} rule713 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule714 #-} rule714 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule715 #-} rule715 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule716 #-} rule716 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule717 #-} rule717 = \ ((_lhsIo_splitsems) :: Bool) -> _lhsIo_splitsems {-# INLINE rule718 #-} rule718 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule719 #-} rule719 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule720 #-} rule720 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule721 #-} rule721 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule722 #-} rule722 = \ ((_lhsIparamInstMap) :: Map Identifier (NontermIdent, [String])) -> _lhsIparamInstMap {-# INLINE rule723 #-} rule723 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule724 #-} rule724 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule725 #-} rule725 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule726 #-} rule726 = \ ((_lhsIterminals) :: [Identifier]) -> _lhsIterminals {-# INLINE rule727 #-} rule727 = \ ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) -> _lhsIunfoldSemDom {-# INLINE rule728 #-} rule728 = \ ((_lhsIvisitedSet) :: Set Identifier) -> _lhsIvisitedSet {-# INLINE rule729 #-} rule729 = \ ((_lhsIwhat) :: String) -> _lhsIwhat {-# INLINE rule730 #-} rule730 = \ ((_lhsIallNts) :: Set NontermIdent) -> _lhsIallNts {-# INLINE rule731 #-} rule731 = \ ((_lhsIaroundMap) :: Set Identifier) -> _lhsIaroundMap {-# INLINE rule732 #-} rule732 = \ ((_lhsIchildren) :: [(Identifier,Type,ChildKind)]) -> _lhsIchildren {-# INLINE rule733 #-} rule733 = \ ((_lhsIcon) :: ConstructorIdent) -> _lhsIcon {-# INLINE rule734 #-} rule734 = \ ((_hdIdeclsAbove) :: [Decl]) -> _hdIdeclsAbove {-# INLINE rule735 #-} rule735 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule736 #-} rule736 = \ ((_lhsIinstVisitNrs) :: Map Identifier Int) -> _lhsIinstVisitNrs {-# INLINE rule737 #-} rule737 = \ ((_lhsIlastExpr) :: Expr) -> _lhsIlastExpr {-# INLINE rule738 #-} rule738 = \ ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier])) -> _lhsImergeMap {-# INLINE rule739 #-} rule739 = \ ((_lhsInr) :: Int) -> _lhsInr {-# INLINE rule740 #-} rule740 = \ ((_lhsInt) :: NontermIdent) -> _lhsInt {-# INLINE rule741 #-} rule741 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule742 #-} rule742 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule743 #-} rule743 = \ ((_lhsIo_clean) :: Bool) -> _lhsIo_clean {-# INLINE rule744 #-} rule744 = \ ((_lhsIo_costcentre) :: Bool) -> _lhsIo_costcentre {-# INLINE rule745 #-} rule745 = \ ((_lhsIo_data) :: Maybe Bool) -> _lhsIo_data {-# INLINE rule746 #-} rule746 = \ ((_lhsIo_linePragmas) :: Bool) -> _lhsIo_linePragmas {-# INLINE rule747 #-} rule747 = \ ((_lhsIo_monadic) :: Bool) -> _lhsIo_monadic {-# INLINE rule748 #-} rule748 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule749 #-} rule749 = \ ((_lhsIo_pretty) :: Bool) -> _lhsIo_pretty {-# INLINE rule750 #-} rule750 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule751 #-} rule751 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule752 #-} rule752 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule753 #-} rule753 = \ ((_lhsIo_splitsems) :: Bool) -> _lhsIo_splitsems {-# INLINE rule754 #-} rule754 = \ ((_lhsIo_strictwrap) :: Bool) -> _lhsIo_strictwrap {-# INLINE rule755 #-} rule755 = \ ((_lhsIo_traces) :: Bool) -> _lhsIo_traces {-# INLINE rule756 #-} rule756 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule757 #-} rule757 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule758 #-} rule758 = \ ((_lhsIparamInstMap) :: Map Identifier (NontermIdent, [String])) -> _lhsIparamInstMap {-# INLINE rule759 #-} rule759 = \ ((_lhsIparamMap) :: ParamMap) -> _lhsIparamMap {-# INLINE rule760 #-} rule760 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule761 #-} rule761 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule762 #-} rule762 = \ ((_lhsIterminals) :: [Identifier]) -> _lhsIterminals {-# INLINE rule763 #-} rule763 = \ ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) -> _lhsIunfoldSemDom {-# INLINE rule764 #-} rule764 = \ ((_hdIvisitedSet) :: Set Identifier) -> _hdIvisitedSet {-# INLINE rule765 #-} rule765 = \ ((_lhsIwhat) :: String) -> _lhsIwhat {-# NOINLINE sem_Sequence_Nil #-} sem_Sequence_Nil :: T_Sequence sem_Sequence_Nil = T_Sequence (return st47) where {-# NOINLINE st47 #-} st47 = let v46 :: T_Sequence_v46 v46 = \ (T_Sequence_vIn46 _lhsIallNts _lhsIaroundMap _lhsIchildren _lhsIcon _lhsIdeclsAbove _lhsIinh _lhsIinstVisitNrs _lhsIlastExpr _lhsImergeMap _lhsInr _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_clean _lhsIo_costcentre _lhsIo_data _lhsIo_linePragmas _lhsIo_monadic _lhsIo_newtypes _lhsIo_pretty _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_splitsems _lhsIo_strictwrap _lhsIo_traces _lhsIo_unbox _lhsIoptions _lhsIparamInstMap _lhsIparamMap _lhsIprefix _lhsIsyn _lhsIterminals _lhsIunfoldSemDom _lhsIvisitedSet _lhsIwhat) -> ( let _lhsOblockDecls :: DeclBlocks _lhsOblockDecls = rule766 _lhsIdeclsAbove _lhsIlastExpr _lhsOallTpsFound :: Bool _lhsOallTpsFound = rule767 () _lhsOcomments :: [String] _lhsOcomments = rule768 () _lhsOdecls :: Decls _lhsOdecls = rule769 () _lhsOdefinedInsts :: [Identifier] _lhsOdefinedInsts = rule770 () _lhsOexprs :: Exprs _lhsOexprs = rule771 () _lhsOtSigs :: [Decl] _lhsOtSigs = rule772 () _lhsOtps :: [Type] _lhsOtps = rule773 () _lhsOusedVars :: Set String _lhsOusedVars = rule774 () _lhsOdeclsAbove :: [Decl] _lhsOdeclsAbove = rule775 _lhsIdeclsAbove _lhsOvisitedSet :: Set Identifier _lhsOvisitedSet = rule776 _lhsIvisitedSet __result_ = T_Sequence_vOut46 _lhsOallTpsFound _lhsOblockDecls _lhsOcomments _lhsOdecls _lhsOdeclsAbove _lhsOdefinedInsts _lhsOexprs _lhsOtSigs _lhsOtps _lhsOusedVars _lhsOvisitedSet in __result_ ) in C_Sequence_s47 v46 {-# INLINE rule766 #-} {-# LINE 629 "src-ag/GenerateCode.ag" #-} rule766 = \ ((_lhsIdeclsAbove) :: [Decl]) ((_lhsIlastExpr) :: Expr) -> {-# LINE 629 "src-ag/GenerateCode.ag" #-} DeclTerminator _lhsIdeclsAbove _lhsIlastExpr {-# LINE 5258 "dist/build/GenerateCode.hs"#-} {-# INLINE rule767 #-} rule767 = \ (_ :: ()) -> True {-# INLINE rule768 #-} rule768 = \ (_ :: ()) -> [] {-# INLINE rule769 #-} rule769 = \ (_ :: ()) -> [] {-# INLINE rule770 #-} rule770 = \ (_ :: ()) -> [] {-# INLINE rule771 #-} rule771 = \ (_ :: ()) -> [] {-# INLINE rule772 #-} rule772 = \ (_ :: ()) -> [] {-# INLINE rule773 #-} rule773 = \ (_ :: ()) -> [] {-# INLINE rule774 #-} rule774 = \ (_ :: ()) -> Set.empty {-# INLINE rule775 #-} rule775 = \ ((_lhsIdeclsAbove) :: [Decl]) -> _lhsIdeclsAbove {-# INLINE rule776 #-} rule776 = \ ((_lhsIvisitedSet) :: Set Identifier) -> _lhsIvisitedSet uuagc-0.9.52.2/src-generated/Interfaces.hs0000644000000000000000000000266213433540502016410 0ustar0000000000000000 -- UUAGC 0.9.51 (src-ag/Interfaces.ag) module Interfaces where {-# LINE 2 "src-ag/Interfaces.ag" #-} import CommonTypes import SequentialTypes {-# LINE 10 "dist/build/Interfaces.hs" #-} -- IRoot ------------------------------------------------------- {- alternatives: alternative IRoot: child inters : Interfaces -} data IRoot = IRoot (Interfaces) -- Interface --------------------------------------------------- {- alternatives: alternative Interface: child nt : {NontermIdent} child cons : {[ConstructorIdent]} child seg : Segments -} data Interface = Interface (NontermIdent) (([ConstructorIdent])) (Segments) -- Interfaces -------------------------------------------------- {- alternatives: alternative Cons: child hd : Interface child tl : Interfaces alternative Nil: -} type Interfaces = [Interface] -- Segment ----------------------------------------------------- {- alternatives: alternative Segment: child inh : {[Vertex]} child syn : {[Vertex]} -} data Segment = Segment (([Vertex])) (([Vertex])) -- Segments ---------------------------------------------------- {- alternatives: alternative Cons: child hd : Segment child tl : Segments alternative Nil: -} type Segments = [Segment]uuagc-0.9.52.2/src-generated/Visage.hs0000644000000000000000000013034613433540502015544 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module Visage where {-# LINE 2 "src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken {-# LINE 10 "dist/build/Visage.hs" #-} {-# LINE 2 "src-ag/VisagePatterns.ag" #-} import UU.Scanner.Position(Pos) import CommonTypes {-# LINE 16 "dist/build/Visage.hs" #-} {-# LINE 2 "src-ag/VisageSyntax.ag" #-} import CommonTypes import UU.Pretty import AbstractSyntax import VisagePatterns import Expression {-# LINE 25 "dist/build/Visage.hs" #-} {-# LINE 6 "src-ag/Visage.ag" #-} import UU.Scanner.Position(Pos(..)) import CommonTypes import ATermAbstractSyntax import Expression import VisagePatterns import VisageSyntax import qualified Data.Map as Map import Data.Map(Map) import Data.List(intersperse) import TokenDef {-# LINE 39 "dist/build/Visage.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 19 "src-ag/Visage.ag" #-} convert :: String -> String convert [] = [] convert (c:ct) | c == '\n' = '\\' : 'n' : convert ct | otherwise = c : convert ct sQ :: String -> String sQ [] = [] sQ (x:xs) = if (x=='"') then rest else x:rest where rest = if not (null xs) && last xs == '"' then init xs else xs showAGPos :: Pos -> String showAGPos (Pos l c f) | l == (-1) = "" | otherwise = let file = if null f then "" else f -- No show of f lc = "(line " ++ show l ++ ", column " ++ show c ++")" in file ++ lc showMap :: (Show a, Show b) => Map a b -> String showMap = braces . concat . intersperse "," . map (uncurry assign) . Map.assocs where braces s = "{" ++ s ++ "}" assign a b = show a ++ ":=" ++ show b {-# LINE 67 "dist/build/Visage.hs" #-} -- Expression -------------------------------------------------- -- wrapper data Inh_Expression = Inh_Expression { } data Syn_Expression = Syn_Expression { aterm_Syn_Expression :: (ATerm) } {-# INLINABLE wrap_Expression #-} wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) wrap_Expression (T_Expression act) (Inh_Expression ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_Expression_vIn1 (T_Expression_vOut1 _lhsOaterm) <- return (inv_Expression_s2 sem arg1) return (Syn_Expression _lhsOaterm) ) -- cata {-# INLINE sem_Expression #-} sem_Expression :: Expression -> T_Expression sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_ -- semantic domain newtype T_Expression = T_Expression { attach_T_Expression :: Identity (T_Expression_s2 ) } newtype T_Expression_s2 = C_Expression_s2 { inv_Expression_s2 :: (T_Expression_v1 ) } data T_Expression_s3 = C_Expression_s3 type T_Expression_v1 = (T_Expression_vIn1 ) -> (T_Expression_vOut1 ) data T_Expression_vIn1 = T_Expression_vIn1 data T_Expression_vOut1 = T_Expression_vOut1 (ATerm) {-# NOINLINE sem_Expression_Expression #-} sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression sem_Expression_Expression arg_pos_ arg_tks_ = T_Expression (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Expression_v1 v1 = \ (T_Expression_vIn1 ) -> ( let _lhsOaterm :: ATerm _lhsOaterm = rule0 arg_pos_ arg_tks_ __result_ = T_Expression_vOut1 _lhsOaterm in __result_ ) in C_Expression_s2 v1 {-# INLINE rule0 #-} {-# LINE 103 "src-ag/Visage.ag" #-} rule0 = \ pos_ tks_ -> {-# LINE 103 "src-ag/Visage.ag" #-} AAppl "Expression" [AString (sQ (showAGPos pos_)), AString (sQ (unlines . showTokens . tokensToStrings $ tks_))] {-# LINE 115 "dist/build/Visage.hs"#-} -- VisageChild ------------------------------------------------- -- wrapper data Inh_VisageChild = Inh_VisageChild { } data Syn_VisageChild = Syn_VisageChild { aterm_Syn_VisageChild :: (ATerm) } {-# INLINABLE wrap_VisageChild #-} wrap_VisageChild :: T_VisageChild -> Inh_VisageChild -> (Syn_VisageChild ) wrap_VisageChild (T_VisageChild act) (Inh_VisageChild ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_VisageChild_vIn4 (T_VisageChild_vOut4 _lhsOaterm) <- return (inv_VisageChild_s5 sem arg4) return (Syn_VisageChild _lhsOaterm) ) -- cata {-# INLINE sem_VisageChild #-} sem_VisageChild :: VisageChild -> T_VisageChild sem_VisageChild ( VChild name_ tp_ inh_ syn_ rules_ ) = sem_VisageChild_VChild name_ tp_ inh_ syn_ ( sem_VisageRules rules_ ) -- semantic domain newtype T_VisageChild = T_VisageChild { attach_T_VisageChild :: Identity (T_VisageChild_s5 ) } newtype T_VisageChild_s5 = C_VisageChild_s5 { inv_VisageChild_s5 :: (T_VisageChild_v4 ) } data T_VisageChild_s6 = C_VisageChild_s6 type T_VisageChild_v4 = (T_VisageChild_vIn4 ) -> (T_VisageChild_vOut4 ) data T_VisageChild_vIn4 = T_VisageChild_vIn4 data T_VisageChild_vOut4 = T_VisageChild_vOut4 (ATerm) {-# NOINLINE sem_VisageChild_VChild #-} sem_VisageChild_VChild :: (Identifier) -> (Type) -> (Attributes) -> (Attributes) -> T_VisageRules -> T_VisageChild sem_VisageChild_VChild arg_name_ arg_tp_ arg_inh_ arg_syn_ arg_rules_ = T_VisageChild (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_VisageChild_v4 v4 = \ (T_VisageChild_vIn4 ) -> ( let _rulesX35 = Control.Monad.Identity.runIdentity (attach_T_VisageRules (arg_rules_)) (T_VisageRules_vOut34 _rulesIaterms) = inv_VisageRules_s35 _rulesX35 (T_VisageRules_vIn34 _rulesOisLoc) _lhsOaterm :: ATerm _lhsOaterm = rule1 _rulesIaterms arg_inh_ arg_name_ arg_syn_ arg_tp_ _rulesOisLoc = rule2 () __result_ = T_VisageChild_vOut4 _lhsOaterm in __result_ ) in C_VisageChild_s5 v4 {-# INLINE rule1 #-} {-# LINE 85 "src-ag/Visage.ag" #-} rule1 = \ ((_rulesIaterms) :: [ATerm]) inh_ name_ syn_ tp_ -> {-# LINE 85 "src-ag/Visage.ag" #-} AAppl "Child" [AString (sQ (getName name_)), AString (sQ (show tp_)), AString (sQ (showMap inh_)), AString (sQ (showMap syn_)), AAppl "Rules" _rulesIaterms] {-# LINE 170 "dist/build/Visage.hs"#-} {-# INLINE rule2 #-} {-# LINE 89 "src-ag/Visage.ag" #-} rule2 = \ (_ :: ()) -> {-# LINE 89 "src-ag/Visage.ag" #-} False {-# LINE 176 "dist/build/Visage.hs"#-} -- VisageChildren ---------------------------------------------- -- wrapper data Inh_VisageChildren = Inh_VisageChildren { } data Syn_VisageChildren = Syn_VisageChildren { aterms_Syn_VisageChildren :: ([ATerm]) } {-# INLINABLE wrap_VisageChildren #-} wrap_VisageChildren :: T_VisageChildren -> Inh_VisageChildren -> (Syn_VisageChildren ) wrap_VisageChildren (T_VisageChildren act) (Inh_VisageChildren ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_VisageChildren_vIn7 (T_VisageChildren_vOut7 _lhsOaterms) <- return (inv_VisageChildren_s8 sem arg7) return (Syn_VisageChildren _lhsOaterms) ) -- cata {-# NOINLINE sem_VisageChildren #-} sem_VisageChildren :: VisageChildren -> T_VisageChildren sem_VisageChildren list = Prelude.foldr sem_VisageChildren_Cons sem_VisageChildren_Nil (Prelude.map sem_VisageChild list) -- semantic domain newtype T_VisageChildren = T_VisageChildren { attach_T_VisageChildren :: Identity (T_VisageChildren_s8 ) } newtype T_VisageChildren_s8 = C_VisageChildren_s8 { inv_VisageChildren_s8 :: (T_VisageChildren_v7 ) } data T_VisageChildren_s9 = C_VisageChildren_s9 type T_VisageChildren_v7 = (T_VisageChildren_vIn7 ) -> (T_VisageChildren_vOut7 ) data T_VisageChildren_vIn7 = T_VisageChildren_vIn7 data T_VisageChildren_vOut7 = T_VisageChildren_vOut7 ([ATerm]) {-# NOINLINE sem_VisageChildren_Cons #-} sem_VisageChildren_Cons :: T_VisageChild -> T_VisageChildren -> T_VisageChildren sem_VisageChildren_Cons arg_hd_ arg_tl_ = T_VisageChildren (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_VisageChildren_v7 v7 = \ (T_VisageChildren_vIn7 ) -> ( let _hdX5 = Control.Monad.Identity.runIdentity (attach_T_VisageChild (arg_hd_)) _tlX8 = Control.Monad.Identity.runIdentity (attach_T_VisageChildren (arg_tl_)) (T_VisageChild_vOut4 _hdIaterm) = inv_VisageChild_s5 _hdX5 (T_VisageChild_vIn4 ) (T_VisageChildren_vOut7 _tlIaterms) = inv_VisageChildren_s8 _tlX8 (T_VisageChildren_vIn7 ) _lhsOaterms :: [ATerm] _lhsOaterms = rule3 _hdIaterm _tlIaterms __result_ = T_VisageChildren_vOut7 _lhsOaterms in __result_ ) in C_VisageChildren_s8 v7 {-# INLINE rule3 #-} {-# LINE 80 "src-ag/Visage.ag" #-} rule3 = \ ((_hdIaterm) :: ATerm) ((_tlIaterms) :: [ATerm]) -> {-# LINE 80 "src-ag/Visage.ag" #-} _hdIaterm : _tlIaterms {-# LINE 229 "dist/build/Visage.hs"#-} {-# NOINLINE sem_VisageChildren_Nil #-} sem_VisageChildren_Nil :: T_VisageChildren sem_VisageChildren_Nil = T_VisageChildren (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_VisageChildren_v7 v7 = \ (T_VisageChildren_vIn7 ) -> ( let _lhsOaterms :: [ATerm] _lhsOaterms = rule4 () __result_ = T_VisageChildren_vOut7 _lhsOaterms in __result_ ) in C_VisageChildren_s8 v7 {-# INLINE rule4 #-} {-# LINE 81 "src-ag/Visage.ag" #-} rule4 = \ (_ :: ()) -> {-# LINE 81 "src-ag/Visage.ag" #-} [] {-# LINE 247 "dist/build/Visage.hs"#-} -- VisageGrammar ----------------------------------------------- -- wrapper data Inh_VisageGrammar = Inh_VisageGrammar { } data Syn_VisageGrammar = Syn_VisageGrammar { aterm_Syn_VisageGrammar :: (ATerm) } {-# INLINABLE wrap_VisageGrammar #-} wrap_VisageGrammar :: T_VisageGrammar -> Inh_VisageGrammar -> (Syn_VisageGrammar ) wrap_VisageGrammar (T_VisageGrammar act) (Inh_VisageGrammar ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg10 = T_VisageGrammar_vIn10 (T_VisageGrammar_vOut10 _lhsOaterm) <- return (inv_VisageGrammar_s11 sem arg10) return (Syn_VisageGrammar _lhsOaterm) ) -- cata {-# INLINE sem_VisageGrammar #-} sem_VisageGrammar :: VisageGrammar -> T_VisageGrammar sem_VisageGrammar ( VGrammar nonts_ ) = sem_VisageGrammar_VGrammar ( sem_VisageNonterminals nonts_ ) -- semantic domain newtype T_VisageGrammar = T_VisageGrammar { attach_T_VisageGrammar :: Identity (T_VisageGrammar_s11 ) } newtype T_VisageGrammar_s11 = C_VisageGrammar_s11 { inv_VisageGrammar_s11 :: (T_VisageGrammar_v10 ) } data T_VisageGrammar_s12 = C_VisageGrammar_s12 type T_VisageGrammar_v10 = (T_VisageGrammar_vIn10 ) -> (T_VisageGrammar_vOut10 ) data T_VisageGrammar_vIn10 = T_VisageGrammar_vIn10 data T_VisageGrammar_vOut10 = T_VisageGrammar_vOut10 (ATerm) {-# NOINLINE sem_VisageGrammar_VGrammar #-} sem_VisageGrammar_VGrammar :: T_VisageNonterminals -> T_VisageGrammar sem_VisageGrammar_VGrammar arg_nonts_ = T_VisageGrammar (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_VisageGrammar_v10 v10 = \ (T_VisageGrammar_vIn10 ) -> ( let _nontsX17 = Control.Monad.Identity.runIdentity (attach_T_VisageNonterminals (arg_nonts_)) (T_VisageNonterminals_vOut16 _nontsIaterms) = inv_VisageNonterminals_s17 _nontsX17 (T_VisageNonterminals_vIn16 ) _lhsOaterm :: ATerm _lhsOaterm = rule5 _nontsIaterms __result_ = T_VisageGrammar_vOut10 _lhsOaterm in __result_ ) in C_VisageGrammar_s11 v10 {-# INLINE rule5 #-} {-# LINE 54 "src-ag/Visage.ag" #-} rule5 = \ ((_nontsIaterms) :: [ATerm]) -> {-# LINE 54 "src-ag/Visage.ag" #-} AAppl "Productions" _nontsIaterms {-# LINE 298 "dist/build/Visage.hs"#-} -- VisageNonterminal ------------------------------------------- -- wrapper data Inh_VisageNonterminal = Inh_VisageNonterminal { } data Syn_VisageNonterminal = Syn_VisageNonterminal { aterm_Syn_VisageNonterminal :: (ATerm) } {-# INLINABLE wrap_VisageNonterminal #-} wrap_VisageNonterminal :: T_VisageNonterminal -> Inh_VisageNonterminal -> (Syn_VisageNonterminal ) wrap_VisageNonterminal (T_VisageNonterminal act) (Inh_VisageNonterminal ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg13 = T_VisageNonterminal_vIn13 (T_VisageNonterminal_vOut13 _lhsOaterm) <- return (inv_VisageNonterminal_s14 sem arg13) return (Syn_VisageNonterminal _lhsOaterm) ) -- cata {-# INLINE sem_VisageNonterminal #-} sem_VisageNonterminal :: VisageNonterminal -> T_VisageNonterminal sem_VisageNonterminal ( VNonterminal nt_ inh_ syn_ alts_ ) = sem_VisageNonterminal_VNonterminal nt_ inh_ syn_ ( sem_VisageProductions alts_ ) -- semantic domain newtype T_VisageNonterminal = T_VisageNonterminal { attach_T_VisageNonterminal :: Identity (T_VisageNonterminal_s14 ) } newtype T_VisageNonterminal_s14 = C_VisageNonterminal_s14 { inv_VisageNonterminal_s14 :: (T_VisageNonterminal_v13 ) } data T_VisageNonterminal_s15 = C_VisageNonterminal_s15 type T_VisageNonterminal_v13 = (T_VisageNonterminal_vIn13 ) -> (T_VisageNonterminal_vOut13 ) data T_VisageNonterminal_vIn13 = T_VisageNonterminal_vIn13 data T_VisageNonterminal_vOut13 = T_VisageNonterminal_vOut13 (ATerm) {-# NOINLINE sem_VisageNonterminal_VNonterminal #-} sem_VisageNonterminal_VNonterminal :: (NontermIdent) -> (Attributes) -> (Attributes) -> T_VisageProductions -> T_VisageNonterminal sem_VisageNonterminal_VNonterminal arg_nt_ arg_inh_ arg_syn_ arg_alts_ = T_VisageNonterminal (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_VisageNonterminal_v13 v13 = \ (T_VisageNonterminal_vIn13 ) -> ( let _altsX29 = Control.Monad.Identity.runIdentity (attach_T_VisageProductions (arg_alts_)) (T_VisageProductions_vOut28 _altsIaterms) = inv_VisageProductions_s29 _altsX29 (T_VisageProductions_vIn28 ) _lhsOaterm :: ATerm _lhsOaterm = rule6 _altsIaterms arg_inh_ arg_nt_ arg_syn_ __result_ = T_VisageNonterminal_vOut13 _lhsOaterm in __result_ ) in C_VisageNonterminal_s14 v13 {-# INLINE rule6 #-} {-# LINE 63 "src-ag/Visage.ag" #-} rule6 = \ ((_altsIaterms) :: [ATerm]) inh_ nt_ syn_ -> {-# LINE 63 "src-ag/Visage.ag" #-} AAppl "Production" [AString (sQ (getName nt_)), AString (sQ(showMap inh_)), AString (sQ(showMap syn_)), AAppl "Alternatives" _altsIaterms] {-# LINE 350 "dist/build/Visage.hs"#-} -- VisageNonterminals ------------------------------------------ -- wrapper data Inh_VisageNonterminals = Inh_VisageNonterminals { } data Syn_VisageNonterminals = Syn_VisageNonterminals { aterms_Syn_VisageNonterminals :: ([ATerm]) } {-# INLINABLE wrap_VisageNonterminals #-} wrap_VisageNonterminals :: T_VisageNonterminals -> Inh_VisageNonterminals -> (Syn_VisageNonterminals ) wrap_VisageNonterminals (T_VisageNonterminals act) (Inh_VisageNonterminals ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg16 = T_VisageNonterminals_vIn16 (T_VisageNonterminals_vOut16 _lhsOaterms) <- return (inv_VisageNonterminals_s17 sem arg16) return (Syn_VisageNonterminals _lhsOaterms) ) -- cata {-# NOINLINE sem_VisageNonterminals #-} sem_VisageNonterminals :: VisageNonterminals -> T_VisageNonterminals sem_VisageNonterminals list = Prelude.foldr sem_VisageNonterminals_Cons sem_VisageNonterminals_Nil (Prelude.map sem_VisageNonterminal list) -- semantic domain newtype T_VisageNonterminals = T_VisageNonterminals { attach_T_VisageNonterminals :: Identity (T_VisageNonterminals_s17 ) } newtype T_VisageNonterminals_s17 = C_VisageNonterminals_s17 { inv_VisageNonterminals_s17 :: (T_VisageNonterminals_v16 ) } data T_VisageNonterminals_s18 = C_VisageNonterminals_s18 type T_VisageNonterminals_v16 = (T_VisageNonterminals_vIn16 ) -> (T_VisageNonterminals_vOut16 ) data T_VisageNonterminals_vIn16 = T_VisageNonterminals_vIn16 data T_VisageNonterminals_vOut16 = T_VisageNonterminals_vOut16 ([ATerm]) {-# NOINLINE sem_VisageNonterminals_Cons #-} sem_VisageNonterminals_Cons :: T_VisageNonterminal -> T_VisageNonterminals -> T_VisageNonterminals sem_VisageNonterminals_Cons arg_hd_ arg_tl_ = T_VisageNonterminals (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_VisageNonterminals_v16 v16 = \ (T_VisageNonterminals_vIn16 ) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_VisageNonterminal (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_VisageNonterminals (arg_tl_)) (T_VisageNonterminal_vOut13 _hdIaterm) = inv_VisageNonterminal_s14 _hdX14 (T_VisageNonterminal_vIn13 ) (T_VisageNonterminals_vOut16 _tlIaterms) = inv_VisageNonterminals_s17 _tlX17 (T_VisageNonterminals_vIn16 ) _lhsOaterms :: [ATerm] _lhsOaterms = rule7 _hdIaterm _tlIaterms __result_ = T_VisageNonterminals_vOut16 _lhsOaterms in __result_ ) in C_VisageNonterminals_s17 v16 {-# INLINE rule7 #-} {-# LINE 58 "src-ag/Visage.ag" #-} rule7 = \ ((_hdIaterm) :: ATerm) ((_tlIaterms) :: [ATerm]) -> {-# LINE 58 "src-ag/Visage.ag" #-} _hdIaterm : _tlIaterms {-# LINE 403 "dist/build/Visage.hs"#-} {-# NOINLINE sem_VisageNonterminals_Nil #-} sem_VisageNonterminals_Nil :: T_VisageNonterminals sem_VisageNonterminals_Nil = T_VisageNonterminals (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_VisageNonterminals_v16 v16 = \ (T_VisageNonterminals_vIn16 ) -> ( let _lhsOaterms :: [ATerm] _lhsOaterms = rule8 () __result_ = T_VisageNonterminals_vOut16 _lhsOaterms in __result_ ) in C_VisageNonterminals_s17 v16 {-# INLINE rule8 #-} {-# LINE 59 "src-ag/Visage.ag" #-} rule8 = \ (_ :: ()) -> {-# LINE 59 "src-ag/Visage.ag" #-} [] {-# LINE 421 "dist/build/Visage.hs"#-} -- VisagePattern ----------------------------------------------- -- wrapper data Inh_VisagePattern = Inh_VisagePattern { } data Syn_VisagePattern = Syn_VisagePattern { aterm_Syn_VisagePattern :: (ATerm) } {-# INLINABLE wrap_VisagePattern #-} wrap_VisagePattern :: T_VisagePattern -> Inh_VisagePattern -> (Syn_VisagePattern ) wrap_VisagePattern (T_VisagePattern act) (Inh_VisagePattern ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg19 = T_VisagePattern_vIn19 (T_VisagePattern_vOut19 _lhsOaterm) <- return (inv_VisagePattern_s20 sem arg19) return (Syn_VisagePattern _lhsOaterm) ) -- cata {-# NOINLINE sem_VisagePattern #-} sem_VisagePattern :: VisagePattern -> T_VisagePattern sem_VisagePattern ( VConstr name_ pats_ ) = sem_VisagePattern_VConstr name_ ( sem_VisagePatterns pats_ ) sem_VisagePattern ( VProduct pos_ pats_ ) = sem_VisagePattern_VProduct pos_ ( sem_VisagePatterns pats_ ) sem_VisagePattern ( VVar field_ attr_ ) = sem_VisagePattern_VVar field_ attr_ sem_VisagePattern ( VAlias field_ attr_ pat_ ) = sem_VisagePattern_VAlias field_ attr_ ( sem_VisagePattern pat_ ) sem_VisagePattern ( VUnderscore pos_ ) = sem_VisagePattern_VUnderscore pos_ -- semantic domain newtype T_VisagePattern = T_VisagePattern { attach_T_VisagePattern :: Identity (T_VisagePattern_s20 ) } newtype T_VisagePattern_s20 = C_VisagePattern_s20 { inv_VisagePattern_s20 :: (T_VisagePattern_v19 ) } data T_VisagePattern_s21 = C_VisagePattern_s21 type T_VisagePattern_v19 = (T_VisagePattern_vIn19 ) -> (T_VisagePattern_vOut19 ) data T_VisagePattern_vIn19 = T_VisagePattern_vIn19 data T_VisagePattern_vOut19 = T_VisagePattern_vOut19 (ATerm) {-# NOINLINE sem_VisagePattern_VConstr #-} sem_VisagePattern_VConstr :: (ConstructorIdent) -> T_VisagePatterns -> T_VisagePattern sem_VisagePattern_VConstr arg_name_ arg_pats_ = T_VisagePattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_VisagePattern_v19 v19 = \ (T_VisagePattern_vIn19 ) -> ( let _patsX23 = Control.Monad.Identity.runIdentity (attach_T_VisagePatterns (arg_pats_)) (T_VisagePatterns_vOut22 _patsIaterms) = inv_VisagePatterns_s23 _patsX23 (T_VisagePatterns_vIn22 ) _lhsOaterm :: ATerm _lhsOaterm = rule9 _patsIaterms arg_name_ __result_ = T_VisagePattern_vOut19 _lhsOaterm in __result_ ) in C_VisagePattern_s20 v19 {-# INLINE rule9 #-} {-# LINE 112 "src-ag/Visage.ag" #-} rule9 = \ ((_patsIaterms) :: [ATerm]) name_ -> {-# LINE 112 "src-ag/Visage.ag" #-} AAppl "Pattern" [AAppl "Constr" [AString (sQ (showAGPos (getPos name_))), AString (sQ (getName name_)), AAppl "Patterns" _patsIaterms]] {-# LINE 478 "dist/build/Visage.hs"#-} {-# NOINLINE sem_VisagePattern_VProduct #-} sem_VisagePattern_VProduct :: (Pos) -> T_VisagePatterns -> T_VisagePattern sem_VisagePattern_VProduct arg_pos_ arg_pats_ = T_VisagePattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_VisagePattern_v19 v19 = \ (T_VisagePattern_vIn19 ) -> ( let _patsX23 = Control.Monad.Identity.runIdentity (attach_T_VisagePatterns (arg_pats_)) (T_VisagePatterns_vOut22 _patsIaterms) = inv_VisagePatterns_s23 _patsX23 (T_VisagePatterns_vIn22 ) _lhsOaterm :: ATerm _lhsOaterm = rule10 _patsIaterms arg_pos_ __result_ = T_VisagePattern_vOut19 _lhsOaterm in __result_ ) in C_VisagePattern_s20 v19 {-# INLINE rule10 #-} {-# LINE 115 "src-ag/Visage.ag" #-} rule10 = \ ((_patsIaterms) :: [ATerm]) pos_ -> {-# LINE 115 "src-ag/Visage.ag" #-} AAppl "Pattern" [AAppl "Product" [AString (sQ (showAGPos pos_)), AAppl "Patterns" _patsIaterms]] {-# LINE 499 "dist/build/Visage.hs"#-} {-# NOINLINE sem_VisagePattern_VVar #-} sem_VisagePattern_VVar :: (Identifier) -> (Identifier) -> T_VisagePattern sem_VisagePattern_VVar arg_field_ arg_attr_ = T_VisagePattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_VisagePattern_v19 v19 = \ (T_VisagePattern_vIn19 ) -> ( let _lhsOaterm :: ATerm _lhsOaterm = rule11 arg_attr_ arg_field_ __result_ = T_VisagePattern_vOut19 _lhsOaterm in __result_ ) in C_VisagePattern_s20 v19 {-# INLINE rule11 #-} {-# LINE 117 "src-ag/Visage.ag" #-} rule11 = \ attr_ field_ -> {-# LINE 117 "src-ag/Visage.ag" #-} AAppl "Pattern" [AAppl "Var" [AString (sQ (showAGPos (getPos field_))), AString (sQ (getName field_ ++ "." ++ getName attr_))]] {-# LINE 518 "dist/build/Visage.hs"#-} {-# NOINLINE sem_VisagePattern_VAlias #-} sem_VisagePattern_VAlias :: (Identifier) -> (Identifier) -> T_VisagePattern -> T_VisagePattern sem_VisagePattern_VAlias arg_field_ arg_attr_ arg_pat_ = T_VisagePattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_VisagePattern_v19 v19 = \ (T_VisagePattern_vIn19 ) -> ( let _patX20 = Control.Monad.Identity.runIdentity (attach_T_VisagePattern (arg_pat_)) (T_VisagePattern_vOut19 _patIaterm) = inv_VisagePattern_s20 _patX20 (T_VisagePattern_vIn19 ) _lhsOaterm :: ATerm _lhsOaterm = rule12 _patIaterm arg_attr_ arg_field_ __result_ = T_VisagePattern_vOut19 _lhsOaterm in __result_ ) in C_VisagePattern_s20 v19 {-# INLINE rule12 #-} {-# LINE 119 "src-ag/Visage.ag" #-} rule12 = \ ((_patIaterm) :: ATerm) attr_ field_ -> {-# LINE 119 "src-ag/Visage.ag" #-} AAppl "Pattern" [AAppl "Alias" [AString (sQ (showAGPos (getPos field_))), AString (sQ (getName field_ ++ "." ++ getName attr_)), _patIaterm]] {-# LINE 539 "dist/build/Visage.hs"#-} {-# NOINLINE sem_VisagePattern_VUnderscore #-} sem_VisagePattern_VUnderscore :: (Pos) -> T_VisagePattern sem_VisagePattern_VUnderscore arg_pos_ = T_VisagePattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_VisagePattern_v19 v19 = \ (T_VisagePattern_vIn19 ) -> ( let _lhsOaterm :: ATerm _lhsOaterm = rule13 arg_pos_ __result_ = T_VisagePattern_vOut19 _lhsOaterm in __result_ ) in C_VisagePattern_s20 v19 {-# INLINE rule13 #-} {-# LINE 121 "src-ag/Visage.ag" #-} rule13 = \ pos_ -> {-# LINE 121 "src-ag/Visage.ag" #-} AAppl "Pattern" [AAppl "Underscore" [AString (sQ (showAGPos pos_))]] {-# LINE 557 "dist/build/Visage.hs"#-} -- VisagePatterns ---------------------------------------------- -- wrapper data Inh_VisagePatterns = Inh_VisagePatterns { } data Syn_VisagePatterns = Syn_VisagePatterns { aterms_Syn_VisagePatterns :: ([ATerm]) } {-# INLINABLE wrap_VisagePatterns #-} wrap_VisagePatterns :: T_VisagePatterns -> Inh_VisagePatterns -> (Syn_VisagePatterns ) wrap_VisagePatterns (T_VisagePatterns act) (Inh_VisagePatterns ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg22 = T_VisagePatterns_vIn22 (T_VisagePatterns_vOut22 _lhsOaterms) <- return (inv_VisagePatterns_s23 sem arg22) return (Syn_VisagePatterns _lhsOaterms) ) -- cata {-# NOINLINE sem_VisagePatterns #-} sem_VisagePatterns :: VisagePatterns -> T_VisagePatterns sem_VisagePatterns list = Prelude.foldr sem_VisagePatterns_Cons sem_VisagePatterns_Nil (Prelude.map sem_VisagePattern list) -- semantic domain newtype T_VisagePatterns = T_VisagePatterns { attach_T_VisagePatterns :: Identity (T_VisagePatterns_s23 ) } newtype T_VisagePatterns_s23 = C_VisagePatterns_s23 { inv_VisagePatterns_s23 :: (T_VisagePatterns_v22 ) } data T_VisagePatterns_s24 = C_VisagePatterns_s24 type T_VisagePatterns_v22 = (T_VisagePatterns_vIn22 ) -> (T_VisagePatterns_vOut22 ) data T_VisagePatterns_vIn22 = T_VisagePatterns_vIn22 data T_VisagePatterns_vOut22 = T_VisagePatterns_vOut22 ([ATerm]) {-# NOINLINE sem_VisagePatterns_Cons #-} sem_VisagePatterns_Cons :: T_VisagePattern -> T_VisagePatterns -> T_VisagePatterns sem_VisagePatterns_Cons arg_hd_ arg_tl_ = T_VisagePatterns (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_VisagePatterns_v22 v22 = \ (T_VisagePatterns_vIn22 ) -> ( let _hdX20 = Control.Monad.Identity.runIdentity (attach_T_VisagePattern (arg_hd_)) _tlX23 = Control.Monad.Identity.runIdentity (attach_T_VisagePatterns (arg_tl_)) (T_VisagePattern_vOut19 _hdIaterm) = inv_VisagePattern_s20 _hdX20 (T_VisagePattern_vIn19 ) (T_VisagePatterns_vOut22 _tlIaterms) = inv_VisagePatterns_s23 _tlX23 (T_VisagePatterns_vIn22 ) _lhsOaterms :: [ATerm] _lhsOaterms = rule14 _hdIaterm _tlIaterms __result_ = T_VisagePatterns_vOut22 _lhsOaterms in __result_ ) in C_VisagePatterns_s23 v22 {-# INLINE rule14 #-} {-# LINE 107 "src-ag/Visage.ag" #-} rule14 = \ ((_hdIaterm) :: ATerm) ((_tlIaterms) :: [ATerm]) -> {-# LINE 107 "src-ag/Visage.ag" #-} _hdIaterm : _tlIaterms {-# LINE 610 "dist/build/Visage.hs"#-} {-# NOINLINE sem_VisagePatterns_Nil #-} sem_VisagePatterns_Nil :: T_VisagePatterns sem_VisagePatterns_Nil = T_VisagePatterns (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_VisagePatterns_v22 v22 = \ (T_VisagePatterns_vIn22 ) -> ( let _lhsOaterms :: [ATerm] _lhsOaterms = rule15 () __result_ = T_VisagePatterns_vOut22 _lhsOaterms in __result_ ) in C_VisagePatterns_s23 v22 {-# INLINE rule15 #-} {-# LINE 108 "src-ag/Visage.ag" #-} rule15 = \ (_ :: ()) -> {-# LINE 108 "src-ag/Visage.ag" #-} [] {-# LINE 628 "dist/build/Visage.hs"#-} -- VisageProduction -------------------------------------------- -- wrapper data Inh_VisageProduction = Inh_VisageProduction { } data Syn_VisageProduction = Syn_VisageProduction { aterm_Syn_VisageProduction :: (ATerm) } {-# INLINABLE wrap_VisageProduction #-} wrap_VisageProduction :: T_VisageProduction -> Inh_VisageProduction -> (Syn_VisageProduction ) wrap_VisageProduction (T_VisageProduction act) (Inh_VisageProduction ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg25 = T_VisageProduction_vIn25 (T_VisageProduction_vOut25 _lhsOaterm) <- return (inv_VisageProduction_s26 sem arg25) return (Syn_VisageProduction _lhsOaterm) ) -- cata {-# INLINE sem_VisageProduction #-} sem_VisageProduction :: VisageProduction -> T_VisageProduction sem_VisageProduction ( VProduction con_ children_ rules_ locrules_ ) = sem_VisageProduction_VProduction con_ ( sem_VisageChildren children_ ) ( sem_VisageRules rules_ ) ( sem_VisageRules locrules_ ) -- semantic domain newtype T_VisageProduction = T_VisageProduction { attach_T_VisageProduction :: Identity (T_VisageProduction_s26 ) } newtype T_VisageProduction_s26 = C_VisageProduction_s26 { inv_VisageProduction_s26 :: (T_VisageProduction_v25 ) } data T_VisageProduction_s27 = C_VisageProduction_s27 type T_VisageProduction_v25 = (T_VisageProduction_vIn25 ) -> (T_VisageProduction_vOut25 ) data T_VisageProduction_vIn25 = T_VisageProduction_vIn25 data T_VisageProduction_vOut25 = T_VisageProduction_vOut25 (ATerm) {-# NOINLINE sem_VisageProduction_VProduction #-} sem_VisageProduction_VProduction :: (ConstructorIdent) -> T_VisageChildren -> T_VisageRules -> T_VisageRules -> T_VisageProduction sem_VisageProduction_VProduction arg_con_ arg_children_ arg_rules_ arg_locrules_ = T_VisageProduction (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_VisageProduction_v25 v25 = \ (T_VisageProduction_vIn25 ) -> ( let _childrenX8 = Control.Monad.Identity.runIdentity (attach_T_VisageChildren (arg_children_)) _rulesX35 = Control.Monad.Identity.runIdentity (attach_T_VisageRules (arg_rules_)) _locrulesX35 = Control.Monad.Identity.runIdentity (attach_T_VisageRules (arg_locrules_)) (T_VisageChildren_vOut7 _childrenIaterms) = inv_VisageChildren_s8 _childrenX8 (T_VisageChildren_vIn7 ) (T_VisageRules_vOut34 _rulesIaterms) = inv_VisageRules_s35 _rulesX35 (T_VisageRules_vIn34 _rulesOisLoc) (T_VisageRules_vOut34 _locrulesIaterms) = inv_VisageRules_s35 _locrulesX35 (T_VisageRules_vIn34 _locrulesOisLoc) _lhsOaterm :: ATerm _lhsOaterm = rule16 _childrenIaterms _locrulesIaterms _rulesIaterms arg_con_ _locrulesOisLoc = rule17 () _rulesOisLoc = rule18 () __result_ = T_VisageProduction_vOut25 _lhsOaterm in __result_ ) in C_VisageProduction_s26 v25 {-# INLINE rule16 #-} {-# LINE 73 "src-ag/Visage.ag" #-} rule16 = \ ((_childrenIaterms) :: [ATerm]) ((_locrulesIaterms) :: [ATerm]) ((_rulesIaterms) :: [ATerm]) con_ -> {-# LINE 73 "src-ag/Visage.ag" #-} AAppl "Alternative" [AString (sQ (getName con_)), AAppl "Children" _childrenIaterms, AAppl "Rules" _rulesIaterms, AAppl "LocRules" _locrulesIaterms] {-# LINE 687 "dist/build/Visage.hs"#-} {-# INLINE rule17 #-} {-# LINE 76 "src-ag/Visage.ag" #-} rule17 = \ (_ :: ()) -> {-# LINE 76 "src-ag/Visage.ag" #-} True {-# LINE 693 "dist/build/Visage.hs"#-} {-# INLINE rule18 #-} {-# LINE 77 "src-ag/Visage.ag" #-} rule18 = \ (_ :: ()) -> {-# LINE 77 "src-ag/Visage.ag" #-} False {-# LINE 699 "dist/build/Visage.hs"#-} -- VisageProductions ------------------------------------------- -- wrapper data Inh_VisageProductions = Inh_VisageProductions { } data Syn_VisageProductions = Syn_VisageProductions { aterms_Syn_VisageProductions :: ([ATerm]) } {-# INLINABLE wrap_VisageProductions #-} wrap_VisageProductions :: T_VisageProductions -> Inh_VisageProductions -> (Syn_VisageProductions ) wrap_VisageProductions (T_VisageProductions act) (Inh_VisageProductions ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg28 = T_VisageProductions_vIn28 (T_VisageProductions_vOut28 _lhsOaterms) <- return (inv_VisageProductions_s29 sem arg28) return (Syn_VisageProductions _lhsOaterms) ) -- cata {-# NOINLINE sem_VisageProductions #-} sem_VisageProductions :: VisageProductions -> T_VisageProductions sem_VisageProductions list = Prelude.foldr sem_VisageProductions_Cons sem_VisageProductions_Nil (Prelude.map sem_VisageProduction list) -- semantic domain newtype T_VisageProductions = T_VisageProductions { attach_T_VisageProductions :: Identity (T_VisageProductions_s29 ) } newtype T_VisageProductions_s29 = C_VisageProductions_s29 { inv_VisageProductions_s29 :: (T_VisageProductions_v28 ) } data T_VisageProductions_s30 = C_VisageProductions_s30 type T_VisageProductions_v28 = (T_VisageProductions_vIn28 ) -> (T_VisageProductions_vOut28 ) data T_VisageProductions_vIn28 = T_VisageProductions_vIn28 data T_VisageProductions_vOut28 = T_VisageProductions_vOut28 ([ATerm]) {-# NOINLINE sem_VisageProductions_Cons #-} sem_VisageProductions_Cons :: T_VisageProduction -> T_VisageProductions -> T_VisageProductions sem_VisageProductions_Cons arg_hd_ arg_tl_ = T_VisageProductions (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_VisageProductions_v28 v28 = \ (T_VisageProductions_vIn28 ) -> ( let _hdX26 = Control.Monad.Identity.runIdentity (attach_T_VisageProduction (arg_hd_)) _tlX29 = Control.Monad.Identity.runIdentity (attach_T_VisageProductions (arg_tl_)) (T_VisageProduction_vOut25 _hdIaterm) = inv_VisageProduction_s26 _hdX26 (T_VisageProduction_vIn25 ) (T_VisageProductions_vOut28 _tlIaterms) = inv_VisageProductions_s29 _tlX29 (T_VisageProductions_vIn28 ) _lhsOaterms :: [ATerm] _lhsOaterms = rule19 _hdIaterm _tlIaterms __result_ = T_VisageProductions_vOut28 _lhsOaterms in __result_ ) in C_VisageProductions_s29 v28 {-# INLINE rule19 #-} {-# LINE 68 "src-ag/Visage.ag" #-} rule19 = \ ((_hdIaterm) :: ATerm) ((_tlIaterms) :: [ATerm]) -> {-# LINE 68 "src-ag/Visage.ag" #-} _hdIaterm : _tlIaterms {-# LINE 752 "dist/build/Visage.hs"#-} {-# NOINLINE sem_VisageProductions_Nil #-} sem_VisageProductions_Nil :: T_VisageProductions sem_VisageProductions_Nil = T_VisageProductions (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_VisageProductions_v28 v28 = \ (T_VisageProductions_vIn28 ) -> ( let _lhsOaterms :: [ATerm] _lhsOaterms = rule20 () __result_ = T_VisageProductions_vOut28 _lhsOaterms in __result_ ) in C_VisageProductions_s29 v28 {-# INLINE rule20 #-} {-# LINE 69 "src-ag/Visage.ag" #-} rule20 = \ (_ :: ()) -> {-# LINE 69 "src-ag/Visage.ag" #-} [] {-# LINE 770 "dist/build/Visage.hs"#-} -- VisageRule -------------------------------------------------- -- wrapper data Inh_VisageRule = Inh_VisageRule { isLoc_Inh_VisageRule :: (Bool) } data Syn_VisageRule = Syn_VisageRule { aterm_Syn_VisageRule :: (ATerm) } {-# INLINABLE wrap_VisageRule #-} wrap_VisageRule :: T_VisageRule -> Inh_VisageRule -> (Syn_VisageRule ) wrap_VisageRule (T_VisageRule act) (Inh_VisageRule _lhsIisLoc) = Control.Monad.Identity.runIdentity ( do sem <- act let arg31 = T_VisageRule_vIn31 _lhsIisLoc (T_VisageRule_vOut31 _lhsOaterm) <- return (inv_VisageRule_s32 sem arg31) return (Syn_VisageRule _lhsOaterm) ) -- cata {-# INLINE sem_VisageRule #-} sem_VisageRule :: VisageRule -> T_VisageRule sem_VisageRule ( VRule fieldattrs_ attr_ pat_ rhs_ owrt_ ) = sem_VisageRule_VRule fieldattrs_ attr_ ( sem_VisagePattern pat_ ) ( sem_Expression rhs_ ) owrt_ -- semantic domain newtype T_VisageRule = T_VisageRule { attach_T_VisageRule :: Identity (T_VisageRule_s32 ) } newtype T_VisageRule_s32 = C_VisageRule_s32 { inv_VisageRule_s32 :: (T_VisageRule_v31 ) } data T_VisageRule_s33 = C_VisageRule_s33 type T_VisageRule_v31 = (T_VisageRule_vIn31 ) -> (T_VisageRule_vOut31 ) data T_VisageRule_vIn31 = T_VisageRule_vIn31 (Bool) data T_VisageRule_vOut31 = T_VisageRule_vOut31 (ATerm) {-# NOINLINE sem_VisageRule_VRule #-} sem_VisageRule_VRule :: ([(Identifier,Identifier)]) -> (Identifier) -> T_VisagePattern -> T_Expression -> (Bool) -> T_VisageRule sem_VisageRule_VRule _ arg_attr_ arg_pat_ arg_rhs_ arg_owrt_ = T_VisageRule (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_VisageRule_v31 v31 = \ (T_VisageRule_vIn31 _lhsIisLoc) -> ( let _patX20 = Control.Monad.Identity.runIdentity (attach_T_VisagePattern (arg_pat_)) _rhsX2 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) (T_VisagePattern_vOut19 _patIaterm) = inv_VisagePattern_s20 _patX20 (T_VisagePattern_vIn19 ) (T_Expression_vOut1 _rhsIaterm) = inv_Expression_s2 _rhsX2 (T_Expression_vIn1 ) _lhsOaterm :: ATerm _lhsOaterm = rule21 _lhsIisLoc _patIaterm _rhsIaterm arg_attr_ arg_owrt_ __result_ = T_VisageRule_vOut31 _lhsOaterm in __result_ ) in C_VisageRule_s32 v31 {-# INLINE rule21 #-} {-# LINE 97 "src-ag/Visage.ag" #-} rule21 = \ ((_lhsIisLoc) :: Bool) ((_patIaterm) :: ATerm) ((_rhsIaterm) :: ATerm) attr_ owrt_ -> {-# LINE 97 "src-ag/Visage.ag" #-} AAppl (if _lhsIisLoc then "LocRule" else "Rule") ([AString (sQ (getName attr_)), _patIaterm, _rhsIaterm] ++ if _lhsIisLoc then [AString (sQ (show owrt_))] else []) {-# LINE 824 "dist/build/Visage.hs"#-} -- VisageRules ------------------------------------------------- -- wrapper data Inh_VisageRules = Inh_VisageRules { isLoc_Inh_VisageRules :: (Bool) } data Syn_VisageRules = Syn_VisageRules { aterms_Syn_VisageRules :: ([ATerm]) } {-# INLINABLE wrap_VisageRules #-} wrap_VisageRules :: T_VisageRules -> Inh_VisageRules -> (Syn_VisageRules ) wrap_VisageRules (T_VisageRules act) (Inh_VisageRules _lhsIisLoc) = Control.Monad.Identity.runIdentity ( do sem <- act let arg34 = T_VisageRules_vIn34 _lhsIisLoc (T_VisageRules_vOut34 _lhsOaterms) <- return (inv_VisageRules_s35 sem arg34) return (Syn_VisageRules _lhsOaterms) ) -- cata {-# NOINLINE sem_VisageRules #-} sem_VisageRules :: VisageRules -> T_VisageRules sem_VisageRules list = Prelude.foldr sem_VisageRules_Cons sem_VisageRules_Nil (Prelude.map sem_VisageRule list) -- semantic domain newtype T_VisageRules = T_VisageRules { attach_T_VisageRules :: Identity (T_VisageRules_s35 ) } newtype T_VisageRules_s35 = C_VisageRules_s35 { inv_VisageRules_s35 :: (T_VisageRules_v34 ) } data T_VisageRules_s36 = C_VisageRules_s36 type T_VisageRules_v34 = (T_VisageRules_vIn34 ) -> (T_VisageRules_vOut34 ) data T_VisageRules_vIn34 = T_VisageRules_vIn34 (Bool) data T_VisageRules_vOut34 = T_VisageRules_vOut34 ([ATerm]) {-# NOINLINE sem_VisageRules_Cons #-} sem_VisageRules_Cons :: T_VisageRule -> T_VisageRules -> T_VisageRules sem_VisageRules_Cons arg_hd_ arg_tl_ = T_VisageRules (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_VisageRules_v34 v34 = \ (T_VisageRules_vIn34 _lhsIisLoc) -> ( let _hdX32 = Control.Monad.Identity.runIdentity (attach_T_VisageRule (arg_hd_)) _tlX35 = Control.Monad.Identity.runIdentity (attach_T_VisageRules (arg_tl_)) (T_VisageRule_vOut31 _hdIaterm) = inv_VisageRule_s32 _hdX32 (T_VisageRule_vIn31 _hdOisLoc) (T_VisageRules_vOut34 _tlIaterms) = inv_VisageRules_s35 _tlX35 (T_VisageRules_vIn34 _tlOisLoc) _lhsOaterms :: [ATerm] _lhsOaterms = rule22 _hdIaterm _tlIaterms _hdOisLoc = rule23 _lhsIisLoc _tlOisLoc = rule24 _lhsIisLoc __result_ = T_VisageRules_vOut34 _lhsOaterms in __result_ ) in C_VisageRules_s35 v34 {-# INLINE rule22 #-} {-# LINE 92 "src-ag/Visage.ag" #-} rule22 = \ ((_hdIaterm) :: ATerm) ((_tlIaterms) :: [ATerm]) -> {-# LINE 92 "src-ag/Visage.ag" #-} _hdIaterm : _tlIaterms {-# LINE 879 "dist/build/Visage.hs"#-} {-# INLINE rule23 #-} rule23 = \ ((_lhsIisLoc) :: Bool) -> _lhsIisLoc {-# INLINE rule24 #-} rule24 = \ ((_lhsIisLoc) :: Bool) -> _lhsIisLoc {-# NOINLINE sem_VisageRules_Nil #-} sem_VisageRules_Nil :: T_VisageRules sem_VisageRules_Nil = T_VisageRules (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_VisageRules_v34 v34 = \ (T_VisageRules_vIn34 _lhsIisLoc) -> ( let _lhsOaterms :: [ATerm] _lhsOaterms = rule25 () __result_ = T_VisageRules_vOut34 _lhsOaterms in __result_ ) in C_VisageRules_s35 v34 {-# INLINE rule25 #-} {-# LINE 93 "src-ag/Visage.ag" #-} rule25 = \ (_ :: ()) -> {-# LINE 93 "src-ag/Visage.ag" #-} [] {-# LINE 903 "dist/build/Visage.hs"#-} uuagc-0.9.52.2/src-generated/SemHsTokens.hs0000644000000000000000000007757613433540502016550 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module SemHsTokens where {-# LINE 2 "src-ag/HsToken.ag" #-} import CommonTypes import UU.Scanner.Position(Pos) {-# LINE 10 "dist/build/SemHsTokens.hs" #-} {-# LINE 4 "src-ag/SemHsTokens.ag" #-} import qualified Data.Sequence as Seq import Data.Sequence(Seq,empty,singleton,(><)) import Data.Foldable(toList) import Pretty import TokenDef import HsToken import ErrorMessages {-# LINE 22 "dist/build/SemHsTokens.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 58 "src-ag/SemHsTokens.ag" #-} isNTname allnts (Just (NT nt _ _)) = nt `elem` allnts isNTname allnts _ = False {-# LINE 29 "dist/build/SemHsTokens.hs" #-} -- HsToken ----------------------------------------------------- -- wrapper data Inh_HsToken = Inh_HsToken { allfields_Inh_HsToken :: ([(Identifier,Type,ChildKind)]), allnts_Inh_HsToken :: ([Identifier]), attrs_Inh_HsToken :: ([(Identifier,Identifier)]), con_Inh_HsToken :: (Identifier), fieldnames_Inh_HsToken :: ([Identifier]), nt_Inh_HsToken :: (Identifier), options_Inh_HsToken :: (Options) } data Syn_HsToken = Syn_HsToken { errors_Syn_HsToken :: (Seq Error), output_Syn_HsToken :: (HsToken), tok_Syn_HsToken :: ((Pos,String)), usedAttrs_Syn_HsToken :: ([(Identifier,Identifier)]), usedFields_Syn_HsToken :: (Seq Identifier), usedLocals_Syn_HsToken :: ([Identifier]) } {-# INLINABLE wrap_HsToken #-} wrap_HsToken :: T_HsToken -> Inh_HsToken -> (Syn_HsToken ) wrap_HsToken (T_HsToken act) (Inh_HsToken _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_HsToken_vIn1 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions (T_HsToken_vOut1 _lhsOerrors _lhsOoutput _lhsOtok _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals) <- return (inv_HsToken_s2 sem arg1) return (Syn_HsToken _lhsOerrors _lhsOoutput _lhsOtok _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals) ) -- cata {-# NOINLINE sem_HsToken #-} sem_HsToken :: HsToken -> T_HsToken sem_HsToken ( AGLocal var_ pos_ rdesc_ ) = sem_HsToken_AGLocal var_ pos_ rdesc_ sem_HsToken ( AGField field_ attr_ pos_ rdesc_ ) = sem_HsToken_AGField field_ attr_ pos_ rdesc_ sem_HsToken ( HsToken value_ pos_ ) = sem_HsToken_HsToken value_ pos_ sem_HsToken ( CharToken value_ pos_ ) = sem_HsToken_CharToken value_ pos_ sem_HsToken ( StrToken value_ pos_ ) = sem_HsToken_StrToken value_ pos_ sem_HsToken ( Err mesg_ pos_ ) = sem_HsToken_Err mesg_ pos_ -- semantic domain newtype T_HsToken = T_HsToken { attach_T_HsToken :: Identity (T_HsToken_s2 ) } newtype T_HsToken_s2 = C_HsToken_s2 { inv_HsToken_s2 :: (T_HsToken_v1 ) } data T_HsToken_s3 = C_HsToken_s3 type T_HsToken_v1 = (T_HsToken_vIn1 ) -> (T_HsToken_vOut1 ) data T_HsToken_vIn1 = T_HsToken_vIn1 ([(Identifier,Type,ChildKind)]) ([Identifier]) ([(Identifier,Identifier)]) (Identifier) ([Identifier]) (Identifier) (Options) data T_HsToken_vOut1 = T_HsToken_vOut1 (Seq Error) (HsToken) ((Pos,String)) ([(Identifier,Identifier)]) (Seq Identifier) ([Identifier]) {-# NOINLINE sem_HsToken_AGLocal #-} sem_HsToken_AGLocal :: (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGLocal arg_var_ arg_pos_ arg_rdesc_ = T_HsToken (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_HsToken_v1 v1 = \ (T_HsToken_vIn1 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions) -> ( let _tkAsLocal = rule0 arg_pos_ arg_rdesc_ arg_var_ _tkAsField = rule1 arg_pos_ arg_rdesc_ arg_var_ (_errors,_output,_tok,_usedLocals) = rule2 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions _tkAsField _tkAsLocal arg_pos_ arg_var_ _lhsOusedFields :: Seq Identifier _lhsOusedFields = rule3 _lhsIfieldnames arg_var_ _lhsOerrors :: Seq Error _lhsOerrors = rule4 _errors _lhsOusedAttrs :: [(Identifier,Identifier)] _lhsOusedAttrs = rule5 () _lhsOusedLocals :: [Identifier] _lhsOusedLocals = rule6 _usedLocals _lhsOoutput :: HsToken _lhsOoutput = rule7 _output _lhsOtok :: (Pos,String) _lhsOtok = rule8 _tok __result_ = T_HsToken_vOut1 _lhsOerrors _lhsOoutput _lhsOtok _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals in __result_ ) in C_HsToken_s2 v1 {-# INLINE rule0 #-} {-# LINE 66 "src-ag/SemHsTokens.ag" #-} rule0 = \ pos_ rdesc_ var_ -> {-# LINE 66 "src-ag/SemHsTokens.ag" #-} AGLocal var_ pos_ rdesc_ {-# LINE 95 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule1 #-} {-# LINE 67 "src-ag/SemHsTokens.ag" #-} rule1 = \ pos_ rdesc_ var_ -> {-# LINE 67 "src-ag/SemHsTokens.ag" #-} AGField _LOC var_ pos_ rdesc_ {-# LINE 101 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule2 #-} {-# LINE 69 "src-ag/SemHsTokens.ag" #-} rule2 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) ((_lhsIallnts) :: [Identifier]) ((_lhsIattrs) :: [(Identifier,Identifier)]) ((_lhsIcon) :: Identifier) ((_lhsIfieldnames) :: [Identifier]) ((_lhsInt) :: Identifier) ((_lhsIoptions) :: Options) _tkAsField _tkAsLocal pos_ var_ -> {-# LINE 69 "src-ag/SemHsTokens.ag" #-} if var_ `elem` _lhsIfieldnames then if isNTname _lhsIallnts (lookup var_ (map (\(n,t,_) -> (n,t)) _lhsIallfields)) then (Seq.singleton(ChildAsLocal _lhsInt _lhsIcon var_), _tkAsLocal ,(pos_,fieldname var_), [] ) else (Seq.empty, _tkAsLocal , (pos_,fieldname var_), [] ) else if (_LOC,var_) `elem` _lhsIattrs then (Seq.empty , _tkAsField , (pos_,locname _lhsIoptions var_), [var_]) else (Seq.singleton(UndefLocal _lhsInt _lhsIcon var_), _tkAsField , (pos_,locname _lhsIoptions var_), [] ) {-# LINE 113 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule3 #-} {-# LINE 104 "src-ag/SemHsTokens.ag" #-} rule3 = \ ((_lhsIfieldnames) :: [Identifier]) var_ -> {-# LINE 104 "src-ag/SemHsTokens.ag" #-} if var_ `elem` _lhsIfieldnames then Seq.singleton var_ else Seq.empty {-# LINE 121 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule4 #-} rule4 = \ _errors -> _errors {-# INLINE rule5 #-} rule5 = \ (_ :: ()) -> [] {-# INLINE rule6 #-} rule6 = \ _usedLocals -> _usedLocals {-# INLINE rule7 #-} rule7 = \ _output -> _output {-# INLINE rule8 #-} rule8 = \ _tok -> _tok {-# NOINLINE sem_HsToken_AGField #-} sem_HsToken_AGField :: (Identifier) -> (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGField arg_field_ arg_attr_ arg_pos_ arg_rdesc_ = T_HsToken (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_HsToken_v1 v1 = \ (T_HsToken_vIn1 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions) -> ( let _lhsOerrors :: Seq Error _lhsOerrors = rule9 _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt arg_attr_ arg_field_ _lhsOusedAttrs :: [(Identifier,Identifier)] _lhsOusedLocals :: [Identifier] (_lhsOusedAttrs,_lhsOusedLocals) = rule10 arg_attr_ arg_field_ _addTrace = rule11 arg_attr_ arg_field_ arg_rdesc_ _lhsOtok :: (Pos,String) _lhsOtok = rule12 _addTrace _lhsIoptions arg_attr_ arg_field_ arg_pos_ _lhsOusedFields :: Seq Identifier _lhsOusedFields = rule13 () _output = rule14 arg_attr_ arg_field_ arg_pos_ arg_rdesc_ _lhsOoutput :: HsToken _lhsOoutput = rule15 _output __result_ = T_HsToken_vOut1 _lhsOerrors _lhsOoutput _lhsOtok _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals in __result_ ) in C_HsToken_s2 v1 {-# INLINE rule9 #-} {-# LINE 78 "src-ag/SemHsTokens.ag" #-} rule9 = \ ((_lhsIattrs) :: [(Identifier,Identifier)]) ((_lhsIcon) :: Identifier) ((_lhsIfieldnames) :: [Identifier]) ((_lhsInt) :: Identifier) attr_ field_ -> {-# LINE 78 "src-ag/SemHsTokens.ag" #-} if (field_,attr_) `elem` _lhsIattrs then Seq.empty else if not(field_ `elem` (_LHS : _LOC: _lhsIfieldnames)) then Seq.singleton (UndefChild _lhsInt _lhsIcon field_) else Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ attr_ False) {-# LINE 169 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule10 #-} {-# LINE 93 "src-ag/SemHsTokens.ag" #-} rule10 = \ attr_ field_ -> {-# LINE 93 "src-ag/SemHsTokens.ag" #-} if field_ == _LOC then ([], [attr_]) else ([(field_,attr_)], []) {-# LINE 177 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule11 #-} {-# LINE 123 "src-ag/SemHsTokens.ag" #-} rule11 = \ attr_ field_ rdesc_ -> {-# LINE 123 "src-ag/SemHsTokens.ag" #-} case rdesc_ of Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))" Nothing -> id {-# LINE 185 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule12 #-} {-# LINE 126 "src-ag/SemHsTokens.ag" #-} rule12 = \ _addTrace ((_lhsIoptions) :: Options) attr_ field_ pos_ -> {-# LINE 126 "src-ag/SemHsTokens.ag" #-} (pos_, _addTrace $ attrname _lhsIoptions True field_ attr_) {-# LINE 191 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule13 #-} rule13 = \ (_ :: ()) -> Seq.empty {-# INLINE rule14 #-} rule14 = \ attr_ field_ pos_ rdesc_ -> AGField field_ attr_ pos_ rdesc_ {-# INLINE rule15 #-} rule15 = \ _output -> _output {-# NOINLINE sem_HsToken_HsToken #-} sem_HsToken_HsToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_HsToken arg_value_ arg_pos_ = T_HsToken (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_HsToken_v1 v1 = \ (T_HsToken_vIn1 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions) -> ( let _lhsOtok :: (Pos,String) _lhsOtok = rule16 arg_pos_ arg_value_ _lhsOerrors :: Seq Error _lhsOerrors = rule17 () _lhsOusedAttrs :: [(Identifier,Identifier)] _lhsOusedAttrs = rule18 () _lhsOusedFields :: Seq Identifier _lhsOusedFields = rule19 () _lhsOusedLocals :: [Identifier] _lhsOusedLocals = rule20 () _output = rule21 arg_pos_ arg_value_ _lhsOoutput :: HsToken _lhsOoutput = rule22 _output __result_ = T_HsToken_vOut1 _lhsOerrors _lhsOoutput _lhsOtok _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals in __result_ ) in C_HsToken_s2 v1 {-# INLINE rule16 #-} {-# LINE 128 "src-ag/SemHsTokens.ag" #-} rule16 = \ pos_ value_ -> {-# LINE 128 "src-ag/SemHsTokens.ag" #-} (pos_, value_) {-# LINE 229 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule17 #-} rule17 = \ (_ :: ()) -> Seq.empty {-# INLINE rule18 #-} rule18 = \ (_ :: ()) -> [] {-# INLINE rule19 #-} rule19 = \ (_ :: ()) -> Seq.empty {-# INLINE rule20 #-} rule20 = \ (_ :: ()) -> [] {-# INLINE rule21 #-} rule21 = \ pos_ value_ -> HsToken value_ pos_ {-# INLINE rule22 #-} rule22 = \ _output -> _output {-# NOINLINE sem_HsToken_CharToken #-} sem_HsToken_CharToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_CharToken arg_value_ arg_pos_ = T_HsToken (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_HsToken_v1 v1 = \ (T_HsToken_vIn1 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions) -> ( let _lhsOtok :: (Pos,String) _lhsOtok = rule23 arg_pos_ arg_value_ _lhsOerrors :: Seq Error _lhsOerrors = rule24 () _lhsOusedAttrs :: [(Identifier,Identifier)] _lhsOusedAttrs = rule25 () _lhsOusedFields :: Seq Identifier _lhsOusedFields = rule26 () _lhsOusedLocals :: [Identifier] _lhsOusedLocals = rule27 () _output = rule28 arg_pos_ arg_value_ _lhsOoutput :: HsToken _lhsOoutput = rule29 _output __result_ = T_HsToken_vOut1 _lhsOerrors _lhsOoutput _lhsOtok _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals in __result_ ) in C_HsToken_s2 v1 {-# INLINE rule23 #-} {-# LINE 130 "src-ag/SemHsTokens.ag" #-} rule23 = \ pos_ value_ -> {-# LINE 130 "src-ag/SemHsTokens.ag" #-} (pos_, if null value_ then "" else showCharShort (head value_) ) {-# LINE 279 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule24 #-} rule24 = \ (_ :: ()) -> Seq.empty {-# INLINE rule25 #-} rule25 = \ (_ :: ()) -> [] {-# INLINE rule26 #-} rule26 = \ (_ :: ()) -> Seq.empty {-# INLINE rule27 #-} rule27 = \ (_ :: ()) -> [] {-# INLINE rule28 #-} rule28 = \ pos_ value_ -> CharToken value_ pos_ {-# INLINE rule29 #-} rule29 = \ _output -> _output {-# NOINLINE sem_HsToken_StrToken #-} sem_HsToken_StrToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_StrToken arg_value_ arg_pos_ = T_HsToken (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_HsToken_v1 v1 = \ (T_HsToken_vIn1 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions) -> ( let _lhsOtok :: (Pos,String) _lhsOtok = rule30 arg_pos_ arg_value_ _lhsOerrors :: Seq Error _lhsOerrors = rule31 () _lhsOusedAttrs :: [(Identifier,Identifier)] _lhsOusedAttrs = rule32 () _lhsOusedFields :: Seq Identifier _lhsOusedFields = rule33 () _lhsOusedLocals :: [Identifier] _lhsOusedLocals = rule34 () _output = rule35 arg_pos_ arg_value_ _lhsOoutput :: HsToken _lhsOoutput = rule36 _output __result_ = T_HsToken_vOut1 _lhsOerrors _lhsOoutput _lhsOtok _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals in __result_ ) in C_HsToken_s2 v1 {-# INLINE rule30 #-} {-# LINE 135 "src-ag/SemHsTokens.ag" #-} rule30 = \ pos_ value_ -> {-# LINE 135 "src-ag/SemHsTokens.ag" #-} (pos_, showStrShort value_) {-# LINE 326 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule31 #-} rule31 = \ (_ :: ()) -> Seq.empty {-# INLINE rule32 #-} rule32 = \ (_ :: ()) -> [] {-# INLINE rule33 #-} rule33 = \ (_ :: ()) -> Seq.empty {-# INLINE rule34 #-} rule34 = \ (_ :: ()) -> [] {-# INLINE rule35 #-} rule35 = \ pos_ value_ -> StrToken value_ pos_ {-# INLINE rule36 #-} rule36 = \ _output -> _output {-# NOINLINE sem_HsToken_Err #-} sem_HsToken_Err :: (String) -> (Pos) -> T_HsToken sem_HsToken_Err arg_mesg_ arg_pos_ = T_HsToken (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_HsToken_v1 v1 = \ (T_HsToken_vIn1 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions) -> ( let _lhsOerrors :: Seq Error _lhsOerrors = rule37 arg_mesg_ arg_pos_ _lhsOtok :: (Pos,String) _lhsOtok = rule38 arg_pos_ _lhsOusedAttrs :: [(Identifier,Identifier)] _lhsOusedAttrs = rule39 () _lhsOusedFields :: Seq Identifier _lhsOusedFields = rule40 () _lhsOusedLocals :: [Identifier] _lhsOusedLocals = rule41 () _output = rule42 arg_mesg_ arg_pos_ _lhsOoutput :: HsToken _lhsOoutput = rule43 _output __result_ = T_HsToken_vOut1 _lhsOerrors _lhsOoutput _lhsOtok _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals in __result_ ) in C_HsToken_s2 v1 {-# INLINE rule37 #-} {-# LINE 51 "src-ag/SemHsTokens.ag" #-} rule37 = \ mesg_ pos_ -> {-# LINE 51 "src-ag/SemHsTokens.ag" #-} let m = text mesg_ in Seq.singleton (CustomError False pos_ m) {-# LINE 374 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule38 #-} {-# LINE 136 "src-ag/SemHsTokens.ag" #-} rule38 = \ pos_ -> {-# LINE 136 "src-ag/SemHsTokens.ag" #-} (pos_, "") {-# LINE 380 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule39 #-} rule39 = \ (_ :: ()) -> [] {-# INLINE rule40 #-} rule40 = \ (_ :: ()) -> Seq.empty {-# INLINE rule41 #-} rule41 = \ (_ :: ()) -> [] {-# INLINE rule42 #-} rule42 = \ mesg_ pos_ -> Err mesg_ pos_ {-# INLINE rule43 #-} rule43 = \ _output -> _output -- HsTokens ---------------------------------------------------- -- wrapper data Inh_HsTokens = Inh_HsTokens { allfields_Inh_HsTokens :: ([(Identifier,Type,ChildKind)]), allnts_Inh_HsTokens :: ([Identifier]), attrs_Inh_HsTokens :: ([(Identifier,Identifier)]), con_Inh_HsTokens :: (Identifier), fieldnames_Inh_HsTokens :: ([Identifier]), nt_Inh_HsTokens :: (Identifier), options_Inh_HsTokens :: (Options) } data Syn_HsTokens = Syn_HsTokens { errors_Syn_HsTokens :: (Seq Error), output_Syn_HsTokens :: (HsTokens), tks_Syn_HsTokens :: ([(Pos,String)]), usedAttrs_Syn_HsTokens :: ([(Identifier,Identifier)]), usedFields_Syn_HsTokens :: (Seq Identifier), usedLocals_Syn_HsTokens :: ([Identifier]) } {-# INLINABLE wrap_HsTokens #-} wrap_HsTokens :: T_HsTokens -> Inh_HsTokens -> (Syn_HsTokens ) wrap_HsTokens (T_HsTokens act) (Inh_HsTokens _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_HsTokens_vIn4 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions (T_HsTokens_vOut4 _lhsOerrors _lhsOoutput _lhsOtks _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals) <- return (inv_HsTokens_s5 sem arg4) return (Syn_HsTokens _lhsOerrors _lhsOoutput _lhsOtks _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals) ) -- cata {-# NOINLINE sem_HsTokens #-} sem_HsTokens :: HsTokens -> T_HsTokens sem_HsTokens list = Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) -- semantic domain newtype T_HsTokens = T_HsTokens { attach_T_HsTokens :: Identity (T_HsTokens_s5 ) } newtype T_HsTokens_s5 = C_HsTokens_s5 { inv_HsTokens_s5 :: (T_HsTokens_v4 ) } data T_HsTokens_s6 = C_HsTokens_s6 type T_HsTokens_v4 = (T_HsTokens_vIn4 ) -> (T_HsTokens_vOut4 ) data T_HsTokens_vIn4 = T_HsTokens_vIn4 ([(Identifier,Type,ChildKind)]) ([Identifier]) ([(Identifier,Identifier)]) (Identifier) ([Identifier]) (Identifier) (Options) data T_HsTokens_vOut4 = T_HsTokens_vOut4 (Seq Error) (HsTokens) ([(Pos,String)]) ([(Identifier,Identifier)]) (Seq Identifier) ([Identifier]) {-# NOINLINE sem_HsTokens_Cons #-} sem_HsTokens_Cons :: T_HsToken -> T_HsTokens -> T_HsTokens sem_HsTokens_Cons arg_hd_ arg_tl_ = T_HsTokens (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_HsTokens_v4 v4 = \ (T_HsTokens_vIn4 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions) -> ( let _hdX2 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_)) _tlX5 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_)) (T_HsToken_vOut1 _hdIerrors _hdIoutput _hdItok _hdIusedAttrs _hdIusedFields _hdIusedLocals) = inv_HsToken_s2 _hdX2 (T_HsToken_vIn1 _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOfieldnames _hdOnt _hdOoptions) (T_HsTokens_vOut4 _tlIerrors _tlIoutput _tlItks _tlIusedAttrs _tlIusedFields _tlIusedLocals) = inv_HsTokens_s5 _tlX5 (T_HsTokens_vIn4 _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOfieldnames _tlOnt _tlOoptions) _lhsOtks :: [(Pos,String)] _lhsOtks = rule44 _hdItok _tlItks _lhsOerrors :: Seq Error _lhsOerrors = rule45 _hdIerrors _tlIerrors _lhsOusedAttrs :: [(Identifier,Identifier)] _lhsOusedAttrs = rule46 _hdIusedAttrs _tlIusedAttrs _lhsOusedFields :: Seq Identifier _lhsOusedFields = rule47 _hdIusedFields _tlIusedFields _lhsOusedLocals :: [Identifier] _lhsOusedLocals = rule48 _hdIusedLocals _tlIusedLocals _output = rule49 _hdIoutput _tlIoutput _lhsOoutput :: HsTokens _lhsOoutput = rule50 _output _hdOallfields = rule51 _lhsIallfields _hdOallnts = rule52 _lhsIallnts _hdOattrs = rule53 _lhsIattrs _hdOcon = rule54 _lhsIcon _hdOfieldnames = rule55 _lhsIfieldnames _hdOnt = rule56 _lhsInt _hdOoptions = rule57 _lhsIoptions _tlOallfields = rule58 _lhsIallfields _tlOallnts = rule59 _lhsIallnts _tlOattrs = rule60 _lhsIattrs _tlOcon = rule61 _lhsIcon _tlOfieldnames = rule62 _lhsIfieldnames _tlOnt = rule63 _lhsInt _tlOoptions = rule64 _lhsIoptions __result_ = T_HsTokens_vOut4 _lhsOerrors _lhsOoutput _lhsOtks _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals in __result_ ) in C_HsTokens_s5 v4 {-# INLINE rule44 #-} {-# LINE 118 "src-ag/SemHsTokens.ag" #-} rule44 = \ ((_hdItok) :: (Pos,String)) ((_tlItks) :: [(Pos,String)]) -> {-# LINE 118 "src-ag/SemHsTokens.ag" #-} _hdItok : _tlItks {-# LINE 473 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule45 #-} rule45 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule46 #-} rule46 = \ ((_hdIusedAttrs) :: [(Identifier,Identifier)]) ((_tlIusedAttrs) :: [(Identifier,Identifier)]) -> _hdIusedAttrs ++ _tlIusedAttrs {-# INLINE rule47 #-} rule47 = \ ((_hdIusedFields) :: Seq Identifier) ((_tlIusedFields) :: Seq Identifier) -> _hdIusedFields Seq.>< _tlIusedFields {-# INLINE rule48 #-} rule48 = \ ((_hdIusedLocals) :: [Identifier]) ((_tlIusedLocals) :: [Identifier]) -> _hdIusedLocals ++ _tlIusedLocals {-# INLINE rule49 #-} rule49 = \ ((_hdIoutput) :: HsToken) ((_tlIoutput) :: HsTokens) -> (:) _hdIoutput _tlIoutput {-# INLINE rule50 #-} rule50 = \ _output -> _output {-# INLINE rule51 #-} rule51 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) -> _lhsIallfields {-# INLINE rule52 #-} rule52 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule53 #-} rule53 = \ ((_lhsIattrs) :: [(Identifier,Identifier)]) -> _lhsIattrs {-# INLINE rule54 #-} rule54 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule55 #-} rule55 = \ ((_lhsIfieldnames) :: [Identifier]) -> _lhsIfieldnames {-# INLINE rule56 #-} rule56 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule57 #-} rule57 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule58 #-} rule58 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) -> _lhsIallfields {-# INLINE rule59 #-} rule59 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule60 #-} rule60 = \ ((_lhsIattrs) :: [(Identifier,Identifier)]) -> _lhsIattrs {-# INLINE rule61 #-} rule61 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule62 #-} rule62 = \ ((_lhsIfieldnames) :: [Identifier]) -> _lhsIfieldnames {-# INLINE rule63 #-} rule63 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule64 #-} rule64 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# NOINLINE sem_HsTokens_Nil #-} sem_HsTokens_Nil :: T_HsTokens sem_HsTokens_Nil = T_HsTokens (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_HsTokens_v4 v4 = \ (T_HsTokens_vIn4 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions) -> ( let _lhsOtks :: [(Pos,String)] _lhsOtks = rule65 () _lhsOerrors :: Seq Error _lhsOerrors = rule66 () _lhsOusedAttrs :: [(Identifier,Identifier)] _lhsOusedAttrs = rule67 () _lhsOusedFields :: Seq Identifier _lhsOusedFields = rule68 () _lhsOusedLocals :: [Identifier] _lhsOusedLocals = rule69 () _output = rule70 () _lhsOoutput :: HsTokens _lhsOoutput = rule71 _output __result_ = T_HsTokens_vOut4 _lhsOerrors _lhsOoutput _lhsOtks _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals in __result_ ) in C_HsTokens_s5 v4 {-# INLINE rule65 #-} {-# LINE 119 "src-ag/SemHsTokens.ag" #-} rule65 = \ (_ :: ()) -> {-# LINE 119 "src-ag/SemHsTokens.ag" #-} [] {-# LINE 562 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule66 #-} rule66 = \ (_ :: ()) -> Seq.empty {-# INLINE rule67 #-} rule67 = \ (_ :: ()) -> [] {-# INLINE rule68 #-} rule68 = \ (_ :: ()) -> Seq.empty {-# INLINE rule69 #-} rule69 = \ (_ :: ()) -> [] {-# INLINE rule70 #-} rule70 = \ (_ :: ()) -> [] {-# INLINE rule71 #-} rule71 = \ _output -> _output -- HsTokensRoot ------------------------------------------------ -- wrapper data Inh_HsTokensRoot = Inh_HsTokensRoot { allfields_Inh_HsTokensRoot :: ([(Identifier,Type,ChildKind)]), allnts_Inh_HsTokensRoot :: ([Identifier]), attrs_Inh_HsTokensRoot :: ([(Identifier,Identifier)]), con_Inh_HsTokensRoot :: (Identifier), nt_Inh_HsTokensRoot :: (Identifier), options_Inh_HsTokensRoot :: (Options) } data Syn_HsTokensRoot = Syn_HsTokensRoot { errors_Syn_HsTokensRoot :: (Seq Error), output_Syn_HsTokensRoot :: ([HsToken]), textLines_Syn_HsTokensRoot :: ([String]), usedAttrs_Syn_HsTokensRoot :: ([(Identifier,Identifier)]), usedFields_Syn_HsTokensRoot :: ([Identifier]), usedLocals_Syn_HsTokensRoot :: ([Identifier]) } {-# INLINABLE wrap_HsTokensRoot #-} wrap_HsTokensRoot :: T_HsTokensRoot -> Inh_HsTokensRoot -> (Syn_HsTokensRoot ) wrap_HsTokensRoot (T_HsTokensRoot act) (Inh_HsTokensRoot _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_HsTokensRoot_vIn7 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt _lhsIoptions (T_HsTokensRoot_vOut7 _lhsOerrors _lhsOoutput _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals) <- return (inv_HsTokensRoot_s8 sem arg7) return (Syn_HsTokensRoot _lhsOerrors _lhsOoutput _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals) ) -- cata {-# INLINE sem_HsTokensRoot #-} sem_HsTokensRoot :: HsTokensRoot -> T_HsTokensRoot sem_HsTokensRoot ( HsTokensRoot tokens_ ) = sem_HsTokensRoot_HsTokensRoot ( sem_HsTokens tokens_ ) -- semantic domain newtype T_HsTokensRoot = T_HsTokensRoot { attach_T_HsTokensRoot :: Identity (T_HsTokensRoot_s8 ) } newtype T_HsTokensRoot_s8 = C_HsTokensRoot_s8 { inv_HsTokensRoot_s8 :: (T_HsTokensRoot_v7 ) } data T_HsTokensRoot_s9 = C_HsTokensRoot_s9 type T_HsTokensRoot_v7 = (T_HsTokensRoot_vIn7 ) -> (T_HsTokensRoot_vOut7 ) data T_HsTokensRoot_vIn7 = T_HsTokensRoot_vIn7 ([(Identifier,Type,ChildKind)]) ([Identifier]) ([(Identifier,Identifier)]) (Identifier) (Identifier) (Options) data T_HsTokensRoot_vOut7 = T_HsTokensRoot_vOut7 (Seq Error) ([HsToken]) ([String]) ([(Identifier,Identifier)]) ([Identifier]) ([Identifier]) {-# NOINLINE sem_HsTokensRoot_HsTokensRoot #-} sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> T_HsTokensRoot sem_HsTokensRoot_HsTokensRoot arg_tokens_ = T_HsTokensRoot (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_HsTokensRoot_v7 v7 = \ (T_HsTokensRoot_vIn7 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt _lhsIoptions) -> ( let _tokensX5 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tokens_)) (T_HsTokens_vOut4 _tokensIerrors _tokensIoutput _tokensItks _tokensIusedAttrs _tokensIusedFields _tokensIusedLocals) = inv_HsTokens_s5 _tokensX5 (T_HsTokens_vIn4 _tokensOallfields _tokensOallnts _tokensOattrs _tokensOcon _tokensOfieldnames _tokensOnt _tokensOoptions) _tokensOfieldnames = rule72 _lhsIallfields _lhsOusedFields :: [Identifier] _lhsOusedFields = rule73 _tokensIusedFields _lhsOtextLines :: [String] _lhsOtextLines = rule74 _tokensItks _lhsOerrors :: Seq Error _lhsOerrors = rule75 _tokensIerrors _lhsOoutput :: [HsToken] _lhsOoutput = rule76 _tokensIoutput _lhsOusedAttrs :: [(Identifier,Identifier)] _lhsOusedAttrs = rule77 _tokensIusedAttrs _lhsOusedLocals :: [Identifier] _lhsOusedLocals = rule78 _tokensIusedLocals _tokensOallfields = rule79 _lhsIallfields _tokensOallnts = rule80 _lhsIallnts _tokensOattrs = rule81 _lhsIattrs _tokensOcon = rule82 _lhsIcon _tokensOnt = rule83 _lhsInt _tokensOoptions = rule84 _lhsIoptions __result_ = T_HsTokensRoot_vOut7 _lhsOerrors _lhsOoutput _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals in __result_ ) in C_HsTokensRoot_s8 v7 {-# INLINE rule72 #-} {-# LINE 39 "src-ag/SemHsTokens.ag" #-} rule72 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) -> {-# LINE 39 "src-ag/SemHsTokens.ag" #-} map (\(n,_,_) -> n) _lhsIallfields {-# LINE 648 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule73 #-} {-# LINE 108 "src-ag/SemHsTokens.ag" #-} rule73 = \ ((_tokensIusedFields) :: Seq Identifier) -> {-# LINE 108 "src-ag/SemHsTokens.ag" #-} toList _tokensIusedFields {-# LINE 654 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule74 #-} {-# LINE 115 "src-ag/SemHsTokens.ag" #-} rule74 = \ ((_tokensItks) :: [(Pos,String)]) -> {-# LINE 115 "src-ag/SemHsTokens.ag" #-} showTokens _tokensItks {-# LINE 660 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule75 #-} rule75 = \ ((_tokensIerrors) :: Seq Error) -> _tokensIerrors {-# INLINE rule76 #-} rule76 = \ ((_tokensIoutput) :: HsTokens) -> _tokensIoutput {-# INLINE rule77 #-} rule77 = \ ((_tokensIusedAttrs) :: [(Identifier,Identifier)]) -> _tokensIusedAttrs {-# INLINE rule78 #-} rule78 = \ ((_tokensIusedLocals) :: [Identifier]) -> _tokensIusedLocals {-# INLINE rule79 #-} rule79 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) -> _lhsIallfields {-# INLINE rule80 #-} rule80 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule81 #-} rule81 = \ ((_lhsIattrs) :: [(Identifier,Identifier)]) -> _lhsIattrs {-# INLINE rule82 #-} rule82 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule83 #-} rule83 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule84 #-} rule84 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions uuagc-0.9.52.2/src-generated/HsToken.hs0000644000000000000000000000343113433540502015673 0ustar0000000000000000 -- UUAGC 0.9.51 (src-ag/HsToken.ag) module HsToken where {-# LINE 2 "src-ag/HsToken.ag" #-} import CommonTypes import UU.Scanner.Position(Pos) {-# LINE 10 "dist/build/HsToken.hs" #-} -- HsToken ----------------------------------------------------- {- alternatives: alternative AGLocal: child var : {Identifier} child pos : {Pos} child rdesc : {Maybe String} alternative AGField: child field : {Identifier} child attr : {Identifier} child pos : {Pos} child rdesc : {Maybe String} alternative HsToken: child value : {String} child pos : {Pos} alternative CharToken: child value : {String} child pos : {Pos} alternative StrToken: child value : {String} child pos : {Pos} alternative Err: child mesg : {String} child pos : {Pos} -} data HsToken = AGLocal (Identifier) (Pos) ((Maybe String)) | AGField (Identifier) (Identifier) (Pos) ((Maybe String)) | HsToken (String) (Pos) | CharToken (String) (Pos) | StrToken (String) (Pos) | Err (String) (Pos) deriving ( Show) -- HsTokens ---------------------------------------------------- {- alternatives: alternative Cons: child hd : HsToken child tl : HsTokens alternative Nil: -} type HsTokens = [HsToken] -- HsTokensRoot ------------------------------------------------ {- alternatives: alternative HsTokensRoot: child tokens : HsTokens -} data HsTokensRoot = HsTokensRoot (HsTokens)uuagc-0.9.52.2/src-generated/KWOrder.hs0000644000000000000000000035476013433540502015653 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module KWOrder where {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 11 "dist/build/KWOrder.hs" #-} {-# LINE 2 "src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken {-# LINE 17 "dist/build/KWOrder.hs" #-} {-# LINE 2 "src-ag/HsToken.ag" #-} import CommonTypes import UU.Scanner.Position(Pos) {-# LINE 23 "dist/build/KWOrder.hs" #-} {-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) import Data.Map(Map) import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import Macro --marcos import CommonTypes import ErrorMessages {-# LINE 35 "dist/build/KWOrder.hs" #-} {-# LINE 10 "src-ag/KWOrder.ag" #-} import AbstractSyntax import HsToken import Expression import Patterns import Options import PPUtil import Pretty import Knuth1 import KennedyWarren import ExecutionPlan import Data.Maybe import Debug.Trace import Data.Set(Set) import Data.Map(Map) import Data.Sequence(Seq) import qualified Data.Set as Set import qualified Data.Map as Map import qualified Data.Sequence as Seq import Data.Monoid(mappend,mempty) {-# LINE 58 "dist/build/KWOrder.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 125 "src-ag/KWOrder.ag" #-} -- a depends on b, thus a is a successor of b depToEdge :: Dependency -> Edge depToEdge (Dependency a b) = (occToVertex False b, occToVertex True a) occToVertex :: Bool -> Occurrence -> Vertex occToVertex _ (OccRule nm) = VRule nm occToVertex isDependency (OccAttr c a) | c == _LOC = VAttr Syn c a -- local attributes are treated as synthesized attrs of 'loc' | c == _INST = VChild a -- higher-order attributes are treated as children | otherwise = VAttr kind c a where kind | isDependency && c == _LHS = Inh -- these dependencies have the property that | isDependency && c /= _LHS = Syn -- they can all be faked by writing a 'const' rule | not isDependency && c == _LHS = Syn -- Perhaps we should also allow other forms of dependencies | not isDependency && c /= _LHS = Inh -- as well, such as two inherited attributes, which would -- force them in different visits {-# LINE 78 "dist/build/KWOrder.hs" #-} -- Child ------------------------------------------------------- -- wrapper data Inh_Child = Inh_Child { aroundMap_Inh_Child :: (Map Identifier [Expression]), inhMap_Inh_Child :: (Map Identifier Attributes), mergeMap_Inh_Child :: (Map Identifier (Identifier, [Identifier], Expression)), mergedChildren_Inh_Child :: (Set Identifier), options_Inh_Child :: (Options), synMap_Inh_Child :: (Map Identifier Attributes) } data Syn_Child = Syn_Child { echilds_Syn_Child :: (EChild), edges_Syn_Child :: (Set.Set Edge), nontnames_Syn_Child :: ([(Identifier, Identifier)]), refHoNts_Syn_Child :: (Set NontermIdent), refNts_Syn_Child :: (Set NontermIdent), vertices_Syn_Child :: (Set.Set Vertex) } {-# INLINABLE wrap_Child #-} wrap_Child :: T_Child -> Inh_Child -> (Syn_Child ) wrap_Child (T_Child act) (Inh_Child _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_Child_vIn1 _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap (T_Child_vOut1 _lhsOechilds _lhsOedges _lhsOnontnames _lhsOrefHoNts _lhsOrefNts _lhsOvertices) <- return (inv_Child_s2 sem arg1) return (Syn_Child _lhsOechilds _lhsOedges _lhsOnontnames _lhsOrefHoNts _lhsOrefNts _lhsOvertices) ) -- cata {-# INLINE sem_Child #-} sem_Child :: Child -> T_Child sem_Child ( Child name_ tp_ kind_ ) = sem_Child_Child name_ tp_ kind_ -- semantic domain newtype T_Child = T_Child { attach_T_Child :: Identity (T_Child_s2 ) } newtype T_Child_s2 = C_Child_s2 { inv_Child_s2 :: (T_Child_v1 ) } data T_Child_s3 = C_Child_s3 type T_Child_v1 = (T_Child_vIn1 ) -> (T_Child_vOut1 ) data T_Child_vIn1 = T_Child_vIn1 (Map Identifier [Expression]) (Map Identifier Attributes) (Map Identifier (Identifier, [Identifier], Expression)) (Set Identifier) (Options) (Map Identifier Attributes) data T_Child_vOut1 = T_Child_vOut1 (EChild) (Set.Set Edge) ([(Identifier, Identifier)]) (Set NontermIdent) (Set NontermIdent) (Set.Set Vertex) {-# NOINLINE sem_Child_Child #-} sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child sem_Child_Child arg_name_ arg_tp_ arg_kind_ = T_Child (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Child_v1 v1 = \ (T_Child_vIn1 _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap) -> ( let _refNts = rule0 arg_tp_ _refHoNts = rule1 _isHigherOrder _refNts _isHigherOrder = rule2 arg_kind_ _hasArounds = rule3 _lhsIaroundMap arg_name_ _merges = rule4 _lhsImergeMap arg_name_ _isMerged = rule5 _lhsImergedChildren arg_name_ _lhsOechilds :: EChild _lhsOechilds = rule6 _hasArounds _isMerged _merges arg_kind_ arg_name_ arg_tp_ _chnt = rule7 arg_name_ arg_tp_ _inh = rule8 _chnt _lhsIinhMap _syn = rule9 _chnt _lhsIsynMap _vertex = rule10 arg_name_ _synvertices = rule11 _syn arg_name_ _inhvertices = rule12 _inh arg_name_ _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule13 _inhvertices _synvertices _vertex arg_tp_ _childIsDeforested = rule14 arg_tp_ _higherOrderEdges = rule15 _childIsDeforested _lhsIoptions _vertex arg_kind_ _aroundEdges = rule16 _hasArounds _vertex arg_name_ _edgesout = rule17 _higherOrderEdges _edgesin = rule18 _synvertices _vertex _lhsOedges :: Set.Set Edge _lhsOedges = rule19 _edgesin _edgesout _lhsOnontnames :: [(Identifier, Identifier)] _lhsOnontnames = rule20 arg_name_ arg_tp_ _lhsOrefHoNts :: Set NontermIdent _lhsOrefHoNts = rule21 _refHoNts _lhsOrefNts :: Set NontermIdent _lhsOrefNts = rule22 _refNts __result_ = T_Child_vOut1 _lhsOechilds _lhsOedges _lhsOnontnames _lhsOrefHoNts _lhsOrefNts _lhsOvertices in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} {-# LINE 31 "src-ag/ExecutionPlanCommon.ag" #-} rule0 = \ tp_ -> {-# LINE 31 "src-ag/ExecutionPlanCommon.ag" #-} case tp_ of NT nt _ _ -> Set.singleton nt _ -> mempty {-# LINE 155 "dist/build/KWOrder.hs"#-} {-# INLINE rule1 #-} {-# LINE 34 "src-ag/ExecutionPlanCommon.ag" #-} rule1 = \ _isHigherOrder _refNts -> {-# LINE 34 "src-ag/ExecutionPlanCommon.ag" #-} if _isHigherOrder then _refNts else mempty {-# LINE 161 "dist/build/KWOrder.hs"#-} {-# INLINE rule2 #-} {-# LINE 35 "src-ag/ExecutionPlanCommon.ag" #-} rule2 = \ kind_ -> {-# LINE 35 "src-ag/ExecutionPlanCommon.ag" #-} case kind_ of ChildSyntax -> False _ -> True {-# LINE 169 "dist/build/KWOrder.hs"#-} {-# INLINE rule3 #-} {-# LINE 95 "src-ag/ExecutionPlanCommon.ag" #-} rule3 = \ ((_lhsIaroundMap) :: Map Identifier [Expression]) name_ -> {-# LINE 95 "src-ag/ExecutionPlanCommon.ag" #-} case Map.lookup name_ _lhsIaroundMap of Nothing -> False Just as -> not (null as) {-# LINE 177 "dist/build/KWOrder.hs"#-} {-# INLINE rule4 #-} {-# LINE 123 "src-ag/ExecutionPlanCommon.ag" #-} rule4 = \ ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier], Expression)) name_ -> {-# LINE 123 "src-ag/ExecutionPlanCommon.ag" #-} maybe Nothing (\(_,ms,_) -> Just ms) $ Map.lookup name_ _lhsImergeMap {-# LINE 183 "dist/build/KWOrder.hs"#-} {-# INLINE rule5 #-} {-# LINE 124 "src-ag/ExecutionPlanCommon.ag" #-} rule5 = \ ((_lhsImergedChildren) :: Set Identifier) name_ -> {-# LINE 124 "src-ag/ExecutionPlanCommon.ag" #-} name_ `Set.member` _lhsImergedChildren {-# LINE 189 "dist/build/KWOrder.hs"#-} {-# INLINE rule6 #-} {-# LINE 135 "src-ag/ExecutionPlanCommon.ag" #-} rule6 = \ _hasArounds _isMerged _merges kind_ name_ tp_ -> {-# LINE 135 "src-ag/ExecutionPlanCommon.ag" #-} case tp_ of NT _ _ _ -> EChild name_ tp_ kind_ _hasArounds _merges _isMerged _ -> ETerm name_ tp_ {-# LINE 197 "dist/build/KWOrder.hs"#-} {-# INLINE rule7 #-} {-# LINE 19 "src-ag/DistChildAttr.ag" #-} rule7 = \ name_ tp_ -> {-# LINE 19 "src-ag/DistChildAttr.ag" #-} case tp_ of NT nt _ _ -> nt Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") Haskell t -> identifier "" {-# LINE 206 "dist/build/KWOrder.hs"#-} {-# INLINE rule8 #-} {-# LINE 23 "src-ag/DistChildAttr.ag" #-} rule8 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> {-# LINE 23 "src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIinhMap {-# LINE 212 "dist/build/KWOrder.hs"#-} {-# INLINE rule9 #-} {-# LINE 24 "src-ag/DistChildAttr.ag" #-} rule9 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> {-# LINE 24 "src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIsynMap {-# LINE 218 "dist/build/KWOrder.hs"#-} {-# INLINE rule10 #-} {-# LINE 65 "src-ag/KWOrder.ag" #-} rule10 = \ name_ -> {-# LINE 65 "src-ag/KWOrder.ag" #-} VChild name_ {-# LINE 224 "dist/build/KWOrder.hs"#-} {-# INLINE rule11 #-} {-# LINE 66 "src-ag/KWOrder.ag" #-} rule11 = \ _syn name_ -> {-# LINE 66 "src-ag/KWOrder.ag" #-} map (VAttr Syn name_) . Map.keys $ _syn {-# LINE 230 "dist/build/KWOrder.hs"#-} {-# INLINE rule12 #-} {-# LINE 67 "src-ag/KWOrder.ag" #-} rule12 = \ _inh name_ -> {-# LINE 67 "src-ag/KWOrder.ag" #-} map (VAttr Inh name_) . Map.keys $ _inh {-# LINE 236 "dist/build/KWOrder.hs"#-} {-# INLINE rule13 #-} {-# LINE 68 "src-ag/KWOrder.ag" #-} rule13 = \ _inhvertices _synvertices _vertex tp_ -> {-# LINE 68 "src-ag/KWOrder.ag" #-} case tp_ of NT _ _ _ -> Set.insert _vertex $ Set.fromList (_synvertices ++ _inhvertices ) _ -> Set.empty {-# LINE 244 "dist/build/KWOrder.hs"#-} {-# INLINE rule14 #-} {-# LINE 98 "src-ag/KWOrder.ag" #-} rule14 = \ tp_ -> {-# LINE 98 "src-ag/KWOrder.ag" #-} case tp_ of NT _ _ defor -> defor _ -> False {-# LINE 252 "dist/build/KWOrder.hs"#-} {-# INLINE rule15 #-} {-# LINE 101 "src-ag/KWOrder.ag" #-} rule15 = \ _childIsDeforested ((_lhsIoptions) :: Options) _vertex kind_ -> {-# LINE 101 "src-ag/KWOrder.ag" #-} case kind_ of ChildAttr | lateHigherOrderBinding _lhsIoptions && not _childIsDeforested -> [(_vertex , VAttr Inh _LHS idLateBindingAttr)] _ -> [] {-# LINE 261 "dist/build/KWOrder.hs"#-} {-# INLINE rule16 #-} {-# LINE 105 "src-ag/KWOrder.ag" #-} rule16 = \ _hasArounds _vertex name_ -> {-# LINE 105 "src-ag/KWOrder.ag" #-} if _hasArounds then [(_vertex , VAttr Syn _LOC (Ident (getName name_ ++ "_around") (getPos name_)))] else [] {-# LINE 269 "dist/build/KWOrder.hs"#-} {-# INLINE rule17 #-} {-# LINE 111 "src-ag/KWOrder.ag" #-} rule17 = \ _higherOrderEdges -> {-# LINE 111 "src-ag/KWOrder.ag" #-} _higherOrderEdges {-# LINE 275 "dist/build/KWOrder.hs"#-} {-# INLINE rule18 #-} {-# LINE 112 "src-ag/KWOrder.ag" #-} rule18 = \ _synvertices _vertex -> {-# LINE 112 "src-ag/KWOrder.ag" #-} map (flip (,) _vertex ) _synvertices {-# LINE 281 "dist/build/KWOrder.hs"#-} {-# INLINE rule19 #-} {-# LINE 113 "src-ag/KWOrder.ag" #-} rule19 = \ _edgesin _edgesout -> {-# LINE 113 "src-ag/KWOrder.ag" #-} Set.fromList (_edgesout ++ _edgesin ) {-# LINE 287 "dist/build/KWOrder.hs"#-} {-# INLINE rule20 #-} {-# LINE 151 "src-ag/KWOrder.ag" #-} rule20 = \ name_ tp_ -> {-# LINE 151 "src-ag/KWOrder.ag" #-} case tp_ of NT nont _ _ -> [(name_, nont)] _ -> [] {-# LINE 295 "dist/build/KWOrder.hs"#-} {-# INLINE rule21 #-} rule21 = \ _refHoNts -> _refHoNts {-# INLINE rule22 #-} rule22 = \ _refNts -> _refNts -- Children ---------------------------------------------------- -- wrapper data Inh_Children = Inh_Children { aroundMap_Inh_Children :: (Map Identifier [Expression]), inhMap_Inh_Children :: (Map Identifier Attributes), mergeMap_Inh_Children :: (Map Identifier (Identifier, [Identifier], Expression)), mergedChildren_Inh_Children :: (Set Identifier), options_Inh_Children :: (Options), synMap_Inh_Children :: (Map Identifier Attributes) } data Syn_Children = Syn_Children { echilds_Syn_Children :: (EChildren), edges_Syn_Children :: (Set.Set Edge), nontnames_Syn_Children :: ([(Identifier, Identifier)]), refHoNts_Syn_Children :: (Set NontermIdent), refNts_Syn_Children :: (Set NontermIdent), vertices_Syn_Children :: (Set.Set Vertex) } {-# INLINABLE wrap_Children #-} wrap_Children :: T_Children -> Inh_Children -> (Syn_Children ) wrap_Children (T_Children act) (Inh_Children _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_Children_vIn4 _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap (T_Children_vOut4 _lhsOechilds _lhsOedges _lhsOnontnames _lhsOrefHoNts _lhsOrefNts _lhsOvertices) <- return (inv_Children_s5 sem arg4) return (Syn_Children _lhsOechilds _lhsOedges _lhsOnontnames _lhsOrefHoNts _lhsOrefNts _lhsOvertices) ) -- cata {-# NOINLINE sem_Children #-} sem_Children :: Children -> T_Children sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) -- semantic domain newtype T_Children = T_Children { attach_T_Children :: Identity (T_Children_s5 ) } newtype T_Children_s5 = C_Children_s5 { inv_Children_s5 :: (T_Children_v4 ) } data T_Children_s6 = C_Children_s6 type T_Children_v4 = (T_Children_vIn4 ) -> (T_Children_vOut4 ) data T_Children_vIn4 = T_Children_vIn4 (Map Identifier [Expression]) (Map Identifier Attributes) (Map Identifier (Identifier, [Identifier], Expression)) (Set Identifier) (Options) (Map Identifier Attributes) data T_Children_vOut4 = T_Children_vOut4 (EChildren) (Set.Set Edge) ([(Identifier, Identifier)]) (Set NontermIdent) (Set NontermIdent) (Set.Set Vertex) {-# NOINLINE sem_Children_Cons #-} sem_Children_Cons :: T_Child -> T_Children -> T_Children sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_Children_v4 v4 = \ (T_Children_vIn4 _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap) -> ( let _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) (T_Child_vOut1 _hdIechilds _hdIedges _hdInontnames _hdIrefHoNts _hdIrefNts _hdIvertices) = inv_Child_s2 _hdX2 (T_Child_vIn1 _hdOaroundMap _hdOinhMap _hdOmergeMap _hdOmergedChildren _hdOoptions _hdOsynMap) (T_Children_vOut4 _tlIechilds _tlIedges _tlInontnames _tlIrefHoNts _tlIrefNts _tlIvertices) = inv_Children_s5 _tlX5 (T_Children_vIn4 _tlOaroundMap _tlOinhMap _tlOmergeMap _tlOmergedChildren _tlOoptions _tlOsynMap) _lhsOechilds :: EChildren _lhsOechilds = rule23 _hdIechilds _tlIechilds _lhsOedges :: Set.Set Edge _lhsOedges = rule24 _hdIedges _tlIedges _lhsOnontnames :: [(Identifier, Identifier)] _lhsOnontnames = rule25 _hdInontnames _tlInontnames _lhsOrefHoNts :: Set NontermIdent _lhsOrefHoNts = rule26 _hdIrefHoNts _tlIrefHoNts _lhsOrefNts :: Set NontermIdent _lhsOrefNts = rule27 _hdIrefNts _tlIrefNts _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule28 _hdIvertices _tlIvertices _hdOaroundMap = rule29 _lhsIaroundMap _hdOinhMap = rule30 _lhsIinhMap _hdOmergeMap = rule31 _lhsImergeMap _hdOmergedChildren = rule32 _lhsImergedChildren _hdOoptions = rule33 _lhsIoptions _hdOsynMap = rule34 _lhsIsynMap _tlOaroundMap = rule35 _lhsIaroundMap _tlOinhMap = rule36 _lhsIinhMap _tlOmergeMap = rule37 _lhsImergeMap _tlOmergedChildren = rule38 _lhsImergedChildren _tlOoptions = rule39 _lhsIoptions _tlOsynMap = rule40 _lhsIsynMap __result_ = T_Children_vOut4 _lhsOechilds _lhsOedges _lhsOnontnames _lhsOrefHoNts _lhsOrefNts _lhsOvertices in __result_ ) in C_Children_s5 v4 {-# INLINE rule23 #-} rule23 = \ ((_hdIechilds) :: EChild) ((_tlIechilds) :: EChildren) -> _hdIechilds : _tlIechilds {-# INLINE rule24 #-} rule24 = \ ((_hdIedges) :: Set.Set Edge) ((_tlIedges) :: Set.Set Edge) -> _hdIedges `Set.union` _tlIedges {-# INLINE rule25 #-} rule25 = \ ((_hdInontnames) :: [(Identifier, Identifier)]) ((_tlInontnames) :: [(Identifier, Identifier)]) -> _hdInontnames ++ _tlInontnames {-# INLINE rule26 #-} rule26 = \ ((_hdIrefHoNts) :: Set NontermIdent) ((_tlIrefHoNts) :: Set NontermIdent) -> _hdIrefHoNts `mappend` _tlIrefHoNts {-# INLINE rule27 #-} rule27 = \ ((_hdIrefNts) :: Set NontermIdent) ((_tlIrefNts) :: Set NontermIdent) -> _hdIrefNts `mappend` _tlIrefNts {-# INLINE rule28 #-} rule28 = \ ((_hdIvertices) :: Set.Set Vertex) ((_tlIvertices) :: Set.Set Vertex) -> _hdIvertices `Set.union` _tlIvertices {-# INLINE rule29 #-} rule29 = \ ((_lhsIaroundMap) :: Map Identifier [Expression]) -> _lhsIaroundMap {-# INLINE rule30 #-} rule30 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule31 #-} rule31 = \ ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier], Expression)) -> _lhsImergeMap {-# INLINE rule32 #-} rule32 = \ ((_lhsImergedChildren) :: Set Identifier) -> _lhsImergedChildren {-# INLINE rule33 #-} rule33 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule34 #-} rule34 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule35 #-} rule35 = \ ((_lhsIaroundMap) :: Map Identifier [Expression]) -> _lhsIaroundMap {-# INLINE rule36 #-} rule36 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule37 #-} rule37 = \ ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier], Expression)) -> _lhsImergeMap {-# INLINE rule38 #-} rule38 = \ ((_lhsImergedChildren) :: Set Identifier) -> _lhsImergedChildren {-# INLINE rule39 #-} rule39 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule40 #-} rule40 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE sem_Children_Nil #-} sem_Children_Nil :: T_Children sem_Children_Nil = T_Children (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_Children_v4 v4 = \ (T_Children_vIn4 _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap) -> ( let _lhsOechilds :: EChildren _lhsOechilds = rule41 () _lhsOedges :: Set.Set Edge _lhsOedges = rule42 () _lhsOnontnames :: [(Identifier, Identifier)] _lhsOnontnames = rule43 () _lhsOrefHoNts :: Set NontermIdent _lhsOrefHoNts = rule44 () _lhsOrefNts :: Set NontermIdent _lhsOrefNts = rule45 () _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule46 () __result_ = T_Children_vOut4 _lhsOechilds _lhsOedges _lhsOnontnames _lhsOrefHoNts _lhsOrefNts _lhsOvertices in __result_ ) in C_Children_s5 v4 {-# INLINE rule41 #-} rule41 = \ (_ :: ()) -> [] {-# INLINE rule42 #-} rule42 = \ (_ :: ()) -> Set.empty {-# INLINE rule43 #-} rule43 = \ (_ :: ()) -> [] {-# INLINE rule44 #-} rule44 = \ (_ :: ()) -> mempty {-# INLINE rule45 #-} rule45 = \ (_ :: ()) -> mempty {-# INLINE rule46 #-} rule46 = \ (_ :: ()) -> Set.empty -- Expression -------------------------------------------------- -- wrapper data Inh_Expression = Inh_Expression { } data Syn_Expression = Syn_Expression { copy_Syn_Expression :: (Expression), vertices_Syn_Expression :: (Set.Set Vertex) } {-# INLINABLE wrap_Expression #-} wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) wrap_Expression (T_Expression act) (Inh_Expression ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_Expression_vIn7 (T_Expression_vOut7 _lhsOcopy _lhsOvertices) <- return (inv_Expression_s8 sem arg7) return (Syn_Expression _lhsOcopy _lhsOvertices) ) -- cata {-# INLINE sem_Expression #-} sem_Expression :: Expression -> T_Expression sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_ -- semantic domain newtype T_Expression = T_Expression { attach_T_Expression :: Identity (T_Expression_s8 ) } newtype T_Expression_s8 = C_Expression_s8 { inv_Expression_s8 :: (T_Expression_v7 ) } data T_Expression_s9 = C_Expression_s9 type T_Expression_v7 = (T_Expression_vIn7 ) -> (T_Expression_vOut7 ) data T_Expression_vIn7 = T_Expression_vIn7 data T_Expression_vOut7 = T_Expression_vOut7 (Expression) (Set.Set Vertex) {-# NOINLINE sem_Expression_Expression #-} sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression sem_Expression_Expression arg_pos_ arg_tks_ = T_Expression (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_Expression_v7 v7 = \ (T_Expression_vIn7 ) -> ( let _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule47 arg_tks_ _copy = rule48 arg_pos_ arg_tks_ _lhsOcopy :: Expression _lhsOcopy = rule49 _copy __result_ = T_Expression_vOut7 _lhsOcopy _lhsOvertices in __result_ ) in C_Expression_s8 v7 {-# INLINE rule47 #-} {-# LINE 50 "src-ag/KWOrder.ag" #-} rule47 = \ tks_ -> {-# LINE 50 "src-ag/KWOrder.ag" #-} Set.unions $ map (\tok -> vertices_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_ {-# LINE 517 "dist/build/KWOrder.hs"#-} {-# INLINE rule48 #-} rule48 = \ pos_ tks_ -> Expression pos_ tks_ {-# INLINE rule49 #-} rule49 = \ _copy -> _copy -- Grammar ----------------------------------------------------- -- wrapper data Inh_Grammar = Inh_Grammar { options_Inh_Grammar :: (Options) } data Syn_Grammar = Syn_Grammar { depgraphs_Syn_Grammar :: (PP_Doc), errors_Syn_Grammar :: (Seq Error), inhmap_Syn_Grammar :: (Map.Map NontermIdent Attributes), localSigMap_Syn_Grammar :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))), output_Syn_Grammar :: (ExecutionPlan), synmap_Syn_Grammar :: (Map.Map NontermIdent Attributes), visitgraph_Syn_Grammar :: (PP_Doc) } {-# INLINABLE wrap_Grammar #-} wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar ) wrap_Grammar (T_Grammar act) (Inh_Grammar _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg10 = T_Grammar_vIn10 _lhsIoptions (T_Grammar_vOut10 _lhsOdepgraphs _lhsOerrors _lhsOinhmap _lhsOlocalSigMap _lhsOoutput _lhsOsynmap _lhsOvisitgraph) <- return (inv_Grammar_s11 sem arg10) return (Syn_Grammar _lhsOdepgraphs _lhsOerrors _lhsOinhmap _lhsOlocalSigMap _lhsOoutput _lhsOsynmap _lhsOvisitgraph) ) -- cata {-# INLINE sem_Grammar #-} sem_Grammar :: Grammar -> T_Grammar sem_Grammar ( Grammar typeSyns_ useMap_ derivings_ wrappers_ nonts_ pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ -- semantic domain newtype T_Grammar = T_Grammar { attach_T_Grammar :: Identity (T_Grammar_s11 ) } newtype T_Grammar_s11 = C_Grammar_s11 { inv_Grammar_s11 :: (T_Grammar_v10 ) } data T_Grammar_s12 = C_Grammar_s12 type T_Grammar_v10 = (T_Grammar_vIn10 ) -> (T_Grammar_vOut10 ) data T_Grammar_vIn10 = T_Grammar_vIn10 (Options) data T_Grammar_vOut10 = T_Grammar_vOut10 (PP_Doc) (Seq Error) (Map.Map NontermIdent Attributes) (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) (ExecutionPlan) (Map.Map NontermIdent Attributes) (PP_Doc) {-# NOINLINE sem_Grammar_Grammar #-} sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar sem_Grammar_Grammar arg_typeSyns_ _ arg_derivings_ arg_wrappers_ arg_nonts_ _ arg_manualAttrOrderMap_ _ arg_contextMap_ _ _ _ arg_aroundsMap_ arg_mergeMap_ = T_Grammar (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_Grammar_v10 v10 = \ (T_Grammar_vIn10 _lhsIoptions) -> ( let _nontsX26 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) (T_Nonterminals_vOut25 _nontsIdepinfo _nontsIinhMap' _nontsIinhmap _nontsIlocalSigMap _nontsIntDeps _nontsIntHoDeps _nontsIrulenumber _nontsIsynMap' _nontsIsynmap) = inv_Nonterminals_s26 _nontsX26 (T_Nonterminals_vIn25 _nontsOaroundMap _nontsOclassContexts _nontsOclosedHoNtDeps _nontsOclosedHoNtRevDeps _nontsOclosedNtDeps _nontsOinhMap _nontsOmanualDeps _nontsOmergeMap _nontsOoptions _nontsOrulenumber _nontsOsynMap) _closedNtDeps = rule50 _nontsIntDeps _closedHoNtDeps = rule51 _nontsIntHoDeps _closedHoNtRevDeps = rule52 _closedHoNtDeps _nontsOclassContexts = rule53 arg_contextMap_ _nontsOaroundMap = rule54 arg_aroundsMap_ _nontsOmergeMap = rule55 arg_mergeMap_ _nontsOrulenumber = rule56 () _nontsOinhMap = rule57 _nontsIinhMap' _nontsOsynMap = rule58 _nontsIsynMap' _nontsOmanualDeps = rule59 arg_manualAttrOrderMap_ _lhsOoutput :: ExecutionPlan _lhsOdepgraphs :: PP_Doc _lhsOvisitgraph :: PP_Doc _lhsOerrors :: Seq Error (_lhsOoutput,_lhsOdepgraphs,_lhsOvisitgraph,_lhsOerrors) = rule60 _lhsIoptions _nontsIdepinfo arg_derivings_ arg_typeSyns_ arg_wrappers_ _lhsOinhmap :: Map.Map NontermIdent Attributes _lhsOinhmap = rule61 _nontsIinhmap _lhsOlocalSigMap :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type)) _lhsOlocalSigMap = rule62 _nontsIlocalSigMap _lhsOsynmap :: Map.Map NontermIdent Attributes _lhsOsynmap = rule63 _nontsIsynmap _nontsOclosedHoNtDeps = rule64 _closedHoNtDeps _nontsOclosedHoNtRevDeps = rule65 _closedHoNtRevDeps _nontsOclosedNtDeps = rule66 _closedNtDeps _nontsOoptions = rule67 _lhsIoptions __result_ = T_Grammar_vOut10 _lhsOdepgraphs _lhsOerrors _lhsOinhmap _lhsOlocalSigMap _lhsOoutput _lhsOsynmap _lhsOvisitgraph in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule50 #-} {-# LINE 40 "src-ag/ExecutionPlanCommon.ag" #-} rule50 = \ ((_nontsIntDeps) :: Map NontermIdent (Set NontermIdent)) -> {-# LINE 40 "src-ag/ExecutionPlanCommon.ag" #-} closeMap _nontsIntDeps {-# LINE 597 "dist/build/KWOrder.hs"#-} {-# INLINE rule51 #-} {-# LINE 41 "src-ag/ExecutionPlanCommon.ag" #-} rule51 = \ ((_nontsIntHoDeps) :: Map NontermIdent (Set NontermIdent)) -> {-# LINE 41 "src-ag/ExecutionPlanCommon.ag" #-} closeMap _nontsIntHoDeps {-# LINE 603 "dist/build/KWOrder.hs"#-} {-# INLINE rule52 #-} {-# LINE 42 "src-ag/ExecutionPlanCommon.ag" #-} rule52 = \ _closedHoNtDeps -> {-# LINE 42 "src-ag/ExecutionPlanCommon.ag" #-} revDeps _closedHoNtDeps {-# LINE 609 "dist/build/KWOrder.hs"#-} {-# INLINE rule53 #-} {-# LINE 51 "src-ag/ExecutionPlanCommon.ag" #-} rule53 = \ contextMap_ -> {-# LINE 51 "src-ag/ExecutionPlanCommon.ag" #-} contextMap_ {-# LINE 615 "dist/build/KWOrder.hs"#-} {-# INLINE rule54 #-} {-# LINE 92 "src-ag/ExecutionPlanCommon.ag" #-} rule54 = \ aroundsMap_ -> {-# LINE 92 "src-ag/ExecutionPlanCommon.ag" #-} aroundsMap_ {-# LINE 621 "dist/build/KWOrder.hs"#-} {-# INLINE rule55 #-} {-# LINE 117 "src-ag/ExecutionPlanCommon.ag" #-} rule55 = \ mergeMap_ -> {-# LINE 117 "src-ag/ExecutionPlanCommon.ag" #-} mergeMap_ {-# LINE 627 "dist/build/KWOrder.hs"#-} {-# INLINE rule56 #-} {-# LINE 9 "src-ag/ExecutionPlanPre.ag" #-} rule56 = \ (_ :: ()) -> {-# LINE 9 "src-ag/ExecutionPlanPre.ag" #-} 0 {-# LINE 633 "dist/build/KWOrder.hs"#-} {-# INLINE rule57 #-} {-# LINE 15 "src-ag/DistChildAttr.ag" #-} rule57 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> {-# LINE 15 "src-ag/DistChildAttr.ag" #-} _nontsIinhMap' {-# LINE 639 "dist/build/KWOrder.hs"#-} {-# INLINE rule58 #-} {-# LINE 16 "src-ag/DistChildAttr.ag" #-} rule58 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> {-# LINE 16 "src-ag/DistChildAttr.ag" #-} _nontsIsynMap' {-# LINE 645 "dist/build/KWOrder.hs"#-} {-# INLINE rule59 #-} {-# LINE 119 "src-ag/KWOrder.ag" #-} rule59 = \ manualAttrOrderMap_ -> {-# LINE 119 "src-ag/KWOrder.ag" #-} manualAttrOrderMap_ {-# LINE 651 "dist/build/KWOrder.hs"#-} {-# INLINE rule60 #-} {-# LINE 210 "src-ag/KWOrder.ag" #-} rule60 = \ ((_lhsIoptions) :: Options) ((_nontsIdepinfo) :: [NontDependencyInformation]) derivings_ typeSyns_ wrappers_ -> {-# LINE 210 "src-ag/KWOrder.ag" #-} let lazyPlan = kennedyWarrenLazy _lhsIoptions wrappers_ _nontsIdepinfo typeSyns_ derivings_ in if visit _lhsIoptions && withCycle _lhsIoptions then case kennedyWarrenOrder _lhsIoptions wrappers_ _nontsIdepinfo typeSyns_ derivings_ of Left e -> (lazyPlan,empty,empty,Seq.singleton e) Right (o,d,v) -> (o,d,v,Seq.empty) else (lazyPlan,empty,empty,Seq.empty) {-# LINE 662 "dist/build/KWOrder.hs"#-} {-# INLINE rule61 #-} rule61 = \ ((_nontsIinhmap) :: Map.Map NontermIdent Attributes) -> _nontsIinhmap {-# INLINE rule62 #-} rule62 = \ ((_nontsIlocalSigMap) :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) -> _nontsIlocalSigMap {-# INLINE rule63 #-} rule63 = \ ((_nontsIsynmap) :: Map.Map NontermIdent Attributes) -> _nontsIsynmap {-# INLINE rule64 #-} rule64 = \ _closedHoNtDeps -> _closedHoNtDeps {-# INLINE rule65 #-} rule65 = \ _closedHoNtRevDeps -> _closedHoNtRevDeps {-# INLINE rule66 #-} rule66 = \ _closedNtDeps -> _closedNtDeps {-# INLINE rule67 #-} rule67 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- HsToken ----------------------------------------------------- -- wrapper data Inh_HsToken = Inh_HsToken { } data Syn_HsToken = Syn_HsToken { vertices_Syn_HsToken :: (Set.Set Vertex) } {-# INLINABLE wrap_HsToken #-} wrap_HsToken :: T_HsToken -> Inh_HsToken -> (Syn_HsToken ) wrap_HsToken (T_HsToken act) (Inh_HsToken ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg13 = T_HsToken_vIn13 (T_HsToken_vOut13 _lhsOvertices) <- return (inv_HsToken_s14 sem arg13) return (Syn_HsToken _lhsOvertices) ) -- cata {-# NOINLINE sem_HsToken #-} sem_HsToken :: HsToken -> T_HsToken sem_HsToken ( AGLocal var_ pos_ rdesc_ ) = sem_HsToken_AGLocal var_ pos_ rdesc_ sem_HsToken ( AGField field_ attr_ pos_ rdesc_ ) = sem_HsToken_AGField field_ attr_ pos_ rdesc_ sem_HsToken ( HsToken value_ pos_ ) = sem_HsToken_HsToken value_ pos_ sem_HsToken ( CharToken value_ pos_ ) = sem_HsToken_CharToken value_ pos_ sem_HsToken ( StrToken value_ pos_ ) = sem_HsToken_StrToken value_ pos_ sem_HsToken ( Err mesg_ pos_ ) = sem_HsToken_Err mesg_ pos_ -- semantic domain newtype T_HsToken = T_HsToken { attach_T_HsToken :: Identity (T_HsToken_s14 ) } newtype T_HsToken_s14 = C_HsToken_s14 { inv_HsToken_s14 :: (T_HsToken_v13 ) } data T_HsToken_s15 = C_HsToken_s15 type T_HsToken_v13 = (T_HsToken_vIn13 ) -> (T_HsToken_vOut13 ) data T_HsToken_vIn13 = T_HsToken_vIn13 data T_HsToken_vOut13 = T_HsToken_vOut13 (Set.Set Vertex) {-# NOINLINE sem_HsToken_AGLocal #-} sem_HsToken_AGLocal :: (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGLocal arg_var_ _ _ = T_HsToken (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_HsToken_v13 v13 = \ (T_HsToken_vIn13 ) -> ( let _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule68 arg_var_ __result_ = T_HsToken_vOut13 _lhsOvertices in __result_ ) in C_HsToken_s14 v13 {-# INLINE rule68 #-} {-# LINE 43 "src-ag/KWOrder.ag" #-} rule68 = \ var_ -> {-# LINE 43 "src-ag/KWOrder.ag" #-} Set.singleton $ VChild var_ {-# LINE 737 "dist/build/KWOrder.hs"#-} {-# NOINLINE sem_HsToken_AGField #-} sem_HsToken_AGField :: (Identifier) -> (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGField arg_field_ arg_attr_ _ _ = T_HsToken (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_HsToken_v13 v13 = \ (T_HsToken_vIn13 ) -> ( let _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule69 arg_attr_ arg_field_ __result_ = T_HsToken_vOut13 _lhsOvertices in __result_ ) in C_HsToken_s14 v13 {-# INLINE rule69 #-} {-# LINE 44 "src-ag/KWOrder.ag" #-} rule69 = \ attr_ field_ -> {-# LINE 44 "src-ag/KWOrder.ag" #-} Set.singleton $ VAttr (if field_ == _LHS then Inh else if field_ == _LOC then Loc else Syn) field_ attr_ {-# LINE 757 "dist/build/KWOrder.hs"#-} {-# NOINLINE sem_HsToken_HsToken #-} sem_HsToken_HsToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_HsToken _ _ = T_HsToken (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_HsToken_v13 v13 = \ (T_HsToken_vIn13 ) -> ( let _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule70 () __result_ = T_HsToken_vOut13 _lhsOvertices in __result_ ) in C_HsToken_s14 v13 {-# INLINE rule70 #-} rule70 = \ (_ :: ()) -> Set.empty {-# NOINLINE sem_HsToken_CharToken #-} sem_HsToken_CharToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_CharToken _ _ = T_HsToken (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_HsToken_v13 v13 = \ (T_HsToken_vIn13 ) -> ( let _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule71 () __result_ = T_HsToken_vOut13 _lhsOvertices in __result_ ) in C_HsToken_s14 v13 {-# INLINE rule71 #-} rule71 = \ (_ :: ()) -> Set.empty {-# NOINLINE sem_HsToken_StrToken #-} sem_HsToken_StrToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_StrToken _ _ = T_HsToken (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_HsToken_v13 v13 = \ (T_HsToken_vIn13 ) -> ( let _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule72 () __result_ = T_HsToken_vOut13 _lhsOvertices in __result_ ) in C_HsToken_s14 v13 {-# INLINE rule72 #-} rule72 = \ (_ :: ()) -> Set.empty {-# NOINLINE sem_HsToken_Err #-} sem_HsToken_Err :: (String) -> (Pos) -> T_HsToken sem_HsToken_Err _ _ = T_HsToken (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_HsToken_v13 v13 = \ (T_HsToken_vIn13 ) -> ( let _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule73 () __result_ = T_HsToken_vOut13 _lhsOvertices in __result_ ) in C_HsToken_s14 v13 {-# INLINE rule73 #-} rule73 = \ (_ :: ()) -> Set.empty -- HsTokens ---------------------------------------------------- -- wrapper data Inh_HsTokens = Inh_HsTokens { } data Syn_HsTokens = Syn_HsTokens { } {-# INLINABLE wrap_HsTokens #-} wrap_HsTokens :: T_HsTokens -> Inh_HsTokens -> (Syn_HsTokens ) wrap_HsTokens (T_HsTokens act) (Inh_HsTokens ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg16 = T_HsTokens_vIn16 (T_HsTokens_vOut16 ) <- return (inv_HsTokens_s17 sem arg16) return (Syn_HsTokens ) ) -- cata {-# NOINLINE sem_HsTokens #-} sem_HsTokens :: HsTokens -> T_HsTokens sem_HsTokens list = Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) -- semantic domain newtype T_HsTokens = T_HsTokens { attach_T_HsTokens :: Identity (T_HsTokens_s17 ) } newtype T_HsTokens_s17 = C_HsTokens_s17 { inv_HsTokens_s17 :: (T_HsTokens_v16 ) } data T_HsTokens_s18 = C_HsTokens_s18 type T_HsTokens_v16 = (T_HsTokens_vIn16 ) -> (T_HsTokens_vOut16 ) data T_HsTokens_vIn16 = T_HsTokens_vIn16 data T_HsTokens_vOut16 = T_HsTokens_vOut16 {-# NOINLINE sem_HsTokens_Cons #-} sem_HsTokens_Cons :: T_HsToken -> T_HsTokens -> T_HsTokens sem_HsTokens_Cons arg_hd_ arg_tl_ = T_HsTokens (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_HsTokens_v16 v16 = \ (T_HsTokens_vIn16 ) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_)) (T_HsToken_vOut13 _hdIvertices) = inv_HsToken_s14 _hdX14 (T_HsToken_vIn13 ) (T_HsTokens_vOut16 ) = inv_HsTokens_s17 _tlX17 (T_HsTokens_vIn16 ) __result_ = T_HsTokens_vOut16 in __result_ ) in C_HsTokens_s17 v16 {-# NOINLINE sem_HsTokens_Nil #-} sem_HsTokens_Nil :: T_HsTokens sem_HsTokens_Nil = T_HsTokens (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_HsTokens_v16 v16 = \ (T_HsTokens_vIn16 ) -> ( let __result_ = T_HsTokens_vOut16 in __result_ ) in C_HsTokens_s17 v16 -- HsTokensRoot ------------------------------------------------ -- wrapper data Inh_HsTokensRoot = Inh_HsTokensRoot { } data Syn_HsTokensRoot = Syn_HsTokensRoot { } {-# INLINABLE wrap_HsTokensRoot #-} wrap_HsTokensRoot :: T_HsTokensRoot -> Inh_HsTokensRoot -> (Syn_HsTokensRoot ) wrap_HsTokensRoot (T_HsTokensRoot act) (Inh_HsTokensRoot ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg19 = T_HsTokensRoot_vIn19 (T_HsTokensRoot_vOut19 ) <- return (inv_HsTokensRoot_s20 sem arg19) return (Syn_HsTokensRoot ) ) -- cata {-# INLINE sem_HsTokensRoot #-} sem_HsTokensRoot :: HsTokensRoot -> T_HsTokensRoot sem_HsTokensRoot ( HsTokensRoot tokens_ ) = sem_HsTokensRoot_HsTokensRoot ( sem_HsTokens tokens_ ) -- semantic domain newtype T_HsTokensRoot = T_HsTokensRoot { attach_T_HsTokensRoot :: Identity (T_HsTokensRoot_s20 ) } newtype T_HsTokensRoot_s20 = C_HsTokensRoot_s20 { inv_HsTokensRoot_s20 :: (T_HsTokensRoot_v19 ) } data T_HsTokensRoot_s21 = C_HsTokensRoot_s21 type T_HsTokensRoot_v19 = (T_HsTokensRoot_vIn19 ) -> (T_HsTokensRoot_vOut19 ) data T_HsTokensRoot_vIn19 = T_HsTokensRoot_vIn19 data T_HsTokensRoot_vOut19 = T_HsTokensRoot_vOut19 {-# NOINLINE sem_HsTokensRoot_HsTokensRoot #-} sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> T_HsTokensRoot sem_HsTokensRoot_HsTokensRoot arg_tokens_ = T_HsTokensRoot (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_HsTokensRoot_v19 v19 = \ (T_HsTokensRoot_vIn19 ) -> ( let _tokensX17 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tokens_)) (T_HsTokens_vOut16 ) = inv_HsTokens_s17 _tokensX17 (T_HsTokens_vIn16 ) __result_ = T_HsTokensRoot_vOut19 in __result_ ) in C_HsTokensRoot_s20 v19 -- Nonterminal ------------------------------------------------- -- wrapper data Inh_Nonterminal = Inh_Nonterminal { aroundMap_Inh_Nonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), classContexts_Inh_Nonterminal :: (ContextMap), closedHoNtDeps_Inh_Nonterminal :: (Map NontermIdent (Set NontermIdent)), closedHoNtRevDeps_Inh_Nonterminal :: (Map NontermIdent (Set NontermIdent)), closedNtDeps_Inh_Nonterminal :: (Map NontermIdent (Set NontermIdent)), inhMap_Inh_Nonterminal :: (Map Identifier Attributes), manualDeps_Inh_Nonterminal :: (AttrOrderMap), mergeMap_Inh_Nonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))), options_Inh_Nonterminal :: (Options), rulenumber_Inh_Nonterminal :: (Int), synMap_Inh_Nonterminal :: (Map Identifier Attributes) } data Syn_Nonterminal = Syn_Nonterminal { depinfo_Syn_Nonterminal :: (NontDependencyInformation), inhMap'_Syn_Nonterminal :: (Map Identifier Attributes), inhmap_Syn_Nonterminal :: (Map.Map NontermIdent Attributes), localSigMap_Syn_Nonterminal :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))), ntDeps_Syn_Nonterminal :: (Map NontermIdent (Set NontermIdent)), ntHoDeps_Syn_Nonterminal :: (Map NontermIdent (Set NontermIdent)), rulenumber_Syn_Nonterminal :: (Int), synMap'_Syn_Nonterminal :: (Map Identifier Attributes), synmap_Syn_Nonterminal :: (Map.Map NontermIdent Attributes) } {-# INLINABLE wrap_Nonterminal #-} wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal ) wrap_Nonterminal (T_Nonterminal act) (Inh_Nonterminal _lhsIaroundMap _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg22 = T_Nonterminal_vIn22 _lhsIaroundMap _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap (T_Nonterminal_vOut22 _lhsOdepinfo _lhsOinhMap' _lhsOinhmap _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOrulenumber _lhsOsynMap' _lhsOsynmap) <- return (inv_Nonterminal_s23 sem arg22) return (Syn_Nonterminal _lhsOdepinfo _lhsOinhMap' _lhsOinhmap _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOrulenumber _lhsOsynMap' _lhsOsynmap) ) -- cata {-# INLINE sem_Nonterminal #-} sem_Nonterminal :: Nonterminal -> T_Nonterminal sem_Nonterminal ( Nonterminal nt_ params_ inh_ syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ ) -- semantic domain newtype T_Nonterminal = T_Nonterminal { attach_T_Nonterminal :: Identity (T_Nonterminal_s23 ) } newtype T_Nonterminal_s23 = C_Nonterminal_s23 { inv_Nonterminal_s23 :: (T_Nonterminal_v22 ) } data T_Nonterminal_s24 = C_Nonterminal_s24 type T_Nonterminal_v22 = (T_Nonterminal_vIn22 ) -> (T_Nonterminal_vOut22 ) data T_Nonterminal_vIn22 = T_Nonterminal_vIn22 (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) (ContextMap) (Map NontermIdent (Set NontermIdent)) (Map NontermIdent (Set NontermIdent)) (Map NontermIdent (Set NontermIdent)) (Map Identifier Attributes) (AttrOrderMap) (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) (Options) (Int) (Map Identifier Attributes) data T_Nonterminal_vOut22 = T_Nonterminal_vOut22 (NontDependencyInformation) (Map Identifier Attributes) (Map.Map NontermIdent Attributes) (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) (Map NontermIdent (Set NontermIdent)) (Map NontermIdent (Set NontermIdent)) (Int) (Map Identifier Attributes) (Map.Map NontermIdent Attributes) {-# NOINLINE sem_Nonterminal_Nonterminal #-} sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal sem_Nonterminal_Nonterminal arg_nt_ arg_params_ arg_inh_ arg_syn_ arg_prods_ = T_Nonterminal (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_Nonterminal_v22 v22 = \ (T_Nonterminal_vIn22 _lhsIaroundMap _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) -> ( let _prodsX38 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) (T_Productions_vOut37 _prodsIdepgraph _prodsIlocalSigMap _prodsIrefHoNts _prodsIrefNts _prodsIrulenumber) = inv_Productions_s38 _prodsX38 (T_Productions_vIn37 _prodsOaroundMap _prodsOinhMap _prodsOmanualDeps _prodsOmergeMap _prodsOoptions _prodsOrulenumber _prodsOsynMap) _lhsOntDeps :: Map NontermIdent (Set NontermIdent) _lhsOntDeps = rule74 _prodsIrefNts arg_nt_ _lhsOntHoDeps :: Map NontermIdent (Set NontermIdent) _lhsOntHoDeps = rule75 _prodsIrefHoNts arg_nt_ _closedNtDeps = rule76 _lhsIclosedNtDeps arg_nt_ _closedHoNtDeps = rule77 _lhsIclosedHoNtDeps arg_nt_ _closedHoNtRevDeps = rule78 _lhsIclosedHoNtRevDeps arg_nt_ _recursive = rule79 _closedNtDeps arg_nt_ _nontrivAcyc = rule80 _closedHoNtDeps arg_nt_ _hoInfo = rule81 _closedHoNtDeps _closedHoNtRevDeps _nontrivAcyc _classContexts = rule82 _lhsIclassContexts arg_nt_ _aroundMap = rule83 _lhsIaroundMap arg_nt_ _mergeMap = rule84 _lhsImergeMap arg_nt_ _lhsOinhmap :: Map.Map NontermIdent Attributes _lhsOinhmap = rule85 arg_inh_ arg_nt_ _lhsOsynmap :: Map.Map NontermIdent Attributes _lhsOsynmap = rule86 arg_nt_ arg_syn_ _lhsOlocalSigMap :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type)) _lhsOlocalSigMap = rule87 _prodsIlocalSigMap arg_nt_ _lhsOinhMap' :: Map Identifier Attributes _lhsOinhMap' = rule88 arg_inh_ arg_nt_ _lhsOsynMap' :: Map Identifier Attributes _lhsOsynMap' = rule89 arg_nt_ arg_syn_ _prodsOmanualDeps = rule90 _lhsImanualDeps arg_nt_ _synvertices = rule91 arg_nt_ arg_syn_ _inhvertices = rule92 arg_inh_ arg_nt_ _vertices = rule93 _inhvertices _synvertices _nontgraph = rule94 _vertices _lhsOdepinfo :: NontDependencyInformation _lhsOdepinfo = rule95 _classContexts _hoInfo _nontgraph _prodsIdepgraph _recursive arg_inh_ arg_nt_ arg_params_ arg_syn_ _lhsOrulenumber :: Int _lhsOrulenumber = rule96 _prodsIrulenumber _prodsOaroundMap = rule97 _aroundMap _prodsOinhMap = rule98 _lhsIinhMap _prodsOmergeMap = rule99 _mergeMap _prodsOoptions = rule100 _lhsIoptions _prodsOrulenumber = rule101 _lhsIrulenumber _prodsOsynMap = rule102 _lhsIsynMap __result_ = T_Nonterminal_vOut22 _lhsOdepinfo _lhsOinhMap' _lhsOinhmap _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOrulenumber _lhsOsynMap' _lhsOsynmap in __result_ ) in C_Nonterminal_s23 v22 {-# INLINE rule74 #-} {-# LINE 16 "src-ag/ExecutionPlanCommon.ag" #-} rule74 = \ ((_prodsIrefNts) :: Set NontermIdent) nt_ -> {-# LINE 16 "src-ag/ExecutionPlanCommon.ag" #-} Map.singleton nt_ _prodsIrefNts {-# LINE 1002 "dist/build/KWOrder.hs"#-} {-# INLINE rule75 #-} {-# LINE 17 "src-ag/ExecutionPlanCommon.ag" #-} rule75 = \ ((_prodsIrefHoNts) :: Set NontermIdent) nt_ -> {-# LINE 17 "src-ag/ExecutionPlanCommon.ag" #-} Map.singleton nt_ _prodsIrefHoNts {-# LINE 1008 "dist/build/KWOrder.hs"#-} {-# INLINE rule76 #-} {-# LINE 19 "src-ag/ExecutionPlanCommon.ag" #-} rule76 = \ ((_lhsIclosedNtDeps) :: Map NontermIdent (Set NontermIdent)) nt_ -> {-# LINE 19 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Set.empty nt_ _lhsIclosedNtDeps {-# LINE 1014 "dist/build/KWOrder.hs"#-} {-# INLINE rule77 #-} {-# LINE 20 "src-ag/ExecutionPlanCommon.ag" #-} rule77 = \ ((_lhsIclosedHoNtDeps) :: Map NontermIdent (Set NontermIdent)) nt_ -> {-# LINE 20 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Set.empty nt_ _lhsIclosedHoNtDeps {-# LINE 1020 "dist/build/KWOrder.hs"#-} {-# INLINE rule78 #-} {-# LINE 21 "src-ag/ExecutionPlanCommon.ag" #-} rule78 = \ ((_lhsIclosedHoNtRevDeps) :: Map NontermIdent (Set NontermIdent)) nt_ -> {-# LINE 21 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Set.empty nt_ _lhsIclosedHoNtRevDeps {-# LINE 1026 "dist/build/KWOrder.hs"#-} {-# INLINE rule79 #-} {-# LINE 23 "src-ag/ExecutionPlanCommon.ag" #-} rule79 = \ _closedNtDeps nt_ -> {-# LINE 23 "src-ag/ExecutionPlanCommon.ag" #-} nt_ `Set.member` _closedNtDeps {-# LINE 1032 "dist/build/KWOrder.hs"#-} {-# INLINE rule80 #-} {-# LINE 24 "src-ag/ExecutionPlanCommon.ag" #-} rule80 = \ _closedHoNtDeps nt_ -> {-# LINE 24 "src-ag/ExecutionPlanCommon.ag" #-} nt_ `Set.member` _closedHoNtDeps {-# LINE 1038 "dist/build/KWOrder.hs"#-} {-# INLINE rule81 #-} {-# LINE 25 "src-ag/ExecutionPlanCommon.ag" #-} rule81 = \ _closedHoNtDeps _closedHoNtRevDeps _nontrivAcyc -> {-# LINE 25 "src-ag/ExecutionPlanCommon.ag" #-} HigherOrderInfo { hoNtDeps = _closedHoNtDeps , hoNtRevDeps = _closedHoNtRevDeps , hoAcyclic = _nontrivAcyc } {-# LINE 1047 "dist/build/KWOrder.hs"#-} {-# INLINE rule82 #-} {-# LINE 54 "src-ag/ExecutionPlanCommon.ag" #-} rule82 = \ ((_lhsIclassContexts) :: ContextMap) nt_ -> {-# LINE 54 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault [] nt_ _lhsIclassContexts {-# LINE 1053 "dist/build/KWOrder.hs"#-} {-# INLINE rule83 #-} {-# LINE 88 "src-ag/ExecutionPlanCommon.ag" #-} rule83 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) nt_ -> {-# LINE 88 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIaroundMap {-# LINE 1059 "dist/build/KWOrder.hs"#-} {-# INLINE rule84 #-} {-# LINE 113 "src-ag/ExecutionPlanCommon.ag" #-} rule84 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) nt_ -> {-# LINE 113 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Map.empty nt_ _lhsImergeMap {-# LINE 1065 "dist/build/KWOrder.hs"#-} {-# INLINE rule85 #-} {-# LINE 149 "src-ag/ExecutionPlanCommon.ag" #-} rule85 = \ inh_ nt_ -> {-# LINE 149 "src-ag/ExecutionPlanCommon.ag" #-} Map.singleton nt_ inh_ {-# LINE 1071 "dist/build/KWOrder.hs"#-} {-# INLINE rule86 #-} {-# LINE 150 "src-ag/ExecutionPlanCommon.ag" #-} rule86 = \ nt_ syn_ -> {-# LINE 150 "src-ag/ExecutionPlanCommon.ag" #-} Map.singleton nt_ syn_ {-# LINE 1077 "dist/build/KWOrder.hs"#-} {-# INLINE rule87 #-} {-# LINE 159 "src-ag/ExecutionPlanCommon.ag" #-} rule87 = \ ((_prodsIlocalSigMap) :: Map.Map ConstructorIdent (Map.Map Identifier Type)) nt_ -> {-# LINE 159 "src-ag/ExecutionPlanCommon.ag" #-} Map.singleton nt_ _prodsIlocalSigMap {-# LINE 1083 "dist/build/KWOrder.hs"#-} {-# INLINE rule88 #-} {-# LINE 7 "src-ag/DistChildAttr.ag" #-} rule88 = \ inh_ nt_ -> {-# LINE 7 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ inh_ {-# LINE 1089 "dist/build/KWOrder.hs"#-} {-# INLINE rule89 #-} {-# LINE 8 "src-ag/DistChildAttr.ag" #-} rule89 = \ nt_ syn_ -> {-# LINE 8 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ syn_ {-# LINE 1095 "dist/build/KWOrder.hs"#-} {-# INLINE rule90 #-} {-# LINE 120 "src-ag/KWOrder.ag" #-} rule90 = \ ((_lhsImanualDeps) :: AttrOrderMap) nt_ -> {-# LINE 120 "src-ag/KWOrder.ag" #-} Map.findWithDefault Map.empty nt_ _lhsImanualDeps {-# LINE 1101 "dist/build/KWOrder.hs"#-} {-# INLINE rule91 #-} {-# LINE 175 "src-ag/KWOrder.ag" #-} rule91 = \ nt_ syn_ -> {-# LINE 175 "src-ag/KWOrder.ag" #-} map (VAttr Syn nt_) . Map.keys $ syn_ {-# LINE 1107 "dist/build/KWOrder.hs"#-} {-# INLINE rule92 #-} {-# LINE 176 "src-ag/KWOrder.ag" #-} rule92 = \ inh_ nt_ -> {-# LINE 176 "src-ag/KWOrder.ag" #-} map (VAttr Inh nt_) . Map.keys $ inh_ {-# LINE 1113 "dist/build/KWOrder.hs"#-} {-# INLINE rule93 #-} {-# LINE 177 "src-ag/KWOrder.ag" #-} rule93 = \ _inhvertices _synvertices -> {-# LINE 177 "src-ag/KWOrder.ag" #-} _synvertices ++ _inhvertices {-# LINE 1119 "dist/build/KWOrder.hs"#-} {-# INLINE rule94 #-} {-# LINE 181 "src-ag/KWOrder.ag" #-} rule94 = \ _vertices -> {-# LINE 181 "src-ag/KWOrder.ag" #-} NontDependencyGraph { ndgVertices = _vertices , ndgEdges = [] } {-# LINE 1126 "dist/build/KWOrder.hs"#-} {-# INLINE rule95 #-} {-# LINE 189 "src-ag/KWOrder.ag" #-} rule95 = \ _classContexts _hoInfo _nontgraph ((_prodsIdepgraph) :: [ProdDependencyGraph]) _recursive inh_ nt_ params_ syn_ -> {-# LINE 189 "src-ag/KWOrder.ag" #-} NontDependencyInformation { ndiNonterminal = nt_ , ndiParams = params_ , ndiInh = Map.keys inh_ , ndiSyn = Map.keys syn_ , ndiDepGraph = _nontgraph , ndiProds = _prodsIdepgraph , ndiRecursive = _recursive , ndiHoInfo = _hoInfo , ndiClassCtxs = _classContexts } {-# LINE 1141 "dist/build/KWOrder.hs"#-} {-# INLINE rule96 #-} rule96 = \ ((_prodsIrulenumber) :: Int) -> _prodsIrulenumber {-# INLINE rule97 #-} rule97 = \ _aroundMap -> _aroundMap {-# INLINE rule98 #-} rule98 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule99 #-} rule99 = \ _mergeMap -> _mergeMap {-# INLINE rule100 #-} rule100 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule101 #-} rule101 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber {-# INLINE rule102 #-} rule102 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap -- Nonterminals ------------------------------------------------ -- wrapper data Inh_Nonterminals = Inh_Nonterminals { aroundMap_Inh_Nonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), classContexts_Inh_Nonterminals :: (ContextMap), closedHoNtDeps_Inh_Nonterminals :: (Map NontermIdent (Set NontermIdent)), closedHoNtRevDeps_Inh_Nonterminals :: (Map NontermIdent (Set NontermIdent)), closedNtDeps_Inh_Nonterminals :: (Map NontermIdent (Set NontermIdent)), inhMap_Inh_Nonterminals :: (Map Identifier Attributes), manualDeps_Inh_Nonterminals :: (AttrOrderMap), mergeMap_Inh_Nonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))), options_Inh_Nonterminals :: (Options), rulenumber_Inh_Nonterminals :: (Int), synMap_Inh_Nonterminals :: (Map Identifier Attributes) } data Syn_Nonterminals = Syn_Nonterminals { depinfo_Syn_Nonterminals :: ([NontDependencyInformation]), inhMap'_Syn_Nonterminals :: (Map Identifier Attributes), inhmap_Syn_Nonterminals :: (Map.Map NontermIdent Attributes), localSigMap_Syn_Nonterminals :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))), ntDeps_Syn_Nonterminals :: (Map NontermIdent (Set NontermIdent)), ntHoDeps_Syn_Nonterminals :: (Map NontermIdent (Set NontermIdent)), rulenumber_Syn_Nonterminals :: (Int), synMap'_Syn_Nonterminals :: (Map Identifier Attributes), synmap_Syn_Nonterminals :: (Map.Map NontermIdent Attributes) } {-# INLINABLE wrap_Nonterminals #-} wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals ) wrap_Nonterminals (T_Nonterminals act) (Inh_Nonterminals _lhsIaroundMap _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg25 = T_Nonterminals_vIn25 _lhsIaroundMap _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap (T_Nonterminals_vOut25 _lhsOdepinfo _lhsOinhMap' _lhsOinhmap _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOrulenumber _lhsOsynMap' _lhsOsynmap) <- return (inv_Nonterminals_s26 sem arg25) return (Syn_Nonterminals _lhsOdepinfo _lhsOinhMap' _lhsOinhmap _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOrulenumber _lhsOsynMap' _lhsOsynmap) ) -- cata {-# NOINLINE sem_Nonterminals #-} sem_Nonterminals :: Nonterminals -> T_Nonterminals sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) -- semantic domain newtype T_Nonterminals = T_Nonterminals { attach_T_Nonterminals :: Identity (T_Nonterminals_s26 ) } newtype T_Nonterminals_s26 = C_Nonterminals_s26 { inv_Nonterminals_s26 :: (T_Nonterminals_v25 ) } data T_Nonterminals_s27 = C_Nonterminals_s27 type T_Nonterminals_v25 = (T_Nonterminals_vIn25 ) -> (T_Nonterminals_vOut25 ) data T_Nonterminals_vIn25 = T_Nonterminals_vIn25 (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) (ContextMap) (Map NontermIdent (Set NontermIdent)) (Map NontermIdent (Set NontermIdent)) (Map NontermIdent (Set NontermIdent)) (Map Identifier Attributes) (AttrOrderMap) (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) (Options) (Int) (Map Identifier Attributes) data T_Nonterminals_vOut25 = T_Nonterminals_vOut25 ([NontDependencyInformation]) (Map Identifier Attributes) (Map.Map NontermIdent Attributes) (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) (Map NontermIdent (Set NontermIdent)) (Map NontermIdent (Set NontermIdent)) (Int) (Map Identifier Attributes) (Map.Map NontermIdent Attributes) {-# NOINLINE sem_Nonterminals_Cons #-} sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_Nonterminals_v25 v25 = \ (T_Nonterminals_vIn25 _lhsIaroundMap _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) -> ( let _hdX23 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) _tlX26 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) (T_Nonterminal_vOut22 _hdIdepinfo _hdIinhMap' _hdIinhmap _hdIlocalSigMap _hdIntDeps _hdIntHoDeps _hdIrulenumber _hdIsynMap' _hdIsynmap) = inv_Nonterminal_s23 _hdX23 (T_Nonterminal_vIn22 _hdOaroundMap _hdOclassContexts _hdOclosedHoNtDeps _hdOclosedHoNtRevDeps _hdOclosedNtDeps _hdOinhMap _hdOmanualDeps _hdOmergeMap _hdOoptions _hdOrulenumber _hdOsynMap) (T_Nonterminals_vOut25 _tlIdepinfo _tlIinhMap' _tlIinhmap _tlIlocalSigMap _tlIntDeps _tlIntHoDeps _tlIrulenumber _tlIsynMap' _tlIsynmap) = inv_Nonterminals_s26 _tlX26 (T_Nonterminals_vIn25 _tlOaroundMap _tlOclassContexts _tlOclosedHoNtDeps _tlOclosedHoNtRevDeps _tlOclosedNtDeps _tlOinhMap _tlOmanualDeps _tlOmergeMap _tlOoptions _tlOrulenumber _tlOsynMap) _lhsOdepinfo :: [NontDependencyInformation] _lhsOdepinfo = rule103 _hdIdepinfo _tlIdepinfo _lhsOinhMap' :: Map Identifier Attributes _lhsOinhMap' = rule104 _hdIinhMap' _tlIinhMap' _lhsOinhmap :: Map.Map NontermIdent Attributes _lhsOinhmap = rule105 _hdIinhmap _tlIinhmap _lhsOlocalSigMap :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type)) _lhsOlocalSigMap = rule106 _hdIlocalSigMap _tlIlocalSigMap _lhsOntDeps :: Map NontermIdent (Set NontermIdent) _lhsOntDeps = rule107 _hdIntDeps _tlIntDeps _lhsOntHoDeps :: Map NontermIdent (Set NontermIdent) _lhsOntHoDeps = rule108 _hdIntHoDeps _tlIntHoDeps _lhsOsynMap' :: Map Identifier Attributes _lhsOsynMap' = rule109 _hdIsynMap' _tlIsynMap' _lhsOsynmap :: Map.Map NontermIdent Attributes _lhsOsynmap = rule110 _hdIsynmap _tlIsynmap _lhsOrulenumber :: Int _lhsOrulenumber = rule111 _tlIrulenumber _hdOaroundMap = rule112 _lhsIaroundMap _hdOclassContexts = rule113 _lhsIclassContexts _hdOclosedHoNtDeps = rule114 _lhsIclosedHoNtDeps _hdOclosedHoNtRevDeps = rule115 _lhsIclosedHoNtRevDeps _hdOclosedNtDeps = rule116 _lhsIclosedNtDeps _hdOinhMap = rule117 _lhsIinhMap _hdOmanualDeps = rule118 _lhsImanualDeps _hdOmergeMap = rule119 _lhsImergeMap _hdOoptions = rule120 _lhsIoptions _hdOrulenumber = rule121 _lhsIrulenumber _hdOsynMap = rule122 _lhsIsynMap _tlOaroundMap = rule123 _lhsIaroundMap _tlOclassContexts = rule124 _lhsIclassContexts _tlOclosedHoNtDeps = rule125 _lhsIclosedHoNtDeps _tlOclosedHoNtRevDeps = rule126 _lhsIclosedHoNtRevDeps _tlOclosedNtDeps = rule127 _lhsIclosedNtDeps _tlOinhMap = rule128 _lhsIinhMap _tlOmanualDeps = rule129 _lhsImanualDeps _tlOmergeMap = rule130 _lhsImergeMap _tlOoptions = rule131 _lhsIoptions _tlOrulenumber = rule132 _hdIrulenumber _tlOsynMap = rule133 _lhsIsynMap __result_ = T_Nonterminals_vOut25 _lhsOdepinfo _lhsOinhMap' _lhsOinhmap _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOrulenumber _lhsOsynMap' _lhsOsynmap in __result_ ) in C_Nonterminals_s26 v25 {-# INLINE rule103 #-} rule103 = \ ((_hdIdepinfo) :: NontDependencyInformation) ((_tlIdepinfo) :: [NontDependencyInformation]) -> _hdIdepinfo : _tlIdepinfo {-# INLINE rule104 #-} rule104 = \ ((_hdIinhMap') :: Map Identifier Attributes) ((_tlIinhMap') :: Map Identifier Attributes) -> _hdIinhMap' `Map.union` _tlIinhMap' {-# INLINE rule105 #-} rule105 = \ ((_hdIinhmap) :: Map.Map NontermIdent Attributes) ((_tlIinhmap) :: Map.Map NontermIdent Attributes) -> _hdIinhmap `Map.union` _tlIinhmap {-# INLINE rule106 #-} rule106 = \ ((_hdIlocalSigMap) :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) ((_tlIlocalSigMap) :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) -> _hdIlocalSigMap `Map.union` _tlIlocalSigMap {-# INLINE rule107 #-} rule107 = \ ((_hdIntDeps) :: Map NontermIdent (Set NontermIdent)) ((_tlIntDeps) :: Map NontermIdent (Set NontermIdent)) -> _hdIntDeps `mappend` _tlIntDeps {-# INLINE rule108 #-} rule108 = \ ((_hdIntHoDeps) :: Map NontermIdent (Set NontermIdent)) ((_tlIntHoDeps) :: Map NontermIdent (Set NontermIdent)) -> _hdIntHoDeps `mappend` _tlIntHoDeps {-# INLINE rule109 #-} rule109 = \ ((_hdIsynMap') :: Map Identifier Attributes) ((_tlIsynMap') :: Map Identifier Attributes) -> _hdIsynMap' `Map.union` _tlIsynMap' {-# INLINE rule110 #-} rule110 = \ ((_hdIsynmap) :: Map.Map NontermIdent Attributes) ((_tlIsynmap) :: Map.Map NontermIdent Attributes) -> _hdIsynmap `Map.union` _tlIsynmap {-# INLINE rule111 #-} rule111 = \ ((_tlIrulenumber) :: Int) -> _tlIrulenumber {-# INLINE rule112 #-} rule112 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> _lhsIaroundMap {-# INLINE rule113 #-} rule113 = \ ((_lhsIclassContexts) :: ContextMap) -> _lhsIclassContexts {-# INLINE rule114 #-} rule114 = \ ((_lhsIclosedHoNtDeps) :: Map NontermIdent (Set NontermIdent)) -> _lhsIclosedHoNtDeps {-# INLINE rule115 #-} rule115 = \ ((_lhsIclosedHoNtRevDeps) :: Map NontermIdent (Set NontermIdent)) -> _lhsIclosedHoNtRevDeps {-# INLINE rule116 #-} rule116 = \ ((_lhsIclosedNtDeps) :: Map NontermIdent (Set NontermIdent)) -> _lhsIclosedNtDeps {-# INLINE rule117 #-} rule117 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule118 #-} rule118 = \ ((_lhsImanualDeps) :: AttrOrderMap) -> _lhsImanualDeps {-# INLINE rule119 #-} rule119 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> _lhsImergeMap {-# INLINE rule120 #-} rule120 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule121 #-} rule121 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber {-# INLINE rule122 #-} rule122 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule123 #-} rule123 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> _lhsIaroundMap {-# INLINE rule124 #-} rule124 = \ ((_lhsIclassContexts) :: ContextMap) -> _lhsIclassContexts {-# INLINE rule125 #-} rule125 = \ ((_lhsIclosedHoNtDeps) :: Map NontermIdent (Set NontermIdent)) -> _lhsIclosedHoNtDeps {-# INLINE rule126 #-} rule126 = \ ((_lhsIclosedHoNtRevDeps) :: Map NontermIdent (Set NontermIdent)) -> _lhsIclosedHoNtRevDeps {-# INLINE rule127 #-} rule127 = \ ((_lhsIclosedNtDeps) :: Map NontermIdent (Set NontermIdent)) -> _lhsIclosedNtDeps {-# INLINE rule128 #-} rule128 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule129 #-} rule129 = \ ((_lhsImanualDeps) :: AttrOrderMap) -> _lhsImanualDeps {-# INLINE rule130 #-} rule130 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> _lhsImergeMap {-# INLINE rule131 #-} rule131 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule132 #-} rule132 = \ ((_hdIrulenumber) :: Int) -> _hdIrulenumber {-# INLINE rule133 #-} rule133 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE sem_Nonterminals_Nil #-} sem_Nonterminals_Nil :: T_Nonterminals sem_Nonterminals_Nil = T_Nonterminals (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_Nonterminals_v25 v25 = \ (T_Nonterminals_vIn25 _lhsIaroundMap _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) -> ( let _lhsOdepinfo :: [NontDependencyInformation] _lhsOdepinfo = rule134 () _lhsOinhMap' :: Map Identifier Attributes _lhsOinhMap' = rule135 () _lhsOinhmap :: Map.Map NontermIdent Attributes _lhsOinhmap = rule136 () _lhsOlocalSigMap :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type)) _lhsOlocalSigMap = rule137 () _lhsOntDeps :: Map NontermIdent (Set NontermIdent) _lhsOntDeps = rule138 () _lhsOntHoDeps :: Map NontermIdent (Set NontermIdent) _lhsOntHoDeps = rule139 () _lhsOsynMap' :: Map Identifier Attributes _lhsOsynMap' = rule140 () _lhsOsynmap :: Map.Map NontermIdent Attributes _lhsOsynmap = rule141 () _lhsOrulenumber :: Int _lhsOrulenumber = rule142 _lhsIrulenumber __result_ = T_Nonterminals_vOut25 _lhsOdepinfo _lhsOinhMap' _lhsOinhmap _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOrulenumber _lhsOsynMap' _lhsOsynmap in __result_ ) in C_Nonterminals_s26 v25 {-# INLINE rule134 #-} rule134 = \ (_ :: ()) -> [] {-# INLINE rule135 #-} rule135 = \ (_ :: ()) -> Map.empty {-# INLINE rule136 #-} rule136 = \ (_ :: ()) -> Map.empty {-# INLINE rule137 #-} rule137 = \ (_ :: ()) -> Map.empty {-# INLINE rule138 #-} rule138 = \ (_ :: ()) -> mempty {-# INLINE rule139 #-} rule139 = \ (_ :: ()) -> mempty {-# INLINE rule140 #-} rule140 = \ (_ :: ()) -> Map.empty {-# INLINE rule141 #-} rule141 = \ (_ :: ()) -> Map.empty {-# INLINE rule142 #-} rule142 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { } data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), vertices_Syn_Pattern :: (Set.Set Vertex) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg28 = T_Pattern_vIn28 (T_Pattern_vOut28 _lhsOcopy _lhsOvertices) <- return (inv_Pattern_s29 sem arg28) return (Syn_Pattern _lhsOcopy _lhsOvertices) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s29 ) } newtype T_Pattern_s29 = C_Pattern_s29 { inv_Pattern_s29 :: (T_Pattern_v28 ) } data T_Pattern_s30 = C_Pattern_s30 type T_Pattern_v28 = (T_Pattern_vIn28 ) -> (T_Pattern_vOut28 ) data T_Pattern_vIn28 = T_Pattern_vIn28 data T_Pattern_vOut28 = T_Pattern_vOut28 (Pattern) (Set.Set Vertex) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Pattern_v28 v28 = \ (T_Pattern_vIn28 ) -> ( let _patsX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut31 _patsIcopy _patsIvertices) = inv_Patterns_s32 _patsX32 (T_Patterns_vIn31 ) _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule143 _patsIvertices _copy = rule144 _patsIcopy arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule145 _copy __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOvertices in __result_ ) in C_Pattern_s29 v28 {-# INLINE rule143 #-} rule143 = \ ((_patsIvertices) :: Set.Set Vertex) -> _patsIvertices {-# INLINE rule144 #-} rule144 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule145 #-} rule145 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Pattern_v28 v28 = \ (T_Pattern_vIn28 ) -> ( let _patsX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut31 _patsIcopy _patsIvertices) = inv_Patterns_s32 _patsX32 (T_Patterns_vIn31 ) _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule146 _patsIvertices _copy = rule147 _patsIcopy arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule148 _copy __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOvertices in __result_ ) in C_Pattern_s29 v28 {-# INLINE rule146 #-} rule146 = \ ((_patsIvertices) :: Set.Set Vertex) -> _patsIvertices {-# INLINE rule147 #-} rule147 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule148 #-} rule148 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Pattern_v28 v28 = \ (T_Pattern_vIn28 ) -> ( let _patX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut28 _patIcopy _patIvertices) = inv_Pattern_s29 _patX29 (T_Pattern_vIn28 ) _vertex = rule149 arg_attr_ arg_field_ _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule150 _patIvertices _vertex _copy = rule151 _patIcopy arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule152 _copy __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOvertices in __result_ ) in C_Pattern_s29 v28 {-# INLINE rule149 #-} {-# LINE 55 "src-ag/KWOrder.ag" #-} rule149 = \ attr_ field_ -> {-# LINE 55 "src-ag/KWOrder.ag" #-} if field_ == _INST then VChild attr_ else VAttr (if field_ == _LHS then Syn else if field_ == _LOC then Loc else Inh) field_ attr_ {-# LINE 1509 "dist/build/KWOrder.hs"#-} {-# INLINE rule150 #-} {-# LINE 59 "src-ag/KWOrder.ag" #-} rule150 = \ ((_patIvertices) :: Set.Set Vertex) _vertex -> {-# LINE 59 "src-ag/KWOrder.ag" #-} Set.insert _vertex _patIvertices {-# LINE 1515 "dist/build/KWOrder.hs"#-} {-# INLINE rule151 #-} rule151 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule152 #-} rule152 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Pattern_v28 v28 = \ (T_Pattern_vIn28 ) -> ( let _patX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut28 _patIcopy _patIvertices) = inv_Pattern_s29 _patX29 (T_Pattern_vIn28 ) _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule153 _patIvertices _copy = rule154 _patIcopy _lhsOcopy :: Pattern _lhsOcopy = rule155 _copy __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOvertices in __result_ ) in C_Pattern_s29 v28 {-# INLINE rule153 #-} rule153 = \ ((_patIvertices) :: Set.Set Vertex) -> _patIvertices {-# INLINE rule154 #-} rule154 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule155 #-} rule155 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore arg_pos_ = T_Pattern (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Pattern_v28 v28 = \ (T_Pattern_vIn28 ) -> ( let _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule156 () _copy = rule157 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule158 _copy __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOvertices in __result_ ) in C_Pattern_s29 v28 {-# INLINE rule156 #-} rule156 = \ (_ :: ()) -> Set.empty {-# INLINE rule157 #-} rule157 = \ pos_ -> Underscore pos_ {-# INLINE rule158 #-} rule158 = \ _copy -> _copy -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { } data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns), vertices_Syn_Patterns :: (Set.Set Vertex) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg31 = T_Patterns_vIn31 (T_Patterns_vOut31 _lhsOcopy _lhsOvertices) <- return (inv_Patterns_s32 sem arg31) return (Syn_Patterns _lhsOcopy _lhsOvertices) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s32 ) } newtype T_Patterns_s32 = C_Patterns_s32 { inv_Patterns_s32 :: (T_Patterns_v31 ) } data T_Patterns_s33 = C_Patterns_s33 type T_Patterns_v31 = (T_Patterns_vIn31 ) -> (T_Patterns_vOut31 ) data T_Patterns_vIn31 = T_Patterns_vIn31 data T_Patterns_vOut31 = T_Patterns_vOut31 (Patterns) (Set.Set Vertex) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_Patterns_v31 v31 = \ (T_Patterns_vIn31 ) -> ( let _hdX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut28 _hdIcopy _hdIvertices) = inv_Pattern_s29 _hdX29 (T_Pattern_vIn28 ) (T_Patterns_vOut31 _tlIcopy _tlIvertices) = inv_Patterns_s32 _tlX32 (T_Patterns_vIn31 ) _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule159 _hdIvertices _tlIvertices _copy = rule160 _hdIcopy _tlIcopy _lhsOcopy :: Patterns _lhsOcopy = rule161 _copy __result_ = T_Patterns_vOut31 _lhsOcopy _lhsOvertices in __result_ ) in C_Patterns_s32 v31 {-# INLINE rule159 #-} rule159 = \ ((_hdIvertices) :: Set.Set Vertex) ((_tlIvertices) :: Set.Set Vertex) -> _hdIvertices `Set.union` _tlIvertices {-# INLINE rule160 #-} rule160 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule161 #-} rule161 = \ _copy -> _copy {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_Patterns_v31 v31 = \ (T_Patterns_vIn31 ) -> ( let _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule162 () _copy = rule163 () _lhsOcopy :: Patterns _lhsOcopy = rule164 _copy __result_ = T_Patterns_vOut31 _lhsOcopy _lhsOvertices in __result_ ) in C_Patterns_s32 v31 {-# INLINE rule162 #-} rule162 = \ (_ :: ()) -> Set.empty {-# INLINE rule163 #-} rule163 = \ (_ :: ()) -> [] {-# INLINE rule164 #-} rule164 = \ _copy -> _copy -- Production -------------------------------------------------- -- wrapper data Inh_Production = Inh_Production { aroundMap_Inh_Production :: (Map ConstructorIdent (Map Identifier [Expression])), inhMap_Inh_Production :: (Map Identifier Attributes), manualDeps_Inh_Production :: (Map ConstructorIdent (Set Dependency)), mergeMap_Inh_Production :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))), options_Inh_Production :: (Options), rulenumber_Inh_Production :: (Int), synMap_Inh_Production :: (Map Identifier Attributes) } data Syn_Production = Syn_Production { depgraph_Syn_Production :: (ProdDependencyGraph), localSigMap_Syn_Production :: (Map.Map ConstructorIdent (Map.Map Identifier Type)), refHoNts_Syn_Production :: (Set NontermIdent), refNts_Syn_Production :: (Set NontermIdent), rulenumber_Syn_Production :: (Int) } {-# INLINABLE wrap_Production #-} wrap_Production :: T_Production -> Inh_Production -> (Syn_Production ) wrap_Production (T_Production act) (Inh_Production _lhsIaroundMap _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg34 = T_Production_vIn34 _lhsIaroundMap _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap (T_Production_vOut34 _lhsOdepgraph _lhsOlocalSigMap _lhsOrefHoNts _lhsOrefNts _lhsOrulenumber) <- return (inv_Production_s35 sem arg34) return (Syn_Production _lhsOdepgraph _lhsOlocalSigMap _lhsOrefHoNts _lhsOrefNts _lhsOrulenumber) ) -- cata {-# INLINE sem_Production #-} sem_Production :: Production -> T_Production sem_Production ( Production con_ params_ constraints_ children_ rules_ typeSigs_ macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_ -- semantic domain newtype T_Production = T_Production { attach_T_Production :: Identity (T_Production_s35 ) } newtype T_Production_s35 = C_Production_s35 { inv_Production_s35 :: (T_Production_v34 ) } data T_Production_s36 = C_Production_s36 type T_Production_v34 = (T_Production_vIn34 ) -> (T_Production_vOut34 ) data T_Production_vIn34 = T_Production_vIn34 (Map ConstructorIdent (Map Identifier [Expression])) (Map Identifier Attributes) (Map ConstructorIdent (Set Dependency)) (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) (Options) (Int) (Map Identifier Attributes) data T_Production_vOut34 = T_Production_vOut34 (ProdDependencyGraph) (Map.Map ConstructorIdent (Map.Map Identifier Type)) (Set NontermIdent) (Set NontermIdent) (Int) {-# NOINLINE sem_Production_Production #-} sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production sem_Production_Production arg_con_ arg_params_ arg_constraints_ arg_children_ arg_rules_ arg_typeSigs_ _ = T_Production (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Production_v34 v34 = \ (T_Production_vIn34 _lhsIaroundMap _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) -> ( let _childrenX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) _rulesX44 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) _typeSigsX50 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) (T_Children_vOut4 _childrenIechilds _childrenIedges _childrenInontnames _childrenIrefHoNts _childrenIrefNts _childrenIvertices) = inv_Children_s5 _childrenX5 (T_Children_vIn4 _childrenOaroundMap _childrenOinhMap _childrenOmergeMap _childrenOmergedChildren _childrenOoptions _childrenOsynMap) (T_Rules_vOut43 _rulesIedges _rulesIerules _rulesIrulenumber _rulesIvertices) = inv_Rules_s44 _rulesX44 (T_Rules_vIn43 _rulesOrulenumber) (T_TypeSigs_vOut49 _typeSigsIlocalSigMap) = inv_TypeSigs_s50 _typeSigsX50 (T_TypeSigs_vIn49 ) _aroundMap = rule165 _lhsIaroundMap arg_con_ _mergeMap = rule166 _lhsImergeMap arg_con_ _mergedChildren = rule167 _mergeMap _lhsOlocalSigMap :: Map.Map ConstructorIdent (Map.Map Identifier Type) _lhsOlocalSigMap = rule168 _typeSigsIlocalSigMap arg_con_ _vertices = rule169 _childrenIvertices _rulesIvertices _manualDeps = rule170 _lhsImanualDeps arg_con_ _manualEdges = rule171 _manualDeps _edges = rule172 _childrenIedges _rulesIedges _lhsOdepgraph :: ProdDependencyGraph _lhsOdepgraph = rule173 _childrenIechilds _childrenInontnames _edges _rulesIerules _vertices arg_con_ arg_constraints_ arg_params_ _lhsOrefHoNts :: Set NontermIdent _lhsOrefHoNts = rule174 _childrenIrefHoNts _lhsOrefNts :: Set NontermIdent _lhsOrefNts = rule175 _childrenIrefNts _lhsOrulenumber :: Int _lhsOrulenumber = rule176 _rulesIrulenumber _childrenOaroundMap = rule177 _aroundMap _childrenOinhMap = rule178 _lhsIinhMap _childrenOmergeMap = rule179 _mergeMap _childrenOmergedChildren = rule180 _mergedChildren _childrenOoptions = rule181 _lhsIoptions _childrenOsynMap = rule182 _lhsIsynMap _rulesOrulenumber = rule183 _lhsIrulenumber __result_ = T_Production_vOut34 _lhsOdepgraph _lhsOlocalSigMap _lhsOrefHoNts _lhsOrefNts _lhsOrulenumber in __result_ ) in C_Production_s35 v34 {-# INLINE rule165 #-} {-# LINE 89 "src-ag/ExecutionPlanCommon.ag" #-} rule165 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Map Identifier [Expression])) con_ -> {-# LINE 89 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Map.empty con_ _lhsIaroundMap {-# LINE 1731 "dist/build/KWOrder.hs"#-} {-# INLINE rule166 #-} {-# LINE 114 "src-ag/ExecutionPlanCommon.ag" #-} rule166 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) con_ -> {-# LINE 114 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Map.empty con_ _lhsImergeMap {-# LINE 1737 "dist/build/KWOrder.hs"#-} {-# INLINE rule167 #-} {-# LINE 120 "src-ag/ExecutionPlanCommon.ag" #-} rule167 = \ _mergeMap -> {-# LINE 120 "src-ag/ExecutionPlanCommon.ag" #-} Set.unions [ Set.fromList ms | (_,ms,_) <- Map.elems _mergeMap ] {-# LINE 1743 "dist/build/KWOrder.hs"#-} {-# INLINE rule168 #-} {-# LINE 160 "src-ag/ExecutionPlanCommon.ag" #-} rule168 = \ ((_typeSigsIlocalSigMap) :: Map Identifier Type) con_ -> {-# LINE 160 "src-ag/ExecutionPlanCommon.ag" #-} Map.singleton con_ _typeSigsIlocalSigMap {-# LINE 1749 "dist/build/KWOrder.hs"#-} {-# INLINE rule169 #-} {-# LINE 79 "src-ag/KWOrder.ag" #-} rule169 = \ ((_childrenIvertices) :: Set.Set Vertex) ((_rulesIvertices) :: Set.Set Vertex) -> {-# LINE 79 "src-ag/KWOrder.ag" #-} _rulesIvertices `Set.union` _childrenIvertices {-# LINE 1755 "dist/build/KWOrder.hs"#-} {-# INLINE rule170 #-} {-# LINE 122 "src-ag/KWOrder.ag" #-} rule170 = \ ((_lhsImanualDeps) :: Map ConstructorIdent (Set Dependency)) con_ -> {-# LINE 122 "src-ag/KWOrder.ag" #-} Map.findWithDefault Set.empty con_ _lhsImanualDeps {-# LINE 1761 "dist/build/KWOrder.hs"#-} {-# INLINE rule171 #-} {-# LINE 123 "src-ag/KWOrder.ag" #-} rule171 = \ _manualDeps -> {-# LINE 123 "src-ag/KWOrder.ag" #-} Set.map depToEdge _manualDeps {-# LINE 1767 "dist/build/KWOrder.hs"#-} {-# INLINE rule172 #-} {-# LINE 145 "src-ag/KWOrder.ag" #-} rule172 = \ ((_childrenIedges) :: Set.Set Edge) ((_rulesIedges) :: Set.Set Edge) -> {-# LINE 145 "src-ag/KWOrder.ag" #-} _rulesIedges `Set.union` _childrenIedges {-# LINE 1773 "dist/build/KWOrder.hs"#-} {-# INLINE rule173 #-} {-# LINE 160 "src-ag/KWOrder.ag" #-} rule173 = \ ((_childrenIechilds) :: EChildren) ((_childrenInontnames) :: [(Identifier, Identifier)]) _edges ((_rulesIerules) :: ERules) _vertices con_ constraints_ params_ -> {-# LINE 160 "src-ag/KWOrder.ag" #-} ProdDependencyGraph { pdgVertices = Set.toList _vertices , pdgEdges = Set.toList _edges , pdgRules = _rulesIerules , pdgChilds = _childrenIechilds , pdgProduction = con_ , pdgChildMap = _childrenInontnames , pdgConstraints = constraints_ , pdgParams = params_ } {-# LINE 1786 "dist/build/KWOrder.hs"#-} {-# INLINE rule174 #-} rule174 = \ ((_childrenIrefHoNts) :: Set NontermIdent) -> _childrenIrefHoNts {-# INLINE rule175 #-} rule175 = \ ((_childrenIrefNts) :: Set NontermIdent) -> _childrenIrefNts {-# INLINE rule176 #-} rule176 = \ ((_rulesIrulenumber) :: Int) -> _rulesIrulenumber {-# INLINE rule177 #-} rule177 = \ _aroundMap -> _aroundMap {-# INLINE rule178 #-} rule178 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule179 #-} rule179 = \ _mergeMap -> _mergeMap {-# INLINE rule180 #-} rule180 = \ _mergedChildren -> _mergedChildren {-# INLINE rule181 #-} rule181 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule182 #-} rule182 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule183 #-} rule183 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber -- Productions ------------------------------------------------- -- wrapper data Inh_Productions = Inh_Productions { aroundMap_Inh_Productions :: (Map ConstructorIdent (Map Identifier [Expression])), inhMap_Inh_Productions :: (Map Identifier Attributes), manualDeps_Inh_Productions :: (Map ConstructorIdent (Set Dependency)), mergeMap_Inh_Productions :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))), options_Inh_Productions :: (Options), rulenumber_Inh_Productions :: (Int), synMap_Inh_Productions :: (Map Identifier Attributes) } data Syn_Productions = Syn_Productions { depgraph_Syn_Productions :: ([ProdDependencyGraph]), localSigMap_Syn_Productions :: (Map.Map ConstructorIdent (Map.Map Identifier Type)), refHoNts_Syn_Productions :: (Set NontermIdent), refNts_Syn_Productions :: (Set NontermIdent), rulenumber_Syn_Productions :: (Int) } {-# INLINABLE wrap_Productions #-} wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions ) wrap_Productions (T_Productions act) (Inh_Productions _lhsIaroundMap _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg37 = T_Productions_vIn37 _lhsIaroundMap _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap (T_Productions_vOut37 _lhsOdepgraph _lhsOlocalSigMap _lhsOrefHoNts _lhsOrefNts _lhsOrulenumber) <- return (inv_Productions_s38 sem arg37) return (Syn_Productions _lhsOdepgraph _lhsOlocalSigMap _lhsOrefHoNts _lhsOrefNts _lhsOrulenumber) ) -- cata {-# NOINLINE sem_Productions #-} sem_Productions :: Productions -> T_Productions sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) -- semantic domain newtype T_Productions = T_Productions { attach_T_Productions :: Identity (T_Productions_s38 ) } newtype T_Productions_s38 = C_Productions_s38 { inv_Productions_s38 :: (T_Productions_v37 ) } data T_Productions_s39 = C_Productions_s39 type T_Productions_v37 = (T_Productions_vIn37 ) -> (T_Productions_vOut37 ) data T_Productions_vIn37 = T_Productions_vIn37 (Map ConstructorIdent (Map Identifier [Expression])) (Map Identifier Attributes) (Map ConstructorIdent (Set Dependency)) (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) (Options) (Int) (Map Identifier Attributes) data T_Productions_vOut37 = T_Productions_vOut37 ([ProdDependencyGraph]) (Map.Map ConstructorIdent (Map.Map Identifier Type)) (Set NontermIdent) (Set NontermIdent) (Int) {-# NOINLINE sem_Productions_Cons #-} sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_Productions_v37 v37 = \ (T_Productions_vIn37 _lhsIaroundMap _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) -> ( let _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) (T_Production_vOut34 _hdIdepgraph _hdIlocalSigMap _hdIrefHoNts _hdIrefNts _hdIrulenumber) = inv_Production_s35 _hdX35 (T_Production_vIn34 _hdOaroundMap _hdOinhMap _hdOmanualDeps _hdOmergeMap _hdOoptions _hdOrulenumber _hdOsynMap) (T_Productions_vOut37 _tlIdepgraph _tlIlocalSigMap _tlIrefHoNts _tlIrefNts _tlIrulenumber) = inv_Productions_s38 _tlX38 (T_Productions_vIn37 _tlOaroundMap _tlOinhMap _tlOmanualDeps _tlOmergeMap _tlOoptions _tlOrulenumber _tlOsynMap) _lhsOdepgraph :: [ProdDependencyGraph] _lhsOdepgraph = rule184 _hdIdepgraph _tlIdepgraph _lhsOlocalSigMap :: Map.Map ConstructorIdent (Map.Map Identifier Type) _lhsOlocalSigMap = rule185 _hdIlocalSigMap _tlIlocalSigMap _lhsOrefHoNts :: Set NontermIdent _lhsOrefHoNts = rule186 _hdIrefHoNts _tlIrefHoNts _lhsOrefNts :: Set NontermIdent _lhsOrefNts = rule187 _hdIrefNts _tlIrefNts _lhsOrulenumber :: Int _lhsOrulenumber = rule188 _tlIrulenumber _hdOaroundMap = rule189 _lhsIaroundMap _hdOinhMap = rule190 _lhsIinhMap _hdOmanualDeps = rule191 _lhsImanualDeps _hdOmergeMap = rule192 _lhsImergeMap _hdOoptions = rule193 _lhsIoptions _hdOrulenumber = rule194 _lhsIrulenumber _hdOsynMap = rule195 _lhsIsynMap _tlOaroundMap = rule196 _lhsIaroundMap _tlOinhMap = rule197 _lhsIinhMap _tlOmanualDeps = rule198 _lhsImanualDeps _tlOmergeMap = rule199 _lhsImergeMap _tlOoptions = rule200 _lhsIoptions _tlOrulenumber = rule201 _hdIrulenumber _tlOsynMap = rule202 _lhsIsynMap __result_ = T_Productions_vOut37 _lhsOdepgraph _lhsOlocalSigMap _lhsOrefHoNts _lhsOrefNts _lhsOrulenumber in __result_ ) in C_Productions_s38 v37 {-# INLINE rule184 #-} rule184 = \ ((_hdIdepgraph) :: ProdDependencyGraph) ((_tlIdepgraph) :: [ProdDependencyGraph]) -> _hdIdepgraph : _tlIdepgraph {-# INLINE rule185 #-} rule185 = \ ((_hdIlocalSigMap) :: Map.Map ConstructorIdent (Map.Map Identifier Type)) ((_tlIlocalSigMap) :: Map.Map ConstructorIdent (Map.Map Identifier Type)) -> _hdIlocalSigMap `Map.union` _tlIlocalSigMap {-# INLINE rule186 #-} rule186 = \ ((_hdIrefHoNts) :: Set NontermIdent) ((_tlIrefHoNts) :: Set NontermIdent) -> _hdIrefHoNts `mappend` _tlIrefHoNts {-# INLINE rule187 #-} rule187 = \ ((_hdIrefNts) :: Set NontermIdent) ((_tlIrefNts) :: Set NontermIdent) -> _hdIrefNts `mappend` _tlIrefNts {-# INLINE rule188 #-} rule188 = \ ((_tlIrulenumber) :: Int) -> _tlIrulenumber {-# INLINE rule189 #-} rule189 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Map Identifier [Expression])) -> _lhsIaroundMap {-# INLINE rule190 #-} rule190 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule191 #-} rule191 = \ ((_lhsImanualDeps) :: Map ConstructorIdent (Set Dependency)) -> _lhsImanualDeps {-# INLINE rule192 #-} rule192 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) -> _lhsImergeMap {-# INLINE rule193 #-} rule193 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule194 #-} rule194 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber {-# INLINE rule195 #-} rule195 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule196 #-} rule196 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Map Identifier [Expression])) -> _lhsIaroundMap {-# INLINE rule197 #-} rule197 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule198 #-} rule198 = \ ((_lhsImanualDeps) :: Map ConstructorIdent (Set Dependency)) -> _lhsImanualDeps {-# INLINE rule199 #-} rule199 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) -> _lhsImergeMap {-# INLINE rule200 #-} rule200 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule201 #-} rule201 = \ ((_hdIrulenumber) :: Int) -> _hdIrulenumber {-# INLINE rule202 #-} rule202 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE sem_Productions_Nil #-} sem_Productions_Nil :: T_Productions sem_Productions_Nil = T_Productions (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_Productions_v37 v37 = \ (T_Productions_vIn37 _lhsIaroundMap _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) -> ( let _lhsOdepgraph :: [ProdDependencyGraph] _lhsOdepgraph = rule203 () _lhsOlocalSigMap :: Map.Map ConstructorIdent (Map.Map Identifier Type) _lhsOlocalSigMap = rule204 () _lhsOrefHoNts :: Set NontermIdent _lhsOrefHoNts = rule205 () _lhsOrefNts :: Set NontermIdent _lhsOrefNts = rule206 () _lhsOrulenumber :: Int _lhsOrulenumber = rule207 _lhsIrulenumber __result_ = T_Productions_vOut37 _lhsOdepgraph _lhsOlocalSigMap _lhsOrefHoNts _lhsOrefNts _lhsOrulenumber in __result_ ) in C_Productions_s38 v37 {-# INLINE rule203 #-} rule203 = \ (_ :: ()) -> [] {-# INLINE rule204 #-} rule204 = \ (_ :: ()) -> Map.empty {-# INLINE rule205 #-} rule205 = \ (_ :: ()) -> mempty {-# INLINE rule206 #-} rule206 = \ (_ :: ()) -> mempty {-# INLINE rule207 #-} rule207 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber -- Rule -------------------------------------------------------- -- wrapper data Inh_Rule = Inh_Rule { rulenumber_Inh_Rule :: (Int) } data Syn_Rule = Syn_Rule { edges_Syn_Rule :: (Set.Set Edge), erules_Syn_Rule :: (ERule), rulenumber_Syn_Rule :: (Int), vertices_Syn_Rule :: (Set.Set Vertex) } {-# INLINABLE wrap_Rule #-} wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule ) wrap_Rule (T_Rule act) (Inh_Rule _lhsIrulenumber) = Control.Monad.Identity.runIdentity ( do sem <- act let arg40 = T_Rule_vIn40 _lhsIrulenumber (T_Rule_vOut40 _lhsOedges _lhsOerules _lhsOrulenumber _lhsOvertices) <- return (inv_Rule_s41 sem arg40) return (Syn_Rule _lhsOedges _lhsOerules _lhsOrulenumber _lhsOvertices) ) -- cata {-# INLINE sem_Rule #-} sem_Rule :: Rule -> T_Rule sem_Rule ( Rule mbName_ pattern_ rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ -- semantic domain newtype T_Rule = T_Rule { attach_T_Rule :: Identity (T_Rule_s41 ) } newtype T_Rule_s41 = C_Rule_s41 { inv_Rule_s41 :: (T_Rule_v40 ) } data T_Rule_s42 = C_Rule_s42 type T_Rule_v40 = (T_Rule_vIn40 ) -> (T_Rule_vOut40 ) data T_Rule_vIn40 = T_Rule_vIn40 (Int) data T_Rule_vOut40 = T_Rule_vOut40 (Set.Set Edge) (ERule) (Int) (Set.Set Vertex) {-# NOINLINE sem_Rule_Rule #-} sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule sem_Rule_Rule arg_mbName_ arg_pattern_ arg_rhs_ arg_owrt_ arg_origin_ arg_explicit_ arg_pure_ _ arg_mbError_ _ = T_Rule (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Rule_v40 v40 = \ (T_Rule_vIn40 _lhsIrulenumber) -> ( let _patternX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) _rhsX8 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) (T_Pattern_vOut28 _patternIcopy _patternIvertices) = inv_Pattern_s29 _patternX29 (T_Pattern_vIn28 ) (T_Expression_vOut7 _rhsIcopy _rhsIvertices) = inv_Expression_s8 _rhsX8 (T_Expression_vIn7 ) _lhsOerules :: ERule _lhsOerules = rule208 _patternIcopy _rhsIcopy _rulename arg_explicit_ arg_mbError_ arg_origin_ arg_owrt_ arg_pure_ _lhsOrulenumber :: Int _lhsOrulenumber = rule209 _lhsIrulenumber _rulename = rule210 _lhsIrulenumber arg_mbName_ _vertex = rule211 _rulename _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule212 _patternIvertices _rhsIvertices _vertex _edgesout = rule213 _rhsIvertices _vertex _edgesin = rule214 _patternIvertices _vertex _lhsOedges :: Set.Set Edge _lhsOedges = rule215 _edgesin _edgesout __result_ = T_Rule_vOut40 _lhsOedges _lhsOerules _lhsOrulenumber _lhsOvertices in __result_ ) in C_Rule_s41 v40 {-# INLINE rule208 #-} {-# LINE 65 "src-ag/ExecutionPlanCommon.ag" #-} rule208 = \ ((_patternIcopy) :: Pattern) ((_rhsIcopy) :: Expression) _rulename explicit_ mbError_ origin_ owrt_ pure_ -> {-# LINE 65 "src-ag/ExecutionPlanCommon.ag" #-} ERule _rulename _patternIcopy _rhsIcopy owrt_ origin_ explicit_ pure_ mbError_ {-# LINE 2047 "dist/build/KWOrder.hs"#-} {-# INLINE rule209 #-} {-# LINE 12 "src-ag/ExecutionPlanPre.ag" #-} rule209 = \ ((_lhsIrulenumber) :: Int) -> {-# LINE 12 "src-ag/ExecutionPlanPre.ag" #-} _lhsIrulenumber + 1 {-# LINE 2053 "dist/build/KWOrder.hs"#-} {-# INLINE rule210 #-} {-# LINE 13 "src-ag/ExecutionPlanPre.ag" #-} rule210 = \ ((_lhsIrulenumber) :: Int) mbName_ -> {-# LINE 13 "src-ag/ExecutionPlanPre.ag" #-} maybe (identifier $ "rule" ++ show _lhsIrulenumber) id mbName_ {-# LINE 2059 "dist/build/KWOrder.hs"#-} {-# INLINE rule211 #-} {-# LINE 74 "src-ag/KWOrder.ag" #-} rule211 = \ _rulename -> {-# LINE 74 "src-ag/KWOrder.ag" #-} VRule _rulename {-# LINE 2065 "dist/build/KWOrder.hs"#-} {-# INLINE rule212 #-} {-# LINE 75 "src-ag/KWOrder.ag" #-} rule212 = \ ((_patternIvertices) :: Set.Set Vertex) ((_rhsIvertices) :: Set.Set Vertex) _vertex -> {-# LINE 75 "src-ag/KWOrder.ag" #-} Set.insert _vertex $ _patternIvertices `Set.union` _rhsIvertices {-# LINE 2071 "dist/build/KWOrder.hs"#-} {-# INLINE rule213 #-} {-# LINE 87 "src-ag/KWOrder.ag" #-} rule213 = \ ((_rhsIvertices) :: Set.Set Vertex) _vertex -> {-# LINE 87 "src-ag/KWOrder.ag" #-} map ((,) _vertex ) (Set.toList _rhsIvertices) {-# LINE 2077 "dist/build/KWOrder.hs"#-} {-# INLINE rule214 #-} {-# LINE 88 "src-ag/KWOrder.ag" #-} rule214 = \ ((_patternIvertices) :: Set.Set Vertex) _vertex -> {-# LINE 88 "src-ag/KWOrder.ag" #-} map (flip (,) _vertex ) (Set.toList _patternIvertices) {-# LINE 2083 "dist/build/KWOrder.hs"#-} {-# INLINE rule215 #-} {-# LINE 89 "src-ag/KWOrder.ag" #-} rule215 = \ _edgesin _edgesout -> {-# LINE 89 "src-ag/KWOrder.ag" #-} Set.fromList $ _edgesout ++ _edgesin {-# LINE 2089 "dist/build/KWOrder.hs"#-} -- Rules ------------------------------------------------------- -- wrapper data Inh_Rules = Inh_Rules { rulenumber_Inh_Rules :: (Int) } data Syn_Rules = Syn_Rules { edges_Syn_Rules :: (Set.Set Edge), erules_Syn_Rules :: (ERules), rulenumber_Syn_Rules :: (Int), vertices_Syn_Rules :: (Set.Set Vertex) } {-# INLINABLE wrap_Rules #-} wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules ) wrap_Rules (T_Rules act) (Inh_Rules _lhsIrulenumber) = Control.Monad.Identity.runIdentity ( do sem <- act let arg43 = T_Rules_vIn43 _lhsIrulenumber (T_Rules_vOut43 _lhsOedges _lhsOerules _lhsOrulenumber _lhsOvertices) <- return (inv_Rules_s44 sem arg43) return (Syn_Rules _lhsOedges _lhsOerules _lhsOrulenumber _lhsOvertices) ) -- cata {-# NOINLINE sem_Rules #-} sem_Rules :: Rules -> T_Rules sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) -- semantic domain newtype T_Rules = T_Rules { attach_T_Rules :: Identity (T_Rules_s44 ) } newtype T_Rules_s44 = C_Rules_s44 { inv_Rules_s44 :: (T_Rules_v43 ) } data T_Rules_s45 = C_Rules_s45 type T_Rules_v43 = (T_Rules_vIn43 ) -> (T_Rules_vOut43 ) data T_Rules_vIn43 = T_Rules_vIn43 (Int) data T_Rules_vOut43 = T_Rules_vOut43 (Set.Set Edge) (ERules) (Int) (Set.Set Vertex) {-# NOINLINE sem_Rules_Cons #-} sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_Rules_v43 v43 = \ (T_Rules_vIn43 _lhsIrulenumber) -> ( let _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) (T_Rule_vOut40 _hdIedges _hdIerules _hdIrulenumber _hdIvertices) = inv_Rule_s41 _hdX41 (T_Rule_vIn40 _hdOrulenumber) (T_Rules_vOut43 _tlIedges _tlIerules _tlIrulenumber _tlIvertices) = inv_Rules_s44 _tlX44 (T_Rules_vIn43 _tlOrulenumber) _lhsOedges :: Set.Set Edge _lhsOedges = rule216 _hdIedges _tlIedges _lhsOerules :: ERules _lhsOerules = rule217 _hdIerules _tlIerules _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule218 _hdIvertices _tlIvertices _lhsOrulenumber :: Int _lhsOrulenumber = rule219 _tlIrulenumber _hdOrulenumber = rule220 _lhsIrulenumber _tlOrulenumber = rule221 _hdIrulenumber __result_ = T_Rules_vOut43 _lhsOedges _lhsOerules _lhsOrulenumber _lhsOvertices in __result_ ) in C_Rules_s44 v43 {-# INLINE rule216 #-} rule216 = \ ((_hdIedges) :: Set.Set Edge) ((_tlIedges) :: Set.Set Edge) -> _hdIedges `Set.union` _tlIedges {-# INLINE rule217 #-} rule217 = \ ((_hdIerules) :: ERule) ((_tlIerules) :: ERules) -> _hdIerules : _tlIerules {-# INLINE rule218 #-} rule218 = \ ((_hdIvertices) :: Set.Set Vertex) ((_tlIvertices) :: Set.Set Vertex) -> _hdIvertices `Set.union` _tlIvertices {-# INLINE rule219 #-} rule219 = \ ((_tlIrulenumber) :: Int) -> _tlIrulenumber {-# INLINE rule220 #-} rule220 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber {-# INLINE rule221 #-} rule221 = \ ((_hdIrulenumber) :: Int) -> _hdIrulenumber {-# NOINLINE sem_Rules_Nil #-} sem_Rules_Nil :: T_Rules sem_Rules_Nil = T_Rules (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_Rules_v43 v43 = \ (T_Rules_vIn43 _lhsIrulenumber) -> ( let _lhsOedges :: Set.Set Edge _lhsOedges = rule222 () _lhsOerules :: ERules _lhsOerules = rule223 () _lhsOvertices :: Set.Set Vertex _lhsOvertices = rule224 () _lhsOrulenumber :: Int _lhsOrulenumber = rule225 _lhsIrulenumber __result_ = T_Rules_vOut43 _lhsOedges _lhsOerules _lhsOrulenumber _lhsOvertices in __result_ ) in C_Rules_s44 v43 {-# INLINE rule222 #-} rule222 = \ (_ :: ()) -> Set.empty {-# INLINE rule223 #-} rule223 = \ (_ :: ()) -> [] {-# INLINE rule224 #-} rule224 = \ (_ :: ()) -> Set.empty {-# INLINE rule225 #-} rule225 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber -- TypeSig ----------------------------------------------------- -- wrapper data Inh_TypeSig = Inh_TypeSig { } data Syn_TypeSig = Syn_TypeSig { localSigMap_Syn_TypeSig :: (Map Identifier Type) } {-# INLINABLE wrap_TypeSig #-} wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig ) wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg46 = T_TypeSig_vIn46 (T_TypeSig_vOut46 _lhsOlocalSigMap) <- return (inv_TypeSig_s47 sem arg46) return (Syn_TypeSig _lhsOlocalSigMap) ) -- cata {-# INLINE sem_TypeSig #-} sem_TypeSig :: TypeSig -> T_TypeSig sem_TypeSig ( TypeSig name_ tp_ ) = sem_TypeSig_TypeSig name_ tp_ -- semantic domain newtype T_TypeSig = T_TypeSig { attach_T_TypeSig :: Identity (T_TypeSig_s47 ) } newtype T_TypeSig_s47 = C_TypeSig_s47 { inv_TypeSig_s47 :: (T_TypeSig_v46 ) } data T_TypeSig_s48 = C_TypeSig_s48 type T_TypeSig_v46 = (T_TypeSig_vIn46 ) -> (T_TypeSig_vOut46 ) data T_TypeSig_vIn46 = T_TypeSig_vIn46 data T_TypeSig_vOut46 = T_TypeSig_vOut46 (Map Identifier Type) {-# NOINLINE sem_TypeSig_TypeSig #-} sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig sem_TypeSig_TypeSig arg_name_ arg_tp_ = T_TypeSig (return st47) where {-# NOINLINE st47 #-} st47 = let v46 :: T_TypeSig_v46 v46 = \ (T_TypeSig_vIn46 ) -> ( let _lhsOlocalSigMap :: Map Identifier Type _lhsOlocalSigMap = rule226 arg_name_ arg_tp_ __result_ = T_TypeSig_vOut46 _lhsOlocalSigMap in __result_ ) in C_TypeSig_s47 v46 {-# INLINE rule226 #-} {-# LINE 161 "src-ag/ExecutionPlanCommon.ag" #-} rule226 = \ name_ tp_ -> {-# LINE 161 "src-ag/ExecutionPlanCommon.ag" #-} Map.singleton name_ tp_ {-# LINE 2241 "dist/build/KWOrder.hs"#-} -- TypeSigs ---------------------------------------------------- -- wrapper data Inh_TypeSigs = Inh_TypeSigs { } data Syn_TypeSigs = Syn_TypeSigs { localSigMap_Syn_TypeSigs :: (Map Identifier Type) } {-# INLINABLE wrap_TypeSigs #-} wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs ) wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg49 = T_TypeSigs_vIn49 (T_TypeSigs_vOut49 _lhsOlocalSigMap) <- return (inv_TypeSigs_s50 sem arg49) return (Syn_TypeSigs _lhsOlocalSigMap) ) -- cata {-# NOINLINE sem_TypeSigs #-} sem_TypeSigs :: TypeSigs -> T_TypeSigs sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) -- semantic domain newtype T_TypeSigs = T_TypeSigs { attach_T_TypeSigs :: Identity (T_TypeSigs_s50 ) } newtype T_TypeSigs_s50 = C_TypeSigs_s50 { inv_TypeSigs_s50 :: (T_TypeSigs_v49 ) } data T_TypeSigs_s51 = C_TypeSigs_s51 type T_TypeSigs_v49 = (T_TypeSigs_vIn49 ) -> (T_TypeSigs_vOut49 ) data T_TypeSigs_vIn49 = T_TypeSigs_vIn49 data T_TypeSigs_vOut49 = T_TypeSigs_vOut49 (Map Identifier Type) {-# NOINLINE sem_TypeSigs_Cons #-} sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_TypeSigs_v49 v49 = \ (T_TypeSigs_vIn49 ) -> ( let _hdX47 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_)) _tlX50 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_)) (T_TypeSig_vOut46 _hdIlocalSigMap) = inv_TypeSig_s47 _hdX47 (T_TypeSig_vIn46 ) (T_TypeSigs_vOut49 _tlIlocalSigMap) = inv_TypeSigs_s50 _tlX50 (T_TypeSigs_vIn49 ) _lhsOlocalSigMap :: Map Identifier Type _lhsOlocalSigMap = rule227 _hdIlocalSigMap _tlIlocalSigMap __result_ = T_TypeSigs_vOut49 _lhsOlocalSigMap in __result_ ) in C_TypeSigs_s50 v49 {-# INLINE rule227 #-} rule227 = \ ((_hdIlocalSigMap) :: Map Identifier Type) ((_tlIlocalSigMap) :: Map Identifier Type) -> _hdIlocalSigMap `Map.union` _tlIlocalSigMap {-# NOINLINE sem_TypeSigs_Nil #-} sem_TypeSigs_Nil :: T_TypeSigs sem_TypeSigs_Nil = T_TypeSigs (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_TypeSigs_v49 v49 = \ (T_TypeSigs_vIn49 ) -> ( let _lhsOlocalSigMap :: Map Identifier Type _lhsOlocalSigMap = rule228 () __result_ = T_TypeSigs_vOut49 _lhsOlocalSigMap in __result_ ) in C_TypeSigs_s50 v49 {-# INLINE rule228 #-} rule228 = \ (_ :: ()) -> Map.empty uuagc-0.9.52.2/src-generated/ResolveLocals.hs0000644000000000000000000027366113433540502017113 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module ResolveLocals where {-# LINE 2 "src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken {-# LINE 10 "dist/build/ResolveLocals.hs" #-} {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 17 "dist/build/ResolveLocals.hs" #-} {-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) import Data.Map(Map) import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import Macro --marcos import CommonTypes import ErrorMessages {-# LINE 29 "dist/build/ResolveLocals.hs" #-} {-# LINE 15 "src-ag/ResolveLocals.ag" #-} import qualified Data.Set as Set import qualified Data.Map as Map import Data.Map(Map) import qualified Data.Sequence as Seq import Data.Sequence(Seq,(><)) import CommonTypes import Patterns import ErrorMessages import AbstractSyntax import Expression import Options import HsToken(HsTokensRoot(HsTokensRoot)) import SemHsTokens(sem_HsTokensRoot,wrap_HsTokensRoot, Syn_HsTokensRoot(..),Inh_HsTokensRoot(..)) import Data.Maybe {-# LINE 47 "dist/build/ResolveLocals.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -- Child ------------------------------------------------------- -- wrapper data Inh_Child = Inh_Child { allfields_Inh_Child :: ([(Identifier,Type,ChildKind)]), allnts_Inh_Child :: ([Identifier]), attrs_Inh_Child :: ([(Identifier,Identifier)]), con_Inh_Child :: (Identifier), inh_Inh_Child :: (Attributes), inhMap_Inh_Child :: (Map Identifier Attributes), mergeMap_Inh_Child :: (Map Identifier (Identifier,[Identifier])), nt_Inh_Child :: (Identifier), syn_Inh_Child :: (Attributes), synMap_Inh_Child :: (Map Identifier Attributes) } data Syn_Child = Syn_Child { attributes_Syn_Child :: ([(Identifier,Attributes,Attributes)]), field_Syn_Child :: ((Identifier,Type,ChildKind)), output_Syn_Child :: (Child) } {-# INLINABLE wrap_Child #-} wrap_Child :: T_Child -> Inh_Child -> (Syn_Child ) wrap_Child (T_Child act) (Inh_Child _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIsyn _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_Child_vIn1 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIsyn _lhsIsynMap (T_Child_vOut1 _lhsOattributes _lhsOfield _lhsOoutput) <- return (inv_Child_s2 sem arg1) return (Syn_Child _lhsOattributes _lhsOfield _lhsOoutput) ) -- cata {-# INLINE sem_Child #-} sem_Child :: Child -> T_Child sem_Child ( Child name_ tp_ kind_ ) = sem_Child_Child name_ tp_ kind_ -- semantic domain newtype T_Child = T_Child { attach_T_Child :: Identity (T_Child_s2 ) } newtype T_Child_s2 = C_Child_s2 { inv_Child_s2 :: (T_Child_v1 ) } data T_Child_s3 = C_Child_s3 type T_Child_v1 = (T_Child_vIn1 ) -> (T_Child_vOut1 ) data T_Child_vIn1 = T_Child_vIn1 ([(Identifier,Type,ChildKind)]) ([Identifier]) ([(Identifier,Identifier)]) (Identifier) (Attributes) (Map Identifier Attributes) (Map Identifier (Identifier,[Identifier])) (Identifier) (Attributes) (Map Identifier Attributes) data T_Child_vOut1 = T_Child_vOut1 ([(Identifier,Attributes,Attributes)]) ((Identifier,Type,ChildKind)) (Child) {-# NOINLINE sem_Child_Child #-} sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child sem_Child_Child arg_name_ arg_tp_ arg_kind_ = T_Child (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Child_v1 v1 = \ (T_Child_vIn1 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIsyn _lhsIsynMap) -> ( let _chnt = rule0 arg_name_ arg_tp_ _inh = rule1 _chnt _lhsIinhMap _syn = rule2 _chnt _lhsIsynMap _lhsOattributes :: [(Identifier,Attributes,Attributes)] _lhsOattributes = rule3 _inh _syn arg_name_ _lhsOfield :: (Identifier,Type,ChildKind) _lhsOfield = rule4 arg_kind_ arg_name_ arg_tp_ _output = rule5 arg_kind_ arg_name_ arg_tp_ _lhsOoutput :: Child _lhsOoutput = rule6 _output __result_ = T_Child_vOut1 _lhsOattributes _lhsOfield _lhsOoutput in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} {-# LINE 19 "src-ag/DistChildAttr.ag" #-} rule0 = \ name_ tp_ -> {-# LINE 19 "src-ag/DistChildAttr.ag" #-} case tp_ of NT nt _ _ -> nt Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") Haskell t -> identifier "" {-# LINE 108 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule1 #-} {-# LINE 23 "src-ag/DistChildAttr.ag" #-} rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> {-# LINE 23 "src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIinhMap {-# LINE 114 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule2 #-} {-# LINE 24 "src-ag/DistChildAttr.ag" #-} rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> {-# LINE 24 "src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIsynMap {-# LINE 120 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule3 #-} {-# LINE 83 "src-ag/ResolveLocals.ag" #-} rule3 = \ _inh _syn name_ -> {-# LINE 83 "src-ag/ResolveLocals.ag" #-} [(name_, _inh , _syn )] {-# LINE 126 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule4 #-} {-# LINE 86 "src-ag/ResolveLocals.ag" #-} rule4 = \ kind_ name_ tp_ -> {-# LINE 86 "src-ag/ResolveLocals.ag" #-} (name_, tp_, kind_) {-# LINE 132 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule5 #-} rule5 = \ kind_ name_ tp_ -> Child name_ tp_ kind_ {-# INLINE rule6 #-} rule6 = \ _output -> _output -- Children ---------------------------------------------------- -- wrapper data Inh_Children = Inh_Children { allfields_Inh_Children :: ([(Identifier,Type,ChildKind)]), allnts_Inh_Children :: ([Identifier]), attrs_Inh_Children :: ([(Identifier,Identifier)]), con_Inh_Children :: (Identifier), inh_Inh_Children :: (Attributes), inhMap_Inh_Children :: (Map Identifier Attributes), mergeMap_Inh_Children :: (Map Identifier (Identifier,[Identifier])), nt_Inh_Children :: (Identifier), syn_Inh_Children :: (Attributes), synMap_Inh_Children :: (Map Identifier Attributes) } data Syn_Children = Syn_Children { attributes_Syn_Children :: ([(Identifier,Attributes,Attributes)]), fields_Syn_Children :: ([(Identifier,Type,ChildKind)]), output_Syn_Children :: (Children) } {-# INLINABLE wrap_Children #-} wrap_Children :: T_Children -> Inh_Children -> (Syn_Children ) wrap_Children (T_Children act) (Inh_Children _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIsyn _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_Children_vIn4 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIsyn _lhsIsynMap (T_Children_vOut4 _lhsOattributes _lhsOfields _lhsOoutput) <- return (inv_Children_s5 sem arg4) return (Syn_Children _lhsOattributes _lhsOfields _lhsOoutput) ) -- cata {-# NOINLINE sem_Children #-} sem_Children :: Children -> T_Children sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) -- semantic domain newtype T_Children = T_Children { attach_T_Children :: Identity (T_Children_s5 ) } newtype T_Children_s5 = C_Children_s5 { inv_Children_s5 :: (T_Children_v4 ) } data T_Children_s6 = C_Children_s6 type T_Children_v4 = (T_Children_vIn4 ) -> (T_Children_vOut4 ) data T_Children_vIn4 = T_Children_vIn4 ([(Identifier,Type,ChildKind)]) ([Identifier]) ([(Identifier,Identifier)]) (Identifier) (Attributes) (Map Identifier Attributes) (Map Identifier (Identifier,[Identifier])) (Identifier) (Attributes) (Map Identifier Attributes) data T_Children_vOut4 = T_Children_vOut4 ([(Identifier,Attributes,Attributes)]) ([(Identifier,Type,ChildKind)]) (Children) {-# NOINLINE sem_Children_Cons #-} sem_Children_Cons :: T_Child -> T_Children -> T_Children sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_Children_v4 v4 = \ (T_Children_vIn4 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIsyn _lhsIsynMap) -> ( let _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) (T_Child_vOut1 _hdIattributes _hdIfield _hdIoutput) = inv_Child_s2 _hdX2 (T_Child_vIn1 _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOinh _hdOinhMap _hdOmergeMap _hdOnt _hdOsyn _hdOsynMap) (T_Children_vOut4 _tlIattributes _tlIfields _tlIoutput) = inv_Children_s5 _tlX5 (T_Children_vIn4 _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOinh _tlOinhMap _tlOmergeMap _tlOnt _tlOsyn _tlOsynMap) _lhsOfields :: [(Identifier,Type,ChildKind)] _lhsOfields = rule7 _hdIfield _tlIfields _lhsOattributes :: [(Identifier,Attributes,Attributes)] _lhsOattributes = rule8 _hdIattributes _tlIattributes _output = rule9 _hdIoutput _tlIoutput _lhsOoutput :: Children _lhsOoutput = rule10 _output _hdOallfields = rule11 _lhsIallfields _hdOallnts = rule12 _lhsIallnts _hdOattrs = rule13 _lhsIattrs _hdOcon = rule14 _lhsIcon _hdOinh = rule15 _lhsIinh _hdOinhMap = rule16 _lhsIinhMap _hdOmergeMap = rule17 _lhsImergeMap _hdOnt = rule18 _lhsInt _hdOsyn = rule19 _lhsIsyn _hdOsynMap = rule20 _lhsIsynMap _tlOallfields = rule21 _lhsIallfields _tlOallnts = rule22 _lhsIallnts _tlOattrs = rule23 _lhsIattrs _tlOcon = rule24 _lhsIcon _tlOinh = rule25 _lhsIinh _tlOinhMap = rule26 _lhsIinhMap _tlOmergeMap = rule27 _lhsImergeMap _tlOnt = rule28 _lhsInt _tlOsyn = rule29 _lhsIsyn _tlOsynMap = rule30 _lhsIsynMap __result_ = T_Children_vOut4 _lhsOattributes _lhsOfields _lhsOoutput in __result_ ) in C_Children_s5 v4 {-# INLINE rule7 #-} {-# LINE 89 "src-ag/ResolveLocals.ag" #-} rule7 = \ ((_hdIfield) :: (Identifier,Type,ChildKind)) ((_tlIfields) :: [(Identifier,Type,ChildKind)]) -> {-# LINE 89 "src-ag/ResolveLocals.ag" #-} _hdIfield : _tlIfields {-# LINE 216 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule8 #-} rule8 = \ ((_hdIattributes) :: [(Identifier,Attributes,Attributes)]) ((_tlIattributes) :: [(Identifier,Attributes,Attributes)]) -> _hdIattributes ++ _tlIattributes {-# INLINE rule9 #-} rule9 = \ ((_hdIoutput) :: Child) ((_tlIoutput) :: Children) -> (:) _hdIoutput _tlIoutput {-# INLINE rule10 #-} rule10 = \ _output -> _output {-# INLINE rule11 #-} rule11 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) -> _lhsIallfields {-# INLINE rule12 #-} rule12 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule13 #-} rule13 = \ ((_lhsIattrs) :: [(Identifier,Identifier)]) -> _lhsIattrs {-# INLINE rule14 #-} rule14 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule15 #-} rule15 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule16 #-} rule16 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule17 #-} rule17 = \ ((_lhsImergeMap) :: Map Identifier (Identifier,[Identifier])) -> _lhsImergeMap {-# INLINE rule18 #-} rule18 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule19 #-} rule19 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule20 #-} rule20 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule21 #-} rule21 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) -> _lhsIallfields {-# INLINE rule22 #-} rule22 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule23 #-} rule23 = \ ((_lhsIattrs) :: [(Identifier,Identifier)]) -> _lhsIattrs {-# INLINE rule24 #-} rule24 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule25 #-} rule25 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule26 #-} rule26 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule27 #-} rule27 = \ ((_lhsImergeMap) :: Map Identifier (Identifier,[Identifier])) -> _lhsImergeMap {-# INLINE rule28 #-} rule28 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule29 #-} rule29 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule30 #-} rule30 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE sem_Children_Nil #-} sem_Children_Nil :: T_Children sem_Children_Nil = T_Children (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_Children_v4 v4 = \ (T_Children_vIn4 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIsyn _lhsIsynMap) -> ( let _lhsOfields :: [(Identifier,Type,ChildKind)] _lhsOfields = rule31 () _lhsOattributes :: [(Identifier,Attributes,Attributes)] _lhsOattributes = rule32 () _output = rule33 () _lhsOoutput :: Children _lhsOoutput = rule34 _output __result_ = T_Children_vOut4 _lhsOattributes _lhsOfields _lhsOoutput in __result_ ) in C_Children_s5 v4 {-# INLINE rule31 #-} {-# LINE 90 "src-ag/ResolveLocals.ag" #-} rule31 = \ (_ :: ()) -> {-# LINE 90 "src-ag/ResolveLocals.ag" #-} [] {-# LINE 308 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule32 #-} rule32 = \ (_ :: ()) -> [] {-# INLINE rule33 #-} rule33 = \ (_ :: ()) -> [] {-# INLINE rule34 #-} rule34 = \ _output -> _output -- Expression -------------------------------------------------- -- wrapper data Inh_Expression = Inh_Expression { allfields_Inh_Expression :: ([(Identifier,Type,ChildKind)]), allnts_Inh_Expression :: ([Identifier]), attrs_Inh_Expression :: ([(Identifier,Identifier)]), con_Inh_Expression :: (Identifier), mergeMap_Inh_Expression :: (Map Identifier (Identifier,[Identifier])), nt_Inh_Expression :: (Identifier), options_Inh_Expression :: (Options) } data Syn_Expression = Syn_Expression { errors_Syn_Expression :: (Seq Error), output_Syn_Expression :: (Expression) } {-# INLINABLE wrap_Expression #-} wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) wrap_Expression (T_Expression act) (Inh_Expression _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_Expression_vIn7 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt _lhsIoptions (T_Expression_vOut7 _lhsOerrors _lhsOoutput) <- return (inv_Expression_s8 sem arg7) return (Syn_Expression _lhsOerrors _lhsOoutput) ) -- cata {-# INLINE sem_Expression #-} sem_Expression :: Expression -> T_Expression sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_ -- semantic domain newtype T_Expression = T_Expression { attach_T_Expression :: Identity (T_Expression_s8 ) } newtype T_Expression_s8 = C_Expression_s8 { inv_Expression_s8 :: (T_Expression_v7 ) } data T_Expression_s9 = C_Expression_s9 type T_Expression_v7 = (T_Expression_vIn7 ) -> (T_Expression_vOut7 ) data T_Expression_vIn7 = T_Expression_vIn7 ([(Identifier,Type,ChildKind)]) ([Identifier]) ([(Identifier,Identifier)]) (Identifier) (Map Identifier (Identifier,[Identifier])) (Identifier) (Options) data T_Expression_vOut7 = T_Expression_vOut7 (Seq Error) (Expression) {-# NOINLINE sem_Expression_Expression #-} sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression sem_Expression_Expression arg_pos_ arg_tks_ = T_Expression (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_Expression_v7 v7 = \ (T_Expression_vIn7 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt _lhsIoptions) -> ( let (_errors,_newTks) = rule35 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt _lhsIoptions arg_tks_ _lhsOoutput :: Expression _lhsOoutput = rule36 _newTks arg_pos_ _lhsOerrors :: Seq Error _lhsOerrors = rule37 _errors _output = rule38 arg_pos_ arg_tks_ __result_ = T_Expression_vOut7 _lhsOerrors _lhsOoutput in __result_ ) in C_Expression_s8 v7 {-# INLINE rule35 #-} {-# LINE 145 "src-ag/ResolveLocals.ag" #-} rule35 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) ((_lhsIallnts) :: [Identifier]) ((_lhsIattrs) :: [(Identifier,Identifier)]) ((_lhsIcon) :: Identifier) ((_lhsImergeMap) :: Map Identifier (Identifier,[Identifier])) ((_lhsInt) :: Identifier) ((_lhsIoptions) :: Options) tks_ -> {-# LINE 145 "src-ag/ResolveLocals.ag" #-} let mergedChildren = [ x | (_,xs) <- Map.elems _lhsImergeMap, x <- xs ] attrsIn = filter (\(fld,_) -> not (fld `elem` mergedChildren)) _lhsIattrs inherited = Inh_HsTokensRoot { attrs_Inh_HsTokensRoot = attrsIn , con_Inh_HsTokensRoot = _lhsIcon , allfields_Inh_HsTokensRoot = _lhsIallfields , allnts_Inh_HsTokensRoot = _lhsIallnts , nt_Inh_HsTokensRoot = _lhsInt , options_Inh_HsTokensRoot = _lhsIoptions } synthesized = wrap_HsTokensRoot (sem_HsTokensRoot (HsTokensRoot tks_)) inherited in (errors_Syn_HsTokensRoot synthesized, output_Syn_HsTokensRoot synthesized) {-# LINE 381 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule36 #-} {-# LINE 157 "src-ag/ResolveLocals.ag" #-} rule36 = \ _newTks pos_ -> {-# LINE 157 "src-ag/ResolveLocals.ag" #-} Expression pos_ _newTks {-# LINE 387 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule37 #-} rule37 = \ _errors -> _errors {-# INLINE rule38 #-} rule38 = \ pos_ tks_ -> Expression pos_ tks_ -- Grammar ----------------------------------------------------- -- wrapper data Inh_Grammar = Inh_Grammar { options_Inh_Grammar :: (Options) } data Syn_Grammar = Syn_Grammar { errors_Syn_Grammar :: (Seq Error), output_Syn_Grammar :: (Grammar) } {-# INLINABLE wrap_Grammar #-} wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar ) wrap_Grammar (T_Grammar act) (Inh_Grammar _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg10 = T_Grammar_vIn10 _lhsIoptions (T_Grammar_vOut10 _lhsOerrors _lhsOoutput) <- return (inv_Grammar_s11 sem arg10) return (Syn_Grammar _lhsOerrors _lhsOoutput) ) -- cata {-# INLINE sem_Grammar #-} sem_Grammar :: Grammar -> T_Grammar sem_Grammar ( Grammar typeSyns_ useMap_ derivings_ wrappers_ nonts_ pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ -- semantic domain newtype T_Grammar = T_Grammar { attach_T_Grammar :: Identity (T_Grammar_s11 ) } newtype T_Grammar_s11 = C_Grammar_s11 { inv_Grammar_s11 :: (T_Grammar_v10 ) } data T_Grammar_s12 = C_Grammar_s12 type T_Grammar_v10 = (T_Grammar_vIn10 ) -> (T_Grammar_vOut10 ) data T_Grammar_vIn10 = T_Grammar_vIn10 (Options) data T_Grammar_vOut10 = T_Grammar_vOut10 (Seq Error) (Grammar) {-# NOINLINE sem_Grammar_Grammar #-} sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar sem_Grammar_Grammar arg_typeSyns_ arg_useMap_ arg_derivings_ arg_wrappers_ arg_nonts_ arg_pragmas_ arg_manualAttrOrderMap_ arg_paramMap_ arg_contextMap_ arg_quantMap_ arg_uniqueMap_ arg_augmentsMap_ arg_aroundsMap_ arg_mergeMap_ = T_Grammar (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_Grammar_v10 v10 = \ (T_Grammar_vIn10 _lhsIoptions) -> ( let _nontsX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) (T_Nonterminals_vOut16 _nontsIerrors _nontsIinhMap' _nontsInonts _nontsIoutput _nontsIsynMap') = inv_Nonterminals_s17 _nontsX17 (T_Nonterminals_vIn16 _nontsOallnts _nontsOinhMap _nontsOmergeMap _nontsOoptions _nontsOsynMap) _nontsOinhMap = rule39 _nontsIinhMap' _nontsOsynMap = rule40 _nontsIsynMap' _nontsOallnts = rule41 _nontsInonts _nontsOmergeMap = rule42 arg_mergeMap_ _lhsOerrors :: Seq Error _lhsOerrors = rule43 _nontsIerrors _output = rule44 _nontsIoutput arg_aroundsMap_ arg_augmentsMap_ arg_contextMap_ arg_derivings_ arg_manualAttrOrderMap_ arg_mergeMap_ arg_paramMap_ arg_pragmas_ arg_quantMap_ arg_typeSyns_ arg_uniqueMap_ arg_useMap_ arg_wrappers_ _lhsOoutput :: Grammar _lhsOoutput = rule45 _output _nontsOoptions = rule46 _lhsIoptions __result_ = T_Grammar_vOut10 _lhsOerrors _lhsOoutput in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule39 #-} {-# LINE 15 "src-ag/DistChildAttr.ag" #-} rule39 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> {-# LINE 15 "src-ag/DistChildAttr.ag" #-} _nontsIinhMap' {-# LINE 452 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule40 #-} {-# LINE 16 "src-ag/DistChildAttr.ag" #-} rule40 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> {-# LINE 16 "src-ag/DistChildAttr.ag" #-} _nontsIsynMap' {-# LINE 458 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule41 #-} {-# LINE 59 "src-ag/ResolveLocals.ag" #-} rule41 = \ ((_nontsInonts) :: [(NontermIdent,[ConstructorIdent])]) -> {-# LINE 59 "src-ag/ResolveLocals.ag" #-} map fst (_nontsInonts) {-# LINE 464 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule42 #-} {-# LINE 119 "src-ag/ResolveLocals.ag" #-} rule42 = \ mergeMap_ -> {-# LINE 119 "src-ag/ResolveLocals.ag" #-} Map.map (Map.map (Map.map (\(nt,srcs,_) -> (nt,srcs)))) mergeMap_ {-# LINE 470 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule43 #-} rule43 = \ ((_nontsIerrors) :: Seq Error) -> _nontsIerrors {-# INLINE rule44 #-} rule44 = \ ((_nontsIoutput) :: Nonterminals) aroundsMap_ augmentsMap_ contextMap_ derivings_ manualAttrOrderMap_ mergeMap_ paramMap_ pragmas_ quantMap_ typeSyns_ uniqueMap_ useMap_ wrappers_ -> Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ {-# INLINE rule45 #-} rule45 = \ _output -> _output {-# INLINE rule46 #-} rule46 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- Nonterminal ------------------------------------------------- -- wrapper data Inh_Nonterminal = Inh_Nonterminal { allnts_Inh_Nonterminal :: ([Identifier]), inhMap_Inh_Nonterminal :: (Map Identifier Attributes), mergeMap_Inh_Nonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))), options_Inh_Nonterminal :: (Options), synMap_Inh_Nonterminal :: (Map Identifier Attributes) } data Syn_Nonterminal = Syn_Nonterminal { errors_Syn_Nonterminal :: (Seq Error), inhMap'_Syn_Nonterminal :: (Map Identifier Attributes), nonts_Syn_Nonterminal :: ([(NontermIdent,[ConstructorIdent])]), output_Syn_Nonterminal :: (Nonterminal), synMap'_Syn_Nonterminal :: (Map Identifier Attributes) } {-# INLINABLE wrap_Nonterminal #-} wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal ) wrap_Nonterminal (T_Nonterminal act) (Inh_Nonterminal _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg13 = T_Nonterminal_vIn13 _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap (T_Nonterminal_vOut13 _lhsOerrors _lhsOinhMap' _lhsOnonts _lhsOoutput _lhsOsynMap') <- return (inv_Nonterminal_s14 sem arg13) return (Syn_Nonterminal _lhsOerrors _lhsOinhMap' _lhsOnonts _lhsOoutput _lhsOsynMap') ) -- cata {-# INLINE sem_Nonterminal #-} sem_Nonterminal :: Nonterminal -> T_Nonterminal sem_Nonterminal ( Nonterminal nt_ params_ inh_ syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ ) -- semantic domain newtype T_Nonterminal = T_Nonterminal { attach_T_Nonterminal :: Identity (T_Nonterminal_s14 ) } newtype T_Nonterminal_s14 = C_Nonterminal_s14 { inv_Nonterminal_s14 :: (T_Nonterminal_v13 ) } data T_Nonterminal_s15 = C_Nonterminal_s15 type T_Nonterminal_v13 = (T_Nonterminal_vIn13 ) -> (T_Nonterminal_vOut13 ) data T_Nonterminal_vIn13 = T_Nonterminal_vIn13 ([Identifier]) (Map Identifier Attributes) (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) (Options) (Map Identifier Attributes) data T_Nonterminal_vOut13 = T_Nonterminal_vOut13 (Seq Error) (Map Identifier Attributes) ([(NontermIdent,[ConstructorIdent])]) (Nonterminal) (Map Identifier Attributes) {-# NOINLINE sem_Nonterminal_Nonterminal #-} sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal sem_Nonterminal_Nonterminal arg_nt_ arg_params_ arg_inh_ arg_syn_ arg_prods_ = T_Nonterminal (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_Nonterminal_v13 v13 = \ (T_Nonterminal_vIn13 _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap) -> ( let _prodsX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) (T_Productions_vOut28 _prodsIcons _prodsIerrors _prodsIoutput) = inv_Productions_s29 _prodsX29 (T_Productions_vIn28 _prodsOallnts _prodsOinh _prodsOinhMap _prodsOmergeMap _prodsOnt _prodsOoptions _prodsOsyn _prodsOsynMap) _lhsOinhMap' :: Map Identifier Attributes _lhsOinhMap' = rule47 arg_inh_ arg_nt_ _lhsOsynMap' :: Map Identifier Attributes _lhsOsynMap' = rule48 arg_nt_ arg_syn_ _lhsOnonts :: [(NontermIdent,[ConstructorIdent])] _lhsOnonts = rule49 _prodsIcons arg_nt_ _prodsOnt = rule50 arg_nt_ _prodsOinh = rule51 arg_inh_ _prodsOsyn = rule52 arg_syn_ _mergeMap = rule53 _lhsImergeMap arg_nt_ _lhsOerrors :: Seq Error _lhsOerrors = rule54 _prodsIerrors _output = rule55 _prodsIoutput arg_inh_ arg_nt_ arg_params_ arg_syn_ _lhsOoutput :: Nonterminal _lhsOoutput = rule56 _output _prodsOallnts = rule57 _lhsIallnts _prodsOinhMap = rule58 _lhsIinhMap _prodsOmergeMap = rule59 _mergeMap _prodsOoptions = rule60 _lhsIoptions _prodsOsynMap = rule61 _lhsIsynMap __result_ = T_Nonterminal_vOut13 _lhsOerrors _lhsOinhMap' _lhsOnonts _lhsOoutput _lhsOsynMap' in __result_ ) in C_Nonterminal_s14 v13 {-# INLINE rule47 #-} {-# LINE 7 "src-ag/DistChildAttr.ag" #-} rule47 = \ inh_ nt_ -> {-# LINE 7 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ inh_ {-# LINE 551 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule48 #-} {-# LINE 8 "src-ag/DistChildAttr.ag" #-} rule48 = \ nt_ syn_ -> {-# LINE 8 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ syn_ {-# LINE 557 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule49 #-} {-# LINE 63 "src-ag/ResolveLocals.ag" #-} rule49 = \ ((_prodsIcons) :: [ConstructorIdent]) nt_ -> {-# LINE 63 "src-ag/ResolveLocals.ag" #-} [(nt_,_prodsIcons)] {-# LINE 563 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule50 #-} {-# LINE 111 "src-ag/ResolveLocals.ag" #-} rule50 = \ nt_ -> {-# LINE 111 "src-ag/ResolveLocals.ag" #-} nt_ {-# LINE 569 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule51 #-} {-# LINE 114 "src-ag/ResolveLocals.ag" #-} rule51 = \ inh_ -> {-# LINE 114 "src-ag/ResolveLocals.ag" #-} inh_ {-# LINE 575 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule52 #-} {-# LINE 115 "src-ag/ResolveLocals.ag" #-} rule52 = \ syn_ -> {-# LINE 115 "src-ag/ResolveLocals.ag" #-} syn_ {-# LINE 581 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule53 #-} {-# LINE 127 "src-ag/ResolveLocals.ag" #-} rule53 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) nt_ -> {-# LINE 127 "src-ag/ResolveLocals.ag" #-} Map.findWithDefault Map.empty nt_ _lhsImergeMap {-# LINE 587 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule54 #-} rule54 = \ ((_prodsIerrors) :: Seq Error) -> _prodsIerrors {-# INLINE rule55 #-} rule55 = \ ((_prodsIoutput) :: Productions) inh_ nt_ params_ syn_ -> Nonterminal nt_ params_ inh_ syn_ _prodsIoutput {-# INLINE rule56 #-} rule56 = \ _output -> _output {-# INLINE rule57 #-} rule57 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule58 #-} rule58 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule59 #-} rule59 = \ _mergeMap -> _mergeMap {-# INLINE rule60 #-} rule60 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule61 #-} rule61 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap -- Nonterminals ------------------------------------------------ -- wrapper data Inh_Nonterminals = Inh_Nonterminals { allnts_Inh_Nonterminals :: ([Identifier]), inhMap_Inh_Nonterminals :: (Map Identifier Attributes), mergeMap_Inh_Nonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))), options_Inh_Nonterminals :: (Options), synMap_Inh_Nonterminals :: (Map Identifier Attributes) } data Syn_Nonterminals = Syn_Nonterminals { errors_Syn_Nonterminals :: (Seq Error), inhMap'_Syn_Nonterminals :: (Map Identifier Attributes), nonts_Syn_Nonterminals :: ([(NontermIdent,[ConstructorIdent])]), output_Syn_Nonterminals :: (Nonterminals), synMap'_Syn_Nonterminals :: (Map Identifier Attributes) } {-# INLINABLE wrap_Nonterminals #-} wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals ) wrap_Nonterminals (T_Nonterminals act) (Inh_Nonterminals _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg16 = T_Nonterminals_vIn16 _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap (T_Nonterminals_vOut16 _lhsOerrors _lhsOinhMap' _lhsOnonts _lhsOoutput _lhsOsynMap') <- return (inv_Nonterminals_s17 sem arg16) return (Syn_Nonterminals _lhsOerrors _lhsOinhMap' _lhsOnonts _lhsOoutput _lhsOsynMap') ) -- cata {-# NOINLINE sem_Nonterminals #-} sem_Nonterminals :: Nonterminals -> T_Nonterminals sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) -- semantic domain newtype T_Nonterminals = T_Nonterminals { attach_T_Nonterminals :: Identity (T_Nonterminals_s17 ) } newtype T_Nonterminals_s17 = C_Nonterminals_s17 { inv_Nonterminals_s17 :: (T_Nonterminals_v16 ) } data T_Nonterminals_s18 = C_Nonterminals_s18 type T_Nonterminals_v16 = (T_Nonterminals_vIn16 ) -> (T_Nonterminals_vOut16 ) data T_Nonterminals_vIn16 = T_Nonterminals_vIn16 ([Identifier]) (Map Identifier Attributes) (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) (Options) (Map Identifier Attributes) data T_Nonterminals_vOut16 = T_Nonterminals_vOut16 (Seq Error) (Map Identifier Attributes) ([(NontermIdent,[ConstructorIdent])]) (Nonterminals) (Map Identifier Attributes) {-# NOINLINE sem_Nonterminals_Cons #-} sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Nonterminals_v16 v16 = \ (T_Nonterminals_vIn16 _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) (T_Nonterminal_vOut13 _hdIerrors _hdIinhMap' _hdInonts _hdIoutput _hdIsynMap') = inv_Nonterminal_s14 _hdX14 (T_Nonterminal_vIn13 _hdOallnts _hdOinhMap _hdOmergeMap _hdOoptions _hdOsynMap) (T_Nonterminals_vOut16 _tlIerrors _tlIinhMap' _tlInonts _tlIoutput _tlIsynMap') = inv_Nonterminals_s17 _tlX17 (T_Nonterminals_vIn16 _tlOallnts _tlOinhMap _tlOmergeMap _tlOoptions _tlOsynMap) _lhsOerrors :: Seq Error _lhsOerrors = rule62 _hdIerrors _tlIerrors _lhsOinhMap' :: Map Identifier Attributes _lhsOinhMap' = rule63 _hdIinhMap' _tlIinhMap' _lhsOnonts :: [(NontermIdent,[ConstructorIdent])] _lhsOnonts = rule64 _hdInonts _tlInonts _lhsOsynMap' :: Map Identifier Attributes _lhsOsynMap' = rule65 _hdIsynMap' _tlIsynMap' _output = rule66 _hdIoutput _tlIoutput _lhsOoutput :: Nonterminals _lhsOoutput = rule67 _output _hdOallnts = rule68 _lhsIallnts _hdOinhMap = rule69 _lhsIinhMap _hdOmergeMap = rule70 _lhsImergeMap _hdOoptions = rule71 _lhsIoptions _hdOsynMap = rule72 _lhsIsynMap _tlOallnts = rule73 _lhsIallnts _tlOinhMap = rule74 _lhsIinhMap _tlOmergeMap = rule75 _lhsImergeMap _tlOoptions = rule76 _lhsIoptions _tlOsynMap = rule77 _lhsIsynMap __result_ = T_Nonterminals_vOut16 _lhsOerrors _lhsOinhMap' _lhsOnonts _lhsOoutput _lhsOsynMap' in __result_ ) in C_Nonterminals_s17 v16 {-# INLINE rule62 #-} rule62 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule63 #-} rule63 = \ ((_hdIinhMap') :: Map Identifier Attributes) ((_tlIinhMap') :: Map Identifier Attributes) -> _hdIinhMap' `Map.union` _tlIinhMap' {-# INLINE rule64 #-} rule64 = \ ((_hdInonts) :: [(NontermIdent,[ConstructorIdent])]) ((_tlInonts) :: [(NontermIdent,[ConstructorIdent])]) -> _hdInonts ++ _tlInonts {-# INLINE rule65 #-} rule65 = \ ((_hdIsynMap') :: Map Identifier Attributes) ((_tlIsynMap') :: Map Identifier Attributes) -> _hdIsynMap' `Map.union` _tlIsynMap' {-# INLINE rule66 #-} rule66 = \ ((_hdIoutput) :: Nonterminal) ((_tlIoutput) :: Nonterminals) -> (:) _hdIoutput _tlIoutput {-# INLINE rule67 #-} rule67 = \ _output -> _output {-# INLINE rule68 #-} rule68 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule69 #-} rule69 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule70 #-} rule70 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> _lhsImergeMap {-# INLINE rule71 #-} rule71 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule72 #-} rule72 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule73 #-} rule73 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule74 #-} rule74 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule75 #-} rule75 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> _lhsImergeMap {-# INLINE rule76 #-} rule76 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule77 #-} rule77 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE sem_Nonterminals_Nil #-} sem_Nonterminals_Nil :: T_Nonterminals sem_Nonterminals_Nil = T_Nonterminals (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Nonterminals_v16 v16 = \ (T_Nonterminals_vIn16 _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap) -> ( let _lhsOerrors :: Seq Error _lhsOerrors = rule78 () _lhsOinhMap' :: Map Identifier Attributes _lhsOinhMap' = rule79 () _lhsOnonts :: [(NontermIdent,[ConstructorIdent])] _lhsOnonts = rule80 () _lhsOsynMap' :: Map Identifier Attributes _lhsOsynMap' = rule81 () _output = rule82 () _lhsOoutput :: Nonterminals _lhsOoutput = rule83 _output __result_ = T_Nonterminals_vOut16 _lhsOerrors _lhsOinhMap' _lhsOnonts _lhsOoutput _lhsOsynMap' in __result_ ) in C_Nonterminals_s17 v16 {-# INLINE rule78 #-} rule78 = \ (_ :: ()) -> Seq.empty {-# INLINE rule79 #-} rule79 = \ (_ :: ()) -> Map.empty {-# INLINE rule80 #-} rule80 = \ (_ :: ()) -> [] {-# INLINE rule81 #-} rule81 = \ (_ :: ()) -> Map.empty {-# INLINE rule82 #-} rule82 = \ (_ :: ()) -> [] {-# INLINE rule83 #-} rule83 = \ _output -> _output -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { con_Inh_Pattern :: (Identifier), inh_Inh_Pattern :: (Attributes), nt_Inh_Pattern :: (Identifier), syn_Inh_Pattern :: (Attributes) } data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), errors_Syn_Pattern :: (Seq Error), instVars_Syn_Pattern :: ([Identifier]), locVars_Syn_Pattern :: ([Identifier]), output_Syn_Pattern :: (Pattern) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern (T_Pattern act) (Inh_Pattern _lhsIcon _lhsIinh _lhsInt _lhsIsyn) = Control.Monad.Identity.runIdentity ( do sem <- act let arg19 = T_Pattern_vIn19 _lhsIcon _lhsIinh _lhsInt _lhsIsyn (T_Pattern_vOut19 _lhsOcopy _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput) <- return (inv_Pattern_s20 sem arg19) return (Syn_Pattern _lhsOcopy _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s20 ) } newtype T_Pattern_s20 = C_Pattern_s20 { inv_Pattern_s20 :: (T_Pattern_v19 ) } data T_Pattern_s21 = C_Pattern_s21 type T_Pattern_v19 = (T_Pattern_vIn19 ) -> (T_Pattern_vOut19 ) data T_Pattern_vIn19 = T_Pattern_vIn19 (Identifier) (Attributes) (Identifier) (Attributes) data T_Pattern_vOut19 = T_Pattern_vOut19 (Pattern) (Seq Error) ([Identifier]) ([Identifier]) (Pattern) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 _lhsIcon _lhsIinh _lhsInt _lhsIsyn) -> ( let _patsX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut22 _patsIcopy _patsIerrors _patsIinstVars _patsIlocVars _patsIoutput) = inv_Patterns_s23 _patsX23 (T_Patterns_vIn22 _patsOcon _patsOinh _patsOnt _patsOsyn) _lhsOerrors :: Seq Error _lhsOerrors = rule84 _patsIerrors _lhsOinstVars :: [Identifier] _lhsOinstVars = rule85 _patsIinstVars _lhsOlocVars :: [Identifier] _lhsOlocVars = rule86 _patsIlocVars _copy = rule87 _patsIcopy arg_name_ _output = rule88 _patsIoutput arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule89 _copy _lhsOoutput :: Pattern _lhsOoutput = rule90 _output _patsOcon = rule91 _lhsIcon _patsOinh = rule92 _lhsIinh _patsOnt = rule93 _lhsInt _patsOsyn = rule94 _lhsIsyn __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule84 #-} rule84 = \ ((_patsIerrors) :: Seq Error) -> _patsIerrors {-# INLINE rule85 #-} rule85 = \ ((_patsIinstVars) :: [Identifier]) -> _patsIinstVars {-# INLINE rule86 #-} rule86 = \ ((_patsIlocVars) :: [Identifier]) -> _patsIlocVars {-# INLINE rule87 #-} rule87 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule88 #-} rule88 = \ ((_patsIoutput) :: Patterns) name_ -> Constr name_ _patsIoutput {-# INLINE rule89 #-} rule89 = \ _copy -> _copy {-# INLINE rule90 #-} rule90 = \ _output -> _output {-# INLINE rule91 #-} rule91 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule92 #-} rule92 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule93 #-} rule93 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule94 #-} rule94 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 _lhsIcon _lhsIinh _lhsInt _lhsIsyn) -> ( let _patsX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut22 _patsIcopy _patsIerrors _patsIinstVars _patsIlocVars _patsIoutput) = inv_Patterns_s23 _patsX23 (T_Patterns_vIn22 _patsOcon _patsOinh _patsOnt _patsOsyn) _lhsOerrors :: Seq Error _lhsOerrors = rule95 _patsIerrors _lhsOinstVars :: [Identifier] _lhsOinstVars = rule96 _patsIinstVars _lhsOlocVars :: [Identifier] _lhsOlocVars = rule97 _patsIlocVars _copy = rule98 _patsIcopy arg_pos_ _output = rule99 _patsIoutput arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule100 _copy _lhsOoutput :: Pattern _lhsOoutput = rule101 _output _patsOcon = rule102 _lhsIcon _patsOinh = rule103 _lhsIinh _patsOnt = rule104 _lhsInt _patsOsyn = rule105 _lhsIsyn __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule95 #-} rule95 = \ ((_patsIerrors) :: Seq Error) -> _patsIerrors {-# INLINE rule96 #-} rule96 = \ ((_patsIinstVars) :: [Identifier]) -> _patsIinstVars {-# INLINE rule97 #-} rule97 = \ ((_patsIlocVars) :: [Identifier]) -> _patsIlocVars {-# INLINE rule98 #-} rule98 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule99 #-} rule99 = \ ((_patsIoutput) :: Patterns) pos_ -> Product pos_ _patsIoutput {-# INLINE rule100 #-} rule100 = \ _copy -> _copy {-# INLINE rule101 #-} rule101 = \ _output -> _output {-# INLINE rule102 #-} rule102 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule103 #-} rule103 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule104 #-} rule104 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule105 #-} rule105 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 _lhsIcon _lhsIinh _lhsInt _lhsIsyn) -> ( let _patX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut19 _patIcopy _patIerrors _patIinstVars _patIlocVars _patIoutput) = inv_Pattern_s20 _patX20 (T_Pattern_vIn19 _patOcon _patOinh _patOnt _patOsyn) _lhsOlocVars :: [Identifier] _lhsOlocVars = rule106 arg_attr_ arg_field_ _lhsOinstVars :: [Identifier] _lhsOinstVars = rule107 arg_attr_ arg_field_ _lhsOerrors :: Seq Error _lhsOerrors = rule108 _patIerrors _copy = rule109 _patIcopy arg_attr_ arg_field_ _output = rule110 _patIoutput arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule111 _copy _lhsOoutput :: Pattern _lhsOoutput = rule112 _output _patOcon = rule113 _lhsIcon _patOinh = rule114 _lhsIinh _patOnt = rule115 _lhsInt _patOsyn = rule116 _lhsIsyn __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule106 #-} {-# LINE 95 "src-ag/ResolveLocals.ag" #-} rule106 = \ attr_ field_ -> {-# LINE 95 "src-ag/ResolveLocals.ag" #-} if field_ == _LOC then [attr_] else [] {-# LINE 957 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule107 #-} {-# LINE 98 "src-ag/ResolveLocals.ag" #-} rule107 = \ attr_ field_ -> {-# LINE 98 "src-ag/ResolveLocals.ag" #-} if field_ == _INST then [attr_] else [] {-# LINE 965 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule108 #-} rule108 = \ ((_patIerrors) :: Seq Error) -> _patIerrors {-# INLINE rule109 #-} rule109 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule110 #-} rule110 = \ ((_patIoutput) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIoutput {-# INLINE rule111 #-} rule111 = \ _copy -> _copy {-# INLINE rule112 #-} rule112 = \ _output -> _output {-# INLINE rule113 #-} rule113 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule114 #-} rule114 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule115 #-} rule115 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule116 #-} rule116 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 _lhsIcon _lhsIinh _lhsInt _lhsIsyn) -> ( let _patX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut19 _patIcopy _patIerrors _patIinstVars _patIlocVars _patIoutput) = inv_Pattern_s20 _patX20 (T_Pattern_vIn19 _patOcon _patOinh _patOnt _patOsyn) _lhsOerrors :: Seq Error _lhsOerrors = rule117 _patIerrors _lhsOinstVars :: [Identifier] _lhsOinstVars = rule118 _patIinstVars _lhsOlocVars :: [Identifier] _lhsOlocVars = rule119 _patIlocVars _copy = rule120 _patIcopy _output = rule121 _patIoutput _lhsOcopy :: Pattern _lhsOcopy = rule122 _copy _lhsOoutput :: Pattern _lhsOoutput = rule123 _output _patOcon = rule124 _lhsIcon _patOinh = rule125 _lhsIinh _patOnt = rule126 _lhsInt _patOsyn = rule127 _lhsIsyn __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule117 #-} rule117 = \ ((_patIerrors) :: Seq Error) -> _patIerrors {-# INLINE rule118 #-} rule118 = \ ((_patIinstVars) :: [Identifier]) -> _patIinstVars {-# INLINE rule119 #-} rule119 = \ ((_patIlocVars) :: [Identifier]) -> _patIlocVars {-# INLINE rule120 #-} rule120 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule121 #-} rule121 = \ ((_patIoutput) :: Pattern) -> Irrefutable _patIoutput {-# INLINE rule122 #-} rule122 = \ _copy -> _copy {-# INLINE rule123 #-} rule123 = \ _output -> _output {-# INLINE rule124 #-} rule124 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule125 #-} rule125 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule126 #-} rule126 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule127 #-} rule127 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore arg_pos_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 _lhsIcon _lhsIinh _lhsInt _lhsIsyn) -> ( let _lhsOerrors :: Seq Error _lhsOerrors = rule128 () _lhsOinstVars :: [Identifier] _lhsOinstVars = rule129 () _lhsOlocVars :: [Identifier] _lhsOlocVars = rule130 () _copy = rule131 arg_pos_ _output = rule132 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule133 _copy _lhsOoutput :: Pattern _lhsOoutput = rule134 _output __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule128 #-} rule128 = \ (_ :: ()) -> Seq.empty {-# INLINE rule129 #-} rule129 = \ (_ :: ()) -> [] {-# INLINE rule130 #-} rule130 = \ (_ :: ()) -> [] {-# INLINE rule131 #-} rule131 = \ pos_ -> Underscore pos_ {-# INLINE rule132 #-} rule132 = \ pos_ -> Underscore pos_ {-# INLINE rule133 #-} rule133 = \ _copy -> _copy {-# INLINE rule134 #-} rule134 = \ _output -> _output -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { con_Inh_Patterns :: (Identifier), inh_Inh_Patterns :: (Attributes), nt_Inh_Patterns :: (Identifier), syn_Inh_Patterns :: (Attributes) } data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns), errors_Syn_Patterns :: (Seq Error), instVars_Syn_Patterns :: ([Identifier]), locVars_Syn_Patterns :: ([Identifier]), output_Syn_Patterns :: (Patterns) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns (T_Patterns act) (Inh_Patterns _lhsIcon _lhsIinh _lhsInt _lhsIsyn) = Control.Monad.Identity.runIdentity ( do sem <- act let arg22 = T_Patterns_vIn22 _lhsIcon _lhsIinh _lhsInt _lhsIsyn (T_Patterns_vOut22 _lhsOcopy _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput) <- return (inv_Patterns_s23 sem arg22) return (Syn_Patterns _lhsOcopy _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s23 ) } newtype T_Patterns_s23 = C_Patterns_s23 { inv_Patterns_s23 :: (T_Patterns_v22 ) } data T_Patterns_s24 = C_Patterns_s24 type T_Patterns_v22 = (T_Patterns_vIn22 ) -> (T_Patterns_vOut22 ) data T_Patterns_vIn22 = T_Patterns_vIn22 (Identifier) (Attributes) (Identifier) (Attributes) data T_Patterns_vOut22 = T_Patterns_vOut22 (Patterns) (Seq Error) ([Identifier]) ([Identifier]) (Patterns) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_Patterns_v22 v22 = \ (T_Patterns_vIn22 _lhsIcon _lhsIinh _lhsInt _lhsIsyn) -> ( let _hdX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut19 _hdIcopy _hdIerrors _hdIinstVars _hdIlocVars _hdIoutput) = inv_Pattern_s20 _hdX20 (T_Pattern_vIn19 _hdOcon _hdOinh _hdOnt _hdOsyn) (T_Patterns_vOut22 _tlIcopy _tlIerrors _tlIinstVars _tlIlocVars _tlIoutput) = inv_Patterns_s23 _tlX23 (T_Patterns_vIn22 _tlOcon _tlOinh _tlOnt _tlOsyn) _lhsOerrors :: Seq Error _lhsOerrors = rule135 _hdIerrors _tlIerrors _lhsOinstVars :: [Identifier] _lhsOinstVars = rule136 _hdIinstVars _tlIinstVars _lhsOlocVars :: [Identifier] _lhsOlocVars = rule137 _hdIlocVars _tlIlocVars _copy = rule138 _hdIcopy _tlIcopy _output = rule139 _hdIoutput _tlIoutput _lhsOcopy :: Patterns _lhsOcopy = rule140 _copy _lhsOoutput :: Patterns _lhsOoutput = rule141 _output _hdOcon = rule142 _lhsIcon _hdOinh = rule143 _lhsIinh _hdOnt = rule144 _lhsInt _hdOsyn = rule145 _lhsIsyn _tlOcon = rule146 _lhsIcon _tlOinh = rule147 _lhsIinh _tlOnt = rule148 _lhsInt _tlOsyn = rule149 _lhsIsyn __result_ = T_Patterns_vOut22 _lhsOcopy _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput in __result_ ) in C_Patterns_s23 v22 {-# INLINE rule135 #-} rule135 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule136 #-} rule136 = \ ((_hdIinstVars) :: [Identifier]) ((_tlIinstVars) :: [Identifier]) -> _hdIinstVars ++ _tlIinstVars {-# INLINE rule137 #-} rule137 = \ ((_hdIlocVars) :: [Identifier]) ((_tlIlocVars) :: [Identifier]) -> _hdIlocVars ++ _tlIlocVars {-# INLINE rule138 #-} rule138 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule139 #-} rule139 = \ ((_hdIoutput) :: Pattern) ((_tlIoutput) :: Patterns) -> (:) _hdIoutput _tlIoutput {-# INLINE rule140 #-} rule140 = \ _copy -> _copy {-# INLINE rule141 #-} rule141 = \ _output -> _output {-# INLINE rule142 #-} rule142 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule143 #-} rule143 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule144 #-} rule144 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule145 #-} rule145 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule146 #-} rule146 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule147 #-} rule147 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule148 #-} rule148 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule149 #-} rule149 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_Patterns_v22 v22 = \ (T_Patterns_vIn22 _lhsIcon _lhsIinh _lhsInt _lhsIsyn) -> ( let _lhsOerrors :: Seq Error _lhsOerrors = rule150 () _lhsOinstVars :: [Identifier] _lhsOinstVars = rule151 () _lhsOlocVars :: [Identifier] _lhsOlocVars = rule152 () _copy = rule153 () _output = rule154 () _lhsOcopy :: Patterns _lhsOcopy = rule155 _copy _lhsOoutput :: Patterns _lhsOoutput = rule156 _output __result_ = T_Patterns_vOut22 _lhsOcopy _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput in __result_ ) in C_Patterns_s23 v22 {-# INLINE rule150 #-} rule150 = \ (_ :: ()) -> Seq.empty {-# INLINE rule151 #-} rule151 = \ (_ :: ()) -> [] {-# INLINE rule152 #-} rule152 = \ (_ :: ()) -> [] {-# INLINE rule153 #-} rule153 = \ (_ :: ()) -> [] {-# INLINE rule154 #-} rule154 = \ (_ :: ()) -> [] {-# INLINE rule155 #-} rule155 = \ _copy -> _copy {-# INLINE rule156 #-} rule156 = \ _output -> _output -- Production -------------------------------------------------- -- wrapper data Inh_Production = Inh_Production { allnts_Inh_Production :: ([Identifier]), inh_Inh_Production :: (Attributes), inhMap_Inh_Production :: (Map Identifier Attributes), mergeMap_Inh_Production :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))), nt_Inh_Production :: (Identifier), options_Inh_Production :: (Options), syn_Inh_Production :: (Attributes), synMap_Inh_Production :: (Map Identifier Attributes) } data Syn_Production = Syn_Production { cons_Syn_Production :: ([ConstructorIdent]), errors_Syn_Production :: (Seq Error), output_Syn_Production :: (Production) } {-# INLINABLE wrap_Production #-} wrap_Production :: T_Production -> Inh_Production -> (Syn_Production ) wrap_Production (T_Production act) (Inh_Production _lhsIallnts _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg25 = T_Production_vIn25 _lhsIallnts _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn _lhsIsynMap (T_Production_vOut25 _lhsOcons _lhsOerrors _lhsOoutput) <- return (inv_Production_s26 sem arg25) return (Syn_Production _lhsOcons _lhsOerrors _lhsOoutput) ) -- cata {-# INLINE sem_Production #-} sem_Production :: Production -> T_Production sem_Production ( Production con_ params_ constraints_ children_ rules_ typeSigs_ macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_ -- semantic domain newtype T_Production = T_Production { attach_T_Production :: Identity (T_Production_s26 ) } newtype T_Production_s26 = C_Production_s26 { inv_Production_s26 :: (T_Production_v25 ) } data T_Production_s27 = C_Production_s27 type T_Production_v25 = (T_Production_vIn25 ) -> (T_Production_vOut25 ) data T_Production_vIn25 = T_Production_vIn25 ([Identifier]) (Attributes) (Map Identifier Attributes) (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) (Identifier) (Options) (Attributes) (Map Identifier Attributes) data T_Production_vOut25 = T_Production_vOut25 ([ConstructorIdent]) (Seq Error) (Production) {-# NOINLINE sem_Production_Production #-} sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production sem_Production_Production arg_con_ arg_params_ arg_constraints_ arg_children_ arg_rules_ arg_typeSigs_ arg_macro_ = T_Production (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_Production_v25 v25 = \ (T_Production_vIn25 _lhsIallnts _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn _lhsIsynMap) -> ( let _childrenX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) _rulesX35 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) _typeSigsX41 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) (T_Children_vOut4 _childrenIattributes _childrenIfields _childrenIoutput) = inv_Children_s5 _childrenX5 (T_Children_vIn4 _childrenOallfields _childrenOallnts _childrenOattrs _childrenOcon _childrenOinh _childrenOinhMap _childrenOmergeMap _childrenOnt _childrenOsyn _childrenOsynMap) (T_Rules_vOut34 _rulesIerrors _rulesIinstVars _rulesIlocVars _rulesIoutput) = inv_Rules_s35 _rulesX35 (T_Rules_vIn34 _rulesOallfields _rulesOallnts _rulesOattrs _rulesOcon _rulesOinh _rulesOmergeMap _rulesOnt _rulesOoptions _rulesOsyn) (T_TypeSigs_vOut40 _typeSigsIoutput) = inv_TypeSigs_s41 _typeSigsX41 (T_TypeSigs_vIn40 ) _lhsOcons :: [ConstructorIdent] _lhsOcons = rule157 arg_con_ _allfields = rule158 _childrenIfields _attrs = rule159 _childrenIattributes _inhnames _rulesIinstVars _rulesIlocVars _inhnames = rule160 _lhsIinh _synnames = rule161 _lhsIsyn _childrenOcon = rule162 arg_con_ _rulesOcon = rule163 arg_con_ _mergeMap = rule164 _lhsImergeMap arg_con_ _lhsOerrors :: Seq Error _lhsOerrors = rule165 _rulesIerrors _output = rule166 _childrenIoutput _rulesIoutput _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ _lhsOoutput :: Production _lhsOoutput = rule167 _output _childrenOallfields = rule168 _allfields _childrenOallnts = rule169 _lhsIallnts _childrenOattrs = rule170 _attrs _childrenOinh = rule171 _lhsIinh _childrenOinhMap = rule172 _lhsIinhMap _childrenOmergeMap = rule173 _mergeMap _childrenOnt = rule174 _lhsInt _childrenOsyn = rule175 _lhsIsyn _childrenOsynMap = rule176 _lhsIsynMap _rulesOallfields = rule177 _allfields _rulesOallnts = rule178 _lhsIallnts _rulesOattrs = rule179 _attrs _rulesOinh = rule180 _lhsIinh _rulesOmergeMap = rule181 _mergeMap _rulesOnt = rule182 _lhsInt _rulesOoptions = rule183 _lhsIoptions _rulesOsyn = rule184 _lhsIsyn __result_ = T_Production_vOut25 _lhsOcons _lhsOerrors _lhsOoutput in __result_ ) in C_Production_s26 v25 {-# INLINE rule157 #-} {-# LINE 66 "src-ag/ResolveLocals.ag" #-} rule157 = \ con_ -> {-# LINE 66 "src-ag/ResolveLocals.ag" #-} [con_] {-# LINE 1333 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule158 #-} {-# LINE 73 "src-ag/ResolveLocals.ag" #-} rule158 = \ ((_childrenIfields) :: [(Identifier,Type,ChildKind)]) -> {-# LINE 73 "src-ag/ResolveLocals.ag" #-} _childrenIfields {-# LINE 1339 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule159 #-} {-# LINE 74 "src-ag/ResolveLocals.ag" #-} rule159 = \ ((_childrenIattributes) :: [(Identifier,Attributes,Attributes)]) _inhnames ((_rulesIinstVars) :: [Identifier]) ((_rulesIlocVars) :: [Identifier]) -> {-# LINE 74 "src-ag/ResolveLocals.ag" #-} map ((,) _LOC) _rulesIlocVars ++ map ((,) _INST) _rulesIinstVars ++ map ((,) _LHS) _inhnames ++ concat [map ((,) nm) (Map.keys as) | (nm,_,as) <- _childrenIattributes] {-# LINE 1348 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule160 #-} {-# LINE 78 "src-ag/ResolveLocals.ag" #-} rule160 = \ ((_lhsIinh) :: Attributes) -> {-# LINE 78 "src-ag/ResolveLocals.ag" #-} Map.keys _lhsIinh {-# LINE 1354 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule161 #-} {-# LINE 79 "src-ag/ResolveLocals.ag" #-} rule161 = \ ((_lhsIsyn) :: Attributes) -> {-# LINE 79 "src-ag/ResolveLocals.ag" #-} Map.keys _lhsIsyn {-# LINE 1360 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule162 #-} {-# LINE 107 "src-ag/ResolveLocals.ag" #-} rule162 = \ con_ -> {-# LINE 107 "src-ag/ResolveLocals.ag" #-} con_ {-# LINE 1366 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule163 #-} {-# LINE 109 "src-ag/ResolveLocals.ag" #-} rule163 = \ con_ -> {-# LINE 109 "src-ag/ResolveLocals.ag" #-} con_ {-# LINE 1372 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule164 #-} {-# LINE 128 "src-ag/ResolveLocals.ag" #-} rule164 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) con_ -> {-# LINE 128 "src-ag/ResolveLocals.ag" #-} Map.findWithDefault Map.empty con_ _lhsImergeMap {-# LINE 1378 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule165 #-} rule165 = \ ((_rulesIerrors) :: Seq Error) -> _rulesIerrors {-# INLINE rule166 #-} rule166 = \ ((_childrenIoutput) :: Children) ((_rulesIoutput) :: Rules) ((_typeSigsIoutput) :: TypeSigs) con_ constraints_ macro_ params_ -> Production con_ params_ constraints_ _childrenIoutput _rulesIoutput _typeSigsIoutput macro_ {-# INLINE rule167 #-} rule167 = \ _output -> _output {-# INLINE rule168 #-} rule168 = \ _allfields -> _allfields {-# INLINE rule169 #-} rule169 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule170 #-} rule170 = \ _attrs -> _attrs {-# INLINE rule171 #-} rule171 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule172 #-} rule172 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule173 #-} rule173 = \ _mergeMap -> _mergeMap {-# INLINE rule174 #-} rule174 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule175 #-} rule175 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule176 #-} rule176 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule177 #-} rule177 = \ _allfields -> _allfields {-# INLINE rule178 #-} rule178 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule179 #-} rule179 = \ _attrs -> _attrs {-# INLINE rule180 #-} rule180 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule181 #-} rule181 = \ _mergeMap -> _mergeMap {-# INLINE rule182 #-} rule182 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule183 #-} rule183 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule184 #-} rule184 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn -- Productions ------------------------------------------------- -- wrapper data Inh_Productions = Inh_Productions { allnts_Inh_Productions :: ([Identifier]), inh_Inh_Productions :: (Attributes), inhMap_Inh_Productions :: (Map Identifier Attributes), mergeMap_Inh_Productions :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))), nt_Inh_Productions :: (Identifier), options_Inh_Productions :: (Options), syn_Inh_Productions :: (Attributes), synMap_Inh_Productions :: (Map Identifier Attributes) } data Syn_Productions = Syn_Productions { cons_Syn_Productions :: ([ConstructorIdent]), errors_Syn_Productions :: (Seq Error), output_Syn_Productions :: (Productions) } {-# INLINABLE wrap_Productions #-} wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions ) wrap_Productions (T_Productions act) (Inh_Productions _lhsIallnts _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg28 = T_Productions_vIn28 _lhsIallnts _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn _lhsIsynMap (T_Productions_vOut28 _lhsOcons _lhsOerrors _lhsOoutput) <- return (inv_Productions_s29 sem arg28) return (Syn_Productions _lhsOcons _lhsOerrors _lhsOoutput) ) -- cata {-# NOINLINE sem_Productions #-} sem_Productions :: Productions -> T_Productions sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) -- semantic domain newtype T_Productions = T_Productions { attach_T_Productions :: Identity (T_Productions_s29 ) } newtype T_Productions_s29 = C_Productions_s29 { inv_Productions_s29 :: (T_Productions_v28 ) } data T_Productions_s30 = C_Productions_s30 type T_Productions_v28 = (T_Productions_vIn28 ) -> (T_Productions_vOut28 ) data T_Productions_vIn28 = T_Productions_vIn28 ([Identifier]) (Attributes) (Map Identifier Attributes) (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) (Identifier) (Options) (Attributes) (Map Identifier Attributes) data T_Productions_vOut28 = T_Productions_vOut28 ([ConstructorIdent]) (Seq Error) (Productions) {-# NOINLINE sem_Productions_Cons #-} sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Productions_v28 v28 = \ (T_Productions_vIn28 _lhsIallnts _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn _lhsIsynMap) -> ( let _hdX26 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) _tlX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) (T_Production_vOut25 _hdIcons _hdIerrors _hdIoutput) = inv_Production_s26 _hdX26 (T_Production_vIn25 _hdOallnts _hdOinh _hdOinhMap _hdOmergeMap _hdOnt _hdOoptions _hdOsyn _hdOsynMap) (T_Productions_vOut28 _tlIcons _tlIerrors _tlIoutput) = inv_Productions_s29 _tlX29 (T_Productions_vIn28 _tlOallnts _tlOinh _tlOinhMap _tlOmergeMap _tlOnt _tlOoptions _tlOsyn _tlOsynMap) _lhsOcons :: [ConstructorIdent] _lhsOcons = rule185 _hdIcons _tlIcons _lhsOerrors :: Seq Error _lhsOerrors = rule186 _hdIerrors _tlIerrors _output = rule187 _hdIoutput _tlIoutput _lhsOoutput :: Productions _lhsOoutput = rule188 _output _hdOallnts = rule189 _lhsIallnts _hdOinh = rule190 _lhsIinh _hdOinhMap = rule191 _lhsIinhMap _hdOmergeMap = rule192 _lhsImergeMap _hdOnt = rule193 _lhsInt _hdOoptions = rule194 _lhsIoptions _hdOsyn = rule195 _lhsIsyn _hdOsynMap = rule196 _lhsIsynMap _tlOallnts = rule197 _lhsIallnts _tlOinh = rule198 _lhsIinh _tlOinhMap = rule199 _lhsIinhMap _tlOmergeMap = rule200 _lhsImergeMap _tlOnt = rule201 _lhsInt _tlOoptions = rule202 _lhsIoptions _tlOsyn = rule203 _lhsIsyn _tlOsynMap = rule204 _lhsIsynMap __result_ = T_Productions_vOut28 _lhsOcons _lhsOerrors _lhsOoutput in __result_ ) in C_Productions_s29 v28 {-# INLINE rule185 #-} rule185 = \ ((_hdIcons) :: [ConstructorIdent]) ((_tlIcons) :: [ConstructorIdent]) -> _hdIcons ++ _tlIcons {-# INLINE rule186 #-} rule186 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule187 #-} rule187 = \ ((_hdIoutput) :: Production) ((_tlIoutput) :: Productions) -> (:) _hdIoutput _tlIoutput {-# INLINE rule188 #-} rule188 = \ _output -> _output {-# INLINE rule189 #-} rule189 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule190 #-} rule190 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule191 #-} rule191 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule192 #-} rule192 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) -> _lhsImergeMap {-# INLINE rule193 #-} rule193 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule194 #-} rule194 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule195 #-} rule195 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule196 #-} rule196 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule197 #-} rule197 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule198 #-} rule198 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule199 #-} rule199 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule200 #-} rule200 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) -> _lhsImergeMap {-# INLINE rule201 #-} rule201 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule202 #-} rule202 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule203 #-} rule203 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule204 #-} rule204 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE sem_Productions_Nil #-} sem_Productions_Nil :: T_Productions sem_Productions_Nil = T_Productions (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Productions_v28 v28 = \ (T_Productions_vIn28 _lhsIallnts _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn _lhsIsynMap) -> ( let _lhsOcons :: [ConstructorIdent] _lhsOcons = rule205 () _lhsOerrors :: Seq Error _lhsOerrors = rule206 () _output = rule207 () _lhsOoutput :: Productions _lhsOoutput = rule208 _output __result_ = T_Productions_vOut28 _lhsOcons _lhsOerrors _lhsOoutput in __result_ ) in C_Productions_s29 v28 {-# INLINE rule205 #-} rule205 = \ (_ :: ()) -> [] {-# INLINE rule206 #-} rule206 = \ (_ :: ()) -> Seq.empty {-# INLINE rule207 #-} rule207 = \ (_ :: ()) -> [] {-# INLINE rule208 #-} rule208 = \ _output -> _output -- Rule -------------------------------------------------------- -- wrapper data Inh_Rule = Inh_Rule { allfields_Inh_Rule :: ([(Identifier,Type,ChildKind)]), allnts_Inh_Rule :: ([Identifier]), attrs_Inh_Rule :: ([(Identifier,Identifier)]), con_Inh_Rule :: (Identifier), inh_Inh_Rule :: (Attributes), mergeMap_Inh_Rule :: (Map Identifier (Identifier,[Identifier])), nt_Inh_Rule :: (Identifier), options_Inh_Rule :: (Options), syn_Inh_Rule :: (Attributes) } data Syn_Rule = Syn_Rule { errors_Syn_Rule :: (Seq Error), instVars_Syn_Rule :: ([Identifier]), locVars_Syn_Rule :: ([Identifier]), output_Syn_Rule :: (Rule) } {-# INLINABLE wrap_Rule #-} wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule ) wrap_Rule (T_Rule act) (Inh_Rule _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn) = Control.Monad.Identity.runIdentity ( do sem <- act let arg31 = T_Rule_vIn31 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn (T_Rule_vOut31 _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput) <- return (inv_Rule_s32 sem arg31) return (Syn_Rule _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput) ) -- cata {-# INLINE sem_Rule #-} sem_Rule :: Rule -> T_Rule sem_Rule ( Rule mbName_ pattern_ rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ -- semantic domain newtype T_Rule = T_Rule { attach_T_Rule :: Identity (T_Rule_s32 ) } newtype T_Rule_s32 = C_Rule_s32 { inv_Rule_s32 :: (T_Rule_v31 ) } data T_Rule_s33 = C_Rule_s33 type T_Rule_v31 = (T_Rule_vIn31 ) -> (T_Rule_vOut31 ) data T_Rule_vIn31 = T_Rule_vIn31 ([(Identifier,Type,ChildKind)]) ([Identifier]) ([(Identifier,Identifier)]) (Identifier) (Attributes) (Map Identifier (Identifier,[Identifier])) (Identifier) (Options) (Attributes) data T_Rule_vOut31 = T_Rule_vOut31 (Seq Error) ([Identifier]) ([Identifier]) (Rule) {-# NOINLINE sem_Rule_Rule #-} sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule sem_Rule_Rule arg_mbName_ arg_pattern_ arg_rhs_ arg_owrt_ arg_origin_ arg_explicit_ arg_pure_ arg_identity_ arg_mbError_ arg_eager_ = T_Rule (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_Rule_v31 v31 = \ (T_Rule_vIn31 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn) -> ( let _patternX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) _rhsX8 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) (T_Pattern_vOut19 _patternIcopy _patternIerrors _patternIinstVars _patternIlocVars _patternIoutput) = inv_Pattern_s20 _patternX20 (T_Pattern_vIn19 _patternOcon _patternOinh _patternOnt _patternOsyn) (T_Expression_vOut7 _rhsIerrors _rhsIoutput) = inv_Expression_s8 _rhsX8 (T_Expression_vIn7 _rhsOallfields _rhsOallnts _rhsOattrs _rhsOcon _rhsOmergeMap _rhsOnt _rhsOoptions) _lhsOerrors :: Seq Error _lhsOerrors = rule209 _patternIerrors _rhsIerrors _lhsOinstVars :: [Identifier] _lhsOinstVars = rule210 _patternIinstVars _lhsOlocVars :: [Identifier] _lhsOlocVars = rule211 _patternIlocVars _output = rule212 _patternIoutput _rhsIoutput arg_eager_ arg_explicit_ arg_identity_ arg_mbError_ arg_mbName_ arg_origin_ arg_owrt_ arg_pure_ _lhsOoutput :: Rule _lhsOoutput = rule213 _output _patternOcon = rule214 _lhsIcon _patternOinh = rule215 _lhsIinh _patternOnt = rule216 _lhsInt _patternOsyn = rule217 _lhsIsyn _rhsOallfields = rule218 _lhsIallfields _rhsOallnts = rule219 _lhsIallnts _rhsOattrs = rule220 _lhsIattrs _rhsOcon = rule221 _lhsIcon _rhsOmergeMap = rule222 _lhsImergeMap _rhsOnt = rule223 _lhsInt _rhsOoptions = rule224 _lhsIoptions __result_ = T_Rule_vOut31 _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput in __result_ ) in C_Rule_s32 v31 {-# INLINE rule209 #-} rule209 = \ ((_patternIerrors) :: Seq Error) ((_rhsIerrors) :: Seq Error) -> _patternIerrors Seq.>< _rhsIerrors {-# INLINE rule210 #-} rule210 = \ ((_patternIinstVars) :: [Identifier]) -> _patternIinstVars {-# INLINE rule211 #-} rule211 = \ ((_patternIlocVars) :: [Identifier]) -> _patternIlocVars {-# INLINE rule212 #-} rule212 = \ ((_patternIoutput) :: Pattern) ((_rhsIoutput) :: Expression) eager_ explicit_ identity_ mbError_ mbName_ origin_ owrt_ pure_ -> Rule mbName_ _patternIoutput _rhsIoutput owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ {-# INLINE rule213 #-} rule213 = \ _output -> _output {-# INLINE rule214 #-} rule214 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule215 #-} rule215 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule216 #-} rule216 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule217 #-} rule217 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule218 #-} rule218 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) -> _lhsIallfields {-# INLINE rule219 #-} rule219 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule220 #-} rule220 = \ ((_lhsIattrs) :: [(Identifier,Identifier)]) -> _lhsIattrs {-# INLINE rule221 #-} rule221 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule222 #-} rule222 = \ ((_lhsImergeMap) :: Map Identifier (Identifier,[Identifier])) -> _lhsImergeMap {-# INLINE rule223 #-} rule223 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule224 #-} rule224 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- Rules ------------------------------------------------------- -- wrapper data Inh_Rules = Inh_Rules { allfields_Inh_Rules :: ([(Identifier,Type,ChildKind)]), allnts_Inh_Rules :: ([Identifier]), attrs_Inh_Rules :: ([(Identifier,Identifier)]), con_Inh_Rules :: (Identifier), inh_Inh_Rules :: (Attributes), mergeMap_Inh_Rules :: (Map Identifier (Identifier,[Identifier])), nt_Inh_Rules :: (Identifier), options_Inh_Rules :: (Options), syn_Inh_Rules :: (Attributes) } data Syn_Rules = Syn_Rules { errors_Syn_Rules :: (Seq Error), instVars_Syn_Rules :: ([Identifier]), locVars_Syn_Rules :: ([Identifier]), output_Syn_Rules :: (Rules) } {-# INLINABLE wrap_Rules #-} wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules ) wrap_Rules (T_Rules act) (Inh_Rules _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn) = Control.Monad.Identity.runIdentity ( do sem <- act let arg34 = T_Rules_vIn34 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn (T_Rules_vOut34 _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput) <- return (inv_Rules_s35 sem arg34) return (Syn_Rules _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput) ) -- cata {-# NOINLINE sem_Rules #-} sem_Rules :: Rules -> T_Rules sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) -- semantic domain newtype T_Rules = T_Rules { attach_T_Rules :: Identity (T_Rules_s35 ) } newtype T_Rules_s35 = C_Rules_s35 { inv_Rules_s35 :: (T_Rules_v34 ) } data T_Rules_s36 = C_Rules_s36 type T_Rules_v34 = (T_Rules_vIn34 ) -> (T_Rules_vOut34 ) data T_Rules_vIn34 = T_Rules_vIn34 ([(Identifier,Type,ChildKind)]) ([Identifier]) ([(Identifier,Identifier)]) (Identifier) (Attributes) (Map Identifier (Identifier,[Identifier])) (Identifier) (Options) (Attributes) data T_Rules_vOut34 = T_Rules_vOut34 (Seq Error) ([Identifier]) ([Identifier]) (Rules) {-# NOINLINE sem_Rules_Cons #-} sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Rules_v34 v34 = \ (T_Rules_vIn34 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn) -> ( let _hdX32 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) _tlX35 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) (T_Rule_vOut31 _hdIerrors _hdIinstVars _hdIlocVars _hdIoutput) = inv_Rule_s32 _hdX32 (T_Rule_vIn31 _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOinh _hdOmergeMap _hdOnt _hdOoptions _hdOsyn) (T_Rules_vOut34 _tlIerrors _tlIinstVars _tlIlocVars _tlIoutput) = inv_Rules_s35 _tlX35 (T_Rules_vIn34 _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOinh _tlOmergeMap _tlOnt _tlOoptions _tlOsyn) _lhsOerrors :: Seq Error _lhsOerrors = rule225 _hdIerrors _tlIerrors _lhsOinstVars :: [Identifier] _lhsOinstVars = rule226 _hdIinstVars _tlIinstVars _lhsOlocVars :: [Identifier] _lhsOlocVars = rule227 _hdIlocVars _tlIlocVars _output = rule228 _hdIoutput _tlIoutput _lhsOoutput :: Rules _lhsOoutput = rule229 _output _hdOallfields = rule230 _lhsIallfields _hdOallnts = rule231 _lhsIallnts _hdOattrs = rule232 _lhsIattrs _hdOcon = rule233 _lhsIcon _hdOinh = rule234 _lhsIinh _hdOmergeMap = rule235 _lhsImergeMap _hdOnt = rule236 _lhsInt _hdOoptions = rule237 _lhsIoptions _hdOsyn = rule238 _lhsIsyn _tlOallfields = rule239 _lhsIallfields _tlOallnts = rule240 _lhsIallnts _tlOattrs = rule241 _lhsIattrs _tlOcon = rule242 _lhsIcon _tlOinh = rule243 _lhsIinh _tlOmergeMap = rule244 _lhsImergeMap _tlOnt = rule245 _lhsInt _tlOoptions = rule246 _lhsIoptions _tlOsyn = rule247 _lhsIsyn __result_ = T_Rules_vOut34 _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput in __result_ ) in C_Rules_s35 v34 {-# INLINE rule225 #-} rule225 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule226 #-} rule226 = \ ((_hdIinstVars) :: [Identifier]) ((_tlIinstVars) :: [Identifier]) -> _hdIinstVars ++ _tlIinstVars {-# INLINE rule227 #-} rule227 = \ ((_hdIlocVars) :: [Identifier]) ((_tlIlocVars) :: [Identifier]) -> _hdIlocVars ++ _tlIlocVars {-# INLINE rule228 #-} rule228 = \ ((_hdIoutput) :: Rule) ((_tlIoutput) :: Rules) -> (:) _hdIoutput _tlIoutput {-# INLINE rule229 #-} rule229 = \ _output -> _output {-# INLINE rule230 #-} rule230 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) -> _lhsIallfields {-# INLINE rule231 #-} rule231 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule232 #-} rule232 = \ ((_lhsIattrs) :: [(Identifier,Identifier)]) -> _lhsIattrs {-# INLINE rule233 #-} rule233 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule234 #-} rule234 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule235 #-} rule235 = \ ((_lhsImergeMap) :: Map Identifier (Identifier,[Identifier])) -> _lhsImergeMap {-# INLINE rule236 #-} rule236 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule237 #-} rule237 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule238 #-} rule238 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule239 #-} rule239 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) -> _lhsIallfields {-# INLINE rule240 #-} rule240 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule241 #-} rule241 = \ ((_lhsIattrs) :: [(Identifier,Identifier)]) -> _lhsIattrs {-# INLINE rule242 #-} rule242 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule243 #-} rule243 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule244 #-} rule244 = \ ((_lhsImergeMap) :: Map Identifier (Identifier,[Identifier])) -> _lhsImergeMap {-# INLINE rule245 #-} rule245 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule246 #-} rule246 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule247 #-} rule247 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# NOINLINE sem_Rules_Nil #-} sem_Rules_Nil :: T_Rules sem_Rules_Nil = T_Rules (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Rules_v34 v34 = \ (T_Rules_vIn34 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn) -> ( let _lhsOerrors :: Seq Error _lhsOerrors = rule248 () _lhsOinstVars :: [Identifier] _lhsOinstVars = rule249 () _lhsOlocVars :: [Identifier] _lhsOlocVars = rule250 () _output = rule251 () _lhsOoutput :: Rules _lhsOoutput = rule252 _output __result_ = T_Rules_vOut34 _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput in __result_ ) in C_Rules_s35 v34 {-# INLINE rule248 #-} rule248 = \ (_ :: ()) -> Seq.empty {-# INLINE rule249 #-} rule249 = \ (_ :: ()) -> [] {-# INLINE rule250 #-} rule250 = \ (_ :: ()) -> [] {-# INLINE rule251 #-} rule251 = \ (_ :: ()) -> [] {-# INLINE rule252 #-} rule252 = \ _output -> _output -- TypeSig ----------------------------------------------------- -- wrapper data Inh_TypeSig = Inh_TypeSig { } data Syn_TypeSig = Syn_TypeSig { output_Syn_TypeSig :: (TypeSig) } {-# INLINABLE wrap_TypeSig #-} wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig ) wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg37 = T_TypeSig_vIn37 (T_TypeSig_vOut37 _lhsOoutput) <- return (inv_TypeSig_s38 sem arg37) return (Syn_TypeSig _lhsOoutput) ) -- cata {-# INLINE sem_TypeSig #-} sem_TypeSig :: TypeSig -> T_TypeSig sem_TypeSig ( TypeSig name_ tp_ ) = sem_TypeSig_TypeSig name_ tp_ -- semantic domain newtype T_TypeSig = T_TypeSig { attach_T_TypeSig :: Identity (T_TypeSig_s38 ) } newtype T_TypeSig_s38 = C_TypeSig_s38 { inv_TypeSig_s38 :: (T_TypeSig_v37 ) } data T_TypeSig_s39 = C_TypeSig_s39 type T_TypeSig_v37 = (T_TypeSig_vIn37 ) -> (T_TypeSig_vOut37 ) data T_TypeSig_vIn37 = T_TypeSig_vIn37 data T_TypeSig_vOut37 = T_TypeSig_vOut37 (TypeSig) {-# NOINLINE sem_TypeSig_TypeSig #-} sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig sem_TypeSig_TypeSig arg_name_ arg_tp_ = T_TypeSig (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_TypeSig_v37 v37 = \ (T_TypeSig_vIn37 ) -> ( let _output = rule253 arg_name_ arg_tp_ _lhsOoutput :: TypeSig _lhsOoutput = rule254 _output __result_ = T_TypeSig_vOut37 _lhsOoutput in __result_ ) in C_TypeSig_s38 v37 {-# INLINE rule253 #-} rule253 = \ name_ tp_ -> TypeSig name_ tp_ {-# INLINE rule254 #-} rule254 = \ _output -> _output -- TypeSigs ---------------------------------------------------- -- wrapper data Inh_TypeSigs = Inh_TypeSigs { } data Syn_TypeSigs = Syn_TypeSigs { output_Syn_TypeSigs :: (TypeSigs) } {-# INLINABLE wrap_TypeSigs #-} wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs ) wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg40 = T_TypeSigs_vIn40 (T_TypeSigs_vOut40 _lhsOoutput) <- return (inv_TypeSigs_s41 sem arg40) return (Syn_TypeSigs _lhsOoutput) ) -- cata {-# NOINLINE sem_TypeSigs #-} sem_TypeSigs :: TypeSigs -> T_TypeSigs sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) -- semantic domain newtype T_TypeSigs = T_TypeSigs { attach_T_TypeSigs :: Identity (T_TypeSigs_s41 ) } newtype T_TypeSigs_s41 = C_TypeSigs_s41 { inv_TypeSigs_s41 :: (T_TypeSigs_v40 ) } data T_TypeSigs_s42 = C_TypeSigs_s42 type T_TypeSigs_v40 = (T_TypeSigs_vIn40 ) -> (T_TypeSigs_vOut40 ) data T_TypeSigs_vIn40 = T_TypeSigs_vIn40 data T_TypeSigs_vOut40 = T_TypeSigs_vOut40 (TypeSigs) {-# NOINLINE sem_TypeSigs_Cons #-} sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_TypeSigs_v40 v40 = \ (T_TypeSigs_vIn40 ) -> ( let _hdX38 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_)) _tlX41 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_)) (T_TypeSig_vOut37 _hdIoutput) = inv_TypeSig_s38 _hdX38 (T_TypeSig_vIn37 ) (T_TypeSigs_vOut40 _tlIoutput) = inv_TypeSigs_s41 _tlX41 (T_TypeSigs_vIn40 ) _output = rule255 _hdIoutput _tlIoutput _lhsOoutput :: TypeSigs _lhsOoutput = rule256 _output __result_ = T_TypeSigs_vOut40 _lhsOoutput in __result_ ) in C_TypeSigs_s41 v40 {-# INLINE rule255 #-} rule255 = \ ((_hdIoutput) :: TypeSig) ((_tlIoutput) :: TypeSigs) -> (:) _hdIoutput _tlIoutput {-# INLINE rule256 #-} rule256 = \ _output -> _output {-# NOINLINE sem_TypeSigs_Nil #-} sem_TypeSigs_Nil :: T_TypeSigs sem_TypeSigs_Nil = T_TypeSigs (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_TypeSigs_v40 v40 = \ (T_TypeSigs_vIn40 ) -> ( let _output = rule257 () _lhsOoutput :: TypeSigs _lhsOoutput = rule258 _output __result_ = T_TypeSigs_vOut40 _lhsOoutput in __result_ ) in C_TypeSigs_s41 v40 {-# INLINE rule257 #-} rule257 = \ (_ :: ()) -> [] {-# INLINE rule258 #-} rule258 = \ _output -> _output uuagc-0.9.52.2/src-generated/AG2AspectAG.hs0000644000000000000000000047140413433540502016252 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module AG2AspectAG where {-# LINE 2 "src-ag/HsToken.ag" #-} import CommonTypes import UU.Scanner.Position(Pos) {-# LINE 10 "dist/build/AG2AspectAG.hs" #-} {-# LINE 2 "src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken {-# LINE 16 "dist/build/AG2AspectAG.hs" #-} {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 23 "dist/build/AG2AspectAG.hs" #-} {-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) import Data.Map(Map) import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import Macro --marcos import CommonTypes import ErrorMessages {-# LINE 35 "dist/build/AG2AspectAG.hs" #-} {-# LINE 8 "src-ag/AG2AspectAG.ag" #-} import Options import Data.Char import Data.List import qualified Data.Map as Map import qualified Data.Set as Set import Data.Maybe import Pretty import PPUtil import UU.Scanner.Position import AbstractSyntax import TokenDef import CommonTypes -- import Debug.Trace {-# LINE 56 "dist/build/AG2AspectAG.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 28 "src-ag/AG2AspectAG.ag" #-} pragmaAspectAG = pp "{-# LANGUAGE EmptyDataDecls, NoMonomorphismRestriction , TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}" {-# LINE 63 "dist/build/AG2AspectAG.hs" #-} {-# LINE 33 "src-ag/AG2AspectAG.ag" #-} ppName l = ppListSep "" "" "_" l {-# LINE 68 "dist/build/AG2AspectAG.hs" #-} {-# LINE 70 "src-ag/AG2AspectAG.ag" #-} type FieldMap = [(Identifier, Type)] type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap) {-# LINE 74 "dist/build/AG2AspectAG.hs" #-} {-# LINE 342 "src-ag/AG2AspectAG.ag" #-} filterAtts newAtts = filter (\att -> Map.member (identifier att) newAtts) filterNotAtts newAtts = filter (\att -> not (Map.member (identifier att) newAtts)) defAtt att = "data " >|< attTName att >|< "; " >|< attName att >|< " = proxy :: Proxy " >|< attTName att attName att = pp $ "att_" ++ att attTName att = pp $ "Att_" ++ att defAttRec recPref ppNt atts noGroup = let recName = ppName [recPref, ppNt] fields = ppCommas (map (\(a,t) -> ppName [pp a, recName ] >|< " ::" >|< ppShow t) (groupAtts atts noGroup)) in "data " >|< recName >|< " = " >|< recName >|< " { " >|< fields >|< " }" groupAtts atts noGroup = (Map.toAscList . Map.difference atts) noGroup -- it defines selectors with the form: -- l1_nt_prod(x, _, .., _) = x -- ln_nt_prod(_, .., _, x) = x defLocalAtts prodName total actual (l:ls) = ppName [pp l, prodName] >|< ppListSep "(" ")" "," (replicate (actual-1) "_" ++ "x" : replicate (total-actual) "_") >|< pp " = x" >-< defLocalAtts prodName total (actual+1) ls defLocalAtts _ _ _ [] = empty {-# LINE 103 "dist/build/AG2AspectAG.hs" #-} {-# LINE 397 "src-ag/AG2AspectAG.ag" #-} ntsList att ppNtL = "nts_" ++ att ++ " = " >|< ppListSep "" "" " .*. " ((map fst ppNtL) ++ [pp "hNil"]) filterNts att = filter ( Map.member (identifier att) . snd ) {-# LINE 110 "dist/build/AG2AspectAG.hs" #-} {-# LINE 455 "src-ag/AG2AspectAG.ag" #-} data PPRule = PPRule Identifier Identifier Bool ([(Identifier,Type)] -> [Identifier] -> PP_Doc) ppRule (field,attr) owrt def = PPRule field attr owrt def ruleField (PPRule field _ _ _ ) = field ruleAttr (PPRule _ attr _ _ ) = attr ruleOwrt (PPRule _ _ owrt _ ) = owrt ruleDef (PPRule _ _ _ def) = def {-# LINE 122 "dist/build/AG2AspectAG.hs" #-} {-# LINE 494 "src-ag/AG2AspectAG.ag" #-} defInhGRule ppNt prodName newNT newProd ch rules inhNoGroup synNoGroup chids locals = let ppAtt = ppName [pp "inh", prodName] ppR = ppAtt >|< pp " = inhdefM att_inh nts_group $" >-< indent 4 "do " >-< indent 5 "loc <- at loc" >-< indent 5 "lhs <- at lhs" >-< indent 5 ch >-< indent 5 "return $" >-< indent 6 (foldr (>-<) (pp "emptyRecord") (map (chGRule ppNt prodName rules inhNoGroup synNoGroup chids locals) chids)) in if (newNT || (not newNT && newProd)) then (ppR, [ ppAtt ]) else (empty, []) chGRule ppNt prodName rules inhNoGroup synNoGroup chids locals (idCh,tp) = let chName = ppName [pp "ch", pp idCh, prodName] ppTp = ppShow tp chRules = ppCommas $ mapGRuleDefs (== idCh) rules inhNoGroup synNoGroup chids locals in if (isNonterminal tp) then chName >|< ".=." >-< indent 1 "InhG_" >|< ppShow tp >|< pp " {" >-< indent 2 chRules >-< indent 1 "} .*. " else empty defSynGRule ppNt prod newNT newProd ch rules inhNoGroup synNoGroup chids locals = let ppAtt = ppName [pp "syn", ppNt, pp prod] ppTAtt = "SynG_" >|< ppNt ppR = ppAtt >|< pp " = syndefM att_syn $" >-< indent 4 "do " >-< indent 5 "loc <- at loc" >-< indent 5 "lhs <- at lhs" >-< indent 5 ch >-< indent 5 "return $" >-< indent 6 ppTAtt >|< pp " {" >-< indent 7 (ppCommas $ mapGRuleDefs ((== "lhs") . show) rules inhNoGroup synNoGroup chids locals) >-< indent 6 "}" in if (newNT || (not newNT && newProd)) then (ppR, [ ppAtt ]) else (empty, []) defLocRule ppNt prod newNT newProd ch rules inhNoGroup synNoGroup chids locals = let ppAtt = ppName [pp "loc", ppNt, pp prod] ppTAtt = ppName [pp "Loc", ppNt, pp prod] ppR = ppAtt >|< pp " = locdefM att_loc $" >-< indent 4 "do " >-< indent 5 "loc <- at loc" >-< indent 5 "lhs <- at lhs" >-< indent 5 ch >-< indent 5 "return $" >-< indent 6 (ppListSep "(" ")" "," $ mapLRuleDefs rules inhNoGroup synNoGroup chids locals) in (ppR, [ ppAtt ]) defInstRules ppNt prod newNT newProd ch rules chids locals = let ppAsp = ppName [pp "inst", ppNt, pp prod] instRules = filter ((=="inst") . show . ruleField) rules ppAtt att = ppListSep "`ext` " "" "_" [pp "inst_ch", pp att, ppNt, pp prod] in ( ppAsp >|< pp " = emptyRule " >|< (map (ppAtt . ruleAttr) instRules) >-< (vlist $ map (defInstRule ppNt prod ch chids locals) instRules) , [ ppAsp ]) defInstRule ppNt prod ch chids locals rule = let ppAtt = ppName [pp "ch", pp (ruleAttr rule), ppNt, pp prod] in pp "inst_" >|< ppAtt >|< pp " = instdefM " >|< ppAtt >|< pp " $" >-< indent 4 "do " >-< indent 5 "loc <- at loc" >-< indent 5 "lhs <- at lhs" >-< indent 5 ch >-< indent 5 "return $" >-< indent 6 ((ruleDef rule) chids locals) defSynRules ppNt prod newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals = let synRules = filter ( (=="lhs") . show . ruleField) rules ngRules = filter ((flip elem synNoGroup) . getName . ruleAttr) synRules (ppR, ppRA) = unzip $ map (defSynRule True ppNt prod newNT newProd newAtts ch chids locals) ngRules in (vlist ppR, concat ppRA ) modSynRules ppNt prod newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals = let synRules = filter ( (=="lhs") . show . ruleField) rules ngRules = filter ((flip elem synNoGroup) . getName . ruleAttr) synRules (ppR, ppRA) = unzip $ map (defSynRule False ppNt prod newNT newProd newAtts ch chids locals) ngRules in (vlist ppR, concat ppRA ) defSynRule new ppNt prod newNT newProd newAtts ch chids locals rule = let att = ruleAttr rule newAtt = Map.member att newAtts owrt = ruleOwrt rule ppAtt = ppName [pp att, pp (if new then "syn" else "synM"), ppNt, pp prod] ppR def = ppAtt >|< pp (" = " ++ def ++ " ") >|< attName (show att) >|< pp " $" >-< indent 4 "do " >-< indent 5 "loc <- at loc" >-< indent 5 "lhs <- at lhs" >-< indent 5 ch >-< indent 5 "return $" >-< indent 6 ((ruleDef rule) chids locals) in if new then if (not owrt && (newNT || (not newNT && newProd) || newAtt)) then (ppR "syndefM", [ ppAtt ]) else (empty, []) else if owrt then (ppR "synmodM", [ ppAtt ]) else (empty, []) defInhRules ppNt prodName newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals = let ngRules = filter ((flip elem inhNoGroup) . getName . ruleAttr) rules (ppR, ppRA) = unzip $ map (defInhRule True ppNt prodName newNT newProd newAtts ch ngRules inhNoGroup synNoGroup chids locals) inhNoGroup in (vlist ppR, concat ppRA) modInhRules ppNt prodName newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals = let ngRules = filter ((flip elem inhNoGroup) . getName . ruleAttr) rules (ppR, ppRA) = unzip $ map (defInhRule False ppNt prodName newNT newProd newAtts ch ngRules inhNoGroup synNoGroup chids locals) inhNoGroup in (vlist ppR, concat ppRA) defInhRule new ppNt prodName newNT newProd newAtts ch rules inhNoGroup synNoGroup chids locals att = let ppAtt = ppName [pp att, pp (if new then "inh" else "inhM"),prodName] newAtt = Map.member (identifier att) newAtts chRMaybe = map (chRule new ppNt prodName att rules inhNoGroup synNoGroup chids locals) chids chR = [ x | (Just x) <- chRMaybe ] ppR def = ppAtt >|< pp (" = " ++ def ++ " ") >|< attName att >|< " nts_" >|< att >|< " $" >-< indent 4 "do " >-< indent 5 "loc <- at loc" >-< indent 5 "lhs <- at lhs" >-< indent 5 ch >-< indent 5 "return $" >-< indent 6 (foldr (>-<) (pp "emptyRecord") chR) in if new then if (newNT || (not newNT && newProd) || newAtt) then (ppR "inhdefM", [ ppAtt ]) else (empty, []) else if (not . null) chR then (ppR "inhmodM", [ ppAtt ]) else (empty, []) chRule new ppNt prodName att rules inhNoGroup synNoGroup chids locals (idCh,tp) = let chName = ppName [pp "ch", pp idCh, prodName] ppTp = ppShow tp chRule = inhRuleDef new (== idCh) (== att) rules inhNoGroup synNoGroup chids locals -- it's supposed to be only one in if (isNonterminal tp && (not . null) chRule) then Just $ chName >|< ".=. (" >|< chRule >|< ") .*. " else Nothing mapLRuleDefs rules inhNoGroup synNoGroup chids locals = map appSnd $ sortBy cmpField $ filter ((== "loc") . show . ruleField) rules where cmpField r1 r2 = compare (ruleField r1) (ruleField r2) appSnd rule = (ruleDef rule) chids locals mapGRuleDefs filt rules inhNoGroup synNoGroup chids locals = map appSnd $ sortBy cmpField $ filter (not . (flip elem inhNoGroup) . getName . ruleAttr) $ filter (not . (flip elem synNoGroup) . getName . ruleAttr) $ filter ( filt . ruleField) rules where cmpField r1 r2 = compare (ruleField r1) (ruleField r2) appSnd rule = (ruleDef rule) chids locals inhRuleDef new filt1 filt2 rules inhNoGroup synNoGroup chids locals = map appSnd $ sortBy cmpField $ filter ( (== not new) . ruleOwrt) $ filter ((flip elem inhNoGroup) . getName . ruleAttr) $ filter ( filt2 . getName . ruleAttr) $ filter ( filt1 . ruleField) rules where cmpField r1 r2 = compare (ruleField r1) (ruleField r2) appSnd rule = (ruleDef rule) chids locals defRule ppNt (field,att) noGroup rhs = \chids locals -> let ppAtt = if (elem (getName att) noGroup) then empty else case (show field) of "lhs" -> att >|< "_" >|< pp "SynG" >|< pp "_" >|< ppNt >|< " = " "loc" -> empty "inst" -> empty otherwise -> att >|< "_" >|< pp "InhG" >|< pp "_" >|< (maybe (error $ "lhs field " ++ show field ++" is not a child") ppShow (lookup field chids)) >|< " = " in ppAtt >|< (rhs noGroup field chids locals) rhsRule ppNt ppProd tks noGroup field chids locals = vlist . lines2PP . (map (token2PP ppNt ppProd field chids locals noGroup )) $ tks lines2PP [] = [] lines2PP xs = map line2PP . shiftLeft . getLines $ xs token2PP ppNt ppProd field chids locals noGroup tk = case tk of AGLocal var pos _ -> (pos, if (elem var locals) then (ppListSep "(" "" "_" [pp var, ppNt, ppProd]) >|< pp " (loc # att_loc)) " else pp var) AGField field attr pos _ -> let ppChT = maybe (error $ "rhs field " ++ show field ++ " is not a child") ppShow (lookup field chids) ppAtt = case (show field) of "lhs" -> attName "inh" "loc" -> attName "loc" otherwise -> attName "syn" ppSubAtt = case (show field) of "lhs" -> ppName [pp (getName attr), pp "InhG", ppNt] "loc" -> ppName [pp (getName attr), ppNt, ppProd] otherwise -> ppName [pp (getName attr), pp "SynG", ppChT] in (pos, if ((elem (getName attr) noGroup) && ((show field) /= "loc")) then pp "(" >|< pp (getName field) >|< " # " >|< attName (getName attr) >|< pp ")" else pp "(" >|< ppSubAtt >|< " (" >|< pp (getName field) >|< " # " >|< ppAtt >|< ")) ") HsToken value pos -> (pos, pp value) CharToken value pos -> (pos, pp (show value)) StrToken value pos -> (pos, pp (show value)) Err mesg pos -> (pos, pp $ " ***" ++ mesg ++ "*** ") line2PP ts = let f (p,t) r = let ct = column p in \c -> pp (spaces (ct-c)) >|< t >|< r (length (show t) +ct) spaces x | x < 0 = "" | otherwise = replicate x ' ' in foldr f (pp . const "") ts 1 {-# LINE 347 "dist/build/AG2AspectAG.hs" #-} {-# LINE 721 "src-ag/AG2AspectAG.ag" #-} ppMacro (Macro con children) = "( atts_" >|< show con >|< ", " >|< ppListSep "" "" " <.> " ppChildren >|<")" where ppChildren = map ppChild children ppChild (RuleChild ch n) = chName ch >|< " ==> " >|< ppMacro n ppChild (ChildChild ch n) = chName ch >|< " --> " >|< n ppChild (ValueChild ch n) = chName ch >|< " ~~> " >|< n chName ch = ppName [pp "ch", pp ch, pp con] {-# LINE 357 "dist/build/AG2AspectAG.hs" #-} {-# LINE 754 "src-ag/AG2AspectAG.ag" #-} ppNoGroupAtts syn noGroup = let synatts = Map.keys $ Map.filterWithKey (\att _ -> elem (getName att) noGroup) syn in map (flip (>|<) "_inh") noGroup ++ map (flip (>|<) "_syn") synatts ruleName att prodName = ppName [att,prodName] elemNT a b = False {-# LINE 367 "dist/build/AG2AspectAG.hs" #-} {-# LINE 797 "src-ag/AG2AspectAG.ag" #-} attTypes atts = map (\(a,t) -> "(HCons (LVPair (Proxy Att_" >|< a >|< ") " >|< ppShow t >|< ") ") $ Map.toAscList atts {-# LINE 372 "dist/build/AG2AspectAG.hs" #-} {-# LINE 851 "src-ag/AG2AspectAG.ag" #-} attVars atts = map (\(a,_) -> "_" >|< a >|< " ") $ Map.toAscList atts attFields atts noGroup ppNt = let ng = map (\(a,_) -> attName (getName a) >|< " .=. _" >|< a >|< " .*. ") $ Map.toAscList noGroup g = ppCommas $ map (\(a,_) -> ppName [pp a, pp "InhG",ppNt] >|< "= _" >|< a) $ Map.toAscList $ Map.difference atts noGroup in "(" >|< ng >|< "att_inh .=. " >|< ppName [pp "InhG", ppNt] >|< " { " >|< g >|< " } .*. emptyRecord)" {-# LINE 381 "dist/build/AG2AspectAG.hs" #-} -- Child ------------------------------------------------------- -- wrapper data Inh_Child = Inh_Child { ext_Inh_Child :: (Maybe String), inhMap_Inh_Child :: (Map Identifier Attributes), inhNoGroup_Inh_Child :: ([String]), newAtts_Inh_Child :: ( Attributes ), o_noGroup_Inh_Child :: ([String]), o_rename_Inh_Child :: (Bool), ppNt_Inh_Child :: (PP_Doc), ppProd_Inh_Child :: (PP_Doc), synMap_Inh_Child :: (Map Identifier Attributes), synNoGroup_Inh_Child :: ([String]) } data Syn_Child = Syn_Child { idCL_Syn_Child :: ([(Identifier,Type)]), ppCSF_Syn_Child :: ([(Identifier,(PP_Doc,PP_Doc))]), ppDL_Syn_Child :: ([PP_Doc]), ppL_Syn_Child :: (PP_Doc), ppLI_Syn_Child :: ([PP_Doc]), ppR_Syn_Child :: (PP_Doc), prdInh_Syn_Child :: (Attributes) } {-# INLINABLE wrap_Child #-} wrap_Child :: T_Child -> Inh_Child -> (Syn_Child ) wrap_Child (T_Child act) (Inh_Child _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_Child_vIn1 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup (T_Child_vOut1 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh) <- return (inv_Child_s2 sem arg1) return (Syn_Child _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh) ) -- cata {-# INLINE sem_Child #-} sem_Child :: Child -> T_Child sem_Child ( Child name_ tp_ kind_ ) = sem_Child_Child name_ tp_ kind_ -- semantic domain newtype T_Child = T_Child { attach_T_Child :: Identity (T_Child_s2 ) } newtype T_Child_s2 = C_Child_s2 { inv_Child_s2 :: (T_Child_v1 ) } data T_Child_s3 = C_Child_s3 type T_Child_v1 = (T_Child_vIn1 ) -> (T_Child_vOut1 ) data T_Child_vIn1 = T_Child_vIn1 (Maybe String) (Map Identifier Attributes) ([String]) ( Attributes ) ([String]) (Bool) (PP_Doc) (PP_Doc) (Map Identifier Attributes) ([String]) data T_Child_vOut1 = T_Child_vOut1 ([(Identifier,Type)]) ([(Identifier,(PP_Doc,PP_Doc))]) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (Attributes) {-# NOINLINE sem_Child_Child #-} sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child sem_Child_Child arg_name_ arg_tp_ arg_kind_ = T_Child (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Child_v1 v1 = \ (T_Child_vIn1 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) -> ( let _chnt = rule0 arg_name_ arg_tp_ _inh = rule1 _chnt _lhsIinhMap _syn = rule2 _chnt _lhsIsynMap _lhsOprdInh :: Attributes _lhsOprdInh = rule3 _inh _ppCh = rule4 arg_name_ _ppTCh = rule5 arg_tp_ _chName = rule6 _lhsIppNt _lhsIppProd _ppCh _lhsOppDL :: [PP_Doc] _lhsOppDL = rule7 _chName _ppTCh arg_kind_ _chLabel = rule8 _chName _chTLabel = rule9 _chName _lhsOppL :: PP_Doc _lhsOppL = rule10 _chLabel _chTLabel _ppTCh arg_kind_ _lhsOppLI :: [PP_Doc] _lhsOppLI = rule11 _chLabel _chTLabel _lhsOppR :: PP_Doc _lhsOppR = rule12 _lhsIppNt _lhsIppProd arg_name_ _lhsOidCL :: [(Identifier,Type)] _lhsOidCL = rule13 arg_name_ arg_tp_ _lhsOppCSF :: [(Identifier,(PP_Doc,PP_Doc))] _lhsOppCSF = rule14 _chLabel arg_kind_ arg_name_ arg_tp_ __result_ = T_Child_vOut1 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} {-# LINE 19 "src-ag/DistChildAttr.ag" #-} rule0 = \ name_ tp_ -> {-# LINE 19 "src-ag/DistChildAttr.ag" #-} case tp_ of NT nt _ _ -> nt Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") Haskell t -> identifier "" {-# LINE 452 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule1 #-} {-# LINE 23 "src-ag/DistChildAttr.ag" #-} rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> {-# LINE 23 "src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIinhMap {-# LINE 458 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule2 #-} {-# LINE 24 "src-ag/DistChildAttr.ag" #-} rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> {-# LINE 24 "src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIsynMap {-# LINE 464 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule3 #-} {-# LINE 67 "src-ag/AG2AspectAG.ag" #-} rule3 = \ _inh -> {-# LINE 67 "src-ag/AG2AspectAG.ag" #-} _inh {-# LINE 470 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule4 #-} {-# LINE 182 "src-ag/AG2AspectAG.ag" #-} rule4 = \ name_ -> {-# LINE 182 "src-ag/AG2AspectAG.ag" #-} pp name_ {-# LINE 476 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule5 #-} {-# LINE 183 "src-ag/AG2AspectAG.ag" #-} rule5 = \ tp_ -> {-# LINE 183 "src-ag/AG2AspectAG.ag" #-} ppShow tp_ {-# LINE 482 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule6 #-} {-# LINE 184 "src-ag/AG2AspectAG.ag" #-} rule6 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) _ppCh -> {-# LINE 184 "src-ag/AG2AspectAG.ag" #-} ppName [_ppCh , _lhsIppNt, _lhsIppProd] {-# LINE 488 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule7 #-} {-# LINE 242 "src-ag/AG2AspectAG.ag" #-} rule7 = \ _chName _ppTCh kind_ -> {-# LINE 242 "src-ag/AG2AspectAG.ag" #-} case kind_ of ChildSyntax -> [ _chName >|< pp " :: " >|< _ppTCh ] _ -> [] {-# LINE 496 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule8 #-} {-# LINE 285 "src-ag/AG2AspectAG.ag" #-} rule8 = \ _chName -> {-# LINE 285 "src-ag/AG2AspectAG.ag" #-} "ch_" >|< _chName {-# LINE 502 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule9 #-} {-# LINE 286 "src-ag/AG2AspectAG.ag" #-} rule9 = \ _chName -> {-# LINE 286 "src-ag/AG2AspectAG.ag" #-} "Ch_" >|< _chName {-# LINE 508 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule10 #-} {-# LINE 287 "src-ag/AG2AspectAG.ag" #-} rule10 = \ _chLabel _chTLabel _ppTCh kind_ -> {-# LINE 287 "src-ag/AG2AspectAG.ag" #-} "data " >|< _chTLabel >|< "; " >|< _chLabel >|< pp " = proxy :: " >|< case kind_ of ChildSyntax -> "Proxy " >|< "(" >|< _chTLabel >|< ", " >|< _ppTCh >|< ")" _ -> "SemType " >|< _ppTCh >|< pp " nt => Proxy " >|< "(" >|< _chTLabel >|< ", nt)" {-# LINE 518 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule11 #-} {-# LINE 293 "src-ag/AG2AspectAG.ag" #-} rule11 = \ _chLabel _chTLabel -> {-# LINE 293 "src-ag/AG2AspectAG.ag" #-} [ _chLabel , _chTLabel ] {-# LINE 524 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule12 #-} {-# LINE 451 "src-ag/AG2AspectAG.ag" #-} rule12 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) name_ -> {-# LINE 451 "src-ag/AG2AspectAG.ag" #-} let chName = ppListSep "" "" "_" [pp name_, _lhsIppNt, _lhsIppProd] in pp name_ >|< " <- at ch_" >|< chName {-# LINE 531 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule13 #-} {-# LINE 489 "src-ag/AG2AspectAG.ag" #-} rule13 = \ name_ tp_ -> {-# LINE 489 "src-ag/AG2AspectAG.ag" #-} [ (name_, removeDeforested tp_ ) ] {-# LINE 537 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule14 #-} {-# LINE 827 "src-ag/AG2AspectAG.ag" #-} rule14 = \ _chLabel kind_ name_ tp_ -> {-# LINE 827 "src-ag/AG2AspectAG.ag" #-} let semC = if (isNonterminal tp_) then "sem_" >|< ppShow tp_ >|< " _" >|< name_ else "sem_Lit _" >|< name_ in case kind_ of ChildSyntax -> [(name_, ( _chLabel >|< " .=. (" >|< semC >|< ") .*. " , _chLabel >|< " .=. _" >|< name_ >|< " .*. "))] _ -> [] {-# LINE 550 "dist/build/AG2AspectAG.hs"#-} -- Children ---------------------------------------------------- -- wrapper data Inh_Children = Inh_Children { ext_Inh_Children :: (Maybe String), inhMap_Inh_Children :: (Map Identifier Attributes), inhNoGroup_Inh_Children :: ([String]), newAtts_Inh_Children :: ( Attributes ), o_noGroup_Inh_Children :: ([String]), o_rename_Inh_Children :: (Bool), ppNt_Inh_Children :: (PP_Doc), ppProd_Inh_Children :: (PP_Doc), synMap_Inh_Children :: (Map Identifier Attributes), synNoGroup_Inh_Children :: ([String]) } data Syn_Children = Syn_Children { idCL_Syn_Children :: ([(Identifier,Type)]), ppCSF_Syn_Children :: ([(Identifier,(PP_Doc,PP_Doc))]), ppDL_Syn_Children :: ([PP_Doc]), ppL_Syn_Children :: (PP_Doc), ppLI_Syn_Children :: ([PP_Doc]), ppR_Syn_Children :: (PP_Doc), prdInh_Syn_Children :: (Attributes) } {-# INLINABLE wrap_Children #-} wrap_Children :: T_Children -> Inh_Children -> (Syn_Children ) wrap_Children (T_Children act) (Inh_Children _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_Children_vIn4 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup (T_Children_vOut4 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh) <- return (inv_Children_s5 sem arg4) return (Syn_Children _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh) ) -- cata {-# NOINLINE sem_Children #-} sem_Children :: Children -> T_Children sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) -- semantic domain newtype T_Children = T_Children { attach_T_Children :: Identity (T_Children_s5 ) } newtype T_Children_s5 = C_Children_s5 { inv_Children_s5 :: (T_Children_v4 ) } data T_Children_s6 = C_Children_s6 type T_Children_v4 = (T_Children_vIn4 ) -> (T_Children_vOut4 ) data T_Children_vIn4 = T_Children_vIn4 (Maybe String) (Map Identifier Attributes) ([String]) ( Attributes ) ([String]) (Bool) (PP_Doc) (PP_Doc) (Map Identifier Attributes) ([String]) data T_Children_vOut4 = T_Children_vOut4 ([(Identifier,Type)]) ([(Identifier,(PP_Doc,PP_Doc))]) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (Attributes) {-# NOINLINE sem_Children_Cons #-} sem_Children_Cons :: T_Child -> T_Children -> T_Children sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_Children_v4 v4 = \ (T_Children_vIn4 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) -> ( let _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) (T_Child_vOut1 _hdIidCL _hdIppCSF _hdIppDL _hdIppL _hdIppLI _hdIppR _hdIprdInh) = inv_Child_s2 _hdX2 (T_Child_vIn1 _hdOext _hdOinhMap _hdOinhNoGroup _hdOnewAtts _hdOo_noGroup _hdOo_rename _hdOppNt _hdOppProd _hdOsynMap _hdOsynNoGroup) (T_Children_vOut4 _tlIidCL _tlIppCSF _tlIppDL _tlIppL _tlIppLI _tlIppR _tlIprdInh) = inv_Children_s5 _tlX5 (T_Children_vIn4 _tlOext _tlOinhMap _tlOinhNoGroup _tlOnewAtts _tlOo_noGroup _tlOo_rename _tlOppNt _tlOppProd _tlOsynMap _tlOsynNoGroup) _lhsOppDL :: [PP_Doc] _lhsOppDL = rule15 _hdIppDL _tlIppDL _lhsOidCL :: [(Identifier,Type)] _lhsOidCL = rule16 _hdIidCL _tlIidCL _lhsOppCSF :: [(Identifier,(PP_Doc,PP_Doc))] _lhsOppCSF = rule17 _hdIppCSF _tlIppCSF _lhsOppL :: PP_Doc _lhsOppL = rule18 _hdIppL _tlIppL _lhsOppLI :: [PP_Doc] _lhsOppLI = rule19 _hdIppLI _tlIppLI _lhsOppR :: PP_Doc _lhsOppR = rule20 _hdIppR _tlIppR _lhsOprdInh :: Attributes _lhsOprdInh = rule21 _hdIprdInh _tlIprdInh _hdOext = rule22 _lhsIext _hdOinhMap = rule23 _lhsIinhMap _hdOinhNoGroup = rule24 _lhsIinhNoGroup _hdOnewAtts = rule25 _lhsInewAtts _hdOo_noGroup = rule26 _lhsIo_noGroup _hdOo_rename = rule27 _lhsIo_rename _hdOppNt = rule28 _lhsIppNt _hdOppProd = rule29 _lhsIppProd _hdOsynMap = rule30 _lhsIsynMap _hdOsynNoGroup = rule31 _lhsIsynNoGroup _tlOext = rule32 _lhsIext _tlOinhMap = rule33 _lhsIinhMap _tlOinhNoGroup = rule34 _lhsIinhNoGroup _tlOnewAtts = rule35 _lhsInewAtts _tlOo_noGroup = rule36 _lhsIo_noGroup _tlOo_rename = rule37 _lhsIo_rename _tlOppNt = rule38 _lhsIppNt _tlOppProd = rule39 _lhsIppProd _tlOsynMap = rule40 _lhsIsynMap _tlOsynNoGroup = rule41 _lhsIsynNoGroup __result_ = T_Children_vOut4 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh in __result_ ) in C_Children_s5 v4 {-# INLINE rule15 #-} {-# LINE 238 "src-ag/AG2AspectAG.ag" #-} rule15 = \ ((_hdIppDL) :: [PP_Doc]) ((_tlIppDL) :: [PP_Doc]) -> {-# LINE 238 "src-ag/AG2AspectAG.ag" #-} _hdIppDL ++ _tlIppDL {-# LINE 635 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule16 #-} rule16 = \ ((_hdIidCL) :: [(Identifier,Type)]) ((_tlIidCL) :: [(Identifier,Type)]) -> _hdIidCL ++ _tlIidCL {-# INLINE rule17 #-} rule17 = \ ((_hdIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) ((_tlIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) -> _hdIppCSF ++ _tlIppCSF {-# INLINE rule18 #-} rule18 = \ ((_hdIppL) :: PP_Doc) ((_tlIppL) :: PP_Doc) -> _hdIppL >-< _tlIppL {-# INLINE rule19 #-} rule19 = \ ((_hdIppLI) :: [PP_Doc]) ((_tlIppLI) :: [PP_Doc]) -> _hdIppLI ++ _tlIppLI {-# INLINE rule20 #-} rule20 = \ ((_hdIppR) :: PP_Doc) ((_tlIppR) :: PP_Doc) -> _hdIppR >-< _tlIppR {-# INLINE rule21 #-} rule21 = \ ((_hdIprdInh) :: Attributes) ((_tlIprdInh) :: Attributes) -> _hdIprdInh `Map.union` _tlIprdInh {-# INLINE rule22 #-} rule22 = \ ((_lhsIext) :: Maybe String) -> _lhsIext {-# INLINE rule23 #-} rule23 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule24 #-} rule24 = \ ((_lhsIinhNoGroup) :: [String]) -> _lhsIinhNoGroup {-# INLINE rule25 #-} rule25 = \ ((_lhsInewAtts) :: Attributes ) -> _lhsInewAtts {-# INLINE rule26 #-} rule26 = \ ((_lhsIo_noGroup) :: [String]) -> _lhsIo_noGroup {-# INLINE rule27 #-} rule27 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule28 #-} rule28 = \ ((_lhsIppNt) :: PP_Doc) -> _lhsIppNt {-# INLINE rule29 #-} rule29 = \ ((_lhsIppProd) :: PP_Doc) -> _lhsIppProd {-# INLINE rule30 #-} rule30 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule31 #-} rule31 = \ ((_lhsIsynNoGroup) :: [String]) -> _lhsIsynNoGroup {-# INLINE rule32 #-} rule32 = \ ((_lhsIext) :: Maybe String) -> _lhsIext {-# INLINE rule33 #-} rule33 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule34 #-} rule34 = \ ((_lhsIinhNoGroup) :: [String]) -> _lhsIinhNoGroup {-# INLINE rule35 #-} rule35 = \ ((_lhsInewAtts) :: Attributes ) -> _lhsInewAtts {-# INLINE rule36 #-} rule36 = \ ((_lhsIo_noGroup) :: [String]) -> _lhsIo_noGroup {-# INLINE rule37 #-} rule37 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule38 #-} rule38 = \ ((_lhsIppNt) :: PP_Doc) -> _lhsIppNt {-# INLINE rule39 #-} rule39 = \ ((_lhsIppProd) :: PP_Doc) -> _lhsIppProd {-# INLINE rule40 #-} rule40 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule41 #-} rule41 = \ ((_lhsIsynNoGroup) :: [String]) -> _lhsIsynNoGroup {-# NOINLINE sem_Children_Nil #-} sem_Children_Nil :: T_Children sem_Children_Nil = T_Children (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_Children_v4 v4 = \ (T_Children_vIn4 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) -> ( let _lhsOppDL :: [PP_Doc] _lhsOppDL = rule42 () _lhsOidCL :: [(Identifier,Type)] _lhsOidCL = rule43 () _lhsOppCSF :: [(Identifier,(PP_Doc,PP_Doc))] _lhsOppCSF = rule44 () _lhsOppL :: PP_Doc _lhsOppL = rule45 () _lhsOppLI :: [PP_Doc] _lhsOppLI = rule46 () _lhsOppR :: PP_Doc _lhsOppR = rule47 () _lhsOprdInh :: Attributes _lhsOprdInh = rule48 () __result_ = T_Children_vOut4 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh in __result_ ) in C_Children_s5 v4 {-# INLINE rule42 #-} {-# LINE 239 "src-ag/AG2AspectAG.ag" #-} rule42 = \ (_ :: ()) -> {-# LINE 239 "src-ag/AG2AspectAG.ag" #-} [] {-# LINE 743 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule43 #-} rule43 = \ (_ :: ()) -> [] {-# INLINE rule44 #-} rule44 = \ (_ :: ()) -> [] {-# INLINE rule45 #-} rule45 = \ (_ :: ()) -> empty {-# INLINE rule46 #-} rule46 = \ (_ :: ()) -> [] {-# INLINE rule47 #-} rule47 = \ (_ :: ()) -> empty {-# INLINE rule48 #-} rule48 = \ (_ :: ()) -> Map.empty -- Expression -------------------------------------------------- -- wrapper data Inh_Expression = Inh_Expression { ppNt_Inh_Expression :: (PP_Doc), ppProd_Inh_Expression :: (PP_Doc) } data Syn_Expression = Syn_Expression { ppRE_Syn_Expression :: ([String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc) } {-# INLINABLE wrap_Expression #-} wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) wrap_Expression (T_Expression act) (Inh_Expression _lhsIppNt _lhsIppProd) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_Expression_vIn7 _lhsIppNt _lhsIppProd (T_Expression_vOut7 _lhsOppRE) <- return (inv_Expression_s8 sem arg7) return (Syn_Expression _lhsOppRE) ) -- cata {-# INLINE sem_Expression #-} sem_Expression :: Expression -> T_Expression sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_ -- semantic domain newtype T_Expression = T_Expression { attach_T_Expression :: Identity (T_Expression_s8 ) } newtype T_Expression_s8 = C_Expression_s8 { inv_Expression_s8 :: (T_Expression_v7 ) } data T_Expression_s9 = C_Expression_s9 type T_Expression_v7 = (T_Expression_vIn7 ) -> (T_Expression_vOut7 ) data T_Expression_vIn7 = T_Expression_vIn7 (PP_Doc) (PP_Doc) data T_Expression_vOut7 = T_Expression_vOut7 ([String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc) {-# NOINLINE sem_Expression_Expression #-} sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression sem_Expression_Expression _ arg_tks_ = T_Expression (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_Expression_v7 v7 = \ (T_Expression_vIn7 _lhsIppNt _lhsIppProd) -> ( let _lhsOppRE :: [String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc _lhsOppRE = rule49 _lhsIppNt _lhsIppProd arg_tks_ __result_ = T_Expression_vOut7 _lhsOppRE in __result_ ) in C_Expression_s8 v7 {-# INLINE rule49 #-} {-# LINE 484 "src-ag/AG2AspectAG.ag" #-} rule49 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) tks_ -> {-# LINE 484 "src-ag/AG2AspectAG.ag" #-} rhsRule _lhsIppNt _lhsIppProd tks_ {-# LINE 810 "dist/build/AG2AspectAG.hs"#-} -- Grammar ----------------------------------------------------- -- wrapper data Inh_Grammar = Inh_Grammar { agi_Inh_Grammar :: ((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))), ext_Inh_Grammar :: (Maybe String), options_Inh_Grammar :: (Options) } data Syn_Grammar = Syn_Grammar { imp_Syn_Grammar :: (PP_Doc), pp_Syn_Grammar :: (PP_Doc) } {-# INLINABLE wrap_Grammar #-} wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar ) wrap_Grammar (T_Grammar act) (Inh_Grammar _lhsIagi _lhsIext _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg10 = T_Grammar_vIn10 _lhsIagi _lhsIext _lhsIoptions (T_Grammar_vOut10 _lhsOimp _lhsOpp) <- return (inv_Grammar_s11 sem arg10) return (Syn_Grammar _lhsOimp _lhsOpp) ) -- cata {-# INLINE sem_Grammar #-} sem_Grammar :: Grammar -> T_Grammar sem_Grammar ( Grammar typeSyns_ useMap_ derivings_ wrappers_ nonts_ pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ -- semantic domain newtype T_Grammar = T_Grammar { attach_T_Grammar :: Identity (T_Grammar_s11 ) } newtype T_Grammar_s11 = C_Grammar_s11 { inv_Grammar_s11 :: (T_Grammar_v10 ) } data T_Grammar_s12 = C_Grammar_s12 type T_Grammar_v10 = (T_Grammar_vIn10 ) -> (T_Grammar_vOut10 ) data T_Grammar_vIn10 = T_Grammar_vIn10 ((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) (Maybe String) (Options) data T_Grammar_vOut10 = T_Grammar_vOut10 (PP_Doc) (PP_Doc) {-# NOINLINE sem_Grammar_Grammar #-} sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar sem_Grammar_Grammar arg_typeSyns_ _ arg_derivings_ _ arg_nonts_ _ _ _ _ _ _ _ _ _ = T_Grammar (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_Grammar_v10 v10 = \ (T_Grammar_vIn10 _lhsIagi _lhsIext _lhsIoptions) -> ( let _nontsX26 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) (T_Nonterminals_vOut25 _nontsIextendedNTs _nontsIinhMap' _nontsIppA _nontsIppAI _nontsIppCata _nontsIppD _nontsIppDI _nontsIppL _nontsIppLI _nontsIppNtL _nontsIppR _nontsIppSF _nontsIppW _nontsIsynMap') = inv_Nonterminals_s26 _nontsX26 (T_Nonterminals_vIn25 _nontsOderivs _nontsOext _nontsOinhMap _nontsOnewAtts _nontsOnewNTs _nontsOnewProds _nontsOo_noGroup _nontsOo_rename _nontsOsynMap _nontsOtSyns) _nontsOinhMap = rule50 _nontsIinhMap' _nontsOsynMap = rule51 _nontsIsynMap' _nontsOo_rename = rule52 _lhsIoptions _o_noGroup = rule53 _lhsIoptions _nontsOo_noGroup = rule54 _o_noGroup _newAtts = rule55 _lhsIagi _nontsOnewAtts = rule56 _newAtts _newProds = rule57 _lhsIagi _nontsOnewProds = rule58 _newProds _nontsOnewNTs = rule59 _lhsIagi _nontsIextendedNTs _lhsOimp :: PP_Doc _lhsOimp = rule60 _lhsIext _nontsIppDI _nontsIppLI _ppAI _ppANT _lhsOpp :: PP_Doc _lhsOpp = rule61 _lhsIoptions _nontsIppCata _nontsIppD _nontsIppL _nontsIppSF _nontsIppW _ppA _ppR _nontsOderivs = rule62 arg_derivings_ _nontsOtSyns = rule63 arg_typeSyns_ _ppA = rule64 _lhsIext _newAtts _nontsIppA _o_noGroup _ppAI = rule65 _lhsIext _newAtts _nontsIppAI _o_noGroup _ppANT = rule66 _newAtts _o_noGroup _ppNtL = rule67 _nontsIppNtL _ppR = rule68 _newAtts _nontsIppR _o_noGroup _ppNtL _nontsOext = rule69 _lhsIext __result_ = T_Grammar_vOut10 _lhsOimp _lhsOpp in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule50 #-} {-# LINE 15 "src-ag/DistChildAttr.ag" #-} rule50 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> {-# LINE 15 "src-ag/DistChildAttr.ag" #-} _nontsIinhMap' {-# LINE 881 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule51 #-} {-# LINE 16 "src-ag/DistChildAttr.ag" #-} rule51 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> {-# LINE 16 "src-ag/DistChildAttr.ag" #-} _nontsIsynMap' {-# LINE 887 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule52 #-} {-# LINE 43 "src-ag/AG2AspectAG.ag" #-} rule52 = \ ((_lhsIoptions) :: Options) -> {-# LINE 43 "src-ag/AG2AspectAG.ag" #-} rename _lhsIoptions {-# LINE 893 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule53 #-} {-# LINE 47 "src-ag/AG2AspectAG.ag" #-} rule53 = \ ((_lhsIoptions) :: Options) -> {-# LINE 47 "src-ag/AG2AspectAG.ag" #-} sort $ noGroup _lhsIoptions {-# LINE 899 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule54 #-} {-# LINE 48 "src-ag/AG2AspectAG.ag" #-} rule54 = \ _o_noGroup -> {-# LINE 48 "src-ag/AG2AspectAG.ag" #-} _o_noGroup {-# LINE 905 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule55 #-} {-# LINE 80 "src-ag/AG2AspectAG.ag" #-} rule55 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) -> {-# LINE 80 "src-ag/AG2AspectAG.ag" #-} case _lhsIagi of (_,_,atts) -> ( Map.unions . (\(a,b) -> a++b) . unzip . Map.elems) atts {-# LINE 912 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule56 #-} {-# LINE 82 "src-ag/AG2AspectAG.ag" #-} rule56 = \ _newAtts -> {-# LINE 82 "src-ag/AG2AspectAG.ag" #-} _newAtts {-# LINE 918 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule57 #-} {-# LINE 88 "src-ag/AG2AspectAG.ag" #-} rule57 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) -> {-# LINE 88 "src-ag/AG2AspectAG.ag" #-} case _lhsIagi of (_,prods,_) -> prods {-# LINE 925 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule58 #-} {-# LINE 90 "src-ag/AG2AspectAG.ag" #-} rule58 = \ _newProds -> {-# LINE 90 "src-ag/AG2AspectAG.ag" #-} _newProds {-# LINE 931 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule59 #-} {-# LINE 112 "src-ag/AG2AspectAG.ag" #-} rule59 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) ((_nontsIextendedNTs) :: Set NontermIdent) -> {-# LINE 112 "src-ag/AG2AspectAG.ag" #-} case _lhsIagi of (newNTs,_,_) -> Set.difference newNTs _nontsIextendedNTs {-# LINE 938 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule60 #-} {-# LINE 127 "src-ag/AG2AspectAG.ag" #-} rule60 = \ ((_lhsIext) :: Maybe String) ((_nontsIppDI) :: [PP_Doc]) ((_nontsIppLI) :: [PP_Doc]) _ppAI _ppANT -> {-# LINE 127 "src-ag/AG2AspectAG.ag" #-} "import Language.Grammars.AspectAG" >-< "import Language.Grammars.AspectAG.Derive" >-< "import Data.HList.Label4" >-< "import Data.HList.TypeEqGeneric1" >-< "import Data.HList.TypeCastGeneric1" >-< maybe empty ("import qualified" >#<) _lhsIext >-< maybe empty (\ext -> "import" >#< ext >#< ppListSep "(" ")" "," (_nontsIppDI ++ _nontsIppLI ++ _ppAI ++ _ppANT )) _lhsIext {-# LINE 950 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule61 #-} {-# LINE 140 "src-ag/AG2AspectAG.ag" #-} rule61 = \ ((_lhsIoptions) :: Options) ((_nontsIppCata) :: PP_Doc) ((_nontsIppD) :: PP_Doc) ((_nontsIppL) :: PP_Doc) ((_nontsIppSF) :: PP_Doc) ((_nontsIppW) :: PP_Doc) _ppA _ppR -> {-# LINE 140 "src-ag/AG2AspectAG.ag" #-} (if dataTypes _lhsIoptions then "-- datatypes" >-< _nontsIppD >-< "-- labels" >-< _nontsIppL else empty) >-< (if folds _lhsIoptions then "-- attributes" >-< _ppA >-< "-- rules" >-< _ppR >-< "-- catas" >-< _nontsIppCata else empty) >-< (if semfuns _lhsIoptions then "-- semantic functions" >-< _nontsIppSF else empty) >-< (if wrappers _lhsIoptions then "-- wrappers" >-< _nontsIppW else empty) {-# LINE 973 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule62 #-} {-# LINE 202 "src-ag/AG2AspectAG.ag" #-} rule62 = \ derivings_ -> {-# LINE 202 "src-ag/AG2AspectAG.ag" #-} derivings_ {-# LINE 979 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule63 #-} {-# LINE 251 "src-ag/AG2AspectAG.ag" #-} rule63 = \ typeSyns_ -> {-# LINE 251 "src-ag/AG2AspectAG.ag" #-} typeSyns_ {-# LINE 985 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule64 #-} {-# LINE 300 "src-ag/AG2AspectAG.ag" #-} rule64 = \ ((_lhsIext) :: Maybe String) _newAtts ((_nontsIppA) :: PP_Doc) _o_noGroup -> {-# LINE 300 "src-ag/AG2AspectAG.ag" #-} vlist (map defAtt (filterAtts _newAtts _o_noGroup )) >-< defAtt "loc" >-< (case _lhsIext of Nothing -> defAtt "inh" >-< defAtt "syn" otherwise -> empty) >-< _nontsIppA {-# LINE 996 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule65 #-} {-# LINE 308 "src-ag/AG2AspectAG.ag" #-} rule65 = \ ((_lhsIext) :: Maybe String) _newAtts ((_nontsIppAI) :: [PP_Doc]) _o_noGroup -> {-# LINE 308 "src-ag/AG2AspectAG.ag" #-} let atts = filterNotAtts _newAtts _o_noGroup in (foldr (\a as -> attName a : as) [] atts) ++ (foldr (\a as -> attTName a : as) [] atts) ++ (case _lhsIext of Nothing -> [] otherwise -> [ attName "inh", attName "syn", attTName "inh", attTName "syn" ]) ++ _nontsIppAI {-# LINE 1008 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule66 #-} {-# LINE 318 "src-ag/AG2AspectAG.ag" #-} rule66 = \ _newAtts _o_noGroup -> {-# LINE 318 "src-ag/AG2AspectAG.ag" #-} let atts = filterNotAtts _newAtts _o_noGroup in (foldr (\a as -> ("nts_" >|< a) : as) [] atts) {-# LINE 1015 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule67 #-} {-# LINE 392 "src-ag/AG2AspectAG.ag" #-} rule67 = \ ((_nontsIppNtL) :: [(PP_Doc, Attributes)]) -> {-# LINE 392 "src-ag/AG2AspectAG.ag" #-} _nontsIppNtL {-# LINE 1021 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule68 #-} {-# LINE 393 "src-ag/AG2AspectAG.ag" #-} rule68 = \ _newAtts ((_nontsIppR) :: PP_Doc) _o_noGroup _ppNtL -> {-# LINE 393 "src-ag/AG2AspectAG.ag" #-} ntsList "group" _ppNtL >-< vlist (map (\att -> ntsList att (filterNts att _ppNtL )) (filterAtts _newAtts _o_noGroup )) >-< _nontsIppR {-# LINE 1029 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule69 #-} rule69 = \ ((_lhsIext) :: Maybe String) -> _lhsIext -- HsToken ----------------------------------------------------- -- wrapper data Inh_HsToken = Inh_HsToken { } data Syn_HsToken = Syn_HsToken { } {-# INLINABLE wrap_HsToken #-} wrap_HsToken :: T_HsToken -> Inh_HsToken -> (Syn_HsToken ) wrap_HsToken (T_HsToken act) (Inh_HsToken ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg13 = T_HsToken_vIn13 (T_HsToken_vOut13 ) <- return (inv_HsToken_s14 sem arg13) return (Syn_HsToken ) ) -- cata {-# NOINLINE sem_HsToken #-} sem_HsToken :: HsToken -> T_HsToken sem_HsToken ( AGLocal var_ pos_ rdesc_ ) = sem_HsToken_AGLocal var_ pos_ rdesc_ sem_HsToken ( AGField field_ attr_ pos_ rdesc_ ) = sem_HsToken_AGField field_ attr_ pos_ rdesc_ sem_HsToken ( HsToken value_ pos_ ) = sem_HsToken_HsToken value_ pos_ sem_HsToken ( CharToken value_ pos_ ) = sem_HsToken_CharToken value_ pos_ sem_HsToken ( StrToken value_ pos_ ) = sem_HsToken_StrToken value_ pos_ sem_HsToken ( Err mesg_ pos_ ) = sem_HsToken_Err mesg_ pos_ -- semantic domain newtype T_HsToken = T_HsToken { attach_T_HsToken :: Identity (T_HsToken_s14 ) } newtype T_HsToken_s14 = C_HsToken_s14 { inv_HsToken_s14 :: (T_HsToken_v13 ) } data T_HsToken_s15 = C_HsToken_s15 type T_HsToken_v13 = (T_HsToken_vIn13 ) -> (T_HsToken_vOut13 ) data T_HsToken_vIn13 = T_HsToken_vIn13 data T_HsToken_vOut13 = T_HsToken_vOut13 {-# NOINLINE sem_HsToken_AGLocal #-} sem_HsToken_AGLocal :: (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGLocal _ _ _ = T_HsToken (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_HsToken_v13 v13 = \ (T_HsToken_vIn13 ) -> ( let __result_ = T_HsToken_vOut13 in __result_ ) in C_HsToken_s14 v13 {-# NOINLINE sem_HsToken_AGField #-} sem_HsToken_AGField :: (Identifier) -> (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGField _ _ _ _ = T_HsToken (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_HsToken_v13 v13 = \ (T_HsToken_vIn13 ) -> ( let __result_ = T_HsToken_vOut13 in __result_ ) in C_HsToken_s14 v13 {-# NOINLINE sem_HsToken_HsToken #-} sem_HsToken_HsToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_HsToken _ _ = T_HsToken (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_HsToken_v13 v13 = \ (T_HsToken_vIn13 ) -> ( let __result_ = T_HsToken_vOut13 in __result_ ) in C_HsToken_s14 v13 {-# NOINLINE sem_HsToken_CharToken #-} sem_HsToken_CharToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_CharToken _ _ = T_HsToken (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_HsToken_v13 v13 = \ (T_HsToken_vIn13 ) -> ( let __result_ = T_HsToken_vOut13 in __result_ ) in C_HsToken_s14 v13 {-# NOINLINE sem_HsToken_StrToken #-} sem_HsToken_StrToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_StrToken _ _ = T_HsToken (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_HsToken_v13 v13 = \ (T_HsToken_vIn13 ) -> ( let __result_ = T_HsToken_vOut13 in __result_ ) in C_HsToken_s14 v13 {-# NOINLINE sem_HsToken_Err #-} sem_HsToken_Err :: (String) -> (Pos) -> T_HsToken sem_HsToken_Err _ _ = T_HsToken (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_HsToken_v13 v13 = \ (T_HsToken_vIn13 ) -> ( let __result_ = T_HsToken_vOut13 in __result_ ) in C_HsToken_s14 v13 -- HsTokens ---------------------------------------------------- -- wrapper data Inh_HsTokens = Inh_HsTokens { } data Syn_HsTokens = Syn_HsTokens { } {-# INLINABLE wrap_HsTokens #-} wrap_HsTokens :: T_HsTokens -> Inh_HsTokens -> (Syn_HsTokens ) wrap_HsTokens (T_HsTokens act) (Inh_HsTokens ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg16 = T_HsTokens_vIn16 (T_HsTokens_vOut16 ) <- return (inv_HsTokens_s17 sem arg16) return (Syn_HsTokens ) ) -- cata {-# NOINLINE sem_HsTokens #-} sem_HsTokens :: HsTokens -> T_HsTokens sem_HsTokens list = Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) -- semantic domain newtype T_HsTokens = T_HsTokens { attach_T_HsTokens :: Identity (T_HsTokens_s17 ) } newtype T_HsTokens_s17 = C_HsTokens_s17 { inv_HsTokens_s17 :: (T_HsTokens_v16 ) } data T_HsTokens_s18 = C_HsTokens_s18 type T_HsTokens_v16 = (T_HsTokens_vIn16 ) -> (T_HsTokens_vOut16 ) data T_HsTokens_vIn16 = T_HsTokens_vIn16 data T_HsTokens_vOut16 = T_HsTokens_vOut16 {-# NOINLINE sem_HsTokens_Cons #-} sem_HsTokens_Cons :: T_HsToken -> T_HsTokens -> T_HsTokens sem_HsTokens_Cons arg_hd_ arg_tl_ = T_HsTokens (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_HsTokens_v16 v16 = \ (T_HsTokens_vIn16 ) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_)) (T_HsToken_vOut13 ) = inv_HsToken_s14 _hdX14 (T_HsToken_vIn13 ) (T_HsTokens_vOut16 ) = inv_HsTokens_s17 _tlX17 (T_HsTokens_vIn16 ) __result_ = T_HsTokens_vOut16 in __result_ ) in C_HsTokens_s17 v16 {-# NOINLINE sem_HsTokens_Nil #-} sem_HsTokens_Nil :: T_HsTokens sem_HsTokens_Nil = T_HsTokens (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_HsTokens_v16 v16 = \ (T_HsTokens_vIn16 ) -> ( let __result_ = T_HsTokens_vOut16 in __result_ ) in C_HsTokens_s17 v16 -- HsTokensRoot ------------------------------------------------ -- wrapper data Inh_HsTokensRoot = Inh_HsTokensRoot { } data Syn_HsTokensRoot = Syn_HsTokensRoot { } {-# INLINABLE wrap_HsTokensRoot #-} wrap_HsTokensRoot :: T_HsTokensRoot -> Inh_HsTokensRoot -> (Syn_HsTokensRoot ) wrap_HsTokensRoot (T_HsTokensRoot act) (Inh_HsTokensRoot ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg19 = T_HsTokensRoot_vIn19 (T_HsTokensRoot_vOut19 ) <- return (inv_HsTokensRoot_s20 sem arg19) return (Syn_HsTokensRoot ) ) -- cata {-# INLINE sem_HsTokensRoot #-} sem_HsTokensRoot :: HsTokensRoot -> T_HsTokensRoot sem_HsTokensRoot ( HsTokensRoot tokens_ ) = sem_HsTokensRoot_HsTokensRoot ( sem_HsTokens tokens_ ) -- semantic domain newtype T_HsTokensRoot = T_HsTokensRoot { attach_T_HsTokensRoot :: Identity (T_HsTokensRoot_s20 ) } newtype T_HsTokensRoot_s20 = C_HsTokensRoot_s20 { inv_HsTokensRoot_s20 :: (T_HsTokensRoot_v19 ) } data T_HsTokensRoot_s21 = C_HsTokensRoot_s21 type T_HsTokensRoot_v19 = (T_HsTokensRoot_vIn19 ) -> (T_HsTokensRoot_vOut19 ) data T_HsTokensRoot_vIn19 = T_HsTokensRoot_vIn19 data T_HsTokensRoot_vOut19 = T_HsTokensRoot_vOut19 {-# NOINLINE sem_HsTokensRoot_HsTokensRoot #-} sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> T_HsTokensRoot sem_HsTokensRoot_HsTokensRoot arg_tokens_ = T_HsTokensRoot (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_HsTokensRoot_v19 v19 = \ (T_HsTokensRoot_vIn19 ) -> ( let _tokensX17 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tokens_)) (T_HsTokens_vOut16 ) = inv_HsTokens_s17 _tokensX17 (T_HsTokens_vIn16 ) __result_ = T_HsTokensRoot_vOut19 in __result_ ) in C_HsTokensRoot_s20 v19 -- Nonterminal ------------------------------------------------- -- wrapper data Inh_Nonterminal = Inh_Nonterminal { derivs_Inh_Nonterminal :: (Derivings), ext_Inh_Nonterminal :: (Maybe String), inhMap_Inh_Nonterminal :: (Map Identifier Attributes), newAtts_Inh_Nonterminal :: ( Attributes ), newNTs_Inh_Nonterminal :: (Set NontermIdent), newProds_Inh_Nonterminal :: ( DataTypes ), o_noGroup_Inh_Nonterminal :: ([String]), o_rename_Inh_Nonterminal :: (Bool), synMap_Inh_Nonterminal :: (Map Identifier Attributes), tSyns_Inh_Nonterminal :: (TypeSyns) } data Syn_Nonterminal = Syn_Nonterminal { extendedNTs_Syn_Nonterminal :: (Set NontermIdent), inhMap'_Syn_Nonterminal :: (Map Identifier Attributes), ppA_Syn_Nonterminal :: (PP_Doc), ppAI_Syn_Nonterminal :: ([PP_Doc]), ppCata_Syn_Nonterminal :: (PP_Doc), ppD_Syn_Nonterminal :: (PP_Doc), ppDI_Syn_Nonterminal :: ([PP_Doc]), ppL_Syn_Nonterminal :: (PP_Doc), ppLI_Syn_Nonterminal :: ([PP_Doc]), ppNtL_Syn_Nonterminal :: ([(PP_Doc, Attributes)]), ppR_Syn_Nonterminal :: (PP_Doc), ppSF_Syn_Nonterminal :: (PP_Doc), ppW_Syn_Nonterminal :: (PP_Doc), synMap'_Syn_Nonterminal :: (Map Identifier Attributes) } {-# INLINABLE wrap_Nonterminal #-} wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal ) wrap_Nonterminal (T_Nonterminal act) (Inh_Nonterminal _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) = Control.Monad.Identity.runIdentity ( do sem <- act let arg22 = T_Nonterminal_vIn22 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns (T_Nonterminal_vOut22 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap') <- return (inv_Nonterminal_s23 sem arg22) return (Syn_Nonterminal _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap') ) -- cata {-# INLINE sem_Nonterminal #-} sem_Nonterminal :: Nonterminal -> T_Nonterminal sem_Nonterminal ( Nonterminal nt_ params_ inh_ syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ ) -- semantic domain newtype T_Nonterminal = T_Nonterminal { attach_T_Nonterminal :: Identity (T_Nonterminal_s23 ) } newtype T_Nonterminal_s23 = C_Nonterminal_s23 { inv_Nonterminal_s23 :: (T_Nonterminal_v22 ) } data T_Nonterminal_s24 = C_Nonterminal_s24 type T_Nonterminal_v22 = (T_Nonterminal_vIn22 ) -> (T_Nonterminal_vOut22 ) data T_Nonterminal_vIn22 = T_Nonterminal_vIn22 (Derivings) (Maybe String) (Map Identifier Attributes) ( Attributes ) (Set NontermIdent) ( DataTypes ) ([String]) (Bool) (Map Identifier Attributes) (TypeSyns) data T_Nonterminal_vOut22 = T_Nonterminal_vOut22 (Set NontermIdent) (Map Identifier Attributes) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) ([(PP_Doc, Attributes)]) (PP_Doc) (PP_Doc) (PP_Doc) (Map Identifier Attributes) {-# NOINLINE sem_Nonterminal_Nonterminal #-} sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal sem_Nonterminal_Nonterminal arg_nt_ _ arg_inh_ arg_syn_ arg_prods_ = T_Nonterminal (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_Nonterminal_v22 v22 = \ (T_Nonterminal_vIn22 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) -> ( let _prodsX38 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) (T_Productions_vOut37 _prodsIhasMoreProds _prodsIppA _prodsIppCata _prodsIppDL _prodsIppL _prodsIppLI _prodsIppR _prodsIppRA _prodsIppSF _prodsIppSPF _prodsIprdInh) = inv_Productions_s38 _prodsX38 (T_Productions_vIn37 _prodsOext _prodsOinh _prodsOinhMap _prodsOinhNoGroup _prodsOnewAtts _prodsOnewNT _prodsOnewProds _prodsOo_noGroup _prodsOo_rename _prodsOppNt _prodsOsyn _prodsOsynMap _prodsOsynNoGroup) _lhsOinhMap' :: Map Identifier Attributes _lhsOinhMap' = rule70 arg_inh_ arg_nt_ _lhsOsynMap' :: Map Identifier Attributes _lhsOsynMap' = rule71 arg_nt_ arg_syn_ _inhNoGroup = rule72 _lhsIo_noGroup _prodsIprdInh _synNoGroup = rule73 _lhsIo_noGroup arg_syn_ _prodsOinhNoGroup = rule74 _inhNoGroup _prodsOsynNoGroup = rule75 _synNoGroup _prodsOnewProds = rule76 _lhsInewProds arg_nt_ _lhsOextendedNTs :: Set NontermIdent _lhsOextendedNTs = rule77 _prodsIhasMoreProds arg_nt_ _ppNt = rule78 arg_nt_ _prodsOppNt = rule79 _ppNt _lhsOppD :: PP_Doc _lhsOppD = rule80 _lhsIderivs _lhsInewNTs _lhsItSyns _ppNt _prodsIppDL arg_nt_ _lhsOppDI :: [PP_Doc] _lhsOppDI = rule81 _lhsInewNTs _ppNt arg_nt_ _ntLabel = rule82 _ppNt _lhsOppL :: PP_Doc _lhsOppL = rule83 _lhsInewNTs _ntLabel _ppNt _prodsIppL arg_nt_ _lhsOppLI :: [PP_Doc] _lhsOppLI = rule84 _lhsInewNTs _ntLabel _prodsIppLI arg_nt_ _lhsOppA :: PP_Doc _lhsOppA = rule85 _inhNoGroup _lhsInewNTs _ppNt _prodsIppA _synNoGroup arg_inh_ arg_nt_ arg_syn_ _lhsOppAI :: [PP_Doc] _lhsOppAI = rule86 _lhsInewNTs _ppNt arg_nt_ _lhsOppNtL :: [(PP_Doc, Attributes)] _lhsOppNtL = rule87 arg_inh_ arg_nt_ arg_syn_ _prodsOnewNT = rule88 _lhsInewNTs arg_nt_ _lhsOppR :: PP_Doc _lhsOppR = rule89 _prodsIppR arg_nt_ _lhsOppCata :: PP_Doc _lhsOppCata = rule90 _ppNt _prodsIppCata _prodsOsyn = rule91 arg_syn_ _prodsOinh = rule92 arg_inh_ _lhsOppSF :: PP_Doc _lhsOppSF = rule93 _inhNoGroup _ppNt _prodsIppSPF _synNoGroup _lhsOppW :: PP_Doc _lhsOppW = rule94 _inhNoGroup _ppNt arg_inh_ _prodsOext = rule95 _lhsIext _prodsOinhMap = rule96 _lhsIinhMap _prodsOnewAtts = rule97 _lhsInewAtts _prodsOo_noGroup = rule98 _lhsIo_noGroup _prodsOo_rename = rule99 _lhsIo_rename _prodsOsynMap = rule100 _lhsIsynMap __result_ = T_Nonterminal_vOut22 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap' in __result_ ) in C_Nonterminal_s23 v22 {-# INLINE rule70 #-} {-# LINE 7 "src-ag/DistChildAttr.ag" #-} rule70 = \ inh_ nt_ -> {-# LINE 7 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ inh_ {-# LINE 1320 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule71 #-} {-# LINE 8 "src-ag/DistChildAttr.ag" #-} rule71 = \ nt_ syn_ -> {-# LINE 8 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ syn_ {-# LINE 1326 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule72 #-} {-# LINE 51 "src-ag/AG2AspectAG.ag" #-} rule72 = \ ((_lhsIo_noGroup) :: [String]) ((_prodsIprdInh) :: Attributes) -> {-# LINE 51 "src-ag/AG2AspectAG.ag" #-} Map.filterWithKey (\att _ -> elem (getName att) _lhsIo_noGroup) _prodsIprdInh {-# LINE 1332 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule73 #-} {-# LINE 52 "src-ag/AG2AspectAG.ag" #-} rule73 = \ ((_lhsIo_noGroup) :: [String]) syn_ -> {-# LINE 52 "src-ag/AG2AspectAG.ag" #-} Map.filterWithKey (\att _ -> elem (getName att) _lhsIo_noGroup) syn_ {-# LINE 1338 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule74 #-} {-# LINE 57 "src-ag/AG2AspectAG.ag" #-} rule74 = \ _inhNoGroup -> {-# LINE 57 "src-ag/AG2AspectAG.ag" #-} map show $ Map.keys _inhNoGroup {-# LINE 1344 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule75 #-} {-# LINE 58 "src-ag/AG2AspectAG.ag" #-} rule75 = \ _synNoGroup -> {-# LINE 58 "src-ag/AG2AspectAG.ag" #-} map show $ Map.keys _synNoGroup {-# LINE 1350 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule76 #-} {-# LINE 94 "src-ag/AG2AspectAG.ag" #-} rule76 = \ ((_lhsInewProds) :: DataTypes ) nt_ -> {-# LINE 94 "src-ag/AG2AspectAG.ag" #-} case Map.lookup nt_ _lhsInewProds of Just prds -> prds Nothing -> Map.empty {-# LINE 1358 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule77 #-} {-# LINE 107 "src-ag/AG2AspectAG.ag" #-} rule77 = \ ((_prodsIhasMoreProds) :: Bool ) nt_ -> {-# LINE 107 "src-ag/AG2AspectAG.ag" #-} if _prodsIhasMoreProds then Set.singleton nt_ else Set.empty {-# LINE 1366 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule78 #-} {-# LINE 173 "src-ag/AG2AspectAG.ag" #-} rule78 = \ nt_ -> {-# LINE 173 "src-ag/AG2AspectAG.ag" #-} pp nt_ {-# LINE 1372 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule79 #-} {-# LINE 190 "src-ag/AG2AspectAG.ag" #-} rule79 = \ _ppNt -> {-# LINE 190 "src-ag/AG2AspectAG.ag" #-} _ppNt {-# LINE 1378 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule80 #-} {-# LINE 209 "src-ag/AG2AspectAG.ag" #-} rule80 = \ ((_lhsIderivs) :: Derivings) ((_lhsInewNTs) :: Set NontermIdent) ((_lhsItSyns) :: TypeSyns) _ppNt ((_prodsIppDL) :: [PP_Doc]) nt_ -> {-# LINE 209 "src-ag/AG2AspectAG.ag" #-} if (Set.member nt_ _lhsInewNTs) then case (lookup nt_ _lhsItSyns) of Nothing -> "data " >|< _ppNt >|< " = " >|< vlist_sep " | " _prodsIppDL >-< case (Map.lookup nt_ _lhsIderivs) of Just ntds -> pp " deriving " >|< (ppListSep "(" ")" ", " $ Set.elems ntds) Nothing -> empty Just tp -> "type " >|< _ppNt >|< " = " >|< ppShow tp else empty {-# LINE 1392 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule81 #-} {-# LINE 222 "src-ag/AG2AspectAG.ag" #-} rule81 = \ ((_lhsInewNTs) :: Set NontermIdent) _ppNt nt_ -> {-# LINE 222 "src-ag/AG2AspectAG.ag" #-} if (not $ Set.member nt_ _lhsInewNTs) then [ _ppNt ] else [ ] {-# LINE 1400 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule82 #-} {-# LINE 262 "src-ag/AG2AspectAG.ag" #-} rule82 = \ _ppNt -> {-# LINE 262 "src-ag/AG2AspectAG.ag" #-} "nt_" >|< _ppNt {-# LINE 1406 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule83 #-} {-# LINE 264 "src-ag/AG2AspectAG.ag" #-} rule83 = \ ((_lhsInewNTs) :: Set NontermIdent) _ntLabel _ppNt ((_prodsIppL) :: PP_Doc) nt_ -> {-# LINE 264 "src-ag/AG2AspectAG.ag" #-} ( if (Set.member nt_ _lhsInewNTs) then _ntLabel >|< " = proxy :: Proxy " >|< _ppNt else empty) >-< _prodsIppL {-# LINE 1415 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule84 #-} {-# LINE 269 "src-ag/AG2AspectAG.ag" #-} rule84 = \ ((_lhsInewNTs) :: Set NontermIdent) _ntLabel ((_prodsIppLI) :: [PP_Doc]) nt_ -> {-# LINE 269 "src-ag/AG2AspectAG.ag" #-} ( if (not $ Set.member nt_ _lhsInewNTs) then [ _ntLabel ] else [ ]) ++ _prodsIppLI {-# LINE 1424 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule85 #-} {-# LINE 324 "src-ag/AG2AspectAG.ag" #-} rule85 = \ _inhNoGroup ((_lhsInewNTs) :: Set NontermIdent) _ppNt ((_prodsIppA) :: PP_Doc) _synNoGroup inh_ nt_ syn_ -> {-# LINE 324 "src-ag/AG2AspectAG.ag" #-} ( if (Set.member nt_ _lhsInewNTs) then defAttRec (pp "InhG") _ppNt inh_ _inhNoGroup >-< defAttRec (pp "SynG") _ppNt syn_ _synNoGroup else empty) >-< _prodsIppA {-# LINE 1435 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule86 #-} {-# LINE 338 "src-ag/AG2AspectAG.ag" #-} rule86 = \ ((_lhsInewNTs) :: Set NontermIdent) _ppNt nt_ -> {-# LINE 338 "src-ag/AG2AspectAG.ag" #-} if (not $ Set.member nt_ _lhsInewNTs) then [ ppName [(pp "InhG"), _ppNt ] >#< pp "(..)", ppName [(pp "SynG"), _ppNt ] >#< pp "(..)" ] else [ ] {-# LINE 1443 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule87 #-} {-# LINE 406 "src-ag/AG2AspectAG.ag" #-} rule87 = \ inh_ nt_ syn_ -> {-# LINE 406 "src-ag/AG2AspectAG.ag" #-} [ ("nt_" >|< nt_, Map.union inh_ syn_) ] {-# LINE 1449 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule88 #-} {-# LINE 415 "src-ag/AG2AspectAG.ag" #-} rule88 = \ ((_lhsInewNTs) :: Set NontermIdent) nt_ -> {-# LINE 415 "src-ag/AG2AspectAG.ag" #-} Set.member nt_ _lhsInewNTs {-# LINE 1455 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule89 #-} {-# LINE 425 "src-ag/AG2AspectAG.ag" #-} rule89 = \ ((_prodsIppR) :: PP_Doc) nt_ -> {-# LINE 425 "src-ag/AG2AspectAG.ag" #-} pp "----" >|< pp nt_ >-< _prodsIppR {-# LINE 1461 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule90 #-} {-# LINE 735 "src-ag/AG2AspectAG.ag" #-} rule90 = \ _ppNt ((_prodsIppCata) :: PP_Doc) -> {-# LINE 735 "src-ag/AG2AspectAG.ag" #-} "----" >|< _ppNt >-< _prodsIppCata {-# LINE 1467 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule91 #-} {-# LINE 766 "src-ag/AG2AspectAG.ag" #-} rule91 = \ syn_ -> {-# LINE 766 "src-ag/AG2AspectAG.ag" #-} syn_ {-# LINE 1473 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule92 #-} {-# LINE 767 "src-ag/AG2AspectAG.ag" #-} rule92 = \ inh_ -> {-# LINE 767 "src-ag/AG2AspectAG.ag" #-} inh_ {-# LINE 1479 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule93 #-} {-# LINE 779 "src-ag/AG2AspectAG.ag" #-} rule93 = \ _inhNoGroup _ppNt ((_prodsIppSPF) :: PP_Doc) _synNoGroup -> {-# LINE 779 "src-ag/AG2AspectAG.ag" #-} let inhAtts = attTypes _inhNoGroup synAtts = attTypes _synNoGroup in "----" >|< _ppNt >-< "type T_" >|< _ppNt >|< " = " >|< "(Record " >|< inhAtts >|< "(HCons (LVPair (Proxy Att_inh) InhG_" >|< _ppNt >|< ") HNil))" >|< replicate (length inhAtts) ")" >|< " -> " >|< "(Record " >|< synAtts >|< "(HCons (LVPair (Proxy Att_syn) SynG_" >|< _ppNt >|< ") HNil))" >|< replicate (length synAtts) ")" >-< "-- instance SemType T_" >|< _ppNt >|< " " >|< _ppNt >-< "-- sem_" >|< _ppNt >|< " :: " >|< _ppNt >|< " -> T_" >|< _ppNt >-< _prodsIppSPF {-# LINE 1500 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule94 #-} {-# LINE 847 "src-ag/AG2AspectAG.ag" #-} rule94 = \ _inhNoGroup _ppNt inh_ -> {-# LINE 847 "src-ag/AG2AspectAG.ag" #-} ppName [pp "wrap", _ppNt ] >|< " sem " >|< attVars inh_ >|< " = " >-< " sem " >|< attFields inh_ _inhNoGroup _ppNt {-# LINE 1507 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule95 #-} rule95 = \ ((_lhsIext) :: Maybe String) -> _lhsIext {-# INLINE rule96 #-} rule96 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule97 #-} rule97 = \ ((_lhsInewAtts) :: Attributes ) -> _lhsInewAtts {-# INLINE rule98 #-} rule98 = \ ((_lhsIo_noGroup) :: [String]) -> _lhsIo_noGroup {-# INLINE rule99 #-} rule99 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule100 #-} rule100 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap -- Nonterminals ------------------------------------------------ -- wrapper data Inh_Nonterminals = Inh_Nonterminals { derivs_Inh_Nonterminals :: (Derivings), ext_Inh_Nonterminals :: (Maybe String), inhMap_Inh_Nonterminals :: (Map Identifier Attributes), newAtts_Inh_Nonterminals :: ( Attributes ), newNTs_Inh_Nonterminals :: (Set NontermIdent), newProds_Inh_Nonterminals :: ( DataTypes ), o_noGroup_Inh_Nonterminals :: ([String]), o_rename_Inh_Nonterminals :: (Bool), synMap_Inh_Nonterminals :: (Map Identifier Attributes), tSyns_Inh_Nonterminals :: (TypeSyns) } data Syn_Nonterminals = Syn_Nonterminals { extendedNTs_Syn_Nonterminals :: (Set NontermIdent), inhMap'_Syn_Nonterminals :: (Map Identifier Attributes), ppA_Syn_Nonterminals :: (PP_Doc), ppAI_Syn_Nonterminals :: ([PP_Doc]), ppCata_Syn_Nonterminals :: (PP_Doc), ppD_Syn_Nonterminals :: (PP_Doc), ppDI_Syn_Nonterminals :: ([PP_Doc]), ppL_Syn_Nonterminals :: (PP_Doc), ppLI_Syn_Nonterminals :: ([PP_Doc]), ppNtL_Syn_Nonterminals :: ([(PP_Doc, Attributes)]), ppR_Syn_Nonterminals :: (PP_Doc), ppSF_Syn_Nonterminals :: (PP_Doc), ppW_Syn_Nonterminals :: (PP_Doc), synMap'_Syn_Nonterminals :: (Map Identifier Attributes) } {-# INLINABLE wrap_Nonterminals #-} wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals ) wrap_Nonterminals (T_Nonterminals act) (Inh_Nonterminals _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) = Control.Monad.Identity.runIdentity ( do sem <- act let arg25 = T_Nonterminals_vIn25 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns (T_Nonterminals_vOut25 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap') <- return (inv_Nonterminals_s26 sem arg25) return (Syn_Nonterminals _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap') ) -- cata {-# NOINLINE sem_Nonterminals #-} sem_Nonterminals :: Nonterminals -> T_Nonterminals sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) -- semantic domain newtype T_Nonterminals = T_Nonterminals { attach_T_Nonterminals :: Identity (T_Nonterminals_s26 ) } newtype T_Nonterminals_s26 = C_Nonterminals_s26 { inv_Nonterminals_s26 :: (T_Nonterminals_v25 ) } data T_Nonterminals_s27 = C_Nonterminals_s27 type T_Nonterminals_v25 = (T_Nonterminals_vIn25 ) -> (T_Nonterminals_vOut25 ) data T_Nonterminals_vIn25 = T_Nonterminals_vIn25 (Derivings) (Maybe String) (Map Identifier Attributes) ( Attributes ) (Set NontermIdent) ( DataTypes ) ([String]) (Bool) (Map Identifier Attributes) (TypeSyns) data T_Nonterminals_vOut25 = T_Nonterminals_vOut25 (Set NontermIdent) (Map Identifier Attributes) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) ([(PP_Doc, Attributes)]) (PP_Doc) (PP_Doc) (PP_Doc) (Map Identifier Attributes) {-# NOINLINE sem_Nonterminals_Cons #-} sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_Nonterminals_v25 v25 = \ (T_Nonterminals_vIn25 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) -> ( let _hdX23 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) _tlX26 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) (T_Nonterminal_vOut22 _hdIextendedNTs _hdIinhMap' _hdIppA _hdIppAI _hdIppCata _hdIppD _hdIppDI _hdIppL _hdIppLI _hdIppNtL _hdIppR _hdIppSF _hdIppW _hdIsynMap') = inv_Nonterminal_s23 _hdX23 (T_Nonterminal_vIn22 _hdOderivs _hdOext _hdOinhMap _hdOnewAtts _hdOnewNTs _hdOnewProds _hdOo_noGroup _hdOo_rename _hdOsynMap _hdOtSyns) (T_Nonterminals_vOut25 _tlIextendedNTs _tlIinhMap' _tlIppA _tlIppAI _tlIppCata _tlIppD _tlIppDI _tlIppL _tlIppLI _tlIppNtL _tlIppR _tlIppSF _tlIppW _tlIsynMap') = inv_Nonterminals_s26 _tlX26 (T_Nonterminals_vIn25 _tlOderivs _tlOext _tlOinhMap _tlOnewAtts _tlOnewNTs _tlOnewProds _tlOo_noGroup _tlOo_rename _tlOsynMap _tlOtSyns) _lhsOextendedNTs :: Set NontermIdent _lhsOextendedNTs = rule101 _hdIextendedNTs _tlIextendedNTs _lhsOinhMap' :: Map Identifier Attributes _lhsOinhMap' = rule102 _hdIinhMap' _tlIinhMap' _lhsOppA :: PP_Doc _lhsOppA = rule103 _hdIppA _tlIppA _lhsOppAI :: [PP_Doc] _lhsOppAI = rule104 _hdIppAI _tlIppAI _lhsOppCata :: PP_Doc _lhsOppCata = rule105 _hdIppCata _tlIppCata _lhsOppD :: PP_Doc _lhsOppD = rule106 _hdIppD _tlIppD _lhsOppDI :: [PP_Doc] _lhsOppDI = rule107 _hdIppDI _tlIppDI _lhsOppL :: PP_Doc _lhsOppL = rule108 _hdIppL _tlIppL _lhsOppLI :: [PP_Doc] _lhsOppLI = rule109 _hdIppLI _tlIppLI _lhsOppNtL :: [(PP_Doc, Attributes)] _lhsOppNtL = rule110 _hdIppNtL _tlIppNtL _lhsOppR :: PP_Doc _lhsOppR = rule111 _hdIppR _tlIppR _lhsOppSF :: PP_Doc _lhsOppSF = rule112 _hdIppSF _tlIppSF _lhsOppW :: PP_Doc _lhsOppW = rule113 _hdIppW _tlIppW _lhsOsynMap' :: Map Identifier Attributes _lhsOsynMap' = rule114 _hdIsynMap' _tlIsynMap' _hdOderivs = rule115 _lhsIderivs _hdOext = rule116 _lhsIext _hdOinhMap = rule117 _lhsIinhMap _hdOnewAtts = rule118 _lhsInewAtts _hdOnewNTs = rule119 _lhsInewNTs _hdOnewProds = rule120 _lhsInewProds _hdOo_noGroup = rule121 _lhsIo_noGroup _hdOo_rename = rule122 _lhsIo_rename _hdOsynMap = rule123 _lhsIsynMap _hdOtSyns = rule124 _lhsItSyns _tlOderivs = rule125 _lhsIderivs _tlOext = rule126 _lhsIext _tlOinhMap = rule127 _lhsIinhMap _tlOnewAtts = rule128 _lhsInewAtts _tlOnewNTs = rule129 _lhsInewNTs _tlOnewProds = rule130 _lhsInewProds _tlOo_noGroup = rule131 _lhsIo_noGroup _tlOo_rename = rule132 _lhsIo_rename _tlOsynMap = rule133 _lhsIsynMap _tlOtSyns = rule134 _lhsItSyns __result_ = T_Nonterminals_vOut25 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap' in __result_ ) in C_Nonterminals_s26 v25 {-# INLINE rule101 #-} rule101 = \ ((_hdIextendedNTs) :: Set NontermIdent) ((_tlIextendedNTs) :: Set NontermIdent) -> _hdIextendedNTs `Set.union` _tlIextendedNTs {-# INLINE rule102 #-} rule102 = \ ((_hdIinhMap') :: Map Identifier Attributes) ((_tlIinhMap') :: Map Identifier Attributes) -> _hdIinhMap' `Map.union` _tlIinhMap' {-# INLINE rule103 #-} rule103 = \ ((_hdIppA) :: PP_Doc) ((_tlIppA) :: PP_Doc) -> _hdIppA >-< _tlIppA {-# INLINE rule104 #-} rule104 = \ ((_hdIppAI) :: [PP_Doc]) ((_tlIppAI) :: [PP_Doc]) -> _hdIppAI ++ _tlIppAI {-# INLINE rule105 #-} rule105 = \ ((_hdIppCata) :: PP_Doc) ((_tlIppCata) :: PP_Doc) -> _hdIppCata >-< _tlIppCata {-# INLINE rule106 #-} rule106 = \ ((_hdIppD) :: PP_Doc) ((_tlIppD) :: PP_Doc) -> _hdIppD >-< _tlIppD {-# INLINE rule107 #-} rule107 = \ ((_hdIppDI) :: [PP_Doc]) ((_tlIppDI) :: [PP_Doc]) -> _hdIppDI ++ _tlIppDI {-# INLINE rule108 #-} rule108 = \ ((_hdIppL) :: PP_Doc) ((_tlIppL) :: PP_Doc) -> _hdIppL >-< _tlIppL {-# INLINE rule109 #-} rule109 = \ ((_hdIppLI) :: [PP_Doc]) ((_tlIppLI) :: [PP_Doc]) -> _hdIppLI ++ _tlIppLI {-# INLINE rule110 #-} rule110 = \ ((_hdIppNtL) :: [(PP_Doc, Attributes)]) ((_tlIppNtL) :: [(PP_Doc, Attributes)]) -> _hdIppNtL ++ _tlIppNtL {-# INLINE rule111 #-} rule111 = \ ((_hdIppR) :: PP_Doc) ((_tlIppR) :: PP_Doc) -> _hdIppR >-< _tlIppR {-# INLINE rule112 #-} rule112 = \ ((_hdIppSF) :: PP_Doc) ((_tlIppSF) :: PP_Doc) -> _hdIppSF >-< _tlIppSF {-# INLINE rule113 #-} rule113 = \ ((_hdIppW) :: PP_Doc) ((_tlIppW) :: PP_Doc) -> _hdIppW >-< _tlIppW {-# INLINE rule114 #-} rule114 = \ ((_hdIsynMap') :: Map Identifier Attributes) ((_tlIsynMap') :: Map Identifier Attributes) -> _hdIsynMap' `Map.union` _tlIsynMap' {-# INLINE rule115 #-} rule115 = \ ((_lhsIderivs) :: Derivings) -> _lhsIderivs {-# INLINE rule116 #-} rule116 = \ ((_lhsIext) :: Maybe String) -> _lhsIext {-# INLINE rule117 #-} rule117 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule118 #-} rule118 = \ ((_lhsInewAtts) :: Attributes ) -> _lhsInewAtts {-# INLINE rule119 #-} rule119 = \ ((_lhsInewNTs) :: Set NontermIdent) -> _lhsInewNTs {-# INLINE rule120 #-} rule120 = \ ((_lhsInewProds) :: DataTypes ) -> _lhsInewProds {-# INLINE rule121 #-} rule121 = \ ((_lhsIo_noGroup) :: [String]) -> _lhsIo_noGroup {-# INLINE rule122 #-} rule122 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule123 #-} rule123 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule124 #-} rule124 = \ ((_lhsItSyns) :: TypeSyns) -> _lhsItSyns {-# INLINE rule125 #-} rule125 = \ ((_lhsIderivs) :: Derivings) -> _lhsIderivs {-# INLINE rule126 #-} rule126 = \ ((_lhsIext) :: Maybe String) -> _lhsIext {-# INLINE rule127 #-} rule127 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule128 #-} rule128 = \ ((_lhsInewAtts) :: Attributes ) -> _lhsInewAtts {-# INLINE rule129 #-} rule129 = \ ((_lhsInewNTs) :: Set NontermIdent) -> _lhsInewNTs {-# INLINE rule130 #-} rule130 = \ ((_lhsInewProds) :: DataTypes ) -> _lhsInewProds {-# INLINE rule131 #-} rule131 = \ ((_lhsIo_noGroup) :: [String]) -> _lhsIo_noGroup {-# INLINE rule132 #-} rule132 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule133 #-} rule133 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule134 #-} rule134 = \ ((_lhsItSyns) :: TypeSyns) -> _lhsItSyns {-# NOINLINE sem_Nonterminals_Nil #-} sem_Nonterminals_Nil :: T_Nonterminals sem_Nonterminals_Nil = T_Nonterminals (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_Nonterminals_v25 v25 = \ (T_Nonterminals_vIn25 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) -> ( let _lhsOextendedNTs :: Set NontermIdent _lhsOextendedNTs = rule135 () _lhsOinhMap' :: Map Identifier Attributes _lhsOinhMap' = rule136 () _lhsOppA :: PP_Doc _lhsOppA = rule137 () _lhsOppAI :: [PP_Doc] _lhsOppAI = rule138 () _lhsOppCata :: PP_Doc _lhsOppCata = rule139 () _lhsOppD :: PP_Doc _lhsOppD = rule140 () _lhsOppDI :: [PP_Doc] _lhsOppDI = rule141 () _lhsOppL :: PP_Doc _lhsOppL = rule142 () _lhsOppLI :: [PP_Doc] _lhsOppLI = rule143 () _lhsOppNtL :: [(PP_Doc, Attributes)] _lhsOppNtL = rule144 () _lhsOppR :: PP_Doc _lhsOppR = rule145 () _lhsOppSF :: PP_Doc _lhsOppSF = rule146 () _lhsOppW :: PP_Doc _lhsOppW = rule147 () _lhsOsynMap' :: Map Identifier Attributes _lhsOsynMap' = rule148 () __result_ = T_Nonterminals_vOut25 _lhsOextendedNTs _lhsOinhMap' _lhsOppA _lhsOppAI _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppNtL _lhsOppR _lhsOppSF _lhsOppW _lhsOsynMap' in __result_ ) in C_Nonterminals_s26 v25 {-# INLINE rule135 #-} rule135 = \ (_ :: ()) -> Set.empty {-# INLINE rule136 #-} rule136 = \ (_ :: ()) -> Map.empty {-# INLINE rule137 #-} rule137 = \ (_ :: ()) -> empty {-# INLINE rule138 #-} rule138 = \ (_ :: ()) -> [] {-# INLINE rule139 #-} rule139 = \ (_ :: ()) -> empty {-# INLINE rule140 #-} rule140 = \ (_ :: ()) -> empty {-# INLINE rule141 #-} rule141 = \ (_ :: ()) -> [] {-# INLINE rule142 #-} rule142 = \ (_ :: ()) -> empty {-# INLINE rule143 #-} rule143 = \ (_ :: ()) -> [] {-# INLINE rule144 #-} rule144 = \ (_ :: ()) -> [] {-# INLINE rule145 #-} rule145 = \ (_ :: ()) -> empty {-# INLINE rule146 #-} rule146 = \ (_ :: ()) -> empty {-# INLINE rule147 #-} rule147 = \ (_ :: ()) -> empty {-# INLINE rule148 #-} rule148 = \ (_ :: ()) -> Map.empty -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { } data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), info_Syn_Pattern :: ((Identifier, Identifier)) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg28 = T_Pattern_vIn28 (T_Pattern_vOut28 _lhsOcopy _lhsOinfo) <- return (inv_Pattern_s29 sem arg28) return (Syn_Pattern _lhsOcopy _lhsOinfo) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s29 ) } newtype T_Pattern_s29 = C_Pattern_s29 { inv_Pattern_s29 :: (T_Pattern_v28 ) } data T_Pattern_s30 = C_Pattern_s30 type T_Pattern_v28 = (T_Pattern_vIn28 ) -> (T_Pattern_vOut28 ) data T_Pattern_vIn28 = T_Pattern_vIn28 data T_Pattern_vOut28 = T_Pattern_vOut28 (Pattern) ((Identifier, Identifier)) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Pattern_v28 v28 = \ (T_Pattern_vIn28 ) -> ( let _patsX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut31 _patsIcopy) = inv_Patterns_s32 _patsX32 (T_Patterns_vIn31 ) _lhsOinfo :: (Identifier, Identifier) _lhsOinfo = rule149 () _copy = rule150 _patsIcopy arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule151 _copy __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo in __result_ ) in C_Pattern_s29 v28 {-# INLINE rule149 #-} {-# LINE 383 "src-ag/AG2AspectAG.ag" #-} rule149 = \ (_ :: ()) -> {-# LINE 383 "src-ag/AG2AspectAG.ag" #-} error "Pattern Constr undefined!!" {-# LINE 1858 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule150 #-} rule150 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule151 #-} rule151 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Pattern_v28 v28 = \ (T_Pattern_vIn28 ) -> ( let _patsX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut31 _patsIcopy) = inv_Patterns_s32 _patsX32 (T_Patterns_vIn31 ) _lhsOinfo :: (Identifier, Identifier) _lhsOinfo = rule152 () _copy = rule153 _patsIcopy arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule154 _copy __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo in __result_ ) in C_Pattern_s29 v28 {-# INLINE rule152 #-} {-# LINE 384 "src-ag/AG2AspectAG.ag" #-} rule152 = \ (_ :: ()) -> {-# LINE 384 "src-ag/AG2AspectAG.ag" #-} error "Pattern Product undefined!!" {-# LINE 1887 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule153 #-} rule153 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule154 #-} rule154 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Pattern_v28 v28 = \ (T_Pattern_vIn28 ) -> ( let _patX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut28 _patIcopy _patIinfo) = inv_Pattern_s29 _patX29 (T_Pattern_vIn28 ) _lhsOinfo :: (Identifier, Identifier) _lhsOinfo = rule155 arg_attr_ arg_field_ _copy = rule156 _patIcopy arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule157 _copy __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo in __result_ ) in C_Pattern_s29 v28 {-# INLINE rule155 #-} {-# LINE 382 "src-ag/AG2AspectAG.ag" #-} rule155 = \ attr_ field_ -> {-# LINE 382 "src-ag/AG2AspectAG.ag" #-} (field_, attr_) {-# LINE 1916 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule156 #-} rule156 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule157 #-} rule157 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Pattern_v28 v28 = \ (T_Pattern_vIn28 ) -> ( let _patX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut28 _patIcopy _patIinfo) = inv_Pattern_s29 _patX29 (T_Pattern_vIn28 ) _copy = rule158 _patIcopy _lhsOcopy :: Pattern _lhsOcopy = rule159 _copy _lhsOinfo :: (Identifier, Identifier) _lhsOinfo = rule160 _patIinfo __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo in __result_ ) in C_Pattern_s29 v28 {-# INLINE rule158 #-} rule158 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule159 #-} rule159 = \ _copy -> _copy {-# INLINE rule160 #-} rule160 = \ ((_patIinfo) :: (Identifier, Identifier)) -> _patIinfo {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore arg_pos_ = T_Pattern (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Pattern_v28 v28 = \ (T_Pattern_vIn28 ) -> ( let _lhsOinfo :: (Identifier, Identifier) _lhsOinfo = rule161 () _copy = rule162 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule163 _copy __result_ = T_Pattern_vOut28 _lhsOcopy _lhsOinfo in __result_ ) in C_Pattern_s29 v28 {-# INLINE rule161 #-} {-# LINE 385 "src-ag/AG2AspectAG.ag" #-} rule161 = \ (_ :: ()) -> {-# LINE 385 "src-ag/AG2AspectAG.ag" #-} error "Pattern Underscore undefined!!" {-# LINE 1969 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule162 #-} rule162 = \ pos_ -> Underscore pos_ {-# INLINE rule163 #-} rule163 = \ _copy -> _copy -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { } data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg31 = T_Patterns_vIn31 (T_Patterns_vOut31 _lhsOcopy) <- return (inv_Patterns_s32 sem arg31) return (Syn_Patterns _lhsOcopy) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s32 ) } newtype T_Patterns_s32 = C_Patterns_s32 { inv_Patterns_s32 :: (T_Patterns_v31 ) } data T_Patterns_s33 = C_Patterns_s33 type T_Patterns_v31 = (T_Patterns_vIn31 ) -> (T_Patterns_vOut31 ) data T_Patterns_vIn31 = T_Patterns_vIn31 data T_Patterns_vOut31 = T_Patterns_vOut31 (Patterns) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_Patterns_v31 v31 = \ (T_Patterns_vIn31 ) -> ( let _hdX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut28 _hdIcopy _hdIinfo) = inv_Pattern_s29 _hdX29 (T_Pattern_vIn28 ) (T_Patterns_vOut31 _tlIcopy) = inv_Patterns_s32 _tlX32 (T_Patterns_vIn31 ) _copy = rule164 _hdIcopy _tlIcopy _lhsOcopy :: Patterns _lhsOcopy = rule165 _copy __result_ = T_Patterns_vOut31 _lhsOcopy in __result_ ) in C_Patterns_s32 v31 {-# INLINE rule164 #-} rule164 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule165 #-} rule165 = \ _copy -> _copy {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_Patterns_v31 v31 = \ (T_Patterns_vIn31 ) -> ( let _copy = rule166 () _lhsOcopy :: Patterns _lhsOcopy = rule167 _copy __result_ = T_Patterns_vOut31 _lhsOcopy in __result_ ) in C_Patterns_s32 v31 {-# INLINE rule166 #-} rule166 = \ (_ :: ()) -> [] {-# INLINE rule167 #-} rule167 = \ _copy -> _copy -- Production -------------------------------------------------- -- wrapper data Inh_Production = Inh_Production { ext_Inh_Production :: (Maybe String), inh_Inh_Production :: ( Attributes ), inhMap_Inh_Production :: (Map Identifier Attributes), inhNoGroup_Inh_Production :: ([String]), newAtts_Inh_Production :: ( Attributes ), newNT_Inh_Production :: (Bool), newProds_Inh_Production :: ( Map.Map ConstructorIdent FieldMap ), o_noGroup_Inh_Production :: ([String]), o_rename_Inh_Production :: (Bool), ppNt_Inh_Production :: (PP_Doc), syn_Inh_Production :: ( Attributes ), synMap_Inh_Production :: (Map Identifier Attributes), synNoGroup_Inh_Production :: ([String]) } data Syn_Production = Syn_Production { hasMoreProds_Syn_Production :: ( Bool ), ppA_Syn_Production :: (PP_Doc), ppCata_Syn_Production :: (PP_Doc), ppD_Syn_Production :: (PP_Doc), ppDI_Syn_Production :: ([PP_Doc]), ppL_Syn_Production :: (PP_Doc), ppLI_Syn_Production :: ([PP_Doc]), ppR_Syn_Production :: (PP_Doc), ppRA_Syn_Production :: ([PP_Doc]), ppSF_Syn_Production :: (PP_Doc), ppSPF_Syn_Production :: (PP_Doc), prdInh_Syn_Production :: (Attributes) } {-# INLINABLE wrap_Production #-} wrap_Production :: T_Production -> Inh_Production -> (Syn_Production ) wrap_Production (T_Production act) (Inh_Production _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) = Control.Monad.Identity.runIdentity ( do sem <- act let arg34 = T_Production_vIn34 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup (T_Production_vOut34 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh) <- return (inv_Production_s35 sem arg34) return (Syn_Production _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh) ) -- cata {-# INLINE sem_Production #-} sem_Production :: Production -> T_Production sem_Production ( Production con_ params_ constraints_ children_ rules_ typeSigs_ macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_ -- semantic domain newtype T_Production = T_Production { attach_T_Production :: Identity (T_Production_s35 ) } newtype T_Production_s35 = C_Production_s35 { inv_Production_s35 :: (T_Production_v34 ) } data T_Production_s36 = C_Production_s36 type T_Production_v34 = (T_Production_vIn34 ) -> (T_Production_vOut34 ) data T_Production_vIn34 = T_Production_vIn34 (Maybe String) ( Attributes ) (Map Identifier Attributes) ([String]) ( Attributes ) (Bool) ( Map.Map ConstructorIdent FieldMap ) ([String]) (Bool) (PP_Doc) ( Attributes ) (Map Identifier Attributes) ([String]) data T_Production_vOut34 = T_Production_vOut34 ( Bool ) (PP_Doc) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) (Attributes) {-# NOINLINE sem_Production_Production #-} sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production sem_Production_Production arg_con_ _ _ arg_children_ arg_rules_ arg_typeSigs_ arg_macro_ = T_Production (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Production_v34 v34 = \ (T_Production_vIn34 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) -> ( let _childrenX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) _rulesX44 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) _typeSigsX50 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) (T_Children_vOut4 _childrenIidCL _childrenIppCSF _childrenIppDL _childrenIppL _childrenIppLI _childrenIppR _childrenIprdInh) = inv_Children_s5 _childrenX5 (T_Children_vIn4 _childrenOext _childrenOinhMap _childrenOinhNoGroup _childrenOnewAtts _childrenOo_noGroup _childrenOo_rename _childrenOppNt _childrenOppProd _childrenOsynMap _childrenOsynNoGroup) (T_Rules_vOut43 _rulesIlocals _rulesIppRL) = inv_Rules_s44 _rulesX44 (T_Rules_vIn43 _rulesOext _rulesOinhNoGroup _rulesOnewAtts _rulesOnewProd _rulesOo_noGroup _rulesOppNt _rulesOppProd _rulesOsynNoGroup) (T_TypeSigs_vOut49 ) = inv_TypeSigs_s50 _typeSigsX50 (T_TypeSigs_vIn49 ) _lhsOhasMoreProds :: Bool _lhsOhasMoreProds = rule168 _lhsInewProds arg_con_ _ppProd = rule169 arg_con_ _prodName = rule170 _lhsIppNt _ppProd _conName = rule171 _lhsIo_rename _ppProd _prodName _childrenOppProd = rule172 _ppProd _rulesOppProd = rule173 _ppProd _lhsOppD :: PP_Doc _lhsOppD = rule174 _childrenIppDL _conName _lhsOppL :: PP_Doc _lhsOppL = rule175 _childrenIppL _lhsInewProds arg_con_ _lhsOppLI :: [PP_Doc] _lhsOppLI = rule176 _childrenIppLI _lhsInewProds arg_con_ _lhsOppA :: PP_Doc _lhsOppA = rule177 _prodName _rulesIlocals _newProd = rule178 _lhsInewProds arg_con_ (_ppR,_ppRA) = rule179 _childrenIidCL _childrenIppR _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsIppNt _lhsIsynNoGroup _newProd _prodName _rulesIlocals _rulesIppRL arg_con_ _lhsOppCata :: PP_Doc _lhsOppCata = rule180 _lhsIext _lhsInewNT _newProd _ppRA _prodName arg_macro_ _lhsOppSF :: PP_Doc _lhsOppSF = rule181 _childrenIppCSF _conName _lhsIppNt _prodName arg_con_ _lhsOppSPF :: PP_Doc _lhsOppSPF = rule182 _childrenIppCSF _lhsIppNt _prodName arg_con_ _lhsOppDI :: [PP_Doc] _lhsOppDI = rule183 () _lhsOppR :: PP_Doc _lhsOppR = rule184 _ppR _lhsOppRA :: [PP_Doc] _lhsOppRA = rule185 _ppRA _lhsOprdInh :: Attributes _lhsOprdInh = rule186 _childrenIprdInh _childrenOext = rule187 _lhsIext _childrenOinhMap = rule188 _lhsIinhMap _childrenOinhNoGroup = rule189 _lhsIinhNoGroup _childrenOnewAtts = rule190 _lhsInewAtts _childrenOo_noGroup = rule191 _lhsIo_noGroup _childrenOo_rename = rule192 _lhsIo_rename _childrenOppNt = rule193 _lhsIppNt _childrenOsynMap = rule194 _lhsIsynMap _childrenOsynNoGroup = rule195 _lhsIsynNoGroup _rulesOext = rule196 _lhsIext _rulesOinhNoGroup = rule197 _lhsIinhNoGroup _rulesOnewAtts = rule198 _lhsInewAtts _rulesOnewProd = rule199 _newProd _rulesOo_noGroup = rule200 _lhsIo_noGroup _rulesOppNt = rule201 _lhsIppNt _rulesOsynNoGroup = rule202 _lhsIsynNoGroup __result_ = T_Production_vOut34 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppD _lhsOppDI _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh in __result_ ) in C_Production_s35 v34 {-# INLINE rule168 #-} {-# LINE 103 "src-ag/AG2AspectAG.ag" #-} rule168 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ -> {-# LINE 103 "src-ag/AG2AspectAG.ag" #-} not $ Map.member con_ _lhsInewProds {-# LINE 2148 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule169 #-} {-# LINE 176 "src-ag/AG2AspectAG.ag" #-} rule169 = \ con_ -> {-# LINE 176 "src-ag/AG2AspectAG.ag" #-} pp con_ {-# LINE 2154 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule170 #-} {-# LINE 177 "src-ag/AG2AspectAG.ag" #-} rule170 = \ ((_lhsIppNt) :: PP_Doc) _ppProd -> {-# LINE 177 "src-ag/AG2AspectAG.ag" #-} ppName [_lhsIppNt, _ppProd ] {-# LINE 2160 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule171 #-} {-# LINE 178 "src-ag/AG2AspectAG.ag" #-} rule171 = \ ((_lhsIo_rename) :: Bool) _ppProd _prodName -> {-# LINE 178 "src-ag/AG2AspectAG.ag" #-} if _lhsIo_rename then _prodName else _ppProd {-# LINE 2168 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule172 #-} {-# LINE 195 "src-ag/AG2AspectAG.ag" #-} rule172 = \ _ppProd -> {-# LINE 195 "src-ag/AG2AspectAG.ag" #-} _ppProd {-# LINE 2174 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule173 #-} {-# LINE 196 "src-ag/AG2AspectAG.ag" #-} rule173 = \ _ppProd -> {-# LINE 196 "src-ag/AG2AspectAG.ag" #-} _ppProd {-# LINE 2180 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule174 #-} {-# LINE 228 "src-ag/AG2AspectAG.ag" #-} rule174 = \ ((_childrenIppDL) :: [PP_Doc]) _conName -> {-# LINE 228 "src-ag/AG2AspectAG.ag" #-} _conName >|< ppListSep " {" "}" ", " _childrenIppDL {-# LINE 2186 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule175 #-} {-# LINE 275 "src-ag/AG2AspectAG.ag" #-} rule175 = \ ((_childrenIppL) :: PP_Doc) ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ -> {-# LINE 275 "src-ag/AG2AspectAG.ag" #-} if (Map.member con_ _lhsInewProds) then _childrenIppL else empty {-# LINE 2194 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule176 #-} {-# LINE 279 "src-ag/AG2AspectAG.ag" #-} rule176 = \ ((_childrenIppLI) :: [PP_Doc]) ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ -> {-# LINE 279 "src-ag/AG2AspectAG.ag" #-} if (not $ Map.member con_ _lhsInewProds) then _childrenIppLI else [] {-# LINE 2202 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule177 #-} {-# LINE 332 "src-ag/AG2AspectAG.ag" #-} rule177 = \ _prodName ((_rulesIlocals) :: [Identifier]) -> {-# LINE 332 "src-ag/AG2AspectAG.ag" #-} defLocalAtts _prodName (length _rulesIlocals) 1 $ sort _rulesIlocals {-# LINE 2208 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule178 #-} {-# LINE 428 "src-ag/AG2AspectAG.ag" #-} rule178 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ -> {-# LINE 428 "src-ag/AG2AspectAG.ag" #-} Map.member con_ _lhsInewProds {-# LINE 2214 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule179 #-} {-# LINE 430 "src-ag/AG2AspectAG.ag" #-} rule179 = \ ((_childrenIidCL) :: [(Identifier,Type)]) ((_childrenIppR) :: PP_Doc) ((_lhsIinhNoGroup) :: [String]) ((_lhsInewAtts) :: Attributes ) ((_lhsInewNT) :: Bool) ((_lhsIppNt) :: PP_Doc) ((_lhsIsynNoGroup) :: [String]) _newProd _prodName ((_rulesIlocals) :: [Identifier]) ((_rulesIppRL) :: [ PPRule ]) con_ -> {-# LINE 430 "src-ag/AG2AspectAG.ag" #-} let (instR, instRA) = defInstRules _lhsIppNt con_ _lhsInewNT _newProd _childrenIppR _rulesIppRL _childrenIidCL _rulesIlocals (locR, locRA) = defLocRule _lhsIppNt con_ _lhsInewNT _newProd _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals (inhGR, inhGRA) = defInhGRule _lhsIppNt _prodName _lhsInewNT _newProd _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals (synGR, synGRA) = defSynGRule _lhsIppNt con_ _lhsInewNT _newProd _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals (inhR, inhRA) = defInhRules _lhsIppNt _prodName _lhsInewNT _newProd _lhsInewAtts _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals (synR, synRA) = defSynRules _lhsIppNt con_ _lhsInewNT _newProd _lhsInewAtts _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals (inhMR, inhMRA) = modInhRules _lhsIppNt _prodName _lhsInewNT _newProd _lhsInewAtts _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals (synMR, synMRA) = modSynRules _lhsIppNt con_ _lhsInewNT _newProd _lhsInewAtts _childrenIppR _rulesIppRL _lhsIinhNoGroup _lhsIsynNoGroup _childrenIidCL _rulesIlocals in ( vlist [instR,locR,inhGR,synGR,inhR,synR,inhMR,synMR] , instRA ++ locRA ++ inhGRA ++ synGRA ++ inhMRA ++ synMRA ++ inhRA ++ synRA) {-# LINE 2237 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule180 #-} {-# LINE 740 "src-ag/AG2AspectAG.ag" #-} rule180 = \ ((_lhsIext) :: Maybe String) ((_lhsInewNT) :: Bool) _newProd _ppRA _prodName macro_ -> {-# LINE 740 "src-ag/AG2AspectAG.ag" #-} let extend = maybe [] ( \ext -> if (_lhsInewNT || (not _lhsInewNT && _newProd )) then [] else [ ext >|< ".atts_" >|< _prodName ]) _lhsIext macro = case macro_ of Nothing -> [] Just macro -> [ "agMacro " >|< ppMacro macro ] atts = sortBy (\a b -> compare (show a) (show b)) _ppRA in "atts_" >|< _prodName >|< " = " >|< ppListSep "" "" " `ext` " (atts ++ macro ++ extend ) >-< "semP_" >|< _prodName >|< pp " = knit atts_" >|< _prodName {-# LINE 2255 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule181 #-} {-# LINE 804 "src-ag/AG2AspectAG.ag" #-} rule181 = \ ((_childrenIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) _conName ((_lhsIppNt) :: PP_Doc) _prodName con_ -> {-# LINE 804 "src-ag/AG2AspectAG.ag" #-} let chi = _childrenIppCSF ppPattern = case (show con_) of "Cons" -> ppParams (ppListSep "" "" " : ") "Nil" -> pp "[]" otherwise -> _conName >|< " " >|< (ppParams ppSpaced) ppParams f = f $ map (((>|<) (pp "_")) . fst) chi in "sem_" >|< _lhsIppNt >|< " (" >|< ppPattern >|< ") = sem_" >|< _prodName >|< " (" >|< map (fst . snd) chi >|< "emptyRecord)" {-# LINE 2268 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule182 #-} {-# LINE 816 "src-ag/AG2AspectAG.ag" #-} rule182 = \ ((_childrenIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) ((_lhsIppNt) :: PP_Doc) _prodName con_ -> {-# LINE 816 "src-ag/AG2AspectAG.ag" #-} let chi = _childrenIppCSF ppParams f = f $ map (((>|<) (pp "_")) . fst) chi in "sem_" >|< _lhsIppNt >|< "_" >|< con_ >#< ppParams ppSpaced >|< " = semP_" >|< _prodName >|< " (" >|< map (snd . snd) chi >|< "emptyRecord)" {-# LINE 2277 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule183 #-} rule183 = \ (_ :: ()) -> [] {-# INLINE rule184 #-} rule184 = \ _ppR -> _ppR {-# INLINE rule185 #-} rule185 = \ _ppRA -> _ppRA {-# INLINE rule186 #-} rule186 = \ ((_childrenIprdInh) :: Attributes) -> _childrenIprdInh {-# INLINE rule187 #-} rule187 = \ ((_lhsIext) :: Maybe String) -> _lhsIext {-# INLINE rule188 #-} rule188 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule189 #-} rule189 = \ ((_lhsIinhNoGroup) :: [String]) -> _lhsIinhNoGroup {-# INLINE rule190 #-} rule190 = \ ((_lhsInewAtts) :: Attributes ) -> _lhsInewAtts {-# INLINE rule191 #-} rule191 = \ ((_lhsIo_noGroup) :: [String]) -> _lhsIo_noGroup {-# INLINE rule192 #-} rule192 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule193 #-} rule193 = \ ((_lhsIppNt) :: PP_Doc) -> _lhsIppNt {-# INLINE rule194 #-} rule194 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule195 #-} rule195 = \ ((_lhsIsynNoGroup) :: [String]) -> _lhsIsynNoGroup {-# INLINE rule196 #-} rule196 = \ ((_lhsIext) :: Maybe String) -> _lhsIext {-# INLINE rule197 #-} rule197 = \ ((_lhsIinhNoGroup) :: [String]) -> _lhsIinhNoGroup {-# INLINE rule198 #-} rule198 = \ ((_lhsInewAtts) :: Attributes ) -> _lhsInewAtts {-# INLINE rule199 #-} rule199 = \ _newProd -> _newProd {-# INLINE rule200 #-} rule200 = \ ((_lhsIo_noGroup) :: [String]) -> _lhsIo_noGroup {-# INLINE rule201 #-} rule201 = \ ((_lhsIppNt) :: PP_Doc) -> _lhsIppNt {-# INLINE rule202 #-} rule202 = \ ((_lhsIsynNoGroup) :: [String]) -> _lhsIsynNoGroup -- Productions ------------------------------------------------- -- wrapper data Inh_Productions = Inh_Productions { ext_Inh_Productions :: (Maybe String), inh_Inh_Productions :: ( Attributes ), inhMap_Inh_Productions :: (Map Identifier Attributes), inhNoGroup_Inh_Productions :: ([String]), newAtts_Inh_Productions :: ( Attributes ), newNT_Inh_Productions :: (Bool), newProds_Inh_Productions :: ( Map.Map ConstructorIdent FieldMap ), o_noGroup_Inh_Productions :: ([String]), o_rename_Inh_Productions :: (Bool), ppNt_Inh_Productions :: (PP_Doc), syn_Inh_Productions :: ( Attributes ), synMap_Inh_Productions :: (Map Identifier Attributes), synNoGroup_Inh_Productions :: ([String]) } data Syn_Productions = Syn_Productions { hasMoreProds_Syn_Productions :: ( Bool ), ppA_Syn_Productions :: (PP_Doc), ppCata_Syn_Productions :: (PP_Doc), ppDL_Syn_Productions :: ([PP_Doc]), ppL_Syn_Productions :: (PP_Doc), ppLI_Syn_Productions :: ([PP_Doc]), ppR_Syn_Productions :: (PP_Doc), ppRA_Syn_Productions :: ([PP_Doc]), ppSF_Syn_Productions :: (PP_Doc), ppSPF_Syn_Productions :: (PP_Doc), prdInh_Syn_Productions :: (Attributes) } {-# INLINABLE wrap_Productions #-} wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions ) wrap_Productions (T_Productions act) (Inh_Productions _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) = Control.Monad.Identity.runIdentity ( do sem <- act let arg37 = T_Productions_vIn37 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup (T_Productions_vOut37 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh) <- return (inv_Productions_s38 sem arg37) return (Syn_Productions _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh) ) -- cata {-# NOINLINE sem_Productions #-} sem_Productions :: Productions -> T_Productions sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) -- semantic domain newtype T_Productions = T_Productions { attach_T_Productions :: Identity (T_Productions_s38 ) } newtype T_Productions_s38 = C_Productions_s38 { inv_Productions_s38 :: (T_Productions_v37 ) } data T_Productions_s39 = C_Productions_s39 type T_Productions_v37 = (T_Productions_vIn37 ) -> (T_Productions_vOut37 ) data T_Productions_vIn37 = T_Productions_vIn37 (Maybe String) ( Attributes ) (Map Identifier Attributes) ([String]) ( Attributes ) (Bool) ( Map.Map ConstructorIdent FieldMap ) ([String]) (Bool) (PP_Doc) ( Attributes ) (Map Identifier Attributes) ([String]) data T_Productions_vOut37 = T_Productions_vOut37 ( Bool ) (PP_Doc) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) ([PP_Doc]) (PP_Doc) (PP_Doc) (Attributes) {-# NOINLINE sem_Productions_Cons #-} sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_Productions_v37 v37 = \ (T_Productions_vIn37 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) -> ( let _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) (T_Production_vOut34 _hdIhasMoreProds _hdIppA _hdIppCata _hdIppD _hdIppDI _hdIppL _hdIppLI _hdIppR _hdIppRA _hdIppSF _hdIppSPF _hdIprdInh) = inv_Production_s35 _hdX35 (T_Production_vIn34 _hdOext _hdOinh _hdOinhMap _hdOinhNoGroup _hdOnewAtts _hdOnewNT _hdOnewProds _hdOo_noGroup _hdOo_rename _hdOppNt _hdOsyn _hdOsynMap _hdOsynNoGroup) (T_Productions_vOut37 _tlIhasMoreProds _tlIppA _tlIppCata _tlIppDL _tlIppL _tlIppLI _tlIppR _tlIppRA _tlIppSF _tlIppSPF _tlIprdInh) = inv_Productions_s38 _tlX38 (T_Productions_vIn37 _tlOext _tlOinh _tlOinhMap _tlOinhNoGroup _tlOnewAtts _tlOnewNT _tlOnewProds _tlOo_noGroup _tlOo_rename _tlOppNt _tlOsyn _tlOsynMap _tlOsynNoGroup) _hdOinhNoGroup = rule203 _hdIprdInh _lhsIinhNoGroup _lhsOppDL :: [PP_Doc] _lhsOppDL = rule204 _hdIppD _tlIppDL _lhsOhasMoreProds :: Bool _lhsOhasMoreProds = rule205 _hdIhasMoreProds _tlIhasMoreProds _lhsOppA :: PP_Doc _lhsOppA = rule206 _hdIppA _tlIppA _lhsOppCata :: PP_Doc _lhsOppCata = rule207 _hdIppCata _tlIppCata _lhsOppL :: PP_Doc _lhsOppL = rule208 _hdIppL _tlIppL _lhsOppLI :: [PP_Doc] _lhsOppLI = rule209 _hdIppLI _tlIppLI _lhsOppR :: PP_Doc _lhsOppR = rule210 _hdIppR _tlIppR _lhsOppRA :: [PP_Doc] _lhsOppRA = rule211 _hdIppRA _tlIppRA _lhsOppSF :: PP_Doc _lhsOppSF = rule212 _hdIppSF _tlIppSF _lhsOppSPF :: PP_Doc _lhsOppSPF = rule213 _hdIppSPF _tlIppSPF _lhsOprdInh :: Attributes _lhsOprdInh = rule214 _hdIprdInh _tlIprdInh _hdOext = rule215 _lhsIext _hdOinh = rule216 _lhsIinh _hdOinhMap = rule217 _lhsIinhMap _hdOnewAtts = rule218 _lhsInewAtts _hdOnewNT = rule219 _lhsInewNT _hdOnewProds = rule220 _lhsInewProds _hdOo_noGroup = rule221 _lhsIo_noGroup _hdOo_rename = rule222 _lhsIo_rename _hdOppNt = rule223 _lhsIppNt _hdOsyn = rule224 _lhsIsyn _hdOsynMap = rule225 _lhsIsynMap _hdOsynNoGroup = rule226 _lhsIsynNoGroup _tlOext = rule227 _lhsIext _tlOinh = rule228 _lhsIinh _tlOinhMap = rule229 _lhsIinhMap _tlOinhNoGroup = rule230 _lhsIinhNoGroup _tlOnewAtts = rule231 _lhsInewAtts _tlOnewNT = rule232 _lhsInewNT _tlOnewProds = rule233 _lhsInewProds _tlOo_noGroup = rule234 _lhsIo_noGroup _tlOo_rename = rule235 _lhsIo_rename _tlOppNt = rule236 _lhsIppNt _tlOsyn = rule237 _lhsIsyn _tlOsynMap = rule238 _lhsIsynMap _tlOsynNoGroup = rule239 _lhsIsynNoGroup __result_ = T_Productions_vOut37 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh in __result_ ) in C_Productions_s38 v37 {-# INLINE rule203 #-} {-# LINE 62 "src-ag/AG2AspectAG.ag" #-} rule203 = \ ((_hdIprdInh) :: Attributes) ((_lhsIinhNoGroup) :: [String]) -> {-# LINE 62 "src-ag/AG2AspectAG.ag" #-} filter (flip Map.member _hdIprdInh . identifier) _lhsIinhNoGroup {-# LINE 2436 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule204 #-} {-# LINE 234 "src-ag/AG2AspectAG.ag" #-} rule204 = \ ((_hdIppD) :: PP_Doc) ((_tlIppDL) :: [PP_Doc]) -> {-# LINE 234 "src-ag/AG2AspectAG.ag" #-} _hdIppD : _tlIppDL {-# LINE 2442 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule205 #-} rule205 = \ ((_hdIhasMoreProds) :: Bool ) ((_tlIhasMoreProds) :: Bool ) -> _hdIhasMoreProds || _tlIhasMoreProds {-# INLINE rule206 #-} rule206 = \ ((_hdIppA) :: PP_Doc) ((_tlIppA) :: PP_Doc) -> _hdIppA >-< _tlIppA {-# INLINE rule207 #-} rule207 = \ ((_hdIppCata) :: PP_Doc) ((_tlIppCata) :: PP_Doc) -> _hdIppCata >-< _tlIppCata {-# INLINE rule208 #-} rule208 = \ ((_hdIppL) :: PP_Doc) ((_tlIppL) :: PP_Doc) -> _hdIppL >-< _tlIppL {-# INLINE rule209 #-} rule209 = \ ((_hdIppLI) :: [PP_Doc]) ((_tlIppLI) :: [PP_Doc]) -> _hdIppLI ++ _tlIppLI {-# INLINE rule210 #-} rule210 = \ ((_hdIppR) :: PP_Doc) ((_tlIppR) :: PP_Doc) -> _hdIppR >-< _tlIppR {-# INLINE rule211 #-} rule211 = \ ((_hdIppRA) :: [PP_Doc]) ((_tlIppRA) :: [PP_Doc]) -> _hdIppRA ++ _tlIppRA {-# INLINE rule212 #-} rule212 = \ ((_hdIppSF) :: PP_Doc) ((_tlIppSF) :: PP_Doc) -> _hdIppSF >-< _tlIppSF {-# INLINE rule213 #-} rule213 = \ ((_hdIppSPF) :: PP_Doc) ((_tlIppSPF) :: PP_Doc) -> _hdIppSPF >-< _tlIppSPF {-# INLINE rule214 #-} rule214 = \ ((_hdIprdInh) :: Attributes) ((_tlIprdInh) :: Attributes) -> _hdIprdInh `Map.union` _tlIprdInh {-# INLINE rule215 #-} rule215 = \ ((_lhsIext) :: Maybe String) -> _lhsIext {-# INLINE rule216 #-} rule216 = \ ((_lhsIinh) :: Attributes ) -> _lhsIinh {-# INLINE rule217 #-} rule217 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule218 #-} rule218 = \ ((_lhsInewAtts) :: Attributes ) -> _lhsInewAtts {-# INLINE rule219 #-} rule219 = \ ((_lhsInewNT) :: Bool) -> _lhsInewNT {-# INLINE rule220 #-} rule220 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) -> _lhsInewProds {-# INLINE rule221 #-} rule221 = \ ((_lhsIo_noGroup) :: [String]) -> _lhsIo_noGroup {-# INLINE rule222 #-} rule222 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule223 #-} rule223 = \ ((_lhsIppNt) :: PP_Doc) -> _lhsIppNt {-# INLINE rule224 #-} rule224 = \ ((_lhsIsyn) :: Attributes ) -> _lhsIsyn {-# INLINE rule225 #-} rule225 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule226 #-} rule226 = \ ((_lhsIsynNoGroup) :: [String]) -> _lhsIsynNoGroup {-# INLINE rule227 #-} rule227 = \ ((_lhsIext) :: Maybe String) -> _lhsIext {-# INLINE rule228 #-} rule228 = \ ((_lhsIinh) :: Attributes ) -> _lhsIinh {-# INLINE rule229 #-} rule229 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule230 #-} rule230 = \ ((_lhsIinhNoGroup) :: [String]) -> _lhsIinhNoGroup {-# INLINE rule231 #-} rule231 = \ ((_lhsInewAtts) :: Attributes ) -> _lhsInewAtts {-# INLINE rule232 #-} rule232 = \ ((_lhsInewNT) :: Bool) -> _lhsInewNT {-# INLINE rule233 #-} rule233 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) -> _lhsInewProds {-# INLINE rule234 #-} rule234 = \ ((_lhsIo_noGroup) :: [String]) -> _lhsIo_noGroup {-# INLINE rule235 #-} rule235 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule236 #-} rule236 = \ ((_lhsIppNt) :: PP_Doc) -> _lhsIppNt {-# INLINE rule237 #-} rule237 = \ ((_lhsIsyn) :: Attributes ) -> _lhsIsyn {-# INLINE rule238 #-} rule238 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule239 #-} rule239 = \ ((_lhsIsynNoGroup) :: [String]) -> _lhsIsynNoGroup {-# NOINLINE sem_Productions_Nil #-} sem_Productions_Nil :: T_Productions sem_Productions_Nil = T_Productions (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_Productions_v37 v37 = \ (T_Productions_vIn37 _lhsIext _lhsIinh _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsInewNT _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIsyn _lhsIsynMap _lhsIsynNoGroup) -> ( let _lhsOppDL :: [PP_Doc] _lhsOppDL = rule240 () _lhsOhasMoreProds :: Bool _lhsOhasMoreProds = rule241 () _lhsOppA :: PP_Doc _lhsOppA = rule242 () _lhsOppCata :: PP_Doc _lhsOppCata = rule243 () _lhsOppL :: PP_Doc _lhsOppL = rule244 () _lhsOppLI :: [PP_Doc] _lhsOppLI = rule245 () _lhsOppR :: PP_Doc _lhsOppR = rule246 () _lhsOppRA :: [PP_Doc] _lhsOppRA = rule247 () _lhsOppSF :: PP_Doc _lhsOppSF = rule248 () _lhsOppSPF :: PP_Doc _lhsOppSPF = rule249 () _lhsOprdInh :: Attributes _lhsOprdInh = rule250 () __result_ = T_Productions_vOut37 _lhsOhasMoreProds _lhsOppA _lhsOppCata _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOppRA _lhsOppSF _lhsOppSPF _lhsOprdInh in __result_ ) in C_Productions_s38 v37 {-# INLINE rule240 #-} {-# LINE 235 "src-ag/AG2AspectAG.ag" #-} rule240 = \ (_ :: ()) -> {-# LINE 235 "src-ag/AG2AspectAG.ag" #-} [] {-# LINE 2585 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule241 #-} rule241 = \ (_ :: ()) -> False {-# INLINE rule242 #-} rule242 = \ (_ :: ()) -> empty {-# INLINE rule243 #-} rule243 = \ (_ :: ()) -> empty {-# INLINE rule244 #-} rule244 = \ (_ :: ()) -> empty {-# INLINE rule245 #-} rule245 = \ (_ :: ()) -> [] {-# INLINE rule246 #-} rule246 = \ (_ :: ()) -> empty {-# INLINE rule247 #-} rule247 = \ (_ :: ()) -> [] {-# INLINE rule248 #-} rule248 = \ (_ :: ()) -> empty {-# INLINE rule249 #-} rule249 = \ (_ :: ()) -> empty {-# INLINE rule250 #-} rule250 = \ (_ :: ()) -> Map.empty -- Rule -------------------------------------------------------- -- wrapper data Inh_Rule = Inh_Rule { ext_Inh_Rule :: (Maybe String), inhNoGroup_Inh_Rule :: ([String]), newAtts_Inh_Rule :: ( Attributes ), newProd_Inh_Rule :: (Bool), o_noGroup_Inh_Rule :: ([String]), ppNt_Inh_Rule :: (PP_Doc), ppProd_Inh_Rule :: (PP_Doc), synNoGroup_Inh_Rule :: ([String]) } data Syn_Rule = Syn_Rule { locals_Syn_Rule :: ([Identifier]), ppRL_Syn_Rule :: ([ PPRule ]) } {-# INLINABLE wrap_Rule #-} wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule ) wrap_Rule (T_Rule act) (Inh_Rule _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) = Control.Monad.Identity.runIdentity ( do sem <- act let arg40 = T_Rule_vIn40 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup (T_Rule_vOut40 _lhsOlocals _lhsOppRL) <- return (inv_Rule_s41 sem arg40) return (Syn_Rule _lhsOlocals _lhsOppRL) ) -- cata {-# INLINE sem_Rule #-} sem_Rule :: Rule -> T_Rule sem_Rule ( Rule mbName_ pattern_ rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ -- semantic domain newtype T_Rule = T_Rule { attach_T_Rule :: Identity (T_Rule_s41 ) } newtype T_Rule_s41 = C_Rule_s41 { inv_Rule_s41 :: (T_Rule_v40 ) } data T_Rule_s42 = C_Rule_s42 type T_Rule_v40 = (T_Rule_vIn40 ) -> (T_Rule_vOut40 ) data T_Rule_vIn40 = T_Rule_vIn40 (Maybe String) ([String]) ( Attributes ) (Bool) ([String]) (PP_Doc) (PP_Doc) ([String]) data T_Rule_vOut40 = T_Rule_vOut40 ([Identifier]) ([ PPRule ]) {-# NOINLINE sem_Rule_Rule #-} sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule sem_Rule_Rule _ arg_pattern_ arg_rhs_ arg_owrt_ _ arg_explicit_ _ _ _ _ = T_Rule (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Rule_v40 v40 = \ (T_Rule_vIn40 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) -> ( let _patternX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) _rhsX8 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) (T_Pattern_vOut28 _patternIcopy _patternIinfo) = inv_Pattern_s29 _patternX29 (T_Pattern_vIn28 ) (T_Expression_vOut7 _rhsIppRE) = inv_Expression_s8 _rhsX8 (T_Expression_vIn7 _rhsOppNt _rhsOppProd) _lhsOlocals :: [Identifier] _lhsOlocals = rule251 _patternIinfo _lhsOppRL :: [ PPRule ] _lhsOppRL = rule252 _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _patternIinfo _rhsIppRE arg_explicit_ arg_owrt_ _rhsOppNt = rule253 _lhsIppNt _rhsOppProd = rule254 _lhsIppProd __result_ = T_Rule_vOut40 _lhsOlocals _lhsOppRL in __result_ ) in C_Rule_s41 v40 {-# INLINE rule251 #-} {-# LINE 375 "src-ag/AG2AspectAG.ag" #-} rule251 = \ ((_patternIinfo) :: (Identifier, Identifier)) -> {-# LINE 375 "src-ag/AG2AspectAG.ag" #-} if (show (fst _patternIinfo) == "loc") then [ snd _patternIinfo ] else [ ] {-# LINE 2674 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule252 #-} {-# LINE 472 "src-ag/AG2AspectAG.ag" #-} rule252 = \ ((_lhsInewAtts) :: Attributes ) ((_lhsInewProd) :: Bool) ((_lhsIo_noGroup) :: [String]) ((_lhsIppNt) :: PP_Doc) ((_patternIinfo) :: (Identifier, Identifier)) ((_rhsIppRE) :: [String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc) explicit_ owrt_ -> {-# LINE 472 "src-ag/AG2AspectAG.ag" #-} if (not explicit_ && not _lhsInewProd && not (Map.member (snd _patternIinfo) _lhsInewAtts) ) then [] else [ ppRule _patternIinfo owrt_ (defRule _lhsIppNt _patternIinfo _lhsIo_noGroup _rhsIppRE) ] {-# LINE 2682 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule253 #-} rule253 = \ ((_lhsIppNt) :: PP_Doc) -> _lhsIppNt {-# INLINE rule254 #-} rule254 = \ ((_lhsIppProd) :: PP_Doc) -> _lhsIppProd -- Rules ------------------------------------------------------- -- wrapper data Inh_Rules = Inh_Rules { ext_Inh_Rules :: (Maybe String), inhNoGroup_Inh_Rules :: ([String]), newAtts_Inh_Rules :: ( Attributes ), newProd_Inh_Rules :: (Bool), o_noGroup_Inh_Rules :: ([String]), ppNt_Inh_Rules :: (PP_Doc), ppProd_Inh_Rules :: (PP_Doc), synNoGroup_Inh_Rules :: ([String]) } data Syn_Rules = Syn_Rules { locals_Syn_Rules :: ([Identifier]), ppRL_Syn_Rules :: ([ PPRule ]) } {-# INLINABLE wrap_Rules #-} wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules ) wrap_Rules (T_Rules act) (Inh_Rules _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) = Control.Monad.Identity.runIdentity ( do sem <- act let arg43 = T_Rules_vIn43 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup (T_Rules_vOut43 _lhsOlocals _lhsOppRL) <- return (inv_Rules_s44 sem arg43) return (Syn_Rules _lhsOlocals _lhsOppRL) ) -- cata {-# NOINLINE sem_Rules #-} sem_Rules :: Rules -> T_Rules sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) -- semantic domain newtype T_Rules = T_Rules { attach_T_Rules :: Identity (T_Rules_s44 ) } newtype T_Rules_s44 = C_Rules_s44 { inv_Rules_s44 :: (T_Rules_v43 ) } data T_Rules_s45 = C_Rules_s45 type T_Rules_v43 = (T_Rules_vIn43 ) -> (T_Rules_vOut43 ) data T_Rules_vIn43 = T_Rules_vIn43 (Maybe String) ([String]) ( Attributes ) (Bool) ([String]) (PP_Doc) (PP_Doc) ([String]) data T_Rules_vOut43 = T_Rules_vOut43 ([Identifier]) ([ PPRule ]) {-# NOINLINE sem_Rules_Cons #-} sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_Rules_v43 v43 = \ (T_Rules_vIn43 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) -> ( let _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) (T_Rule_vOut40 _hdIlocals _hdIppRL) = inv_Rule_s41 _hdX41 (T_Rule_vIn40 _hdOext _hdOinhNoGroup _hdOnewAtts _hdOnewProd _hdOo_noGroup _hdOppNt _hdOppProd _hdOsynNoGroup) (T_Rules_vOut43 _tlIlocals _tlIppRL) = inv_Rules_s44 _tlX44 (T_Rules_vIn43 _tlOext _tlOinhNoGroup _tlOnewAtts _tlOnewProd _tlOo_noGroup _tlOppNt _tlOppProd _tlOsynNoGroup) _lhsOppRL :: [ PPRule ] _lhsOppRL = rule255 _hdIppRL _tlIppRL _lhsOlocals :: [Identifier] _lhsOlocals = rule256 _hdIlocals _tlIlocals _hdOext = rule257 _lhsIext _hdOinhNoGroup = rule258 _lhsIinhNoGroup _hdOnewAtts = rule259 _lhsInewAtts _hdOnewProd = rule260 _lhsInewProd _hdOo_noGroup = rule261 _lhsIo_noGroup _hdOppNt = rule262 _lhsIppNt _hdOppProd = rule263 _lhsIppProd _hdOsynNoGroup = rule264 _lhsIsynNoGroup _tlOext = rule265 _lhsIext _tlOinhNoGroup = rule266 _lhsIinhNoGroup _tlOnewAtts = rule267 _lhsInewAtts _tlOnewProd = rule268 _lhsInewProd _tlOo_noGroup = rule269 _lhsIo_noGroup _tlOppNt = rule270 _lhsIppNt _tlOppProd = rule271 _lhsIppProd _tlOsynNoGroup = rule272 _lhsIsynNoGroup __result_ = T_Rules_vOut43 _lhsOlocals _lhsOppRL in __result_ ) in C_Rules_s44 v43 {-# INLINE rule255 #-} {-# LINE 468 "src-ag/AG2AspectAG.ag" #-} rule255 = \ ((_hdIppRL) :: [ PPRule ]) ((_tlIppRL) :: [ PPRule ]) -> {-# LINE 468 "src-ag/AG2AspectAG.ag" #-} _hdIppRL ++ _tlIppRL {-# LINE 2759 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule256 #-} rule256 = \ ((_hdIlocals) :: [Identifier]) ((_tlIlocals) :: [Identifier]) -> _hdIlocals ++ _tlIlocals {-# INLINE rule257 #-} rule257 = \ ((_lhsIext) :: Maybe String) -> _lhsIext {-# INLINE rule258 #-} rule258 = \ ((_lhsIinhNoGroup) :: [String]) -> _lhsIinhNoGroup {-# INLINE rule259 #-} rule259 = \ ((_lhsInewAtts) :: Attributes ) -> _lhsInewAtts {-# INLINE rule260 #-} rule260 = \ ((_lhsInewProd) :: Bool) -> _lhsInewProd {-# INLINE rule261 #-} rule261 = \ ((_lhsIo_noGroup) :: [String]) -> _lhsIo_noGroup {-# INLINE rule262 #-} rule262 = \ ((_lhsIppNt) :: PP_Doc) -> _lhsIppNt {-# INLINE rule263 #-} rule263 = \ ((_lhsIppProd) :: PP_Doc) -> _lhsIppProd {-# INLINE rule264 #-} rule264 = \ ((_lhsIsynNoGroup) :: [String]) -> _lhsIsynNoGroup {-# INLINE rule265 #-} rule265 = \ ((_lhsIext) :: Maybe String) -> _lhsIext {-# INLINE rule266 #-} rule266 = \ ((_lhsIinhNoGroup) :: [String]) -> _lhsIinhNoGroup {-# INLINE rule267 #-} rule267 = \ ((_lhsInewAtts) :: Attributes ) -> _lhsInewAtts {-# INLINE rule268 #-} rule268 = \ ((_lhsInewProd) :: Bool) -> _lhsInewProd {-# INLINE rule269 #-} rule269 = \ ((_lhsIo_noGroup) :: [String]) -> _lhsIo_noGroup {-# INLINE rule270 #-} rule270 = \ ((_lhsIppNt) :: PP_Doc) -> _lhsIppNt {-# INLINE rule271 #-} rule271 = \ ((_lhsIppProd) :: PP_Doc) -> _lhsIppProd {-# INLINE rule272 #-} rule272 = \ ((_lhsIsynNoGroup) :: [String]) -> _lhsIsynNoGroup {-# NOINLINE sem_Rules_Nil #-} sem_Rules_Nil :: T_Rules sem_Rules_Nil = T_Rules (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_Rules_v43 v43 = \ (T_Rules_vIn43 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) -> ( let _lhsOppRL :: [ PPRule ] _lhsOppRL = rule273 () _lhsOlocals :: [Identifier] _lhsOlocals = rule274 () __result_ = T_Rules_vOut43 _lhsOlocals _lhsOppRL in __result_ ) in C_Rules_s44 v43 {-# INLINE rule273 #-} {-# LINE 469 "src-ag/AG2AspectAG.ag" #-} rule273 = \ (_ :: ()) -> {-# LINE 469 "src-ag/AG2AspectAG.ag" #-} [] {-# LINE 2830 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule274 #-} rule274 = \ (_ :: ()) -> [] -- TypeSig ----------------------------------------------------- -- wrapper data Inh_TypeSig = Inh_TypeSig { } data Syn_TypeSig = Syn_TypeSig { } {-# INLINABLE wrap_TypeSig #-} wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig ) wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg46 = T_TypeSig_vIn46 (T_TypeSig_vOut46 ) <- return (inv_TypeSig_s47 sem arg46) return (Syn_TypeSig ) ) -- cata {-# INLINE sem_TypeSig #-} sem_TypeSig :: TypeSig -> T_TypeSig sem_TypeSig ( TypeSig name_ tp_ ) = sem_TypeSig_TypeSig name_ tp_ -- semantic domain newtype T_TypeSig = T_TypeSig { attach_T_TypeSig :: Identity (T_TypeSig_s47 ) } newtype T_TypeSig_s47 = C_TypeSig_s47 { inv_TypeSig_s47 :: (T_TypeSig_v46 ) } data T_TypeSig_s48 = C_TypeSig_s48 type T_TypeSig_v46 = (T_TypeSig_vIn46 ) -> (T_TypeSig_vOut46 ) data T_TypeSig_vIn46 = T_TypeSig_vIn46 data T_TypeSig_vOut46 = T_TypeSig_vOut46 {-# NOINLINE sem_TypeSig_TypeSig #-} sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig sem_TypeSig_TypeSig _ _ = T_TypeSig (return st47) where {-# NOINLINE st47 #-} st47 = let v46 :: T_TypeSig_v46 v46 = \ (T_TypeSig_vIn46 ) -> ( let __result_ = T_TypeSig_vOut46 in __result_ ) in C_TypeSig_s47 v46 -- TypeSigs ---------------------------------------------------- -- wrapper data Inh_TypeSigs = Inh_TypeSigs { } data Syn_TypeSigs = Syn_TypeSigs { } {-# INLINABLE wrap_TypeSigs #-} wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs ) wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg49 = T_TypeSigs_vIn49 (T_TypeSigs_vOut49 ) <- return (inv_TypeSigs_s50 sem arg49) return (Syn_TypeSigs ) ) -- cata {-# NOINLINE sem_TypeSigs #-} sem_TypeSigs :: TypeSigs -> T_TypeSigs sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) -- semantic domain newtype T_TypeSigs = T_TypeSigs { attach_T_TypeSigs :: Identity (T_TypeSigs_s50 ) } newtype T_TypeSigs_s50 = C_TypeSigs_s50 { inv_TypeSigs_s50 :: (T_TypeSigs_v49 ) } data T_TypeSigs_s51 = C_TypeSigs_s51 type T_TypeSigs_v49 = (T_TypeSigs_vIn49 ) -> (T_TypeSigs_vOut49 ) data T_TypeSigs_vIn49 = T_TypeSigs_vIn49 data T_TypeSigs_vOut49 = T_TypeSigs_vOut49 {-# NOINLINE sem_TypeSigs_Cons #-} sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_TypeSigs_v49 v49 = \ (T_TypeSigs_vIn49 ) -> ( let _hdX47 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_)) _tlX50 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_)) (T_TypeSig_vOut46 ) = inv_TypeSig_s47 _hdX47 (T_TypeSig_vIn46 ) (T_TypeSigs_vOut49 ) = inv_TypeSigs_s50 _tlX50 (T_TypeSigs_vIn49 ) __result_ = T_TypeSigs_vOut49 in __result_ ) in C_TypeSigs_s50 v49 {-# NOINLINE sem_TypeSigs_Nil #-} sem_TypeSigs_Nil :: T_TypeSigs sem_TypeSigs_Nil = T_TypeSigs (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_TypeSigs_v49 v49 = \ (T_TypeSigs_vIn49 ) -> ( let __result_ = T_TypeSigs_vOut49 in __result_ ) in C_TypeSigs_s50 v49 uuagc-0.9.52.2/src-generated/Code.hs0000644000000000000000000002736613433540502015207 0ustar0000000000000000 -- UUAGC 0.9.51 (src-ag/Code.ag) module Code where {-# LINE 2 "src-ag/Code.ag" #-} import Patterns import Data.Set(Set) import qualified Data.Set as Set import Data.Map(Map) import qualified Data.Map as Map {-# LINE 13 "dist/build/Code.hs" #-} {-# LINE 146 "src-ag/Code.ag" #-} -- Unboxed tuples -- unbox Whether unboxed tuples are wanted or not -- inh The inherited attributes. -- If there are none, no unboxing can take place, -- because in that case the semantic function (a top-level identifier) would have an unboxed type. -- Of course we can't have an unboxed 1-tuple mkTupleExpr :: Bool -> Bool -> Exprs -> Expr mkTupleExpr unbox' noInh exprs | not unbox' || noInh || length exprs == 1 = TupleExpr exprs | otherwise = UnboxedTupleExpr exprs mkTupleType :: Bool -> Bool -> Types -> Type mkTupleType unbox' noInh tps | not unbox' || noInh || length tps == 1 = TupleType tps | otherwise = UnboxedTupleType tps mkTupleLhs :: Bool -> Bool -> [String] -> Lhs mkTupleLhs unbox' noInh comps | not unbox' || noInh || length comps == 1 = TupleLhs comps | otherwise = UnboxedTupleLhs comps {-# LINE 31 "dist/build/Code.hs" #-} -- CaseAlt ----------------------------------------------------- {- alternatives: alternative CaseAlt: child left : Lhs child expr : Expr -} data CaseAlt = CaseAlt (Lhs) (Expr) -- CaseAlts ---------------------------------------------------- {- alternatives: alternative Cons: child hd : CaseAlt child tl : CaseAlts alternative Nil: -} type CaseAlts = [CaseAlt] -- Chunk ------------------------------------------------------- {- alternatives: alternative Chunk: child name : {String} child comment : Decl child info : Decls child dataDef : Decls child cataFun : Decls child semDom : Decls child semWrapper : Decls child semFunctions : Decls child semNames : {[String]} -} data Chunk = Chunk (String) (Decl) (Decls) (Decls) (Decls) (Decls) (Decls) (Decls) (([String])) -- Chunks ------------------------------------------------------ {- alternatives: alternative Cons: child hd : Chunk child tl : Chunks alternative Nil: -} type Chunks = [Chunk] -- DataAlt ----------------------------------------------------- {- alternatives: alternative DataAlt: child name : {String} child args : Types alternative Record: child name : {String} child args : NamedTypes -} data DataAlt = DataAlt (String) (Types) | Record (String) (NamedTypes) -- DataAlts ---------------------------------------------------- {- alternatives: alternative Cons: child hd : DataAlt child tl : DataAlts alternative Nil: -} type DataAlts = [DataAlt] -- Decl -------------------------------------------------------- {- alternatives: alternative Decl: child left : Lhs child rhs : Expr child binds : {Set String} child uses : {Set String} alternative Bind: child left : Lhs child rhs : Expr alternative BindLet: child left : Lhs child rhs : Expr alternative Data: child name : {String} child params : {[String]} child alts : DataAlts child strict : {Bool} child derivings : {[String]} alternative NewType: child name : {String} child params : {[String]} child con : {String} child tp : Type alternative Type: child name : {String} child params : {[String]} child tp : Type alternative TSig: child name : {String} child tp : Type alternative Comment: child txt : {String} alternative PragmaDecl: child txt : {String} alternative Resume: child monadic : {Bool} child nt : {String} child left : Lhs child rhs : Expr alternative EvalDecl: child nt : {String} child left : Lhs child rhs : Expr -} data Decl = Decl (Lhs) (Expr) ((Set String)) ((Set String)) | Bind (Lhs) (Expr) | BindLet (Lhs) (Expr) | Data (String) (([String])) (DataAlts) (Bool) (([String])) | NewType (String) (([String])) (String) (Type) | Type (String) (([String])) (Type) | TSig (String) (Type) | Comment (String) | PragmaDecl (String) | Resume (Bool) (String) (Lhs) (Expr) | EvalDecl (String) (Lhs) (Expr) -- Decls ------------------------------------------------------- {- alternatives: alternative Cons: child hd : Decl child tl : Decls alternative Nil: -} type Decls = [Decl] -- Expr -------------------------------------------------------- {- alternatives: alternative Let: child decls : Decls child body : Expr alternative Case: child expr : Expr child alts : CaseAlts alternative Do: child stmts : Decls child body : Expr alternative Lambda: child args : Exprs child body : Expr alternative TupleExpr: child exprs : Exprs alternative UnboxedTupleExpr: child exprs : Exprs alternative App: child name : {String} child args : Exprs alternative SimpleExpr: child txt : {String} alternative TextExpr: child lns : {[String]} alternative Trace: child txt : {String} child expr : Expr alternative PragmaExpr: child onLeftSide : {Bool} child onNewLine : {Bool} child txt : {String} child expr : Expr alternative LineExpr: child expr : Expr alternative TypedExpr: child expr : Expr child tp : Type alternative ResultExpr: child nt : {String} child expr : Expr alternative InvokeExpr: child nt : {String} child expr : Expr child args : Exprs alternative ResumeExpr: child nt : {String} child expr : Expr child left : Lhs child rhs : Expr alternative SemFun: child nt : {String} child args : Exprs child body : Expr -} data Expr = Let (Decls) (Expr) | Case (Expr) (CaseAlts) | Do (Decls) (Expr) | Lambda (Exprs) (Expr) | TupleExpr (Exprs) | UnboxedTupleExpr (Exprs) | App (String) (Exprs) | SimpleExpr (String) | TextExpr (([String])) | Trace (String) (Expr) | PragmaExpr (Bool) (Bool) (String) (Expr) | LineExpr (Expr) | TypedExpr (Expr) (Type) | ResultExpr (String) (Expr) | InvokeExpr (String) (Expr) (Exprs) | ResumeExpr (String) (Expr) (Lhs) (Expr) | SemFun (String) (Exprs) (Expr) -- Exprs ------------------------------------------------------- {- alternatives: alternative Cons: child hd : Expr child tl : Exprs alternative Nil: -} type Exprs = [Expr] -- Lhs --------------------------------------------------------- {- alternatives: alternative Pattern3: child pat3 : {Pattern} alternative Pattern3SM: child pat3 : {Pattern} alternative TupleLhs: child comps : {[String]} alternative UnboxedTupleLhs: child comps : {[String]} alternative Fun: child name : {String} child args : Exprs alternative Unwrap: child name : {String} child sub : Lhs -} data Lhs = Pattern3 (Pattern) | Pattern3SM (Pattern) | TupleLhs (([String])) | UnboxedTupleLhs (([String])) | Fun (String) (Exprs) | Unwrap (String) (Lhs) -- NamedType --------------------------------------------------- {- alternatives: alternative Named: child strict : {Bool} child name : {String} child tp : Type -} data NamedType = Named (Bool) (String) (Type) -- NamedTypes -------------------------------------------------- {- alternatives: alternative Cons: child hd : NamedType child tl : NamedTypes alternative Nil: -} type NamedTypes = [NamedType] -- Program ----------------------------------------------------- {- alternatives: alternative Program: child chunks : Chunks child ordered : {Bool} -} data Program = Program (Chunks) (Bool) -- Type -------------------------------------------------------- {- alternatives: alternative Arr: child left : Type child right : Type alternative CtxApp: child left : {[(String, [String])]} child right : Type alternative QuantApp: child left : {String} child right : Type alternative TypeApp: child func : Type child args : Types alternative TupleType: child tps : Types alternative UnboxedTupleType: child tps : Types alternative List: child tp : Type alternative SimpleType: child txt : {String} alternative NontermType: child name : {String} child params : {[String]} child deforested : {Bool} alternative TMaybe: child tp : Type alternative TEither: child left : Type child right : Type alternative TMap: child key : Type child value : Type alternative TIntMap: child value : Type alternative TSet: child tp : Type alternative TIntSet: -} data Type = Arr (Type) (Type) | CtxApp (([(String, [String])])) (Type) | QuantApp (String) (Type) | TypeApp (Type) (Types) | TupleType (Types) | UnboxedTupleType (Types) | List (Type) | SimpleType (String) | NontermType (String) (([String])) (Bool) | TMaybe (Type) | TEither (Type) (Type) | TMap (Type) (Type) | TIntMap (Type) | TSet (Type) | TIntSet deriving ( Show) -- Types ------------------------------------------------------- {- alternatives: alternative Cons: child hd : Type child tl : Types alternative Nil: -} type Types = [Type]uuagc-0.9.52.2/src-generated/Order.hs0000644000000000000000000062221513433540502015402 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module Order where {-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) import Data.Map(Map) import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import Macro --marcos import CommonTypes import ErrorMessages {-# LINE 16 "dist/build/Order.hs" #-} {-# LINE 2 "src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken {-# LINE 22 "dist/build/Order.hs" #-} {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 29 "dist/build/Order.hs" #-} {-# LINE 10 "src-ag/Order.ag" #-} -- From uuagc import CommonTypes import Patterns import ErrorMessages import AbstractSyntax import Code hiding (Type) import qualified Code import Expression import Options import SequentialComputation import SequentialTypes import CodeSyntax import GrammarInfo import HsToken(HsTokensRoot(HsTokensRoot)) import SemHsTokens(sem_HsTokensRoot,wrap_HsTokensRoot, Syn_HsTokensRoot(..),Inh_HsTokensRoot(..)) -- From uulib import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Sequence as Seq import Data.Map(Map) import Data.Set(Set) import Data.Sequence(Seq, (><)) import UU.Util.Utils import UU.Scanner.Position(Pos(..),initPos) import Data.Foldable(toList) -- From haskell libraries import Control.Monad(liftM) import qualified Data.Array as Array import Data.Array((!),bounds,inRange) import Data.List(elemIndex,partition,sort,mapAccumL,find,nubBy,intersperse,groupBy,transpose) import qualified Data.Tree as Tree import Data.Maybe {-# LINE 66 "dist/build/Order.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 46 "src-ag/Order.ag" #-} -- Terminates with an error if the key is not in the map findWithErr1 :: (Ord k, Show k) => String -> k -> Map k a -> a findWithErr1 s k = Map.findWithDefault (error ("findWithErr1 " ++ s ++ ": key " ++ show k ++ " not in map.")) k findWithErr2 :: (Ord k, Show k, Show a) => k -> Map k a -> a findWithErr2 k m = Map.findWithDefault (error ("findWithErr2: key " ++ show k ++ " not in map: " ++ show m)) k m {-# LINE 79 "dist/build/Order.hs" #-} {-# LINE 71 "src-ag/Order.ag" #-} startsWith :: String -> String -> Bool startsWith k h = k == take (length k) h {-# LINE 85 "dist/build/Order.hs" #-} {-# LINE 138 "src-ag/Order.ag" #-} getNtName :: Type -> NontermIdent getNtName (NT nt _ _) = nt getNtName _ = nullIdent {-# LINE 92 "dist/build/Order.hs" #-} {-# LINE 166 "src-ag/Order.ag" #-} data AltAttr = AltAttr Identifier Identifier Bool deriving (Eq, Ord, Show) {-# LINE 98 "dist/build/Order.hs" #-} {-# LINE 239 "src-ag/Order.ag" #-} substSelf nt tp = case tp of NT n tps defor | n == _SELF -> NT nt tps defor _ -> tp haskellTupel :: [Type] -> Maybe Type haskellTupel ts = Just ( Haskell ( '(' : (concat (intersperse "," (map show ts))) ++ ")" )) {-# LINE 109 "dist/build/Order.hs" #-} {-# LINE 692 "src-ag/Order.ag" #-} swap (a,b) = (b,a) showPath :: Table CRule -> [Vertex] -> [String] showPath ruleTable path = let look a | inRange (bounds ruleTable) a = [showOrigin (ruleTable ! a)] | otherwise = ["Vertex " ++ show a] showOrigin cr | getHasCode cr && getName (getAttr cr) /= "self" = prettyCRule cr ++ " (" ++ show (getPos (getAttr cr)) ++ ")" | otherwise = prettyCRule cr in concatMap look path showPathLocal :: Table CRule -> [Vertex] -> [String] showPathLocal _ [] = [] showPathLocal ruleTable xs = showP (xs++[-1]) where showP [] = [] showP (v1:v2:vs) = let line = step v1 v2 lines = showP vs in line:lines step v1 v2 = " - " ++ a1 where r1 = ruleTable ! v1 a1 = show (getAttr r1) limitTo :: Int -> [String] -> [String] limitTo _ [] = [] limitTo 0 _ = ["....etcetera, etcetera...."] limitTo n (x:xs) = x : limitTo (n-1) xs showPathNice :: Table CRule -> [Vertex] -> [String] showPathNice _ [] = [] showPathNice ruleTable xs = limitTo 100 (showP ((-1):xs++[-1])) where [maxf, maxa, maxn, maxc] = maxWidths ruleTable (take 100 xs) showP [] = [] showP (v1:v2:vs) = let line = step v1 v2 lines = showP vs in if null line then lines else line:lines step v1 v2 | last && first = induced | last && isSyn r1 = "pass up " ++ alignR maxf "" ++ " " ++ alignL maxa a1 ++ " in " ++ alignR maxn n1 ++ "|" ++ c1 ++ induced | first&& not(isSyn r2) = "get from above " ++ alignR maxf "" ++ " " ++ alignL maxa a2 ++ " in " ++ alignR maxn n2 ++ "|" ++ c2 | last = "pass down " ++ alignR maxf f1 ++ "." ++ a1 ++ induced | isSyn r2 = "get from below " ++ alignR maxf f2 ++ "." ++ alignL maxa a2 ++ " in " ++ alignR maxn n2 ++ "|" ++ c2 | isLocal r1 = if head a1 == '_' then "" else "calculate " ++ alignR maxf "loc" ++ "." ++ a1 | otherwise = "pass down " ++ alignR maxf f1 ++ "." ++ alignL maxa a1 ++ " to " ++ alignR maxn n2 ++ "|" ++ c2 where first = v1<0 last = v2<0 r1 = ruleTable ! v1 r2 = ruleTable ! v2 a1 = show (getAttr r1) a2 = show (getAttr r2) f1 = show (getField r1) f2 = show (getField r2) n1 = show (getLhsNt r1) n2 = show (getLhsNt r2) c1 = show (getCon r1) c2 = show (getCon r2) induced | v2== -2 = " INDUCED dependency to " | otherwise = "" maxWidths ruleTable vs = map maximum (transpose (map getWidth vs)) where getWidth v | v<0 = [0,0,0,0] | otherwise = map (length . show . ($ (ruleTable!v))) [getField, getAttr, getLhsNt, getCon] alignL n xs | k Bool -> Route -> Error localCycleErr ruleTable o_visit (s:path) = let cr = ruleTable ! s attr = getAttr cr nt = getLhsNt cr con = getCon cr in LocalCirc nt con attr o_visit (showPathLocal ruleTable path) instCycleErr :: Table CRule -> Bool -> Route -> Error instCycleErr ruleTable o_visit (s:path) = let cr = ruleTable ! s attr = getAttr cr nt = getLhsNt cr con = getCon cr in InstCirc nt con attr o_visit (showPathLocal ruleTable path) directCycleErrs :: Table NTAttr -> Table CRule -> Bool -> [EdgeRoutes] -> [Error] directCycleErrs attrTable ruleTable o_visit xs = let getNont v = case attrTable ! v of NTASyn nt _ _ -> nt NTAInh nt _ _ -> nt getAttr v = case attrTable ! v of NTASyn _ a _ -> a NTAInh _ a _ -> a sameNont ((v1,_),_,_) ((v2,_),_,_) = getNont v1 == getNont v2 procCycle ((v1,v2),p1,p2) = ((getAttr v1, getAttr v2), showPathNice ruleTable p1, showPathNice ruleTable p2) wrapGroup gr@(((v1,_),_,_):_) = DirectCirc (getNont v1) o_visit (map procCycle gr) in map wrapGroup (groupBy sameNont xs) inducedCycleErrs :: Table NTAttr -> Table CRule -> CInterfaceMap -> [EdgeRoutes] -> [Error] inducedCycleErrs attrTable ruleTable cim xs = let getNont v = case attrTable ! v of NTASyn nt _ _ -> nt NTAInh nt _ _ -> nt getAttr v = case attrTable ! v of NTASyn _ a _ -> a NTAInh _ a _ -> a sameNont ((v1,_),_,_) ((v2,_),_,_) = getNont v1 == getNont v2 procCycle ((v1,v2),p1,p2) = ((getAttr v1, getAttr v2), showPathNice ruleTable p1, showPathNice ruleTable p2) wrapGroup gr@(((v1,_),_,_):_) = InducedCirc (getNont v1) (findWithErr1 "inducedCycleErr.cinter" (getNont v1) cim) (map procCycle gr) in map wrapGroup (groupBy sameNont xs) {-# LINE 229 "dist/build/Order.hs" #-} -- Child ------------------------------------------------------- -- wrapper data Inh_Child = Inh_Child { allfields_Inh_Child :: ([(Identifier,Type,ChildKind)]), allnts_Inh_Child :: ([Identifier]), attrs_Inh_Child :: ([(Identifier,Identifier)]), con_Inh_Child :: (Identifier), inh_Inh_Child :: (Attributes), inhMap_Inh_Child :: (Map Identifier Attributes), mergeMap_Inh_Child :: (Map Identifier (Identifier,[Identifier])), nt_Inh_Child :: (Identifier), o_unbox_Inh_Child :: (Bool), syn_Inh_Child :: (Attributes), synMap_Inh_Child :: (Map Identifier Attributes) } data Syn_Child = Syn_Child { attributes_Syn_Child :: ([(Identifier,Attributes,Attributes)]), collectChildrenInhs_Syn_Child :: (Map Identifier Attributes ), collectChildrenSyns_Syn_Child :: (Map Identifier Attributes ), errors_Syn_Child :: (Seq Error), field_Syn_Child :: ((Identifier,Type,ChildKind)), gathAltAttrs_Syn_Child :: ([AltAttr]), gathRules_Syn_Child :: (Seq CRule), inhs_Syn_Child :: (Seq (Identifier,Attributes)), nts_Syn_Child :: (Seq (Identifier,NontermIdent)), singlevisits_Syn_Child :: ([CRule]), terminals_Syn_Child :: ([Identifier]) } {-# INLINABLE wrap_Child #-} wrap_Child :: T_Child -> Inh_Child -> (Syn_Child ) wrap_Child (T_Child act) (Inh_Child _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_Child_vIn1 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn _lhsIsynMap (T_Child_vOut1 _lhsOattributes _lhsOcollectChildrenInhs _lhsOcollectChildrenSyns _lhsOerrors _lhsOfield _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals) <- return (inv_Child_s2 sem arg1) return (Syn_Child _lhsOattributes _lhsOcollectChildrenInhs _lhsOcollectChildrenSyns _lhsOerrors _lhsOfield _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals) ) -- cata {-# INLINE sem_Child #-} sem_Child :: Child -> T_Child sem_Child ( Child name_ tp_ kind_ ) = sem_Child_Child name_ tp_ kind_ -- semantic domain newtype T_Child = T_Child { attach_T_Child :: Identity (T_Child_s2 ) } newtype T_Child_s2 = C_Child_s2 { inv_Child_s2 :: (T_Child_v1 ) } data T_Child_s3 = C_Child_s3 type T_Child_v1 = (T_Child_vIn1 ) -> (T_Child_vOut1 ) data T_Child_vIn1 = T_Child_vIn1 ([(Identifier,Type,ChildKind)]) ([Identifier]) ([(Identifier,Identifier)]) (Identifier) (Attributes) (Map Identifier Attributes) (Map Identifier (Identifier,[Identifier])) (Identifier) (Bool) (Attributes) (Map Identifier Attributes) data T_Child_vOut1 = T_Child_vOut1 ([(Identifier,Attributes,Attributes)]) (Map Identifier Attributes ) (Map Identifier Attributes ) (Seq Error) ((Identifier,Type,ChildKind)) ([AltAttr]) (Seq CRule) (Seq (Identifier,Attributes)) (Seq (Identifier,NontermIdent)) ([CRule]) ([Identifier]) {-# NOINLINE sem_Child_Child #-} sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child sem_Child_Child arg_name_ arg_tp_ arg_kind_ = T_Child (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Child_v1 v1 = \ (T_Child_vIn1 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn _lhsIsynMap) -> ( let _chnt = rule0 arg_name_ arg_tp_ _inh = rule1 _chnt _lhsIinhMap _syn = rule2 _chnt _lhsIsynMap _maptolocal = rule3 _syn arg_tp_ _lhsOgathAltAttrs :: [AltAttr] _lhsOgathAltAttrs = rule4 _maptolocal _syn arg_name_ _lhsOnts :: Seq (Identifier,NontermIdent) _lhsOnts = rule5 arg_name_ arg_tp_ _lhsOinhs :: Seq (Identifier,Attributes) _lhsOinhs = rule6 _inh arg_name_ _gathRules = rule7 _lhsIcon _lhsInt _maptolocal _syn arg_name_ arg_tp_ _lhsOcollectChildrenSyns :: Map Identifier Attributes _lhsOcollectChildrenSyns = rule8 _syn arg_name_ _lhsOcollectChildrenInhs :: Map Identifier Attributes _lhsOcollectChildrenInhs = rule9 _inh arg_name_ _lhsOsinglevisits :: [CRule] _lhsOsinglevisits = rule10 _inh _maptolocal _syn arg_name_ arg_tp_ _lhsOterminals :: [Identifier] _lhsOterminals = rule11 _maptolocal arg_name_ _lhsOattributes :: [(Identifier,Attributes,Attributes)] _lhsOattributes = rule12 _inh _syn arg_name_ _lhsOfield :: (Identifier,Type,ChildKind) _lhsOfield = rule13 arg_kind_ arg_name_ arg_tp_ _lhsOerrors :: Seq Error _lhsOerrors = rule14 () _lhsOgathRules :: Seq CRule _lhsOgathRules = rule15 _gathRules __result_ = T_Child_vOut1 _lhsOattributes _lhsOcollectChildrenInhs _lhsOcollectChildrenSyns _lhsOerrors _lhsOfield _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} {-# LINE 19 "src-ag/DistChildAttr.ag" #-} rule0 = \ name_ tp_ -> {-# LINE 19 "src-ag/DistChildAttr.ag" #-} case tp_ of NT nt _ _ -> nt Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") Haskell t -> identifier "" {-# LINE 305 "dist/build/Order.hs"#-} {-# INLINE rule1 #-} {-# LINE 23 "src-ag/DistChildAttr.ag" #-} rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> {-# LINE 23 "src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIinhMap {-# LINE 311 "dist/build/Order.hs"#-} {-# INLINE rule2 #-} {-# LINE 24 "src-ag/DistChildAttr.ag" #-} rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> {-# LINE 24 "src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIsynMap {-# LINE 317 "dist/build/Order.hs"#-} {-# INLINE rule3 #-} {-# LINE 180 "src-ag/Order.ag" #-} rule3 = \ _syn tp_ -> {-# LINE 180 "src-ag/Order.ag" #-} case tp_ of NT nt _ _ -> Map.null _syn _ -> True {-# LINE 325 "dist/build/Order.hs"#-} {-# INLINE rule4 #-} {-# LINE 183 "src-ag/Order.ag" #-} rule4 = \ _maptolocal _syn name_ -> {-# LINE 183 "src-ag/Order.ag" #-} if _maptolocal then [ AltAttr _LOC name_ True ] else [ AltAttr name_ syn True | syn <- Map.keys _syn ] {-# LINE 333 "dist/build/Order.hs"#-} {-# INLINE rule5 #-} {-# LINE 198 "src-ag/Order.ag" #-} rule5 = \ name_ tp_ -> {-# LINE 198 "src-ag/Order.ag" #-} Seq.singleton (name_,getNtName tp_) {-# LINE 339 "dist/build/Order.hs"#-} {-# INLINE rule6 #-} {-# LINE 199 "src-ag/Order.ag" #-} rule6 = \ _inh name_ -> {-# LINE 199 "src-ag/Order.ag" #-} Seq.singleton (name_,_inh ) {-# LINE 345 "dist/build/Order.hs"#-} {-# INLINE rule7 #-} {-# LINE 215 "src-ag/Order.ag" #-} rule7 = \ ((_lhsIcon) :: Identifier) ((_lhsInt) :: Identifier) _maptolocal _syn name_ tp_ -> {-# LINE 215 "src-ag/Order.ag" #-} if _maptolocal then Seq.singleton (cRuleTerminal name_ _lhsInt _lhsIcon tp_) else Seq.fromList [ cRuleRhsSyn syn _lhsInt _lhsIcon tp name_ (getNtName tp_) | (syn,tp) <- Map.assocs _syn ] {-# LINE 353 "dist/build/Order.hs"#-} {-# INLINE rule8 #-} {-# LINE 347 "src-ag/Order.ag" #-} rule8 = \ _syn name_ -> {-# LINE 347 "src-ag/Order.ag" #-} Map.singleton name_ _syn {-# LINE 359 "dist/build/Order.hs"#-} {-# INLINE rule9 #-} {-# LINE 348 "src-ag/Order.ag" #-} rule9 = \ _inh name_ -> {-# LINE 348 "src-ag/Order.ag" #-} Map.singleton name_ _inh {-# LINE 365 "dist/build/Order.hs"#-} {-# INLINE rule10 #-} {-# LINE 618 "src-ag/Order.ag" #-} rule10 = \ _inh _maptolocal _syn name_ tp_ -> {-# LINE 618 "src-ag/Order.ag" #-} if _maptolocal then [] else [CChildVisit name_ (getNtName tp_) 0 _inh _syn True] {-# LINE 373 "dist/build/Order.hs"#-} {-# INLINE rule11 #-} {-# LINE 643 "src-ag/Order.ag" #-} rule11 = \ _maptolocal name_ -> {-# LINE 643 "src-ag/Order.ag" #-} if _maptolocal then [name_] else [] {-# LINE 381 "dist/build/Order.hs"#-} {-# INLINE rule12 #-} {-# LINE 672 "src-ag/Order.ag" #-} rule12 = \ _inh _syn name_ -> {-# LINE 672 "src-ag/Order.ag" #-} [(name_, _inh , _syn )] {-# LINE 387 "dist/build/Order.hs"#-} {-# INLINE rule13 #-} {-# LINE 676 "src-ag/Order.ag" #-} rule13 = \ kind_ name_ tp_ -> {-# LINE 676 "src-ag/Order.ag" #-} (name_, tp_, kind_) {-# LINE 393 "dist/build/Order.hs"#-} {-# INLINE rule14 #-} rule14 = \ (_ :: ()) -> Seq.empty {-# INLINE rule15 #-} rule15 = \ _gathRules -> _gathRules -- Children ---------------------------------------------------- -- wrapper data Inh_Children = Inh_Children { allfields_Inh_Children :: ([(Identifier,Type,ChildKind)]), allnts_Inh_Children :: ([Identifier]), attrs_Inh_Children :: ([(Identifier,Identifier)]), con_Inh_Children :: (Identifier), inh_Inh_Children :: (Attributes), inhMap_Inh_Children :: (Map Identifier Attributes), mergeMap_Inh_Children :: (Map Identifier (Identifier,[Identifier])), nt_Inh_Children :: (Identifier), o_unbox_Inh_Children :: (Bool), syn_Inh_Children :: (Attributes), synMap_Inh_Children :: (Map Identifier Attributes) } data Syn_Children = Syn_Children { attributes_Syn_Children :: ([(Identifier,Attributes,Attributes)]), collectChildrenInhs_Syn_Children :: (Map Identifier Attributes ), collectChildrenSyns_Syn_Children :: (Map Identifier Attributes ), errors_Syn_Children :: (Seq Error), fields_Syn_Children :: ([(Identifier,Type,ChildKind)]), gathAltAttrs_Syn_Children :: ([AltAttr]), gathRules_Syn_Children :: (Seq CRule), inhs_Syn_Children :: (Seq (Identifier,Attributes)), nts_Syn_Children :: (Seq (Identifier,NontermIdent)), singlevisits_Syn_Children :: ([CRule]), terminals_Syn_Children :: ([Identifier]) } {-# INLINABLE wrap_Children #-} wrap_Children :: T_Children -> Inh_Children -> (Syn_Children ) wrap_Children (T_Children act) (Inh_Children _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_Children_vIn4 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn _lhsIsynMap (T_Children_vOut4 _lhsOattributes _lhsOcollectChildrenInhs _lhsOcollectChildrenSyns _lhsOerrors _lhsOfields _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals) <- return (inv_Children_s5 sem arg4) return (Syn_Children _lhsOattributes _lhsOcollectChildrenInhs _lhsOcollectChildrenSyns _lhsOerrors _lhsOfields _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals) ) -- cata {-# NOINLINE sem_Children #-} sem_Children :: Children -> T_Children sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) -- semantic domain newtype T_Children = T_Children { attach_T_Children :: Identity (T_Children_s5 ) } newtype T_Children_s5 = C_Children_s5 { inv_Children_s5 :: (T_Children_v4 ) } data T_Children_s6 = C_Children_s6 type T_Children_v4 = (T_Children_vIn4 ) -> (T_Children_vOut4 ) data T_Children_vIn4 = T_Children_vIn4 ([(Identifier,Type,ChildKind)]) ([Identifier]) ([(Identifier,Identifier)]) (Identifier) (Attributes) (Map Identifier Attributes) (Map Identifier (Identifier,[Identifier])) (Identifier) (Bool) (Attributes) (Map Identifier Attributes) data T_Children_vOut4 = T_Children_vOut4 ([(Identifier,Attributes,Attributes)]) (Map Identifier Attributes ) (Map Identifier Attributes ) (Seq Error) ([(Identifier,Type,ChildKind)]) ([AltAttr]) (Seq CRule) (Seq (Identifier,Attributes)) (Seq (Identifier,NontermIdent)) ([CRule]) ([Identifier]) {-# NOINLINE sem_Children_Cons #-} sem_Children_Cons :: T_Child -> T_Children -> T_Children sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_Children_v4 v4 = \ (T_Children_vIn4 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn _lhsIsynMap) -> ( let _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) (T_Child_vOut1 _hdIattributes _hdIcollectChildrenInhs _hdIcollectChildrenSyns _hdIerrors _hdIfield _hdIgathAltAttrs _hdIgathRules _hdIinhs _hdInts _hdIsinglevisits _hdIterminals) = inv_Child_s2 _hdX2 (T_Child_vIn1 _hdOallfields _hdOallnts _hdOattrs _hdOcon _hdOinh _hdOinhMap _hdOmergeMap _hdOnt _hdOo_unbox _hdOsyn _hdOsynMap) (T_Children_vOut4 _tlIattributes _tlIcollectChildrenInhs _tlIcollectChildrenSyns _tlIerrors _tlIfields _tlIgathAltAttrs _tlIgathRules _tlIinhs _tlInts _tlIsinglevisits _tlIterminals) = inv_Children_s5 _tlX5 (T_Children_vIn4 _tlOallfields _tlOallnts _tlOattrs _tlOcon _tlOinh _tlOinhMap _tlOmergeMap _tlOnt _tlOo_unbox _tlOsyn _tlOsynMap) _lhsOfields :: [(Identifier,Type,ChildKind)] _lhsOfields = rule16 _hdIfield _tlIfields _lhsOattributes :: [(Identifier,Attributes,Attributes)] _lhsOattributes = rule17 _hdIattributes _tlIattributes _lhsOcollectChildrenInhs :: Map Identifier Attributes _lhsOcollectChildrenInhs = rule18 _hdIcollectChildrenInhs _tlIcollectChildrenInhs _lhsOcollectChildrenSyns :: Map Identifier Attributes _lhsOcollectChildrenSyns = rule19 _hdIcollectChildrenSyns _tlIcollectChildrenSyns _lhsOerrors :: Seq Error _lhsOerrors = rule20 _hdIerrors _tlIerrors _lhsOgathAltAttrs :: [AltAttr] _lhsOgathAltAttrs = rule21 _hdIgathAltAttrs _tlIgathAltAttrs _lhsOgathRules :: Seq CRule _lhsOgathRules = rule22 _hdIgathRules _tlIgathRules _lhsOinhs :: Seq (Identifier,Attributes) _lhsOinhs = rule23 _hdIinhs _tlIinhs _lhsOnts :: Seq (Identifier,NontermIdent) _lhsOnts = rule24 _hdInts _tlInts _lhsOsinglevisits :: [CRule] _lhsOsinglevisits = rule25 _hdIsinglevisits _tlIsinglevisits _lhsOterminals :: [Identifier] _lhsOterminals = rule26 _hdIterminals _tlIterminals _hdOallfields = rule27 _lhsIallfields _hdOallnts = rule28 _lhsIallnts _hdOattrs = rule29 _lhsIattrs _hdOcon = rule30 _lhsIcon _hdOinh = rule31 _lhsIinh _hdOinhMap = rule32 _lhsIinhMap _hdOmergeMap = rule33 _lhsImergeMap _hdOnt = rule34 _lhsInt _hdOo_unbox = rule35 _lhsIo_unbox _hdOsyn = rule36 _lhsIsyn _hdOsynMap = rule37 _lhsIsynMap _tlOallfields = rule38 _lhsIallfields _tlOallnts = rule39 _lhsIallnts _tlOattrs = rule40 _lhsIattrs _tlOcon = rule41 _lhsIcon _tlOinh = rule42 _lhsIinh _tlOinhMap = rule43 _lhsIinhMap _tlOmergeMap = rule44 _lhsImergeMap _tlOnt = rule45 _lhsInt _tlOo_unbox = rule46 _lhsIo_unbox _tlOsyn = rule47 _lhsIsyn _tlOsynMap = rule48 _lhsIsynMap __result_ = T_Children_vOut4 _lhsOattributes _lhsOcollectChildrenInhs _lhsOcollectChildrenSyns _lhsOerrors _lhsOfields _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals in __result_ ) in C_Children_s5 v4 {-# INLINE rule16 #-} {-# LINE 679 "src-ag/Order.ag" #-} rule16 = \ ((_hdIfield) :: (Identifier,Type,ChildKind)) ((_tlIfields) :: [(Identifier,Type,ChildKind)]) -> {-# LINE 679 "src-ag/Order.ag" #-} _hdIfield : _tlIfields {-# LINE 494 "dist/build/Order.hs"#-} {-# INLINE rule17 #-} rule17 = \ ((_hdIattributes) :: [(Identifier,Attributes,Attributes)]) ((_tlIattributes) :: [(Identifier,Attributes,Attributes)]) -> _hdIattributes ++ _tlIattributes {-# INLINE rule18 #-} rule18 = \ ((_hdIcollectChildrenInhs) :: Map Identifier Attributes ) ((_tlIcollectChildrenInhs) :: Map Identifier Attributes ) -> _hdIcollectChildrenInhs `Map.union` _tlIcollectChildrenInhs {-# INLINE rule19 #-} rule19 = \ ((_hdIcollectChildrenSyns) :: Map Identifier Attributes ) ((_tlIcollectChildrenSyns) :: Map Identifier Attributes ) -> _hdIcollectChildrenSyns `Map.union` _tlIcollectChildrenSyns {-# INLINE rule20 #-} rule20 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule21 #-} rule21 = \ ((_hdIgathAltAttrs) :: [AltAttr]) ((_tlIgathAltAttrs) :: [AltAttr]) -> _hdIgathAltAttrs ++ _tlIgathAltAttrs {-# INLINE rule22 #-} rule22 = \ ((_hdIgathRules) :: Seq CRule) ((_tlIgathRules) :: Seq CRule) -> _hdIgathRules Seq.>< _tlIgathRules {-# INLINE rule23 #-} rule23 = \ ((_hdIinhs) :: Seq (Identifier,Attributes)) ((_tlIinhs) :: Seq (Identifier,Attributes)) -> _hdIinhs Seq.>< _tlIinhs {-# INLINE rule24 #-} rule24 = \ ((_hdInts) :: Seq (Identifier,NontermIdent)) ((_tlInts) :: Seq (Identifier,NontermIdent)) -> _hdInts Seq.>< _tlInts {-# INLINE rule25 #-} rule25 = \ ((_hdIsinglevisits) :: [CRule]) ((_tlIsinglevisits) :: [CRule]) -> _hdIsinglevisits ++ _tlIsinglevisits {-# INLINE rule26 #-} rule26 = \ ((_hdIterminals) :: [Identifier]) ((_tlIterminals) :: [Identifier]) -> _hdIterminals ++ _tlIterminals {-# INLINE rule27 #-} rule27 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) -> _lhsIallfields {-# INLINE rule28 #-} rule28 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule29 #-} rule29 = \ ((_lhsIattrs) :: [(Identifier,Identifier)]) -> _lhsIattrs {-# INLINE rule30 #-} rule30 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule31 #-} rule31 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule32 #-} rule32 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule33 #-} rule33 = \ ((_lhsImergeMap) :: Map Identifier (Identifier,[Identifier])) -> _lhsImergeMap {-# INLINE rule34 #-} rule34 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule35 #-} rule35 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule36 #-} rule36 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule37 #-} rule37 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule38 #-} rule38 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) -> _lhsIallfields {-# INLINE rule39 #-} rule39 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule40 #-} rule40 = \ ((_lhsIattrs) :: [(Identifier,Identifier)]) -> _lhsIattrs {-# INLINE rule41 #-} rule41 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule42 #-} rule42 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule43 #-} rule43 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule44 #-} rule44 = \ ((_lhsImergeMap) :: Map Identifier (Identifier,[Identifier])) -> _lhsImergeMap {-# INLINE rule45 #-} rule45 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule46 #-} rule46 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule47 #-} rule47 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule48 #-} rule48 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE sem_Children_Nil #-} sem_Children_Nil :: T_Children sem_Children_Nil = T_Children (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_Children_v4 v4 = \ (T_Children_vIn4 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn _lhsIsynMap) -> ( let _lhsOfields :: [(Identifier,Type,ChildKind)] _lhsOfields = rule49 () _lhsOattributes :: [(Identifier,Attributes,Attributes)] _lhsOattributes = rule50 () _lhsOcollectChildrenInhs :: Map Identifier Attributes _lhsOcollectChildrenInhs = rule51 () _lhsOcollectChildrenSyns :: Map Identifier Attributes _lhsOcollectChildrenSyns = rule52 () _lhsOerrors :: Seq Error _lhsOerrors = rule53 () _lhsOgathAltAttrs :: [AltAttr] _lhsOgathAltAttrs = rule54 () _lhsOgathRules :: Seq CRule _lhsOgathRules = rule55 () _lhsOinhs :: Seq (Identifier,Attributes) _lhsOinhs = rule56 () _lhsOnts :: Seq (Identifier,NontermIdent) _lhsOnts = rule57 () _lhsOsinglevisits :: [CRule] _lhsOsinglevisits = rule58 () _lhsOterminals :: [Identifier] _lhsOterminals = rule59 () __result_ = T_Children_vOut4 _lhsOattributes _lhsOcollectChildrenInhs _lhsOcollectChildrenSyns _lhsOerrors _lhsOfields _lhsOgathAltAttrs _lhsOgathRules _lhsOinhs _lhsOnts _lhsOsinglevisits _lhsOterminals in __result_ ) in C_Children_s5 v4 {-# INLINE rule49 #-} {-# LINE 680 "src-ag/Order.ag" #-} rule49 = \ (_ :: ()) -> {-# LINE 680 "src-ag/Order.ag" #-} [] {-# LINE 628 "dist/build/Order.hs"#-} {-# INLINE rule50 #-} rule50 = \ (_ :: ()) -> [] {-# INLINE rule51 #-} rule51 = \ (_ :: ()) -> Map.empty {-# INLINE rule52 #-} rule52 = \ (_ :: ()) -> Map.empty {-# INLINE rule53 #-} rule53 = \ (_ :: ()) -> Seq.empty {-# INLINE rule54 #-} rule54 = \ (_ :: ()) -> [] {-# INLINE rule55 #-} rule55 = \ (_ :: ()) -> Seq.empty {-# INLINE rule56 #-} rule56 = \ (_ :: ()) -> Seq.empty {-# INLINE rule57 #-} rule57 = \ (_ :: ()) -> Seq.empty {-# INLINE rule58 #-} rule58 = \ (_ :: ()) -> [] {-# INLINE rule59 #-} rule59 = \ (_ :: ()) -> [] -- Expression -------------------------------------------------- -- wrapper data Inh_Expression = Inh_Expression { allfields_Inh_Expression :: ([(Identifier,Type,ChildKind)]), allnts_Inh_Expression :: ([Identifier]), attrs_Inh_Expression :: ([(Identifier,Identifier)]), con_Inh_Expression :: (Identifier), mergeMap_Inh_Expression :: (Map Identifier (Identifier,[Identifier])), nt_Inh_Expression :: (Identifier), options_Inh_Expression :: (Options) } data Syn_Expression = Syn_Expression { allRhsVars_Syn_Expression :: (Set (Identifier,Identifier)), copy_Syn_Expression :: (Expression), errors_Syn_Expression :: (Seq Error), textLines_Syn_Expression :: ([String]), usedAttrs_Syn_Expression :: ([(Identifier,Identifier)]), usedFields_Syn_Expression :: ([Identifier]), usedLocals_Syn_Expression :: ([Identifier]) } {-# INLINABLE wrap_Expression #-} wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) wrap_Expression (T_Expression act) (Inh_Expression _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_Expression_vIn7 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt _lhsIoptions (T_Expression_vOut7 _lhsOallRhsVars _lhsOcopy _lhsOerrors _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals) <- return (inv_Expression_s8 sem arg7) return (Syn_Expression _lhsOallRhsVars _lhsOcopy _lhsOerrors _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals) ) -- cata {-# INLINE sem_Expression #-} sem_Expression :: Expression -> T_Expression sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_ -- semantic domain newtype T_Expression = T_Expression { attach_T_Expression :: Identity (T_Expression_s8 ) } newtype T_Expression_s8 = C_Expression_s8 { inv_Expression_s8 :: (T_Expression_v7 ) } data T_Expression_s9 = C_Expression_s9 type T_Expression_v7 = (T_Expression_vIn7 ) -> (T_Expression_vOut7 ) data T_Expression_vIn7 = T_Expression_vIn7 ([(Identifier,Type,ChildKind)]) ([Identifier]) ([(Identifier,Identifier)]) (Identifier) (Map Identifier (Identifier,[Identifier])) (Identifier) (Options) data T_Expression_vOut7 = T_Expression_vOut7 (Set (Identifier,Identifier)) (Expression) (Seq Error) ([String]) ([(Identifier,Identifier)]) ([Identifier]) ([Identifier]) {-# NOINLINE sem_Expression_Expression #-} sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression sem_Expression_Expression arg_pos_ arg_tks_ = T_Expression (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_Expression_v7 v7 = \ (T_Expression_vIn7 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt _lhsIoptions) -> ( let (_textLines,_usedAttrs,_usedLocals,_usedFields) = rule60 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt _lhsIoptions arg_tks_ _lhsOerrors :: Seq Error _lhsOerrors = rule61 () _lhsOallRhsVars :: Set (Identifier,Identifier) _lhsOallRhsVars = rule62 _usedAttrs _usedFields _usedLocals _copy = rule63 arg_pos_ arg_tks_ _lhsOcopy :: Expression _lhsOcopy = rule64 _copy _lhsOtextLines :: [String] _lhsOtextLines = rule65 _textLines _lhsOusedAttrs :: [(Identifier,Identifier)] _lhsOusedAttrs = rule66 _usedAttrs _lhsOusedFields :: [Identifier] _lhsOusedFields = rule67 _usedFields _lhsOusedLocals :: [Identifier] _lhsOusedLocals = rule68 _usedLocals __result_ = T_Expression_vOut7 _lhsOallRhsVars _lhsOcopy _lhsOerrors _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals in __result_ ) in C_Expression_s8 v7 {-# INLINE rule60 #-} {-# LINE 469 "src-ag/Order.ag" #-} rule60 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) ((_lhsIallnts) :: [Identifier]) ((_lhsIattrs) :: [(Identifier,Identifier)]) ((_lhsIcon) :: Identifier) ((_lhsImergeMap) :: Map Identifier (Identifier,[Identifier])) ((_lhsInt) :: Identifier) ((_lhsIoptions) :: Options) tks_ -> {-# LINE 469 "src-ag/Order.ag" #-} let mergedChildren = [ x | (_,xs) <- Map.elems _lhsImergeMap, x <- xs ] attrsIn = filter (\(fld,_) -> not (fld `elem` mergedChildren)) _lhsIattrs inherited = Inh_HsTokensRoot { attrs_Inh_HsTokensRoot = attrsIn , con_Inh_HsTokensRoot = _lhsIcon , allfields_Inh_HsTokensRoot = _lhsIallfields , allnts_Inh_HsTokensRoot = _lhsIallnts , nt_Inh_HsTokensRoot = _lhsInt , options_Inh_HsTokensRoot = _lhsIoptions } synthesized = wrap_HsTokensRoot (sem_HsTokensRoot (HsTokensRoot tks_)) inherited in case synthesized of Syn_HsTokensRoot { textLines_Syn_HsTokensRoot = textLines , usedAttrs_Syn_HsTokensRoot = usedAttrs , usedLocals_Syn_HsTokensRoot = usedLocals , usedFields_Syn_HsTokensRoot = usedFields } -> let extraAttrs = [ (src,attr) | (fld,attr) <- usedAttrs, let mbMerged = Map.lookup fld _lhsImergeMap, isJust mbMerged , let (Just (_, srcs)) = mbMerged, src <- srcs ] usedAttrs' = usedAttrs ++ extraAttrs in (textLines,usedAttrs',usedLocals,usedFields) {-# LINE 742 "dist/build/Order.hs"#-} {-# INLINE rule61 #-} {-# LINE 492 "src-ag/Order.ag" #-} rule61 = \ (_ :: ()) -> {-# LINE 492 "src-ag/Order.ag" #-} Seq.empty {-# LINE 748 "dist/build/Order.hs"#-} {-# INLINE rule62 #-} {-# LINE 493 "src-ag/Order.ag" #-} rule62 = \ _usedAttrs _usedFields _usedLocals -> {-# LINE 493 "src-ag/Order.ag" #-} Set.fromList _usedAttrs `Set.union` Set.fromList [ (_LOC, l) | l <- _usedLocals ] `Set.union` Set.fromList [ (_FIELD, fld) | fld <- _usedFields ] {-# LINE 758 "dist/build/Order.hs"#-} {-# INLINE rule63 #-} rule63 = \ pos_ tks_ -> Expression pos_ tks_ {-# INLINE rule64 #-} rule64 = \ _copy -> _copy {-# INLINE rule65 #-} rule65 = \ _textLines -> _textLines {-# INLINE rule66 #-} rule66 = \ _usedAttrs -> _usedAttrs {-# INLINE rule67 #-} rule67 = \ _usedFields -> _usedFields {-# INLINE rule68 #-} rule68 = \ _usedLocals -> _usedLocals -- Grammar ----------------------------------------------------- -- wrapper data Inh_Grammar = Inh_Grammar { options_Inh_Grammar :: (Options) } data Syn_Grammar = Syn_Grammar { errors_Syn_Grammar :: (Seq Error), nAutoRules_Syn_Grammar :: (Int), nExplicitRules_Syn_Grammar :: (Int), output_Syn_Grammar :: (CGrammar) } {-# INLINABLE wrap_Grammar #-} wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar ) wrap_Grammar (T_Grammar act) (Inh_Grammar _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg10 = T_Grammar_vIn10 _lhsIoptions (T_Grammar_vOut10 _lhsOerrors _lhsOnAutoRules _lhsOnExplicitRules _lhsOoutput) <- return (inv_Grammar_s11 sem arg10) return (Syn_Grammar _lhsOerrors _lhsOnAutoRules _lhsOnExplicitRules _lhsOoutput) ) -- cata {-# INLINE sem_Grammar #-} sem_Grammar :: Grammar -> T_Grammar sem_Grammar ( Grammar typeSyns_ useMap_ derivings_ wrappers_ nonts_ pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ -- semantic domain newtype T_Grammar = T_Grammar { attach_T_Grammar :: Identity (T_Grammar_s11 ) } newtype T_Grammar_s11 = C_Grammar_s11 { inv_Grammar_s11 :: (T_Grammar_v10 ) } data T_Grammar_s12 = C_Grammar_s12 type T_Grammar_v10 = (T_Grammar_vIn10 ) -> (T_Grammar_vOut10 ) data T_Grammar_vIn10 = T_Grammar_vIn10 (Options) data T_Grammar_vOut10 = T_Grammar_vOut10 (Seq Error) (Int) (Int) (CGrammar) {-# NOINLINE sem_Grammar_Grammar #-} sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar sem_Grammar_Grammar arg_typeSyns_ _ arg_derivings_ arg_wrappers_ arg_nonts_ arg_pragmas_ arg_manualAttrOrderMap_ arg_paramMap_ arg_contextMap_ arg_quantMap_ _ _ arg_aroundsMap_ arg_mergeMap_ = T_Grammar (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_Grammar_v10 v10 = \ (T_Grammar_vIn10 _lhsIoptions) -> ( let _nontsX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) (T_Nonterminals_vOut16 _nontsIacount _nontsIadditionalDep _nontsIaranges _nontsIaroundDep _nontsIcNonterminals _nontsIdirectDep _nontsIerrors _nontsIinhMap' _nontsIinstDep _nontsImergeDep _nontsInAutoRules _nontsInExplicitRules _nontsInonts _nontsIntattrs _nontsIrules _nontsIsynMap' _nontsIvcount) = inv_Nonterminals_s17 _nontsX17 (T_Nonterminals_vIn16 _nontsOacount _nontsOallnts _nontsOaroundMap _nontsOcInterfaceMap _nontsOcVisitsMap _nontsOinhMap _nontsOmanualAttrDepMap _nontsOmergeMap _nontsOo_case _nontsOo_cata _nontsOo_data _nontsOo_dovisit _nontsOo_newtypes _nontsOo_rename _nontsOo_sem _nontsOo_sig _nontsOo_unbox _nontsOo_wantvisit _nontsOoptions _nontsOprefix _nontsOsynMap _nontsOvcount) _nontsOinhMap = rule69 _nontsIinhMap' _nontsOsynMap = rule70 _nontsIsynMap' _o_dovisit = rule71 _cyclesErrors _lhsIoptions _nontsOo_cata = rule72 _lhsIoptions _nontsOo_data = rule73 _lhsIoptions _nontsOo_sig = rule74 _lhsIoptions _nontsOo_sem = rule75 _lhsIoptions _nontsOo_rename = rule76 _lhsIoptions _nontsOo_newtypes = rule77 _lhsIoptions _nontsOo_wantvisit = rule78 _lhsIoptions _nontsOo_unbox = rule79 _lhsIoptions _nontsOo_case = rule80 _lhsIoptions _nontsOprefix = rule81 _lhsIoptions _nontsOvcount = rule82 () _nontsOmanualAttrDepMap = rule83 arg_manualAttrOrderMap_ _nontsOaroundMap = rule84 arg_aroundsMap_ _nontsOacount = rule85 () _ruleTable = rule86 _nontsIrules _nontsIvcount _attrTable = rule87 _nontsIacount _nontsIntattrs _attrVertex = rule88 _nontsIntattrs _tdpToTds = rule89 _attrVertex _nontsIrules _tdsToTdp = rule90 _tdpToTds _directDep = rule91 _nontsIadditionalDep _nontsIdirectDep _instDep = rule92 _nontsIinstDep _aroundDep = rule93 _nontsIaroundDep _mergeDep = rule94 _nontsImergeDep _info = rule95 _attrTable _nontsIacount _nontsIaranges _nontsInonts _nontsIvcount _ruleTable _tdpToTds _tdsToTdp arg_wrappers_ (_cInterfaceMap,_cVisitsMap,_cyclesErrors) = rule96 _aroundDep _attrTable _directDep _info _instDep _lhsIoptions _mergeDep _ruleTable _lhsOerrors :: Seq Error _lhsOerrors = rule97 _cyclesErrors _lhsIoptions _nontsIerrors _lhsOoutput :: CGrammar _lhsOoutput = rule98 _aroundMap _mergeMap _nontsIcNonterminals _o_dovisit arg_contextMap_ arg_derivings_ arg_paramMap_ arg_pragmas_ arg_quantMap_ arg_typeSyns_ arg_wrappers_ _aroundMap = rule99 arg_aroundsMap_ _mergeMap = rule100 arg_mergeMap_ _nontsOallnts = rule101 _nontsInonts _lhsOnAutoRules :: Int _lhsOnAutoRules = rule102 _nontsInAutoRules _lhsOnExplicitRules :: Int _lhsOnExplicitRules = rule103 _nontsInExplicitRules _nontsOcInterfaceMap = rule104 _cInterfaceMap _nontsOcVisitsMap = rule105 _cVisitsMap _nontsOmergeMap = rule106 _mergeMap _nontsOo_dovisit = rule107 _o_dovisit _nontsOoptions = rule108 _lhsIoptions __result_ = T_Grammar_vOut10 _lhsOerrors _lhsOnAutoRules _lhsOnExplicitRules _lhsOoutput in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule69 #-} {-# LINE 15 "src-ag/DistChildAttr.ag" #-} rule69 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> {-# LINE 15 "src-ag/DistChildAttr.ag" #-} _nontsIinhMap' {-# LINE 869 "dist/build/Order.hs"#-} {-# INLINE rule70 #-} {-# LINE 16 "src-ag/DistChildAttr.ag" #-} rule70 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> {-# LINE 16 "src-ag/DistChildAttr.ag" #-} _nontsIsynMap' {-# LINE 875 "dist/build/Order.hs"#-} {-# INLINE rule71 #-} {-# LINE 123 "src-ag/Order.ag" #-} rule71 = \ _cyclesErrors ((_lhsIoptions) :: Options) -> {-# LINE 123 "src-ag/Order.ag" #-} visit _lhsIoptions && null _cyclesErrors {-# LINE 881 "dist/build/Order.hs"#-} {-# INLINE rule72 #-} {-# LINE 124 "src-ag/Order.ag" #-} rule72 = \ ((_lhsIoptions) :: Options) -> {-# LINE 124 "src-ag/Order.ag" #-} folds _lhsIoptions {-# LINE 887 "dist/build/Order.hs"#-} {-# INLINE rule73 #-} {-# LINE 125 "src-ag/Order.ag" #-} rule73 = \ ((_lhsIoptions) :: Options) -> {-# LINE 125 "src-ag/Order.ag" #-} dataTypes _lhsIoptions {-# LINE 893 "dist/build/Order.hs"#-} {-# INLINE rule74 #-} {-# LINE 126 "src-ag/Order.ag" #-} rule74 = \ ((_lhsIoptions) :: Options) -> {-# LINE 126 "src-ag/Order.ag" #-} typeSigs _lhsIoptions {-# LINE 899 "dist/build/Order.hs"#-} {-# INLINE rule75 #-} {-# LINE 127 "src-ag/Order.ag" #-} rule75 = \ ((_lhsIoptions) :: Options) -> {-# LINE 127 "src-ag/Order.ag" #-} semfuns _lhsIoptions {-# LINE 905 "dist/build/Order.hs"#-} {-# INLINE rule76 #-} {-# LINE 128 "src-ag/Order.ag" #-} rule76 = \ ((_lhsIoptions) :: Options) -> {-# LINE 128 "src-ag/Order.ag" #-} rename _lhsIoptions {-# LINE 911 "dist/build/Order.hs"#-} {-# INLINE rule77 #-} {-# LINE 129 "src-ag/Order.ag" #-} rule77 = \ ((_lhsIoptions) :: Options) -> {-# LINE 129 "src-ag/Order.ag" #-} newtypes _lhsIoptions {-# LINE 917 "dist/build/Order.hs"#-} {-# INLINE rule78 #-} {-# LINE 130 "src-ag/Order.ag" #-} rule78 = \ ((_lhsIoptions) :: Options) -> {-# LINE 130 "src-ag/Order.ag" #-} visit _lhsIoptions {-# LINE 923 "dist/build/Order.hs"#-} {-# INLINE rule79 #-} {-# LINE 131 "src-ag/Order.ag" #-} rule79 = \ ((_lhsIoptions) :: Options) -> {-# LINE 131 "src-ag/Order.ag" #-} unbox _lhsIoptions {-# LINE 929 "dist/build/Order.hs"#-} {-# INLINE rule80 #-} {-# LINE 132 "src-ag/Order.ag" #-} rule80 = \ ((_lhsIoptions) :: Options) -> {-# LINE 132 "src-ag/Order.ag" #-} cases _lhsIoptions {-# LINE 935 "dist/build/Order.hs"#-} {-# INLINE rule81 #-} {-# LINE 133 "src-ag/Order.ag" #-} rule81 = \ ((_lhsIoptions) :: Options) -> {-# LINE 133 "src-ag/Order.ag" #-} prefix _lhsIoptions {-# LINE 941 "dist/build/Order.hs"#-} {-# INLINE rule82 #-} {-# LINE 262 "src-ag/Order.ag" #-} rule82 = \ (_ :: ()) -> {-# LINE 262 "src-ag/Order.ag" #-} 0 {-# LINE 947 "dist/build/Order.hs"#-} {-# INLINE rule83 #-} {-# LINE 288 "src-ag/Order.ag" #-} rule83 = \ manualAttrOrderMap_ -> {-# LINE 288 "src-ag/Order.ag" #-} manualAttrOrderMap_ {-# LINE 953 "dist/build/Order.hs"#-} {-# INLINE rule84 #-} {-# LINE 417 "src-ag/Order.ag" #-} rule84 = \ aroundsMap_ -> {-# LINE 417 "src-ag/Order.ag" #-} aroundsMap_ {-# LINE 959 "dist/build/Order.hs"#-} {-# INLINE rule85 #-} {-# LINE 508 "src-ag/Order.ag" #-} rule85 = \ (_ :: ()) -> {-# LINE 508 "src-ag/Order.ag" #-} 0 {-# LINE 965 "dist/build/Order.hs"#-} {-# INLINE rule86 #-} {-# LINE 546 "src-ag/Order.ag" #-} rule86 = \ ((_nontsIrules) :: Seq (Vertex,CRule)) ((_nontsIvcount) :: Int) -> {-# LINE 546 "src-ag/Order.ag" #-} Array.array (0,_nontsIvcount-1) (toList _nontsIrules) {-# LINE 971 "dist/build/Order.hs"#-} {-# INLINE rule87 #-} {-# LINE 547 "src-ag/Order.ag" #-} rule87 = \ ((_nontsIacount) :: Int) ((_nontsIntattrs) :: Seq (Vertex,NTAttr)) -> {-# LINE 547 "src-ag/Order.ag" #-} Array.array (0,_nontsIacount-1) (toList _nontsIntattrs) {-# LINE 977 "dist/build/Order.hs"#-} {-# INLINE rule88 #-} {-# LINE 548 "src-ag/Order.ag" #-} rule88 = \ ((_nontsIntattrs) :: Seq (Vertex,NTAttr)) -> {-# LINE 548 "src-ag/Order.ag" #-} Map.fromList (map swap (toList _nontsIntattrs)) {-# LINE 983 "dist/build/Order.hs"#-} {-# INLINE rule89 #-} {-# LINE 549 "src-ag/Order.ag" #-} rule89 = \ _attrVertex ((_nontsIrules) :: Seq (Vertex,CRule)) -> {-# LINE 549 "src-ag/Order.ag" #-} [ (s, maybe (-1) (\v -> findWithErr1 "Grammar.tdpToTds" v _attrVertex) (ntattr cr)) | (s,cr) <- toList _nontsIrules] {-# LINE 990 "dist/build/Order.hs"#-} {-# INLINE rule90 #-} {-# LINE 551 "src-ag/Order.ag" #-} rule90 = \ _tdpToTds -> {-# LINE 551 "src-ag/Order.ag" #-} let eq (_,v) (_,v') = v == v' conv ((s,v):svs) | v == -1 = Nothing | otherwise = Just (v,s:map fst svs) in mapMaybe conv (eqClasses eq _tdpToTds) {-# LINE 999 "dist/build/Order.hs"#-} {-# INLINE rule91 #-} {-# LINE 555 "src-ag/Order.ag" #-} rule91 = \ ((_nontsIadditionalDep) :: Seq Edge) ((_nontsIdirectDep) :: Seq Edge) -> {-# LINE 555 "src-ag/Order.ag" #-} toList (_nontsIdirectDep Seq.>< _nontsIadditionalDep) {-# LINE 1005 "dist/build/Order.hs"#-} {-# INLINE rule92 #-} {-# LINE 556 "src-ag/Order.ag" #-} rule92 = \ ((_nontsIinstDep) :: Seq Edge) -> {-# LINE 556 "src-ag/Order.ag" #-} toList _nontsIinstDep {-# LINE 1011 "dist/build/Order.hs"#-} {-# INLINE rule93 #-} {-# LINE 557 "src-ag/Order.ag" #-} rule93 = \ ((_nontsIaroundDep) :: Seq Edge) -> {-# LINE 557 "src-ag/Order.ag" #-} toList _nontsIaroundDep {-# LINE 1017 "dist/build/Order.hs"#-} {-# INLINE rule94 #-} {-# LINE 558 "src-ag/Order.ag" #-} rule94 = \ ((_nontsImergeDep) :: Seq Edge) -> {-# LINE 558 "src-ag/Order.ag" #-} toList _nontsImergeDep {-# LINE 1023 "dist/build/Order.hs"#-} {-# INLINE rule95 #-} {-# LINE 559 "src-ag/Order.ag" #-} rule95 = \ _attrTable ((_nontsIacount) :: Int) ((_nontsIaranges) :: Seq (Int,Int,Int)) ((_nontsInonts) :: [(NontermIdent,[ConstructorIdent])]) ((_nontsIvcount) :: Int) _ruleTable _tdpToTds _tdsToTdp wrappers_ -> {-# LINE 559 "src-ag/Order.ag" #-} let def [] = -1 def (v:vs) = v in Info { tdsToTdp = Array.array (0,_nontsIacount-1) _tdsToTdp , tdpToTds = Array.array (0,_nontsIvcount-1) _tdpToTds , attrTable = _attrTable , ruleTable = _ruleTable , lmh = toList _nontsIaranges , nonts = _nontsInonts , wraps = wrappers_ } {-# LINE 1038 "dist/build/Order.hs"#-} {-# INLINE rule96 #-} {-# LINE 571 "src-ag/Order.ag" #-} rule96 = \ _aroundDep _attrTable _directDep _info _instDep ((_lhsIoptions) :: Options) _mergeDep _ruleTable -> {-# LINE 571 "src-ag/Order.ag" #-} case computeSequential _info _directDep (_instDep ++ _aroundDep ++ _mergeDep ) of CycleFree cim cvm -> ( cim , cvm , [] ) LocalCycle errs -> ( error "No interfaces for AG with local cycles" , error "No visit sub-sequences for AG with local cycles" , map (localCycleErr _ruleTable (visit _lhsIoptions)) errs ) InstCycle errs -> ( error "No interfaces for AG with cycles through insts" , error "No visit sub-sequences for AG with cycles through insts" , map (instCycleErr _ruleTable (visit _lhsIoptions)) errs ) DirectCycle errs -> ( error "No interfaces for AG with direct cycles" , error "No visit sub-sequences for AG with direct cycles" , directCycleErrs _attrTable _ruleTable (visit _lhsIoptions) errs ) InducedCycle cim errs -> ( cim , error "No visit sub-sequences for AG with induced cycles" , inducedCycleErrs _attrTable _ruleTable cim errs ) {-# LINE 1064 "dist/build/Order.hs"#-} {-# INLINE rule97 #-} {-# LINE 592 "src-ag/Order.ag" #-} rule97 = \ _cyclesErrors ((_lhsIoptions) :: Options) ((_nontsIerrors) :: Seq Error) -> {-# LINE 592 "src-ag/Order.ag" #-} (if withCycle _lhsIoptions then Seq.fromList _cyclesErrors else Seq.empty) Seq.>< _nontsIerrors {-# LINE 1071 "dist/build/Order.hs"#-} {-# INLINE rule98 #-} {-# LINE 624 "src-ag/Order.ag" #-} rule98 = \ _aroundMap _mergeMap ((_nontsIcNonterminals) :: CNonterminals) _o_dovisit contextMap_ derivings_ paramMap_ pragmas_ quantMap_ typeSyns_ wrappers_ -> {-# LINE 624 "src-ag/Order.ag" #-} CGrammar typeSyns_ derivings_ wrappers_ _nontsIcNonterminals pragmas_ paramMap_ contextMap_ quantMap_ _aroundMap _mergeMap _o_dovisit {-# LINE 1077 "dist/build/Order.hs"#-} {-# INLINE rule99 #-} {-# LINE 637 "src-ag/Order.ag" #-} rule99 = \ aroundsMap_ -> {-# LINE 637 "src-ag/Order.ag" #-} Map.map (Map.map Map.keysSet) aroundsMap_ {-# LINE 1083 "dist/build/Order.hs"#-} {-# INLINE rule100 #-} {-# LINE 638 "src-ag/Order.ag" #-} rule100 = \ mergeMap_ -> {-# LINE 638 "src-ag/Order.ag" #-} Map.map (Map.map (Map.map (\(nt,srcs,_) -> (nt,srcs)))) mergeMap_ {-# LINE 1089 "dist/build/Order.hs"#-} {-# INLINE rule101 #-} {-# LINE 655 "src-ag/Order.ag" #-} rule101 = \ ((_nontsInonts) :: [(NontermIdent,[ConstructorIdent])]) -> {-# LINE 655 "src-ag/Order.ag" #-} map fst (_nontsInonts) {-# LINE 1095 "dist/build/Order.hs"#-} {-# INLINE rule102 #-} rule102 = \ ((_nontsInAutoRules) :: Int) -> _nontsInAutoRules {-# INLINE rule103 #-} rule103 = \ ((_nontsInExplicitRules) :: Int) -> _nontsInExplicitRules {-# INLINE rule104 #-} rule104 = \ _cInterfaceMap -> _cInterfaceMap {-# INLINE rule105 #-} rule105 = \ _cVisitsMap -> _cVisitsMap {-# INLINE rule106 #-} rule106 = \ _mergeMap -> _mergeMap {-# INLINE rule107 #-} rule107 = \ _o_dovisit -> _o_dovisit {-# INLINE rule108 #-} rule108 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- Nonterminal ------------------------------------------------- -- wrapper data Inh_Nonterminal = Inh_Nonterminal { acount_Inh_Nonterminal :: (Int), allnts_Inh_Nonterminal :: ([Identifier]), aroundMap_Inh_Nonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), cInterfaceMap_Inh_Nonterminal :: (CInterfaceMap), cVisitsMap_Inh_Nonterminal :: (CVisitsMap), inhMap_Inh_Nonterminal :: (Map Identifier Attributes), manualAttrDepMap_Inh_Nonterminal :: (AttrOrderMap), mergeMap_Inh_Nonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))), o_case_Inh_Nonterminal :: (Bool), o_cata_Inh_Nonterminal :: (Bool), o_data_Inh_Nonterminal :: (Bool), o_dovisit_Inh_Nonterminal :: (Bool), o_newtypes_Inh_Nonterminal :: (Bool), o_rename_Inh_Nonterminal :: (Bool), o_sem_Inh_Nonterminal :: (Bool), o_sig_Inh_Nonterminal :: (Bool), o_unbox_Inh_Nonterminal :: (Bool), o_wantvisit_Inh_Nonterminal :: (Bool), options_Inh_Nonterminal :: (Options), prefix_Inh_Nonterminal :: (String), synMap_Inh_Nonterminal :: (Map Identifier Attributes), vcount_Inh_Nonterminal :: (Int) } data Syn_Nonterminal = Syn_Nonterminal { acount_Syn_Nonterminal :: (Int), additionalDep_Syn_Nonterminal :: (Seq Edge), aranges_Syn_Nonterminal :: (Seq (Int,Int,Int)), aroundDep_Syn_Nonterminal :: (Seq Edge), cNonterminal_Syn_Nonterminal :: (CNonterminal), directDep_Syn_Nonterminal :: (Seq Edge), errors_Syn_Nonterminal :: (Seq Error), inhMap'_Syn_Nonterminal :: (Map Identifier Attributes), instDep_Syn_Nonterminal :: (Seq Edge), mergeDep_Syn_Nonterminal :: (Seq Edge), nAutoRules_Syn_Nonterminal :: (Int), nExplicitRules_Syn_Nonterminal :: (Int), nonts_Syn_Nonterminal :: ([(NontermIdent,[ConstructorIdent])]), ntattrs_Syn_Nonterminal :: (Seq (Vertex,NTAttr)), rules_Syn_Nonterminal :: (Seq (Vertex,CRule)), synMap'_Syn_Nonterminal :: (Map Identifier Attributes), vcount_Syn_Nonterminal :: (Int) } {-# INLINABLE wrap_Nonterminal #-} wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal ) wrap_Nonterminal (T_Nonterminal act) (Inh_Nonterminal _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsynMap _lhsIvcount) = Control.Monad.Identity.runIdentity ( do sem <- act let arg13 = T_Nonterminal_vIn13 _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsynMap _lhsIvcount (T_Nonterminal_vOut13 _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOaroundDep _lhsOcNonterminal _lhsOdirectDep _lhsOerrors _lhsOinhMap' _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOnonts _lhsOntattrs _lhsOrules _lhsOsynMap' _lhsOvcount) <- return (inv_Nonterminal_s14 sem arg13) return (Syn_Nonterminal _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOaroundDep _lhsOcNonterminal _lhsOdirectDep _lhsOerrors _lhsOinhMap' _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOnonts _lhsOntattrs _lhsOrules _lhsOsynMap' _lhsOvcount) ) -- cata {-# INLINE sem_Nonterminal #-} sem_Nonterminal :: Nonterminal -> T_Nonterminal sem_Nonterminal ( Nonterminal nt_ params_ inh_ syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ ) -- semantic domain newtype T_Nonterminal = T_Nonterminal { attach_T_Nonterminal :: Identity (T_Nonterminal_s14 ) } newtype T_Nonterminal_s14 = C_Nonterminal_s14 { inv_Nonterminal_s14 :: (T_Nonterminal_v13 ) } data T_Nonterminal_s15 = C_Nonterminal_s15 type T_Nonterminal_v13 = (T_Nonterminal_vIn13 ) -> (T_Nonterminal_vOut13 ) data T_Nonterminal_vIn13 = T_Nonterminal_vIn13 (Int) ([Identifier]) (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) (CInterfaceMap) (CVisitsMap) (Map Identifier Attributes) (AttrOrderMap) (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (String) (Map Identifier Attributes) (Int) data T_Nonterminal_vOut13 = T_Nonterminal_vOut13 (Int) (Seq Edge) (Seq (Int,Int,Int)) (Seq Edge) (CNonterminal) (Seq Edge) (Seq Error) (Map Identifier Attributes) (Seq Edge) (Seq Edge) (Int) (Int) ([(NontermIdent,[ConstructorIdent])]) (Seq (Vertex,NTAttr)) (Seq (Vertex,CRule)) (Map Identifier Attributes) (Int) {-# NOINLINE sem_Nonterminal_Nonterminal #-} sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal sem_Nonterminal_Nonterminal arg_nt_ arg_params_ arg_inh_ arg_syn_ arg_prods_ = T_Nonterminal (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_Nonterminal_v13 v13 = \ (T_Nonterminal_vIn13 _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsynMap _lhsIvcount) -> ( let _prodsX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) (T_Productions_vOut28 _prodsIadditionalDep _prodsIaroundDep _prodsIcProductions _prodsIcons _prodsIdirectDep _prodsIerrors _prodsIinstDep _prodsImergeDep _prodsInAutoRules _prodsInExplicitRules _prodsIrules _prodsIvcount) = inv_Productions_s29 _prodsX29 (T_Productions_vIn28 _prodsOallnts _prodsOaroundMap _prodsOcVisitsMap _prodsOinh _prodsOinhMap _prodsOmanualAttrDepMap _prodsOmergeMap _prodsOnt _prodsOo_case _prodsOo_cata _prodsOo_dovisit _prodsOo_newtypes _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_unbox _prodsOo_wantvisit _prodsOoptions _prodsOprefix _prodsOsyn _prodsOsynMap _prodsOvcount) _lhsOinhMap' :: Map Identifier Attributes _lhsOinhMap' = rule109 arg_inh_ arg_nt_ _lhsOsynMap' :: Map Identifier Attributes _lhsOsynMap' = rule110 arg_nt_ arg_syn_ _prodsOnt = rule111 arg_nt_ _prodsOinh = rule112 arg_inh_ _prodsOsyn = rule113 arg_syn_ _mergeMap = rule114 _lhsImergeMap arg_nt_ _aroundMap = rule115 _lhsIaroundMap arg_nt_ _ntattrs = rule116 arg_inh_ arg_nt_ arg_syn_ _lhsOntattrs :: Seq (Vertex,NTAttr) _lhsOntattrs = rule117 _lhsIacount _ntattrs _lhsOacount :: Int _lhsOacount = rule118 _lhsIacount arg_inh_ arg_syn_ _lhsOaranges :: Seq (Int,Int,Int) _lhsOaranges = rule119 _lhsIacount arg_inh_ arg_syn_ _lhsOnonts :: [(NontermIdent,[ConstructorIdent])] _lhsOnonts = rule120 _prodsIcons arg_nt_ _cInter = rule121 _lhsIcInterfaceMap _lhsIo_dovisit arg_inh_ arg_nt_ arg_syn_ _lhsOcNonterminal :: CNonterminal _lhsOcNonterminal = rule122 _cInter _prodsIcProductions arg_inh_ arg_nt_ arg_params_ arg_syn_ _lhsOadditionalDep :: Seq Edge _lhsOadditionalDep = rule123 _prodsIadditionalDep _lhsOaroundDep :: Seq Edge _lhsOaroundDep = rule124 _prodsIaroundDep _lhsOdirectDep :: Seq Edge _lhsOdirectDep = rule125 _prodsIdirectDep _lhsOerrors :: Seq Error _lhsOerrors = rule126 _prodsIerrors _lhsOinstDep :: Seq Edge _lhsOinstDep = rule127 _prodsIinstDep _lhsOmergeDep :: Seq Edge _lhsOmergeDep = rule128 _prodsImergeDep _lhsOnAutoRules :: Int _lhsOnAutoRules = rule129 _prodsInAutoRules _lhsOnExplicitRules :: Int _lhsOnExplicitRules = rule130 _prodsInExplicitRules _lhsOrules :: Seq (Vertex,CRule) _lhsOrules = rule131 _prodsIrules _lhsOvcount :: Int _lhsOvcount = rule132 _prodsIvcount _prodsOallnts = rule133 _lhsIallnts _prodsOaroundMap = rule134 _aroundMap _prodsOcVisitsMap = rule135 _lhsIcVisitsMap _prodsOinhMap = rule136 _lhsIinhMap _prodsOmanualAttrDepMap = rule137 _lhsImanualAttrDepMap _prodsOmergeMap = rule138 _mergeMap _prodsOo_case = rule139 _lhsIo_case _prodsOo_cata = rule140 _lhsIo_cata _prodsOo_dovisit = rule141 _lhsIo_dovisit _prodsOo_newtypes = rule142 _lhsIo_newtypes _prodsOo_rename = rule143 _lhsIo_rename _prodsOo_sem = rule144 _lhsIo_sem _prodsOo_sig = rule145 _lhsIo_sig _prodsOo_unbox = rule146 _lhsIo_unbox _prodsOo_wantvisit = rule147 _lhsIo_wantvisit _prodsOoptions = rule148 _lhsIoptions _prodsOprefix = rule149 _lhsIprefix _prodsOsynMap = rule150 _lhsIsynMap _prodsOvcount = rule151 _lhsIvcount __result_ = T_Nonterminal_vOut13 _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOaroundDep _lhsOcNonterminal _lhsOdirectDep _lhsOerrors _lhsOinhMap' _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOnonts _lhsOntattrs _lhsOrules _lhsOsynMap' _lhsOvcount in __result_ ) in C_Nonterminal_s14 v13 {-# INLINE rule109 #-} {-# LINE 7 "src-ag/DistChildAttr.ag" #-} rule109 = \ inh_ nt_ -> {-# LINE 7 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ inh_ {-# LINE 1225 "dist/build/Order.hs"#-} {-# INLINE rule110 #-} {-# LINE 8 "src-ag/DistChildAttr.ag" #-} rule110 = \ nt_ syn_ -> {-# LINE 8 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ syn_ {-# LINE 1231 "dist/build/Order.hs"#-} {-# INLINE rule111 #-} {-# LINE 97 "src-ag/Order.ag" #-} rule111 = \ nt_ -> {-# LINE 97 "src-ag/Order.ag" #-} nt_ {-# LINE 1237 "dist/build/Order.hs"#-} {-# INLINE rule112 #-} {-# LINE 100 "src-ag/Order.ag" #-} rule112 = \ inh_ -> {-# LINE 100 "src-ag/Order.ag" #-} inh_ {-# LINE 1243 "dist/build/Order.hs"#-} {-# INLINE rule113 #-} {-# LINE 101 "src-ag/Order.ag" #-} rule113 = \ syn_ -> {-# LINE 101 "src-ag/Order.ag" #-} syn_ {-# LINE 1249 "dist/build/Order.hs"#-} {-# INLINE rule114 #-} {-# LINE 360 "src-ag/Order.ag" #-} rule114 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) nt_ -> {-# LINE 360 "src-ag/Order.ag" #-} Map.findWithDefault Map.empty nt_ _lhsImergeMap {-# LINE 1255 "dist/build/Order.hs"#-} {-# INLINE rule115 #-} {-# LINE 413 "src-ag/Order.ag" #-} rule115 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) nt_ -> {-# LINE 413 "src-ag/Order.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIaroundMap {-# LINE 1261 "dist/build/Order.hs"#-} {-# INLINE rule116 #-} {-# LINE 511 "src-ag/Order.ag" #-} rule116 = \ inh_ nt_ syn_ -> {-# LINE 511 "src-ag/Order.ag" #-} [ NTAInh nt_ inh tp | (inh,tp) <- Map.assocs inh_ ] ++ [NTASyn nt_ syn tp | (syn,tp) <- Map.assocs syn_ ] {-# LINE 1268 "dist/build/Order.hs"#-} {-# INLINE rule117 #-} {-# LINE 513 "src-ag/Order.ag" #-} rule117 = \ ((_lhsIacount) :: Int) _ntattrs -> {-# LINE 513 "src-ag/Order.ag" #-} Seq.fromList (zip [_lhsIacount ..] _ntattrs) {-# LINE 1274 "dist/build/Order.hs"#-} {-# INLINE rule118 #-} {-# LINE 514 "src-ag/Order.ag" #-} rule118 = \ ((_lhsIacount) :: Int) inh_ syn_ -> {-# LINE 514 "src-ag/Order.ag" #-} _lhsIacount + Map.size inh_ + Map.size syn_ {-# LINE 1280 "dist/build/Order.hs"#-} {-# INLINE rule119 #-} {-# LINE 515 "src-ag/Order.ag" #-} rule119 = \ ((_lhsIacount) :: Int) inh_ syn_ -> {-# LINE 515 "src-ag/Order.ag" #-} Seq.singleton (_lhsIacount ,_lhsIacount + Map.size inh_ ,_lhsIacount + Map.size syn_ + Map.size inh_ - 1) {-# LINE 1289 "dist/build/Order.hs"#-} {-# INLINE rule120 #-} {-# LINE 524 "src-ag/Order.ag" #-} rule120 = \ ((_prodsIcons) :: [ConstructorIdent]) nt_ -> {-# LINE 524 "src-ag/Order.ag" #-} [(nt_,_prodsIcons)] {-# LINE 1295 "dist/build/Order.hs"#-} {-# INLINE rule121 #-} {-# LINE 601 "src-ag/Order.ag" #-} rule121 = \ ((_lhsIcInterfaceMap) :: CInterfaceMap) ((_lhsIo_dovisit) :: Bool) inh_ nt_ syn_ -> {-# LINE 601 "src-ag/Order.ag" #-} if _lhsIo_dovisit then findWithErr1 "Nonterminal.cInter" nt_ _lhsIcInterfaceMap else CInterface [CSegment inh_ syn_] {-# LINE 1303 "dist/build/Order.hs"#-} {-# INLINE rule122 #-} {-# LINE 629 "src-ag/Order.ag" #-} rule122 = \ _cInter ((_prodsIcProductions) :: CProductions) inh_ nt_ params_ syn_ -> {-# LINE 629 "src-ag/Order.ag" #-} CNonterminal nt_ params_ inh_ syn_ _prodsIcProductions _cInter {-# LINE 1309 "dist/build/Order.hs"#-} {-# INLINE rule123 #-} rule123 = \ ((_prodsIadditionalDep) :: Seq Edge) -> _prodsIadditionalDep {-# INLINE rule124 #-} rule124 = \ ((_prodsIaroundDep) :: Seq Edge) -> _prodsIaroundDep {-# INLINE rule125 #-} rule125 = \ ((_prodsIdirectDep) :: Seq Edge) -> _prodsIdirectDep {-# INLINE rule126 #-} rule126 = \ ((_prodsIerrors) :: Seq Error) -> _prodsIerrors {-# INLINE rule127 #-} rule127 = \ ((_prodsIinstDep) :: Seq Edge) -> _prodsIinstDep {-# INLINE rule128 #-} rule128 = \ ((_prodsImergeDep) :: Seq Edge) -> _prodsImergeDep {-# INLINE rule129 #-} rule129 = \ ((_prodsInAutoRules) :: Int) -> _prodsInAutoRules {-# INLINE rule130 #-} rule130 = \ ((_prodsInExplicitRules) :: Int) -> _prodsInExplicitRules {-# INLINE rule131 #-} rule131 = \ ((_prodsIrules) :: Seq (Vertex,CRule)) -> _prodsIrules {-# INLINE rule132 #-} rule132 = \ ((_prodsIvcount) :: Int) -> _prodsIvcount {-# INLINE rule133 #-} rule133 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule134 #-} rule134 = \ _aroundMap -> _aroundMap {-# INLINE rule135 #-} rule135 = \ ((_lhsIcVisitsMap) :: CVisitsMap) -> _lhsIcVisitsMap {-# INLINE rule136 #-} rule136 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule137 #-} rule137 = \ ((_lhsImanualAttrDepMap) :: AttrOrderMap) -> _lhsImanualAttrDepMap {-# INLINE rule138 #-} rule138 = \ _mergeMap -> _mergeMap {-# INLINE rule139 #-} rule139 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule140 #-} rule140 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule141 #-} rule141 = \ ((_lhsIo_dovisit) :: Bool) -> _lhsIo_dovisit {-# INLINE rule142 #-} rule142 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule143 #-} rule143 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule144 #-} rule144 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule145 #-} rule145 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule146 #-} rule146 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule147 #-} rule147 = \ ((_lhsIo_wantvisit) :: Bool) -> _lhsIo_wantvisit {-# INLINE rule148 #-} rule148 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule149 #-} rule149 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule150 #-} rule150 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule151 #-} rule151 = \ ((_lhsIvcount) :: Int) -> _lhsIvcount -- Nonterminals ------------------------------------------------ -- wrapper data Inh_Nonterminals = Inh_Nonterminals { acount_Inh_Nonterminals :: (Int), allnts_Inh_Nonterminals :: ([Identifier]), aroundMap_Inh_Nonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), cInterfaceMap_Inh_Nonterminals :: (CInterfaceMap), cVisitsMap_Inh_Nonterminals :: (CVisitsMap), inhMap_Inh_Nonterminals :: (Map Identifier Attributes), manualAttrDepMap_Inh_Nonterminals :: (AttrOrderMap), mergeMap_Inh_Nonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))), o_case_Inh_Nonterminals :: (Bool), o_cata_Inh_Nonterminals :: (Bool), o_data_Inh_Nonterminals :: (Bool), o_dovisit_Inh_Nonterminals :: (Bool), o_newtypes_Inh_Nonterminals :: (Bool), o_rename_Inh_Nonterminals :: (Bool), o_sem_Inh_Nonterminals :: (Bool), o_sig_Inh_Nonterminals :: (Bool), o_unbox_Inh_Nonterminals :: (Bool), o_wantvisit_Inh_Nonterminals :: (Bool), options_Inh_Nonterminals :: (Options), prefix_Inh_Nonterminals :: (String), synMap_Inh_Nonterminals :: (Map Identifier Attributes), vcount_Inh_Nonterminals :: (Int) } data Syn_Nonterminals = Syn_Nonterminals { acount_Syn_Nonterminals :: (Int), additionalDep_Syn_Nonterminals :: (Seq Edge), aranges_Syn_Nonterminals :: (Seq (Int,Int,Int)), aroundDep_Syn_Nonterminals :: (Seq Edge), cNonterminals_Syn_Nonterminals :: (CNonterminals), directDep_Syn_Nonterminals :: (Seq Edge), errors_Syn_Nonterminals :: (Seq Error), inhMap'_Syn_Nonterminals :: (Map Identifier Attributes), instDep_Syn_Nonterminals :: (Seq Edge), mergeDep_Syn_Nonterminals :: (Seq Edge), nAutoRules_Syn_Nonterminals :: (Int), nExplicitRules_Syn_Nonterminals :: (Int), nonts_Syn_Nonterminals :: ([(NontermIdent,[ConstructorIdent])]), ntattrs_Syn_Nonterminals :: (Seq (Vertex,NTAttr)), rules_Syn_Nonterminals :: (Seq (Vertex,CRule)), synMap'_Syn_Nonterminals :: (Map Identifier Attributes), vcount_Syn_Nonterminals :: (Int) } {-# INLINABLE wrap_Nonterminals #-} wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals ) wrap_Nonterminals (T_Nonterminals act) (Inh_Nonterminals _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsynMap _lhsIvcount) = Control.Monad.Identity.runIdentity ( do sem <- act let arg16 = T_Nonterminals_vIn16 _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsynMap _lhsIvcount (T_Nonterminals_vOut16 _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOaroundDep _lhsOcNonterminals _lhsOdirectDep _lhsOerrors _lhsOinhMap' _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOnonts _lhsOntattrs _lhsOrules _lhsOsynMap' _lhsOvcount) <- return (inv_Nonterminals_s17 sem arg16) return (Syn_Nonterminals _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOaroundDep _lhsOcNonterminals _lhsOdirectDep _lhsOerrors _lhsOinhMap' _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOnonts _lhsOntattrs _lhsOrules _lhsOsynMap' _lhsOvcount) ) -- cata {-# NOINLINE sem_Nonterminals #-} sem_Nonterminals :: Nonterminals -> T_Nonterminals sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) -- semantic domain newtype T_Nonterminals = T_Nonterminals { attach_T_Nonterminals :: Identity (T_Nonterminals_s17 ) } newtype T_Nonterminals_s17 = C_Nonterminals_s17 { inv_Nonterminals_s17 :: (T_Nonterminals_v16 ) } data T_Nonterminals_s18 = C_Nonterminals_s18 type T_Nonterminals_v16 = (T_Nonterminals_vIn16 ) -> (T_Nonterminals_vOut16 ) data T_Nonterminals_vIn16 = T_Nonterminals_vIn16 (Int) ([Identifier]) (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) (CInterfaceMap) (CVisitsMap) (Map Identifier Attributes) (AttrOrderMap) (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (String) (Map Identifier Attributes) (Int) data T_Nonterminals_vOut16 = T_Nonterminals_vOut16 (Int) (Seq Edge) (Seq (Int,Int,Int)) (Seq Edge) (CNonterminals) (Seq Edge) (Seq Error) (Map Identifier Attributes) (Seq Edge) (Seq Edge) (Int) (Int) ([(NontermIdent,[ConstructorIdent])]) (Seq (Vertex,NTAttr)) (Seq (Vertex,CRule)) (Map Identifier Attributes) (Int) {-# NOINLINE sem_Nonterminals_Cons #-} sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Nonterminals_v16 v16 = \ (T_Nonterminals_vIn16 _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsynMap _lhsIvcount) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) (T_Nonterminal_vOut13 _hdIacount _hdIadditionalDep _hdIaranges _hdIaroundDep _hdIcNonterminal _hdIdirectDep _hdIerrors _hdIinhMap' _hdIinstDep _hdImergeDep _hdInAutoRules _hdInExplicitRules _hdInonts _hdIntattrs _hdIrules _hdIsynMap' _hdIvcount) = inv_Nonterminal_s14 _hdX14 (T_Nonterminal_vIn13 _hdOacount _hdOallnts _hdOaroundMap _hdOcInterfaceMap _hdOcVisitsMap _hdOinhMap _hdOmanualAttrDepMap _hdOmergeMap _hdOo_case _hdOo_cata _hdOo_data _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_unbox _hdOo_wantvisit _hdOoptions _hdOprefix _hdOsynMap _hdOvcount) (T_Nonterminals_vOut16 _tlIacount _tlIadditionalDep _tlIaranges _tlIaroundDep _tlIcNonterminals _tlIdirectDep _tlIerrors _tlIinhMap' _tlIinstDep _tlImergeDep _tlInAutoRules _tlInExplicitRules _tlInonts _tlIntattrs _tlIrules _tlIsynMap' _tlIvcount) = inv_Nonterminals_s17 _tlX17 (T_Nonterminals_vIn16 _tlOacount _tlOallnts _tlOaroundMap _tlOcInterfaceMap _tlOcVisitsMap _tlOinhMap _tlOmanualAttrDepMap _tlOmergeMap _tlOo_case _tlOo_cata _tlOo_data _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_unbox _tlOo_wantvisit _tlOoptions _tlOprefix _tlOsynMap _tlOvcount) _lhsOcNonterminals :: CNonterminals _lhsOcNonterminals = rule152 _hdIcNonterminal _tlIcNonterminals _lhsOadditionalDep :: Seq Edge _lhsOadditionalDep = rule153 _hdIadditionalDep _tlIadditionalDep _lhsOaranges :: Seq (Int,Int,Int) _lhsOaranges = rule154 _hdIaranges _tlIaranges _lhsOaroundDep :: Seq Edge _lhsOaroundDep = rule155 _hdIaroundDep _tlIaroundDep _lhsOdirectDep :: Seq Edge _lhsOdirectDep = rule156 _hdIdirectDep _tlIdirectDep _lhsOerrors :: Seq Error _lhsOerrors = rule157 _hdIerrors _tlIerrors _lhsOinhMap' :: Map Identifier Attributes _lhsOinhMap' = rule158 _hdIinhMap' _tlIinhMap' _lhsOinstDep :: Seq Edge _lhsOinstDep = rule159 _hdIinstDep _tlIinstDep _lhsOmergeDep :: Seq Edge _lhsOmergeDep = rule160 _hdImergeDep _tlImergeDep _lhsOnAutoRules :: Int _lhsOnAutoRules = rule161 _hdInAutoRules _tlInAutoRules _lhsOnExplicitRules :: Int _lhsOnExplicitRules = rule162 _hdInExplicitRules _tlInExplicitRules _lhsOnonts :: [(NontermIdent,[ConstructorIdent])] _lhsOnonts = rule163 _hdInonts _tlInonts _lhsOntattrs :: Seq (Vertex,NTAttr) _lhsOntattrs = rule164 _hdIntattrs _tlIntattrs _lhsOrules :: Seq (Vertex,CRule) _lhsOrules = rule165 _hdIrules _tlIrules _lhsOsynMap' :: Map Identifier Attributes _lhsOsynMap' = rule166 _hdIsynMap' _tlIsynMap' _lhsOacount :: Int _lhsOacount = rule167 _tlIacount _lhsOvcount :: Int _lhsOvcount = rule168 _tlIvcount _hdOacount = rule169 _lhsIacount _hdOallnts = rule170 _lhsIallnts _hdOaroundMap = rule171 _lhsIaroundMap _hdOcInterfaceMap = rule172 _lhsIcInterfaceMap _hdOcVisitsMap = rule173 _lhsIcVisitsMap _hdOinhMap = rule174 _lhsIinhMap _hdOmanualAttrDepMap = rule175 _lhsImanualAttrDepMap _hdOmergeMap = rule176 _lhsImergeMap _hdOo_case = rule177 _lhsIo_case _hdOo_cata = rule178 _lhsIo_cata _hdOo_data = rule179 _lhsIo_data _hdOo_dovisit = rule180 _lhsIo_dovisit _hdOo_newtypes = rule181 _lhsIo_newtypes _hdOo_rename = rule182 _lhsIo_rename _hdOo_sem = rule183 _lhsIo_sem _hdOo_sig = rule184 _lhsIo_sig _hdOo_unbox = rule185 _lhsIo_unbox _hdOo_wantvisit = rule186 _lhsIo_wantvisit _hdOoptions = rule187 _lhsIoptions _hdOprefix = rule188 _lhsIprefix _hdOsynMap = rule189 _lhsIsynMap _hdOvcount = rule190 _lhsIvcount _tlOacount = rule191 _hdIacount _tlOallnts = rule192 _lhsIallnts _tlOaroundMap = rule193 _lhsIaroundMap _tlOcInterfaceMap = rule194 _lhsIcInterfaceMap _tlOcVisitsMap = rule195 _lhsIcVisitsMap _tlOinhMap = rule196 _lhsIinhMap _tlOmanualAttrDepMap = rule197 _lhsImanualAttrDepMap _tlOmergeMap = rule198 _lhsImergeMap _tlOo_case = rule199 _lhsIo_case _tlOo_cata = rule200 _lhsIo_cata _tlOo_data = rule201 _lhsIo_data _tlOo_dovisit = rule202 _lhsIo_dovisit _tlOo_newtypes = rule203 _lhsIo_newtypes _tlOo_rename = rule204 _lhsIo_rename _tlOo_sem = rule205 _lhsIo_sem _tlOo_sig = rule206 _lhsIo_sig _tlOo_unbox = rule207 _lhsIo_unbox _tlOo_wantvisit = rule208 _lhsIo_wantvisit _tlOoptions = rule209 _lhsIoptions _tlOprefix = rule210 _lhsIprefix _tlOsynMap = rule211 _lhsIsynMap _tlOvcount = rule212 _hdIvcount __result_ = T_Nonterminals_vOut16 _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOaroundDep _lhsOcNonterminals _lhsOdirectDep _lhsOerrors _lhsOinhMap' _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOnonts _lhsOntattrs _lhsOrules _lhsOsynMap' _lhsOvcount in __result_ ) in C_Nonterminals_s17 v16 {-# INLINE rule152 #-} {-# LINE 626 "src-ag/Order.ag" #-} rule152 = \ ((_hdIcNonterminal) :: CNonterminal) ((_tlIcNonterminals) :: CNonterminals) -> {-# LINE 626 "src-ag/Order.ag" #-} _hdIcNonterminal : _tlIcNonterminals {-# LINE 1525 "dist/build/Order.hs"#-} {-# INLINE rule153 #-} rule153 = \ ((_hdIadditionalDep) :: Seq Edge) ((_tlIadditionalDep) :: Seq Edge) -> _hdIadditionalDep Seq.>< _tlIadditionalDep {-# INLINE rule154 #-} rule154 = \ ((_hdIaranges) :: Seq (Int,Int,Int)) ((_tlIaranges) :: Seq (Int,Int,Int)) -> _hdIaranges Seq.>< _tlIaranges {-# INLINE rule155 #-} rule155 = \ ((_hdIaroundDep) :: Seq Edge) ((_tlIaroundDep) :: Seq Edge) -> _hdIaroundDep Seq.>< _tlIaroundDep {-# INLINE rule156 #-} rule156 = \ ((_hdIdirectDep) :: Seq Edge) ((_tlIdirectDep) :: Seq Edge) -> _hdIdirectDep Seq.>< _tlIdirectDep {-# INLINE rule157 #-} rule157 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule158 #-} rule158 = \ ((_hdIinhMap') :: Map Identifier Attributes) ((_tlIinhMap') :: Map Identifier Attributes) -> _hdIinhMap' `Map.union` _tlIinhMap' {-# INLINE rule159 #-} rule159 = \ ((_hdIinstDep) :: Seq Edge) ((_tlIinstDep) :: Seq Edge) -> _hdIinstDep Seq.>< _tlIinstDep {-# INLINE rule160 #-} rule160 = \ ((_hdImergeDep) :: Seq Edge) ((_tlImergeDep) :: Seq Edge) -> _hdImergeDep Seq.>< _tlImergeDep {-# INLINE rule161 #-} rule161 = \ ((_hdInAutoRules) :: Int) ((_tlInAutoRules) :: Int) -> _hdInAutoRules + _tlInAutoRules {-# INLINE rule162 #-} rule162 = \ ((_hdInExplicitRules) :: Int) ((_tlInExplicitRules) :: Int) -> _hdInExplicitRules + _tlInExplicitRules {-# INLINE rule163 #-} rule163 = \ ((_hdInonts) :: [(NontermIdent,[ConstructorIdent])]) ((_tlInonts) :: [(NontermIdent,[ConstructorIdent])]) -> _hdInonts ++ _tlInonts {-# INLINE rule164 #-} rule164 = \ ((_hdIntattrs) :: Seq (Vertex,NTAttr)) ((_tlIntattrs) :: Seq (Vertex,NTAttr)) -> _hdIntattrs Seq.>< _tlIntattrs {-# INLINE rule165 #-} rule165 = \ ((_hdIrules) :: Seq (Vertex,CRule)) ((_tlIrules) :: Seq (Vertex,CRule)) -> _hdIrules Seq.>< _tlIrules {-# INLINE rule166 #-} rule166 = \ ((_hdIsynMap') :: Map Identifier Attributes) ((_tlIsynMap') :: Map Identifier Attributes) -> _hdIsynMap' `Map.union` _tlIsynMap' {-# INLINE rule167 #-} rule167 = \ ((_tlIacount) :: Int) -> _tlIacount {-# INLINE rule168 #-} rule168 = \ ((_tlIvcount) :: Int) -> _tlIvcount {-# INLINE rule169 #-} rule169 = \ ((_lhsIacount) :: Int) -> _lhsIacount {-# INLINE rule170 #-} rule170 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule171 #-} rule171 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> _lhsIaroundMap {-# INLINE rule172 #-} rule172 = \ ((_lhsIcInterfaceMap) :: CInterfaceMap) -> _lhsIcInterfaceMap {-# INLINE rule173 #-} rule173 = \ ((_lhsIcVisitsMap) :: CVisitsMap) -> _lhsIcVisitsMap {-# INLINE rule174 #-} rule174 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule175 #-} rule175 = \ ((_lhsImanualAttrDepMap) :: AttrOrderMap) -> _lhsImanualAttrDepMap {-# INLINE rule176 #-} rule176 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> _lhsImergeMap {-# INLINE rule177 #-} rule177 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule178 #-} rule178 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule179 #-} rule179 = \ ((_lhsIo_data) :: Bool) -> _lhsIo_data {-# INLINE rule180 #-} rule180 = \ ((_lhsIo_dovisit) :: Bool) -> _lhsIo_dovisit {-# INLINE rule181 #-} rule181 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule182 #-} rule182 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule183 #-} rule183 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule184 #-} rule184 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule185 #-} rule185 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule186 #-} rule186 = \ ((_lhsIo_wantvisit) :: Bool) -> _lhsIo_wantvisit {-# INLINE rule187 #-} rule187 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule188 #-} rule188 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule189 #-} rule189 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule190 #-} rule190 = \ ((_lhsIvcount) :: Int) -> _lhsIvcount {-# INLINE rule191 #-} rule191 = \ ((_hdIacount) :: Int) -> _hdIacount {-# INLINE rule192 #-} rule192 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule193 #-} rule193 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> _lhsIaroundMap {-# INLINE rule194 #-} rule194 = \ ((_lhsIcInterfaceMap) :: CInterfaceMap) -> _lhsIcInterfaceMap {-# INLINE rule195 #-} rule195 = \ ((_lhsIcVisitsMap) :: CVisitsMap) -> _lhsIcVisitsMap {-# INLINE rule196 #-} rule196 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule197 #-} rule197 = \ ((_lhsImanualAttrDepMap) :: AttrOrderMap) -> _lhsImanualAttrDepMap {-# INLINE rule198 #-} rule198 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> _lhsImergeMap {-# INLINE rule199 #-} rule199 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule200 #-} rule200 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule201 #-} rule201 = \ ((_lhsIo_data) :: Bool) -> _lhsIo_data {-# INLINE rule202 #-} rule202 = \ ((_lhsIo_dovisit) :: Bool) -> _lhsIo_dovisit {-# INLINE rule203 #-} rule203 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule204 #-} rule204 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule205 #-} rule205 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule206 #-} rule206 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule207 #-} rule207 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule208 #-} rule208 = \ ((_lhsIo_wantvisit) :: Bool) -> _lhsIo_wantvisit {-# INLINE rule209 #-} rule209 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule210 #-} rule210 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule211 #-} rule211 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule212 #-} rule212 = \ ((_hdIvcount) :: Int) -> _hdIvcount {-# NOINLINE sem_Nonterminals_Nil #-} sem_Nonterminals_Nil :: T_Nonterminals sem_Nonterminals_Nil = T_Nonterminals (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Nonterminals_v16 v16 = \ (T_Nonterminals_vIn16 _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsynMap _lhsIvcount) -> ( let _lhsOcNonterminals :: CNonterminals _lhsOcNonterminals = rule213 () _lhsOadditionalDep :: Seq Edge _lhsOadditionalDep = rule214 () _lhsOaranges :: Seq (Int,Int,Int) _lhsOaranges = rule215 () _lhsOaroundDep :: Seq Edge _lhsOaroundDep = rule216 () _lhsOdirectDep :: Seq Edge _lhsOdirectDep = rule217 () _lhsOerrors :: Seq Error _lhsOerrors = rule218 () _lhsOinhMap' :: Map Identifier Attributes _lhsOinhMap' = rule219 () _lhsOinstDep :: Seq Edge _lhsOinstDep = rule220 () _lhsOmergeDep :: Seq Edge _lhsOmergeDep = rule221 () _lhsOnAutoRules :: Int _lhsOnAutoRules = rule222 () _lhsOnExplicitRules :: Int _lhsOnExplicitRules = rule223 () _lhsOnonts :: [(NontermIdent,[ConstructorIdent])] _lhsOnonts = rule224 () _lhsOntattrs :: Seq (Vertex,NTAttr) _lhsOntattrs = rule225 () _lhsOrules :: Seq (Vertex,CRule) _lhsOrules = rule226 () _lhsOsynMap' :: Map Identifier Attributes _lhsOsynMap' = rule227 () _lhsOacount :: Int _lhsOacount = rule228 _lhsIacount _lhsOvcount :: Int _lhsOvcount = rule229 _lhsIvcount __result_ = T_Nonterminals_vOut16 _lhsOacount _lhsOadditionalDep _lhsOaranges _lhsOaroundDep _lhsOcNonterminals _lhsOdirectDep _lhsOerrors _lhsOinhMap' _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOnonts _lhsOntattrs _lhsOrules _lhsOsynMap' _lhsOvcount in __result_ ) in C_Nonterminals_s17 v16 {-# INLINE rule213 #-} {-# LINE 627 "src-ag/Order.ag" #-} rule213 = \ (_ :: ()) -> {-# LINE 627 "src-ag/Order.ag" #-} [] {-# LINE 1755 "dist/build/Order.hs"#-} {-# INLINE rule214 #-} rule214 = \ (_ :: ()) -> Seq.empty {-# INLINE rule215 #-} rule215 = \ (_ :: ()) -> Seq.empty {-# INLINE rule216 #-} rule216 = \ (_ :: ()) -> Seq.empty {-# INLINE rule217 #-} rule217 = \ (_ :: ()) -> Seq.empty {-# INLINE rule218 #-} rule218 = \ (_ :: ()) -> Seq.empty {-# INLINE rule219 #-} rule219 = \ (_ :: ()) -> Map.empty {-# INLINE rule220 #-} rule220 = \ (_ :: ()) -> Seq.empty {-# INLINE rule221 #-} rule221 = \ (_ :: ()) -> Seq.empty {-# INLINE rule222 #-} rule222 = \ (_ :: ()) -> 0 {-# INLINE rule223 #-} rule223 = \ (_ :: ()) -> 0 {-# INLINE rule224 #-} rule224 = \ (_ :: ()) -> [] {-# INLINE rule225 #-} rule225 = \ (_ :: ()) -> Seq.empty {-# INLINE rule226 #-} rule226 = \ (_ :: ()) -> Seq.empty {-# INLINE rule227 #-} rule227 = \ (_ :: ()) -> Map.empty {-# INLINE rule228 #-} rule228 = \ ((_lhsIacount) :: Int) -> _lhsIacount {-# INLINE rule229 #-} rule229 = \ ((_lhsIvcount) :: Int) -> _lhsIvcount -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { allTypeSigs_Inh_Pattern :: (Map Identifier Type), altAttrs_Inh_Pattern :: (Map AltAttr Vertex), con_Inh_Pattern :: (Identifier), inh_Inh_Pattern :: (Attributes), nt_Inh_Pattern :: (Identifier), syn_Inh_Pattern :: (Attributes) } data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), errors_Syn_Pattern :: (Seq Error), gathAltAttrs_Syn_Pattern :: ([AltAttr]), instVars_Syn_Pattern :: ([Identifier]), locVars_Syn_Pattern :: ([Identifier]), patternAttrs_Syn_Pattern :: ([(Identifier,Identifier,Bool)]) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern (T_Pattern act) (Inh_Pattern _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) = Control.Monad.Identity.runIdentity ( do sem <- act let arg19 = T_Pattern_vIn19 _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn (T_Pattern_vOut19 _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs) <- return (inv_Pattern_s20 sem arg19) return (Syn_Pattern _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s20 ) } newtype T_Pattern_s20 = C_Pattern_s20 { inv_Pattern_s20 :: (T_Pattern_v19 ) } data T_Pattern_s21 = C_Pattern_s21 type T_Pattern_v19 = (T_Pattern_vIn19 ) -> (T_Pattern_vOut19 ) data T_Pattern_vIn19 = T_Pattern_vIn19 (Map Identifier Type) (Map AltAttr Vertex) (Identifier) (Attributes) (Identifier) (Attributes) data T_Pattern_vOut19 = T_Pattern_vOut19 (Pattern) (Seq Error) ([AltAttr]) ([Identifier]) ([Identifier]) ([(Identifier,Identifier,Bool)]) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) -> ( let _patsX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut22 _patsIcopy _patsIerrors _patsIgathAltAttrs _patsIinstVars _patsIlocVars _patsIpatternAttrs) = inv_Patterns_s23 _patsX23 (T_Patterns_vIn22 _patsOallTypeSigs _patsOaltAttrs _patsOcon _patsOinh _patsOnt _patsOsyn) _lhsOerrors :: Seq Error _lhsOerrors = rule230 _patsIerrors _lhsOgathAltAttrs :: [AltAttr] _lhsOgathAltAttrs = rule231 _patsIgathAltAttrs _lhsOinstVars :: [Identifier] _lhsOinstVars = rule232 _patsIinstVars _lhsOlocVars :: [Identifier] _lhsOlocVars = rule233 _patsIlocVars _lhsOpatternAttrs :: [(Identifier,Identifier,Bool)] _lhsOpatternAttrs = rule234 _patsIpatternAttrs _copy = rule235 _patsIcopy arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule236 _copy _patsOallTypeSigs = rule237 _lhsIallTypeSigs _patsOaltAttrs = rule238 _lhsIaltAttrs _patsOcon = rule239 _lhsIcon _patsOinh = rule240 _lhsIinh _patsOnt = rule241 _lhsInt _patsOsyn = rule242 _lhsIsyn __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule230 #-} rule230 = \ ((_patsIerrors) :: Seq Error) -> _patsIerrors {-# INLINE rule231 #-} rule231 = \ ((_patsIgathAltAttrs) :: [AltAttr]) -> _patsIgathAltAttrs {-# INLINE rule232 #-} rule232 = \ ((_patsIinstVars) :: [Identifier]) -> _patsIinstVars {-# INLINE rule233 #-} rule233 = \ ((_patsIlocVars) :: [Identifier]) -> _patsIlocVars {-# INLINE rule234 #-} rule234 = \ ((_patsIpatternAttrs) :: [(Identifier,Identifier,Bool)]) -> _patsIpatternAttrs {-# INLINE rule235 #-} rule235 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule236 #-} rule236 = \ _copy -> _copy {-# INLINE rule237 #-} rule237 = \ ((_lhsIallTypeSigs) :: Map Identifier Type) -> _lhsIallTypeSigs {-# INLINE rule238 #-} rule238 = \ ((_lhsIaltAttrs) :: Map AltAttr Vertex) -> _lhsIaltAttrs {-# INLINE rule239 #-} rule239 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule240 #-} rule240 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule241 #-} rule241 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule242 #-} rule242 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) -> ( let _patsX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut22 _patsIcopy _patsIerrors _patsIgathAltAttrs _patsIinstVars _patsIlocVars _patsIpatternAttrs) = inv_Patterns_s23 _patsX23 (T_Patterns_vIn22 _patsOallTypeSigs _patsOaltAttrs _patsOcon _patsOinh _patsOnt _patsOsyn) _lhsOerrors :: Seq Error _lhsOerrors = rule243 _patsIerrors _lhsOgathAltAttrs :: [AltAttr] _lhsOgathAltAttrs = rule244 _patsIgathAltAttrs _lhsOinstVars :: [Identifier] _lhsOinstVars = rule245 _patsIinstVars _lhsOlocVars :: [Identifier] _lhsOlocVars = rule246 _patsIlocVars _lhsOpatternAttrs :: [(Identifier,Identifier,Bool)] _lhsOpatternAttrs = rule247 _patsIpatternAttrs _copy = rule248 _patsIcopy arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule249 _copy _patsOallTypeSigs = rule250 _lhsIallTypeSigs _patsOaltAttrs = rule251 _lhsIaltAttrs _patsOcon = rule252 _lhsIcon _patsOinh = rule253 _lhsIinh _patsOnt = rule254 _lhsInt _patsOsyn = rule255 _lhsIsyn __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule243 #-} rule243 = \ ((_patsIerrors) :: Seq Error) -> _patsIerrors {-# INLINE rule244 #-} rule244 = \ ((_patsIgathAltAttrs) :: [AltAttr]) -> _patsIgathAltAttrs {-# INLINE rule245 #-} rule245 = \ ((_patsIinstVars) :: [Identifier]) -> _patsIinstVars {-# INLINE rule246 #-} rule246 = \ ((_patsIlocVars) :: [Identifier]) -> _patsIlocVars {-# INLINE rule247 #-} rule247 = \ ((_patsIpatternAttrs) :: [(Identifier,Identifier,Bool)]) -> _patsIpatternAttrs {-# INLINE rule248 #-} rule248 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule249 #-} rule249 = \ _copy -> _copy {-# INLINE rule250 #-} rule250 = \ ((_lhsIallTypeSigs) :: Map Identifier Type) -> _lhsIallTypeSigs {-# INLINE rule251 #-} rule251 = \ ((_lhsIaltAttrs) :: Map AltAttr Vertex) -> _lhsIaltAttrs {-# INLINE rule252 #-} rule252 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule253 #-} rule253 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule254 #-} rule254 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule255 #-} rule255 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) -> ( let _patX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut19 _patIcopy _patIerrors _patIgathAltAttrs _patIinstVars _patIlocVars _patIpatternAttrs) = inv_Pattern_s20 _patX20 (T_Pattern_vIn19 _patOallTypeSigs _patOaltAttrs _patOcon _patOinh _patOnt _patOsyn) _lhsOgathAltAttrs :: [AltAttr] _lhsOgathAltAttrs = rule256 arg_attr_ arg_field_ _lhsOpatternAttrs :: [(Identifier,Identifier,Bool)] _lhsOpatternAttrs = rule257 arg_attr_ arg_field_ _lhsOlocVars :: [Identifier] _lhsOlocVars = rule258 arg_attr_ arg_field_ _lhsOinstVars :: [Identifier] _lhsOinstVars = rule259 arg_attr_ arg_field_ _lhsOerrors :: Seq Error _lhsOerrors = rule260 _patIerrors _copy = rule261 _patIcopy arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule262 _copy _patOallTypeSigs = rule263 _lhsIallTypeSigs _patOaltAttrs = rule264 _lhsIaltAttrs _patOcon = rule265 _lhsIcon _patOinh = rule266 _lhsIinh _patOnt = rule267 _lhsInt _patOsyn = rule268 _lhsIsyn __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule256 #-} {-# LINE 187 "src-ag/Order.ag" #-} rule256 = \ attr_ field_ -> {-# LINE 187 "src-ag/Order.ag" #-} [AltAttr field_ attr_ (field_ == _LOC || field_ == _INST)] {-# LINE 2015 "dist/build/Order.hs"#-} {-# INLINE rule257 #-} {-# LINE 253 "src-ag/Order.ag" #-} rule257 = \ attr_ field_ -> {-# LINE 253 "src-ag/Order.ag" #-} [(field_,attr_,(field_ == _LOC || field_ == _INST))] {-# LINE 2021 "dist/build/Order.hs"#-} {-# INLINE rule258 #-} {-# LINE 685 "src-ag/Order.ag" #-} rule258 = \ attr_ field_ -> {-# LINE 685 "src-ag/Order.ag" #-} if field_ == _LOC then [attr_] else [] {-# LINE 2029 "dist/build/Order.hs"#-} {-# INLINE rule259 #-} {-# LINE 688 "src-ag/Order.ag" #-} rule259 = \ attr_ field_ -> {-# LINE 688 "src-ag/Order.ag" #-} if field_ == _INST then [attr_] else [] {-# LINE 2037 "dist/build/Order.hs"#-} {-# INLINE rule260 #-} rule260 = \ ((_patIerrors) :: Seq Error) -> _patIerrors {-# INLINE rule261 #-} rule261 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule262 #-} rule262 = \ _copy -> _copy {-# INLINE rule263 #-} rule263 = \ ((_lhsIallTypeSigs) :: Map Identifier Type) -> _lhsIallTypeSigs {-# INLINE rule264 #-} rule264 = \ ((_lhsIaltAttrs) :: Map AltAttr Vertex) -> _lhsIaltAttrs {-# INLINE rule265 #-} rule265 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule266 #-} rule266 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule267 #-} rule267 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule268 #-} rule268 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) -> ( let _patX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut19 _patIcopy _patIerrors _patIgathAltAttrs _patIinstVars _patIlocVars _patIpatternAttrs) = inv_Pattern_s20 _patX20 (T_Pattern_vIn19 _patOallTypeSigs _patOaltAttrs _patOcon _patOinh _patOnt _patOsyn) _lhsOerrors :: Seq Error _lhsOerrors = rule269 _patIerrors _lhsOgathAltAttrs :: [AltAttr] _lhsOgathAltAttrs = rule270 _patIgathAltAttrs _lhsOinstVars :: [Identifier] _lhsOinstVars = rule271 _patIinstVars _lhsOlocVars :: [Identifier] _lhsOlocVars = rule272 _patIlocVars _lhsOpatternAttrs :: [(Identifier,Identifier,Bool)] _lhsOpatternAttrs = rule273 _patIpatternAttrs _copy = rule274 _patIcopy _lhsOcopy :: Pattern _lhsOcopy = rule275 _copy _patOallTypeSigs = rule276 _lhsIallTypeSigs _patOaltAttrs = rule277 _lhsIaltAttrs _patOcon = rule278 _lhsIcon _patOinh = rule279 _lhsIinh _patOnt = rule280 _lhsInt _patOsyn = rule281 _lhsIsyn __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule269 #-} rule269 = \ ((_patIerrors) :: Seq Error) -> _patIerrors {-# INLINE rule270 #-} rule270 = \ ((_patIgathAltAttrs) :: [AltAttr]) -> _patIgathAltAttrs {-# INLINE rule271 #-} rule271 = \ ((_patIinstVars) :: [Identifier]) -> _patIinstVars {-# INLINE rule272 #-} rule272 = \ ((_patIlocVars) :: [Identifier]) -> _patIlocVars {-# INLINE rule273 #-} rule273 = \ ((_patIpatternAttrs) :: [(Identifier,Identifier,Bool)]) -> _patIpatternAttrs {-# INLINE rule274 #-} rule274 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule275 #-} rule275 = \ _copy -> _copy {-# INLINE rule276 #-} rule276 = \ ((_lhsIallTypeSigs) :: Map Identifier Type) -> _lhsIallTypeSigs {-# INLINE rule277 #-} rule277 = \ ((_lhsIaltAttrs) :: Map AltAttr Vertex) -> _lhsIaltAttrs {-# INLINE rule278 #-} rule278 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule279 #-} rule279 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule280 #-} rule280 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule281 #-} rule281 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore arg_pos_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) -> ( let _lhsOerrors :: Seq Error _lhsOerrors = rule282 () _lhsOgathAltAttrs :: [AltAttr] _lhsOgathAltAttrs = rule283 () _lhsOinstVars :: [Identifier] _lhsOinstVars = rule284 () _lhsOlocVars :: [Identifier] _lhsOlocVars = rule285 () _lhsOpatternAttrs :: [(Identifier,Identifier,Bool)] _lhsOpatternAttrs = rule286 () _copy = rule287 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule288 _copy __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule282 #-} rule282 = \ (_ :: ()) -> Seq.empty {-# INLINE rule283 #-} rule283 = \ (_ :: ()) -> [] {-# INLINE rule284 #-} rule284 = \ (_ :: ()) -> [] {-# INLINE rule285 #-} rule285 = \ (_ :: ()) -> [] {-# INLINE rule286 #-} rule286 = \ (_ :: ()) -> [] {-# INLINE rule287 #-} rule287 = \ pos_ -> Underscore pos_ {-# INLINE rule288 #-} rule288 = \ _copy -> _copy -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { allTypeSigs_Inh_Patterns :: (Map Identifier Type), altAttrs_Inh_Patterns :: (Map AltAttr Vertex), con_Inh_Patterns :: (Identifier), inh_Inh_Patterns :: (Attributes), nt_Inh_Patterns :: (Identifier), syn_Inh_Patterns :: (Attributes) } data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns), errors_Syn_Patterns :: (Seq Error), gathAltAttrs_Syn_Patterns :: ([AltAttr]), instVars_Syn_Patterns :: ([Identifier]), locVars_Syn_Patterns :: ([Identifier]), patternAttrs_Syn_Patterns :: ([(Identifier,Identifier,Bool)]) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns (T_Patterns act) (Inh_Patterns _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) = Control.Monad.Identity.runIdentity ( do sem <- act let arg22 = T_Patterns_vIn22 _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn (T_Patterns_vOut22 _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs) <- return (inv_Patterns_s23 sem arg22) return (Syn_Patterns _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s23 ) } newtype T_Patterns_s23 = C_Patterns_s23 { inv_Patterns_s23 :: (T_Patterns_v22 ) } data T_Patterns_s24 = C_Patterns_s24 type T_Patterns_v22 = (T_Patterns_vIn22 ) -> (T_Patterns_vOut22 ) data T_Patterns_vIn22 = T_Patterns_vIn22 (Map Identifier Type) (Map AltAttr Vertex) (Identifier) (Attributes) (Identifier) (Attributes) data T_Patterns_vOut22 = T_Patterns_vOut22 (Patterns) (Seq Error) ([AltAttr]) ([Identifier]) ([Identifier]) ([(Identifier,Identifier,Bool)]) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_Patterns_v22 v22 = \ (T_Patterns_vIn22 _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) -> ( let _hdX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut19 _hdIcopy _hdIerrors _hdIgathAltAttrs _hdIinstVars _hdIlocVars _hdIpatternAttrs) = inv_Pattern_s20 _hdX20 (T_Pattern_vIn19 _hdOallTypeSigs _hdOaltAttrs _hdOcon _hdOinh _hdOnt _hdOsyn) (T_Patterns_vOut22 _tlIcopy _tlIerrors _tlIgathAltAttrs _tlIinstVars _tlIlocVars _tlIpatternAttrs) = inv_Patterns_s23 _tlX23 (T_Patterns_vIn22 _tlOallTypeSigs _tlOaltAttrs _tlOcon _tlOinh _tlOnt _tlOsyn) _lhsOerrors :: Seq Error _lhsOerrors = rule289 _hdIerrors _tlIerrors _lhsOgathAltAttrs :: [AltAttr] _lhsOgathAltAttrs = rule290 _hdIgathAltAttrs _tlIgathAltAttrs _lhsOinstVars :: [Identifier] _lhsOinstVars = rule291 _hdIinstVars _tlIinstVars _lhsOlocVars :: [Identifier] _lhsOlocVars = rule292 _hdIlocVars _tlIlocVars _lhsOpatternAttrs :: [(Identifier,Identifier,Bool)] _lhsOpatternAttrs = rule293 _hdIpatternAttrs _tlIpatternAttrs _copy = rule294 _hdIcopy _tlIcopy _lhsOcopy :: Patterns _lhsOcopy = rule295 _copy _hdOallTypeSigs = rule296 _lhsIallTypeSigs _hdOaltAttrs = rule297 _lhsIaltAttrs _hdOcon = rule298 _lhsIcon _hdOinh = rule299 _lhsIinh _hdOnt = rule300 _lhsInt _hdOsyn = rule301 _lhsIsyn _tlOallTypeSigs = rule302 _lhsIallTypeSigs _tlOaltAttrs = rule303 _lhsIaltAttrs _tlOcon = rule304 _lhsIcon _tlOinh = rule305 _lhsIinh _tlOnt = rule306 _lhsInt _tlOsyn = rule307 _lhsIsyn __result_ = T_Patterns_vOut22 _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs in __result_ ) in C_Patterns_s23 v22 {-# INLINE rule289 #-} rule289 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule290 #-} rule290 = \ ((_hdIgathAltAttrs) :: [AltAttr]) ((_tlIgathAltAttrs) :: [AltAttr]) -> _hdIgathAltAttrs ++ _tlIgathAltAttrs {-# INLINE rule291 #-} rule291 = \ ((_hdIinstVars) :: [Identifier]) ((_tlIinstVars) :: [Identifier]) -> _hdIinstVars ++ _tlIinstVars {-# INLINE rule292 #-} rule292 = \ ((_hdIlocVars) :: [Identifier]) ((_tlIlocVars) :: [Identifier]) -> _hdIlocVars ++ _tlIlocVars {-# INLINE rule293 #-} rule293 = \ ((_hdIpatternAttrs) :: [(Identifier,Identifier,Bool)]) ((_tlIpatternAttrs) :: [(Identifier,Identifier,Bool)]) -> _hdIpatternAttrs ++ _tlIpatternAttrs {-# INLINE rule294 #-} rule294 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule295 #-} rule295 = \ _copy -> _copy {-# INLINE rule296 #-} rule296 = \ ((_lhsIallTypeSigs) :: Map Identifier Type) -> _lhsIallTypeSigs {-# INLINE rule297 #-} rule297 = \ ((_lhsIaltAttrs) :: Map AltAttr Vertex) -> _lhsIaltAttrs {-# INLINE rule298 #-} rule298 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule299 #-} rule299 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule300 #-} rule300 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule301 #-} rule301 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule302 #-} rule302 = \ ((_lhsIallTypeSigs) :: Map Identifier Type) -> _lhsIallTypeSigs {-# INLINE rule303 #-} rule303 = \ ((_lhsIaltAttrs) :: Map AltAttr Vertex) -> _lhsIaltAttrs {-# INLINE rule304 #-} rule304 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule305 #-} rule305 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule306 #-} rule306 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule307 #-} rule307 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_Patterns_v22 v22 = \ (T_Patterns_vIn22 _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) -> ( let _lhsOerrors :: Seq Error _lhsOerrors = rule308 () _lhsOgathAltAttrs :: [AltAttr] _lhsOgathAltAttrs = rule309 () _lhsOinstVars :: [Identifier] _lhsOinstVars = rule310 () _lhsOlocVars :: [Identifier] _lhsOlocVars = rule311 () _lhsOpatternAttrs :: [(Identifier,Identifier,Bool)] _lhsOpatternAttrs = rule312 () _copy = rule313 () _lhsOcopy :: Patterns _lhsOcopy = rule314 _copy __result_ = T_Patterns_vOut22 _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs in __result_ ) in C_Patterns_s23 v22 {-# INLINE rule308 #-} rule308 = \ (_ :: ()) -> Seq.empty {-# INLINE rule309 #-} rule309 = \ (_ :: ()) -> [] {-# INLINE rule310 #-} rule310 = \ (_ :: ()) -> [] {-# INLINE rule311 #-} rule311 = \ (_ :: ()) -> [] {-# INLINE rule312 #-} rule312 = \ (_ :: ()) -> [] {-# INLINE rule313 #-} rule313 = \ (_ :: ()) -> [] {-# INLINE rule314 #-} rule314 = \ _copy -> _copy -- Production -------------------------------------------------- -- wrapper data Inh_Production = Inh_Production { allnts_Inh_Production :: ([Identifier]), aroundMap_Inh_Production :: (Map ConstructorIdent (Map Identifier [Expression])), cVisitsMap_Inh_Production :: (CVisitsMap), inh_Inh_Production :: (Attributes), inhMap_Inh_Production :: (Map Identifier Attributes), manualAttrDepMap_Inh_Production :: (AttrOrderMap), mergeMap_Inh_Production :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))), nt_Inh_Production :: (Identifier), o_case_Inh_Production :: (Bool), o_cata_Inh_Production :: (Bool), o_dovisit_Inh_Production :: (Bool), o_newtypes_Inh_Production :: (Bool), o_rename_Inh_Production :: (Bool), o_sem_Inh_Production :: (Bool), o_sig_Inh_Production :: (Bool), o_unbox_Inh_Production :: (Bool), o_wantvisit_Inh_Production :: (Bool), options_Inh_Production :: (Options), prefix_Inh_Production :: (String), syn_Inh_Production :: (Attributes), synMap_Inh_Production :: (Map Identifier Attributes), vcount_Inh_Production :: (Int) } data Syn_Production = Syn_Production { additionalDep_Syn_Production :: (Seq Edge), aroundDep_Syn_Production :: (Seq Edge), cProduction_Syn_Production :: (CProduction), cons_Syn_Production :: ([ConstructorIdent]), directDep_Syn_Production :: (Seq Edge), errors_Syn_Production :: (Seq Error), instDep_Syn_Production :: (Seq Edge), mergeDep_Syn_Production :: (Seq Edge), nAutoRules_Syn_Production :: (Int), nExplicitRules_Syn_Production :: (Int), rules_Syn_Production :: (Seq (Vertex,CRule)), vcount_Syn_Production :: (Int) } {-# INLINABLE wrap_Production #-} wrap_Production :: T_Production -> Inh_Production -> (Syn_Production ) wrap_Production (T_Production act) (Inh_Production _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsyn _lhsIsynMap _lhsIvcount) = Control.Monad.Identity.runIdentity ( do sem <- act let arg25 = T_Production_vIn25 _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsyn _lhsIsynMap _lhsIvcount (T_Production_vOut25 _lhsOadditionalDep _lhsOaroundDep _lhsOcProduction _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOrules _lhsOvcount) <- return (inv_Production_s26 sem arg25) return (Syn_Production _lhsOadditionalDep _lhsOaroundDep _lhsOcProduction _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOrules _lhsOvcount) ) -- cata {-# INLINE sem_Production #-} sem_Production :: Production -> T_Production sem_Production ( Production con_ params_ constraints_ children_ rules_ typeSigs_ macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_ -- semantic domain newtype T_Production = T_Production { attach_T_Production :: Identity (T_Production_s26 ) } newtype T_Production_s26 = C_Production_s26 { inv_Production_s26 :: (T_Production_v25 ) } data T_Production_s27 = C_Production_s27 type T_Production_v25 = (T_Production_vIn25 ) -> (T_Production_vOut25 ) data T_Production_vIn25 = T_Production_vIn25 ([Identifier]) (Map ConstructorIdent (Map Identifier [Expression])) (CVisitsMap) (Attributes) (Map Identifier Attributes) (AttrOrderMap) (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) (Identifier) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (String) (Attributes) (Map Identifier Attributes) (Int) data T_Production_vOut25 = T_Production_vOut25 (Seq Edge) (Seq Edge) (CProduction) ([ConstructorIdent]) (Seq Edge) (Seq Error) (Seq Edge) (Seq Edge) (Int) (Int) (Seq (Vertex,CRule)) (Int) {-# NOINLINE sem_Production_Production #-} sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production sem_Production_Production arg_con_ _ _ arg_children_ arg_rules_ arg_typeSigs_ _ = T_Production (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_Production_v25 v25 = \ (T_Production_vIn25 _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsyn _lhsIsynMap _lhsIvcount) -> ( let _childrenX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) _rulesX35 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) _typeSigsX41 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) (T_Children_vOut4 _childrenIattributes _childrenIcollectChildrenInhs _childrenIcollectChildrenSyns _childrenIerrors _childrenIfields _childrenIgathAltAttrs _childrenIgathRules _childrenIinhs _childrenInts _childrenIsinglevisits _childrenIterminals) = inv_Children_s5 _childrenX5 (T_Children_vIn4 _childrenOallfields _childrenOallnts _childrenOattrs _childrenOcon _childrenOinh _childrenOinhMap _childrenOmergeMap _childrenOnt _childrenOo_unbox _childrenOsyn _childrenOsynMap) (T_Rules_vOut34 _rulesIdirectDep _rulesIerrors _rulesIgathAltAttrs _rulesIgathRules _rulesIinstDep _rulesIinstVars _rulesIlocVars _rulesInAutoRules _rulesInExplicitRules) = inv_Rules_s35 _rulesX35 (T_Rules_vIn34 _rulesOallTypeSigs _rulesOallfields _rulesOallnts _rulesOaltAttrs _rulesOattrs _rulesOchildInhs _rulesOchildNts _rulesOcon _rulesOinh _rulesOinhsOfChildren _rulesOmergeMap _rulesOnt _rulesOo_case _rulesOo_cata _rulesOo_dovisit _rulesOo_newtypes _rulesOo_rename _rulesOo_sem _rulesOo_sig _rulesOo_wantvisit _rulesOoptions _rulesOprefix _rulesOsyn _rulesOsynsOfChildren) (T_TypeSigs_vOut40 _typeSigsItypeSigs) = inv_TypeSigs_s41 _typeSigsX41 (T_TypeSigs_vIn40 _typeSigsOtypeSigs) _childrenOcon = rule315 arg_con_ _rulesOcon = rule316 arg_con_ _gathAltAttrs = rule317 _childrenIgathAltAttrs _lhsIinh _rulesIgathAltAttrs _altAttrs = rule318 _gathAltAttrs _lhsIvcount _rulesOchildNts = rule319 _childrenInts _rulesOchildInhs = rule320 _childrenIinhs _inhRules = rule321 _lhsIinh _lhsInt arg_con_ _gathRules = rule322 _childrenIgathRules _inhRules _rulesIgathRules _lhsOrules :: Seq (Vertex,CRule) _lhsOrules = rule323 _gathRules _lhsIvcount _lhsOvcount :: Int _lhsOvcount = rule324 _gathRules _lhsIvcount _manualDeps = rule325 _lhsImanualAttrDepMap _lhsInt arg_con_ _lhsOadditionalDep :: Seq Edge _lhsOadditionalDep = rule326 _altAttrs _manualDeps _rulesOsynsOfChildren = rule327 _childrenIcollectChildrenSyns _rulesOinhsOfChildren = rule328 _childrenIcollectChildrenInhs _mergeMap = rule329 _lhsImergeMap arg_con_ _lhsOmergeDep :: Seq Edge _lhsOmergeDep = rule330 _mergeDep1 _mergeDep2 _mergeDep1 = rule331 _altAttrs _childrenIcollectChildrenSyns _mergeMap _mergeDep2 = rule332 _altAttrs _childrenIcollectChildrenSyns _mergeMap _aroundMap = rule333 _lhsIaroundMap arg_con_ _aroundDep1 = rule334 _altAttrs _aroundMap _childrenIcollectChildrenSyns _aroundDep2 = rule335 _altAttrs _aroundMap _childrenIcollectChildrenInhs _lhsOaroundDep :: Seq Edge _lhsOaroundDep = rule336 _aroundDep1 _aroundDep2 _lhsOcons :: [ConstructorIdent] _lhsOcons = rule337 arg_con_ _typeSigsOtypeSigs = rule338 () _rulesOallTypeSigs = rule339 _typeSigsItypeSigs _cVisits = rule340 _childrenIsinglevisits _gathRules _lhsIcVisitsMap _lhsIinh _lhsInt _lhsIo_dovisit _lhsIsyn arg_con_ _lhsOcProduction :: CProduction _lhsOcProduction = rule341 _cVisits _childrenIfields _childrenIterminals arg_con_ _allfields = rule342 _childrenIfields _attrs = rule343 _childrenIattributes _inhnames _rulesIinstVars _rulesIlocVars _inhnames = rule344 _lhsIinh _synnames = rule345 _lhsIsyn _lhsOdirectDep :: Seq Edge _lhsOdirectDep = rule346 _rulesIdirectDep _lhsOerrors :: Seq Error _lhsOerrors = rule347 _childrenIerrors _rulesIerrors _lhsOinstDep :: Seq Edge _lhsOinstDep = rule348 _rulesIinstDep _lhsOnAutoRules :: Int _lhsOnAutoRules = rule349 _rulesInAutoRules _lhsOnExplicitRules :: Int _lhsOnExplicitRules = rule350 _rulesInExplicitRules _childrenOallfields = rule351 _allfields _childrenOallnts = rule352 _lhsIallnts _childrenOattrs = rule353 _attrs _childrenOinh = rule354 _lhsIinh _childrenOinhMap = rule355 _lhsIinhMap _childrenOmergeMap = rule356 _mergeMap _childrenOnt = rule357 _lhsInt _childrenOo_unbox = rule358 _lhsIo_unbox _childrenOsyn = rule359 _lhsIsyn _childrenOsynMap = rule360 _lhsIsynMap _rulesOallfields = rule361 _allfields _rulesOallnts = rule362 _lhsIallnts _rulesOaltAttrs = rule363 _altAttrs _rulesOattrs = rule364 _attrs _rulesOinh = rule365 _lhsIinh _rulesOmergeMap = rule366 _mergeMap _rulesOnt = rule367 _lhsInt _rulesOo_case = rule368 _lhsIo_case _rulesOo_cata = rule369 _lhsIo_cata _rulesOo_dovisit = rule370 _lhsIo_dovisit _rulesOo_newtypes = rule371 _lhsIo_newtypes _rulesOo_rename = rule372 _lhsIo_rename _rulesOo_sem = rule373 _lhsIo_sem _rulesOo_sig = rule374 _lhsIo_sig _rulesOo_wantvisit = rule375 _lhsIo_wantvisit _rulesOoptions = rule376 _lhsIoptions _rulesOprefix = rule377 _lhsIprefix _rulesOsyn = rule378 _lhsIsyn __result_ = T_Production_vOut25 _lhsOadditionalDep _lhsOaroundDep _lhsOcProduction _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOrules _lhsOvcount in __result_ ) in C_Production_s26 v25 {-# INLINE rule315 #-} {-# LINE 93 "src-ag/Order.ag" #-} rule315 = \ con_ -> {-# LINE 93 "src-ag/Order.ag" #-} con_ {-# LINE 2478 "dist/build/Order.hs"#-} {-# INLINE rule316 #-} {-# LINE 95 "src-ag/Order.ag" #-} rule316 = \ con_ -> {-# LINE 95 "src-ag/Order.ag" #-} con_ {-# LINE 2484 "dist/build/Order.hs"#-} {-# INLINE rule317 #-} {-# LINE 175 "src-ag/Order.ag" #-} rule317 = \ ((_childrenIgathAltAttrs) :: [AltAttr]) ((_lhsIinh) :: Attributes) ((_rulesIgathAltAttrs) :: [AltAttr]) -> {-# LINE 175 "src-ag/Order.ag" #-} [ AltAttr _LHS inh True | inh <- Map.keys _lhsIinh ] ++ _childrenIgathAltAttrs ++ _rulesIgathAltAttrs {-# LINE 2492 "dist/build/Order.hs"#-} {-# INLINE rule318 #-} {-# LINE 191 "src-ag/Order.ag" #-} rule318 = \ _gathAltAttrs ((_lhsIvcount) :: Int) -> {-# LINE 191 "src-ag/Order.ag" #-} Map.fromList (zip _gathAltAttrs [_lhsIvcount..]) {-# LINE 2498 "dist/build/Order.hs"#-} {-# INLINE rule319 #-} {-# LINE 204 "src-ag/Order.ag" #-} rule319 = \ ((_childrenInts) :: Seq (Identifier,NontermIdent)) -> {-# LINE 204 "src-ag/Order.ag" #-} Map.fromList (toList _childrenInts) {-# LINE 2504 "dist/build/Order.hs"#-} {-# INLINE rule320 #-} {-# LINE 205 "src-ag/Order.ag" #-} rule320 = \ ((_childrenIinhs) :: Seq (Identifier,Attributes)) -> {-# LINE 205 "src-ag/Order.ag" #-} Map.fromList (toList _childrenIinhs) {-# LINE 2510 "dist/build/Order.hs"#-} {-# INLINE rule321 #-} {-# LINE 211 "src-ag/Order.ag" #-} rule321 = \ ((_lhsIinh) :: Attributes) ((_lhsInt) :: Identifier) con_ -> {-# LINE 211 "src-ag/Order.ag" #-} [ cRuleLhsInh inh _lhsInt con_ tp | (inh,tp) <- Map.assocs _lhsIinh ] {-# LINE 2516 "dist/build/Order.hs"#-} {-# INLINE rule322 #-} {-# LINE 212 "src-ag/Order.ag" #-} rule322 = \ ((_childrenIgathRules) :: Seq CRule) _inhRules ((_rulesIgathRules) :: Seq CRule) -> {-# LINE 212 "src-ag/Order.ag" #-} _inhRules ++ toList (_childrenIgathRules Seq.>< _rulesIgathRules) {-# LINE 2522 "dist/build/Order.hs"#-} {-# INLINE rule323 #-} {-# LINE 264 "src-ag/Order.ag" #-} rule323 = \ _gathRules ((_lhsIvcount) :: Int) -> {-# LINE 264 "src-ag/Order.ag" #-} Seq.fromList (zip [_lhsIvcount..] _gathRules) {-# LINE 2528 "dist/build/Order.hs"#-} {-# INLINE rule324 #-} {-# LINE 265 "src-ag/Order.ag" #-} rule324 = \ _gathRules ((_lhsIvcount) :: Int) -> {-# LINE 265 "src-ag/Order.ag" #-} _lhsIvcount + length _gathRules {-# LINE 2534 "dist/build/Order.hs"#-} {-# INLINE rule325 #-} {-# LINE 293 "src-ag/Order.ag" #-} rule325 = \ ((_lhsImanualAttrDepMap) :: AttrOrderMap) ((_lhsInt) :: Identifier) con_ -> {-# LINE 293 "src-ag/Order.ag" #-} Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrDepMap {-# LINE 2540 "dist/build/Order.hs"#-} {-# INLINE rule326 #-} {-# LINE 296 "src-ag/Order.ag" #-} rule326 = \ _altAttrs _manualDeps -> {-# LINE 296 "src-ag/Order.ag" #-} Seq.fromList [ (vertex True occA, vertex False occB) | Dependency occA occB <- _manualDeps , let vertex inout (OccAttr child nm) | child == _LOC = findWithErr2 (AltAttr _LOC nm True) _altAttrs | otherwise = findWithErr2 (AltAttr child nm inout) _altAttrs vertex _ (OccRule nm) = findWithErr2 (AltAttr _LOC (Ident ("_rule_" ++ show nm) (getPos nm)) True) _altAttrs ] {-# LINE 2553 "dist/build/Order.hs"#-} {-# INLINE rule327 #-} {-# LINE 342 "src-ag/Order.ag" #-} rule327 = \ ((_childrenIcollectChildrenSyns) :: Map Identifier Attributes ) -> {-# LINE 342 "src-ag/Order.ag" #-} _childrenIcollectChildrenSyns {-# LINE 2559 "dist/build/Order.hs"#-} {-# INLINE rule328 #-} {-# LINE 343 "src-ag/Order.ag" #-} rule328 = \ ((_childrenIcollectChildrenInhs) :: Map Identifier Attributes ) -> {-# LINE 343 "src-ag/Order.ag" #-} _childrenIcollectChildrenInhs {-# LINE 2565 "dist/build/Order.hs"#-} {-# INLINE rule329 #-} {-# LINE 361 "src-ag/Order.ag" #-} rule329 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) con_ -> {-# LINE 361 "src-ag/Order.ag" #-} Map.findWithDefault Map.empty con_ _lhsImergeMap {-# LINE 2571 "dist/build/Order.hs"#-} {-# INLINE rule330 #-} {-# LINE 372 "src-ag/Order.ag" #-} rule330 = \ _mergeDep1 _mergeDep2 -> {-# LINE 372 "src-ag/Order.ag" #-} _mergeDep1 Seq.>< _mergeDep2 {-# LINE 2577 "dist/build/Order.hs"#-} {-# INLINE rule331 #-} {-# LINE 374 "src-ag/Order.ag" #-} rule331 = \ _altAttrs ((_childrenIcollectChildrenSyns) :: Map Identifier Attributes ) _mergeMap -> {-# LINE 374 "src-ag/Order.ag" #-} Seq.fromList $ [ (childVert, synVert) | childNm <- Map.keys _mergeMap , synNm <- Map.keys (findWithErr2 childNm _childrenIcollectChildrenSyns) , let childNm' = Ident (show childNm ++ "_merge") (getPos childNm) childAttr = AltAttr _LOC childNm' True synAttr = AltAttr childNm synNm True childVert = findWithErr2 childAttr _altAttrs synVert = findWithErr2 synAttr _altAttrs ] {-# LINE 2592 "dist/build/Order.hs"#-} {-# INLINE rule332 #-} {-# LINE 385 "src-ag/Order.ag" #-} rule332 = \ _altAttrs ((_childrenIcollectChildrenSyns) :: Map Identifier Attributes ) _mergeMap -> {-# LINE 385 "src-ag/Order.ag" #-} Seq.fromList $ [ (mergedVert, sourceVert) | (childNm, (_,cs)) <- Map.assocs _mergeMap , c <- cs , synNm <- Map.keys (findWithErr2 childNm _childrenIcollectChildrenSyns) , let sourceAttr = AltAttr childNm synNm True mergedAttr = AltAttr c synNm True sourceVert = findWithErr2 sourceAttr _altAttrs mergedVert = findWithErr2 mergedAttr _altAttrs ] {-# LINE 2607 "dist/build/Order.hs"#-} {-# INLINE rule333 #-} {-# LINE 414 "src-ag/Order.ag" #-} rule333 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Map Identifier [Expression])) con_ -> {-# LINE 414 "src-ag/Order.ag" #-} Map.findWithDefault Map.empty con_ _lhsIaroundMap {-# LINE 2613 "dist/build/Order.hs"#-} {-# INLINE rule334 #-} {-# LINE 422 "src-ag/Order.ag" #-} rule334 = \ _altAttrs _aroundMap ((_childrenIcollectChildrenSyns) :: Map Identifier Attributes ) -> {-# LINE 422 "src-ag/Order.ag" #-} Seq.fromList $ [ (childVert, synVert) | childNm <- Map.keys _aroundMap , synNm <- Map.keys (findWithErr2 childNm _childrenIcollectChildrenSyns) , let childNm' = Ident (show childNm ++ "_around") (getPos childNm) childAttr = AltAttr _LOC childNm' True synAttr = AltAttr childNm synNm True childVert = findWithErr2 childAttr _altAttrs synVert = findWithErr2 synAttr _altAttrs ] {-# LINE 2628 "dist/build/Order.hs"#-} {-# INLINE rule335 #-} {-# LINE 433 "src-ag/Order.ag" #-} rule335 = \ _altAttrs _aroundMap ((_childrenIcollectChildrenInhs) :: Map Identifier Attributes ) -> {-# LINE 433 "src-ag/Order.ag" #-} Seq.fromList $ [ (childVert, inhVert) | childNm <- Map.keys _aroundMap , inhNm <- Map.keys (findWithErr2 childNm _childrenIcollectChildrenInhs) , let childNm' = Ident (show childNm ++ "_around") (getPos childNm) childAttr = AltAttr _LOC childNm' True inhAttr = AltAttr childNm inhNm False childVert = findWithErr2 childAttr _altAttrs inhVert = findWithErr2 inhAttr _altAttrs ] {-# LINE 2643 "dist/build/Order.hs"#-} {-# INLINE rule336 #-} {-# LINE 443 "src-ag/Order.ag" #-} rule336 = \ _aroundDep1 _aroundDep2 -> {-# LINE 443 "src-ag/Order.ag" #-} _aroundDep1 Seq.>< _aroundDep2 {-# LINE 2649 "dist/build/Order.hs"#-} {-# INLINE rule337 #-} {-# LINE 527 "src-ag/Order.ag" #-} rule337 = \ con_ -> {-# LINE 527 "src-ag/Order.ag" #-} [con_] {-# LINE 2655 "dist/build/Order.hs"#-} {-# INLINE rule338 #-} {-# LINE 534 "src-ag/Order.ag" #-} rule338 = \ (_ :: ()) -> {-# LINE 534 "src-ag/Order.ag" #-} Map.empty {-# LINE 2661 "dist/build/Order.hs"#-} {-# INLINE rule339 #-} {-# LINE 540 "src-ag/Order.ag" #-} rule339 = \ ((_typeSigsItypeSigs) :: Map Identifier Type) -> {-# LINE 540 "src-ag/Order.ag" #-} _typeSigsItypeSigs {-# LINE 2667 "dist/build/Order.hs"#-} {-# INLINE rule340 #-} {-# LINE 608 "src-ag/Order.ag" #-} rule340 = \ ((_childrenIsinglevisits) :: [CRule]) _gathRules ((_lhsIcVisitsMap) :: CVisitsMap) ((_lhsIinh) :: Attributes) ((_lhsInt) :: Identifier) ((_lhsIo_dovisit) :: Bool) ((_lhsIsyn) :: Attributes) con_ -> {-# LINE 608 "src-ag/Order.ag" #-} if _lhsIo_dovisit then let prodsVisitsMap = findWithErr1 "Production.cVisits.nt" _lhsInt _lhsIcVisitsMap visits = findWithErr1 "Production.cVisits.con" con_ prodsVisitsMap in visits else let vss = nubBy eqCRuleDefines _gathRules ++ _childrenIsinglevisits in [CVisit _lhsIinh _lhsIsyn vss [] False] {-# LINE 2678 "dist/build/Order.hs"#-} {-# INLINE rule341 #-} {-# LINE 634 "src-ag/Order.ag" #-} rule341 = \ _cVisits ((_childrenIfields) :: [(Identifier,Type,ChildKind)]) ((_childrenIterminals) :: [Identifier]) con_ -> {-# LINE 634 "src-ag/Order.ag" #-} CProduction con_ _cVisits _childrenIfields _childrenIterminals {-# LINE 2684 "dist/build/Order.hs"#-} {-# INLINE rule342 #-} {-# LINE 662 "src-ag/Order.ag" #-} rule342 = \ ((_childrenIfields) :: [(Identifier,Type,ChildKind)]) -> {-# LINE 662 "src-ag/Order.ag" #-} _childrenIfields {-# LINE 2690 "dist/build/Order.hs"#-} {-# INLINE rule343 #-} {-# LINE 663 "src-ag/Order.ag" #-} rule343 = \ ((_childrenIattributes) :: [(Identifier,Attributes,Attributes)]) _inhnames ((_rulesIinstVars) :: [Identifier]) ((_rulesIlocVars) :: [Identifier]) -> {-# LINE 663 "src-ag/Order.ag" #-} map ((,) _LOC) _rulesIlocVars ++ map ((,) _INST) _rulesIinstVars ++ map ((,) _LHS) _inhnames ++ concat [map ((,) nm) (Map.keys as) | (nm,_,as) <- _childrenIattributes] {-# LINE 2699 "dist/build/Order.hs"#-} {-# INLINE rule344 #-} {-# LINE 667 "src-ag/Order.ag" #-} rule344 = \ ((_lhsIinh) :: Attributes) -> {-# LINE 667 "src-ag/Order.ag" #-} Map.keys _lhsIinh {-# LINE 2705 "dist/build/Order.hs"#-} {-# INLINE rule345 #-} {-# LINE 668 "src-ag/Order.ag" #-} rule345 = \ ((_lhsIsyn) :: Attributes) -> {-# LINE 668 "src-ag/Order.ag" #-} Map.keys _lhsIsyn {-# LINE 2711 "dist/build/Order.hs"#-} {-# INLINE rule346 #-} rule346 = \ ((_rulesIdirectDep) :: Seq Edge) -> _rulesIdirectDep {-# INLINE rule347 #-} rule347 = \ ((_childrenIerrors) :: Seq Error) ((_rulesIerrors) :: Seq Error) -> _childrenIerrors Seq.>< _rulesIerrors {-# INLINE rule348 #-} rule348 = \ ((_rulesIinstDep) :: Seq Edge) -> _rulesIinstDep {-# INLINE rule349 #-} rule349 = \ ((_rulesInAutoRules) :: Int) -> _rulesInAutoRules {-# INLINE rule350 #-} rule350 = \ ((_rulesInExplicitRules) :: Int) -> _rulesInExplicitRules {-# INLINE rule351 #-} rule351 = \ _allfields -> _allfields {-# INLINE rule352 #-} rule352 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule353 #-} rule353 = \ _attrs -> _attrs {-# INLINE rule354 #-} rule354 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule355 #-} rule355 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule356 #-} rule356 = \ _mergeMap -> _mergeMap {-# INLINE rule357 #-} rule357 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule358 #-} rule358 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule359 #-} rule359 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule360 #-} rule360 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule361 #-} rule361 = \ _allfields -> _allfields {-# INLINE rule362 #-} rule362 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule363 #-} rule363 = \ _altAttrs -> _altAttrs {-# INLINE rule364 #-} rule364 = \ _attrs -> _attrs {-# INLINE rule365 #-} rule365 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule366 #-} rule366 = \ _mergeMap -> _mergeMap {-# INLINE rule367 #-} rule367 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule368 #-} rule368 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule369 #-} rule369 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule370 #-} rule370 = \ ((_lhsIo_dovisit) :: Bool) -> _lhsIo_dovisit {-# INLINE rule371 #-} rule371 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule372 #-} rule372 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule373 #-} rule373 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule374 #-} rule374 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule375 #-} rule375 = \ ((_lhsIo_wantvisit) :: Bool) -> _lhsIo_wantvisit {-# INLINE rule376 #-} rule376 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule377 #-} rule377 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule378 #-} rule378 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn -- Productions ------------------------------------------------- -- wrapper data Inh_Productions = Inh_Productions { allnts_Inh_Productions :: ([Identifier]), aroundMap_Inh_Productions :: (Map ConstructorIdent (Map Identifier [Expression])), cVisitsMap_Inh_Productions :: (CVisitsMap), inh_Inh_Productions :: (Attributes), inhMap_Inh_Productions :: (Map Identifier Attributes), manualAttrDepMap_Inh_Productions :: (AttrOrderMap), mergeMap_Inh_Productions :: (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))), nt_Inh_Productions :: (Identifier), o_case_Inh_Productions :: (Bool), o_cata_Inh_Productions :: (Bool), o_dovisit_Inh_Productions :: (Bool), o_newtypes_Inh_Productions :: (Bool), o_rename_Inh_Productions :: (Bool), o_sem_Inh_Productions :: (Bool), o_sig_Inh_Productions :: (Bool), o_unbox_Inh_Productions :: (Bool), o_wantvisit_Inh_Productions :: (Bool), options_Inh_Productions :: (Options), prefix_Inh_Productions :: (String), syn_Inh_Productions :: (Attributes), synMap_Inh_Productions :: (Map Identifier Attributes), vcount_Inh_Productions :: (Int) } data Syn_Productions = Syn_Productions { additionalDep_Syn_Productions :: (Seq Edge), aroundDep_Syn_Productions :: (Seq Edge), cProductions_Syn_Productions :: (CProductions), cons_Syn_Productions :: ([ConstructorIdent]), directDep_Syn_Productions :: (Seq Edge), errors_Syn_Productions :: (Seq Error), instDep_Syn_Productions :: (Seq Edge), mergeDep_Syn_Productions :: (Seq Edge), nAutoRules_Syn_Productions :: (Int), nExplicitRules_Syn_Productions :: (Int), rules_Syn_Productions :: (Seq (Vertex,CRule)), vcount_Syn_Productions :: (Int) } {-# INLINABLE wrap_Productions #-} wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions ) wrap_Productions (T_Productions act) (Inh_Productions _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsyn _lhsIsynMap _lhsIvcount) = Control.Monad.Identity.runIdentity ( do sem <- act let arg28 = T_Productions_vIn28 _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsyn _lhsIsynMap _lhsIvcount (T_Productions_vOut28 _lhsOadditionalDep _lhsOaroundDep _lhsOcProductions _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOrules _lhsOvcount) <- return (inv_Productions_s29 sem arg28) return (Syn_Productions _lhsOadditionalDep _lhsOaroundDep _lhsOcProductions _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOrules _lhsOvcount) ) -- cata {-# NOINLINE sem_Productions #-} sem_Productions :: Productions -> T_Productions sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) -- semantic domain newtype T_Productions = T_Productions { attach_T_Productions :: Identity (T_Productions_s29 ) } newtype T_Productions_s29 = C_Productions_s29 { inv_Productions_s29 :: (T_Productions_v28 ) } data T_Productions_s30 = C_Productions_s30 type T_Productions_v28 = (T_Productions_vIn28 ) -> (T_Productions_vOut28 ) data T_Productions_vIn28 = T_Productions_vIn28 ([Identifier]) (Map ConstructorIdent (Map Identifier [Expression])) (CVisitsMap) (Attributes) (Map Identifier Attributes) (AttrOrderMap) (Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) (Identifier) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (String) (Attributes) (Map Identifier Attributes) (Int) data T_Productions_vOut28 = T_Productions_vOut28 (Seq Edge) (Seq Edge) (CProductions) ([ConstructorIdent]) (Seq Edge) (Seq Error) (Seq Edge) (Seq Edge) (Int) (Int) (Seq (Vertex,CRule)) (Int) {-# NOINLINE sem_Productions_Cons #-} sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Productions_v28 v28 = \ (T_Productions_vIn28 _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsyn _lhsIsynMap _lhsIvcount) -> ( let _hdX26 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) _tlX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) (T_Production_vOut25 _hdIadditionalDep _hdIaroundDep _hdIcProduction _hdIcons _hdIdirectDep _hdIerrors _hdIinstDep _hdImergeDep _hdInAutoRules _hdInExplicitRules _hdIrules _hdIvcount) = inv_Production_s26 _hdX26 (T_Production_vIn25 _hdOallnts _hdOaroundMap _hdOcVisitsMap _hdOinh _hdOinhMap _hdOmanualAttrDepMap _hdOmergeMap _hdOnt _hdOo_case _hdOo_cata _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_unbox _hdOo_wantvisit _hdOoptions _hdOprefix _hdOsyn _hdOsynMap _hdOvcount) (T_Productions_vOut28 _tlIadditionalDep _tlIaroundDep _tlIcProductions _tlIcons _tlIdirectDep _tlIerrors _tlIinstDep _tlImergeDep _tlInAutoRules _tlInExplicitRules _tlIrules _tlIvcount) = inv_Productions_s29 _tlX29 (T_Productions_vIn28 _tlOallnts _tlOaroundMap _tlOcVisitsMap _tlOinh _tlOinhMap _tlOmanualAttrDepMap _tlOmergeMap _tlOnt _tlOo_case _tlOo_cata _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_unbox _tlOo_wantvisit _tlOoptions _tlOprefix _tlOsyn _tlOsynMap _tlOvcount) _lhsOcProductions :: CProductions _lhsOcProductions = rule379 _hdIcProduction _tlIcProductions _lhsOadditionalDep :: Seq Edge _lhsOadditionalDep = rule380 _hdIadditionalDep _tlIadditionalDep _lhsOaroundDep :: Seq Edge _lhsOaroundDep = rule381 _hdIaroundDep _tlIaroundDep _lhsOcons :: [ConstructorIdent] _lhsOcons = rule382 _hdIcons _tlIcons _lhsOdirectDep :: Seq Edge _lhsOdirectDep = rule383 _hdIdirectDep _tlIdirectDep _lhsOerrors :: Seq Error _lhsOerrors = rule384 _hdIerrors _tlIerrors _lhsOinstDep :: Seq Edge _lhsOinstDep = rule385 _hdIinstDep _tlIinstDep _lhsOmergeDep :: Seq Edge _lhsOmergeDep = rule386 _hdImergeDep _tlImergeDep _lhsOnAutoRules :: Int _lhsOnAutoRules = rule387 _hdInAutoRules _tlInAutoRules _lhsOnExplicitRules :: Int _lhsOnExplicitRules = rule388 _hdInExplicitRules _tlInExplicitRules _lhsOrules :: Seq (Vertex,CRule) _lhsOrules = rule389 _hdIrules _tlIrules _lhsOvcount :: Int _lhsOvcount = rule390 _tlIvcount _hdOallnts = rule391 _lhsIallnts _hdOaroundMap = rule392 _lhsIaroundMap _hdOcVisitsMap = rule393 _lhsIcVisitsMap _hdOinh = rule394 _lhsIinh _hdOinhMap = rule395 _lhsIinhMap _hdOmanualAttrDepMap = rule396 _lhsImanualAttrDepMap _hdOmergeMap = rule397 _lhsImergeMap _hdOnt = rule398 _lhsInt _hdOo_case = rule399 _lhsIo_case _hdOo_cata = rule400 _lhsIo_cata _hdOo_dovisit = rule401 _lhsIo_dovisit _hdOo_newtypes = rule402 _lhsIo_newtypes _hdOo_rename = rule403 _lhsIo_rename _hdOo_sem = rule404 _lhsIo_sem _hdOo_sig = rule405 _lhsIo_sig _hdOo_unbox = rule406 _lhsIo_unbox _hdOo_wantvisit = rule407 _lhsIo_wantvisit _hdOoptions = rule408 _lhsIoptions _hdOprefix = rule409 _lhsIprefix _hdOsyn = rule410 _lhsIsyn _hdOsynMap = rule411 _lhsIsynMap _hdOvcount = rule412 _lhsIvcount _tlOallnts = rule413 _lhsIallnts _tlOaroundMap = rule414 _lhsIaroundMap _tlOcVisitsMap = rule415 _lhsIcVisitsMap _tlOinh = rule416 _lhsIinh _tlOinhMap = rule417 _lhsIinhMap _tlOmanualAttrDepMap = rule418 _lhsImanualAttrDepMap _tlOmergeMap = rule419 _lhsImergeMap _tlOnt = rule420 _lhsInt _tlOo_case = rule421 _lhsIo_case _tlOo_cata = rule422 _lhsIo_cata _tlOo_dovisit = rule423 _lhsIo_dovisit _tlOo_newtypes = rule424 _lhsIo_newtypes _tlOo_rename = rule425 _lhsIo_rename _tlOo_sem = rule426 _lhsIo_sem _tlOo_sig = rule427 _lhsIo_sig _tlOo_unbox = rule428 _lhsIo_unbox _tlOo_wantvisit = rule429 _lhsIo_wantvisit _tlOoptions = rule430 _lhsIoptions _tlOprefix = rule431 _lhsIprefix _tlOsyn = rule432 _lhsIsyn _tlOsynMap = rule433 _lhsIsynMap _tlOvcount = rule434 _hdIvcount __result_ = T_Productions_vOut28 _lhsOadditionalDep _lhsOaroundDep _lhsOcProductions _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOrules _lhsOvcount in __result_ ) in C_Productions_s29 v28 {-# INLINE rule379 #-} {-# LINE 631 "src-ag/Order.ag" #-} rule379 = \ ((_hdIcProduction) :: CProduction) ((_tlIcProductions) :: CProductions) -> {-# LINE 631 "src-ag/Order.ag" #-} _hdIcProduction : _tlIcProductions {-# LINE 2929 "dist/build/Order.hs"#-} {-# INLINE rule380 #-} rule380 = \ ((_hdIadditionalDep) :: Seq Edge) ((_tlIadditionalDep) :: Seq Edge) -> _hdIadditionalDep Seq.>< _tlIadditionalDep {-# INLINE rule381 #-} rule381 = \ ((_hdIaroundDep) :: Seq Edge) ((_tlIaroundDep) :: Seq Edge) -> _hdIaroundDep Seq.>< _tlIaroundDep {-# INLINE rule382 #-} rule382 = \ ((_hdIcons) :: [ConstructorIdent]) ((_tlIcons) :: [ConstructorIdent]) -> _hdIcons ++ _tlIcons {-# INLINE rule383 #-} rule383 = \ ((_hdIdirectDep) :: Seq Edge) ((_tlIdirectDep) :: Seq Edge) -> _hdIdirectDep Seq.>< _tlIdirectDep {-# INLINE rule384 #-} rule384 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule385 #-} rule385 = \ ((_hdIinstDep) :: Seq Edge) ((_tlIinstDep) :: Seq Edge) -> _hdIinstDep Seq.>< _tlIinstDep {-# INLINE rule386 #-} rule386 = \ ((_hdImergeDep) :: Seq Edge) ((_tlImergeDep) :: Seq Edge) -> _hdImergeDep Seq.>< _tlImergeDep {-# INLINE rule387 #-} rule387 = \ ((_hdInAutoRules) :: Int) ((_tlInAutoRules) :: Int) -> _hdInAutoRules + _tlInAutoRules {-# INLINE rule388 #-} rule388 = \ ((_hdInExplicitRules) :: Int) ((_tlInExplicitRules) :: Int) -> _hdInExplicitRules + _tlInExplicitRules {-# INLINE rule389 #-} rule389 = \ ((_hdIrules) :: Seq (Vertex,CRule)) ((_tlIrules) :: Seq (Vertex,CRule)) -> _hdIrules Seq.>< _tlIrules {-# INLINE rule390 #-} rule390 = \ ((_tlIvcount) :: Int) -> _tlIvcount {-# INLINE rule391 #-} rule391 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule392 #-} rule392 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Map Identifier [Expression])) -> _lhsIaroundMap {-# INLINE rule393 #-} rule393 = \ ((_lhsIcVisitsMap) :: CVisitsMap) -> _lhsIcVisitsMap {-# INLINE rule394 #-} rule394 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule395 #-} rule395 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule396 #-} rule396 = \ ((_lhsImanualAttrDepMap) :: AttrOrderMap) -> _lhsImanualAttrDepMap {-# INLINE rule397 #-} rule397 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) -> _lhsImergeMap {-# INLINE rule398 #-} rule398 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule399 #-} rule399 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule400 #-} rule400 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule401 #-} rule401 = \ ((_lhsIo_dovisit) :: Bool) -> _lhsIo_dovisit {-# INLINE rule402 #-} rule402 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule403 #-} rule403 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule404 #-} rule404 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule405 #-} rule405 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule406 #-} rule406 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule407 #-} rule407 = \ ((_lhsIo_wantvisit) :: Bool) -> _lhsIo_wantvisit {-# INLINE rule408 #-} rule408 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule409 #-} rule409 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule410 #-} rule410 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule411 #-} rule411 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule412 #-} rule412 = \ ((_lhsIvcount) :: Int) -> _lhsIvcount {-# INLINE rule413 #-} rule413 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule414 #-} rule414 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Map Identifier [Expression])) -> _lhsIaroundMap {-# INLINE rule415 #-} rule415 = \ ((_lhsIcVisitsMap) :: CVisitsMap) -> _lhsIcVisitsMap {-# INLINE rule416 #-} rule416 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule417 #-} rule417 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule418 #-} rule418 = \ ((_lhsImanualAttrDepMap) :: AttrOrderMap) -> _lhsImanualAttrDepMap {-# INLINE rule419 #-} rule419 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) -> _lhsImergeMap {-# INLINE rule420 #-} rule420 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule421 #-} rule421 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule422 #-} rule422 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule423 #-} rule423 = \ ((_lhsIo_dovisit) :: Bool) -> _lhsIo_dovisit {-# INLINE rule424 #-} rule424 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule425 #-} rule425 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule426 #-} rule426 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule427 #-} rule427 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule428 #-} rule428 = \ ((_lhsIo_unbox) :: Bool) -> _lhsIo_unbox {-# INLINE rule429 #-} rule429 = \ ((_lhsIo_wantvisit) :: Bool) -> _lhsIo_wantvisit {-# INLINE rule430 #-} rule430 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule431 #-} rule431 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule432 #-} rule432 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule433 #-} rule433 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule434 #-} rule434 = \ ((_hdIvcount) :: Int) -> _hdIvcount {-# NOINLINE sem_Productions_Nil #-} sem_Productions_Nil :: T_Productions sem_Productions_Nil = T_Productions (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Productions_v28 v28 = \ (T_Productions_vIn28 _lhsIallnts _lhsIaroundMap _lhsIcVisitsMap _lhsIinh _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsyn _lhsIsynMap _lhsIvcount) -> ( let _lhsOcProductions :: CProductions _lhsOcProductions = rule435 () _lhsOadditionalDep :: Seq Edge _lhsOadditionalDep = rule436 () _lhsOaroundDep :: Seq Edge _lhsOaroundDep = rule437 () _lhsOcons :: [ConstructorIdent] _lhsOcons = rule438 () _lhsOdirectDep :: Seq Edge _lhsOdirectDep = rule439 () _lhsOerrors :: Seq Error _lhsOerrors = rule440 () _lhsOinstDep :: Seq Edge _lhsOinstDep = rule441 () _lhsOmergeDep :: Seq Edge _lhsOmergeDep = rule442 () _lhsOnAutoRules :: Int _lhsOnAutoRules = rule443 () _lhsOnExplicitRules :: Int _lhsOnExplicitRules = rule444 () _lhsOrules :: Seq (Vertex,CRule) _lhsOrules = rule445 () _lhsOvcount :: Int _lhsOvcount = rule446 _lhsIvcount __result_ = T_Productions_vOut28 _lhsOadditionalDep _lhsOaroundDep _lhsOcProductions _lhsOcons _lhsOdirectDep _lhsOerrors _lhsOinstDep _lhsOmergeDep _lhsOnAutoRules _lhsOnExplicitRules _lhsOrules _lhsOvcount in __result_ ) in C_Productions_s29 v28 {-# INLINE rule435 #-} {-# LINE 632 "src-ag/Order.ag" #-} rule435 = \ (_ :: ()) -> {-# LINE 632 "src-ag/Order.ag" #-} [] {-# LINE 3134 "dist/build/Order.hs"#-} {-# INLINE rule436 #-} rule436 = \ (_ :: ()) -> Seq.empty {-# INLINE rule437 #-} rule437 = \ (_ :: ()) -> Seq.empty {-# INLINE rule438 #-} rule438 = \ (_ :: ()) -> [] {-# INLINE rule439 #-} rule439 = \ (_ :: ()) -> Seq.empty {-# INLINE rule440 #-} rule440 = \ (_ :: ()) -> Seq.empty {-# INLINE rule441 #-} rule441 = \ (_ :: ()) -> Seq.empty {-# INLINE rule442 #-} rule442 = \ (_ :: ()) -> Seq.empty {-# INLINE rule443 #-} rule443 = \ (_ :: ()) -> 0 {-# INLINE rule444 #-} rule444 = \ (_ :: ()) -> 0 {-# INLINE rule445 #-} rule445 = \ (_ :: ()) -> Seq.empty {-# INLINE rule446 #-} rule446 = \ ((_lhsIvcount) :: Int) -> _lhsIvcount -- Rule -------------------------------------------------------- -- wrapper data Inh_Rule = Inh_Rule { allTypeSigs_Inh_Rule :: (Map Identifier Type), allfields_Inh_Rule :: ([(Identifier,Type,ChildKind)]), allnts_Inh_Rule :: ([Identifier]), altAttrs_Inh_Rule :: (Map AltAttr Vertex), attrs_Inh_Rule :: ([(Identifier,Identifier)]), childInhs_Inh_Rule :: (Map Identifier Attributes), childNts_Inh_Rule :: (Map Identifier NontermIdent), con_Inh_Rule :: (Identifier), inh_Inh_Rule :: (Attributes), inhsOfChildren_Inh_Rule :: (Map Identifier Attributes), mergeMap_Inh_Rule :: (Map Identifier (Identifier,[Identifier])), nt_Inh_Rule :: (Identifier), o_case_Inh_Rule :: (Bool), o_cata_Inh_Rule :: (Bool), o_dovisit_Inh_Rule :: (Bool), o_newtypes_Inh_Rule :: (Bool), o_rename_Inh_Rule :: (Bool), o_sem_Inh_Rule :: (Bool), o_sig_Inh_Rule :: (Bool), o_wantvisit_Inh_Rule :: (Bool), options_Inh_Rule :: (Options), prefix_Inh_Rule :: (String), syn_Inh_Rule :: (Attributes), synsOfChildren_Inh_Rule :: (Map Identifier Attributes) } data Syn_Rule = Syn_Rule { directDep_Syn_Rule :: (Seq Edge), errors_Syn_Rule :: (Seq Error), gathAltAttrs_Syn_Rule :: ([AltAttr]), gathRules_Syn_Rule :: (Seq CRule), instDep_Syn_Rule :: (Seq Edge), instVars_Syn_Rule :: ([Identifier]), locVars_Syn_Rule :: ([Identifier]), nAutoRules_Syn_Rule :: (Int), nExplicitRules_Syn_Rule :: (Int) } {-# INLINABLE wrap_Rule #-} wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule ) wrap_Rule (T_Rule act) (Inh_Rule _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsIinhsOfChildren _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsyn _lhsIsynsOfChildren) = Control.Monad.Identity.runIdentity ( do sem <- act let arg31 = T_Rule_vIn31 _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsIinhsOfChildren _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsyn _lhsIsynsOfChildren (T_Rule_vOut31 _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars _lhsOnAutoRules _lhsOnExplicitRules) <- return (inv_Rule_s32 sem arg31) return (Syn_Rule _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars _lhsOnAutoRules _lhsOnExplicitRules) ) -- cata {-# INLINE sem_Rule #-} sem_Rule :: Rule -> T_Rule sem_Rule ( Rule mbName_ pattern_ rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ -- semantic domain newtype T_Rule = T_Rule { attach_T_Rule :: Identity (T_Rule_s32 ) } newtype T_Rule_s32 = C_Rule_s32 { inv_Rule_s32 :: (T_Rule_v31 ) } data T_Rule_s33 = C_Rule_s33 type T_Rule_v31 = (T_Rule_vIn31 ) -> (T_Rule_vOut31 ) data T_Rule_vIn31 = T_Rule_vIn31 (Map Identifier Type) ([(Identifier,Type,ChildKind)]) ([Identifier]) (Map AltAttr Vertex) ([(Identifier,Identifier)]) (Map Identifier Attributes) (Map Identifier NontermIdent) (Identifier) (Attributes) (Map Identifier Attributes) (Map Identifier (Identifier,[Identifier])) (Identifier) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (String) (Attributes) (Map Identifier Attributes) data T_Rule_vOut31 = T_Rule_vOut31 (Seq Edge) (Seq Error) ([AltAttr]) (Seq CRule) (Seq Edge) ([Identifier]) ([Identifier]) (Int) (Int) {-# NOINLINE sem_Rule_Rule #-} sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule sem_Rule_Rule arg_mbName_ arg_pattern_ arg_rhs_ arg_owrt_ arg_origin_ arg_explicit_ _ _ _ _ = T_Rule (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_Rule_v31 v31 = \ (T_Rule_vIn31 _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsIinhsOfChildren _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsyn _lhsIsynsOfChildren) -> ( let _patternX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) _rhsX8 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) (T_Pattern_vOut19 _patternIcopy _patternIerrors _patternIgathAltAttrs _patternIinstVars _patternIlocVars _patternIpatternAttrs) = inv_Pattern_s20 _patternX20 (T_Pattern_vIn19 _patternOallTypeSigs _patternOaltAttrs _patternOcon _patternOinh _patternOnt _patternOsyn) (T_Expression_vOut7 _rhsIallRhsVars _rhsIcopy _rhsIerrors _rhsItextLines _rhsIusedAttrs _rhsIusedFields _rhsIusedLocals) = inv_Expression_s8 _rhsX8 (T_Expression_vIn7 _rhsOallfields _rhsOallnts _rhsOattrs _rhsOcon _rhsOmergeMap _rhsOnt _rhsOoptions) _lhsOnExplicitRules :: Int _lhsOnExplicitRules = rule447 arg_explicit_ _lhsOnAutoRules :: Int _lhsOnAutoRules = rule448 arg_origin_ _defines = rule449 _lhsIallTypeSigs _lhsIaltAttrs _lhsIchildInhs _lhsIsyn _patternIpatternAttrs _gathRules = rule450 _defines _lhsIchildNts _lhsIcon _lhsInt _patternIcopy _rhsIallRhsVars _rhsItextLines arg_explicit_ arg_mbName_ arg_origin_ arg_owrt_ _lhsOdirectDep :: Seq Edge _lhsOdirectDep = rule451 _defines _lhsIaltAttrs _rhsIusedAttrs _rhsIusedFields _rhsIusedLocals _instDep1 = rule452 _defines _lhsIaltAttrs _lhsIsynsOfChildren _instDep2 = rule453 _defines _lhsIaltAttrs _lhsIinhsOfChildren _lhsOinstDep :: Seq Edge _lhsOinstDep = rule454 _instDep1 _instDep2 _lhsOerrors :: Seq Error _lhsOerrors = rule455 _patternIerrors _rhsIerrors _lhsOgathAltAttrs :: [AltAttr] _lhsOgathAltAttrs = rule456 _patternIgathAltAttrs _lhsOgathRules :: Seq CRule _lhsOgathRules = rule457 _gathRules _lhsOinstVars :: [Identifier] _lhsOinstVars = rule458 _patternIinstVars _lhsOlocVars :: [Identifier] _lhsOlocVars = rule459 _patternIlocVars _patternOallTypeSigs = rule460 _lhsIallTypeSigs _patternOaltAttrs = rule461 _lhsIaltAttrs _patternOcon = rule462 _lhsIcon _patternOinh = rule463 _lhsIinh _patternOnt = rule464 _lhsInt _patternOsyn = rule465 _lhsIsyn _rhsOallfields = rule466 _lhsIallfields _rhsOallnts = rule467 _lhsIallnts _rhsOattrs = rule468 _lhsIattrs _rhsOcon = rule469 _lhsIcon _rhsOmergeMap = rule470 _lhsImergeMap _rhsOnt = rule471 _lhsInt _rhsOoptions = rule472 _lhsIoptions __result_ = T_Rule_vOut31 _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars _lhsOnAutoRules _lhsOnExplicitRules in __result_ ) in C_Rule_s32 v31 {-# INLINE rule447 #-} {-# LINE 64 "src-ag/Order.ag" #-} rule447 = \ explicit_ -> {-# LINE 64 "src-ag/Order.ag" #-} if explicit_ then 1 else 0 {-# LINE 3255 "dist/build/Order.hs"#-} {-# INLINE rule448 #-} {-# LINE 67 "src-ag/Order.ag" #-} rule448 = \ origin_ -> {-# LINE 67 "src-ag/Order.ag" #-} if startsWith "use rule" origin_ || startsWith "copy rule" origin_ then 1 else 0 {-# LINE 3263 "dist/build/Order.hs"#-} {-# INLINE rule449 #-} {-# LINE 220 "src-ag/Order.ag" #-} rule449 = \ ((_lhsIallTypeSigs) :: Map Identifier Type) ((_lhsIaltAttrs) :: Map AltAttr Vertex) ((_lhsIchildInhs) :: Map Identifier Attributes) ((_lhsIsyn) :: Attributes) ((_patternIpatternAttrs) :: [(Identifier,Identifier,Bool)]) -> {-# LINE 220 "src-ag/Order.ag" #-} let tp field attr | field == _LOC || field == _INST = Map.lookup attr _lhsIallTypeSigs | field == _LHS = Map.lookup attr _lhsIsyn | otherwise = Map.lookup attr (findWithErr1 "Rule.defines.tp" field _lhsIchildInhs) typ :: Pattern -> Maybe Type typ (Alias field attr _) = tp field attr typ (Underscore _) = Nothing typ _ = Nothing in Map.fromList [ (findWithErr1 "Rule.defines" aa _lhsIaltAttrs, (field,attr,(tp field attr))) | (field,attr,isLocalOrInst) <- _patternIpatternAttrs , let aa = AltAttr field attr isLocalOrInst ] {-# LINE 3280 "dist/build/Order.hs"#-} {-# INLINE rule450 #-} {-# LINE 234 "src-ag/Order.ag" #-} rule450 = \ _defines ((_lhsIchildNts) :: Map Identifier NontermIdent) ((_lhsIcon) :: Identifier) ((_lhsInt) :: Identifier) ((_patternIcopy) :: Pattern) ((_rhsIallRhsVars) :: Set (Identifier,Identifier)) ((_rhsItextLines) :: [String]) explicit_ mbName_ origin_ owrt_ -> {-# LINE 234 "src-ag/Order.ag" #-} let childnt field = Map.lookup field _lhsIchildNts in Seq.fromList [ CRule attr False True _lhsInt _lhsIcon field (childnt field) tp _patternIcopy _rhsItextLines _defines owrt_ origin_ _rhsIallRhsVars explicit_ mbName_ | (field,attr,tp) <- Map.elems _defines ] {-# LINE 3289 "dist/build/Order.hs"#-} {-# INLINE rule451 #-} {-# LINE 273 "src-ag/Order.ag" #-} rule451 = \ _defines ((_lhsIaltAttrs) :: Map AltAttr Vertex) ((_rhsIusedAttrs) :: [(Identifier,Identifier)]) ((_rhsIusedFields) :: [Identifier]) ((_rhsIusedLocals) :: [Identifier]) -> {-# LINE 273 "src-ag/Order.ag" #-} let defined = Map.keys _defines used = [ Map.lookup (AltAttr field attr True) _lhsIaltAttrs | (field,attr) <- _rhsIusedAttrs] ++ [ Map.lookup (AltAttr _LOC attr True) _lhsIaltAttrs | attr <- _rhsIusedLocals ++ _rhsIusedFields ] in Seq.fromList [ (x,y) | Just x <- used, y <- defined ] {-# LINE 3298 "dist/build/Order.hs"#-} {-# INLINE rule452 #-} {-# LINE 317 "src-ag/Order.ag" #-} rule452 = \ _defines ((_lhsIaltAttrs) :: Map AltAttr Vertex) ((_lhsIsynsOfChildren) :: Map Identifier Attributes) -> {-# LINE 317 "src-ag/Order.ag" #-} Seq.fromList $ [ (instVert, synVert) | (field,instNm,_) <- Map.elems _defines , field == _INST , synNm <- Map.keys (findWithErr2 instNm _lhsIsynsOfChildren) , let instAttr = AltAttr _INST instNm True synAttr = AltAttr instNm synNm True instVert = findWithErr2 instAttr _lhsIaltAttrs synVert = findWithErr2 synAttr _lhsIaltAttrs ] {-# LINE 3313 "dist/build/Order.hs"#-} {-# INLINE rule453 #-} {-# LINE 328 "src-ag/Order.ag" #-} rule453 = \ _defines ((_lhsIaltAttrs) :: Map AltAttr Vertex) ((_lhsIinhsOfChildren) :: Map Identifier Attributes) -> {-# LINE 328 "src-ag/Order.ag" #-} Seq.fromList $ [ (instVert, inhVert) | (field,instNm,_) <- Map.elems _defines , field == _INST , inhNm <- Map.keys (findWithErr2 instNm _lhsIinhsOfChildren) , let instAttr = AltAttr _INST instNm True inhAttr = AltAttr instNm inhNm False instVert = findWithErr2 instAttr _lhsIaltAttrs inhVert = findWithErr2 inhAttr _lhsIaltAttrs ] {-# LINE 3328 "dist/build/Order.hs"#-} {-# INLINE rule454 #-} {-# LINE 338 "src-ag/Order.ag" #-} rule454 = \ _instDep1 _instDep2 -> {-# LINE 338 "src-ag/Order.ag" #-} _instDep1 Seq.>< _instDep2 {-# LINE 3334 "dist/build/Order.hs"#-} {-# INLINE rule455 #-} rule455 = \ ((_patternIerrors) :: Seq Error) ((_rhsIerrors) :: Seq Error) -> _patternIerrors Seq.>< _rhsIerrors {-# INLINE rule456 #-} rule456 = \ ((_patternIgathAltAttrs) :: [AltAttr]) -> _patternIgathAltAttrs {-# INLINE rule457 #-} rule457 = \ _gathRules -> _gathRules {-# INLINE rule458 #-} rule458 = \ ((_patternIinstVars) :: [Identifier]) -> _patternIinstVars {-# INLINE rule459 #-} rule459 = \ ((_patternIlocVars) :: [Identifier]) -> _patternIlocVars {-# INLINE rule460 #-} rule460 = \ ((_lhsIallTypeSigs) :: Map Identifier Type) -> _lhsIallTypeSigs {-# INLINE rule461 #-} rule461 = \ ((_lhsIaltAttrs) :: Map AltAttr Vertex) -> _lhsIaltAttrs {-# INLINE rule462 #-} rule462 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule463 #-} rule463 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule464 #-} rule464 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule465 #-} rule465 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule466 #-} rule466 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) -> _lhsIallfields {-# INLINE rule467 #-} rule467 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule468 #-} rule468 = \ ((_lhsIattrs) :: [(Identifier,Identifier)]) -> _lhsIattrs {-# INLINE rule469 #-} rule469 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule470 #-} rule470 = \ ((_lhsImergeMap) :: Map Identifier (Identifier,[Identifier])) -> _lhsImergeMap {-# INLINE rule471 #-} rule471 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule472 #-} rule472 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- Rules ------------------------------------------------------- -- wrapper data Inh_Rules = Inh_Rules { allTypeSigs_Inh_Rules :: (Map Identifier Type), allfields_Inh_Rules :: ([(Identifier,Type,ChildKind)]), allnts_Inh_Rules :: ([Identifier]), altAttrs_Inh_Rules :: (Map AltAttr Vertex), attrs_Inh_Rules :: ([(Identifier,Identifier)]), childInhs_Inh_Rules :: (Map Identifier Attributes), childNts_Inh_Rules :: (Map Identifier NontermIdent), con_Inh_Rules :: (Identifier), inh_Inh_Rules :: (Attributes), inhsOfChildren_Inh_Rules :: (Map Identifier Attributes), mergeMap_Inh_Rules :: (Map Identifier (Identifier,[Identifier])), nt_Inh_Rules :: (Identifier), o_case_Inh_Rules :: (Bool), o_cata_Inh_Rules :: (Bool), o_dovisit_Inh_Rules :: (Bool), o_newtypes_Inh_Rules :: (Bool), o_rename_Inh_Rules :: (Bool), o_sem_Inh_Rules :: (Bool), o_sig_Inh_Rules :: (Bool), o_wantvisit_Inh_Rules :: (Bool), options_Inh_Rules :: (Options), prefix_Inh_Rules :: (String), syn_Inh_Rules :: (Attributes), synsOfChildren_Inh_Rules :: (Map Identifier Attributes) } data Syn_Rules = Syn_Rules { directDep_Syn_Rules :: (Seq Edge), errors_Syn_Rules :: (Seq Error), gathAltAttrs_Syn_Rules :: ([AltAttr]), gathRules_Syn_Rules :: (Seq CRule), instDep_Syn_Rules :: (Seq Edge), instVars_Syn_Rules :: ([Identifier]), locVars_Syn_Rules :: ([Identifier]), nAutoRules_Syn_Rules :: (Int), nExplicitRules_Syn_Rules :: (Int) } {-# INLINABLE wrap_Rules #-} wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules ) wrap_Rules (T_Rules act) (Inh_Rules _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsIinhsOfChildren _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsyn _lhsIsynsOfChildren) = Control.Monad.Identity.runIdentity ( do sem <- act let arg34 = T_Rules_vIn34 _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsIinhsOfChildren _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsyn _lhsIsynsOfChildren (T_Rules_vOut34 _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars _lhsOnAutoRules _lhsOnExplicitRules) <- return (inv_Rules_s35 sem arg34) return (Syn_Rules _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars _lhsOnAutoRules _lhsOnExplicitRules) ) -- cata {-# NOINLINE sem_Rules #-} sem_Rules :: Rules -> T_Rules sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) -- semantic domain newtype T_Rules = T_Rules { attach_T_Rules :: Identity (T_Rules_s35 ) } newtype T_Rules_s35 = C_Rules_s35 { inv_Rules_s35 :: (T_Rules_v34 ) } data T_Rules_s36 = C_Rules_s36 type T_Rules_v34 = (T_Rules_vIn34 ) -> (T_Rules_vOut34 ) data T_Rules_vIn34 = T_Rules_vIn34 (Map Identifier Type) ([(Identifier,Type,ChildKind)]) ([Identifier]) (Map AltAttr Vertex) ([(Identifier,Identifier)]) (Map Identifier Attributes) (Map Identifier NontermIdent) (Identifier) (Attributes) (Map Identifier Attributes) (Map Identifier (Identifier,[Identifier])) (Identifier) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Bool) (Options) (String) (Attributes) (Map Identifier Attributes) data T_Rules_vOut34 = T_Rules_vOut34 (Seq Edge) (Seq Error) ([AltAttr]) (Seq CRule) (Seq Edge) ([Identifier]) ([Identifier]) (Int) (Int) {-# NOINLINE sem_Rules_Cons #-} sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Rules_v34 v34 = \ (T_Rules_vIn34 _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsIinhsOfChildren _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsyn _lhsIsynsOfChildren) -> ( let _hdX32 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) _tlX35 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) (T_Rule_vOut31 _hdIdirectDep _hdIerrors _hdIgathAltAttrs _hdIgathRules _hdIinstDep _hdIinstVars _hdIlocVars _hdInAutoRules _hdInExplicitRules) = inv_Rule_s32 _hdX32 (T_Rule_vIn31 _hdOallTypeSigs _hdOallfields _hdOallnts _hdOaltAttrs _hdOattrs _hdOchildInhs _hdOchildNts _hdOcon _hdOinh _hdOinhsOfChildren _hdOmergeMap _hdOnt _hdOo_case _hdOo_cata _hdOo_dovisit _hdOo_newtypes _hdOo_rename _hdOo_sem _hdOo_sig _hdOo_wantvisit _hdOoptions _hdOprefix _hdOsyn _hdOsynsOfChildren) (T_Rules_vOut34 _tlIdirectDep _tlIerrors _tlIgathAltAttrs _tlIgathRules _tlIinstDep _tlIinstVars _tlIlocVars _tlInAutoRules _tlInExplicitRules) = inv_Rules_s35 _tlX35 (T_Rules_vIn34 _tlOallTypeSigs _tlOallfields _tlOallnts _tlOaltAttrs _tlOattrs _tlOchildInhs _tlOchildNts _tlOcon _tlOinh _tlOinhsOfChildren _tlOmergeMap _tlOnt _tlOo_case _tlOo_cata _tlOo_dovisit _tlOo_newtypes _tlOo_rename _tlOo_sem _tlOo_sig _tlOo_wantvisit _tlOoptions _tlOprefix _tlOsyn _tlOsynsOfChildren) _lhsOdirectDep :: Seq Edge _lhsOdirectDep = rule473 _hdIdirectDep _tlIdirectDep _lhsOerrors :: Seq Error _lhsOerrors = rule474 _hdIerrors _tlIerrors _lhsOgathAltAttrs :: [AltAttr] _lhsOgathAltAttrs = rule475 _hdIgathAltAttrs _tlIgathAltAttrs _lhsOgathRules :: Seq CRule _lhsOgathRules = rule476 _hdIgathRules _tlIgathRules _lhsOinstDep :: Seq Edge _lhsOinstDep = rule477 _hdIinstDep _tlIinstDep _lhsOinstVars :: [Identifier] _lhsOinstVars = rule478 _hdIinstVars _tlIinstVars _lhsOlocVars :: [Identifier] _lhsOlocVars = rule479 _hdIlocVars _tlIlocVars _lhsOnAutoRules :: Int _lhsOnAutoRules = rule480 _hdInAutoRules _tlInAutoRules _lhsOnExplicitRules :: Int _lhsOnExplicitRules = rule481 _hdInExplicitRules _tlInExplicitRules _hdOallTypeSigs = rule482 _lhsIallTypeSigs _hdOallfields = rule483 _lhsIallfields _hdOallnts = rule484 _lhsIallnts _hdOaltAttrs = rule485 _lhsIaltAttrs _hdOattrs = rule486 _lhsIattrs _hdOchildInhs = rule487 _lhsIchildInhs _hdOchildNts = rule488 _lhsIchildNts _hdOcon = rule489 _lhsIcon _hdOinh = rule490 _lhsIinh _hdOinhsOfChildren = rule491 _lhsIinhsOfChildren _hdOmergeMap = rule492 _lhsImergeMap _hdOnt = rule493 _lhsInt _hdOo_case = rule494 _lhsIo_case _hdOo_cata = rule495 _lhsIo_cata _hdOo_dovisit = rule496 _lhsIo_dovisit _hdOo_newtypes = rule497 _lhsIo_newtypes _hdOo_rename = rule498 _lhsIo_rename _hdOo_sem = rule499 _lhsIo_sem _hdOo_sig = rule500 _lhsIo_sig _hdOo_wantvisit = rule501 _lhsIo_wantvisit _hdOoptions = rule502 _lhsIoptions _hdOprefix = rule503 _lhsIprefix _hdOsyn = rule504 _lhsIsyn _hdOsynsOfChildren = rule505 _lhsIsynsOfChildren _tlOallTypeSigs = rule506 _lhsIallTypeSigs _tlOallfields = rule507 _lhsIallfields _tlOallnts = rule508 _lhsIallnts _tlOaltAttrs = rule509 _lhsIaltAttrs _tlOattrs = rule510 _lhsIattrs _tlOchildInhs = rule511 _lhsIchildInhs _tlOchildNts = rule512 _lhsIchildNts _tlOcon = rule513 _lhsIcon _tlOinh = rule514 _lhsIinh _tlOinhsOfChildren = rule515 _lhsIinhsOfChildren _tlOmergeMap = rule516 _lhsImergeMap _tlOnt = rule517 _lhsInt _tlOo_case = rule518 _lhsIo_case _tlOo_cata = rule519 _lhsIo_cata _tlOo_dovisit = rule520 _lhsIo_dovisit _tlOo_newtypes = rule521 _lhsIo_newtypes _tlOo_rename = rule522 _lhsIo_rename _tlOo_sem = rule523 _lhsIo_sem _tlOo_sig = rule524 _lhsIo_sig _tlOo_wantvisit = rule525 _lhsIo_wantvisit _tlOoptions = rule526 _lhsIoptions _tlOprefix = rule527 _lhsIprefix _tlOsyn = rule528 _lhsIsyn _tlOsynsOfChildren = rule529 _lhsIsynsOfChildren __result_ = T_Rules_vOut34 _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars _lhsOnAutoRules _lhsOnExplicitRules in __result_ ) in C_Rules_s35 v34 {-# INLINE rule473 #-} rule473 = \ ((_hdIdirectDep) :: Seq Edge) ((_tlIdirectDep) :: Seq Edge) -> _hdIdirectDep Seq.>< _tlIdirectDep {-# INLINE rule474 #-} rule474 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> _hdIerrors Seq.>< _tlIerrors {-# INLINE rule475 #-} rule475 = \ ((_hdIgathAltAttrs) :: [AltAttr]) ((_tlIgathAltAttrs) :: [AltAttr]) -> _hdIgathAltAttrs ++ _tlIgathAltAttrs {-# INLINE rule476 #-} rule476 = \ ((_hdIgathRules) :: Seq CRule) ((_tlIgathRules) :: Seq CRule) -> _hdIgathRules Seq.>< _tlIgathRules {-# INLINE rule477 #-} rule477 = \ ((_hdIinstDep) :: Seq Edge) ((_tlIinstDep) :: Seq Edge) -> _hdIinstDep Seq.>< _tlIinstDep {-# INLINE rule478 #-} rule478 = \ ((_hdIinstVars) :: [Identifier]) ((_tlIinstVars) :: [Identifier]) -> _hdIinstVars ++ _tlIinstVars {-# INLINE rule479 #-} rule479 = \ ((_hdIlocVars) :: [Identifier]) ((_tlIlocVars) :: [Identifier]) -> _hdIlocVars ++ _tlIlocVars {-# INLINE rule480 #-} rule480 = \ ((_hdInAutoRules) :: Int) ((_tlInAutoRules) :: Int) -> _hdInAutoRules + _tlInAutoRules {-# INLINE rule481 #-} rule481 = \ ((_hdInExplicitRules) :: Int) ((_tlInExplicitRules) :: Int) -> _hdInExplicitRules + _tlInExplicitRules {-# INLINE rule482 #-} rule482 = \ ((_lhsIallTypeSigs) :: Map Identifier Type) -> _lhsIallTypeSigs {-# INLINE rule483 #-} rule483 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) -> _lhsIallfields {-# INLINE rule484 #-} rule484 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule485 #-} rule485 = \ ((_lhsIaltAttrs) :: Map AltAttr Vertex) -> _lhsIaltAttrs {-# INLINE rule486 #-} rule486 = \ ((_lhsIattrs) :: [(Identifier,Identifier)]) -> _lhsIattrs {-# INLINE rule487 #-} rule487 = \ ((_lhsIchildInhs) :: Map Identifier Attributes) -> _lhsIchildInhs {-# INLINE rule488 #-} rule488 = \ ((_lhsIchildNts) :: Map Identifier NontermIdent) -> _lhsIchildNts {-# INLINE rule489 #-} rule489 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule490 #-} rule490 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule491 #-} rule491 = \ ((_lhsIinhsOfChildren) :: Map Identifier Attributes) -> _lhsIinhsOfChildren {-# INLINE rule492 #-} rule492 = \ ((_lhsImergeMap) :: Map Identifier (Identifier,[Identifier])) -> _lhsImergeMap {-# INLINE rule493 #-} rule493 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule494 #-} rule494 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule495 #-} rule495 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule496 #-} rule496 = \ ((_lhsIo_dovisit) :: Bool) -> _lhsIo_dovisit {-# INLINE rule497 #-} rule497 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule498 #-} rule498 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule499 #-} rule499 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule500 #-} rule500 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule501 #-} rule501 = \ ((_lhsIo_wantvisit) :: Bool) -> _lhsIo_wantvisit {-# INLINE rule502 #-} rule502 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule503 #-} rule503 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule504 #-} rule504 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule505 #-} rule505 = \ ((_lhsIsynsOfChildren) :: Map Identifier Attributes) -> _lhsIsynsOfChildren {-# INLINE rule506 #-} rule506 = \ ((_lhsIallTypeSigs) :: Map Identifier Type) -> _lhsIallTypeSigs {-# INLINE rule507 #-} rule507 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) -> _lhsIallfields {-# INLINE rule508 #-} rule508 = \ ((_lhsIallnts) :: [Identifier]) -> _lhsIallnts {-# INLINE rule509 #-} rule509 = \ ((_lhsIaltAttrs) :: Map AltAttr Vertex) -> _lhsIaltAttrs {-# INLINE rule510 #-} rule510 = \ ((_lhsIattrs) :: [(Identifier,Identifier)]) -> _lhsIattrs {-# INLINE rule511 #-} rule511 = \ ((_lhsIchildInhs) :: Map Identifier Attributes) -> _lhsIchildInhs {-# INLINE rule512 #-} rule512 = \ ((_lhsIchildNts) :: Map Identifier NontermIdent) -> _lhsIchildNts {-# INLINE rule513 #-} rule513 = \ ((_lhsIcon) :: Identifier) -> _lhsIcon {-# INLINE rule514 #-} rule514 = \ ((_lhsIinh) :: Attributes) -> _lhsIinh {-# INLINE rule515 #-} rule515 = \ ((_lhsIinhsOfChildren) :: Map Identifier Attributes) -> _lhsIinhsOfChildren {-# INLINE rule516 #-} rule516 = \ ((_lhsImergeMap) :: Map Identifier (Identifier,[Identifier])) -> _lhsImergeMap {-# INLINE rule517 #-} rule517 = \ ((_lhsInt) :: Identifier) -> _lhsInt {-# INLINE rule518 #-} rule518 = \ ((_lhsIo_case) :: Bool) -> _lhsIo_case {-# INLINE rule519 #-} rule519 = \ ((_lhsIo_cata) :: Bool) -> _lhsIo_cata {-# INLINE rule520 #-} rule520 = \ ((_lhsIo_dovisit) :: Bool) -> _lhsIo_dovisit {-# INLINE rule521 #-} rule521 = \ ((_lhsIo_newtypes) :: Bool) -> _lhsIo_newtypes {-# INLINE rule522 #-} rule522 = \ ((_lhsIo_rename) :: Bool) -> _lhsIo_rename {-# INLINE rule523 #-} rule523 = \ ((_lhsIo_sem) :: Bool) -> _lhsIo_sem {-# INLINE rule524 #-} rule524 = \ ((_lhsIo_sig) :: Bool) -> _lhsIo_sig {-# INLINE rule525 #-} rule525 = \ ((_lhsIo_wantvisit) :: Bool) -> _lhsIo_wantvisit {-# INLINE rule526 #-} rule526 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule527 #-} rule527 = \ ((_lhsIprefix) :: String) -> _lhsIprefix {-# INLINE rule528 #-} rule528 = \ ((_lhsIsyn) :: Attributes) -> _lhsIsyn {-# INLINE rule529 #-} rule529 = \ ((_lhsIsynsOfChildren) :: Map Identifier Attributes) -> _lhsIsynsOfChildren {-# NOINLINE sem_Rules_Nil #-} sem_Rules_Nil :: T_Rules sem_Rules_Nil = T_Rules (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Rules_v34 v34 = \ (T_Rules_vIn34 _lhsIallTypeSigs _lhsIallfields _lhsIallnts _lhsIaltAttrs _lhsIattrs _lhsIchildInhs _lhsIchildNts _lhsIcon _lhsIinh _lhsIinhsOfChildren _lhsImergeMap _lhsInt _lhsIo_case _lhsIo_cata _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_wantvisit _lhsIoptions _lhsIprefix _lhsIsyn _lhsIsynsOfChildren) -> ( let _lhsOdirectDep :: Seq Edge _lhsOdirectDep = rule530 () _lhsOerrors :: Seq Error _lhsOerrors = rule531 () _lhsOgathAltAttrs :: [AltAttr] _lhsOgathAltAttrs = rule532 () _lhsOgathRules :: Seq CRule _lhsOgathRules = rule533 () _lhsOinstDep :: Seq Edge _lhsOinstDep = rule534 () _lhsOinstVars :: [Identifier] _lhsOinstVars = rule535 () _lhsOlocVars :: [Identifier] _lhsOlocVars = rule536 () _lhsOnAutoRules :: Int _lhsOnAutoRules = rule537 () _lhsOnExplicitRules :: Int _lhsOnExplicitRules = rule538 () __result_ = T_Rules_vOut34 _lhsOdirectDep _lhsOerrors _lhsOgathAltAttrs _lhsOgathRules _lhsOinstDep _lhsOinstVars _lhsOlocVars _lhsOnAutoRules _lhsOnExplicitRules in __result_ ) in C_Rules_s35 v34 {-# INLINE rule530 #-} rule530 = \ (_ :: ()) -> Seq.empty {-# INLINE rule531 #-} rule531 = \ (_ :: ()) -> Seq.empty {-# INLINE rule532 #-} rule532 = \ (_ :: ()) -> [] {-# INLINE rule533 #-} rule533 = \ (_ :: ()) -> Seq.empty {-# INLINE rule534 #-} rule534 = \ (_ :: ()) -> Seq.empty {-# INLINE rule535 #-} rule535 = \ (_ :: ()) -> [] {-# INLINE rule536 #-} rule536 = \ (_ :: ()) -> [] {-# INLINE rule537 #-} rule537 = \ (_ :: ()) -> 0 {-# INLINE rule538 #-} rule538 = \ (_ :: ()) -> 0 -- TypeSig ----------------------------------------------------- -- wrapper data Inh_TypeSig = Inh_TypeSig { typeSigs_Inh_TypeSig :: (Map Identifier Type) } data Syn_TypeSig = Syn_TypeSig { typeSigs_Syn_TypeSig :: (Map Identifier Type) } {-# INLINABLE wrap_TypeSig #-} wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig ) wrap_TypeSig (T_TypeSig act) (Inh_TypeSig _lhsItypeSigs) = Control.Monad.Identity.runIdentity ( do sem <- act let arg37 = T_TypeSig_vIn37 _lhsItypeSigs (T_TypeSig_vOut37 _lhsOtypeSigs) <- return (inv_TypeSig_s38 sem arg37) return (Syn_TypeSig _lhsOtypeSigs) ) -- cata {-# INLINE sem_TypeSig #-} sem_TypeSig :: TypeSig -> T_TypeSig sem_TypeSig ( TypeSig name_ tp_ ) = sem_TypeSig_TypeSig name_ tp_ -- semantic domain newtype T_TypeSig = T_TypeSig { attach_T_TypeSig :: Identity (T_TypeSig_s38 ) } newtype T_TypeSig_s38 = C_TypeSig_s38 { inv_TypeSig_s38 :: (T_TypeSig_v37 ) } data T_TypeSig_s39 = C_TypeSig_s39 type T_TypeSig_v37 = (T_TypeSig_vIn37 ) -> (T_TypeSig_vOut37 ) data T_TypeSig_vIn37 = T_TypeSig_vIn37 (Map Identifier Type) data T_TypeSig_vOut37 = T_TypeSig_vOut37 (Map Identifier Type) {-# NOINLINE sem_TypeSig_TypeSig #-} sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig sem_TypeSig_TypeSig arg_name_ arg_tp_ = T_TypeSig (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_TypeSig_v37 v37 = \ (T_TypeSig_vIn37 _lhsItypeSigs) -> ( let _lhsOtypeSigs :: Map Identifier Type _lhsOtypeSigs = rule539 _lhsItypeSigs arg_name_ arg_tp_ __result_ = T_TypeSig_vOut37 _lhsOtypeSigs in __result_ ) in C_TypeSig_s38 v37 {-# INLINE rule539 #-} {-# LINE 536 "src-ag/Order.ag" #-} rule539 = \ ((_lhsItypeSigs) :: Map Identifier Type) name_ tp_ -> {-# LINE 536 "src-ag/Order.ag" #-} Map.insert name_ tp_ _lhsItypeSigs {-# LINE 3774 "dist/build/Order.hs"#-} -- TypeSigs ---------------------------------------------------- -- wrapper data Inh_TypeSigs = Inh_TypeSigs { typeSigs_Inh_TypeSigs :: (Map Identifier Type) } data Syn_TypeSigs = Syn_TypeSigs { typeSigs_Syn_TypeSigs :: (Map Identifier Type) } {-# INLINABLE wrap_TypeSigs #-} wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs ) wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs _lhsItypeSigs) = Control.Monad.Identity.runIdentity ( do sem <- act let arg40 = T_TypeSigs_vIn40 _lhsItypeSigs (T_TypeSigs_vOut40 _lhsOtypeSigs) <- return (inv_TypeSigs_s41 sem arg40) return (Syn_TypeSigs _lhsOtypeSigs) ) -- cata {-# NOINLINE sem_TypeSigs #-} sem_TypeSigs :: TypeSigs -> T_TypeSigs sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) -- semantic domain newtype T_TypeSigs = T_TypeSigs { attach_T_TypeSigs :: Identity (T_TypeSigs_s41 ) } newtype T_TypeSigs_s41 = C_TypeSigs_s41 { inv_TypeSigs_s41 :: (T_TypeSigs_v40 ) } data T_TypeSigs_s42 = C_TypeSigs_s42 type T_TypeSigs_v40 = (T_TypeSigs_vIn40 ) -> (T_TypeSigs_vOut40 ) data T_TypeSigs_vIn40 = T_TypeSigs_vIn40 (Map Identifier Type) data T_TypeSigs_vOut40 = T_TypeSigs_vOut40 (Map Identifier Type) {-# NOINLINE sem_TypeSigs_Cons #-} sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_TypeSigs_v40 v40 = \ (T_TypeSigs_vIn40 _lhsItypeSigs) -> ( let _hdX38 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_)) _tlX41 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_)) (T_TypeSig_vOut37 _hdItypeSigs) = inv_TypeSig_s38 _hdX38 (T_TypeSig_vIn37 _hdOtypeSigs) (T_TypeSigs_vOut40 _tlItypeSigs) = inv_TypeSigs_s41 _tlX41 (T_TypeSigs_vIn40 _tlOtypeSigs) _lhsOtypeSigs :: Map Identifier Type _lhsOtypeSigs = rule540 _tlItypeSigs _hdOtypeSigs = rule541 _lhsItypeSigs _tlOtypeSigs = rule542 _hdItypeSigs __result_ = T_TypeSigs_vOut40 _lhsOtypeSigs in __result_ ) in C_TypeSigs_s41 v40 {-# INLINE rule540 #-} rule540 = \ ((_tlItypeSigs) :: Map Identifier Type) -> _tlItypeSigs {-# INLINE rule541 #-} rule541 = \ ((_lhsItypeSigs) :: Map Identifier Type) -> _lhsItypeSigs {-# INLINE rule542 #-} rule542 = \ ((_hdItypeSigs) :: Map Identifier Type) -> _hdItypeSigs {-# NOINLINE sem_TypeSigs_Nil #-} sem_TypeSigs_Nil :: T_TypeSigs sem_TypeSigs_Nil = T_TypeSigs (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_TypeSigs_v40 v40 = \ (T_TypeSigs_vIn40 _lhsItypeSigs) -> ( let _lhsOtypeSigs :: Map Identifier Type _lhsOtypeSigs = rule543 _lhsItypeSigs __result_ = T_TypeSigs_vOut40 _lhsOtypeSigs in __result_ ) in C_TypeSigs_s41 v40 {-# INLINE rule543 #-} rule543 = \ ((_lhsItypeSigs) :: Map Identifier Type) -> _lhsItypeSigs uuagc-0.9.52.2/src-generated/VisageSyntax.hs0000644000000000000000000000625213433540502016751 0ustar0000000000000000 -- UUAGC 0.9.51 (src-ag/VisageSyntax.ag) module VisageSyntax where {-# LINE 2 "src-ag/VisageSyntax.ag" #-} import CommonTypes import UU.Pretty import AbstractSyntax import VisagePatterns import Expression {-# LINE 13 "dist/build/VisageSyntax.hs" #-} -- VisageChild ------------------------------------------------- {- alternatives: alternative VChild: child name : {Identifier} child tp : {Type} child inh : {Attributes} child syn : {Attributes} child rules : VisageRules -} data VisageChild = VChild (Identifier) (Type) (Attributes) (Attributes) (VisageRules) -- VisageChildren ---------------------------------------------- {- alternatives: alternative Cons: child hd : VisageChild child tl : VisageChildren alternative Nil: -} type VisageChildren = [VisageChild] -- VisageGrammar ----------------------------------------------- {- alternatives: alternative VGrammar: child nonts : VisageNonterminals -} data VisageGrammar = VGrammar (VisageNonterminals) -- VisageNonterminal ------------------------------------------- {- alternatives: alternative VNonterminal: child nt : {NontermIdent} child inh : {Attributes} child syn : {Attributes} child alts : VisageProductions -} data VisageNonterminal = VNonterminal (NontermIdent) (Attributes) (Attributes) (VisageProductions) -- VisageNonterminals ------------------------------------------ {- alternatives: alternative Cons: child hd : VisageNonterminal child tl : VisageNonterminals alternative Nil: -} type VisageNonterminals = [VisageNonterminal] -- VisageProduction -------------------------------------------- {- alternatives: alternative VProduction: child con : {ConstructorIdent} child children : VisageChildren child rules : VisageRules child locrules : VisageRules -} data VisageProduction = VProduction (ConstructorIdent) (VisageChildren) (VisageRules) (VisageRules) -- VisageProductions ------------------------------------------- {- alternatives: alternative Cons: child hd : VisageProduction child tl : VisageProductions alternative Nil: -} type VisageProductions = [VisageProduction] -- VisageRule -------------------------------------------------- {- alternatives: alternative VRule: child fieldattrs : {[(Identifier,Identifier)]} child attr : {Identifier} child pat : {VisagePattern} child rhs : {Expression} child owrt : {Bool} -} data VisageRule = VRule (([(Identifier,Identifier)])) (Identifier) (VisagePattern) (Expression) (Bool) -- VisageRules ------------------------------------------------- {- alternatives: alternative Cons: child hd : VisageRule child tl : VisageRules alternative Nil: -} type VisageRules = [VisageRule]uuagc-0.9.52.2/src-generated/ErrorMessages.hs0000644000000000000000000002142513433540502017104 0ustar0000000000000000 -- UUAGC 0.9.51 (src-ag/ErrorMessages.ag) module ErrorMessages where {-# LINE 2 "src-ag/ErrorMessages.ag" #-} import UU.Scanner.Position(Pos) import Pretty import CodeSyntax import CommonTypes {-# LINE 12 "dist/build/ErrorMessages.hs" #-} -- Error ------------------------------------------------------- {- alternatives: alternative ParserError: child pos : {Pos} child problem : {String} child action : {String} alternative HsParseError: child pos : {Pos} child msg : {String} alternative DupAlt: child nt : {NontermIdent} child con : {ConstructorIdent} child occ1 : {ConstructorIdent} alternative DupSynonym: child nt : {NontermIdent} child occ1 : {NontermIdent} alternative DupSet: child name : {NontermIdent} child occ1 : {NontermIdent} alternative DupInhAttr: child nt : {NontermIdent} child attr : {Identifier} child occ1 : {Identifier} alternative DupSynAttr: child nt : {NontermIdent} child attr : {Identifier} child occ1 : {Identifier} alternative DupChild: child nt : {NontermIdent} child con : {ConstructorIdent} child name : {Identifier} child occ1 : {Identifier} alternative DupRule: child nt : {NontermIdent} child con : {ConstructorIdent} child field : {Identifier} child attr : {Identifier} child occ1 : {Identifier} alternative DupRuleName: child nt : {NontermIdent} child con : {ConstructorIdent} child nm : {Identifier} alternative DupSig: child nt : {NontermIdent} child con : {ConstructorIdent} child attr : {Identifier} alternative UndefNont: child nt : {NontermIdent} alternative UndefAlt: child nt : {NontermIdent} child con : {ConstructorIdent} alternative UndefChild: child nt : {NontermIdent} child con : {ConstructorIdent} child name : {Identifier} alternative MissingRule: child nt : {NontermIdent} child con : {ConstructorIdent} child field : {Identifier} child attr : {Identifier} alternative MissingNamedRule: child nt : {NontermIdent} child con : {Identifier} child name : {Identifier} alternative SuperfluousRule: child nt : {NontermIdent} child con : {ConstructorIdent} child field : {Identifier} child attr : {Identifier} alternative UndefLocal: child nt : {NontermIdent} child con : {ConstructorIdent} child var : {Identifier} alternative ChildAsLocal: child nt : {NontermIdent} child con : {ConstructorIdent} child var : {Identifier} alternative UndefAttr: child nt : {NontermIdent} child con : {ConstructorIdent} child field : {Identifier} child attr : {Identifier} child isOut : {Bool} alternative Cyclic: child nt : {NontermIdent} child mbCon : {Maybe ConstructorIdent} child verts : {[String]} alternative CyclicSet: child name : {Identifier} alternative CustomError: child isWarning : {Bool} child pos : {Pos} child mesg : {PP_Doc} alternative LocalCirc: child nt : {NontermIdent} child con : {ConstructorIdent} child attr : {Identifier} child o_visit : {Bool} child path : {[String]} alternative InstCirc: child nt : {NontermIdent} child con : {ConstructorIdent} child attr : {Identifier} child o_visit : {Bool} child path : {[String]} alternative DirectCirc: child nt : {NontermIdent} child o_visit : {Bool} child cyclic : {[((Identifier,Identifier),[String],[String])]} alternative InducedCirc: child nt : {NontermIdent} child cinter : {CInterface} child cyclic : {[((Identifier,Identifier),[String],[String])]} alternative MissingTypeSig: child nt : {NontermIdent} child con : {ConstructorIdent} child attr : {Identifier} alternative MissingInstSig: child nt : {NontermIdent} child con : {ConstructorIdent} child attr : {Identifier} alternative DupUnique: child nt : {NontermIdent} child con : {ConstructorIdent} child attr : {Identifier} alternative MissingUnique: child nt : {NontermIdent} child attr : {Identifier} alternative MissingSyn: child nt : {NontermIdent} child attr : {Identifier} alternative IncompatibleVisitKind: child child : {Identifier} child vis : {VisitIdentifier} child from : {VisitKind} child to : {VisitKind} alternative IncompatibleRuleKind: child rule : {Identifier} child kind : {VisitKind} alternative IncompatibleAttachKind: child child : {Identifier} child kind : {VisitKind} -} data Error = ParserError (Pos) (String) (String) | HsParseError (Pos) (String) | DupAlt (NontermIdent) (ConstructorIdent) (ConstructorIdent) | DupSynonym (NontermIdent) (NontermIdent) | DupSet (NontermIdent) (NontermIdent) | DupInhAttr (NontermIdent) (Identifier) (Identifier) | DupSynAttr (NontermIdent) (Identifier) (Identifier) | DupChild (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) | DupRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) (Identifier) | DupRuleName (NontermIdent) (ConstructorIdent) (Identifier) | DupSig (NontermIdent) (ConstructorIdent) (Identifier) | UndefNont (NontermIdent) | UndefAlt (NontermIdent) (ConstructorIdent) | UndefChild (NontermIdent) (ConstructorIdent) (Identifier) | MissingRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) | MissingNamedRule (NontermIdent) (Identifier) (Identifier) | SuperfluousRule (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) | UndefLocal (NontermIdent) (ConstructorIdent) (Identifier) | ChildAsLocal (NontermIdent) (ConstructorIdent) (Identifier) | UndefAttr (NontermIdent) (ConstructorIdent) (Identifier) (Identifier) (Bool) | Cyclic (NontermIdent) ((Maybe ConstructorIdent)) (([String])) | CyclicSet (Identifier) | CustomError (Bool) (Pos) (PP_Doc) | LocalCirc (NontermIdent) (ConstructorIdent) (Identifier) (Bool) (([String])) | InstCirc (NontermIdent) (ConstructorIdent) (Identifier) (Bool) (([String])) | DirectCirc (NontermIdent) (Bool) (([((Identifier,Identifier),[String],[String])])) | InducedCirc (NontermIdent) (CInterface) (([((Identifier,Identifier),[String],[String])])) | MissingTypeSig (NontermIdent) (ConstructorIdent) (Identifier) | MissingInstSig (NontermIdent) (ConstructorIdent) (Identifier) | DupUnique (NontermIdent) (ConstructorIdent) (Identifier) | MissingUnique (NontermIdent) (Identifier) | MissingSyn (NontermIdent) (Identifier) | IncompatibleVisitKind (Identifier) (VisitIdentifier) (VisitKind) (VisitKind) | IncompatibleRuleKind (Identifier) (VisitKind) | IncompatibleAttachKind (Identifier) (VisitKind) -- Errors ------------------------------------------------------ {- alternatives: alternative Cons: child hd : Error child tl : Errors alternative Nil: -} type Errors = [Error]uuagc-0.9.52.2/src-generated/PrintVisitCode.hs0000644000000000000000000011765413433540502017243 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module PrintVisitCode where {-# LINE 2 "src-ag/DeclBlocks.ag" #-} import Code (Decl,Expr) {-# LINE 9 "dist/build/PrintVisitCode.hs" #-} {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 16 "dist/build/PrintVisitCode.hs" #-} {-# LINE 2 "src-ag/CodeSyntax.ag" #-} import Patterns import CommonTypes import Data.Map(Map) import Data.Set(Set) {-# LINE 24 "dist/build/PrintVisitCode.hs" #-} {-# LINE 10 "src-ag/PrintVisitCode.ag" #-} import CommonTypes import SequentialTypes import Options import CodeSyntax import ErrorMessages import GrammarInfo import DeclBlocks import Pretty import qualified Data.Map as Map import Data.Map(Map) import qualified Data.Set as Set import Data.Set(Set) import qualified Data.Sequence as Seq import Data.Sequence(Seq) import UU.Scanner.Position import Data.List(partition,intersperse,intersect,(\\)) import Data.Maybe(fromJust,isJust) {-# LINE 47 "dist/build/PrintVisitCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 32 "src-ag/PrintVisitCode.ag" #-} type PP_Docs = [PP_Doc] ppMultiSeqH :: [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeqH = ppMultiSeq' (>#<) ppMultiSeqV :: [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeqV = ppMultiSeq' (>-<) ppMultiSeq' :: (PP_Doc -> PP_Doc -> PP_Doc) -> [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeq' next strictArgs expr = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs {-# LINE 63 "dist/build/PrintVisitCode.hs" #-} -- CGrammar ---------------------------------------------------- -- wrapper data Inh_CGrammar = Inh_CGrammar { options_Inh_CGrammar :: (Options) } data Syn_CGrammar = Syn_CGrammar { output_Syn_CGrammar :: (PP_Docs) } {-# INLINABLE wrap_CGrammar #-} wrap_CGrammar :: T_CGrammar -> Inh_CGrammar -> (Syn_CGrammar ) wrap_CGrammar (T_CGrammar act) (Inh_CGrammar _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_CGrammar_vIn1 _lhsIoptions (T_CGrammar_vOut1 _lhsOoutput) <- return (inv_CGrammar_s2 sem arg1) return (Syn_CGrammar _lhsOoutput) ) -- cata {-# INLINE sem_CGrammar #-} sem_CGrammar :: CGrammar -> T_CGrammar sem_CGrammar ( CGrammar typeSyns_ derivings_ wrappers_ nonts_ pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ ) = sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ ( sem_CNonterminals nonts_ ) pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ -- semantic domain newtype T_CGrammar = T_CGrammar { attach_T_CGrammar :: Identity (T_CGrammar_s2 ) } newtype T_CGrammar_s2 = C_CGrammar_s2 { inv_CGrammar_s2 :: (T_CGrammar_v1 ) } data T_CGrammar_s3 = C_CGrammar_s3 type T_CGrammar_v1 = (T_CGrammar_vIn1 ) -> (T_CGrammar_vOut1 ) data T_CGrammar_vIn1 = T_CGrammar_vIn1 (Options) data T_CGrammar_vOut1 = T_CGrammar_vOut1 (PP_Docs) {-# NOINLINE sem_CGrammar_CGrammar #-} sem_CGrammar_CGrammar :: (TypeSyns) -> (Derivings) -> (Set NontermIdent) -> T_CNonterminals -> (PragmaMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> (Bool) -> T_CGrammar sem_CGrammar_CGrammar _ _ _ arg_nonts_ _ _ _ _ _ _ _ = T_CGrammar (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_CGrammar_v1 v1 = \ (T_CGrammar_vIn1 _lhsIoptions) -> ( let _nontsX11 = Control.Monad.Identity.runIdentity (attach_T_CNonterminals (arg_nonts_)) (T_CNonterminals_vOut10 ) = inv_CNonterminals_s11 _nontsX11 (T_CNonterminals_vIn10 ) _lhsOoutput :: PP_Docs _lhsOoutput = rule0 () __result_ = T_CGrammar_vOut1 _lhsOoutput in __result_ ) in C_CGrammar_s2 v1 {-# INLINE rule0 #-} {-# LINE 53 "src-ag/PrintVisitCode.ag" #-} rule0 = \ (_ :: ()) -> {-# LINE 53 "src-ag/PrintVisitCode.ag" #-} [] {-# LINE 113 "dist/build/PrintVisitCode.hs"#-} -- CInterface -------------------------------------------------- -- wrapper data Inh_CInterface = Inh_CInterface { } data Syn_CInterface = Syn_CInterface { } {-# INLINABLE wrap_CInterface #-} wrap_CInterface :: T_CInterface -> Inh_CInterface -> (Syn_CInterface ) wrap_CInterface (T_CInterface act) (Inh_CInterface ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_CInterface_vIn4 (T_CInterface_vOut4 ) <- return (inv_CInterface_s5 sem arg4) return (Syn_CInterface ) ) -- cata {-# INLINE sem_CInterface #-} sem_CInterface :: CInterface -> T_CInterface sem_CInterface ( CInterface seg_ ) = sem_CInterface_CInterface ( sem_CSegments seg_ ) -- semantic domain newtype T_CInterface = T_CInterface { attach_T_CInterface :: Identity (T_CInterface_s5 ) } newtype T_CInterface_s5 = C_CInterface_s5 { inv_CInterface_s5 :: (T_CInterface_v4 ) } data T_CInterface_s6 = C_CInterface_s6 type T_CInterface_v4 = (T_CInterface_vIn4 ) -> (T_CInterface_vOut4 ) data T_CInterface_vIn4 = T_CInterface_vIn4 data T_CInterface_vOut4 = T_CInterface_vOut4 {-# NOINLINE sem_CInterface_CInterface #-} sem_CInterface_CInterface :: T_CSegments -> T_CInterface sem_CInterface_CInterface arg_seg_ = T_CInterface (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_CInterface_v4 v4 = \ (T_CInterface_vIn4 ) -> ( let _segX26 = Control.Monad.Identity.runIdentity (attach_T_CSegments (arg_seg_)) (T_CSegments_vOut25 ) = inv_CSegments_s26 _segX26 (T_CSegments_vIn25 ) __result_ = T_CInterface_vOut4 in __result_ ) in C_CInterface_s5 v4 -- CNonterminal ------------------------------------------------ -- wrapper data Inh_CNonterminal = Inh_CNonterminal { } data Syn_CNonterminal = Syn_CNonterminal { } {-# INLINABLE wrap_CNonterminal #-} wrap_CNonterminal :: T_CNonterminal -> Inh_CNonterminal -> (Syn_CNonterminal ) wrap_CNonterminal (T_CNonterminal act) (Inh_CNonterminal ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_CNonterminal_vIn7 (T_CNonterminal_vOut7 ) <- return (inv_CNonterminal_s8 sem arg7) return (Syn_CNonterminal ) ) -- cata {-# INLINE sem_CNonterminal #-} sem_CNonterminal :: CNonterminal -> T_CNonterminal sem_CNonterminal ( CNonterminal nt_ params_ inh_ syn_ prods_ inter_ ) = sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ ( sem_CProductions prods_ ) ( sem_CInterface inter_ ) -- semantic domain newtype T_CNonterminal = T_CNonterminal { attach_T_CNonterminal :: Identity (T_CNonterminal_s8 ) } newtype T_CNonterminal_s8 = C_CNonterminal_s8 { inv_CNonterminal_s8 :: (T_CNonterminal_v7 ) } data T_CNonterminal_s9 = C_CNonterminal_s9 type T_CNonterminal_v7 = (T_CNonterminal_vIn7 ) -> (T_CNonterminal_vOut7 ) data T_CNonterminal_vIn7 = T_CNonterminal_vIn7 data T_CNonterminal_vOut7 = T_CNonterminal_vOut7 {-# NOINLINE sem_CNonterminal_CNonterminal #-} sem_CNonterminal_CNonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_CProductions -> T_CInterface -> T_CNonterminal sem_CNonterminal_CNonterminal _ _ _ _ arg_prods_ arg_inter_ = T_CNonterminal (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_CNonterminal_v7 v7 = \ (T_CNonterminal_vIn7 ) -> ( let _prodsX17 = Control.Monad.Identity.runIdentity (attach_T_CProductions (arg_prods_)) _interX5 = Control.Monad.Identity.runIdentity (attach_T_CInterface (arg_inter_)) (T_CProductions_vOut16 ) = inv_CProductions_s17 _prodsX17 (T_CProductions_vIn16 ) (T_CInterface_vOut4 ) = inv_CInterface_s5 _interX5 (T_CInterface_vIn4 ) __result_ = T_CNonterminal_vOut7 in __result_ ) in C_CNonterminal_s8 v7 -- CNonterminals ----------------------------------------------- -- wrapper data Inh_CNonterminals = Inh_CNonterminals { } data Syn_CNonterminals = Syn_CNonterminals { } {-# INLINABLE wrap_CNonterminals #-} wrap_CNonterminals :: T_CNonterminals -> Inh_CNonterminals -> (Syn_CNonterminals ) wrap_CNonterminals (T_CNonterminals act) (Inh_CNonterminals ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg10 = T_CNonterminals_vIn10 (T_CNonterminals_vOut10 ) <- return (inv_CNonterminals_s11 sem arg10) return (Syn_CNonterminals ) ) -- cata {-# NOINLINE sem_CNonterminals #-} sem_CNonterminals :: CNonterminals -> T_CNonterminals sem_CNonterminals list = Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list) -- semantic domain newtype T_CNonterminals = T_CNonterminals { attach_T_CNonterminals :: Identity (T_CNonterminals_s11 ) } newtype T_CNonterminals_s11 = C_CNonterminals_s11 { inv_CNonterminals_s11 :: (T_CNonterminals_v10 ) } data T_CNonterminals_s12 = C_CNonterminals_s12 type T_CNonterminals_v10 = (T_CNonterminals_vIn10 ) -> (T_CNonterminals_vOut10 ) data T_CNonterminals_vIn10 = T_CNonterminals_vIn10 data T_CNonterminals_vOut10 = T_CNonterminals_vOut10 {-# NOINLINE sem_CNonterminals_Cons #-} sem_CNonterminals_Cons :: T_CNonterminal -> T_CNonterminals -> T_CNonterminals sem_CNonterminals_Cons arg_hd_ arg_tl_ = T_CNonterminals (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_CNonterminals_v10 v10 = \ (T_CNonterminals_vIn10 ) -> ( let _hdX8 = Control.Monad.Identity.runIdentity (attach_T_CNonterminal (arg_hd_)) _tlX11 = Control.Monad.Identity.runIdentity (attach_T_CNonterminals (arg_tl_)) (T_CNonterminal_vOut7 ) = inv_CNonterminal_s8 _hdX8 (T_CNonterminal_vIn7 ) (T_CNonterminals_vOut10 ) = inv_CNonterminals_s11 _tlX11 (T_CNonterminals_vIn10 ) __result_ = T_CNonterminals_vOut10 in __result_ ) in C_CNonterminals_s11 v10 {-# NOINLINE sem_CNonterminals_Nil #-} sem_CNonterminals_Nil :: T_CNonterminals sem_CNonterminals_Nil = T_CNonterminals (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_CNonterminals_v10 v10 = \ (T_CNonterminals_vIn10 ) -> ( let __result_ = T_CNonterminals_vOut10 in __result_ ) in C_CNonterminals_s11 v10 -- CProduction ------------------------------------------------- -- wrapper data Inh_CProduction = Inh_CProduction { } data Syn_CProduction = Syn_CProduction { } {-# INLINABLE wrap_CProduction #-} wrap_CProduction :: T_CProduction -> Inh_CProduction -> (Syn_CProduction ) wrap_CProduction (T_CProduction act) (Inh_CProduction ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg13 = T_CProduction_vIn13 (T_CProduction_vOut13 ) <- return (inv_CProduction_s14 sem arg13) return (Syn_CProduction ) ) -- cata {-# INLINE sem_CProduction #-} sem_CProduction :: CProduction -> T_CProduction sem_CProduction ( CProduction con_ visits_ children_ terminals_ ) = sem_CProduction_CProduction con_ ( sem_CVisits visits_ ) children_ terminals_ -- semantic domain newtype T_CProduction = T_CProduction { attach_T_CProduction :: Identity (T_CProduction_s14 ) } newtype T_CProduction_s14 = C_CProduction_s14 { inv_CProduction_s14 :: (T_CProduction_v13 ) } data T_CProduction_s15 = C_CProduction_s15 type T_CProduction_v13 = (T_CProduction_vIn13 ) -> (T_CProduction_vOut13 ) data T_CProduction_vIn13 = T_CProduction_vIn13 data T_CProduction_vOut13 = T_CProduction_vOut13 {-# NOINLINE sem_CProduction_CProduction #-} sem_CProduction_CProduction :: (ConstructorIdent) -> T_CVisits -> ([(Identifier,Type,ChildKind)]) -> ([Identifier]) -> T_CProduction sem_CProduction_CProduction _ arg_visits_ _ _ = T_CProduction (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_CProduction_v13 v13 = \ (T_CProduction_vIn13 ) -> ( let _visitsX32 = Control.Monad.Identity.runIdentity (attach_T_CVisits (arg_visits_)) (T_CVisits_vOut31 ) = inv_CVisits_s32 _visitsX32 (T_CVisits_vIn31 ) __result_ = T_CProduction_vOut13 in __result_ ) in C_CProduction_s14 v13 -- CProductions ------------------------------------------------ -- wrapper data Inh_CProductions = Inh_CProductions { } data Syn_CProductions = Syn_CProductions { } {-# INLINABLE wrap_CProductions #-} wrap_CProductions :: T_CProductions -> Inh_CProductions -> (Syn_CProductions ) wrap_CProductions (T_CProductions act) (Inh_CProductions ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg16 = T_CProductions_vIn16 (T_CProductions_vOut16 ) <- return (inv_CProductions_s17 sem arg16) return (Syn_CProductions ) ) -- cata {-# NOINLINE sem_CProductions #-} sem_CProductions :: CProductions -> T_CProductions sem_CProductions list = Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list) -- semantic domain newtype T_CProductions = T_CProductions { attach_T_CProductions :: Identity (T_CProductions_s17 ) } newtype T_CProductions_s17 = C_CProductions_s17 { inv_CProductions_s17 :: (T_CProductions_v16 ) } data T_CProductions_s18 = C_CProductions_s18 type T_CProductions_v16 = (T_CProductions_vIn16 ) -> (T_CProductions_vOut16 ) data T_CProductions_vIn16 = T_CProductions_vIn16 data T_CProductions_vOut16 = T_CProductions_vOut16 {-# NOINLINE sem_CProductions_Cons #-} sem_CProductions_Cons :: T_CProduction -> T_CProductions -> T_CProductions sem_CProductions_Cons arg_hd_ arg_tl_ = T_CProductions (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_CProductions_v16 v16 = \ (T_CProductions_vIn16 ) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_CProduction (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_CProductions (arg_tl_)) (T_CProduction_vOut13 ) = inv_CProduction_s14 _hdX14 (T_CProduction_vIn13 ) (T_CProductions_vOut16 ) = inv_CProductions_s17 _tlX17 (T_CProductions_vIn16 ) __result_ = T_CProductions_vOut16 in __result_ ) in C_CProductions_s17 v16 {-# NOINLINE sem_CProductions_Nil #-} sem_CProductions_Nil :: T_CProductions sem_CProductions_Nil = T_CProductions (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_CProductions_v16 v16 = \ (T_CProductions_vIn16 ) -> ( let __result_ = T_CProductions_vOut16 in __result_ ) in C_CProductions_s17 v16 -- CRule ------------------------------------------------------- -- wrapper data Inh_CRule = Inh_CRule { } data Syn_CRule = Syn_CRule { } {-# INLINABLE wrap_CRule #-} wrap_CRule :: T_CRule -> Inh_CRule -> (Syn_CRule ) wrap_CRule (T_CRule act) (Inh_CRule ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg19 = T_CRule_vIn19 (T_CRule_vOut19 ) <- return (inv_CRule_s20 sem arg19) return (Syn_CRule ) ) -- cata {-# NOINLINE sem_CRule #-} sem_CRule :: CRule -> T_CRule sem_CRule ( CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ pattern_ rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ ) = sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ ( sem_Pattern pattern_ ) rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ sem_CRule ( CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ ) = sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ -- semantic domain newtype T_CRule = T_CRule { attach_T_CRule :: Identity (T_CRule_s20 ) } newtype T_CRule_s20 = C_CRule_s20 { inv_CRule_s20 :: (T_CRule_v19 ) } data T_CRule_s21 = C_CRule_s21 type T_CRule_v19 = (T_CRule_vIn19 ) -> (T_CRule_vOut19 ) data T_CRule_vIn19 = T_CRule_vIn19 data T_CRule_vOut19 = T_CRule_vOut19 {-# NOINLINE sem_CRule_CRule #-} sem_CRule_CRule :: (Identifier) -> (Bool) -> (Bool) -> (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> (Maybe NontermIdent) -> (Maybe Type) -> T_Pattern -> ([String]) -> (Map Int (Identifier,Identifier,Maybe Type)) -> (Bool) -> (String) -> (Set (Identifier, Identifier)) -> (Bool) -> (Maybe Identifier) -> T_CRule sem_CRule_CRule _ _ _ _ _ _ _ _ arg_pattern_ _ _ _ _ _ _ _ = T_CRule (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_CRule_v19 v19 = \ (T_CRule_vIn19 ) -> ( let _patternX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) (T_Pattern_vOut40 _patternIcopy) = inv_Pattern_s41 _patternX41 (T_Pattern_vIn40 ) __result_ = T_CRule_vOut19 in __result_ ) in C_CRule_s20 v19 {-# NOINLINE sem_CRule_CChildVisit #-} sem_CRule_CChildVisit :: (Identifier) -> (NontermIdent) -> (Int) -> (Attributes) -> (Attributes) -> (Bool) -> T_CRule sem_CRule_CChildVisit _ _ _ _ _ _ = T_CRule (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_CRule_v19 v19 = \ (T_CRule_vIn19 ) -> ( let __result_ = T_CRule_vOut19 in __result_ ) in C_CRule_s20 v19 -- CSegment ---------------------------------------------------- -- wrapper data Inh_CSegment = Inh_CSegment { } data Syn_CSegment = Syn_CSegment { } {-# INLINABLE wrap_CSegment #-} wrap_CSegment :: T_CSegment -> Inh_CSegment -> (Syn_CSegment ) wrap_CSegment (T_CSegment act) (Inh_CSegment ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg22 = T_CSegment_vIn22 (T_CSegment_vOut22 ) <- return (inv_CSegment_s23 sem arg22) return (Syn_CSegment ) ) -- cata {-# INLINE sem_CSegment #-} sem_CSegment :: CSegment -> T_CSegment sem_CSegment ( CSegment inh_ syn_ ) = sem_CSegment_CSegment inh_ syn_ -- semantic domain newtype T_CSegment = T_CSegment { attach_T_CSegment :: Identity (T_CSegment_s23 ) } newtype T_CSegment_s23 = C_CSegment_s23 { inv_CSegment_s23 :: (T_CSegment_v22 ) } data T_CSegment_s24 = C_CSegment_s24 type T_CSegment_v22 = (T_CSegment_vIn22 ) -> (T_CSegment_vOut22 ) data T_CSegment_vIn22 = T_CSegment_vIn22 data T_CSegment_vOut22 = T_CSegment_vOut22 {-# NOINLINE sem_CSegment_CSegment #-} sem_CSegment_CSegment :: (Attributes) -> (Attributes) -> T_CSegment sem_CSegment_CSegment _ _ = T_CSegment (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_CSegment_v22 v22 = \ (T_CSegment_vIn22 ) -> ( let __result_ = T_CSegment_vOut22 in __result_ ) in C_CSegment_s23 v22 -- CSegments --------------------------------------------------- -- wrapper data Inh_CSegments = Inh_CSegments { } data Syn_CSegments = Syn_CSegments { } {-# INLINABLE wrap_CSegments #-} wrap_CSegments :: T_CSegments -> Inh_CSegments -> (Syn_CSegments ) wrap_CSegments (T_CSegments act) (Inh_CSegments ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg25 = T_CSegments_vIn25 (T_CSegments_vOut25 ) <- return (inv_CSegments_s26 sem arg25) return (Syn_CSegments ) ) -- cata {-# NOINLINE sem_CSegments #-} sem_CSegments :: CSegments -> T_CSegments sem_CSegments list = Prelude.foldr sem_CSegments_Cons sem_CSegments_Nil (Prelude.map sem_CSegment list) -- semantic domain newtype T_CSegments = T_CSegments { attach_T_CSegments :: Identity (T_CSegments_s26 ) } newtype T_CSegments_s26 = C_CSegments_s26 { inv_CSegments_s26 :: (T_CSegments_v25 ) } data T_CSegments_s27 = C_CSegments_s27 type T_CSegments_v25 = (T_CSegments_vIn25 ) -> (T_CSegments_vOut25 ) data T_CSegments_vIn25 = T_CSegments_vIn25 data T_CSegments_vOut25 = T_CSegments_vOut25 {-# NOINLINE sem_CSegments_Cons #-} sem_CSegments_Cons :: T_CSegment -> T_CSegments -> T_CSegments sem_CSegments_Cons arg_hd_ arg_tl_ = T_CSegments (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_CSegments_v25 v25 = \ (T_CSegments_vIn25 ) -> ( let _hdX23 = Control.Monad.Identity.runIdentity (attach_T_CSegment (arg_hd_)) _tlX26 = Control.Monad.Identity.runIdentity (attach_T_CSegments (arg_tl_)) (T_CSegment_vOut22 ) = inv_CSegment_s23 _hdX23 (T_CSegment_vIn22 ) (T_CSegments_vOut25 ) = inv_CSegments_s26 _tlX26 (T_CSegments_vIn25 ) __result_ = T_CSegments_vOut25 in __result_ ) in C_CSegments_s26 v25 {-# NOINLINE sem_CSegments_Nil #-} sem_CSegments_Nil :: T_CSegments sem_CSegments_Nil = T_CSegments (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_CSegments_v25 v25 = \ (T_CSegments_vIn25 ) -> ( let __result_ = T_CSegments_vOut25 in __result_ ) in C_CSegments_s26 v25 -- CVisit ------------------------------------------------------ -- wrapper data Inh_CVisit = Inh_CVisit { } data Syn_CVisit = Syn_CVisit { } {-# INLINABLE wrap_CVisit #-} wrap_CVisit :: T_CVisit -> Inh_CVisit -> (Syn_CVisit ) wrap_CVisit (T_CVisit act) (Inh_CVisit ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg28 = T_CVisit_vIn28 (T_CVisit_vOut28 ) <- return (inv_CVisit_s29 sem arg28) return (Syn_CVisit ) ) -- cata {-# INLINE sem_CVisit #-} sem_CVisit :: CVisit -> T_CVisit sem_CVisit ( CVisit inh_ syn_ vss_ intra_ ordered_ ) = sem_CVisit_CVisit inh_ syn_ ( sem_Sequence vss_ ) ( sem_Sequence intra_ ) ordered_ -- semantic domain newtype T_CVisit = T_CVisit { attach_T_CVisit :: Identity (T_CVisit_s29 ) } newtype T_CVisit_s29 = C_CVisit_s29 { inv_CVisit_s29 :: (T_CVisit_v28 ) } data T_CVisit_s30 = C_CVisit_s30 type T_CVisit_v28 = (T_CVisit_vIn28 ) -> (T_CVisit_vOut28 ) data T_CVisit_vIn28 = T_CVisit_vIn28 data T_CVisit_vOut28 = T_CVisit_vOut28 {-# NOINLINE sem_CVisit_CVisit #-} sem_CVisit_CVisit :: (Attributes) -> (Attributes) -> T_Sequence -> T_Sequence -> (Bool) -> T_CVisit sem_CVisit_CVisit _ _ arg_vss_ arg_intra_ _ = T_CVisit (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_CVisit_v28 v28 = \ (T_CVisit_vIn28 ) -> ( let _vssX47 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_vss_)) _intraX47 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_intra_)) (T_Sequence_vOut46 ) = inv_Sequence_s47 _vssX47 (T_Sequence_vIn46 ) (T_Sequence_vOut46 ) = inv_Sequence_s47 _intraX47 (T_Sequence_vIn46 ) __result_ = T_CVisit_vOut28 in __result_ ) in C_CVisit_s29 v28 -- CVisits ----------------------------------------------------- -- wrapper data Inh_CVisits = Inh_CVisits { } data Syn_CVisits = Syn_CVisits { } {-# INLINABLE wrap_CVisits #-} wrap_CVisits :: T_CVisits -> Inh_CVisits -> (Syn_CVisits ) wrap_CVisits (T_CVisits act) (Inh_CVisits ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg31 = T_CVisits_vIn31 (T_CVisits_vOut31 ) <- return (inv_CVisits_s32 sem arg31) return (Syn_CVisits ) ) -- cata {-# NOINLINE sem_CVisits #-} sem_CVisits :: CVisits -> T_CVisits sem_CVisits list = Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list) -- semantic domain newtype T_CVisits = T_CVisits { attach_T_CVisits :: Identity (T_CVisits_s32 ) } newtype T_CVisits_s32 = C_CVisits_s32 { inv_CVisits_s32 :: (T_CVisits_v31 ) } data T_CVisits_s33 = C_CVisits_s33 type T_CVisits_v31 = (T_CVisits_vIn31 ) -> (T_CVisits_vOut31 ) data T_CVisits_vIn31 = T_CVisits_vIn31 data T_CVisits_vOut31 = T_CVisits_vOut31 {-# NOINLINE sem_CVisits_Cons #-} sem_CVisits_Cons :: T_CVisit -> T_CVisits -> T_CVisits sem_CVisits_Cons arg_hd_ arg_tl_ = T_CVisits (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_CVisits_v31 v31 = \ (T_CVisits_vIn31 ) -> ( let _hdX29 = Control.Monad.Identity.runIdentity (attach_T_CVisit (arg_hd_)) _tlX32 = Control.Monad.Identity.runIdentity (attach_T_CVisits (arg_tl_)) (T_CVisit_vOut28 ) = inv_CVisit_s29 _hdX29 (T_CVisit_vIn28 ) (T_CVisits_vOut31 ) = inv_CVisits_s32 _tlX32 (T_CVisits_vIn31 ) __result_ = T_CVisits_vOut31 in __result_ ) in C_CVisits_s32 v31 {-# NOINLINE sem_CVisits_Nil #-} sem_CVisits_Nil :: T_CVisits sem_CVisits_Nil = T_CVisits (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_CVisits_v31 v31 = \ (T_CVisits_vIn31 ) -> ( let __result_ = T_CVisits_vOut31 in __result_ ) in C_CVisits_s32 v31 -- DeclBlocks -------------------------------------------------- -- wrapper data Inh_DeclBlocks = Inh_DeclBlocks { } data Syn_DeclBlocks = Syn_DeclBlocks { } {-# INLINABLE wrap_DeclBlocks #-} wrap_DeclBlocks :: T_DeclBlocks -> Inh_DeclBlocks -> (Syn_DeclBlocks ) wrap_DeclBlocks (T_DeclBlocks act) (Inh_DeclBlocks ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg34 = T_DeclBlocks_vIn34 (T_DeclBlocks_vOut34 ) <- return (inv_DeclBlocks_s35 sem arg34) return (Syn_DeclBlocks ) ) -- cata {-# NOINLINE sem_DeclBlocks #-} sem_DeclBlocks :: DeclBlocks -> T_DeclBlocks sem_DeclBlocks ( DeclBlock defs_ visit_ next_ ) = sem_DeclBlocks_DeclBlock defs_ visit_ ( sem_DeclBlocks next_ ) sem_DeclBlocks ( DeclTerminator defs_ result_ ) = sem_DeclBlocks_DeclTerminator defs_ result_ -- semantic domain newtype T_DeclBlocks = T_DeclBlocks { attach_T_DeclBlocks :: Identity (T_DeclBlocks_s35 ) } newtype T_DeclBlocks_s35 = C_DeclBlocks_s35 { inv_DeclBlocks_s35 :: (T_DeclBlocks_v34 ) } data T_DeclBlocks_s36 = C_DeclBlocks_s36 type T_DeclBlocks_v34 = (T_DeclBlocks_vIn34 ) -> (T_DeclBlocks_vOut34 ) data T_DeclBlocks_vIn34 = T_DeclBlocks_vIn34 data T_DeclBlocks_vOut34 = T_DeclBlocks_vOut34 {-# NOINLINE sem_DeclBlocks_DeclBlock #-} sem_DeclBlocks_DeclBlock :: ([Decl]) -> (Decl) -> T_DeclBlocks -> T_DeclBlocks sem_DeclBlocks_DeclBlock _ _ arg_next_ = T_DeclBlocks (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_DeclBlocks_v34 v34 = \ (T_DeclBlocks_vIn34 ) -> ( let _nextX35 = Control.Monad.Identity.runIdentity (attach_T_DeclBlocks (arg_next_)) (T_DeclBlocks_vOut34 ) = inv_DeclBlocks_s35 _nextX35 (T_DeclBlocks_vIn34 ) __result_ = T_DeclBlocks_vOut34 in __result_ ) in C_DeclBlocks_s35 v34 {-# NOINLINE sem_DeclBlocks_DeclTerminator #-} sem_DeclBlocks_DeclTerminator :: ([Decl]) -> (Expr) -> T_DeclBlocks sem_DeclBlocks_DeclTerminator _ _ = T_DeclBlocks (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_DeclBlocks_v34 v34 = \ (T_DeclBlocks_vIn34 ) -> ( let __result_ = T_DeclBlocks_vOut34 in __result_ ) in C_DeclBlocks_s35 v34 -- DeclBlocksRoot ---------------------------------------------- -- wrapper data Inh_DeclBlocksRoot = Inh_DeclBlocksRoot { } data Syn_DeclBlocksRoot = Syn_DeclBlocksRoot { } {-# INLINABLE wrap_DeclBlocksRoot #-} wrap_DeclBlocksRoot :: T_DeclBlocksRoot -> Inh_DeclBlocksRoot -> (Syn_DeclBlocksRoot ) wrap_DeclBlocksRoot (T_DeclBlocksRoot act) (Inh_DeclBlocksRoot ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg37 = T_DeclBlocksRoot_vIn37 (T_DeclBlocksRoot_vOut37 ) <- return (inv_DeclBlocksRoot_s38 sem arg37) return (Syn_DeclBlocksRoot ) ) -- cata {-# INLINE sem_DeclBlocksRoot #-} sem_DeclBlocksRoot :: DeclBlocksRoot -> T_DeclBlocksRoot sem_DeclBlocksRoot ( DeclBlocksRoot blocks_ ) = sem_DeclBlocksRoot_DeclBlocksRoot ( sem_DeclBlocks blocks_ ) -- semantic domain newtype T_DeclBlocksRoot = T_DeclBlocksRoot { attach_T_DeclBlocksRoot :: Identity (T_DeclBlocksRoot_s38 ) } newtype T_DeclBlocksRoot_s38 = C_DeclBlocksRoot_s38 { inv_DeclBlocksRoot_s38 :: (T_DeclBlocksRoot_v37 ) } data T_DeclBlocksRoot_s39 = C_DeclBlocksRoot_s39 type T_DeclBlocksRoot_v37 = (T_DeclBlocksRoot_vIn37 ) -> (T_DeclBlocksRoot_vOut37 ) data T_DeclBlocksRoot_vIn37 = T_DeclBlocksRoot_vIn37 data T_DeclBlocksRoot_vOut37 = T_DeclBlocksRoot_vOut37 {-# NOINLINE sem_DeclBlocksRoot_DeclBlocksRoot #-} sem_DeclBlocksRoot_DeclBlocksRoot :: T_DeclBlocks -> T_DeclBlocksRoot sem_DeclBlocksRoot_DeclBlocksRoot arg_blocks_ = T_DeclBlocksRoot (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_DeclBlocksRoot_v37 v37 = \ (T_DeclBlocksRoot_vIn37 ) -> ( let _blocksX35 = Control.Monad.Identity.runIdentity (attach_T_DeclBlocks (arg_blocks_)) (T_DeclBlocks_vOut34 ) = inv_DeclBlocks_s35 _blocksX35 (T_DeclBlocks_vIn34 ) __result_ = T_DeclBlocksRoot_vOut37 in __result_ ) in C_DeclBlocksRoot_s38 v37 -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { } data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg40 = T_Pattern_vIn40 (T_Pattern_vOut40 _lhsOcopy) <- return (inv_Pattern_s41 sem arg40) return (Syn_Pattern _lhsOcopy) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s41 ) } newtype T_Pattern_s41 = C_Pattern_s41 { inv_Pattern_s41 :: (T_Pattern_v40 ) } data T_Pattern_s42 = C_Pattern_s42 type T_Pattern_v40 = (T_Pattern_vIn40 ) -> (T_Pattern_vOut40 ) data T_Pattern_vIn40 = T_Pattern_vIn40 data T_Pattern_vOut40 = T_Pattern_vOut40 (Pattern) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 ) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIcopy) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 ) _copy = rule1 _patsIcopy arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule2 _copy __result_ = T_Pattern_vOut40 _lhsOcopy in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule1 #-} rule1 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule2 #-} rule2 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 ) -> ( let _patsX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut43 _patsIcopy) = inv_Patterns_s44 _patsX44 (T_Patterns_vIn43 ) _copy = rule3 _patsIcopy arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule4 _copy __result_ = T_Pattern_vOut40 _lhsOcopy in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule3 #-} rule3 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule4 #-} rule4 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 ) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIcopy) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 ) _copy = rule5 _patIcopy arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule6 _copy __result_ = T_Pattern_vOut40 _lhsOcopy in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule5 #-} rule5 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule6 #-} rule6 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 ) -> ( let _patX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut40 _patIcopy) = inv_Pattern_s41 _patX41 (T_Pattern_vIn40 ) _copy = rule7 _patIcopy _lhsOcopy :: Pattern _lhsOcopy = rule8 _copy __result_ = T_Pattern_vOut40 _lhsOcopy in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule7 #-} rule7 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule8 #-} rule8 = \ _copy -> _copy {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore arg_pos_ = T_Pattern (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Pattern_v40 v40 = \ (T_Pattern_vIn40 ) -> ( let _copy = rule9 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule10 _copy __result_ = T_Pattern_vOut40 _lhsOcopy in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule9 #-} rule9 = \ pos_ -> Underscore pos_ {-# INLINE rule10 #-} rule10 = \ _copy -> _copy -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { } data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg43 = T_Patterns_vIn43 (T_Patterns_vOut43 _lhsOcopy) <- return (inv_Patterns_s44 sem arg43) return (Syn_Patterns _lhsOcopy) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s44 ) } newtype T_Patterns_s44 = C_Patterns_s44 { inv_Patterns_s44 :: (T_Patterns_v43 ) } data T_Patterns_s45 = C_Patterns_s45 type T_Patterns_v43 = (T_Patterns_vIn43 ) -> (T_Patterns_vOut43 ) data T_Patterns_vIn43 = T_Patterns_vIn43 data T_Patterns_vOut43 = T_Patterns_vOut43 (Patterns) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_Patterns_v43 v43 = \ (T_Patterns_vIn43 ) -> ( let _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut40 _hdIcopy) = inv_Pattern_s41 _hdX41 (T_Pattern_vIn40 ) (T_Patterns_vOut43 _tlIcopy) = inv_Patterns_s44 _tlX44 (T_Patterns_vIn43 ) _copy = rule11 _hdIcopy _tlIcopy _lhsOcopy :: Patterns _lhsOcopy = rule12 _copy __result_ = T_Patterns_vOut43 _lhsOcopy in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule11 #-} rule11 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule12 #-} rule12 = \ _copy -> _copy {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_Patterns_v43 v43 = \ (T_Patterns_vIn43 ) -> ( let _copy = rule13 () _lhsOcopy :: Patterns _lhsOcopy = rule14 _copy __result_ = T_Patterns_vOut43 _lhsOcopy in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule13 #-} rule13 = \ (_ :: ()) -> [] {-# INLINE rule14 #-} rule14 = \ _copy -> _copy -- Sequence ---------------------------------------------------- -- wrapper data Inh_Sequence = Inh_Sequence { } data Syn_Sequence = Syn_Sequence { } {-# INLINABLE wrap_Sequence #-} wrap_Sequence :: T_Sequence -> Inh_Sequence -> (Syn_Sequence ) wrap_Sequence (T_Sequence act) (Inh_Sequence ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg46 = T_Sequence_vIn46 (T_Sequence_vOut46 ) <- return (inv_Sequence_s47 sem arg46) return (Syn_Sequence ) ) -- cata {-# NOINLINE sem_Sequence #-} sem_Sequence :: Sequence -> T_Sequence sem_Sequence list = Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list) -- semantic domain newtype T_Sequence = T_Sequence { attach_T_Sequence :: Identity (T_Sequence_s47 ) } newtype T_Sequence_s47 = C_Sequence_s47 { inv_Sequence_s47 :: (T_Sequence_v46 ) } data T_Sequence_s48 = C_Sequence_s48 type T_Sequence_v46 = (T_Sequence_vIn46 ) -> (T_Sequence_vOut46 ) data T_Sequence_vIn46 = T_Sequence_vIn46 data T_Sequence_vOut46 = T_Sequence_vOut46 {-# NOINLINE sem_Sequence_Cons #-} sem_Sequence_Cons :: T_CRule -> T_Sequence -> T_Sequence sem_Sequence_Cons arg_hd_ arg_tl_ = T_Sequence (return st47) where {-# NOINLINE st47 #-} st47 = let v46 :: T_Sequence_v46 v46 = \ (T_Sequence_vIn46 ) -> ( let _hdX20 = Control.Monad.Identity.runIdentity (attach_T_CRule (arg_hd_)) _tlX47 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_tl_)) (T_CRule_vOut19 ) = inv_CRule_s20 _hdX20 (T_CRule_vIn19 ) (T_Sequence_vOut46 ) = inv_Sequence_s47 _tlX47 (T_Sequence_vIn46 ) __result_ = T_Sequence_vOut46 in __result_ ) in C_Sequence_s47 v46 {-# NOINLINE sem_Sequence_Nil #-} sem_Sequence_Nil :: T_Sequence sem_Sequence_Nil = T_Sequence (return st47) where {-# NOINLINE st47 #-} st47 = let v46 :: T_Sequence_v46 v46 = \ (T_Sequence_vIn46 ) -> ( let __result_ = T_Sequence_vOut46 in __result_ ) in C_Sequence_s47 v46 uuagc-0.9.52.2/src-generated/TfmToVisage.hs0000644000000000000000000016520613433540502016521 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module TfmToVisage where {-# LINE 2 "src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken {-# LINE 10 "dist/build/TfmToVisage.hs" #-} {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 17 "dist/build/TfmToVisage.hs" #-} {-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) import Data.Map(Map) import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import Macro --marcos import CommonTypes import ErrorMessages {-# LINE 29 "dist/build/TfmToVisage.hs" #-} {-# LINE 9 "src-ag/TfmToVisage.ag" #-} import AbstractSyntax import VisagePatterns import VisageSyntax import qualified Data.Map as Map import Data.Map (Map) {-# LINE 38 "dist/build/TfmToVisage.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 17 "src-ag/TfmToVisage.ag" #-} -- Maps a rule to a pair -- Later, I expect to map to a list of rules, because we might need to unfold. -- Checks that a certain alias is in fact a Var in the old representation of the AG system isVar (Alias _ _ (Underscore _)) = True isVar _ = False type VisageRuleMap = [(String, VisageRule)] splitVRules :: [VisageRule] -> VisageRuleMap splitVRules vrs = concat (map unfoldvrs vrs) unfoldvrs :: VisageRule -> VisageRuleMap unfoldvrs vr@(VRule attrfields _ _ _ _) = zip (map (getName . fst) attrfields) (map (copyRule vr) attrfields) copyRule :: VisageRule -> (Identifier,Identifier) -> VisageRule copyRule (VRule attrfields _ pat expr owrt) (field,attr) = VRule attrfields attr pat expr owrt getForField :: String -> VisageRuleMap -> [VisageRule] getForField field xs = map snd (filter ((field ==) . fst) xs) {- Delivers a map from fieldname to VisageRule with all references to others underscored. So, (lhs.x, rt.y, loc.z) = (0,1,2) becomes something like [("lhs", (lhs.x,_,_) = (0,1,2) At this point, we do not use this anymore. allways :: VisageRule -> VisageRuleMap allways vr@(VRule vrfields _ _ _ _) = zip vrfields (map (underScoreRule vr) (nub vrfields)) splitVRules :: [VisageRule] -> VisageRuleMap splitVRules vrs = concat (map allways vrs) underScoreRule :: VisageRule -> String -> VisageRule underScoreRule (VRule fields pat expr owrt rule) s = VRule fields (underScore s pat) expr owrt rule underScore :: String -> VisagePattern -> VisagePattern underScore field (VConstr name pats) = VConstr name (map (underScore field) pats) underScore field (VProduct pos pats) = VProduct pos (map (underScore field) pats) underScore field vp@(VVar vfield attr) = if (field == getName vfield) then vp else (VUnderscore (getPos vfield)) -- Should I recurse into the pat of VAlias? underScore field vp@(VAlias afield attr pat) = if (field == getName afield) then vp else (VUnderscore (getPos afield)) underScore field vp@(VUnderscore pos) = vp -} {-# LINE 96 "dist/build/TfmToVisage.hs" #-} -- Child ------------------------------------------------------- -- wrapper data Inh_Child = Inh_Child { inhMap_Inh_Child :: (Map Identifier Attributes), rulemap_Inh_Child :: (VisageRuleMap), synMap_Inh_Child :: (Map Identifier Attributes) } data Syn_Child = Syn_Child { vchild_Syn_Child :: (VisageChild) } {-# INLINABLE wrap_Child #-} wrap_Child :: T_Child -> Inh_Child -> (Syn_Child ) wrap_Child (T_Child act) (Inh_Child _lhsIinhMap _lhsIrulemap _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_Child_vIn1 _lhsIinhMap _lhsIrulemap _lhsIsynMap (T_Child_vOut1 _lhsOvchild) <- return (inv_Child_s2 sem arg1) return (Syn_Child _lhsOvchild) ) -- cata {-# INLINE sem_Child #-} sem_Child :: Child -> T_Child sem_Child ( Child name_ tp_ kind_ ) = sem_Child_Child name_ tp_ kind_ -- semantic domain newtype T_Child = T_Child { attach_T_Child :: Identity (T_Child_s2 ) } newtype T_Child_s2 = C_Child_s2 { inv_Child_s2 :: (T_Child_v1 ) } data T_Child_s3 = C_Child_s3 type T_Child_v1 = (T_Child_vIn1 ) -> (T_Child_vOut1 ) data T_Child_vIn1 = T_Child_vIn1 (Map Identifier Attributes) (VisageRuleMap) (Map Identifier Attributes) data T_Child_vOut1 = T_Child_vOut1 (VisageChild) {-# NOINLINE sem_Child_Child #-} sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child sem_Child_Child arg_name_ arg_tp_ _ = T_Child (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_Child_v1 v1 = \ (T_Child_vIn1 _lhsIinhMap _lhsIrulemap _lhsIsynMap) -> ( let _chnt = rule0 arg_name_ arg_tp_ _inh = rule1 _chnt _lhsIinhMap _syn = rule2 _chnt _lhsIsynMap _lhsOvchild :: VisageChild _lhsOvchild = rule3 _inh _lhsIrulemap _syn arg_name_ arg_tp_ __result_ = T_Child_vOut1 _lhsOvchild in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} {-# LINE 19 "src-ag/DistChildAttr.ag" #-} rule0 = \ name_ tp_ -> {-# LINE 19 "src-ag/DistChildAttr.ag" #-} case tp_ of NT nt _ _ -> nt Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") Haskell t -> identifier "" {-# LINE 150 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule1 #-} {-# LINE 23 "src-ag/DistChildAttr.ag" #-} rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> {-# LINE 23 "src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIinhMap {-# LINE 156 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule2 #-} {-# LINE 24 "src-ag/DistChildAttr.ag" #-} rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> {-# LINE 24 "src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIsynMap {-# LINE 162 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule3 #-} {-# LINE 121 "src-ag/TfmToVisage.ag" #-} rule3 = \ _inh ((_lhsIrulemap) :: VisageRuleMap) _syn name_ tp_ -> {-# LINE 121 "src-ag/TfmToVisage.ag" #-} VChild name_ tp_ _inh _syn (getForField (getName name_) _lhsIrulemap) {-# LINE 168 "dist/build/TfmToVisage.hs"#-} -- Children ---------------------------------------------------- -- wrapper data Inh_Children = Inh_Children { inhMap_Inh_Children :: (Map Identifier Attributes), rulemap_Inh_Children :: (VisageRuleMap), synMap_Inh_Children :: (Map Identifier Attributes) } data Syn_Children = Syn_Children { vchildren_Syn_Children :: ([VisageChild]) } {-# INLINABLE wrap_Children #-} wrap_Children :: T_Children -> Inh_Children -> (Syn_Children ) wrap_Children (T_Children act) (Inh_Children _lhsIinhMap _lhsIrulemap _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_Children_vIn4 _lhsIinhMap _lhsIrulemap _lhsIsynMap (T_Children_vOut4 _lhsOvchildren) <- return (inv_Children_s5 sem arg4) return (Syn_Children _lhsOvchildren) ) -- cata {-# NOINLINE sem_Children #-} sem_Children :: Children -> T_Children sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) -- semantic domain newtype T_Children = T_Children { attach_T_Children :: Identity (T_Children_s5 ) } newtype T_Children_s5 = C_Children_s5 { inv_Children_s5 :: (T_Children_v4 ) } data T_Children_s6 = C_Children_s6 type T_Children_v4 = (T_Children_vIn4 ) -> (T_Children_vOut4 ) data T_Children_vIn4 = T_Children_vIn4 (Map Identifier Attributes) (VisageRuleMap) (Map Identifier Attributes) data T_Children_vOut4 = T_Children_vOut4 ([VisageChild]) {-# NOINLINE sem_Children_Cons #-} sem_Children_Cons :: T_Child -> T_Children -> T_Children sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_Children_v4 v4 = \ (T_Children_vIn4 _lhsIinhMap _lhsIrulemap _lhsIsynMap) -> ( let _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) (T_Child_vOut1 _hdIvchild) = inv_Child_s2 _hdX2 (T_Child_vIn1 _hdOinhMap _hdOrulemap _hdOsynMap) (T_Children_vOut4 _tlIvchildren) = inv_Children_s5 _tlX5 (T_Children_vIn4 _tlOinhMap _tlOrulemap _tlOsynMap) _lhsOvchildren :: [VisageChild] _lhsOvchildren = rule4 _hdIvchild _tlIvchildren _hdOinhMap = rule5 _lhsIinhMap _hdOrulemap = rule6 _lhsIrulemap _hdOsynMap = rule7 _lhsIsynMap _tlOinhMap = rule8 _lhsIinhMap _tlOrulemap = rule9 _lhsIrulemap _tlOsynMap = rule10 _lhsIsynMap __result_ = T_Children_vOut4 _lhsOvchildren in __result_ ) in C_Children_s5 v4 {-# INLINE rule4 #-} {-# LINE 117 "src-ag/TfmToVisage.ag" #-} rule4 = \ ((_hdIvchild) :: VisageChild) ((_tlIvchildren) :: [VisageChild]) -> {-# LINE 117 "src-ag/TfmToVisage.ag" #-} _hdIvchild : _tlIvchildren {-# LINE 227 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule5 #-} rule5 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule6 #-} rule6 = \ ((_lhsIrulemap) :: VisageRuleMap) -> _lhsIrulemap {-# INLINE rule7 #-} rule7 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule8 #-} rule8 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule9 #-} rule9 = \ ((_lhsIrulemap) :: VisageRuleMap) -> _lhsIrulemap {-# INLINE rule10 #-} rule10 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE sem_Children_Nil #-} sem_Children_Nil :: T_Children sem_Children_Nil = T_Children (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_Children_v4 v4 = \ (T_Children_vIn4 _lhsIinhMap _lhsIrulemap _lhsIsynMap) -> ( let _lhsOvchildren :: [VisageChild] _lhsOvchildren = rule11 () __result_ = T_Children_vOut4 _lhsOvchildren in __result_ ) in C_Children_s5 v4 {-# INLINE rule11 #-} {-# LINE 118 "src-ag/TfmToVisage.ag" #-} rule11 = \ (_ :: ()) -> {-# LINE 118 "src-ag/TfmToVisage.ag" #-} [] {-# LINE 263 "dist/build/TfmToVisage.hs"#-} -- Expression -------------------------------------------------- -- wrapper data Inh_Expression = Inh_Expression { } data Syn_Expression = Syn_Expression { self_Syn_Expression :: (Expression) } {-# INLINABLE wrap_Expression #-} wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) wrap_Expression (T_Expression act) (Inh_Expression ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_Expression_vIn7 (T_Expression_vOut7 _lhsOself) <- return (inv_Expression_s8 sem arg7) return (Syn_Expression _lhsOself) ) -- cata {-# INLINE sem_Expression #-} sem_Expression :: Expression -> T_Expression sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_ -- semantic domain newtype T_Expression = T_Expression { attach_T_Expression :: Identity (T_Expression_s8 ) } newtype T_Expression_s8 = C_Expression_s8 { inv_Expression_s8 :: (T_Expression_v7 ) } data T_Expression_s9 = C_Expression_s9 type T_Expression_v7 = (T_Expression_vIn7 ) -> (T_Expression_vOut7 ) data T_Expression_vIn7 = T_Expression_vIn7 data T_Expression_vOut7 = T_Expression_vOut7 (Expression) {-# NOINLINE sem_Expression_Expression #-} sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression sem_Expression_Expression arg_pos_ arg_tks_ = T_Expression (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_Expression_v7 v7 = \ (T_Expression_vIn7 ) -> ( let _self = rule12 arg_pos_ arg_tks_ _lhsOself :: Expression _lhsOself = rule13 _self __result_ = T_Expression_vOut7 _lhsOself in __result_ ) in C_Expression_s8 v7 {-# INLINE rule12 #-} rule12 = \ pos_ tks_ -> Expression pos_ tks_ {-# INLINE rule13 #-} rule13 = \ _self -> _self -- Grammar ----------------------------------------------------- -- wrapper data Inh_Grammar = Inh_Grammar { } data Syn_Grammar = Syn_Grammar { visage_Syn_Grammar :: (VisageGrammar) } {-# INLINABLE wrap_Grammar #-} wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar ) wrap_Grammar (T_Grammar act) (Inh_Grammar ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg10 = T_Grammar_vIn10 (T_Grammar_vOut10 _lhsOvisage) <- return (inv_Grammar_s11 sem arg10) return (Syn_Grammar _lhsOvisage) ) -- cata {-# INLINE sem_Grammar #-} sem_Grammar :: Grammar -> T_Grammar sem_Grammar ( Grammar typeSyns_ useMap_ derivings_ wrappers_ nonts_ pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ -- semantic domain newtype T_Grammar = T_Grammar { attach_T_Grammar :: Identity (T_Grammar_s11 ) } newtype T_Grammar_s11 = C_Grammar_s11 { inv_Grammar_s11 :: (T_Grammar_v10 ) } data T_Grammar_s12 = C_Grammar_s12 type T_Grammar_v10 = (T_Grammar_vIn10 ) -> (T_Grammar_vOut10 ) data T_Grammar_vIn10 = T_Grammar_vIn10 data T_Grammar_vOut10 = T_Grammar_vOut10 (VisageGrammar) {-# NOINLINE sem_Grammar_Grammar #-} sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar sem_Grammar_Grammar _ _ _ _ arg_nonts_ _ _ _ _ _ _ _ _ _ = T_Grammar (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_Grammar_v10 v10 = \ (T_Grammar_vIn10 ) -> ( let _nontsX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) (T_Nonterminals_vOut16 _nontsIinhMap' _nontsIsynMap' _nontsIvnonts) = inv_Nonterminals_s17 _nontsX17 (T_Nonterminals_vIn16 _nontsOinhMap _nontsOsynMap) _nontsOinhMap = rule14 _nontsIinhMap' _nontsOsynMap = rule15 _nontsIsynMap' _lhsOvisage :: VisageGrammar _lhsOvisage = rule16 _nontsIvnonts __result_ = T_Grammar_vOut10 _lhsOvisage in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule14 #-} {-# LINE 15 "src-ag/DistChildAttr.ag" #-} rule14 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> {-# LINE 15 "src-ag/DistChildAttr.ag" #-} _nontsIinhMap' {-# LINE 366 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule15 #-} {-# LINE 16 "src-ag/DistChildAttr.ag" #-} rule15 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> {-# LINE 16 "src-ag/DistChildAttr.ag" #-} _nontsIsynMap' {-# LINE 372 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule16 #-} {-# LINE 90 "src-ag/TfmToVisage.ag" #-} rule16 = \ ((_nontsIvnonts) :: [VisageNonterminal]) -> {-# LINE 90 "src-ag/TfmToVisage.ag" #-} VGrammar _nontsIvnonts {-# LINE 378 "dist/build/TfmToVisage.hs"#-} -- Nonterminal ------------------------------------------------- -- wrapper data Inh_Nonterminal = Inh_Nonterminal { inhMap_Inh_Nonterminal :: (Map Identifier Attributes), synMap_Inh_Nonterminal :: (Map Identifier Attributes) } data Syn_Nonterminal = Syn_Nonterminal { inhMap'_Syn_Nonterminal :: (Map Identifier Attributes), synMap'_Syn_Nonterminal :: (Map Identifier Attributes), vnont_Syn_Nonterminal :: (VisageNonterminal) } {-# INLINABLE wrap_Nonterminal #-} wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal ) wrap_Nonterminal (T_Nonterminal act) (Inh_Nonterminal _lhsIinhMap _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg13 = T_Nonterminal_vIn13 _lhsIinhMap _lhsIsynMap (T_Nonterminal_vOut13 _lhsOinhMap' _lhsOsynMap' _lhsOvnont) <- return (inv_Nonterminal_s14 sem arg13) return (Syn_Nonterminal _lhsOinhMap' _lhsOsynMap' _lhsOvnont) ) -- cata {-# INLINE sem_Nonterminal #-} sem_Nonterminal :: Nonterminal -> T_Nonterminal sem_Nonterminal ( Nonterminal nt_ params_ inh_ syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ ) -- semantic domain newtype T_Nonterminal = T_Nonterminal { attach_T_Nonterminal :: Identity (T_Nonterminal_s14 ) } newtype T_Nonterminal_s14 = C_Nonterminal_s14 { inv_Nonterminal_s14 :: (T_Nonterminal_v13 ) } data T_Nonterminal_s15 = C_Nonterminal_s15 type T_Nonterminal_v13 = (T_Nonterminal_vIn13 ) -> (T_Nonterminal_vOut13 ) data T_Nonterminal_vIn13 = T_Nonterminal_vIn13 (Map Identifier Attributes) (Map Identifier Attributes) data T_Nonterminal_vOut13 = T_Nonterminal_vOut13 (Map Identifier Attributes) (Map Identifier Attributes) (VisageNonterminal) {-# NOINLINE sem_Nonterminal_Nonterminal #-} sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal sem_Nonterminal_Nonterminal arg_nt_ _ arg_inh_ arg_syn_ arg_prods_ = T_Nonterminal (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_Nonterminal_v13 v13 = \ (T_Nonterminal_vIn13 _lhsIinhMap _lhsIsynMap) -> ( let _prodsX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) (T_Productions_vOut28 _prodsIvprods) = inv_Productions_s29 _prodsX29 (T_Productions_vIn28 _prodsOinhMap _prodsOsynMap) _lhsOinhMap' :: Map Identifier Attributes _lhsOinhMap' = rule17 arg_inh_ arg_nt_ _lhsOsynMap' :: Map Identifier Attributes _lhsOsynMap' = rule18 arg_nt_ arg_syn_ _lhsOvnont :: VisageNonterminal _lhsOvnont = rule19 _prodsIvprods arg_inh_ arg_nt_ arg_syn_ _prodsOinhMap = rule20 _lhsIinhMap _prodsOsynMap = rule21 _lhsIsynMap __result_ = T_Nonterminal_vOut13 _lhsOinhMap' _lhsOsynMap' _lhsOvnont in __result_ ) in C_Nonterminal_s14 v13 {-# INLINE rule17 #-} {-# LINE 7 "src-ag/DistChildAttr.ag" #-} rule17 = \ inh_ nt_ -> {-# LINE 7 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ inh_ {-# LINE 435 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule18 #-} {-# LINE 8 "src-ag/DistChildAttr.ag" #-} rule18 = \ nt_ syn_ -> {-# LINE 8 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ syn_ {-# LINE 441 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule19 #-} {-# LINE 100 "src-ag/TfmToVisage.ag" #-} rule19 = \ ((_prodsIvprods) :: [VisageProduction]) inh_ nt_ syn_ -> {-# LINE 100 "src-ag/TfmToVisage.ag" #-} VNonterminal nt_ inh_ syn_ _prodsIvprods {-# LINE 447 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule20 #-} rule20 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule21 #-} rule21 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap -- Nonterminals ------------------------------------------------ -- wrapper data Inh_Nonterminals = Inh_Nonterminals { inhMap_Inh_Nonterminals :: (Map Identifier Attributes), synMap_Inh_Nonterminals :: (Map Identifier Attributes) } data Syn_Nonterminals = Syn_Nonterminals { inhMap'_Syn_Nonterminals :: (Map Identifier Attributes), synMap'_Syn_Nonterminals :: (Map Identifier Attributes), vnonts_Syn_Nonterminals :: ([VisageNonterminal]) } {-# INLINABLE wrap_Nonterminals #-} wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals ) wrap_Nonterminals (T_Nonterminals act) (Inh_Nonterminals _lhsIinhMap _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg16 = T_Nonterminals_vIn16 _lhsIinhMap _lhsIsynMap (T_Nonterminals_vOut16 _lhsOinhMap' _lhsOsynMap' _lhsOvnonts) <- return (inv_Nonterminals_s17 sem arg16) return (Syn_Nonterminals _lhsOinhMap' _lhsOsynMap' _lhsOvnonts) ) -- cata {-# NOINLINE sem_Nonterminals #-} sem_Nonterminals :: Nonterminals -> T_Nonterminals sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) -- semantic domain newtype T_Nonterminals = T_Nonterminals { attach_T_Nonterminals :: Identity (T_Nonterminals_s17 ) } newtype T_Nonterminals_s17 = C_Nonterminals_s17 { inv_Nonterminals_s17 :: (T_Nonterminals_v16 ) } data T_Nonterminals_s18 = C_Nonterminals_s18 type T_Nonterminals_v16 = (T_Nonterminals_vIn16 ) -> (T_Nonterminals_vOut16 ) data T_Nonterminals_vIn16 = T_Nonterminals_vIn16 (Map Identifier Attributes) (Map Identifier Attributes) data T_Nonterminals_vOut16 = T_Nonterminals_vOut16 (Map Identifier Attributes) (Map Identifier Attributes) ([VisageNonterminal]) {-# NOINLINE sem_Nonterminals_Cons #-} sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Nonterminals_v16 v16 = \ (T_Nonterminals_vIn16 _lhsIinhMap _lhsIsynMap) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) (T_Nonterminal_vOut13 _hdIinhMap' _hdIsynMap' _hdIvnont) = inv_Nonterminal_s14 _hdX14 (T_Nonterminal_vIn13 _hdOinhMap _hdOsynMap) (T_Nonterminals_vOut16 _tlIinhMap' _tlIsynMap' _tlIvnonts) = inv_Nonterminals_s17 _tlX17 (T_Nonterminals_vIn16 _tlOinhMap _tlOsynMap) _lhsOvnonts :: [VisageNonterminal] _lhsOvnonts = rule22 _hdIvnont _tlIvnonts _lhsOinhMap' :: Map Identifier Attributes _lhsOinhMap' = rule23 _hdIinhMap' _tlIinhMap' _lhsOsynMap' :: Map Identifier Attributes _lhsOsynMap' = rule24 _hdIsynMap' _tlIsynMap' _hdOinhMap = rule25 _lhsIinhMap _hdOsynMap = rule26 _lhsIsynMap _tlOinhMap = rule27 _lhsIinhMap _tlOsynMap = rule28 _lhsIsynMap __result_ = T_Nonterminals_vOut16 _lhsOinhMap' _lhsOsynMap' _lhsOvnonts in __result_ ) in C_Nonterminals_s17 v16 {-# INLINE rule22 #-} {-# LINE 94 "src-ag/TfmToVisage.ag" #-} rule22 = \ ((_hdIvnont) :: VisageNonterminal) ((_tlIvnonts) :: [VisageNonterminal]) -> {-# LINE 94 "src-ag/TfmToVisage.ag" #-} _hdIvnont : _tlIvnonts {-# LINE 514 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule23 #-} rule23 = \ ((_hdIinhMap') :: Map Identifier Attributes) ((_tlIinhMap') :: Map Identifier Attributes) -> _hdIinhMap' `Map.union` _tlIinhMap' {-# INLINE rule24 #-} rule24 = \ ((_hdIsynMap') :: Map Identifier Attributes) ((_tlIsynMap') :: Map Identifier Attributes) -> _hdIsynMap' `Map.union` _tlIsynMap' {-# INLINE rule25 #-} rule25 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule26 #-} rule26 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule27 #-} rule27 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule28 #-} rule28 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE sem_Nonterminals_Nil #-} sem_Nonterminals_Nil :: T_Nonterminals sem_Nonterminals_Nil = T_Nonterminals (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_Nonterminals_v16 v16 = \ (T_Nonterminals_vIn16 _lhsIinhMap _lhsIsynMap) -> ( let _lhsOvnonts :: [VisageNonterminal] _lhsOvnonts = rule29 () _lhsOinhMap' :: Map Identifier Attributes _lhsOinhMap' = rule30 () _lhsOsynMap' :: Map Identifier Attributes _lhsOsynMap' = rule31 () __result_ = T_Nonterminals_vOut16 _lhsOinhMap' _lhsOsynMap' _lhsOvnonts in __result_ ) in C_Nonterminals_s17 v16 {-# INLINE rule29 #-} {-# LINE 96 "src-ag/TfmToVisage.ag" #-} rule29 = \ (_ :: ()) -> {-# LINE 96 "src-ag/TfmToVisage.ag" #-} [] {-# LINE 554 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule30 #-} rule30 = \ (_ :: ()) -> Map.empty {-# INLINE rule31 #-} rule31 = \ (_ :: ()) -> Map.empty -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { } data Syn_Pattern = Syn_Pattern { copy_Syn_Pattern :: (Pattern), fieldattrs_Syn_Pattern :: ( [(Identifier,Identifier)] ), self_Syn_Pattern :: (Pattern), vpat_Syn_Pattern :: (VisagePattern) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg19 = T_Pattern_vIn19 (T_Pattern_vOut19 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat) <- return (inv_Pattern_s20 sem arg19) return (Syn_Pattern _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s20 ) } newtype T_Pattern_s20 = C_Pattern_s20 { inv_Pattern_s20 :: (T_Pattern_v19 ) } data T_Pattern_s21 = C_Pattern_s21 type T_Pattern_v19 = (T_Pattern_vIn19 ) -> (T_Pattern_vOut19 ) data T_Pattern_vIn19 = T_Pattern_vIn19 data T_Pattern_vOut19 = T_Pattern_vOut19 (Pattern) ( [(Identifier,Identifier)] ) (Pattern) (VisagePattern) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 ) -> ( let _patsX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut22 _patsIcopy _patsIfieldattrs _patsIself _patsIvpats) = inv_Patterns_s23 _patsX23 (T_Patterns_vIn22 ) _lhsOvpat :: VisagePattern _lhsOvpat = rule32 _patsIvpats arg_name_ _lhsOfieldattrs :: [(Identifier,Identifier)] _lhsOfieldattrs = rule33 _patsIfieldattrs _copy = rule34 _patsIcopy arg_name_ _self = rule35 _patsIself arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule36 _copy _lhsOself :: Pattern _lhsOself = rule37 _self __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule32 #-} {-# LINE 136 "src-ag/TfmToVisage.ag" #-} rule32 = \ ((_patsIvpats) :: [VisagePattern]) name_ -> {-# LINE 136 "src-ag/TfmToVisage.ag" #-} VConstr name_ _patsIvpats {-# LINE 623 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule33 #-} rule33 = \ ((_patsIfieldattrs) :: [(Identifier,Identifier)] ) -> _patsIfieldattrs {-# INLINE rule34 #-} rule34 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule35 #-} rule35 = \ ((_patsIself) :: Patterns) name_ -> Constr name_ _patsIself {-# INLINE rule36 #-} rule36 = \ _copy -> _copy {-# INLINE rule37 #-} rule37 = \ _self -> _self {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 ) -> ( let _patsX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut22 _patsIcopy _patsIfieldattrs _patsIself _patsIvpats) = inv_Patterns_s23 _patsX23 (T_Patterns_vIn22 ) _lhsOvpat :: VisagePattern _lhsOvpat = rule38 _patsIvpats arg_pos_ _lhsOfieldattrs :: [(Identifier,Identifier)] _lhsOfieldattrs = rule39 _patsIfieldattrs _copy = rule40 _patsIcopy arg_pos_ _self = rule41 _patsIself arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule42 _copy _lhsOself :: Pattern _lhsOself = rule43 _self __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule38 #-} {-# LINE 137 "src-ag/TfmToVisage.ag" #-} rule38 = \ ((_patsIvpats) :: [VisagePattern]) pos_ -> {-# LINE 137 "src-ag/TfmToVisage.ag" #-} VProduct pos_ _patsIvpats {-# LINE 666 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule39 #-} rule39 = \ ((_patsIfieldattrs) :: [(Identifier,Identifier)] ) -> _patsIfieldattrs {-# INLINE rule40 #-} rule40 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule41 #-} rule41 = \ ((_patsIself) :: Patterns) pos_ -> Product pos_ _patsIself {-# INLINE rule42 #-} rule42 = \ _copy -> _copy {-# INLINE rule43 #-} rule43 = \ _self -> _self {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 ) -> ( let _patX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut19 _patIcopy _patIfieldattrs _patIself _patIvpat) = inv_Pattern_s20 _patX20 (T_Pattern_vIn19 ) _lhsOvpat :: VisagePattern _lhsOvpat = rule44 _patIvpat _self arg_attr_ arg_field_ _lhsOfieldattrs :: [(Identifier,Identifier)] _lhsOfieldattrs = rule45 arg_attr_ arg_field_ _copy = rule46 _patIcopy arg_attr_ arg_field_ _self = rule47 _patIself arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule48 _copy _lhsOself :: Pattern _lhsOself = rule49 _self __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule44 #-} {-# LINE 138 "src-ag/TfmToVisage.ag" #-} rule44 = \ ((_patIvpat) :: VisagePattern) _self attr_ field_ -> {-# LINE 138 "src-ag/TfmToVisage.ag" #-} if (isVar _self) then VVar field_ attr_ else VAlias field_ attr_ _patIvpat {-# LINE 711 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule45 #-} {-# LINE 147 "src-ag/TfmToVisage.ag" #-} rule45 = \ attr_ field_ -> {-# LINE 147 "src-ag/TfmToVisage.ag" #-} [(field_, attr_)] {-# LINE 717 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule46 #-} rule46 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule47 #-} rule47 = \ ((_patIself) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIself {-# INLINE rule48 #-} rule48 = \ _copy -> _copy {-# INLINE rule49 #-} rule49 = \ _self -> _self {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 ) -> ( let _patX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut19 _patIcopy _patIfieldattrs _patIself _patIvpat) = inv_Pattern_s20 _patX20 (T_Pattern_vIn19 ) _lhsOfieldattrs :: [(Identifier,Identifier)] _lhsOfieldattrs = rule50 _patIfieldattrs _copy = rule51 _patIcopy _self = rule52 _patIself _lhsOcopy :: Pattern _lhsOcopy = rule53 _copy _lhsOself :: Pattern _lhsOself = rule54 _self _lhsOvpat :: VisagePattern _lhsOvpat = rule55 _patIvpat __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule50 #-} rule50 = \ ((_patIfieldattrs) :: [(Identifier,Identifier)] ) -> _patIfieldattrs {-# INLINE rule51 #-} rule51 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule52 #-} rule52 = \ ((_patIself) :: Pattern) -> Irrefutable _patIself {-# INLINE rule53 #-} rule53 = \ _copy -> _copy {-# INLINE rule54 #-} rule54 = \ _self -> _self {-# INLINE rule55 #-} rule55 = \ ((_patIvpat) :: VisagePattern) -> _patIvpat {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore arg_pos_ = T_Pattern (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_Pattern_v19 v19 = \ (T_Pattern_vIn19 ) -> ( let _lhsOvpat :: VisagePattern _lhsOvpat = rule56 arg_pos_ _lhsOfieldattrs :: [(Identifier,Identifier)] _lhsOfieldattrs = rule57 () _copy = rule58 arg_pos_ _self = rule59 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule60 _copy _lhsOself :: Pattern _lhsOself = rule61 _self __result_ = T_Pattern_vOut19 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule56 #-} {-# LINE 141 "src-ag/TfmToVisage.ag" #-} rule56 = \ pos_ -> {-# LINE 141 "src-ag/TfmToVisage.ag" #-} VUnderscore pos_ {-# LINE 795 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule57 #-} rule57 = \ (_ :: ()) -> [] {-# INLINE rule58 #-} rule58 = \ pos_ -> Underscore pos_ {-# INLINE rule59 #-} rule59 = \ pos_ -> Underscore pos_ {-# INLINE rule60 #-} rule60 = \ _copy -> _copy {-# INLINE rule61 #-} rule61 = \ _self -> _self -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { } data Syn_Patterns = Syn_Patterns { copy_Syn_Patterns :: (Patterns), fieldattrs_Syn_Patterns :: ( [(Identifier,Identifier)] ), self_Syn_Patterns :: (Patterns), vpats_Syn_Patterns :: ([VisagePattern]) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg22 = T_Patterns_vIn22 (T_Patterns_vOut22 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpats) <- return (inv_Patterns_s23 sem arg22) return (Syn_Patterns _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpats) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s23 ) } newtype T_Patterns_s23 = C_Patterns_s23 { inv_Patterns_s23 :: (T_Patterns_v22 ) } data T_Patterns_s24 = C_Patterns_s24 type T_Patterns_v22 = (T_Patterns_vIn22 ) -> (T_Patterns_vOut22 ) data T_Patterns_vIn22 = T_Patterns_vIn22 data T_Patterns_vOut22 = T_Patterns_vOut22 (Patterns) ( [(Identifier,Identifier)] ) (Patterns) ([VisagePattern]) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_Patterns_v22 v22 = \ (T_Patterns_vIn22 ) -> ( let _hdX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX23 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut19 _hdIcopy _hdIfieldattrs _hdIself _hdIvpat) = inv_Pattern_s20 _hdX20 (T_Pattern_vIn19 ) (T_Patterns_vOut22 _tlIcopy _tlIfieldattrs _tlIself _tlIvpats) = inv_Patterns_s23 _tlX23 (T_Patterns_vIn22 ) _lhsOvpats :: [VisagePattern] _lhsOvpats = rule62 _hdIvpat _tlIvpats _lhsOfieldattrs :: [(Identifier,Identifier)] _lhsOfieldattrs = rule63 _hdIfieldattrs _tlIfieldattrs _copy = rule64 _hdIcopy _tlIcopy _self = rule65 _hdIself _tlIself _lhsOcopy :: Patterns _lhsOcopy = rule66 _copy _lhsOself :: Patterns _lhsOself = rule67 _self __result_ = T_Patterns_vOut22 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpats in __result_ ) in C_Patterns_s23 v22 {-# INLINE rule62 #-} {-# LINE 132 "src-ag/TfmToVisage.ag" #-} rule62 = \ ((_hdIvpat) :: VisagePattern) ((_tlIvpats) :: [VisagePattern]) -> {-# LINE 132 "src-ag/TfmToVisage.ag" #-} _hdIvpat : _tlIvpats {-# LINE 871 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule63 #-} rule63 = \ ((_hdIfieldattrs) :: [(Identifier,Identifier)] ) ((_tlIfieldattrs) :: [(Identifier,Identifier)] ) -> _hdIfieldattrs ++ _tlIfieldattrs {-# INLINE rule64 #-} rule64 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule65 #-} rule65 = \ ((_hdIself) :: Pattern) ((_tlIself) :: Patterns) -> (:) _hdIself _tlIself {-# INLINE rule66 #-} rule66 = \ _copy -> _copy {-# INLINE rule67 #-} rule67 = \ _self -> _self {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_Patterns_v22 v22 = \ (T_Patterns_vIn22 ) -> ( let _lhsOvpats :: [VisagePattern] _lhsOvpats = rule68 () _lhsOfieldattrs :: [(Identifier,Identifier)] _lhsOfieldattrs = rule69 () _copy = rule70 () _self = rule71 () _lhsOcopy :: Patterns _lhsOcopy = rule72 _copy _lhsOself :: Patterns _lhsOself = rule73 _self __result_ = T_Patterns_vOut22 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpats in __result_ ) in C_Patterns_s23 v22 {-# INLINE rule68 #-} {-# LINE 133 "src-ag/TfmToVisage.ag" #-} rule68 = \ (_ :: ()) -> {-# LINE 133 "src-ag/TfmToVisage.ag" #-} [] {-# LINE 912 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule69 #-} rule69 = \ (_ :: ()) -> [] {-# INLINE rule70 #-} rule70 = \ (_ :: ()) -> [] {-# INLINE rule71 #-} rule71 = \ (_ :: ()) -> [] {-# INLINE rule72 #-} rule72 = \ _copy -> _copy {-# INLINE rule73 #-} rule73 = \ _self -> _self -- Production -------------------------------------------------- -- wrapper data Inh_Production = Inh_Production { inhMap_Inh_Production :: (Map Identifier Attributes), synMap_Inh_Production :: (Map Identifier Attributes) } data Syn_Production = Syn_Production { vprod_Syn_Production :: (VisageProduction) } {-# INLINABLE wrap_Production #-} wrap_Production :: T_Production -> Inh_Production -> (Syn_Production ) wrap_Production (T_Production act) (Inh_Production _lhsIinhMap _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg25 = T_Production_vIn25 _lhsIinhMap _lhsIsynMap (T_Production_vOut25 _lhsOvprod) <- return (inv_Production_s26 sem arg25) return (Syn_Production _lhsOvprod) ) -- cata {-# INLINE sem_Production #-} sem_Production :: Production -> T_Production sem_Production ( Production con_ params_ constraints_ children_ rules_ typeSigs_ macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_ -- semantic domain newtype T_Production = T_Production { attach_T_Production :: Identity (T_Production_s26 ) } newtype T_Production_s26 = C_Production_s26 { inv_Production_s26 :: (T_Production_v25 ) } data T_Production_s27 = C_Production_s27 type T_Production_v25 = (T_Production_vIn25 ) -> (T_Production_vOut25 ) data T_Production_vIn25 = T_Production_vIn25 (Map Identifier Attributes) (Map Identifier Attributes) data T_Production_vOut25 = T_Production_vOut25 (VisageProduction) {-# NOINLINE sem_Production_Production #-} sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production sem_Production_Production arg_con_ _ _ arg_children_ arg_rules_ arg_typeSigs_ _ = T_Production (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_Production_v25 v25 = \ (T_Production_vIn25 _lhsIinhMap _lhsIsynMap) -> ( let _childrenX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) _rulesX35 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) _typeSigsX41 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) (T_Children_vOut4 _childrenIvchildren) = inv_Children_s5 _childrenX5 (T_Children_vIn4 _childrenOinhMap _childrenOrulemap _childrenOsynMap) (T_Rules_vOut34 _rulesIvrules) = inv_Rules_s35 _rulesX35 (T_Rules_vIn34 ) (T_TypeSigs_vOut40 ) = inv_TypeSigs_s41 _typeSigsX41 (T_TypeSigs_vIn40 ) _lhsOvprod :: VisageProduction _lhsOvprod = rule74 _childrenIvchildren _lhsrules _locrules arg_con_ _splitVRules = rule75 _rulesIvrules _locrules = rule76 _splitVRules _lhsrules = rule77 _splitVRules _childrenOrulemap = rule78 _splitVRules _childrenOinhMap = rule79 _lhsIinhMap _childrenOsynMap = rule80 _lhsIsynMap __result_ = T_Production_vOut25 _lhsOvprod in __result_ ) in C_Production_s26 v25 {-# INLINE rule74 #-} {-# LINE 110 "src-ag/TfmToVisage.ag" #-} rule74 = \ ((_childrenIvchildren) :: [VisageChild]) _lhsrules _locrules con_ -> {-# LINE 110 "src-ag/TfmToVisage.ag" #-} VProduction con_ _childrenIvchildren _lhsrules _locrules {-# LINE 988 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule75 #-} {-# LINE 111 "src-ag/TfmToVisage.ag" #-} rule75 = \ ((_rulesIvrules) :: [VisageRule]) -> {-# LINE 111 "src-ag/TfmToVisage.ag" #-} splitVRules _rulesIvrules {-# LINE 994 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule76 #-} {-# LINE 112 "src-ag/TfmToVisage.ag" #-} rule76 = \ _splitVRules -> {-# LINE 112 "src-ag/TfmToVisage.ag" #-} getForField "loc" _splitVRules {-# LINE 1000 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule77 #-} {-# LINE 113 "src-ag/TfmToVisage.ag" #-} rule77 = \ _splitVRules -> {-# LINE 113 "src-ag/TfmToVisage.ag" #-} getForField "lhs" _splitVRules {-# LINE 1006 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule78 #-} {-# LINE 114 "src-ag/TfmToVisage.ag" #-} rule78 = \ _splitVRules -> {-# LINE 114 "src-ag/TfmToVisage.ag" #-} _splitVRules {-# LINE 1012 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule79 #-} rule79 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule80 #-} rule80 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap -- Productions ------------------------------------------------- -- wrapper data Inh_Productions = Inh_Productions { inhMap_Inh_Productions :: (Map Identifier Attributes), synMap_Inh_Productions :: (Map Identifier Attributes) } data Syn_Productions = Syn_Productions { vprods_Syn_Productions :: ([VisageProduction]) } {-# INLINABLE wrap_Productions #-} wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions ) wrap_Productions (T_Productions act) (Inh_Productions _lhsIinhMap _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act let arg28 = T_Productions_vIn28 _lhsIinhMap _lhsIsynMap (T_Productions_vOut28 _lhsOvprods) <- return (inv_Productions_s29 sem arg28) return (Syn_Productions _lhsOvprods) ) -- cata {-# NOINLINE sem_Productions #-} sem_Productions :: Productions -> T_Productions sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) -- semantic domain newtype T_Productions = T_Productions { attach_T_Productions :: Identity (T_Productions_s29 ) } newtype T_Productions_s29 = C_Productions_s29 { inv_Productions_s29 :: (T_Productions_v28 ) } data T_Productions_s30 = C_Productions_s30 type T_Productions_v28 = (T_Productions_vIn28 ) -> (T_Productions_vOut28 ) data T_Productions_vIn28 = T_Productions_vIn28 (Map Identifier Attributes) (Map Identifier Attributes) data T_Productions_vOut28 = T_Productions_vOut28 ([VisageProduction]) {-# NOINLINE sem_Productions_Cons #-} sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Productions_v28 v28 = \ (T_Productions_vIn28 _lhsIinhMap _lhsIsynMap) -> ( let _hdX26 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) _tlX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) (T_Production_vOut25 _hdIvprod) = inv_Production_s26 _hdX26 (T_Production_vIn25 _hdOinhMap _hdOsynMap) (T_Productions_vOut28 _tlIvprods) = inv_Productions_s29 _tlX29 (T_Productions_vIn28 _tlOinhMap _tlOsynMap) _lhsOvprods :: [VisageProduction] _lhsOvprods = rule81 _hdIvprod _tlIvprods _hdOinhMap = rule82 _lhsIinhMap _hdOsynMap = rule83 _lhsIsynMap _tlOinhMap = rule84 _lhsIinhMap _tlOsynMap = rule85 _lhsIsynMap __result_ = T_Productions_vOut28 _lhsOvprods in __result_ ) in C_Productions_s29 v28 {-# INLINE rule81 #-} {-# LINE 104 "src-ag/TfmToVisage.ag" #-} rule81 = \ ((_hdIvprod) :: VisageProduction) ((_tlIvprods) :: [VisageProduction]) -> {-# LINE 104 "src-ag/TfmToVisage.ag" #-} _hdIvprod : _tlIvprods {-# LINE 1075 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule82 #-} rule82 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule83 #-} rule83 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# INLINE rule84 #-} rule84 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap {-# INLINE rule85 #-} rule85 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> _lhsIsynMap {-# NOINLINE sem_Productions_Nil #-} sem_Productions_Nil :: T_Productions sem_Productions_Nil = T_Productions (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_Productions_v28 v28 = \ (T_Productions_vIn28 _lhsIinhMap _lhsIsynMap) -> ( let _lhsOvprods :: [VisageProduction] _lhsOvprods = rule86 () __result_ = T_Productions_vOut28 _lhsOvprods in __result_ ) in C_Productions_s29 v28 {-# INLINE rule86 #-} {-# LINE 106 "src-ag/TfmToVisage.ag" #-} rule86 = \ (_ :: ()) -> {-# LINE 106 "src-ag/TfmToVisage.ag" #-} [] {-# LINE 1105 "dist/build/TfmToVisage.hs"#-} -- Rule -------------------------------------------------------- -- wrapper data Inh_Rule = Inh_Rule { } data Syn_Rule = Syn_Rule { vrule_Syn_Rule :: (VisageRule) } {-# INLINABLE wrap_Rule #-} wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule ) wrap_Rule (T_Rule act) (Inh_Rule ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg31 = T_Rule_vIn31 (T_Rule_vOut31 _lhsOvrule) <- return (inv_Rule_s32 sem arg31) return (Syn_Rule _lhsOvrule) ) -- cata {-# INLINE sem_Rule #-} sem_Rule :: Rule -> T_Rule sem_Rule ( Rule mbName_ pattern_ rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ -- semantic domain newtype T_Rule = T_Rule { attach_T_Rule :: Identity (T_Rule_s32 ) } newtype T_Rule_s32 = C_Rule_s32 { inv_Rule_s32 :: (T_Rule_v31 ) } data T_Rule_s33 = C_Rule_s33 type T_Rule_v31 = (T_Rule_vIn31 ) -> (T_Rule_vOut31 ) data T_Rule_vIn31 = T_Rule_vIn31 data T_Rule_vOut31 = T_Rule_vOut31 (VisageRule) {-# NOINLINE sem_Rule_Rule #-} sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule sem_Rule_Rule _ arg_pattern_ arg_rhs_ arg_owrt_ _ _ _ _ _ _ = T_Rule (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_Rule_v31 v31 = \ (T_Rule_vIn31 ) -> ( let _patternX20 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) _rhsX8 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) (T_Pattern_vOut19 _patternIcopy _patternIfieldattrs _patternIself _patternIvpat) = inv_Pattern_s20 _patternX20 (T_Pattern_vIn19 ) (T_Expression_vOut7 _rhsIself) = inv_Expression_s8 _rhsX8 (T_Expression_vIn7 ) _lhsOvrule :: VisageRule _lhsOvrule = rule87 _patternIfieldattrs _patternIvpat _rhsIself arg_owrt_ __result_ = T_Rule_vOut31 _lhsOvrule in __result_ ) in C_Rule_s32 v31 {-# INLINE rule87 #-} {-# LINE 129 "src-ag/TfmToVisage.ag" #-} rule87 = \ ((_patternIfieldattrs) :: [(Identifier,Identifier)] ) ((_patternIvpat) :: VisagePattern) ((_rhsIself) :: Expression) owrt_ -> {-# LINE 129 "src-ag/TfmToVisage.ag" #-} VRule _patternIfieldattrs undefined _patternIvpat _rhsIself owrt_ {-# LINE 1158 "dist/build/TfmToVisage.hs"#-} -- Rules ------------------------------------------------------- -- wrapper data Inh_Rules = Inh_Rules { } data Syn_Rules = Syn_Rules { vrules_Syn_Rules :: ([VisageRule]) } {-# INLINABLE wrap_Rules #-} wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules ) wrap_Rules (T_Rules act) (Inh_Rules ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg34 = T_Rules_vIn34 (T_Rules_vOut34 _lhsOvrules) <- return (inv_Rules_s35 sem arg34) return (Syn_Rules _lhsOvrules) ) -- cata {-# NOINLINE sem_Rules #-} sem_Rules :: Rules -> T_Rules sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) -- semantic domain newtype T_Rules = T_Rules { attach_T_Rules :: Identity (T_Rules_s35 ) } newtype T_Rules_s35 = C_Rules_s35 { inv_Rules_s35 :: (T_Rules_v34 ) } data T_Rules_s36 = C_Rules_s36 type T_Rules_v34 = (T_Rules_vIn34 ) -> (T_Rules_vOut34 ) data T_Rules_vIn34 = T_Rules_vIn34 data T_Rules_vOut34 = T_Rules_vOut34 ([VisageRule]) {-# NOINLINE sem_Rules_Cons #-} sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Rules_v34 v34 = \ (T_Rules_vIn34 ) -> ( let _hdX32 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) _tlX35 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) (T_Rule_vOut31 _hdIvrule) = inv_Rule_s32 _hdX32 (T_Rule_vIn31 ) (T_Rules_vOut34 _tlIvrules) = inv_Rules_s35 _tlX35 (T_Rules_vIn34 ) _lhsOvrules :: [VisageRule] _lhsOvrules = rule88 _hdIvrule _tlIvrules __result_ = T_Rules_vOut34 _lhsOvrules in __result_ ) in C_Rules_s35 v34 {-# INLINE rule88 #-} {-# LINE 124 "src-ag/TfmToVisage.ag" #-} rule88 = \ ((_hdIvrule) :: VisageRule) ((_tlIvrules) :: [VisageRule]) -> {-# LINE 124 "src-ag/TfmToVisage.ag" #-} _hdIvrule : _tlIvrules {-# LINE 1211 "dist/build/TfmToVisage.hs"#-} {-# NOINLINE sem_Rules_Nil #-} sem_Rules_Nil :: T_Rules sem_Rules_Nil = T_Rules (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Rules_v34 v34 = \ (T_Rules_vIn34 ) -> ( let _lhsOvrules :: [VisageRule] _lhsOvrules = rule89 () __result_ = T_Rules_vOut34 _lhsOvrules in __result_ ) in C_Rules_s35 v34 {-# INLINE rule89 #-} {-# LINE 125 "src-ag/TfmToVisage.ag" #-} rule89 = \ (_ :: ()) -> {-# LINE 125 "src-ag/TfmToVisage.ag" #-} [] {-# LINE 1229 "dist/build/TfmToVisage.hs"#-} -- TypeSig ----------------------------------------------------- -- wrapper data Inh_TypeSig = Inh_TypeSig { } data Syn_TypeSig = Syn_TypeSig { } {-# INLINABLE wrap_TypeSig #-} wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig ) wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg37 = T_TypeSig_vIn37 (T_TypeSig_vOut37 ) <- return (inv_TypeSig_s38 sem arg37) return (Syn_TypeSig ) ) -- cata {-# INLINE sem_TypeSig #-} sem_TypeSig :: TypeSig -> T_TypeSig sem_TypeSig ( TypeSig name_ tp_ ) = sem_TypeSig_TypeSig name_ tp_ -- semantic domain newtype T_TypeSig = T_TypeSig { attach_T_TypeSig :: Identity (T_TypeSig_s38 ) } newtype T_TypeSig_s38 = C_TypeSig_s38 { inv_TypeSig_s38 :: (T_TypeSig_v37 ) } data T_TypeSig_s39 = C_TypeSig_s39 type T_TypeSig_v37 = (T_TypeSig_vIn37 ) -> (T_TypeSig_vOut37 ) data T_TypeSig_vIn37 = T_TypeSig_vIn37 data T_TypeSig_vOut37 = T_TypeSig_vOut37 {-# NOINLINE sem_TypeSig_TypeSig #-} sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig sem_TypeSig_TypeSig _ _ = T_TypeSig (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_TypeSig_v37 v37 = \ (T_TypeSig_vIn37 ) -> ( let __result_ = T_TypeSig_vOut37 in __result_ ) in C_TypeSig_s38 v37 -- TypeSigs ---------------------------------------------------- -- wrapper data Inh_TypeSigs = Inh_TypeSigs { } data Syn_TypeSigs = Syn_TypeSigs { } {-# INLINABLE wrap_TypeSigs #-} wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs ) wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg40 = T_TypeSigs_vIn40 (T_TypeSigs_vOut40 ) <- return (inv_TypeSigs_s41 sem arg40) return (Syn_TypeSigs ) ) -- cata {-# NOINLINE sem_TypeSigs #-} sem_TypeSigs :: TypeSigs -> T_TypeSigs sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) -- semantic domain newtype T_TypeSigs = T_TypeSigs { attach_T_TypeSigs :: Identity (T_TypeSigs_s41 ) } newtype T_TypeSigs_s41 = C_TypeSigs_s41 { inv_TypeSigs_s41 :: (T_TypeSigs_v40 ) } data T_TypeSigs_s42 = C_TypeSigs_s42 type T_TypeSigs_v40 = (T_TypeSigs_vIn40 ) -> (T_TypeSigs_vOut40 ) data T_TypeSigs_vIn40 = T_TypeSigs_vIn40 data T_TypeSigs_vOut40 = T_TypeSigs_vOut40 {-# NOINLINE sem_TypeSigs_Cons #-} sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_TypeSigs_v40 v40 = \ (T_TypeSigs_vIn40 ) -> ( let _hdX38 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_)) _tlX41 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_)) (T_TypeSig_vOut37 ) = inv_TypeSig_s38 _hdX38 (T_TypeSig_vIn37 ) (T_TypeSigs_vOut40 ) = inv_TypeSigs_s41 _tlX41 (T_TypeSigs_vIn40 ) __result_ = T_TypeSigs_vOut40 in __result_ ) in C_TypeSigs_s41 v40 {-# NOINLINE sem_TypeSigs_Nil #-} sem_TypeSigs_Nil :: T_TypeSigs sem_TypeSigs_Nil = T_TypeSigs (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_TypeSigs_v40 v40 = \ (T_TypeSigs_vIn40 ) -> ( let __result_ = T_TypeSigs_vOut40 in __result_ ) in C_TypeSigs_s41 v40 uuagc-0.9.52.2/src-generated/LOAG/0000755000000000000000000000000013433540502014505 5ustar0000000000000000uuagc-0.9.52.2/src-generated/LOAG/Rep.hs0000644000000000000000000000760413433540502015576 0ustar0000000000000000 -- UUAGC 0.9.51 (src-ag/LOAG/Rep.ag) module LOAG.Rep where import CommonTypes import AbstractSyntax import LOAG.Common import qualified Data.Array as A import qualified Data.Map as Map import qualified Data.Set as Set import Data.List (intercalate, foldl', nub) import Data.Tuple (swap) import Control.Arrow -- FieldAtt ---------------------------------------------------- {- visit 0: synthesized attribute: self : FieldAtt alternatives: alternative FieldAtt: child t : {MyType} child p : {PLabel} child f : {FLabel} child a : {ALabel} visit 0: local self : _ -} data FieldAtt = FieldAtt {t_FieldAtt_FieldAtt :: MyType,p_FieldAtt_FieldAtt :: PLabel,f_FieldAtt_FieldAtt :: FLabel,a_FieldAtt_FieldAtt :: ALabel} -- FieldAtts --------------------------------------------------- {- visit 0: synthesized attribute: self : FieldAtts alternatives: alternative Cons: child hd : FieldAtt child tl : FieldAtts visit 0: local self : _ alternative Nil: visit 0: local self : _ -} type FieldAtts = [FieldAtt] -- LOAGRep ----------------------------------------------------- {- visit 0: synthesized attribute: self : LOAGRep alternatives: alternative LOAGRep: child ps : {[PLabel]} child ap : {A_P} child an : {A_N} child ain : {AI_N} child asn : {AS_N} child sfp : {SF_P} child pmp : {PMP} child pmpr : {PMP_R} child nmp : {NMP} child nmpr : {NMP_R} child gen : {A.Array Int Int} child inss : {A.Array Int [Int]} child ofld : {A.Array Int Int} child fty : {FTY} child fieldMap : {FMap} child fsInP : {Map.Map PLabel [(PLabel,FLabel)]} visit 0: local self : _ -} data LOAGRep = LOAGRep {ps_LOAGRep_LOAGRep :: ([PLabel]),ap_LOAGRep_LOAGRep :: A_P,an_LOAGRep_LOAGRep :: A_N,ain_LOAGRep_LOAGRep :: AI_N,asn_LOAGRep_LOAGRep :: AS_N,sfp_LOAGRep_LOAGRep :: SF_P,pmp_LOAGRep_LOAGRep :: PMP,pmpr_LOAGRep_LOAGRep :: PMP_R,nmp_LOAGRep_LOAGRep :: NMP,nmpr_LOAGRep_LOAGRep :: NMP_R,gen_LOAGRep_LOAGRep :: (A.Array Int Int),inss_LOAGRep_LOAGRep :: (A.Array Int [Int]),ofld_LOAGRep_LOAGRep :: (A.Array Int Int),fty_LOAGRep_LOAGRep :: FTY,fieldMap_LOAGRep_LOAGRep :: FMap,fsInP_LOAGRep_LOAGRep :: (Map.Map PLabel [(PLabel,FLabel)])} -- MySegment --------------------------------------------------- {- visit 0: synthesized attribute: self : MySegment alternatives: alternative MySegment: child visnr : {Int} child inhAttr : {[Int]} child synAttr : {[Int]} child inhOccs : {Maybe [Int]} child synOccs : {Maybe [Int]} visit 0: local self : _ -} data MySegment = MySegment {visnr_MySegment_MySegment :: Int,inhAttr_MySegment_MySegment :: ([Int]),synAttr_MySegment_MySegment :: ([Int]),inhOccs_MySegment_MySegment :: (Maybe [Int]),synOccs_MySegment_MySegment :: (Maybe [Int])} deriving ( Show) -- MySegments -------------------------------------------------- {- visit 0: synthesized attribute: self : MySegments alternatives: alternative Cons: child hd : MySegment child tl : MySegments visit 0: local self : _ alternative Nil: visit 0: local self : _ -} type MySegments = [MySegment]uuagc-0.9.52.2/src-generated/LOAG/Order.hs0000644000000000000000000111176613433540502016131 0ustar0000000000000000{-# LANGUAGE Rank2Types, GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} module LOAG.Order where {-# LINE 10 "src-ag/LOAG/Rep.ag" #-} import Data.List (intercalate, foldl', nub) import Data.Tuple (swap) import Control.Arrow {-# LINE 12 "dist/build/LOAG/Order.hs" #-} {-# LINE 2 "src-ag/HsToken.ag" #-} import CommonTypes import UU.Scanner.Position(Pos) {-# LINE 18 "dist/build/LOAG/Order.hs" #-} {-# LINE 2 "src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken {-# LINE 24 "dist/build/LOAG/Order.hs" #-} {-# LINE 2 "src-ag/CodeSyntax.ag" #-} import Patterns import CommonTypes import Data.Map(Map) import Data.Set(Set) {-# LINE 32 "dist/build/LOAG/Order.hs" #-} {-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) {-# LINE 39 "dist/build/LOAG/Order.hs" #-} {-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) import Data.Map(Map) import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import Macro --marcos import CommonTypes import ErrorMessages {-# LINE 51 "dist/build/LOAG/Order.hs" #-} {-# LINE 13 "src-ag/LOAG/Order.ag" #-} import qualified Data.Array as A import qualified Data.Map as Map import qualified Data.IntMap as IMap import qualified Data.Set as Set import qualified Data.IntSet as IS import qualified Data.Sequence as Seq import qualified CommonTypes as CT import Control.Monad (forM,when) import Control.Monad.ST import Data.Maybe(catMaybes) import Data.Monoid(mappend,mempty) import Data.STRef import AbstractSyntax import qualified LOAG.AOAG as AOAG import LOAG.Common import LOAG.Chordal import LOAG.Rep import LOAG.Graphs import CodeSyntax import Data.Maybe (isJust, fromJust) import ExecutionPlan import GrammarInfo import HsToken (HsToken(..)) import Pretty import qualified System.IO as IO import System.IO.Unsafe {-# LINE 81 "dist/build/LOAG/Order.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity {-# LINE 13 "src-ag/LOAG/Prepare.ag" #-} -- | Translating UUAGC types to MyTypes drhs f | f == _LHS = Inh | f == _LOC = AnyDir | f == _INST = AnyDir | otherwise = Syn dlhs f | f == _LHS = Syn | f == _LOC = AnyDir | f == _INST = AnyDir | otherwise = Inh depToEdge :: PMP_R -> PLabel -> Dependency -> Edge depToEdge pmpr p e = (findWithErr pmpr "depToEdge" $ MyOccurrence (p,getName f1) (getName i1, drhs f1), findWithErr pmpr "depToEdge" $ MyOccurrence (p,getName f2) (getName i2, dlhs f2)) where Dependency (OccAttr f1 i1) (OccAttr f2 i2) = e vertexToAttr :: NMP -> Vertex -> Attributes vertexToAttr nmp v = Map.singleton (identifier a) (fromMyTy ty) where (MyAttribute ty (a,_)) = findWithErr nmp "vertexToAttr" v {-# LINE 106 "dist/build/LOAG/Order.hs" #-} {-# LINE 292 "src-ag/LOAG/Prepare.ag" #-} -- | Replace the references to local attributes, by his attrs dependencies repLocRefs :: SF_P -> SF_P -> SF_P repLocRefs lfp sfp = Map.map (setConcatMap rep) sfp where rep :: MyOccurrence -> Set.Set MyOccurrence rep occ | isLoc occ = setConcatMap rep $ findWithErr lfp "repping locals" occ | otherwise = Set.singleton occ {-# LINE 118 "dist/build/LOAG/Order.hs" #-} {-# LINE 42 "src-ag/LOAG/Order.ag" #-} fst' (a,_,_) = a snd' (_,b,_) = b trd' (_,_,c) = c {-# LINE 125 "dist/build/LOAG/Order.hs" #-} {-# LINE 95 "src-ag/LOAG/Order.ag" #-} data AltAttr = AltAttr Identifier Identifier Bool deriving (Eq, Ord, Show) edgeToDep :: PMP -> Edge -> Dependency edgeToDep pmp (f,t) = Dependency (OccAttr (identifier f1) (identifier i1)) (OccAttr (identifier f2) (identifier i2)) where (MyOccurrence (_,f1) (i1,_),MyOccurrence (_,f2) (i2,_)) = (findWithErr pmp "edgeToDep" f, findWithErr pmp "edgeToDep" t) ppAds :: Options -> PMP -> [Edge] -> PP_Doc ppAds opts pmp = foldr ((>-<) . ppEdge opts pmp) empty ppEdge :: Options -> PMP -> Edge -> PP_Doc ppEdge opts pmp (f,t) = text sem >#< text (show ty) >|< " | " >|< text p >|< " " >|< ppOcc pmp f >|< text " < " >|< ppOcc pmp t where (MyOccurrence ((ty,p),_) _) = pmp Map.! f sem | lcKeywords opts = "sem" | otherwise = "SEM" ppOcc :: PMP -> Vertex -> PP_Doc ppOcc pmp v = text f >|< text "." >|< fst a where (MyOccurrence ((t,p),f) a) = findWithErr pmp "ppOcc" v {-# LINE 155 "dist/build/LOAG/Order.hs" #-} {-# LINE 239 "src-ag/LOAG/Order.ag" #-} getVss (done,intros,rules,vnrs) ps tdp synsO lfp nmpr pmp pmpr fty visMap ruleMap hoMap = do ref <- newSTRef done introed <- newSTRef intros ruleref <- newSTRef rules vnrsref <- newSTRef vnrs lists <- forM synsO (visit ref introed ruleref vnrsref . (pmp Map.!)) done <- readSTRef ref intros <- readSTRef introed rules <- readSTRef ruleref vnrs <- readSTRef vnrsref return (concat lists, (done, intros, rules, vnrs)) where hochildren = maybe Set.empty id $ Map.lookup ps hoMap visit ref introed ruleref vnrsref o@(MyOccurrence (_,f) (_,d)) = do visited <- readSTRef ref if (o `Set.member` visited) then return [] -- already visited else do -- prevent doubles modifySTRef ref (Set.insert o) if inOutput then do -- has to be calculated in this sequence rest' <- rest locs' <- locs sem' <- sem o return $ (rest' ++ locs' ++ sem') else if "lhs" == (snd $ argsOf o) then return [] -- inherited of parent, nothing todo else do -- other input occurrence, perform visit locs' <- locs rest' <- rest visit'<- toVisit o return (rest' ++ locs' ++ visit') where preds = maybe [] (IS.toList . (tdp A.!)) $ Map.lookup o pmpr rest = forM preds (visit ref introed ruleref vnrsref. (pmp Map.!)) >>= (return . concat) free = maybe [] (Set.toList) $ Map.lookup o lfp locs = forM free (visit ref introed ruleref vnrsref) >>= (return . concat) sem o = do rules <- readSTRef ruleref if r `Set.member` rules then return [] else do writeSTRef ruleref (r `Set.insert` rules) return [Sem r] where r = maybe (error "ruleMap") id $ Map.lookup o ruleMap inOutput = f == "lhs" && d == Syn || f /= "lhs" && d == Inh toVisit o = do vnrs <- readSTRef vnrsref if (child,visnr) `Set.member` vnrs then return [] else writeSTRef vnrsref ((child,visnr) `Set.insert` vnrs) >> if child `Set.member` hochildren then do intros <- readSTRef introed case child `Set.member` intros of True -> return [cvisit] False -> do writeSTRef introed (Set.insert child intros) let occ = (ps,"inst") >.< (child, AnyDir) preds = Set.toList $ setConcatMap rep $ findWithErr lfp "woot4" occ rep :: MyOccurrence -> Set.Set MyOccurrence rep occ | isLoc occ = Set.insert occ $ setConcatMap rep $ findWithErr lfp "woot3" occ | otherwise = Set.singleton occ rest <- forM preds (visit ref introed ruleref vnrsref) sem' <- sem occ return $ (concat rest) ++ sem' ++ [ChildIntro (identifier child)] ++ [cvisit] else return [cvisit] where cvisit= ChildVisit (identifier child) ntid visnr child = snd $ argsOf o ntid = ((\(NT name _ _ )-> name) . fromMyTy) nt visnr = (\x-> findWithErr' visMap (show (inOutput,o,x)) x) (findWithErr nmpr "woot3" (nt <.> attr o)) nt = findWithErr fty "woot" (ps,child) {-# LINE 235 "dist/build/LOAG/Order.hs" #-} {-# LINE 356 "src-ag/LOAG/Order.ag" #-} repToAg :: LOAGRep -> Grammar -> Ag repToAg sem (Grammar _ _ _ _ dats _ _ _ _ _ _ _ _ _) = Ag bounds_s bounds_p de (map toNt dats) where pmp = (pmp_LOAGRep_LOAGRep sem) pmpr = (pmpr_LOAGRep_LOAGRep sem) nmp = (nmp_LOAGRep_LOAGRep sem) nmpr = (nmpr_LOAGRep_LOAGRep sem) genA = gen_LOAGRep_LOAGRep sem fieldM = fieldMap_LOAGRep_LOAGRep sem genEdge (f,t) = (gen f, gen t) fsInP = map2F (fsInP_LOAGRep_LOAGRep sem) siblings (f, t) = ofld A.! f == ofld A.! t ofld = (ofld_LOAGRep_LOAGRep sem) sfp = map2F' (sfp_LOAGRep_LOAGRep sem) afp = filter inOutput . ap ap = map (findWithErr pmpr "building ap") . map2F (ap_LOAGRep_LOAGRep sem) inss = inss_LOAGRep_LOAGRep sem gen v = genA A.! v ain = map (findWithErr nmpr "building an") . map2F (ain_LOAGRep_LOAGRep sem) asn = map (findWithErr nmpr "building an") . map2F (asn_LOAGRep_LOAGRep sem) inOutput = not . inContext inContext f = (f1 == "lhs" && d1 == Inh || f1 /= "lhs" && d1 == Syn) where (MyOccurrence (_,f1) (_,d1)) = pmp Map.! f de = [ e | p <- ps, e <- dpe p ] dpe p = [ (findWithErr pmpr "building dpe" a, b) | b <- ap p, a <- Set.toList $ sfp (findWithErr pmp "fetching sfp" b) ] ps = ps_LOAGRep_LOAGRep sem bounds_p = if Map.null pmp then (0,-1) else (fst $ Map.findMin pmp, fst $ Map.findMax pmp) bounds_s = if Map.null nmp then (0,-1) else (fst $ Map.findMin nmp, fst $ Map.findMax nmp) toNt :: Nonterminal -> Nt toNt (Nonterminal ntid _ _ _ prods) = Nt nt dpf dpt (addD Inh $ ain ty) (addD Syn $ asn ty) (map (toPr ty) prods) where nt = getName ntid ty = TyData nt dpt = [ (as, ai) | ai <- ain ty , as <- nub$ [ gen s | i <- inss A.! ai , s <- map (pmpr Map.!) $ Set.toList (sfp $ pmp Map.! i) , siblings (s,i)]] dpf = [ (ai, as) | as <- asn ty , ai <- nub$ [ gen i | s <- inss A.! as , i <- map (pmpr Map.!) $ Set.toList (sfp $ pmp Map.! s) , siblings (i,s)]] addD d = map (\i -> (i,inss A.! i,d)) toPr :: MyType -> Production -> Pr toPr ty (Production con _ _ _ _ _ _) = Pr p dpp fc_occs (map toFd $ fsInP p) where p = (ty, getName con) dpp = [ (f',t) | t <- afp p, f <- (Set.toList $ sfp (pmp Map.! t)) , let f' = pmpr Map.! f , not (siblings (f',t))] fc_occs = foldl' match [] fss where fss = fsInP p match s fs = [ ready (inp, out) lhs | inp <- Set.toList inhs , out <- Set.toList syns] ++ s where ((inhs, syns), lhs) | (snd fs) /= "lhs" = (swap (fieldM Map.! fs),False) | otherwise = (fieldM Map.! fs, True) ready e@(f,t) b = (e', genEdge e', b) where e' = (pmpr Map.! f, pmpr Map.! t) toFd :: (PLabel, FLabel) -> Fd toFd fs@((TyData ty, pr), fd) = Fd fd ty inhs syns where (is,ss) = fieldM Map.! fs inhs = map (((genA A.!) &&& id).(pmpr Map.!))$ Set.toList is syns = map (((genA A.!) &&& id).(pmpr Map.!))$ Set.toList ss {-# LINE 317 "dist/build/LOAG/Order.hs" #-} -- CGrammar ---------------------------------------------------- -- wrapper data Inh_CGrammar = Inh_CGrammar { } data Syn_CGrammar = Syn_CGrammar { self_Syn_CGrammar :: (CGrammar) } {-# INLINABLE wrap_CGrammar #-} wrap_CGrammar :: T_CGrammar -> Inh_CGrammar -> (Syn_CGrammar ) wrap_CGrammar (T_CGrammar act) (Inh_CGrammar ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg1 = T_CGrammar_vIn1 (T_CGrammar_vOut1 _lhsOself) <- return (inv_CGrammar_s2 sem arg1) return (Syn_CGrammar _lhsOself) ) -- cata {-# INLINE sem_CGrammar #-} sem_CGrammar :: CGrammar -> T_CGrammar sem_CGrammar ( CGrammar typeSyns_ derivings_ wrappers_ nonts_ pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ ) = sem_CGrammar_CGrammar typeSyns_ derivings_ wrappers_ ( sem_CNonterminals nonts_ ) pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ -- semantic domain newtype T_CGrammar = T_CGrammar { attach_T_CGrammar :: Identity (T_CGrammar_s2 ) } newtype T_CGrammar_s2 = C_CGrammar_s2 { inv_CGrammar_s2 :: (T_CGrammar_v1 ) } data T_CGrammar_s3 = C_CGrammar_s3 type T_CGrammar_v1 = (T_CGrammar_vIn1 ) -> (T_CGrammar_vOut1 ) data T_CGrammar_vIn1 = T_CGrammar_vIn1 data T_CGrammar_vOut1 = T_CGrammar_vOut1 (CGrammar) {-# NOINLINE sem_CGrammar_CGrammar #-} sem_CGrammar_CGrammar :: (TypeSyns) -> (Derivings) -> (Set NontermIdent) -> T_CNonterminals -> (PragmaMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (Map NontermIdent (Map ConstructorIdent (Set Identifier))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) -> (Bool) -> T_CGrammar sem_CGrammar_CGrammar arg_typeSyns_ arg_derivings_ arg_wrappers_ arg_nonts_ arg_pragmas_ arg_paramMap_ arg_contextMap_ arg_quantMap_ arg_aroundsMap_ arg_mergeMap_ arg_multivisit_ = T_CGrammar (return st2) where {-# NOINLINE st2 #-} st2 = let v1 :: T_CGrammar_v1 v1 = \ (T_CGrammar_vIn1 ) -> ( let _nontsX11 = Control.Monad.Identity.runIdentity (attach_T_CNonterminals (arg_nonts_)) (T_CNonterminals_vOut10 _nontsIself) = inv_CNonterminals_s11 _nontsX11 (T_CNonterminals_vIn10 ) _self = rule0 _nontsIself arg_aroundsMap_ arg_contextMap_ arg_derivings_ arg_mergeMap_ arg_multivisit_ arg_paramMap_ arg_pragmas_ arg_quantMap_ arg_typeSyns_ arg_wrappers_ _lhsOself :: CGrammar _lhsOself = rule1 _self __result_ = T_CGrammar_vOut1 _lhsOself in __result_ ) in C_CGrammar_s2 v1 {-# INLINE rule0 #-} rule0 = \ ((_nontsIself) :: CNonterminals) aroundsMap_ contextMap_ derivings_ mergeMap_ multivisit_ paramMap_ pragmas_ quantMap_ typeSyns_ wrappers_ -> CGrammar typeSyns_ derivings_ wrappers_ _nontsIself pragmas_ paramMap_ contextMap_ quantMap_ aroundsMap_ mergeMap_ multivisit_ {-# INLINE rule1 #-} rule1 = \ _self -> _self -- CInterface -------------------------------------------------- -- wrapper data Inh_CInterface = Inh_CInterface { } data Syn_CInterface = Syn_CInterface { self_Syn_CInterface :: (CInterface) } {-# INLINABLE wrap_CInterface #-} wrap_CInterface :: T_CInterface -> Inh_CInterface -> (Syn_CInterface ) wrap_CInterface (T_CInterface act) (Inh_CInterface ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg4 = T_CInterface_vIn4 (T_CInterface_vOut4 _lhsOself) <- return (inv_CInterface_s5 sem arg4) return (Syn_CInterface _lhsOself) ) -- cata {-# INLINE sem_CInterface #-} sem_CInterface :: CInterface -> T_CInterface sem_CInterface ( CInterface seg_ ) = sem_CInterface_CInterface ( sem_CSegments seg_ ) -- semantic domain newtype T_CInterface = T_CInterface { attach_T_CInterface :: Identity (T_CInterface_s5 ) } newtype T_CInterface_s5 = C_CInterface_s5 { inv_CInterface_s5 :: (T_CInterface_v4 ) } data T_CInterface_s6 = C_CInterface_s6 type T_CInterface_v4 = (T_CInterface_vIn4 ) -> (T_CInterface_vOut4 ) data T_CInterface_vIn4 = T_CInterface_vIn4 data T_CInterface_vOut4 = T_CInterface_vOut4 (CInterface) {-# NOINLINE sem_CInterface_CInterface #-} sem_CInterface_CInterface :: T_CSegments -> T_CInterface sem_CInterface_CInterface arg_seg_ = T_CInterface (return st5) where {-# NOINLINE st5 #-} st5 = let v4 :: T_CInterface_v4 v4 = \ (T_CInterface_vIn4 ) -> ( let _segX26 = Control.Monad.Identity.runIdentity (attach_T_CSegments (arg_seg_)) (T_CSegments_vOut25 _segIself) = inv_CSegments_s26 _segX26 (T_CSegments_vIn25 ) _self = rule2 _segIself _lhsOself :: CInterface _lhsOself = rule3 _self __result_ = T_CInterface_vOut4 _lhsOself in __result_ ) in C_CInterface_s5 v4 {-# INLINE rule2 #-} rule2 = \ ((_segIself) :: CSegments) -> CInterface _segIself {-# INLINE rule3 #-} rule3 = \ _self -> _self -- CNonterminal ------------------------------------------------ -- wrapper data Inh_CNonterminal = Inh_CNonterminal { } data Syn_CNonterminal = Syn_CNonterminal { self_Syn_CNonterminal :: (CNonterminal) } {-# INLINABLE wrap_CNonterminal #-} wrap_CNonterminal :: T_CNonterminal -> Inh_CNonterminal -> (Syn_CNonterminal ) wrap_CNonterminal (T_CNonterminal act) (Inh_CNonterminal ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg7 = T_CNonterminal_vIn7 (T_CNonterminal_vOut7 _lhsOself) <- return (inv_CNonterminal_s8 sem arg7) return (Syn_CNonterminal _lhsOself) ) -- cata {-# INLINE sem_CNonterminal #-} sem_CNonterminal :: CNonterminal -> T_CNonterminal sem_CNonterminal ( CNonterminal nt_ params_ inh_ syn_ prods_ inter_ ) = sem_CNonterminal_CNonterminal nt_ params_ inh_ syn_ ( sem_CProductions prods_ ) ( sem_CInterface inter_ ) -- semantic domain newtype T_CNonterminal = T_CNonterminal { attach_T_CNonterminal :: Identity (T_CNonterminal_s8 ) } newtype T_CNonterminal_s8 = C_CNonterminal_s8 { inv_CNonterminal_s8 :: (T_CNonterminal_v7 ) } data T_CNonterminal_s9 = C_CNonterminal_s9 type T_CNonterminal_v7 = (T_CNonterminal_vIn7 ) -> (T_CNonterminal_vOut7 ) data T_CNonterminal_vIn7 = T_CNonterminal_vIn7 data T_CNonterminal_vOut7 = T_CNonterminal_vOut7 (CNonterminal) {-# NOINLINE sem_CNonterminal_CNonterminal #-} sem_CNonterminal_CNonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_CProductions -> T_CInterface -> T_CNonterminal sem_CNonterminal_CNonterminal arg_nt_ arg_params_ arg_inh_ arg_syn_ arg_prods_ arg_inter_ = T_CNonterminal (return st8) where {-# NOINLINE st8 #-} st8 = let v7 :: T_CNonterminal_v7 v7 = \ (T_CNonterminal_vIn7 ) -> ( let _prodsX17 = Control.Monad.Identity.runIdentity (attach_T_CProductions (arg_prods_)) _interX5 = Control.Monad.Identity.runIdentity (attach_T_CInterface (arg_inter_)) (T_CProductions_vOut16 _prodsIself) = inv_CProductions_s17 _prodsX17 (T_CProductions_vIn16 ) (T_CInterface_vOut4 _interIself) = inv_CInterface_s5 _interX5 (T_CInterface_vIn4 ) _self = rule4 _interIself _prodsIself arg_inh_ arg_nt_ arg_params_ arg_syn_ _lhsOself :: CNonterminal _lhsOself = rule5 _self __result_ = T_CNonterminal_vOut7 _lhsOself in __result_ ) in C_CNonterminal_s8 v7 {-# INLINE rule4 #-} rule4 = \ ((_interIself) :: CInterface) ((_prodsIself) :: CProductions) inh_ nt_ params_ syn_ -> CNonterminal nt_ params_ inh_ syn_ _prodsIself _interIself {-# INLINE rule5 #-} rule5 = \ _self -> _self -- CNonterminals ----------------------------------------------- -- wrapper data Inh_CNonterminals = Inh_CNonterminals { } data Syn_CNonterminals = Syn_CNonterminals { self_Syn_CNonterminals :: (CNonterminals) } {-# INLINABLE wrap_CNonterminals #-} wrap_CNonterminals :: T_CNonterminals -> Inh_CNonterminals -> (Syn_CNonterminals ) wrap_CNonterminals (T_CNonterminals act) (Inh_CNonterminals ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg10 = T_CNonterminals_vIn10 (T_CNonterminals_vOut10 _lhsOself) <- return (inv_CNonterminals_s11 sem arg10) return (Syn_CNonterminals _lhsOself) ) -- cata {-# NOINLINE sem_CNonterminals #-} sem_CNonterminals :: CNonterminals -> T_CNonterminals sem_CNonterminals list = Prelude.foldr sem_CNonterminals_Cons sem_CNonterminals_Nil (Prelude.map sem_CNonterminal list) -- semantic domain newtype T_CNonterminals = T_CNonterminals { attach_T_CNonterminals :: Identity (T_CNonterminals_s11 ) } newtype T_CNonterminals_s11 = C_CNonterminals_s11 { inv_CNonterminals_s11 :: (T_CNonterminals_v10 ) } data T_CNonterminals_s12 = C_CNonterminals_s12 type T_CNonterminals_v10 = (T_CNonterminals_vIn10 ) -> (T_CNonterminals_vOut10 ) data T_CNonterminals_vIn10 = T_CNonterminals_vIn10 data T_CNonterminals_vOut10 = T_CNonterminals_vOut10 (CNonterminals) {-# NOINLINE sem_CNonterminals_Cons #-} sem_CNonterminals_Cons :: T_CNonterminal -> T_CNonterminals -> T_CNonterminals sem_CNonterminals_Cons arg_hd_ arg_tl_ = T_CNonterminals (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_CNonterminals_v10 v10 = \ (T_CNonterminals_vIn10 ) -> ( let _hdX8 = Control.Monad.Identity.runIdentity (attach_T_CNonterminal (arg_hd_)) _tlX11 = Control.Monad.Identity.runIdentity (attach_T_CNonterminals (arg_tl_)) (T_CNonterminal_vOut7 _hdIself) = inv_CNonterminal_s8 _hdX8 (T_CNonterminal_vIn7 ) (T_CNonterminals_vOut10 _tlIself) = inv_CNonterminals_s11 _tlX11 (T_CNonterminals_vIn10 ) _self = rule6 _hdIself _tlIself _lhsOself :: CNonterminals _lhsOself = rule7 _self __result_ = T_CNonterminals_vOut10 _lhsOself in __result_ ) in C_CNonterminals_s11 v10 {-# INLINE rule6 #-} rule6 = \ ((_hdIself) :: CNonterminal) ((_tlIself) :: CNonterminals) -> (:) _hdIself _tlIself {-# INLINE rule7 #-} rule7 = \ _self -> _self {-# NOINLINE sem_CNonterminals_Nil #-} sem_CNonterminals_Nil :: T_CNonterminals sem_CNonterminals_Nil = T_CNonterminals (return st11) where {-# NOINLINE st11 #-} st11 = let v10 :: T_CNonterminals_v10 v10 = \ (T_CNonterminals_vIn10 ) -> ( let _self = rule8 () _lhsOself :: CNonterminals _lhsOself = rule9 _self __result_ = T_CNonterminals_vOut10 _lhsOself in __result_ ) in C_CNonterminals_s11 v10 {-# INLINE rule8 #-} rule8 = \ (_ :: ()) -> [] {-# INLINE rule9 #-} rule9 = \ _self -> _self -- CProduction ------------------------------------------------- -- wrapper data Inh_CProduction = Inh_CProduction { } data Syn_CProduction = Syn_CProduction { self_Syn_CProduction :: (CProduction) } {-# INLINABLE wrap_CProduction #-} wrap_CProduction :: T_CProduction -> Inh_CProduction -> (Syn_CProduction ) wrap_CProduction (T_CProduction act) (Inh_CProduction ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg13 = T_CProduction_vIn13 (T_CProduction_vOut13 _lhsOself) <- return (inv_CProduction_s14 sem arg13) return (Syn_CProduction _lhsOself) ) -- cata {-# INLINE sem_CProduction #-} sem_CProduction :: CProduction -> T_CProduction sem_CProduction ( CProduction con_ visits_ children_ terminals_ ) = sem_CProduction_CProduction con_ ( sem_CVisits visits_ ) children_ terminals_ -- semantic domain newtype T_CProduction = T_CProduction { attach_T_CProduction :: Identity (T_CProduction_s14 ) } newtype T_CProduction_s14 = C_CProduction_s14 { inv_CProduction_s14 :: (T_CProduction_v13 ) } data T_CProduction_s15 = C_CProduction_s15 type T_CProduction_v13 = (T_CProduction_vIn13 ) -> (T_CProduction_vOut13 ) data T_CProduction_vIn13 = T_CProduction_vIn13 data T_CProduction_vOut13 = T_CProduction_vOut13 (CProduction) {-# NOINLINE sem_CProduction_CProduction #-} sem_CProduction_CProduction :: (ConstructorIdent) -> T_CVisits -> ([(Identifier,Type,ChildKind)]) -> ([Identifier]) -> T_CProduction sem_CProduction_CProduction arg_con_ arg_visits_ arg_children_ arg_terminals_ = T_CProduction (return st14) where {-# NOINLINE st14 #-} st14 = let v13 :: T_CProduction_v13 v13 = \ (T_CProduction_vIn13 ) -> ( let _visitsX32 = Control.Monad.Identity.runIdentity (attach_T_CVisits (arg_visits_)) (T_CVisits_vOut31 _visitsIself) = inv_CVisits_s32 _visitsX32 (T_CVisits_vIn31 ) _self = rule10 _visitsIself arg_children_ arg_con_ arg_terminals_ _lhsOself :: CProduction _lhsOself = rule11 _self __result_ = T_CProduction_vOut13 _lhsOself in __result_ ) in C_CProduction_s14 v13 {-# INLINE rule10 #-} rule10 = \ ((_visitsIself) :: CVisits) children_ con_ terminals_ -> CProduction con_ _visitsIself children_ terminals_ {-# INLINE rule11 #-} rule11 = \ _self -> _self -- CProductions ------------------------------------------------ -- wrapper data Inh_CProductions = Inh_CProductions { } data Syn_CProductions = Syn_CProductions { self_Syn_CProductions :: (CProductions) } {-# INLINABLE wrap_CProductions #-} wrap_CProductions :: T_CProductions -> Inh_CProductions -> (Syn_CProductions ) wrap_CProductions (T_CProductions act) (Inh_CProductions ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg16 = T_CProductions_vIn16 (T_CProductions_vOut16 _lhsOself) <- return (inv_CProductions_s17 sem arg16) return (Syn_CProductions _lhsOself) ) -- cata {-# NOINLINE sem_CProductions #-} sem_CProductions :: CProductions -> T_CProductions sem_CProductions list = Prelude.foldr sem_CProductions_Cons sem_CProductions_Nil (Prelude.map sem_CProduction list) -- semantic domain newtype T_CProductions = T_CProductions { attach_T_CProductions :: Identity (T_CProductions_s17 ) } newtype T_CProductions_s17 = C_CProductions_s17 { inv_CProductions_s17 :: (T_CProductions_v16 ) } data T_CProductions_s18 = C_CProductions_s18 type T_CProductions_v16 = (T_CProductions_vIn16 ) -> (T_CProductions_vOut16 ) data T_CProductions_vIn16 = T_CProductions_vIn16 data T_CProductions_vOut16 = T_CProductions_vOut16 (CProductions) {-# NOINLINE sem_CProductions_Cons #-} sem_CProductions_Cons :: T_CProduction -> T_CProductions -> T_CProductions sem_CProductions_Cons arg_hd_ arg_tl_ = T_CProductions (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_CProductions_v16 v16 = \ (T_CProductions_vIn16 ) -> ( let _hdX14 = Control.Monad.Identity.runIdentity (attach_T_CProduction (arg_hd_)) _tlX17 = Control.Monad.Identity.runIdentity (attach_T_CProductions (arg_tl_)) (T_CProduction_vOut13 _hdIself) = inv_CProduction_s14 _hdX14 (T_CProduction_vIn13 ) (T_CProductions_vOut16 _tlIself) = inv_CProductions_s17 _tlX17 (T_CProductions_vIn16 ) _self = rule12 _hdIself _tlIself _lhsOself :: CProductions _lhsOself = rule13 _self __result_ = T_CProductions_vOut16 _lhsOself in __result_ ) in C_CProductions_s17 v16 {-# INLINE rule12 #-} rule12 = \ ((_hdIself) :: CProduction) ((_tlIself) :: CProductions) -> (:) _hdIself _tlIself {-# INLINE rule13 #-} rule13 = \ _self -> _self {-# NOINLINE sem_CProductions_Nil #-} sem_CProductions_Nil :: T_CProductions sem_CProductions_Nil = T_CProductions (return st17) where {-# NOINLINE st17 #-} st17 = let v16 :: T_CProductions_v16 v16 = \ (T_CProductions_vIn16 ) -> ( let _self = rule14 () _lhsOself :: CProductions _lhsOself = rule15 _self __result_ = T_CProductions_vOut16 _lhsOself in __result_ ) in C_CProductions_s17 v16 {-# INLINE rule14 #-} rule14 = \ (_ :: ()) -> [] {-# INLINE rule15 #-} rule15 = \ _self -> _self -- CRule ------------------------------------------------------- -- wrapper data Inh_CRule = Inh_CRule { } data Syn_CRule = Syn_CRule { self_Syn_CRule :: (CRule) } {-# INLINABLE wrap_CRule #-} wrap_CRule :: T_CRule -> Inh_CRule -> (Syn_CRule ) wrap_CRule (T_CRule act) (Inh_CRule ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg19 = T_CRule_vIn19 (T_CRule_vOut19 _lhsOself) <- return (inv_CRule_s20 sem arg19) return (Syn_CRule _lhsOself) ) -- cata {-# NOINLINE sem_CRule #-} sem_CRule :: CRule -> T_CRule sem_CRule ( CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ pattern_ rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ ) = sem_CRule_CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ ( sem_Pattern pattern_ ) rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ sem_CRule ( CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ ) = sem_CRule_CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ -- semantic domain newtype T_CRule = T_CRule { attach_T_CRule :: Identity (T_CRule_s20 ) } newtype T_CRule_s20 = C_CRule_s20 { inv_CRule_s20 :: (T_CRule_v19 ) } data T_CRule_s21 = C_CRule_s21 type T_CRule_v19 = (T_CRule_vIn19 ) -> (T_CRule_vOut19 ) data T_CRule_vIn19 = T_CRule_vIn19 data T_CRule_vOut19 = T_CRule_vOut19 (CRule) {-# NOINLINE sem_CRule_CRule #-} sem_CRule_CRule :: (Identifier) -> (Bool) -> (Bool) -> (NontermIdent) -> (ConstructorIdent) -> (Identifier) -> (Maybe NontermIdent) -> (Maybe Type) -> T_Pattern -> ([String]) -> (Map Int (Identifier,Identifier,Maybe Type)) -> (Bool) -> (String) -> (Set (Identifier, Identifier)) -> (Bool) -> (Maybe Identifier) -> T_CRule sem_CRule_CRule arg_name_ arg_isIn_ arg_hasCode_ arg_nt_ arg_con_ arg_field_ arg_childnt_ arg_tp_ arg_pattern_ arg_rhs_ arg_defines_ arg_owrt_ arg_origin_ arg_uses_ arg_explicit_ arg_mbNamed_ = T_CRule (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_CRule_v19 v19 = \ (T_CRule_vIn19 ) -> ( let _patternX77 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) (T_Pattern_vOut76 _patternIafs _patternIcopy _patternIself) = inv_Pattern_s77 _patternX77 (T_Pattern_vIn76 ) _self = rule16 _patternIself arg_childnt_ arg_con_ arg_defines_ arg_explicit_ arg_field_ arg_hasCode_ arg_isIn_ arg_mbNamed_ arg_name_ arg_nt_ arg_origin_ arg_owrt_ arg_rhs_ arg_tp_ arg_uses_ _lhsOself :: CRule _lhsOself = rule17 _self __result_ = T_CRule_vOut19 _lhsOself in __result_ ) in C_CRule_s20 v19 {-# INLINE rule16 #-} rule16 = \ ((_patternIself) :: Pattern) childnt_ con_ defines_ explicit_ field_ hasCode_ isIn_ mbNamed_ name_ nt_ origin_ owrt_ rhs_ tp_ uses_ -> CRule name_ isIn_ hasCode_ nt_ con_ field_ childnt_ tp_ _patternIself rhs_ defines_ owrt_ origin_ uses_ explicit_ mbNamed_ {-# INLINE rule17 #-} rule17 = \ _self -> _self {-# NOINLINE sem_CRule_CChildVisit #-} sem_CRule_CChildVisit :: (Identifier) -> (NontermIdent) -> (Int) -> (Attributes) -> (Attributes) -> (Bool) -> T_CRule sem_CRule_CChildVisit arg_name_ arg_nt_ arg_nr_ arg_inh_ arg_syn_ arg_isLast_ = T_CRule (return st20) where {-# NOINLINE st20 #-} st20 = let v19 :: T_CRule_v19 v19 = \ (T_CRule_vIn19 ) -> ( let _self = rule18 arg_inh_ arg_isLast_ arg_name_ arg_nr_ arg_nt_ arg_syn_ _lhsOself :: CRule _lhsOself = rule19 _self __result_ = T_CRule_vOut19 _lhsOself in __result_ ) in C_CRule_s20 v19 {-# INLINE rule18 #-} rule18 = \ inh_ isLast_ name_ nr_ nt_ syn_ -> CChildVisit name_ nt_ nr_ inh_ syn_ isLast_ {-# INLINE rule19 #-} rule19 = \ _self -> _self -- CSegment ---------------------------------------------------- -- wrapper data Inh_CSegment = Inh_CSegment { } data Syn_CSegment = Syn_CSegment { self_Syn_CSegment :: (CSegment) } {-# INLINABLE wrap_CSegment #-} wrap_CSegment :: T_CSegment -> Inh_CSegment -> (Syn_CSegment ) wrap_CSegment (T_CSegment act) (Inh_CSegment ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg22 = T_CSegment_vIn22 (T_CSegment_vOut22 _lhsOself) <- return (inv_CSegment_s23 sem arg22) return (Syn_CSegment _lhsOself) ) -- cata {-# INLINE sem_CSegment #-} sem_CSegment :: CSegment -> T_CSegment sem_CSegment ( CSegment inh_ syn_ ) = sem_CSegment_CSegment inh_ syn_ -- semantic domain newtype T_CSegment = T_CSegment { attach_T_CSegment :: Identity (T_CSegment_s23 ) } newtype T_CSegment_s23 = C_CSegment_s23 { inv_CSegment_s23 :: (T_CSegment_v22 ) } data T_CSegment_s24 = C_CSegment_s24 type T_CSegment_v22 = (T_CSegment_vIn22 ) -> (T_CSegment_vOut22 ) data T_CSegment_vIn22 = T_CSegment_vIn22 data T_CSegment_vOut22 = T_CSegment_vOut22 (CSegment) {-# NOINLINE sem_CSegment_CSegment #-} sem_CSegment_CSegment :: (Attributes) -> (Attributes) -> T_CSegment sem_CSegment_CSegment arg_inh_ arg_syn_ = T_CSegment (return st23) where {-# NOINLINE st23 #-} st23 = let v22 :: T_CSegment_v22 v22 = \ (T_CSegment_vIn22 ) -> ( let _self = rule20 arg_inh_ arg_syn_ _lhsOself :: CSegment _lhsOself = rule21 _self __result_ = T_CSegment_vOut22 _lhsOself in __result_ ) in C_CSegment_s23 v22 {-# INLINE rule20 #-} rule20 = \ inh_ syn_ -> CSegment inh_ syn_ {-# INLINE rule21 #-} rule21 = \ _self -> _self -- CSegments --------------------------------------------------- -- wrapper data Inh_CSegments = Inh_CSegments { } data Syn_CSegments = Syn_CSegments { self_Syn_CSegments :: (CSegments) } {-# INLINABLE wrap_CSegments #-} wrap_CSegments :: T_CSegments -> Inh_CSegments -> (Syn_CSegments ) wrap_CSegments (T_CSegments act) (Inh_CSegments ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg25 = T_CSegments_vIn25 (T_CSegments_vOut25 _lhsOself) <- return (inv_CSegments_s26 sem arg25) return (Syn_CSegments _lhsOself) ) -- cata {-# NOINLINE sem_CSegments #-} sem_CSegments :: CSegments -> T_CSegments sem_CSegments list = Prelude.foldr sem_CSegments_Cons sem_CSegments_Nil (Prelude.map sem_CSegment list) -- semantic domain newtype T_CSegments = T_CSegments { attach_T_CSegments :: Identity (T_CSegments_s26 ) } newtype T_CSegments_s26 = C_CSegments_s26 { inv_CSegments_s26 :: (T_CSegments_v25 ) } data T_CSegments_s27 = C_CSegments_s27 type T_CSegments_v25 = (T_CSegments_vIn25 ) -> (T_CSegments_vOut25 ) data T_CSegments_vIn25 = T_CSegments_vIn25 data T_CSegments_vOut25 = T_CSegments_vOut25 (CSegments) {-# NOINLINE sem_CSegments_Cons #-} sem_CSegments_Cons :: T_CSegment -> T_CSegments -> T_CSegments sem_CSegments_Cons arg_hd_ arg_tl_ = T_CSegments (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_CSegments_v25 v25 = \ (T_CSegments_vIn25 ) -> ( let _hdX23 = Control.Monad.Identity.runIdentity (attach_T_CSegment (arg_hd_)) _tlX26 = Control.Monad.Identity.runIdentity (attach_T_CSegments (arg_tl_)) (T_CSegment_vOut22 _hdIself) = inv_CSegment_s23 _hdX23 (T_CSegment_vIn22 ) (T_CSegments_vOut25 _tlIself) = inv_CSegments_s26 _tlX26 (T_CSegments_vIn25 ) _self = rule22 _hdIself _tlIself _lhsOself :: CSegments _lhsOself = rule23 _self __result_ = T_CSegments_vOut25 _lhsOself in __result_ ) in C_CSegments_s26 v25 {-# INLINE rule22 #-} rule22 = \ ((_hdIself) :: CSegment) ((_tlIself) :: CSegments) -> (:) _hdIself _tlIself {-# INLINE rule23 #-} rule23 = \ _self -> _self {-# NOINLINE sem_CSegments_Nil #-} sem_CSegments_Nil :: T_CSegments sem_CSegments_Nil = T_CSegments (return st26) where {-# NOINLINE st26 #-} st26 = let v25 :: T_CSegments_v25 v25 = \ (T_CSegments_vIn25 ) -> ( let _self = rule24 () _lhsOself :: CSegments _lhsOself = rule25 _self __result_ = T_CSegments_vOut25 _lhsOself in __result_ ) in C_CSegments_s26 v25 {-# INLINE rule24 #-} rule24 = \ (_ :: ()) -> [] {-# INLINE rule25 #-} rule25 = \ _self -> _self -- CVisit ------------------------------------------------------ -- wrapper data Inh_CVisit = Inh_CVisit { } data Syn_CVisit = Syn_CVisit { self_Syn_CVisit :: (CVisit) } {-# INLINABLE wrap_CVisit #-} wrap_CVisit :: T_CVisit -> Inh_CVisit -> (Syn_CVisit ) wrap_CVisit (T_CVisit act) (Inh_CVisit ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg28 = T_CVisit_vIn28 (T_CVisit_vOut28 _lhsOself) <- return (inv_CVisit_s29 sem arg28) return (Syn_CVisit _lhsOself) ) -- cata {-# INLINE sem_CVisit #-} sem_CVisit :: CVisit -> T_CVisit sem_CVisit ( CVisit inh_ syn_ vss_ intra_ ordered_ ) = sem_CVisit_CVisit inh_ syn_ ( sem_Sequence vss_ ) ( sem_Sequence intra_ ) ordered_ -- semantic domain newtype T_CVisit = T_CVisit { attach_T_CVisit :: Identity (T_CVisit_s29 ) } newtype T_CVisit_s29 = C_CVisit_s29 { inv_CVisit_s29 :: (T_CVisit_v28 ) } data T_CVisit_s30 = C_CVisit_s30 type T_CVisit_v28 = (T_CVisit_vIn28 ) -> (T_CVisit_vOut28 ) data T_CVisit_vIn28 = T_CVisit_vIn28 data T_CVisit_vOut28 = T_CVisit_vOut28 (CVisit) {-# NOINLINE sem_CVisit_CVisit #-} sem_CVisit_CVisit :: (Attributes) -> (Attributes) -> T_Sequence -> T_Sequence -> (Bool) -> T_CVisit sem_CVisit_CVisit arg_inh_ arg_syn_ arg_vss_ arg_intra_ arg_ordered_ = T_CVisit (return st29) where {-# NOINLINE st29 #-} st29 = let v28 :: T_CVisit_v28 v28 = \ (T_CVisit_vIn28 ) -> ( let _vssX95 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_vss_)) _intraX95 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_intra_)) (T_Sequence_vOut94 _vssIself) = inv_Sequence_s95 _vssX95 (T_Sequence_vIn94 ) (T_Sequence_vOut94 _intraIself) = inv_Sequence_s95 _intraX95 (T_Sequence_vIn94 ) _self = rule26 _intraIself _vssIself arg_inh_ arg_ordered_ arg_syn_ _lhsOself :: CVisit _lhsOself = rule27 _self __result_ = T_CVisit_vOut28 _lhsOself in __result_ ) in C_CVisit_s29 v28 {-# INLINE rule26 #-} rule26 = \ ((_intraIself) :: Sequence) ((_vssIself) :: Sequence) inh_ ordered_ syn_ -> CVisit inh_ syn_ _vssIself _intraIself ordered_ {-# INLINE rule27 #-} rule27 = \ _self -> _self -- CVisits ----------------------------------------------------- -- wrapper data Inh_CVisits = Inh_CVisits { } data Syn_CVisits = Syn_CVisits { self_Syn_CVisits :: (CVisits) } {-# INLINABLE wrap_CVisits #-} wrap_CVisits :: T_CVisits -> Inh_CVisits -> (Syn_CVisits ) wrap_CVisits (T_CVisits act) (Inh_CVisits ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg31 = T_CVisits_vIn31 (T_CVisits_vOut31 _lhsOself) <- return (inv_CVisits_s32 sem arg31) return (Syn_CVisits _lhsOself) ) -- cata {-# NOINLINE sem_CVisits #-} sem_CVisits :: CVisits -> T_CVisits sem_CVisits list = Prelude.foldr sem_CVisits_Cons sem_CVisits_Nil (Prelude.map sem_CVisit list) -- semantic domain newtype T_CVisits = T_CVisits { attach_T_CVisits :: Identity (T_CVisits_s32 ) } newtype T_CVisits_s32 = C_CVisits_s32 { inv_CVisits_s32 :: (T_CVisits_v31 ) } data T_CVisits_s33 = C_CVisits_s33 type T_CVisits_v31 = (T_CVisits_vIn31 ) -> (T_CVisits_vOut31 ) data T_CVisits_vIn31 = T_CVisits_vIn31 data T_CVisits_vOut31 = T_CVisits_vOut31 (CVisits) {-# NOINLINE sem_CVisits_Cons #-} sem_CVisits_Cons :: T_CVisit -> T_CVisits -> T_CVisits sem_CVisits_Cons arg_hd_ arg_tl_ = T_CVisits (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_CVisits_v31 v31 = \ (T_CVisits_vIn31 ) -> ( let _hdX29 = Control.Monad.Identity.runIdentity (attach_T_CVisit (arg_hd_)) _tlX32 = Control.Monad.Identity.runIdentity (attach_T_CVisits (arg_tl_)) (T_CVisit_vOut28 _hdIself) = inv_CVisit_s29 _hdX29 (T_CVisit_vIn28 ) (T_CVisits_vOut31 _tlIself) = inv_CVisits_s32 _tlX32 (T_CVisits_vIn31 ) _self = rule28 _hdIself _tlIself _lhsOself :: CVisits _lhsOself = rule29 _self __result_ = T_CVisits_vOut31 _lhsOself in __result_ ) in C_CVisits_s32 v31 {-# INLINE rule28 #-} rule28 = \ ((_hdIself) :: CVisit) ((_tlIself) :: CVisits) -> (:) _hdIself _tlIself {-# INLINE rule29 #-} rule29 = \ _self -> _self {-# NOINLINE sem_CVisits_Nil #-} sem_CVisits_Nil :: T_CVisits sem_CVisits_Nil = T_CVisits (return st32) where {-# NOINLINE st32 #-} st32 = let v31 :: T_CVisits_v31 v31 = \ (T_CVisits_vIn31 ) -> ( let _self = rule30 () _lhsOself :: CVisits _lhsOself = rule31 _self __result_ = T_CVisits_vOut31 _lhsOself in __result_ ) in C_CVisits_s32 v31 {-# INLINE rule30 #-} rule30 = \ (_ :: ()) -> [] {-# INLINE rule31 #-} rule31 = \ _self -> _self -- Child ------------------------------------------------------- -- wrapper data Inh_Child = Inh_Child { ain_Inh_Child :: (MyType -> MyAttributes), an_Inh_Child :: (MyType -> MyAttributes), aroundMap_Inh_Child :: (Map Identifier [Expression]), asn_Inh_Child :: (MyType -> MyAttributes), flab_Inh_Child :: (Int), fty_Inh_Child :: (FTY), hoMapf_Inh_Child :: (HOMap), lfpf_Inh_Child :: (SF_P), mergeMap_Inh_Child :: (Map Identifier (Identifier, [Identifier], Expression)), mergedChildren_Inh_Child :: (Set Identifier), nmp_Inh_Child :: (NMP), nmprf_Inh_Child :: (NMP_R), olab_Inh_Child :: (Int), options_Inh_Child :: (Options), pll_Inh_Child :: (PLabel), pmpf_Inh_Child :: (PMP), pmprf_Inh_Child :: (PMP_R) } data Syn_Child = Syn_Child { ap_Syn_Child :: (A_P), echilds_Syn_Child :: (EChild), fieldMap_Syn_Child :: (FMap), flab_Syn_Child :: (Int), fty_Syn_Child :: (FTY), gen_Syn_Child :: (Map Int Int), hoMap_Syn_Child :: (HOMap), inss_Syn_Child :: (Map Int [Int]), ofld_Syn_Child :: ([(Int, Int)]), olab_Syn_Child :: (Int), pmp_Syn_Child :: (PMP), pmpr_Syn_Child :: (PMP_R), pts_Syn_Child :: (Set.Set FLabel), refHoNts_Syn_Child :: (Set NontermIdent), refNts_Syn_Child :: (Set NontermIdent), self_Syn_Child :: (Child) } {-# INLINABLE wrap_Child #-} wrap_Child :: T_Child -> Inh_Child -> (Syn_Child ) wrap_Child (T_Child act) (Inh_Child _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIflab _lhsIfty _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsImergedChildren _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpll _lhsIpmpf _lhsIpmprf) = Control.Monad.Identity.runIdentity ( do sem <- act let arg34 = T_Child_vIn34 _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIflab _lhsIfty _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsImergedChildren _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpll _lhsIpmpf _lhsIpmprf (T_Child_vOut34 _lhsOap _lhsOechilds _lhsOfieldMap _lhsOflab _lhsOfty _lhsOgen _lhsOhoMap _lhsOinss _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOpts _lhsOrefHoNts _lhsOrefNts _lhsOself) <- return (inv_Child_s35 sem arg34) return (Syn_Child _lhsOap _lhsOechilds _lhsOfieldMap _lhsOflab _lhsOfty _lhsOgen _lhsOhoMap _lhsOinss _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOpts _lhsOrefHoNts _lhsOrefNts _lhsOself) ) -- cata {-# INLINE sem_Child #-} sem_Child :: Child -> T_Child sem_Child ( Child name_ tp_ kind_ ) = sem_Child_Child name_ tp_ kind_ -- semantic domain newtype T_Child = T_Child { attach_T_Child :: Identity (T_Child_s35 ) } newtype T_Child_s35 = C_Child_s35 { inv_Child_s35 :: (T_Child_v34 ) } data T_Child_s36 = C_Child_s36 type T_Child_v34 = (T_Child_vIn34 ) -> (T_Child_vOut34 ) data T_Child_vIn34 = T_Child_vIn34 (MyType -> MyAttributes) (MyType -> MyAttributes) (Map Identifier [Expression]) (MyType -> MyAttributes) (Int) (FTY) (HOMap) (SF_P) (Map Identifier (Identifier, [Identifier], Expression)) (Set Identifier) (NMP) (NMP_R) (Int) (Options) (PLabel) (PMP) (PMP_R) data T_Child_vOut34 = T_Child_vOut34 (A_P) (EChild) (FMap) (Int) (FTY) (Map Int Int) (HOMap) (Map Int [Int]) ([(Int, Int)]) (Int) (PMP) (PMP_R) (Set.Set FLabel) (Set NontermIdent) (Set NontermIdent) (Child) {-# NOINLINE sem_Child_Child #-} sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child sem_Child_Child arg_name_ arg_tp_ arg_kind_ = T_Child (return st35) where {-# NOINLINE st35 #-} st35 = let v34 :: T_Child_v34 v34 = \ (T_Child_vIn34 _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIflab _lhsIfty _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsImergedChildren _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpll _lhsIpmpf _lhsIpmprf) -> ( let _fattsX47 = Control.Monad.Identity.runIdentity (attach_T_FieldAtts ((sem_FieldAtts fatts_val_))) (T_FieldAtts_vOut46 _fattsIap _fattsIflab _fattsIfty _fattsIgen _fattsIinss _fattsIofld _fattsIolab _fattsIpmp _fattsIpmpr _fattsIself) = inv_FieldAtts_s47 _fattsX47 (T_FieldAtts_vIn46 _fattsOan _fattsOflab _fattsOnmprf _fattsOolab) _refNts = rule32 arg_tp_ _refHoNts = rule33 _isHigherOrder _refNts _isHigherOrder = rule34 arg_kind_ _hasArounds = rule35 _lhsIaroundMap arg_name_ _merges = rule36 _lhsImergeMap arg_name_ _isMerged = rule37 _lhsImergedChildren arg_name_ _lhsOechilds :: EChild _lhsOechilds = rule38 _hasArounds _isMerged _merges arg_kind_ arg_name_ arg_tp_ _flab = rule39 _lhsIflab _atp = rule40 arg_tp_ fatts_val_ = rule41 _atp _lhsIan _lhsIpll arg_name_ _fattsOflab = rule42 _flab _ident = rule43 arg_name_ _label = rule44 _ident _lhsIpll _foccsI = rule45 _atp _label _lhsIain _foccsS = rule46 _atp _label _lhsIasn _fieldMap = rule47 _foccsI _foccsS _label _hoMap = rule48 _ident _lhsIpll arg_kind_ _lhsOfty :: FTY _lhsOfty = rule49 _atp _lhsIpll arg_name_ _lhsOpts :: Set.Set FLabel _lhsOpts = rule50 arg_name_ _lhsOap :: A_P _lhsOap = rule51 _fattsIap _lhsOfieldMap :: FMap _lhsOfieldMap = rule52 _fieldMap _lhsOgen :: Map Int Int _lhsOgen = rule53 _fattsIgen _lhsOhoMap :: HOMap _lhsOhoMap = rule54 _hoMap _lhsOinss :: Map Int [Int] _lhsOinss = rule55 _fattsIinss _lhsOofld :: [(Int, Int)] _lhsOofld = rule56 _fattsIofld _lhsOpmp :: PMP _lhsOpmp = rule57 _fattsIpmp _lhsOpmpr :: PMP_R _lhsOpmpr = rule58 _fattsIpmpr _lhsOrefHoNts :: Set NontermIdent _lhsOrefHoNts = rule59 _refHoNts _lhsOrefNts :: Set NontermIdent _lhsOrefNts = rule60 _refNts _self = rule61 arg_kind_ arg_name_ arg_tp_ _lhsOself :: Child _lhsOself = rule62 _self _lhsOflab :: Int _lhsOflab = rule63 _flab _lhsOolab :: Int _lhsOolab = rule64 _fattsIolab _fattsOan = rule65 _lhsIan _fattsOnmprf = rule66 _lhsInmprf _fattsOolab = rule67 _lhsIolab __result_ = T_Child_vOut34 _lhsOap _lhsOechilds _lhsOfieldMap _lhsOflab _lhsOfty _lhsOgen _lhsOhoMap _lhsOinss _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOpts _lhsOrefHoNts _lhsOrefNts _lhsOself in __result_ ) in C_Child_s35 v34 {-# INLINE rule32 #-} {-# LINE 31 "src-ag/ExecutionPlanCommon.ag" #-} rule32 = \ tp_ -> {-# LINE 31 "src-ag/ExecutionPlanCommon.ag" #-} case tp_ of NT nt _ _ -> Set.singleton nt _ -> mempty {-# LINE 1097 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule33 #-} {-# LINE 34 "src-ag/ExecutionPlanCommon.ag" #-} rule33 = \ _isHigherOrder _refNts -> {-# LINE 34 "src-ag/ExecutionPlanCommon.ag" #-} if _isHigherOrder then _refNts else mempty {-# LINE 1103 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule34 #-} {-# LINE 35 "src-ag/ExecutionPlanCommon.ag" #-} rule34 = \ kind_ -> {-# LINE 35 "src-ag/ExecutionPlanCommon.ag" #-} case kind_ of ChildSyntax -> False _ -> True {-# LINE 1111 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule35 #-} {-# LINE 95 "src-ag/ExecutionPlanCommon.ag" #-} rule35 = \ ((_lhsIaroundMap) :: Map Identifier [Expression]) name_ -> {-# LINE 95 "src-ag/ExecutionPlanCommon.ag" #-} case Map.lookup name_ _lhsIaroundMap of Nothing -> False Just as -> not (null as) {-# LINE 1119 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule36 #-} {-# LINE 123 "src-ag/ExecutionPlanCommon.ag" #-} rule36 = \ ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier], Expression)) name_ -> {-# LINE 123 "src-ag/ExecutionPlanCommon.ag" #-} maybe Nothing (\(_,ms,_) -> Just ms) $ Map.lookup name_ _lhsImergeMap {-# LINE 1125 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule37 #-} {-# LINE 124 "src-ag/ExecutionPlanCommon.ag" #-} rule37 = \ ((_lhsImergedChildren) :: Set Identifier) name_ -> {-# LINE 124 "src-ag/ExecutionPlanCommon.ag" #-} name_ `Set.member` _lhsImergedChildren {-# LINE 1131 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule38 #-} {-# LINE 135 "src-ag/ExecutionPlanCommon.ag" #-} rule38 = \ _hasArounds _isMerged _merges kind_ name_ tp_ -> {-# LINE 135 "src-ag/ExecutionPlanCommon.ag" #-} case tp_ of NT _ _ _ -> EChild name_ tp_ kind_ _hasArounds _merges _isMerged _ -> ETerm name_ tp_ {-# LINE 1139 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule39 #-} {-# LINE 174 "src-ag/LOAG/Prepare.ag" #-} rule39 = \ ((_lhsIflab) :: Int) -> {-# LINE 174 "src-ag/LOAG/Prepare.ag" #-} _lhsIflab + 1 {-# LINE 1145 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule40 #-} {-# LINE 175 "src-ag/LOAG/Prepare.ag" #-} rule40 = \ tp_ -> {-# LINE 175 "src-ag/LOAG/Prepare.ag" #-} toMyTy tp_ {-# LINE 1151 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule41 #-} {-# LINE 177 "src-ag/LOAG/Prepare.ag" #-} rule41 = \ _atp ((_lhsIan) :: MyType -> MyAttributes) ((_lhsIpll) :: PLabel) name_ -> {-# LINE 177 "src-ag/LOAG/Prepare.ag" #-} map ((FieldAtt _atp _lhsIpll (getName name_)) . alab) $ _lhsIan _atp {-# LINE 1158 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule42 #-} {-# LINE 179 "src-ag/LOAG/Prepare.ag" #-} rule42 = \ _flab -> {-# LINE 179 "src-ag/LOAG/Prepare.ag" #-} _flab {-# LINE 1164 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule43 #-} {-# LINE 180 "src-ag/LOAG/Prepare.ag" #-} rule43 = \ name_ -> {-# LINE 180 "src-ag/LOAG/Prepare.ag" #-} getName name_ {-# LINE 1170 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule44 #-} {-# LINE 181 "src-ag/LOAG/Prepare.ag" #-} rule44 = \ _ident ((_lhsIpll) :: PLabel) -> {-# LINE 181 "src-ag/LOAG/Prepare.ag" #-} (_lhsIpll, _ident ) {-# LINE 1176 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule45 #-} {-# LINE 182 "src-ag/LOAG/Prepare.ag" #-} rule45 = \ _atp _label ((_lhsIain) :: MyType -> MyAttributes) -> {-# LINE 182 "src-ag/LOAG/Prepare.ag" #-} Set.fromList $ handAllOut _label $ _lhsIain _atp {-# LINE 1182 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule46 #-} {-# LINE 183 "src-ag/LOAG/Prepare.ag" #-} rule46 = \ _atp _label ((_lhsIasn) :: MyType -> MyAttributes) -> {-# LINE 183 "src-ag/LOAG/Prepare.ag" #-} Set.fromList $ handAllOut _label $ _lhsIasn _atp {-# LINE 1188 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule47 #-} {-# LINE 184 "src-ag/LOAG/Prepare.ag" #-} rule47 = \ _foccsI _foccsS _label -> {-# LINE 184 "src-ag/LOAG/Prepare.ag" #-} if Set.null _foccsI && Set.null _foccsS then Map.empty else Map.singleton _label (_foccsS ,_foccsI ) {-# LINE 1196 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule48 #-} {-# LINE 187 "src-ag/LOAG/Prepare.ag" #-} rule48 = \ _ident ((_lhsIpll) :: PLabel) kind_ -> {-# LINE 187 "src-ag/LOAG/Prepare.ag" #-} case kind_ of ChildAttr -> Map.singleton _lhsIpll (Set.singleton _ident ) _ -> Map.empty {-# LINE 1204 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule49 #-} {-# LINE 190 "src-ag/LOAG/Prepare.ag" #-} rule49 = \ _atp ((_lhsIpll) :: PLabel) name_ -> {-# LINE 190 "src-ag/LOAG/Prepare.ag" #-} Map.singleton (_lhsIpll, getName name_) _atp {-# LINE 1210 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule50 #-} {-# LINE 223 "src-ag/LOAG/Prepare.ag" #-} rule50 = \ name_ -> {-# LINE 223 "src-ag/LOAG/Prepare.ag" #-} Set.singleton $ getName name_ {-# LINE 1216 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule51 #-} rule51 = \ ((_fattsIap) :: A_P) -> _fattsIap {-# INLINE rule52 #-} rule52 = \ _fieldMap -> _fieldMap {-# INLINE rule53 #-} rule53 = \ ((_fattsIgen) :: Map Int Int) -> _fattsIgen {-# INLINE rule54 #-} rule54 = \ _hoMap -> _hoMap {-# INLINE rule55 #-} rule55 = \ ((_fattsIinss) :: Map Int [Int]) -> _fattsIinss {-# INLINE rule56 #-} rule56 = \ ((_fattsIofld) :: [(Int, Int)]) -> _fattsIofld {-# INLINE rule57 #-} rule57 = \ ((_fattsIpmp) :: PMP) -> _fattsIpmp {-# INLINE rule58 #-} rule58 = \ ((_fattsIpmpr) :: PMP_R) -> _fattsIpmpr {-# INLINE rule59 #-} rule59 = \ _refHoNts -> _refHoNts {-# INLINE rule60 #-} rule60 = \ _refNts -> _refNts {-# INLINE rule61 #-} rule61 = \ kind_ name_ tp_ -> Child name_ tp_ kind_ {-# INLINE rule62 #-} rule62 = \ _self -> _self {-# INLINE rule63 #-} rule63 = \ _flab -> _flab {-# INLINE rule64 #-} rule64 = \ ((_fattsIolab) :: Int) -> _fattsIolab {-# INLINE rule65 #-} rule65 = \ ((_lhsIan) :: MyType -> MyAttributes) -> _lhsIan {-# INLINE rule66 #-} rule66 = \ ((_lhsInmprf) :: NMP_R) -> _lhsInmprf {-# INLINE rule67 #-} rule67 = \ ((_lhsIolab) :: Int) -> _lhsIolab -- Children ---------------------------------------------------- -- wrapper data Inh_Children = Inh_Children { ain_Inh_Children :: (MyType -> MyAttributes), an_Inh_Children :: (MyType -> MyAttributes), aroundMap_Inh_Children :: (Map Identifier [Expression]), asn_Inh_Children :: (MyType -> MyAttributes), dty_Inh_Children :: (MyType), flab_Inh_Children :: (Int), fty_Inh_Children :: (FTY), hoMapf_Inh_Children :: (HOMap), lfpf_Inh_Children :: (SF_P), mergeMap_Inh_Children :: (Map Identifier (Identifier, [Identifier], Expression)), mergedChildren_Inh_Children :: (Set Identifier), nmp_Inh_Children :: (NMP), nmprf_Inh_Children :: (NMP_R), olab_Inh_Children :: (Int), options_Inh_Children :: (Options), pll_Inh_Children :: (PLabel), pmpf_Inh_Children :: (PMP), pmprf_Inh_Children :: (PMP_R) } data Syn_Children = Syn_Children { ap_Syn_Children :: (A_P), echilds_Syn_Children :: (EChildren), fieldMap_Syn_Children :: (FMap), flab_Syn_Children :: (Int), fty_Syn_Children :: (FTY), gen_Syn_Children :: (Map Int Int), hoMap_Syn_Children :: (HOMap), inss_Syn_Children :: (Map Int [Int]), ofld_Syn_Children :: ([(Int, Int)]), olab_Syn_Children :: (Int), pmp_Syn_Children :: (PMP), pmpr_Syn_Children :: (PMP_R), pts_Syn_Children :: (Set.Set FLabel), refHoNts_Syn_Children :: (Set NontermIdent), refNts_Syn_Children :: (Set NontermIdent), self_Syn_Children :: (Children) } {-# INLINABLE wrap_Children #-} wrap_Children :: T_Children -> Inh_Children -> (Syn_Children ) wrap_Children (T_Children act) (Inh_Children _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIdty _lhsIflab _lhsIfty _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsImergedChildren _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpll _lhsIpmpf _lhsIpmprf) = Control.Monad.Identity.runIdentity ( do sem <- act let arg37 = T_Children_vIn37 _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIdty _lhsIflab _lhsIfty _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsImergedChildren _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpll _lhsIpmpf _lhsIpmprf (T_Children_vOut37 _lhsOap _lhsOechilds _lhsOfieldMap _lhsOflab _lhsOfty _lhsOgen _lhsOhoMap _lhsOinss _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOpts _lhsOrefHoNts _lhsOrefNts _lhsOself) <- return (inv_Children_s38 sem arg37) return (Syn_Children _lhsOap _lhsOechilds _lhsOfieldMap _lhsOflab _lhsOfty _lhsOgen _lhsOhoMap _lhsOinss _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOpts _lhsOrefHoNts _lhsOrefNts _lhsOself) ) -- cata {-# NOINLINE sem_Children #-} sem_Children :: Children -> T_Children sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) -- semantic domain newtype T_Children = T_Children { attach_T_Children :: Identity (T_Children_s38 ) } newtype T_Children_s38 = C_Children_s38 { inv_Children_s38 :: (T_Children_v37 ) } data T_Children_s39 = C_Children_s39 type T_Children_v37 = (T_Children_vIn37 ) -> (T_Children_vOut37 ) data T_Children_vIn37 = T_Children_vIn37 (MyType -> MyAttributes) (MyType -> MyAttributes) (Map Identifier [Expression]) (MyType -> MyAttributes) (MyType) (Int) (FTY) (HOMap) (SF_P) (Map Identifier (Identifier, [Identifier], Expression)) (Set Identifier) (NMP) (NMP_R) (Int) (Options) (PLabel) (PMP) (PMP_R) data T_Children_vOut37 = T_Children_vOut37 (A_P) (EChildren) (FMap) (Int) (FTY) (Map Int Int) (HOMap) (Map Int [Int]) ([(Int, Int)]) (Int) (PMP) (PMP_R) (Set.Set FLabel) (Set NontermIdent) (Set NontermIdent) (Children) {-# NOINLINE sem_Children_Cons #-} sem_Children_Cons :: T_Child -> T_Children -> T_Children sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_Children_v37 v37 = \ (T_Children_vIn37 _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIdty _lhsIflab _lhsIfty _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsImergedChildren _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpll _lhsIpmpf _lhsIpmprf) -> ( let _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) (T_Child_vOut34 _hdIap _hdIechilds _hdIfieldMap _hdIflab _hdIfty _hdIgen _hdIhoMap _hdIinss _hdIofld _hdIolab _hdIpmp _hdIpmpr _hdIpts _hdIrefHoNts _hdIrefNts _hdIself) = inv_Child_s35 _hdX35 (T_Child_vIn34 _hdOain _hdOan _hdOaroundMap _hdOasn _hdOflab _hdOfty _hdOhoMapf _hdOlfpf _hdOmergeMap _hdOmergedChildren _hdOnmp _hdOnmprf _hdOolab _hdOoptions _hdOpll _hdOpmpf _hdOpmprf) (T_Children_vOut37 _tlIap _tlIechilds _tlIfieldMap _tlIflab _tlIfty _tlIgen _tlIhoMap _tlIinss _tlIofld _tlIolab _tlIpmp _tlIpmpr _tlIpts _tlIrefHoNts _tlIrefNts _tlIself) = inv_Children_s38 _tlX38 (T_Children_vIn37 _tlOain _tlOan _tlOaroundMap _tlOasn _tlOdty _tlOflab _tlOfty _tlOhoMapf _tlOlfpf _tlOmergeMap _tlOmergedChildren _tlOnmp _tlOnmprf _tlOolab _tlOoptions _tlOpll _tlOpmpf _tlOpmprf) _lhsOap :: A_P _lhsOap = rule68 _hdIap _tlIap _lhsOechilds :: EChildren _lhsOechilds = rule69 _hdIechilds _tlIechilds _lhsOfieldMap :: FMap _lhsOfieldMap = rule70 _hdIfieldMap _tlIfieldMap _lhsOfty :: FTY _lhsOfty = rule71 _hdIfty _tlIfty _lhsOgen :: Map Int Int _lhsOgen = rule72 _hdIgen _tlIgen _lhsOhoMap :: HOMap _lhsOhoMap = rule73 _hdIhoMap _tlIhoMap _lhsOinss :: Map Int [Int] _lhsOinss = rule74 _hdIinss _tlIinss _lhsOofld :: [(Int, Int)] _lhsOofld = rule75 _hdIofld _tlIofld _lhsOpmp :: PMP _lhsOpmp = rule76 _hdIpmp _tlIpmp _lhsOpmpr :: PMP_R _lhsOpmpr = rule77 _hdIpmpr _tlIpmpr _lhsOpts :: Set.Set FLabel _lhsOpts = rule78 _hdIpts _tlIpts _lhsOrefHoNts :: Set NontermIdent _lhsOrefHoNts = rule79 _hdIrefHoNts _tlIrefHoNts _lhsOrefNts :: Set NontermIdent _lhsOrefNts = rule80 _hdIrefNts _tlIrefNts _self = rule81 _hdIself _tlIself _lhsOself :: Children _lhsOself = rule82 _self _lhsOflab :: Int _lhsOflab = rule83 _tlIflab _lhsOolab :: Int _lhsOolab = rule84 _tlIolab _hdOain = rule85 _lhsIain _hdOan = rule86 _lhsIan _hdOaroundMap = rule87 _lhsIaroundMap _hdOasn = rule88 _lhsIasn _hdOflab = rule89 _lhsIflab _hdOfty = rule90 _lhsIfty _hdOhoMapf = rule91 _lhsIhoMapf _hdOlfpf = rule92 _lhsIlfpf _hdOmergeMap = rule93 _lhsImergeMap _hdOmergedChildren = rule94 _lhsImergedChildren _hdOnmp = rule95 _lhsInmp _hdOnmprf = rule96 _lhsInmprf _hdOolab = rule97 _lhsIolab _hdOoptions = rule98 _lhsIoptions _hdOpll = rule99 _lhsIpll _hdOpmpf = rule100 _lhsIpmpf _hdOpmprf = rule101 _lhsIpmprf _tlOain = rule102 _lhsIain _tlOan = rule103 _lhsIan _tlOaroundMap = rule104 _lhsIaroundMap _tlOasn = rule105 _lhsIasn _tlOdty = rule106 _lhsIdty _tlOflab = rule107 _hdIflab _tlOfty = rule108 _hdIfty _tlOhoMapf = rule109 _lhsIhoMapf _tlOlfpf = rule110 _lhsIlfpf _tlOmergeMap = rule111 _lhsImergeMap _tlOmergedChildren = rule112 _lhsImergedChildren _tlOnmp = rule113 _lhsInmp _tlOnmprf = rule114 _lhsInmprf _tlOolab = rule115 _hdIolab _tlOoptions = rule116 _lhsIoptions _tlOpll = rule117 _lhsIpll _tlOpmpf = rule118 _lhsIpmpf _tlOpmprf = rule119 _lhsIpmprf __result_ = T_Children_vOut37 _lhsOap _lhsOechilds _lhsOfieldMap _lhsOflab _lhsOfty _lhsOgen _lhsOhoMap _lhsOinss _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOpts _lhsOrefHoNts _lhsOrefNts _lhsOself in __result_ ) in C_Children_s38 v37 {-# INLINE rule68 #-} rule68 = \ ((_hdIap) :: A_P) ((_tlIap) :: A_P) -> (Map.unionWith (++) _hdIap _tlIap) {-# INLINE rule69 #-} rule69 = \ ((_hdIechilds) :: EChild) ((_tlIechilds) :: EChildren) -> _hdIechilds : _tlIechilds {-# INLINE rule70 #-} rule70 = \ ((_hdIfieldMap) :: FMap) ((_tlIfieldMap) :: FMap) -> (Map.union _hdIfieldMap _tlIfieldMap) {-# INLINE rule71 #-} rule71 = \ ((_hdIfty) :: FTY) ((_tlIfty) :: FTY) -> (Map.union _hdIfty _tlIfty) {-# INLINE rule72 #-} rule72 = \ ((_hdIgen) :: Map Int Int) ((_tlIgen) :: Map Int Int) -> (Map.union _hdIgen _tlIgen) {-# INLINE rule73 #-} rule73 = \ ((_hdIhoMap) :: HOMap) ((_tlIhoMap) :: HOMap) -> (Map.unionWith (Set.union) _hdIhoMap _tlIhoMap) {-# INLINE rule74 #-} rule74 = \ ((_hdIinss) :: Map Int [Int]) ((_tlIinss) :: Map Int [Int]) -> (Map.unionWith (++) _hdIinss _tlIinss) {-# INLINE rule75 #-} rule75 = \ ((_hdIofld) :: [(Int, Int)]) ((_tlIofld) :: [(Int, Int)]) -> ((++) _hdIofld _tlIofld) {-# INLINE rule76 #-} rule76 = \ ((_hdIpmp) :: PMP) ((_tlIpmp) :: PMP) -> (Map.union _hdIpmp _tlIpmp) {-# INLINE rule77 #-} rule77 = \ ((_hdIpmpr) :: PMP_R) ((_tlIpmpr) :: PMP_R) -> (Map.union _hdIpmpr _tlIpmpr) {-# INLINE rule78 #-} rule78 = \ ((_hdIpts) :: Set.Set FLabel) ((_tlIpts) :: Set.Set FLabel) -> (Set.union _hdIpts _tlIpts) {-# INLINE rule79 #-} rule79 = \ ((_hdIrefHoNts) :: Set NontermIdent) ((_tlIrefHoNts) :: Set NontermIdent) -> _hdIrefHoNts `mappend` _tlIrefHoNts {-# INLINE rule80 #-} rule80 = \ ((_hdIrefNts) :: Set NontermIdent) ((_tlIrefNts) :: Set NontermIdent) -> _hdIrefNts `mappend` _tlIrefNts {-# INLINE rule81 #-} rule81 = \ ((_hdIself) :: Child) ((_tlIself) :: Children) -> (:) _hdIself _tlIself {-# INLINE rule82 #-} rule82 = \ _self -> _self {-# INLINE rule83 #-} rule83 = \ ((_tlIflab) :: Int) -> _tlIflab {-# INLINE rule84 #-} rule84 = \ ((_tlIolab) :: Int) -> _tlIolab {-# INLINE rule85 #-} rule85 = \ ((_lhsIain) :: MyType -> MyAttributes) -> _lhsIain {-# INLINE rule86 #-} rule86 = \ ((_lhsIan) :: MyType -> MyAttributes) -> _lhsIan {-# INLINE rule87 #-} rule87 = \ ((_lhsIaroundMap) :: Map Identifier [Expression]) -> _lhsIaroundMap {-# INLINE rule88 #-} rule88 = \ ((_lhsIasn) :: MyType -> MyAttributes) -> _lhsIasn {-# INLINE rule89 #-} rule89 = \ ((_lhsIflab) :: Int) -> _lhsIflab {-# INLINE rule90 #-} rule90 = \ ((_lhsIfty) :: FTY) -> _lhsIfty {-# INLINE rule91 #-} rule91 = \ ((_lhsIhoMapf) :: HOMap) -> _lhsIhoMapf {-# INLINE rule92 #-} rule92 = \ ((_lhsIlfpf) :: SF_P) -> _lhsIlfpf {-# INLINE rule93 #-} rule93 = \ ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier], Expression)) -> _lhsImergeMap {-# INLINE rule94 #-} rule94 = \ ((_lhsImergedChildren) :: Set Identifier) -> _lhsImergedChildren {-# INLINE rule95 #-} rule95 = \ ((_lhsInmp) :: NMP) -> _lhsInmp {-# INLINE rule96 #-} rule96 = \ ((_lhsInmprf) :: NMP_R) -> _lhsInmprf {-# INLINE rule97 #-} rule97 = \ ((_lhsIolab) :: Int) -> _lhsIolab {-# INLINE rule98 #-} rule98 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule99 #-} rule99 = \ ((_lhsIpll) :: PLabel) -> _lhsIpll {-# INLINE rule100 #-} rule100 = \ ((_lhsIpmpf) :: PMP) -> _lhsIpmpf {-# INLINE rule101 #-} rule101 = \ ((_lhsIpmprf) :: PMP_R) -> _lhsIpmprf {-# INLINE rule102 #-} rule102 = \ ((_lhsIain) :: MyType -> MyAttributes) -> _lhsIain {-# INLINE rule103 #-} rule103 = \ ((_lhsIan) :: MyType -> MyAttributes) -> _lhsIan {-# INLINE rule104 #-} rule104 = \ ((_lhsIaroundMap) :: Map Identifier [Expression]) -> _lhsIaroundMap {-# INLINE rule105 #-} rule105 = \ ((_lhsIasn) :: MyType -> MyAttributes) -> _lhsIasn {-# INLINE rule106 #-} rule106 = \ ((_lhsIdty) :: MyType) -> _lhsIdty {-# INLINE rule107 #-} rule107 = \ ((_hdIflab) :: Int) -> _hdIflab {-# INLINE rule108 #-} rule108 = \ ((_hdIfty) :: FTY) -> _hdIfty {-# INLINE rule109 #-} rule109 = \ ((_lhsIhoMapf) :: HOMap) -> _lhsIhoMapf {-# INLINE rule110 #-} rule110 = \ ((_lhsIlfpf) :: SF_P) -> _lhsIlfpf {-# INLINE rule111 #-} rule111 = \ ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier], Expression)) -> _lhsImergeMap {-# INLINE rule112 #-} rule112 = \ ((_lhsImergedChildren) :: Set Identifier) -> _lhsImergedChildren {-# INLINE rule113 #-} rule113 = \ ((_lhsInmp) :: NMP) -> _lhsInmp {-# INLINE rule114 #-} rule114 = \ ((_lhsInmprf) :: NMP_R) -> _lhsInmprf {-# INLINE rule115 #-} rule115 = \ ((_hdIolab) :: Int) -> _hdIolab {-# INLINE rule116 #-} rule116 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule117 #-} rule117 = \ ((_lhsIpll) :: PLabel) -> _lhsIpll {-# INLINE rule118 #-} rule118 = \ ((_lhsIpmpf) :: PMP) -> _lhsIpmpf {-# INLINE rule119 #-} rule119 = \ ((_lhsIpmprf) :: PMP_R) -> _lhsIpmprf {-# NOINLINE sem_Children_Nil #-} sem_Children_Nil :: T_Children sem_Children_Nil = T_Children (return st38) where {-# NOINLINE st38 #-} st38 = let v37 :: T_Children_v37 v37 = \ (T_Children_vIn37 _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIdty _lhsIflab _lhsIfty _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsImergedChildren _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpll _lhsIpmpf _lhsIpmprf) -> ( let _fattsX47 = Control.Monad.Identity.runIdentity (attach_T_FieldAtts ((sem_FieldAtts fatts_val_))) (T_FieldAtts_vOut46 _fattsIap _fattsIflab _fattsIfty _fattsIgen _fattsIinss _fattsIofld _fattsIolab _fattsIpmp _fattsIpmpr _fattsIself) = inv_FieldAtts_s47 _fattsX47 (T_FieldAtts_vIn46 _fattsOan _fattsOflab _fattsOnmprf _fattsOolab) _flab = rule120 _lhsIflab _atp = rule121 _lhsIpll fatts_val_ = rule122 _atp _lhsIan _lhsIpll _fattsOflab = rule123 _flab _label = rule124 _lhsIpll _foccsI = rule125 _atp _label _lhsIain _foccsS = rule126 _atp _label _lhsIasn _fieldMap = rule127 _foccsI _foccsS _label _lhsOfty :: FTY _lhsOfty = rule128 _label _lhsIdty _lhsOap :: A_P _lhsOap = rule129 _fattsIap _lhsOechilds :: EChildren _lhsOechilds = rule130 () _lhsOfieldMap :: FMap _lhsOfieldMap = rule131 _fieldMap _lhsOgen :: Map Int Int _lhsOgen = rule132 _fattsIgen _lhsOhoMap :: HOMap _lhsOhoMap = rule133 () _lhsOinss :: Map Int [Int] _lhsOinss = rule134 _fattsIinss _lhsOofld :: [(Int, Int)] _lhsOofld = rule135 _fattsIofld _lhsOpmp :: PMP _lhsOpmp = rule136 _fattsIpmp _lhsOpmpr :: PMP_R _lhsOpmpr = rule137 _fattsIpmpr _lhsOpts :: Set.Set FLabel _lhsOpts = rule138 () _lhsOrefHoNts :: Set NontermIdent _lhsOrefHoNts = rule139 () _lhsOrefNts :: Set NontermIdent _lhsOrefNts = rule140 () _self = rule141 () _lhsOself :: Children _lhsOself = rule142 _self _lhsOflab :: Int _lhsOflab = rule143 _flab _lhsOolab :: Int _lhsOolab = rule144 _fattsIolab _fattsOan = rule145 _lhsIan _fattsOnmprf = rule146 _lhsInmprf _fattsOolab = rule147 _lhsIolab __result_ = T_Children_vOut37 _lhsOap _lhsOechilds _lhsOfieldMap _lhsOflab _lhsOfty _lhsOgen _lhsOhoMap _lhsOinss _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOpts _lhsOrefHoNts _lhsOrefNts _lhsOself in __result_ ) in C_Children_s38 v37 {-# INLINE rule120 #-} {-# LINE 161 "src-ag/LOAG/Prepare.ag" #-} rule120 = \ ((_lhsIflab) :: Int) -> {-# LINE 161 "src-ag/LOAG/Prepare.ag" #-} _lhsIflab + 1 {-# LINE 1598 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule121 #-} {-# LINE 162 "src-ag/LOAG/Prepare.ag" #-} rule121 = \ ((_lhsIpll) :: PLabel) -> {-# LINE 162 "src-ag/LOAG/Prepare.ag" #-} fst _lhsIpll {-# LINE 1604 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule122 #-} {-# LINE 164 "src-ag/LOAG/Prepare.ag" #-} rule122 = \ _atp ((_lhsIan) :: MyType -> MyAttributes) ((_lhsIpll) :: PLabel) -> {-# LINE 164 "src-ag/LOAG/Prepare.ag" #-} map ((FieldAtt _atp _lhsIpll "lhs") . alab) $ _lhsIan _atp {-# LINE 1611 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule123 #-} {-# LINE 166 "src-ag/LOAG/Prepare.ag" #-} rule123 = \ _flab -> {-# LINE 166 "src-ag/LOAG/Prepare.ag" #-} _flab {-# LINE 1617 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule124 #-} {-# LINE 167 "src-ag/LOAG/Prepare.ag" #-} rule124 = \ ((_lhsIpll) :: PLabel) -> {-# LINE 167 "src-ag/LOAG/Prepare.ag" #-} (_lhsIpll, "lhs") {-# LINE 1623 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule125 #-} {-# LINE 168 "src-ag/LOAG/Prepare.ag" #-} rule125 = \ _atp _label ((_lhsIain) :: MyType -> MyAttributes) -> {-# LINE 168 "src-ag/LOAG/Prepare.ag" #-} Set.fromList $ handAllOut _label $ _lhsIain _atp {-# LINE 1629 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule126 #-} {-# LINE 169 "src-ag/LOAG/Prepare.ag" #-} rule126 = \ _atp _label ((_lhsIasn) :: MyType -> MyAttributes) -> {-# LINE 169 "src-ag/LOAG/Prepare.ag" #-} Set.fromList $ handAllOut _label $ _lhsIasn _atp {-# LINE 1635 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule127 #-} {-# LINE 170 "src-ag/LOAG/Prepare.ag" #-} rule127 = \ _foccsI _foccsS _label -> {-# LINE 170 "src-ag/LOAG/Prepare.ag" #-} Map.singleton _label (_foccsI , _foccsS ) {-# LINE 1641 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule128 #-} {-# LINE 171 "src-ag/LOAG/Prepare.ag" #-} rule128 = \ _label ((_lhsIdty) :: MyType) -> {-# LINE 171 "src-ag/LOAG/Prepare.ag" #-} Map.singleton _label _lhsIdty {-# LINE 1647 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule129 #-} rule129 = \ ((_fattsIap) :: A_P) -> _fattsIap {-# INLINE rule130 #-} rule130 = \ (_ :: ()) -> [] {-# INLINE rule131 #-} rule131 = \ _fieldMap -> _fieldMap {-# INLINE rule132 #-} rule132 = \ ((_fattsIgen) :: Map Int Int) -> _fattsIgen {-# INLINE rule133 #-} rule133 = \ (_ :: ()) -> Map.empty {-# INLINE rule134 #-} rule134 = \ ((_fattsIinss) :: Map Int [Int]) -> _fattsIinss {-# INLINE rule135 #-} rule135 = \ ((_fattsIofld) :: [(Int, Int)]) -> _fattsIofld {-# INLINE rule136 #-} rule136 = \ ((_fattsIpmp) :: PMP) -> _fattsIpmp {-# INLINE rule137 #-} rule137 = \ ((_fattsIpmpr) :: PMP_R) -> _fattsIpmpr {-# INLINE rule138 #-} rule138 = \ (_ :: ()) -> Set.empty {-# INLINE rule139 #-} rule139 = \ (_ :: ()) -> mempty {-# INLINE rule140 #-} rule140 = \ (_ :: ()) -> mempty {-# INLINE rule141 #-} rule141 = \ (_ :: ()) -> [] {-# INLINE rule142 #-} rule142 = \ _self -> _self {-# INLINE rule143 #-} rule143 = \ _flab -> _flab {-# INLINE rule144 #-} rule144 = \ ((_fattsIolab) :: Int) -> _fattsIolab {-# INLINE rule145 #-} rule145 = \ ((_lhsIan) :: MyType -> MyAttributes) -> _lhsIan {-# INLINE rule146 #-} rule146 = \ ((_lhsInmprf) :: NMP_R) -> _lhsInmprf {-# INLINE rule147 #-} rule147 = \ ((_lhsIolab) :: Int) -> _lhsIolab -- Expression -------------------------------------------------- -- wrapper data Inh_Expression = Inh_Expression { pll_Inh_Expression :: (PLabel), pts_Inh_Expression :: (Set.Set (FLabel)) } data Syn_Expression = Syn_Expression { copy_Syn_Expression :: (Expression), self_Syn_Expression :: (Expression), used_Syn_Expression :: (Set.Set MyOccurrence) } {-# INLINABLE wrap_Expression #-} wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) wrap_Expression (T_Expression act) (Inh_Expression _lhsIpll _lhsIpts) = Control.Monad.Identity.runIdentity ( do sem <- act let arg40 = T_Expression_vIn40 _lhsIpll _lhsIpts (T_Expression_vOut40 _lhsOcopy _lhsOself _lhsOused) <- return (inv_Expression_s41 sem arg40) return (Syn_Expression _lhsOcopy _lhsOself _lhsOused) ) -- cata {-# INLINE sem_Expression #-} sem_Expression :: Expression -> T_Expression sem_Expression ( Expression pos_ tks_ ) = sem_Expression_Expression pos_ tks_ -- semantic domain newtype T_Expression = T_Expression { attach_T_Expression :: Identity (T_Expression_s41 ) } newtype T_Expression_s41 = C_Expression_s41 { inv_Expression_s41 :: (T_Expression_v40 ) } data T_Expression_s42 = C_Expression_s42 type T_Expression_v40 = (T_Expression_vIn40 ) -> (T_Expression_vOut40 ) data T_Expression_vIn40 = T_Expression_vIn40 (PLabel) (Set.Set (FLabel)) data T_Expression_vOut40 = T_Expression_vOut40 (Expression) (Expression) (Set.Set MyOccurrence) {-# NOINLINE sem_Expression_Expression #-} sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression sem_Expression_Expression arg_pos_ arg_tks_ = T_Expression (return st41) where {-# NOINLINE st41 #-} st41 = let v40 :: T_Expression_v40 v40 = \ (T_Expression_vIn40 _lhsIpll _lhsIpts) -> ( let _tokensX59 = Control.Monad.Identity.runIdentity (attach_T_HsTokensRoot ((sem_HsTokensRoot tokens_val_))) (T_HsTokensRoot_vOut58 _tokensIself _tokensIused) = inv_HsTokensRoot_s59 _tokensX59 (T_HsTokensRoot_vIn58 _tokensOpll _tokensOpts) tokens_val_ = rule148 arg_tks_ _tokensOpll = rule149 _lhsIpll _tokensOpts = rule150 _lhsIpts _lhsOused :: Set.Set MyOccurrence _lhsOused = rule151 _tokensIused _copy = rule152 arg_pos_ arg_tks_ _self = rule153 arg_pos_ arg_tks_ _lhsOcopy :: Expression _lhsOcopy = rule154 _copy _lhsOself :: Expression _lhsOself = rule155 _self __result_ = T_Expression_vOut40 _lhsOcopy _lhsOself _lhsOused in __result_ ) in C_Expression_s41 v40 {-# INLINE rule148 #-} {-# LINE 273 "src-ag/LOAG/Prepare.ag" #-} rule148 = \ tks_ -> {-# LINE 273 "src-ag/LOAG/Prepare.ag" #-} HsTokensRoot tks_ {-# LINE 1764 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule149 #-} {-# LINE 274 "src-ag/LOAG/Prepare.ag" #-} rule149 = \ ((_lhsIpll) :: PLabel) -> {-# LINE 274 "src-ag/LOAG/Prepare.ag" #-} _lhsIpll {-# LINE 1770 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule150 #-} {-# LINE 275 "src-ag/LOAG/Prepare.ag" #-} rule150 = \ ((_lhsIpts) :: Set.Set (FLabel)) -> {-# LINE 275 "src-ag/LOAG/Prepare.ag" #-} _lhsIpts {-# LINE 1776 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule151 #-} {-# LINE 276 "src-ag/LOAG/Prepare.ag" #-} rule151 = \ ((_tokensIused) :: Set.Set MyOccurrence) -> {-# LINE 276 "src-ag/LOAG/Prepare.ag" #-} _tokensIused {-# LINE 1782 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule152 #-} rule152 = \ pos_ tks_ -> Expression pos_ tks_ {-# INLINE rule153 #-} rule153 = \ pos_ tks_ -> Expression pos_ tks_ {-# INLINE rule154 #-} rule154 = \ _copy -> _copy {-# INLINE rule155 #-} rule155 = \ _self -> _self -- FieldAtt ---------------------------------------------------- -- wrapper data Inh_FieldAtt = Inh_FieldAtt { an_Inh_FieldAtt :: (MyType -> MyAttributes), flab_Inh_FieldAtt :: (Int), nmprf_Inh_FieldAtt :: (NMP_R), olab_Inh_FieldAtt :: (Int) } data Syn_FieldAtt = Syn_FieldAtt { ap_Syn_FieldAtt :: (A_P), flab_Syn_FieldAtt :: (Int), fty_Syn_FieldAtt :: (FTY), gen_Syn_FieldAtt :: (Map Int Int), inss_Syn_FieldAtt :: (Map Int [Int]), ofld_Syn_FieldAtt :: ([(Int, Int)]), olab_Syn_FieldAtt :: (Int), pmp_Syn_FieldAtt :: (PMP), pmpr_Syn_FieldAtt :: (PMP_R), self_Syn_FieldAtt :: (FieldAtt) } {-# INLINABLE wrap_FieldAtt #-} wrap_FieldAtt :: T_FieldAtt -> Inh_FieldAtt -> (Syn_FieldAtt ) wrap_FieldAtt (T_FieldAtt act) (Inh_FieldAtt _lhsIan _lhsIflab _lhsInmprf _lhsIolab) = Control.Monad.Identity.runIdentity ( do sem <- act let arg43 = T_FieldAtt_vIn43 _lhsIan _lhsIflab _lhsInmprf _lhsIolab (T_FieldAtt_vOut43 _lhsOap _lhsOflab _lhsOfty _lhsOgen _lhsOinss _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOself) <- return (inv_FieldAtt_s44 sem arg43) return (Syn_FieldAtt _lhsOap _lhsOflab _lhsOfty _lhsOgen _lhsOinss _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOself) ) -- cata {-# INLINE sem_FieldAtt #-} sem_FieldAtt :: FieldAtt -> T_FieldAtt sem_FieldAtt ( FieldAtt t_ p_ f_ a_ ) = sem_FieldAtt_FieldAtt t_ p_ f_ a_ -- semantic domain newtype T_FieldAtt = T_FieldAtt { attach_T_FieldAtt :: Identity (T_FieldAtt_s44 ) } newtype T_FieldAtt_s44 = C_FieldAtt_s44 { inv_FieldAtt_s44 :: (T_FieldAtt_v43 ) } data T_FieldAtt_s45 = C_FieldAtt_s45 type T_FieldAtt_v43 = (T_FieldAtt_vIn43 ) -> (T_FieldAtt_vOut43 ) data T_FieldAtt_vIn43 = T_FieldAtt_vIn43 (MyType -> MyAttributes) (Int) (NMP_R) (Int) data T_FieldAtt_vOut43 = T_FieldAtt_vOut43 (A_P) (Int) (FTY) (Map Int Int) (Map Int [Int]) ([(Int, Int)]) (Int) (PMP) (PMP_R) (FieldAtt) {-# NOINLINE sem_FieldAtt_FieldAtt #-} sem_FieldAtt_FieldAtt :: (MyType) -> (PLabel) -> (FLabel) -> (ALabel) -> T_FieldAtt sem_FieldAtt_FieldAtt arg_t_ arg_p_ arg_f_ arg_a_ = T_FieldAtt (return st44) where {-# NOINLINE st44 #-} st44 = let v43 :: T_FieldAtt_v43 v43 = \ (T_FieldAtt_vIn43 _lhsIan _lhsIflab _lhsInmprf _lhsIolab) -> ( let _olab = rule156 _lhsIolab _alab = rule157 _att _lhsInmprf _att = rule158 arg_a_ arg_t_ _occ = rule159 arg_a_ arg_f_ arg_p_ _pmp = rule160 _occ _olab _pmpr = rule161 _occ _olab _inss = rule162 _alab _olab _gen = rule163 _alab _olab _lhsOap :: A_P _lhsOap = rule164 _occ arg_p_ _lhsOofld :: [(Int, Int)] _lhsOofld = rule165 _lhsIflab _olab _lhsOfty :: FTY _lhsOfty = rule166 () _lhsOgen :: Map Int Int _lhsOgen = rule167 _gen _lhsOinss :: Map Int [Int] _lhsOinss = rule168 _inss _lhsOpmp :: PMP _lhsOpmp = rule169 _pmp _lhsOpmpr :: PMP_R _lhsOpmpr = rule170 _pmpr _self = rule171 arg_a_ arg_f_ arg_p_ arg_t_ _lhsOself :: FieldAtt _lhsOself = rule172 _self _lhsOflab :: Int _lhsOflab = rule173 _lhsIflab _lhsOolab :: Int _lhsOolab = rule174 _olab __result_ = T_FieldAtt_vOut43 _lhsOap _lhsOflab _lhsOfty _lhsOgen _lhsOinss _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOself in __result_ ) in C_FieldAtt_s44 v43 {-# INLINE rule156 #-} {-# LINE 193 "src-ag/LOAG/Prepare.ag" #-} rule156 = \ ((_lhsIolab) :: Int) -> {-# LINE 193 "src-ag/LOAG/Prepare.ag" #-} _lhsIolab + 1 {-# LINE 1870 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule157 #-} {-# LINE 194 "src-ag/LOAG/Prepare.ag" #-} rule157 = \ _att ((_lhsInmprf) :: NMP_R) -> {-# LINE 194 "src-ag/LOAG/Prepare.ag" #-} findWithErr _lhsInmprf "getting attr label" _att {-# LINE 1876 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule158 #-} {-# LINE 195 "src-ag/LOAG/Prepare.ag" #-} rule158 = \ a_ t_ -> {-# LINE 195 "src-ag/LOAG/Prepare.ag" #-} t_ <.> a_ {-# LINE 1882 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule159 #-} {-# LINE 196 "src-ag/LOAG/Prepare.ag" #-} rule159 = \ a_ f_ p_ -> {-# LINE 196 "src-ag/LOAG/Prepare.ag" #-} (p_, f_) >.< a_ {-# LINE 1888 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule160 #-} {-# LINE 197 "src-ag/LOAG/Prepare.ag" #-} rule160 = \ _occ _olab -> {-# LINE 197 "src-ag/LOAG/Prepare.ag" #-} Map.singleton _olab _occ {-# LINE 1894 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule161 #-} {-# LINE 198 "src-ag/LOAG/Prepare.ag" #-} rule161 = \ _occ _olab -> {-# LINE 198 "src-ag/LOAG/Prepare.ag" #-} Map.singleton _occ _olab {-# LINE 1900 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule162 #-} {-# LINE 199 "src-ag/LOAG/Prepare.ag" #-} rule162 = \ _alab _olab -> {-# LINE 199 "src-ag/LOAG/Prepare.ag" #-} Map.singleton _alab [_olab ] {-# LINE 1906 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule163 #-} {-# LINE 200 "src-ag/LOAG/Prepare.ag" #-} rule163 = \ _alab _olab -> {-# LINE 200 "src-ag/LOAG/Prepare.ag" #-} Map.singleton _olab _alab {-# LINE 1912 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule164 #-} {-# LINE 201 "src-ag/LOAG/Prepare.ag" #-} rule164 = \ _occ p_ -> {-# LINE 201 "src-ag/LOAG/Prepare.ag" #-} Map.singleton p_ [_occ ] {-# LINE 1918 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule165 #-} {-# LINE 202 "src-ag/LOAG/Prepare.ag" #-} rule165 = \ ((_lhsIflab) :: Int) _olab -> {-# LINE 202 "src-ag/LOAG/Prepare.ag" #-} [(_olab , _lhsIflab)] {-# LINE 1924 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule166 #-} rule166 = \ (_ :: ()) -> Map.empty {-# INLINE rule167 #-} rule167 = \ _gen -> _gen {-# INLINE rule168 #-} rule168 = \ _inss -> _inss {-# INLINE rule169 #-} rule169 = \ _pmp -> _pmp {-# INLINE rule170 #-} rule170 = \ _pmpr -> _pmpr {-# INLINE rule171 #-} rule171 = \ a_ f_ p_ t_ -> FieldAtt t_ p_ f_ a_ {-# INLINE rule172 #-} rule172 = \ _self -> _self {-# INLINE rule173 #-} rule173 = \ ((_lhsIflab) :: Int) -> _lhsIflab {-# INLINE rule174 #-} rule174 = \ _olab -> _olab -- FieldAtts --------------------------------------------------- -- wrapper data Inh_FieldAtts = Inh_FieldAtts { an_Inh_FieldAtts :: (MyType -> MyAttributes), flab_Inh_FieldAtts :: (Int), nmprf_Inh_FieldAtts :: (NMP_R), olab_Inh_FieldAtts :: (Int) } data Syn_FieldAtts = Syn_FieldAtts { ap_Syn_FieldAtts :: (A_P), flab_Syn_FieldAtts :: (Int), fty_Syn_FieldAtts :: (FTY), gen_Syn_FieldAtts :: (Map Int Int), inss_Syn_FieldAtts :: (Map Int [Int]), ofld_Syn_FieldAtts :: ([(Int, Int)]), olab_Syn_FieldAtts :: (Int), pmp_Syn_FieldAtts :: (PMP), pmpr_Syn_FieldAtts :: (PMP_R), self_Syn_FieldAtts :: (FieldAtts) } {-# INLINABLE wrap_FieldAtts #-} wrap_FieldAtts :: T_FieldAtts -> Inh_FieldAtts -> (Syn_FieldAtts ) wrap_FieldAtts (T_FieldAtts act) (Inh_FieldAtts _lhsIan _lhsIflab _lhsInmprf _lhsIolab) = Control.Monad.Identity.runIdentity ( do sem <- act let arg46 = T_FieldAtts_vIn46 _lhsIan _lhsIflab _lhsInmprf _lhsIolab (T_FieldAtts_vOut46 _lhsOap _lhsOflab _lhsOfty _lhsOgen _lhsOinss _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOself) <- return (inv_FieldAtts_s47 sem arg46) return (Syn_FieldAtts _lhsOap _lhsOflab _lhsOfty _lhsOgen _lhsOinss _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOself) ) -- cata {-# NOINLINE sem_FieldAtts #-} sem_FieldAtts :: FieldAtts -> T_FieldAtts sem_FieldAtts list = Prelude.foldr sem_FieldAtts_Cons sem_FieldAtts_Nil (Prelude.map sem_FieldAtt list) -- semantic domain newtype T_FieldAtts = T_FieldAtts { attach_T_FieldAtts :: Identity (T_FieldAtts_s47 ) } newtype T_FieldAtts_s47 = C_FieldAtts_s47 { inv_FieldAtts_s47 :: (T_FieldAtts_v46 ) } data T_FieldAtts_s48 = C_FieldAtts_s48 type T_FieldAtts_v46 = (T_FieldAtts_vIn46 ) -> (T_FieldAtts_vOut46 ) data T_FieldAtts_vIn46 = T_FieldAtts_vIn46 (MyType -> MyAttributes) (Int) (NMP_R) (Int) data T_FieldAtts_vOut46 = T_FieldAtts_vOut46 (A_P) (Int) (FTY) (Map Int Int) (Map Int [Int]) ([(Int, Int)]) (Int) (PMP) (PMP_R) (FieldAtts) {-# NOINLINE sem_FieldAtts_Cons #-} sem_FieldAtts_Cons :: T_FieldAtt -> T_FieldAtts -> T_FieldAtts sem_FieldAtts_Cons arg_hd_ arg_tl_ = T_FieldAtts (return st47) where {-# NOINLINE st47 #-} st47 = let v46 :: T_FieldAtts_v46 v46 = \ (T_FieldAtts_vIn46 _lhsIan _lhsIflab _lhsInmprf _lhsIolab) -> ( let _hdX44 = Control.Monad.Identity.runIdentity (attach_T_FieldAtt (arg_hd_)) _tlX47 = Control.Monad.Identity.runIdentity (attach_T_FieldAtts (arg_tl_)) (T_FieldAtt_vOut43 _hdIap _hdIflab _hdIfty _hdIgen _hdIinss _hdIofld _hdIolab _hdIpmp _hdIpmpr _hdIself) = inv_FieldAtt_s44 _hdX44 (T_FieldAtt_vIn43 _hdOan _hdOflab _hdOnmprf _hdOolab) (T_FieldAtts_vOut46 _tlIap _tlIflab _tlIfty _tlIgen _tlIinss _tlIofld _tlIolab _tlIpmp _tlIpmpr _tlIself) = inv_FieldAtts_s47 _tlX47 (T_FieldAtts_vIn46 _tlOan _tlOflab _tlOnmprf _tlOolab) _lhsOap :: A_P _lhsOap = rule175 _hdIap _tlIap _lhsOfty :: FTY _lhsOfty = rule176 _hdIfty _tlIfty _lhsOgen :: Map Int Int _lhsOgen = rule177 _hdIgen _tlIgen _lhsOinss :: Map Int [Int] _lhsOinss = rule178 _hdIinss _tlIinss _lhsOofld :: [(Int, Int)] _lhsOofld = rule179 _hdIofld _tlIofld _lhsOpmp :: PMP _lhsOpmp = rule180 _hdIpmp _tlIpmp _lhsOpmpr :: PMP_R _lhsOpmpr = rule181 _hdIpmpr _tlIpmpr _self = rule182 _hdIself _tlIself _lhsOself :: FieldAtts _lhsOself = rule183 _self _lhsOflab :: Int _lhsOflab = rule184 _tlIflab _lhsOolab :: Int _lhsOolab = rule185 _tlIolab _hdOan = rule186 _lhsIan _hdOflab = rule187 _lhsIflab _hdOnmprf = rule188 _lhsInmprf _hdOolab = rule189 _lhsIolab _tlOan = rule190 _lhsIan _tlOflab = rule191 _hdIflab _tlOnmprf = rule192 _lhsInmprf _tlOolab = rule193 _hdIolab __result_ = T_FieldAtts_vOut46 _lhsOap _lhsOflab _lhsOfty _lhsOgen _lhsOinss _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOself in __result_ ) in C_FieldAtts_s47 v46 {-# INLINE rule175 #-} rule175 = \ ((_hdIap) :: A_P) ((_tlIap) :: A_P) -> (Map.unionWith (++) _hdIap _tlIap) {-# INLINE rule176 #-} rule176 = \ ((_hdIfty) :: FTY) ((_tlIfty) :: FTY) -> (Map.union _hdIfty _tlIfty) {-# INLINE rule177 #-} rule177 = \ ((_hdIgen) :: Map Int Int) ((_tlIgen) :: Map Int Int) -> (Map.union _hdIgen _tlIgen) {-# INLINE rule178 #-} rule178 = \ ((_hdIinss) :: Map Int [Int]) ((_tlIinss) :: Map Int [Int]) -> (Map.unionWith (++) _hdIinss _tlIinss) {-# INLINE rule179 #-} rule179 = \ ((_hdIofld) :: [(Int, Int)]) ((_tlIofld) :: [(Int, Int)]) -> ((++) _hdIofld _tlIofld) {-# INLINE rule180 #-} rule180 = \ ((_hdIpmp) :: PMP) ((_tlIpmp) :: PMP) -> (Map.union _hdIpmp _tlIpmp) {-# INLINE rule181 #-} rule181 = \ ((_hdIpmpr) :: PMP_R) ((_tlIpmpr) :: PMP_R) -> (Map.union _hdIpmpr _tlIpmpr) {-# INLINE rule182 #-} rule182 = \ ((_hdIself) :: FieldAtt) ((_tlIself) :: FieldAtts) -> (:) _hdIself _tlIself {-# INLINE rule183 #-} rule183 = \ _self -> _self {-# INLINE rule184 #-} rule184 = \ ((_tlIflab) :: Int) -> _tlIflab {-# INLINE rule185 #-} rule185 = \ ((_tlIolab) :: Int) -> _tlIolab {-# INLINE rule186 #-} rule186 = \ ((_lhsIan) :: MyType -> MyAttributes) -> _lhsIan {-# INLINE rule187 #-} rule187 = \ ((_lhsIflab) :: Int) -> _lhsIflab {-# INLINE rule188 #-} rule188 = \ ((_lhsInmprf) :: NMP_R) -> _lhsInmprf {-# INLINE rule189 #-} rule189 = \ ((_lhsIolab) :: Int) -> _lhsIolab {-# INLINE rule190 #-} rule190 = \ ((_lhsIan) :: MyType -> MyAttributes) -> _lhsIan {-# INLINE rule191 #-} rule191 = \ ((_hdIflab) :: Int) -> _hdIflab {-# INLINE rule192 #-} rule192 = \ ((_lhsInmprf) :: NMP_R) -> _lhsInmprf {-# INLINE rule193 #-} rule193 = \ ((_hdIolab) :: Int) -> _hdIolab {-# NOINLINE sem_FieldAtts_Nil #-} sem_FieldAtts_Nil :: T_FieldAtts sem_FieldAtts_Nil = T_FieldAtts (return st47) where {-# NOINLINE st47 #-} st47 = let v46 :: T_FieldAtts_v46 v46 = \ (T_FieldAtts_vIn46 _lhsIan _lhsIflab _lhsInmprf _lhsIolab) -> ( let _lhsOap :: A_P _lhsOap = rule194 () _lhsOfty :: FTY _lhsOfty = rule195 () _lhsOgen :: Map Int Int _lhsOgen = rule196 () _lhsOinss :: Map Int [Int] _lhsOinss = rule197 () _lhsOofld :: [(Int, Int)] _lhsOofld = rule198 () _lhsOpmp :: PMP _lhsOpmp = rule199 () _lhsOpmpr :: PMP_R _lhsOpmpr = rule200 () _self = rule201 () _lhsOself :: FieldAtts _lhsOself = rule202 _self _lhsOflab :: Int _lhsOflab = rule203 _lhsIflab _lhsOolab :: Int _lhsOolab = rule204 _lhsIolab __result_ = T_FieldAtts_vOut46 _lhsOap _lhsOflab _lhsOfty _lhsOgen _lhsOinss _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOself in __result_ ) in C_FieldAtts_s47 v46 {-# INLINE rule194 #-} rule194 = \ (_ :: ()) -> Map.empty {-# INLINE rule195 #-} rule195 = \ (_ :: ()) -> Map.empty {-# INLINE rule196 #-} rule196 = \ (_ :: ()) -> Map.empty {-# INLINE rule197 #-} rule197 = \ (_ :: ()) -> Map.empty {-# INLINE rule198 #-} rule198 = \ (_ :: ()) -> [] {-# INLINE rule199 #-} rule199 = \ (_ :: ()) -> Map.empty {-# INLINE rule200 #-} rule200 = \ (_ :: ()) -> Map.empty {-# INLINE rule201 #-} rule201 = \ (_ :: ()) -> [] {-# INLINE rule202 #-} rule202 = \ _self -> _self {-# INLINE rule203 #-} rule203 = \ ((_lhsIflab) :: Int) -> _lhsIflab {-# INLINE rule204 #-} rule204 = \ ((_lhsIolab) :: Int) -> _lhsIolab -- Grammar ----------------------------------------------------- -- wrapper data Inh_Grammar = Inh_Grammar { options_Inh_Grammar :: (Options) } data Syn_Grammar = Syn_Grammar { ads_Syn_Grammar :: (Maybe PP_Doc), errors_Syn_Grammar :: (Seq.Seq Error), inhmap_Syn_Grammar :: (Map.Map NontermIdent Attributes), localSigMap_Syn_Grammar :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))), output_Syn_Grammar :: (ExecutionPlan), self_Syn_Grammar :: (Grammar), synmap_Syn_Grammar :: (Map.Map NontermIdent Attributes) } {-# INLINABLE wrap_Grammar #-} wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar ) wrap_Grammar (T_Grammar act) (Inh_Grammar _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act let arg49 = T_Grammar_vIn49 _lhsIoptions (T_Grammar_vOut49 _lhsOads _lhsOerrors _lhsOinhmap _lhsOlocalSigMap _lhsOoutput _lhsOself _lhsOsynmap) <- return (inv_Grammar_s50 sem arg49) return (Syn_Grammar _lhsOads _lhsOerrors _lhsOinhmap _lhsOlocalSigMap _lhsOoutput _lhsOself _lhsOsynmap) ) -- cata {-# INLINE sem_Grammar #-} sem_Grammar :: Grammar -> T_Grammar sem_Grammar ( Grammar typeSyns_ useMap_ derivings_ wrappers_ nonts_ pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ -- semantic domain newtype T_Grammar = T_Grammar { attach_T_Grammar :: Identity (T_Grammar_s50 ) } newtype T_Grammar_s50 = C_Grammar_s50 { inv_Grammar_s50 :: (T_Grammar_v49 ) } data T_Grammar_s51 = C_Grammar_s51 type T_Grammar_v49 = (T_Grammar_vIn49 ) -> (T_Grammar_vOut49 ) data T_Grammar_vIn49 = T_Grammar_vIn49 (Options) data T_Grammar_vOut49 = T_Grammar_vOut49 (Maybe PP_Doc) (Seq.Seq Error) (Map.Map NontermIdent Attributes) (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) (ExecutionPlan) (Grammar) (Map.Map NontermIdent Attributes) {-# NOINLINE sem_Grammar_Grammar #-} sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar sem_Grammar_Grammar arg_typeSyns_ arg_useMap_ arg_derivings_ arg_wrappers_ arg_nonts_ arg_pragmas_ arg_manualAttrOrderMap_ arg_paramMap_ arg_contextMap_ arg_quantMap_ arg_uniqueMap_ arg_augmentsMap_ arg_aroundsMap_ arg_mergeMap_ = T_Grammar (return st50) where {-# NOINLINE st50 #-} st50 = let v49 :: T_Grammar_v49 v49 = \ (T_Grammar_vIn49 _lhsIoptions) -> ( let _nontsX74 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) _smfX62 = Control.Monad.Identity.runIdentity (attach_T_LOAGRep ((sem_LOAGRep smf_val_))) (T_Nonterminals_vOut73 _nontsIads _nontsIap _nontsIenonts _nontsIfdps _nontsIfieldMap _nontsIflab _nontsIfsInP _nontsIfty _nontsIgen _nontsIhoMap _nontsIinhmap _nontsIinhs _nontsIinss _nontsIlfp _nontsIlfpr _nontsIlocalSigMap _nontsIntDeps _nontsIntHoDeps _nontsIofld _nontsIolab _nontsIpmp _nontsIpmpr _nontsIps _nontsIruleMap _nontsIrulenumber _nontsIself _nontsIsfp _nontsIsynmap _nontsIsyns _nontsIvisMap _nontsIvisitnum) = inv_Nonterminals_s74 _nontsX74 (T_Nonterminals_vIn73 _nontsOain _nontsOan _nontsOaroundMap _nontsOasn _nontsOaugM _nontsOclassContexts _nontsOclosedHoNtDeps _nontsOclosedHoNtRevDeps _nontsOclosedNtDeps _nontsOflab _nontsOfty _nontsOftyf _nontsOhoMapf _nontsOlfpf _nontsOmergeMap _nontsOnmp _nontsOnmprf _nontsOolab _nontsOoptions _nontsOpmpf _nontsOpmprf _nontsOres_ads _nontsOrulenumber _nontsOsched _nontsOtdp _nontsOvisMapf _nontsOvisitnum) (T_LOAGRep_vOut61 _smfIself) = inv_LOAGRep_s62 _smfX62 (T_LOAGRep_vIn61 ) _closedNtDeps = rule205 _nontsIntDeps _closedHoNtDeps = rule206 _nontsIntHoDeps _closedHoNtRevDeps = rule207 _closedHoNtDeps _nontsOclassContexts = rule208 arg_contextMap_ _nontsOaroundMap = rule209 arg_aroundsMap_ _nontsOmergeMap = rule210 arg_mergeMap_ _nontsOrulenumber = rule211 () _initO = rule212 _nontsIpmp smf_val_ = rule213 _ain _an _asn _initO _nmp _nmpr _nontsIap _nontsIfieldMap _nontsIfsInP _nontsIfty _nontsIgen _nontsIinss _nontsIofld _nontsIpmp _nontsIpmpr _nontsIps _sfp _nmp = rule214 _atts _nmpr = rule215 _atts _an = rule216 _ain _asn _ain = rule217 _nontsIinhs _asn = rule218 _nontsIsyns _atts = rule219 _an _occs = rule220 _nontsIap _nontsOaugM = rule221 arg_manualAttrOrderMap_ _nontsOain = rule222 _ain _nontsOasn = rule223 _asn _nontsOpmpf = rule224 _nontsIpmp _nontsOpmprf = rule225 _nontsIpmpr _nontsOlfpf = rule226 _nontsIlfp _nontsOhoMapf = rule227 _nontsIhoMap _nontsOftyf = rule228 _nontsIfty _nontsOfty = rule229 _nontsIfty _ps = rule230 _nontsIps _nontsOan = rule231 _an _nontsOnmprf = rule232 _nmpr _nontsOolab = rule233 _nmp _nontsOflab = rule234 () _sfp = rule235 _nontsIlfp _nontsIsfp _lhsOerrors :: Seq.Seq Error _lhsOerrors = rule236 _schedRes _lhsOads :: Maybe PP_Doc _lhsOads = rule237 _lhsIoptions _nontsIpmp _schedRes _lhsOoutput :: ExecutionPlan _lhsOoutput = rule238 _nontsIenonts arg_derivings_ arg_typeSyns_ arg_wrappers_ _nontsOsched = rule239 _schedRes _nontsOtdp = rule240 _schedRes _schedRes = rule241 _ag _lhsIoptions _loagRes _nontsIads _self _smfIself _loagRes = rule242 _ag _lhsIoptions _ag = rule243 _self _smfIself _nontsOres_ads = rule244 _schedRes _nontsOvisMapf = rule245 _nontsIvisMap _nontsOvisitnum = rule246 () _lhsOinhmap :: Map.Map NontermIdent Attributes _lhsOinhmap = rule247 _nontsIinhmap _lhsOlocalSigMap :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type)) _lhsOlocalSigMap = rule248 _nontsIlocalSigMap _lhsOsynmap :: Map.Map NontermIdent Attributes _lhsOsynmap = rule249 _nontsIsynmap _self = rule250 _nontsIself arg_aroundsMap_ arg_augmentsMap_ arg_contextMap_ arg_derivings_ arg_manualAttrOrderMap_ arg_mergeMap_ arg_paramMap_ arg_pragmas_ arg_quantMap_ arg_typeSyns_ arg_uniqueMap_ arg_useMap_ arg_wrappers_ _lhsOself :: Grammar _lhsOself = rule251 _self _nontsOclosedHoNtDeps = rule252 _closedHoNtDeps _nontsOclosedHoNtRevDeps = rule253 _closedHoNtRevDeps _nontsOclosedNtDeps = rule254 _closedNtDeps _nontsOnmp = rule255 _nmp _nontsOoptions = rule256 _lhsIoptions __result_ = T_Grammar_vOut49 _lhsOads _lhsOerrors _lhsOinhmap _lhsOlocalSigMap _lhsOoutput _lhsOself _lhsOsynmap in __result_ ) in C_Grammar_s50 v49 {-# INLINE rule205 #-} {-# LINE 40 "src-ag/ExecutionPlanCommon.ag" #-} rule205 = \ ((_nontsIntDeps) :: Map NontermIdent (Set NontermIdent)) -> {-# LINE 40 "src-ag/ExecutionPlanCommon.ag" #-} closeMap _nontsIntDeps {-# LINE 2256 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule206 #-} {-# LINE 41 "src-ag/ExecutionPlanCommon.ag" #-} rule206 = \ ((_nontsIntHoDeps) :: Map NontermIdent (Set NontermIdent)) -> {-# LINE 41 "src-ag/ExecutionPlanCommon.ag" #-} closeMap _nontsIntHoDeps {-# LINE 2262 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule207 #-} {-# LINE 42 "src-ag/ExecutionPlanCommon.ag" #-} rule207 = \ _closedHoNtDeps -> {-# LINE 42 "src-ag/ExecutionPlanCommon.ag" #-} revDeps _closedHoNtDeps {-# LINE 2268 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule208 #-} {-# LINE 51 "src-ag/ExecutionPlanCommon.ag" #-} rule208 = \ contextMap_ -> {-# LINE 51 "src-ag/ExecutionPlanCommon.ag" #-} contextMap_ {-# LINE 2274 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule209 #-} {-# LINE 92 "src-ag/ExecutionPlanCommon.ag" #-} rule209 = \ aroundsMap_ -> {-# LINE 92 "src-ag/ExecutionPlanCommon.ag" #-} aroundsMap_ {-# LINE 2280 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule210 #-} {-# LINE 117 "src-ag/ExecutionPlanCommon.ag" #-} rule210 = \ mergeMap_ -> {-# LINE 117 "src-ag/ExecutionPlanCommon.ag" #-} mergeMap_ {-# LINE 2286 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule211 #-} {-# LINE 9 "src-ag/ExecutionPlanPre.ag" #-} rule211 = \ (_ :: ()) -> {-# LINE 9 "src-ag/ExecutionPlanPre.ag" #-} 0 {-# LINE 2292 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule212 #-} {-# LINE 38 "src-ag/LOAG/Prepare.ag" #-} rule212 = \ ((_nontsIpmp) :: PMP) -> {-# LINE 38 "src-ag/LOAG/Prepare.ag" #-} if Map.null _nontsIpmp then 1 else fst $ Map.findMin _nontsIpmp {-# LINE 2298 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule213 #-} {-# LINE 40 "src-ag/LOAG/Prepare.ag" #-} rule213 = \ _ain _an _asn _initO _nmp _nmpr ((_nontsIap) :: A_P) ((_nontsIfieldMap) :: FMap) ((_nontsIfsInP) :: FsInP) ((_nontsIfty) :: FTY) ((_nontsIgen) :: Map Int Int) ((_nontsIinss) :: Map Int [Int]) ((_nontsIofld) :: [(Int, Int)]) ((_nontsIpmp) :: PMP) ((_nontsIpmpr) :: PMP_R) ((_nontsIps) :: [PLabel]) _sfp -> {-# LINE 40 "src-ag/LOAG/Prepare.ag" #-} LOAGRep _nontsIps _nontsIap _an _ain _asn _sfp _nontsIpmp _nontsIpmpr _nmp _nmpr (A.array (_initO , _initO + Map.size _nontsIgen) $ Map.toList $ _nontsIgen) (A.array (1,Map.size _nontsIinss) $ Map.toList $ _nontsIinss) (A.array (_initO , _initO + length _nontsIofld) $ _nontsIofld) _nontsIfty _nontsIfieldMap _nontsIfsInP {-# LINE 2312 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule214 #-} {-# LINE 49 "src-ag/LOAG/Prepare.ag" #-} rule214 = \ _atts -> {-# LINE 49 "src-ag/LOAG/Prepare.ag" #-} Map.fromList $ zip [1..] _atts {-# LINE 2318 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule215 #-} {-# LINE 50 "src-ag/LOAG/Prepare.ag" #-} rule215 = \ _atts -> {-# LINE 50 "src-ag/LOAG/Prepare.ag" #-} Map.fromList $ zip _atts [1..] {-# LINE 2324 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule216 #-} {-# LINE 51 "src-ag/LOAG/Prepare.ag" #-} rule216 = \ _ain _asn -> {-# LINE 51 "src-ag/LOAG/Prepare.ag" #-} Map.unionWith (++) _ain _asn {-# LINE 2330 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule217 #-} {-# LINE 52 "src-ag/LOAG/Prepare.ag" #-} rule217 = \ ((_nontsIinhs) :: AI_N) -> {-# LINE 52 "src-ag/LOAG/Prepare.ag" #-} _nontsIinhs {-# LINE 2336 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule218 #-} {-# LINE 53 "src-ag/LOAG/Prepare.ag" #-} rule218 = \ ((_nontsIsyns) :: AS_N) -> {-# LINE 53 "src-ag/LOAG/Prepare.ag" #-} _nontsIsyns {-# LINE 2342 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule219 #-} {-# LINE 54 "src-ag/LOAG/Prepare.ag" #-} rule219 = \ _an -> {-# LINE 54 "src-ag/LOAG/Prepare.ag" #-} concat $ Map.elems _an {-# LINE 2348 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule220 #-} {-# LINE 55 "src-ag/LOAG/Prepare.ag" #-} rule220 = \ ((_nontsIap) :: A_P) -> {-# LINE 55 "src-ag/LOAG/Prepare.ag" #-} concat $ Map.elems _nontsIap {-# LINE 2354 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule221 #-} {-# LINE 56 "src-ag/LOAG/Prepare.ag" #-} rule221 = \ manualAttrOrderMap_ -> {-# LINE 56 "src-ag/LOAG/Prepare.ag" #-} manualAttrOrderMap_ {-# LINE 2360 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule222 #-} {-# LINE 87 "src-ag/LOAG/Prepare.ag" #-} rule222 = \ _ain -> {-# LINE 87 "src-ag/LOAG/Prepare.ag" #-} map2F _ain {-# LINE 2366 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule223 #-} {-# LINE 88 "src-ag/LOAG/Prepare.ag" #-} rule223 = \ _asn -> {-# LINE 88 "src-ag/LOAG/Prepare.ag" #-} map2F _asn {-# LINE 2372 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule224 #-} {-# LINE 89 "src-ag/LOAG/Prepare.ag" #-} rule224 = \ ((_nontsIpmp) :: PMP) -> {-# LINE 89 "src-ag/LOAG/Prepare.ag" #-} _nontsIpmp {-# LINE 2378 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule225 #-} {-# LINE 90 "src-ag/LOAG/Prepare.ag" #-} rule225 = \ ((_nontsIpmpr) :: PMP_R) -> {-# LINE 90 "src-ag/LOAG/Prepare.ag" #-} _nontsIpmpr {-# LINE 2384 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule226 #-} {-# LINE 91 "src-ag/LOAG/Prepare.ag" #-} rule226 = \ ((_nontsIlfp) :: SF_P) -> {-# LINE 91 "src-ag/LOAG/Prepare.ag" #-} _nontsIlfp {-# LINE 2390 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule227 #-} {-# LINE 92 "src-ag/LOAG/Prepare.ag" #-} rule227 = \ ((_nontsIhoMap) :: HOMap) -> {-# LINE 92 "src-ag/LOAG/Prepare.ag" #-} _nontsIhoMap {-# LINE 2396 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule228 #-} {-# LINE 93 "src-ag/LOAG/Prepare.ag" #-} rule228 = \ ((_nontsIfty) :: FTY) -> {-# LINE 93 "src-ag/LOAG/Prepare.ag" #-} _nontsIfty {-# LINE 2402 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule229 #-} {-# LINE 94 "src-ag/LOAG/Prepare.ag" #-} rule229 = \ ((_nontsIfty) :: FTY) -> {-# LINE 94 "src-ag/LOAG/Prepare.ag" #-} _nontsIfty {-# LINE 2408 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule230 #-} {-# LINE 103 "src-ag/LOAG/Prepare.ag" #-} rule230 = \ ((_nontsIps) :: [PLabel]) -> {-# LINE 103 "src-ag/LOAG/Prepare.ag" #-} _nontsIps {-# LINE 2414 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule231 #-} {-# LINE 150 "src-ag/LOAG/Prepare.ag" #-} rule231 = \ _an -> {-# LINE 150 "src-ag/LOAG/Prepare.ag" #-} map2F _an {-# LINE 2420 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule232 #-} {-# LINE 151 "src-ag/LOAG/Prepare.ag" #-} rule232 = \ _nmpr -> {-# LINE 151 "src-ag/LOAG/Prepare.ag" #-} _nmpr {-# LINE 2426 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule233 #-} {-# LINE 152 "src-ag/LOAG/Prepare.ag" #-} rule233 = \ _nmp -> {-# LINE 152 "src-ag/LOAG/Prepare.ag" #-} if Map.null _nmp then 0 else (fst $ Map.findMax _nmp ) {-# LINE 2432 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule234 #-} {-# LINE 153 "src-ag/LOAG/Prepare.ag" #-} rule234 = \ (_ :: ()) -> {-# LINE 153 "src-ag/LOAG/Prepare.ag" #-} 0 {-# LINE 2438 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule235 #-} {-# LINE 207 "src-ag/LOAG/Prepare.ag" #-} rule235 = \ ((_nontsIlfp) :: SF_P) ((_nontsIsfp) :: SF_P) -> {-# LINE 207 "src-ag/LOAG/Prepare.ag" #-} repLocRefs _nontsIlfp _nontsIsfp {-# LINE 2444 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule236 #-} {-# LINE 54 "src-ag/LOAG/Order.ag" #-} rule236 = \ _schedRes -> {-# LINE 54 "src-ag/LOAG/Order.ag" #-} either Seq.singleton (const Seq.empty) _schedRes {-# LINE 2450 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule237 #-} {-# LINE 55 "src-ag/LOAG/Order.ag" #-} rule237 = \ ((_lhsIoptions) :: Options) ((_nontsIpmp) :: PMP) _schedRes -> {-# LINE 55 "src-ag/LOAG/Order.ag" #-} case either (const []) trd' _schedRes of [] -> Nothing ads -> Just $ ppAds _lhsIoptions _nontsIpmp ads {-# LINE 2458 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule238 #-} {-# LINE 58 "src-ag/LOAG/Order.ag" #-} rule238 = \ ((_nontsIenonts) :: ENonterminals) derivings_ typeSyns_ wrappers_ -> {-# LINE 58 "src-ag/LOAG/Order.ag" #-} ExecutionPlan _nontsIenonts typeSyns_ wrappers_ derivings_ {-# LINE 2464 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule239 #-} {-# LINE 60 "src-ag/LOAG/Order.ag" #-} rule239 = \ _schedRes -> {-# LINE 60 "src-ag/LOAG/Order.ag" #-} either (const Map.empty) snd' _schedRes {-# LINE 2470 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule240 #-} {-# LINE 61 "src-ag/LOAG/Order.ag" #-} rule240 = \ _schedRes -> {-# LINE 61 "src-ag/LOAG/Order.ag" #-} either (error "no tdp") (fromJust.fst') _schedRes {-# LINE 2476 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule241 #-} {-# LINE 63 "src-ag/LOAG/Order.ag" #-} rule241 = \ _ag ((_lhsIoptions) :: Options) _loagRes ((_nontsIads) :: [Edge]) _self ((_smfIself) :: LOAGRep) -> {-# LINE 63 "src-ag/LOAG/Order.ag" #-} if CT.loag _lhsIoptions then if CT.aoag _lhsIoptions then AOAG.schedule _smfIself _self _ag _nontsIads else _loagRes else Right (Nothing,Map.empty,[]) {-# LINE 2486 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule242 #-} {-# LINE 68 "src-ag/LOAG/Order.ag" #-} rule242 = \ _ag ((_lhsIoptions) :: Options) -> {-# LINE 68 "src-ag/LOAG/Order.ag" #-} let putStrLn s = when (verbose _lhsIoptions) (IO.putStrLn s) in Right $ unsafePerformIO $ scheduleLOAG _ag putStrLn _lhsIoptions {-# LINE 2493 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule243 #-} {-# LINE 70 "src-ag/LOAG/Order.ag" #-} rule243 = \ _self ((_smfIself) :: LOAGRep) -> {-# LINE 70 "src-ag/LOAG/Order.ag" #-} repToAg _smfIself _self {-# LINE 2499 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule244 #-} {-# LINE 72 "src-ag/LOAG/Order.ag" #-} rule244 = \ _schedRes -> {-# LINE 72 "src-ag/LOAG/Order.ag" #-} either (const []) trd' _schedRes {-# LINE 2505 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule245 #-} {-# LINE 133 "src-ag/LOAG/Order.ag" #-} rule245 = \ ((_nontsIvisMap) :: IMap.IntMap Int) -> {-# LINE 133 "src-ag/LOAG/Order.ag" #-} _nontsIvisMap {-# LINE 2511 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule246 #-} {-# LINE 134 "src-ag/LOAG/Order.ag" #-} rule246 = \ (_ :: ()) -> {-# LINE 134 "src-ag/LOAG/Order.ag" #-} 0 {-# LINE 2517 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule247 #-} rule247 = \ ((_nontsIinhmap) :: Map.Map NontermIdent Attributes) -> _nontsIinhmap {-# INLINE rule248 #-} rule248 = \ ((_nontsIlocalSigMap) :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) -> _nontsIlocalSigMap {-# INLINE rule249 #-} rule249 = \ ((_nontsIsynmap) :: Map.Map NontermIdent Attributes) -> _nontsIsynmap {-# INLINE rule250 #-} rule250 = \ ((_nontsIself) :: Nonterminals) aroundsMap_ augmentsMap_ contextMap_ derivings_ manualAttrOrderMap_ mergeMap_ paramMap_ pragmas_ quantMap_ typeSyns_ uniqueMap_ useMap_ wrappers_ -> Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIself pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ {-# INLINE rule251 #-} rule251 = \ _self -> _self {-# INLINE rule252 #-} rule252 = \ _closedHoNtDeps -> _closedHoNtDeps {-# INLINE rule253 #-} rule253 = \ _closedHoNtRevDeps -> _closedHoNtRevDeps {-# INLINE rule254 #-} rule254 = \ _closedNtDeps -> _closedNtDeps {-# INLINE rule255 #-} rule255 = \ _nmp -> _nmp {-# INLINE rule256 #-} rule256 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions -- HsToken ----------------------------------------------------- -- wrapper data Inh_HsToken = Inh_HsToken { pll_Inh_HsToken :: (PLabel), pts_Inh_HsToken :: (Set.Set (FLabel)) } data Syn_HsToken = Syn_HsToken { self_Syn_HsToken :: (HsToken), used_Syn_HsToken :: (Set.Set MyOccurrence) } {-# INLINABLE wrap_HsToken #-} wrap_HsToken :: T_HsToken -> Inh_HsToken -> (Syn_HsToken ) wrap_HsToken (T_HsToken act) (Inh_HsToken _lhsIpll _lhsIpts) = Control.Monad.Identity.runIdentity ( do sem <- act let arg52 = T_HsToken_vIn52 _lhsIpll _lhsIpts (T_HsToken_vOut52 _lhsOself _lhsOused) <- return (inv_HsToken_s53 sem arg52) return (Syn_HsToken _lhsOself _lhsOused) ) -- cata {-# NOINLINE sem_HsToken #-} sem_HsToken :: HsToken -> T_HsToken sem_HsToken ( AGLocal var_ pos_ rdesc_ ) = sem_HsToken_AGLocal var_ pos_ rdesc_ sem_HsToken ( AGField field_ attr_ pos_ rdesc_ ) = sem_HsToken_AGField field_ attr_ pos_ rdesc_ sem_HsToken ( HsToken value_ pos_ ) = sem_HsToken_HsToken value_ pos_ sem_HsToken ( CharToken value_ pos_ ) = sem_HsToken_CharToken value_ pos_ sem_HsToken ( StrToken value_ pos_ ) = sem_HsToken_StrToken value_ pos_ sem_HsToken ( Err mesg_ pos_ ) = sem_HsToken_Err mesg_ pos_ -- semantic domain newtype T_HsToken = T_HsToken { attach_T_HsToken :: Identity (T_HsToken_s53 ) } newtype T_HsToken_s53 = C_HsToken_s53 { inv_HsToken_s53 :: (T_HsToken_v52 ) } data T_HsToken_s54 = C_HsToken_s54 type T_HsToken_v52 = (T_HsToken_vIn52 ) -> (T_HsToken_vOut52 ) data T_HsToken_vIn52 = T_HsToken_vIn52 (PLabel) (Set.Set (FLabel)) data T_HsToken_vOut52 = T_HsToken_vOut52 (HsToken) (Set.Set MyOccurrence) {-# NOINLINE sem_HsToken_AGLocal #-} sem_HsToken_AGLocal :: (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGLocal arg_var_ arg_pos_ arg_rdesc_ = T_HsToken (return st53) where {-# NOINLINE st53 #-} st53 = let v52 :: T_HsToken_v52 v52 = \ (T_HsToken_vIn52 _lhsIpll _lhsIpts) -> ( let _lhsOused :: Set.Set MyOccurrence _lhsOused = rule257 _lhsIpll _lhsIpts arg_var_ _self = rule258 arg_pos_ arg_rdesc_ arg_var_ _lhsOself :: HsToken _lhsOself = rule259 _self __result_ = T_HsToken_vOut52 _lhsOself _lhsOused in __result_ ) in C_HsToken_s53 v52 {-# INLINE rule257 #-} {-# LINE 281 "src-ag/LOAG/Prepare.ag" #-} rule257 = \ ((_lhsIpll) :: PLabel) ((_lhsIpts) :: Set.Set (FLabel)) var_ -> {-# LINE 281 "src-ag/LOAG/Prepare.ag" #-} case getName var_ `Set.member` _lhsIpts of True -> Set.empty False -> Set.singleton $ (_lhsIpll, getName _LOC) >.< (getName var_, drhs _LOC) {-# LINE 2607 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule258 #-} rule258 = \ pos_ rdesc_ var_ -> AGLocal var_ pos_ rdesc_ {-# INLINE rule259 #-} rule259 = \ _self -> _self {-# NOINLINE sem_HsToken_AGField #-} sem_HsToken_AGField :: (Identifier) -> (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken sem_HsToken_AGField arg_field_ arg_attr_ arg_pos_ arg_rdesc_ = T_HsToken (return st53) where {-# NOINLINE st53 #-} st53 = let v52 :: T_HsToken_v52 v52 = \ (T_HsToken_vIn52 _lhsIpll _lhsIpts) -> ( let _lhsOused :: Set.Set MyOccurrence _lhsOused = rule260 _lhsIpll arg_attr_ arg_field_ _self = rule261 arg_attr_ arg_field_ arg_pos_ arg_rdesc_ _lhsOself :: HsToken _lhsOself = rule262 _self __result_ = T_HsToken_vOut52 _lhsOself _lhsOused in __result_ ) in C_HsToken_s53 v52 {-# INLINE rule260 #-} {-# LINE 289 "src-ag/LOAG/Prepare.ag" #-} rule260 = \ ((_lhsIpll) :: PLabel) attr_ field_ -> {-# LINE 289 "src-ag/LOAG/Prepare.ag" #-} Set.singleton $ (_lhsIpll, getName field_) >.< (getName attr_, drhs field_) {-# LINE 2635 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule261 #-} rule261 = \ attr_ field_ pos_ rdesc_ -> AGField field_ attr_ pos_ rdesc_ {-# INLINE rule262 #-} rule262 = \ _self -> _self {-# NOINLINE sem_HsToken_HsToken #-} sem_HsToken_HsToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_HsToken arg_value_ arg_pos_ = T_HsToken (return st53) where {-# NOINLINE st53 #-} st53 = let v52 :: T_HsToken_v52 v52 = \ (T_HsToken_vIn52 _lhsIpll _lhsIpts) -> ( let _lhsOused :: Set.Set MyOccurrence _lhsOused = rule263 () _self = rule264 arg_pos_ arg_value_ _lhsOself :: HsToken _lhsOself = rule265 _self __result_ = T_HsToken_vOut52 _lhsOself _lhsOused in __result_ ) in C_HsToken_s53 v52 {-# INLINE rule263 #-} rule263 = \ (_ :: ()) -> Set.empty {-# INLINE rule264 #-} rule264 = \ pos_ value_ -> HsToken value_ pos_ {-# INLINE rule265 #-} rule265 = \ _self -> _self {-# NOINLINE sem_HsToken_CharToken #-} sem_HsToken_CharToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_CharToken arg_value_ arg_pos_ = T_HsToken (return st53) where {-# NOINLINE st53 #-} st53 = let v52 :: T_HsToken_v52 v52 = \ (T_HsToken_vIn52 _lhsIpll _lhsIpts) -> ( let _lhsOused :: Set.Set MyOccurrence _lhsOused = rule266 () _self = rule267 arg_pos_ arg_value_ _lhsOself :: HsToken _lhsOself = rule268 _self __result_ = T_HsToken_vOut52 _lhsOself _lhsOused in __result_ ) in C_HsToken_s53 v52 {-# INLINE rule266 #-} rule266 = \ (_ :: ()) -> Set.empty {-# INLINE rule267 #-} rule267 = \ pos_ value_ -> CharToken value_ pos_ {-# INLINE rule268 #-} rule268 = \ _self -> _self {-# NOINLINE sem_HsToken_StrToken #-} sem_HsToken_StrToken :: (String) -> (Pos) -> T_HsToken sem_HsToken_StrToken arg_value_ arg_pos_ = T_HsToken (return st53) where {-# NOINLINE st53 #-} st53 = let v52 :: T_HsToken_v52 v52 = \ (T_HsToken_vIn52 _lhsIpll _lhsIpts) -> ( let _lhsOused :: Set.Set MyOccurrence _lhsOused = rule269 () _self = rule270 arg_pos_ arg_value_ _lhsOself :: HsToken _lhsOself = rule271 _self __result_ = T_HsToken_vOut52 _lhsOself _lhsOused in __result_ ) in C_HsToken_s53 v52 {-# INLINE rule269 #-} rule269 = \ (_ :: ()) -> Set.empty {-# INLINE rule270 #-} rule270 = \ pos_ value_ -> StrToken value_ pos_ {-# INLINE rule271 #-} rule271 = \ _self -> _self {-# NOINLINE sem_HsToken_Err #-} sem_HsToken_Err :: (String) -> (Pos) -> T_HsToken sem_HsToken_Err arg_mesg_ arg_pos_ = T_HsToken (return st53) where {-# NOINLINE st53 #-} st53 = let v52 :: T_HsToken_v52 v52 = \ (T_HsToken_vIn52 _lhsIpll _lhsIpts) -> ( let _lhsOused :: Set.Set MyOccurrence _lhsOused = rule272 () _self = rule273 arg_mesg_ arg_pos_ _lhsOself :: HsToken _lhsOself = rule274 _self __result_ = T_HsToken_vOut52 _lhsOself _lhsOused in __result_ ) in C_HsToken_s53 v52 {-# INLINE rule272 #-} rule272 = \ (_ :: ()) -> Set.empty {-# INLINE rule273 #-} rule273 = \ mesg_ pos_ -> Err mesg_ pos_ {-# INLINE rule274 #-} rule274 = \ _self -> _self -- HsTokens ---------------------------------------------------- -- wrapper data Inh_HsTokens = Inh_HsTokens { pll_Inh_HsTokens :: (PLabel), pts_Inh_HsTokens :: (Set.Set (FLabel)) } data Syn_HsTokens = Syn_HsTokens { self_Syn_HsTokens :: (HsTokens), used_Syn_HsTokens :: (Set.Set MyOccurrence) } {-# INLINABLE wrap_HsTokens #-} wrap_HsTokens :: T_HsTokens -> Inh_HsTokens -> (Syn_HsTokens ) wrap_HsTokens (T_HsTokens act) (Inh_HsTokens _lhsIpll _lhsIpts) = Control.Monad.Identity.runIdentity ( do sem <- act let arg55 = T_HsTokens_vIn55 _lhsIpll _lhsIpts (T_HsTokens_vOut55 _lhsOself _lhsOused) <- return (inv_HsTokens_s56 sem arg55) return (Syn_HsTokens _lhsOself _lhsOused) ) -- cata {-# NOINLINE sem_HsTokens #-} sem_HsTokens :: HsTokens -> T_HsTokens sem_HsTokens list = Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) -- semantic domain newtype T_HsTokens = T_HsTokens { attach_T_HsTokens :: Identity (T_HsTokens_s56 ) } newtype T_HsTokens_s56 = C_HsTokens_s56 { inv_HsTokens_s56 :: (T_HsTokens_v55 ) } data T_HsTokens_s57 = C_HsTokens_s57 type T_HsTokens_v55 = (T_HsTokens_vIn55 ) -> (T_HsTokens_vOut55 ) data T_HsTokens_vIn55 = T_HsTokens_vIn55 (PLabel) (Set.Set (FLabel)) data T_HsTokens_vOut55 = T_HsTokens_vOut55 (HsTokens) (Set.Set MyOccurrence) {-# NOINLINE sem_HsTokens_Cons #-} sem_HsTokens_Cons :: T_HsToken -> T_HsTokens -> T_HsTokens sem_HsTokens_Cons arg_hd_ arg_tl_ = T_HsTokens (return st56) where {-# NOINLINE st56 #-} st56 = let v55 :: T_HsTokens_v55 v55 = \ (T_HsTokens_vIn55 _lhsIpll _lhsIpts) -> ( let _hdX53 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_)) _tlX56 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_)) (T_HsToken_vOut52 _hdIself _hdIused) = inv_HsToken_s53 _hdX53 (T_HsToken_vIn52 _hdOpll _hdOpts) (T_HsTokens_vOut55 _tlIself _tlIused) = inv_HsTokens_s56 _tlX56 (T_HsTokens_vIn55 _tlOpll _tlOpts) _lhsOused :: Set.Set MyOccurrence _lhsOused = rule275 _hdIused _tlIused _self = rule276 _hdIself _tlIself _lhsOself :: HsTokens _lhsOself = rule277 _self _hdOpll = rule278 _lhsIpll _hdOpts = rule279 _lhsIpts _tlOpll = rule280 _lhsIpll _tlOpts = rule281 _lhsIpts __result_ = T_HsTokens_vOut55 _lhsOself _lhsOused in __result_ ) in C_HsTokens_s56 v55 {-# INLINE rule275 #-} rule275 = \ ((_hdIused) :: Set.Set MyOccurrence) ((_tlIused) :: Set.Set MyOccurrence) -> (Set.union _hdIused _tlIused) {-# INLINE rule276 #-} rule276 = \ ((_hdIself) :: HsToken) ((_tlIself) :: HsTokens) -> (:) _hdIself _tlIself {-# INLINE rule277 #-} rule277 = \ _self -> _self {-# INLINE rule278 #-} rule278 = \ ((_lhsIpll) :: PLabel) -> _lhsIpll {-# INLINE rule279 #-} rule279 = \ ((_lhsIpts) :: Set.Set (FLabel)) -> _lhsIpts {-# INLINE rule280 #-} rule280 = \ ((_lhsIpll) :: PLabel) -> _lhsIpll {-# INLINE rule281 #-} rule281 = \ ((_lhsIpts) :: Set.Set (FLabel)) -> _lhsIpts {-# NOINLINE sem_HsTokens_Nil #-} sem_HsTokens_Nil :: T_HsTokens sem_HsTokens_Nil = T_HsTokens (return st56) where {-# NOINLINE st56 #-} st56 = let v55 :: T_HsTokens_v55 v55 = \ (T_HsTokens_vIn55 _lhsIpll _lhsIpts) -> ( let _lhsOused :: Set.Set MyOccurrence _lhsOused = rule282 () _self = rule283 () _lhsOself :: HsTokens _lhsOself = rule284 _self __result_ = T_HsTokens_vOut55 _lhsOself _lhsOused in __result_ ) in C_HsTokens_s56 v55 {-# INLINE rule282 #-} rule282 = \ (_ :: ()) -> Set.empty {-# INLINE rule283 #-} rule283 = \ (_ :: ()) -> [] {-# INLINE rule284 #-} rule284 = \ _self -> _self -- HsTokensRoot ------------------------------------------------ -- wrapper data Inh_HsTokensRoot = Inh_HsTokensRoot { pll_Inh_HsTokensRoot :: (PLabel), pts_Inh_HsTokensRoot :: (Set.Set (FLabel)) } data Syn_HsTokensRoot = Syn_HsTokensRoot { self_Syn_HsTokensRoot :: (HsTokensRoot), used_Syn_HsTokensRoot :: (Set.Set MyOccurrence) } {-# INLINABLE wrap_HsTokensRoot #-} wrap_HsTokensRoot :: T_HsTokensRoot -> Inh_HsTokensRoot -> (Syn_HsTokensRoot ) wrap_HsTokensRoot (T_HsTokensRoot act) (Inh_HsTokensRoot _lhsIpll _lhsIpts) = Control.Monad.Identity.runIdentity ( do sem <- act let arg58 = T_HsTokensRoot_vIn58 _lhsIpll _lhsIpts (T_HsTokensRoot_vOut58 _lhsOself _lhsOused) <- return (inv_HsTokensRoot_s59 sem arg58) return (Syn_HsTokensRoot _lhsOself _lhsOused) ) -- cata {-# INLINE sem_HsTokensRoot #-} sem_HsTokensRoot :: HsTokensRoot -> T_HsTokensRoot sem_HsTokensRoot ( HsTokensRoot tokens_ ) = sem_HsTokensRoot_HsTokensRoot ( sem_HsTokens tokens_ ) -- semantic domain newtype T_HsTokensRoot = T_HsTokensRoot { attach_T_HsTokensRoot :: Identity (T_HsTokensRoot_s59 ) } newtype T_HsTokensRoot_s59 = C_HsTokensRoot_s59 { inv_HsTokensRoot_s59 :: (T_HsTokensRoot_v58 ) } data T_HsTokensRoot_s60 = C_HsTokensRoot_s60 type T_HsTokensRoot_v58 = (T_HsTokensRoot_vIn58 ) -> (T_HsTokensRoot_vOut58 ) data T_HsTokensRoot_vIn58 = T_HsTokensRoot_vIn58 (PLabel) (Set.Set (FLabel)) data T_HsTokensRoot_vOut58 = T_HsTokensRoot_vOut58 (HsTokensRoot) (Set.Set MyOccurrence) {-# NOINLINE sem_HsTokensRoot_HsTokensRoot #-} sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> T_HsTokensRoot sem_HsTokensRoot_HsTokensRoot arg_tokens_ = T_HsTokensRoot (return st59) where {-# NOINLINE st59 #-} st59 = let v58 :: T_HsTokensRoot_v58 v58 = \ (T_HsTokensRoot_vIn58 _lhsIpll _lhsIpts) -> ( let _tokensX56 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tokens_)) (T_HsTokens_vOut55 _tokensIself _tokensIused) = inv_HsTokens_s56 _tokensX56 (T_HsTokens_vIn55 _tokensOpll _tokensOpts) _lhsOused :: Set.Set MyOccurrence _lhsOused = rule285 _tokensIused _self = rule286 _tokensIself _lhsOself :: HsTokensRoot _lhsOself = rule287 _self _tokensOpll = rule288 _lhsIpll _tokensOpts = rule289 _lhsIpts __result_ = T_HsTokensRoot_vOut58 _lhsOself _lhsOused in __result_ ) in C_HsTokensRoot_s59 v58 {-# INLINE rule285 #-} rule285 = \ ((_tokensIused) :: Set.Set MyOccurrence) -> _tokensIused {-# INLINE rule286 #-} rule286 = \ ((_tokensIself) :: HsTokens) -> HsTokensRoot _tokensIself {-# INLINE rule287 #-} rule287 = \ _self -> _self {-# INLINE rule288 #-} rule288 = \ ((_lhsIpll) :: PLabel) -> _lhsIpll {-# INLINE rule289 #-} rule289 = \ ((_lhsIpts) :: Set.Set (FLabel)) -> _lhsIpts -- LOAGRep ----------------------------------------------------- -- wrapper data Inh_LOAGRep = Inh_LOAGRep { } data Syn_LOAGRep = Syn_LOAGRep { self_Syn_LOAGRep :: (LOAGRep) } {-# INLINABLE wrap_LOAGRep #-} wrap_LOAGRep :: T_LOAGRep -> Inh_LOAGRep -> (Syn_LOAGRep ) wrap_LOAGRep (T_LOAGRep act) (Inh_LOAGRep ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg61 = T_LOAGRep_vIn61 (T_LOAGRep_vOut61 _lhsOself) <- return (inv_LOAGRep_s62 sem arg61) return (Syn_LOAGRep _lhsOself) ) -- cata {-# INLINE sem_LOAGRep #-} sem_LOAGRep :: LOAGRep -> T_LOAGRep sem_LOAGRep ( LOAGRep ps_ ap_ an_ ain_ asn_ sfp_ pmp_ pmpr_ nmp_ nmpr_ gen_ inss_ ofld_ fty_ fieldMap_ fsInP_ ) = sem_LOAGRep_LOAGRep ps_ ap_ an_ ain_ asn_ sfp_ pmp_ pmpr_ nmp_ nmpr_ gen_ inss_ ofld_ fty_ fieldMap_ fsInP_ -- semantic domain newtype T_LOAGRep = T_LOAGRep { attach_T_LOAGRep :: Identity (T_LOAGRep_s62 ) } newtype T_LOAGRep_s62 = C_LOAGRep_s62 { inv_LOAGRep_s62 :: (T_LOAGRep_v61 ) } data T_LOAGRep_s63 = C_LOAGRep_s63 type T_LOAGRep_v61 = (T_LOAGRep_vIn61 ) -> (T_LOAGRep_vOut61 ) data T_LOAGRep_vIn61 = T_LOAGRep_vIn61 data T_LOAGRep_vOut61 = T_LOAGRep_vOut61 (LOAGRep) {-# NOINLINE sem_LOAGRep_LOAGRep #-} sem_LOAGRep_LOAGRep :: ([PLabel]) -> (A_P) -> (A_N) -> (AI_N) -> (AS_N) -> (SF_P) -> (PMP) -> (PMP_R) -> (NMP) -> (NMP_R) -> (A.Array Int Int) -> (A.Array Int [Int]) -> (A.Array Int Int) -> (FTY) -> (FMap) -> (Map.Map PLabel [(PLabel,FLabel)]) -> T_LOAGRep sem_LOAGRep_LOAGRep arg_ps_ arg_ap_ arg_an_ arg_ain_ arg_asn_ arg_sfp_ arg_pmp_ arg_pmpr_ arg_nmp_ arg_nmpr_ arg_gen_ arg_inss_ arg_ofld_ arg_fty_ arg_fieldMap_ arg_fsInP_ = T_LOAGRep (return st62) where {-# NOINLINE st62 #-} st62 = let v61 :: T_LOAGRep_v61 v61 = \ (T_LOAGRep_vIn61 ) -> ( let _self = rule290 arg_ain_ arg_an_ arg_ap_ arg_asn_ arg_fieldMap_ arg_fsInP_ arg_fty_ arg_gen_ arg_inss_ arg_nmp_ arg_nmpr_ arg_ofld_ arg_pmp_ arg_pmpr_ arg_ps_ arg_sfp_ _lhsOself :: LOAGRep _lhsOself = rule291 _self __result_ = T_LOAGRep_vOut61 _lhsOself in __result_ ) in C_LOAGRep_s62 v61 {-# INLINE rule290 #-} rule290 = \ ain_ an_ ap_ asn_ fieldMap_ fsInP_ fty_ gen_ inss_ nmp_ nmpr_ ofld_ pmp_ pmpr_ ps_ sfp_ -> LOAGRep ps_ ap_ an_ ain_ asn_ sfp_ pmp_ pmpr_ nmp_ nmpr_ gen_ inss_ ofld_ fty_ fieldMap_ fsInP_ {-# INLINE rule291 #-} rule291 = \ _self -> _self -- MySegment --------------------------------------------------- -- wrapper data Inh_MySegment = Inh_MySegment { ain_Inh_MySegment :: (MyType -> MyAttributes), asn_Inh_MySegment :: (MyType -> MyAttributes), done_Inh_MySegment :: ( (Set.Set MyOccurrence, Set.Set FLabel , Set.Set Identifier, Set.Set (FLabel,Int))), fty_Inh_MySegment :: (FTY), hoMapf_Inh_MySegment :: (HOMap), lfpf_Inh_MySegment :: (SF_P), nmp_Inh_MySegment :: (NMP), nmprf_Inh_MySegment :: (NMP_R), options_Inh_MySegment :: (Options), pmpf_Inh_MySegment :: (PMP), pmprf_Inh_MySegment :: (PMP_R), ps_Inh_MySegment :: (PLabel), ruleMap_Inh_MySegment :: (Map.Map MyOccurrence Identifier), tdp_Inh_MySegment :: (TDPRes), visMapf_Inh_MySegment :: (IMap.IntMap Int), visitnum_Inh_MySegment :: (Int) } data Syn_MySegment = Syn_MySegment { done_Syn_MySegment :: ( (Set.Set MyOccurrence, Set.Set FLabel ,Set.Set Identifier, Set.Set (FLabel,Int))), evisits_Syn_MySegment :: (Visit), self_Syn_MySegment :: (MySegment), synsO_Syn_MySegment :: ([Int]), visitnum_Syn_MySegment :: (Int), visnr_Syn_MySegment :: (Int) } {-# INLINABLE wrap_MySegment #-} wrap_MySegment :: T_MySegment -> Inh_MySegment -> (Syn_MySegment ) wrap_MySegment (T_MySegment act) (Inh_MySegment _lhsIain _lhsIasn _lhsIdone _lhsIfty _lhsIhoMapf _lhsIlfpf _lhsInmp _lhsInmprf _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIps _lhsIruleMap _lhsItdp _lhsIvisMapf _lhsIvisitnum) = Control.Monad.Identity.runIdentity ( do sem <- act let arg64 = T_MySegment_vIn64 _lhsIain _lhsIasn _lhsIdone _lhsIfty _lhsIhoMapf _lhsIlfpf _lhsInmp _lhsInmprf _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIps _lhsIruleMap _lhsItdp _lhsIvisMapf _lhsIvisitnum (T_MySegment_vOut64 _lhsOdone _lhsOevisits _lhsOself _lhsOsynsO _lhsOvisitnum _lhsOvisnr) <- return (inv_MySegment_s65 sem arg64) return (Syn_MySegment _lhsOdone _lhsOevisits _lhsOself _lhsOsynsO _lhsOvisitnum _lhsOvisnr) ) -- cata {-# INLINE sem_MySegment #-} sem_MySegment :: MySegment -> T_MySegment sem_MySegment ( MySegment visnr_ inhAttr_ synAttr_ inhOccs_ synOccs_ ) = sem_MySegment_MySegment visnr_ inhAttr_ synAttr_ inhOccs_ synOccs_ -- semantic domain newtype T_MySegment = T_MySegment { attach_T_MySegment :: Identity (T_MySegment_s65 ) } newtype T_MySegment_s65 = C_MySegment_s65 { inv_MySegment_s65 :: (T_MySegment_v64 ) } data T_MySegment_s66 = C_MySegment_s66 type T_MySegment_v64 = (T_MySegment_vIn64 ) -> (T_MySegment_vOut64 ) data T_MySegment_vIn64 = T_MySegment_vIn64 (MyType -> MyAttributes) (MyType -> MyAttributes) ( (Set.Set MyOccurrence, Set.Set FLabel , Set.Set Identifier, Set.Set (FLabel,Int))) (FTY) (HOMap) (SF_P) (NMP) (NMP_R) (Options) (PMP) (PMP_R) (PLabel) (Map.Map MyOccurrence Identifier) (TDPRes) (IMap.IntMap Int) (Int) data T_MySegment_vOut64 = T_MySegment_vOut64 ( (Set.Set MyOccurrence, Set.Set FLabel ,Set.Set Identifier, Set.Set (FLabel,Int))) (Visit) (MySegment) ([Int]) (Int) (Int) {-# NOINLINE sem_MySegment_MySegment #-} sem_MySegment_MySegment :: (Int) -> ([Int]) -> ([Int]) -> (Maybe [Int]) -> (Maybe [Int]) -> T_MySegment sem_MySegment_MySegment arg_visnr_ arg_inhAttr_ arg_synAttr_ arg_inhOccs_ arg_synOccs_ = T_MySegment (return st65) where {-# NOINLINE st65 #-} st65 = let v64 :: T_MySegment_v64 v64 = \ (T_MySegment_vIn64 _lhsIain _lhsIasn _lhsIdone _lhsIfty _lhsIhoMapf _lhsIlfpf _lhsInmp _lhsInmprf _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIps _lhsIruleMap _lhsItdp _lhsIvisMapf _lhsIvisitnum) -> ( let _lhsOvisitnum :: Int _lhsOvisitnum = rule292 _visitnum_augmented_f1 _visitnum_augmented_syn _visitnum_augmented_f1 = rule293 () _inhs = rule294 _lhsInmp arg_inhAttr_ _syns = rule295 _lhsInmp arg_synAttr_ _inhsO = rule296 arg_inhOccs_ _synsO = rule297 arg_synOccs_ _lhsOvisnr :: Int _lhsOvisnr = rule298 arg_visnr_ _kind = rule299 _lhsIoptions _lhsOevisits :: Visit _lhsOevisits = rule300 _inhs _kind _lhsIvisitnum _steps _syns _steps = rule301 _lhsIoptions _vss _lhsOdone :: (Set.Set MyOccurrence, Set.Set FLabel ,Set.Set Identifier, Set.Set (FLabel,Int)) (_vss,_lhsOdone) = rule302 _lhsIdone _lhsIfty _lhsIhoMapf _lhsIlfpf _lhsInmprf _lhsIpmpf _lhsIpmprf _lhsIps _lhsIruleMap _lhsItdp _lhsIvisMapf _synsO _self = rule303 arg_inhAttr_ arg_inhOccs_ arg_synAttr_ arg_synOccs_ arg_visnr_ _lhsOself :: MySegment _lhsOself = rule304 _self _lhsOsynsO :: [Int] _lhsOsynsO = rule305 _synsO _visitnum_augmented_syn = rule306 _lhsIvisitnum __result_ = T_MySegment_vOut64 _lhsOdone _lhsOevisits _lhsOself _lhsOsynsO _lhsOvisitnum _lhsOvisnr in __result_ ) in C_MySegment_s65 v64 {-# INLINE rule292 #-} rule292 = \ _visitnum_augmented_f1 _visitnum_augmented_syn -> foldr ($) _visitnum_augmented_syn [_visitnum_augmented_f1] {-# INLINE rule293 #-} rule293 = \ (_ :: ()) -> (+1) {-# INLINE rule294 #-} {-# LINE 225 "src-ag/LOAG/Order.ag" #-} rule294 = \ ((_lhsInmp) :: NMP) inhAttr_ -> {-# LINE 225 "src-ag/LOAG/Order.ag" #-} Map.keysSet$ Map.unions $ map (vertexToAttr _lhsInmp) inhAttr_ {-# LINE 3030 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule295 #-} {-# LINE 226 "src-ag/LOAG/Order.ag" #-} rule295 = \ ((_lhsInmp) :: NMP) synAttr_ -> {-# LINE 226 "src-ag/LOAG/Order.ag" #-} Map.keysSet$ Map.unions $ map (vertexToAttr _lhsInmp) synAttr_ {-# LINE 3036 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule296 #-} {-# LINE 227 "src-ag/LOAG/Order.ag" #-} rule296 = \ inhOccs_ -> {-# LINE 227 "src-ag/LOAG/Order.ag" #-} maybe (error "segment not instantiated") id inhOccs_ {-# LINE 3042 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule297 #-} {-# LINE 228 "src-ag/LOAG/Order.ag" #-} rule297 = \ synOccs_ -> {-# LINE 228 "src-ag/LOAG/Order.ag" #-} maybe (error "segment not instantiated") id synOccs_ {-# LINE 3048 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule298 #-} {-# LINE 229 "src-ag/LOAG/Order.ag" #-} rule298 = \ visnr_ -> {-# LINE 229 "src-ag/LOAG/Order.ag" #-} visnr_ {-# LINE 3054 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule299 #-} {-# LINE 230 "src-ag/LOAG/Order.ag" #-} rule299 = \ ((_lhsIoptions) :: Options) -> {-# LINE 230 "src-ag/LOAG/Order.ag" #-} if monadic _lhsIoptions then VisitMonadic else VisitPure True {-# LINE 3060 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule300 #-} {-# LINE 231 "src-ag/LOAG/Order.ag" #-} rule300 = \ _inhs _kind ((_lhsIvisitnum) :: Int) _steps _syns -> {-# LINE 231 "src-ag/LOAG/Order.ag" #-} Visit _lhsIvisitnum _lhsIvisitnum (_lhsIvisitnum+1) _inhs _syns _steps _kind {-# LINE 3067 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule301 #-} {-# LINE 233 "src-ag/LOAG/Order.ag" #-} rule301 = \ ((_lhsIoptions) :: Options) _vss -> {-# LINE 233 "src-ag/LOAG/Order.ag" #-} if monadic _lhsIoptions then [Sim _vss ] else [PureGroup _vss True] {-# LINE 3074 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule302 #-} {-# LINE 235 "src-ag/LOAG/Order.ag" #-} rule302 = \ ((_lhsIdone) :: (Set.Set MyOccurrence, Set.Set FLabel , Set.Set Identifier, Set.Set (FLabel,Int))) ((_lhsIfty) :: FTY) ((_lhsIhoMapf) :: HOMap) ((_lhsIlfpf) :: SF_P) ((_lhsInmprf) :: NMP_R) ((_lhsIpmpf) :: PMP) ((_lhsIpmprf) :: PMP_R) ((_lhsIps) :: PLabel) ((_lhsIruleMap) :: Map.Map MyOccurrence Identifier) ((_lhsItdp) :: TDPRes) ((_lhsIvisMapf) :: IMap.IntMap Int) _synsO -> {-# LINE 235 "src-ag/LOAG/Order.ag" #-} (runST $ getVss _lhsIdone _lhsIps _lhsItdp _synsO _lhsIlfpf _lhsInmprf _lhsIpmpf _lhsIpmprf _lhsIfty _lhsIvisMapf _lhsIruleMap _lhsIhoMapf) {-# LINE 3083 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule303 #-} rule303 = \ inhAttr_ inhOccs_ synAttr_ synOccs_ visnr_ -> MySegment visnr_ inhAttr_ synAttr_ inhOccs_ synOccs_ {-# INLINE rule304 #-} rule304 = \ _self -> _self {-# INLINE rule305 #-} rule305 = \ _synsO -> _synsO {-# INLINE rule306 #-} rule306 = \ ((_lhsIvisitnum) :: Int) -> _lhsIvisitnum -- MySegments -------------------------------------------------- -- wrapper data Inh_MySegments = Inh_MySegments { ain_Inh_MySegments :: (MyType -> MyAttributes), asn_Inh_MySegments :: (MyType -> MyAttributes), done_Inh_MySegments :: ( (Set.Set MyOccurrence, Set.Set FLabel , Set.Set Identifier, Set.Set (FLabel,Int))), fty_Inh_MySegments :: (FTY), hoMapf_Inh_MySegments :: (HOMap), lfpf_Inh_MySegments :: (SF_P), nmp_Inh_MySegments :: (NMP), nmprf_Inh_MySegments :: (NMP_R), options_Inh_MySegments :: (Options), pmpf_Inh_MySegments :: (PMP), pmprf_Inh_MySegments :: (PMP_R), ps_Inh_MySegments :: (PLabel), ruleMap_Inh_MySegments :: (Map.Map MyOccurrence Identifier), tdp_Inh_MySegments :: (TDPRes), visMapf_Inh_MySegments :: (IMap.IntMap Int), visitnum_Inh_MySegments :: (Int) } data Syn_MySegments = Syn_MySegments { evisits_Syn_MySegments :: (Visits), self_Syn_MySegments :: (MySegments), visitnum_Syn_MySegments :: (Int) } {-# INLINABLE wrap_MySegments #-} wrap_MySegments :: T_MySegments -> Inh_MySegments -> (Syn_MySegments ) wrap_MySegments (T_MySegments act) (Inh_MySegments _lhsIain _lhsIasn _lhsIdone _lhsIfty _lhsIhoMapf _lhsIlfpf _lhsInmp _lhsInmprf _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIps _lhsIruleMap _lhsItdp _lhsIvisMapf _lhsIvisitnum) = Control.Monad.Identity.runIdentity ( do sem <- act let arg67 = T_MySegments_vIn67 _lhsIain _lhsIasn _lhsIdone _lhsIfty _lhsIhoMapf _lhsIlfpf _lhsInmp _lhsInmprf _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIps _lhsIruleMap _lhsItdp _lhsIvisMapf _lhsIvisitnum (T_MySegments_vOut67 _lhsOevisits _lhsOself _lhsOvisitnum) <- return (inv_MySegments_s68 sem arg67) return (Syn_MySegments _lhsOevisits _lhsOself _lhsOvisitnum) ) -- cata {-# NOINLINE sem_MySegments #-} sem_MySegments :: MySegments -> T_MySegments sem_MySegments list = Prelude.foldr sem_MySegments_Cons sem_MySegments_Nil (Prelude.map sem_MySegment list) -- semantic domain newtype T_MySegments = T_MySegments { attach_T_MySegments :: Identity (T_MySegments_s68 ) } newtype T_MySegments_s68 = C_MySegments_s68 { inv_MySegments_s68 :: (T_MySegments_v67 ) } data T_MySegments_s69 = C_MySegments_s69 type T_MySegments_v67 = (T_MySegments_vIn67 ) -> (T_MySegments_vOut67 ) data T_MySegments_vIn67 = T_MySegments_vIn67 (MyType -> MyAttributes) (MyType -> MyAttributes) ( (Set.Set MyOccurrence, Set.Set FLabel , Set.Set Identifier, Set.Set (FLabel,Int))) (FTY) (HOMap) (SF_P) (NMP) (NMP_R) (Options) (PMP) (PMP_R) (PLabel) (Map.Map MyOccurrence Identifier) (TDPRes) (IMap.IntMap Int) (Int) data T_MySegments_vOut67 = T_MySegments_vOut67 (Visits) (MySegments) (Int) {-# NOINLINE sem_MySegments_Cons #-} sem_MySegments_Cons :: T_MySegment -> T_MySegments -> T_MySegments sem_MySegments_Cons arg_hd_ arg_tl_ = T_MySegments (return st68) where {-# NOINLINE st68 #-} st68 = let v67 :: T_MySegments_v67 v67 = \ (T_MySegments_vIn67 _lhsIain _lhsIasn _lhsIdone _lhsIfty _lhsIhoMapf _lhsIlfpf _lhsInmp _lhsInmprf _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIps _lhsIruleMap _lhsItdp _lhsIvisMapf _lhsIvisitnum) -> ( let _hdX65 = Control.Monad.Identity.runIdentity (attach_T_MySegment (arg_hd_)) _tlX68 = Control.Monad.Identity.runIdentity (attach_T_MySegments (arg_tl_)) (T_MySegment_vOut64 _hdIdone _hdIevisits _hdIself _hdIsynsO _hdIvisitnum _hdIvisnr) = inv_MySegment_s65 _hdX65 (T_MySegment_vIn64 _hdOain _hdOasn _hdOdone _hdOfty _hdOhoMapf _hdOlfpf _hdOnmp _hdOnmprf _hdOoptions _hdOpmpf _hdOpmprf _hdOps _hdOruleMap _hdOtdp _hdOvisMapf _hdOvisitnum) (T_MySegments_vOut67 _tlIevisits _tlIself _tlIvisitnum) = inv_MySegments_s68 _tlX68 (T_MySegments_vIn67 _tlOain _tlOasn _tlOdone _tlOfty _tlOhoMapf _tlOlfpf _tlOnmp _tlOnmprf _tlOoptions _tlOpmpf _tlOpmprf _tlOps _tlOruleMap _tlOtdp _tlOvisMapf _tlOvisitnum) _hdOdone = rule307 _lhsIdone _tlOdone = rule308 _hdIdone _lhsOevisits :: Visits _lhsOevisits = rule309 _hdIevisits _tlIevisits _self = rule310 _hdIself _tlIself _lhsOself :: MySegments _lhsOself = rule311 _self _lhsOvisitnum :: Int _lhsOvisitnum = rule312 _tlIvisitnum _hdOain = rule313 _lhsIain _hdOasn = rule314 _lhsIasn _hdOfty = rule315 _lhsIfty _hdOhoMapf = rule316 _lhsIhoMapf _hdOlfpf = rule317 _lhsIlfpf _hdOnmp = rule318 _lhsInmp _hdOnmprf = rule319 _lhsInmprf _hdOoptions = rule320 _lhsIoptions _hdOpmpf = rule321 _lhsIpmpf _hdOpmprf = rule322 _lhsIpmprf _hdOps = rule323 _lhsIps _hdOruleMap = rule324 _lhsIruleMap _hdOtdp = rule325 _lhsItdp _hdOvisMapf = rule326 _lhsIvisMapf _hdOvisitnum = rule327 _lhsIvisitnum _tlOain = rule328 _lhsIain _tlOasn = rule329 _lhsIasn _tlOfty = rule330 _lhsIfty _tlOhoMapf = rule331 _lhsIhoMapf _tlOlfpf = rule332 _lhsIlfpf _tlOnmp = rule333 _lhsInmp _tlOnmprf = rule334 _lhsInmprf _tlOoptions = rule335 _lhsIoptions _tlOpmpf = rule336 _lhsIpmpf _tlOpmprf = rule337 _lhsIpmprf _tlOps = rule338 _lhsIps _tlOruleMap = rule339 _lhsIruleMap _tlOtdp = rule340 _lhsItdp _tlOvisMapf = rule341 _lhsIvisMapf _tlOvisitnum = rule342 _hdIvisitnum __result_ = T_MySegments_vOut67 _lhsOevisits _lhsOself _lhsOvisitnum in __result_ ) in C_MySegments_s68 v67 {-# INLINE rule307 #-} {-# LINE 220 "src-ag/LOAG/Order.ag" #-} rule307 = \ ((_lhsIdone) :: (Set.Set MyOccurrence, Set.Set FLabel , Set.Set Identifier, Set.Set (FLabel,Int))) -> {-# LINE 220 "src-ag/LOAG/Order.ag" #-} _lhsIdone {-# LINE 3188 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule308 #-} {-# LINE 221 "src-ag/LOAG/Order.ag" #-} rule308 = \ ((_hdIdone) :: (Set.Set MyOccurrence, Set.Set FLabel ,Set.Set Identifier, Set.Set (FLabel,Int))) -> {-# LINE 221 "src-ag/LOAG/Order.ag" #-} _hdIdone {-# LINE 3195 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule309 #-} rule309 = \ ((_hdIevisits) :: Visit) ((_tlIevisits) :: Visits) -> _hdIevisits : _tlIevisits {-# INLINE rule310 #-} rule310 = \ ((_hdIself) :: MySegment) ((_tlIself) :: MySegments) -> (:) _hdIself _tlIself {-# INLINE rule311 #-} rule311 = \ _self -> _self {-# INLINE rule312 #-} rule312 = \ ((_tlIvisitnum) :: Int) -> _tlIvisitnum {-# INLINE rule313 #-} rule313 = \ ((_lhsIain) :: MyType -> MyAttributes) -> _lhsIain {-# INLINE rule314 #-} rule314 = \ ((_lhsIasn) :: MyType -> MyAttributes) -> _lhsIasn {-# INLINE rule315 #-} rule315 = \ ((_lhsIfty) :: FTY) -> _lhsIfty {-# INLINE rule316 #-} rule316 = \ ((_lhsIhoMapf) :: HOMap) -> _lhsIhoMapf {-# INLINE rule317 #-} rule317 = \ ((_lhsIlfpf) :: SF_P) -> _lhsIlfpf {-# INLINE rule318 #-} rule318 = \ ((_lhsInmp) :: NMP) -> _lhsInmp {-# INLINE rule319 #-} rule319 = \ ((_lhsInmprf) :: NMP_R) -> _lhsInmprf {-# INLINE rule320 #-} rule320 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule321 #-} rule321 = \ ((_lhsIpmpf) :: PMP) -> _lhsIpmpf {-# INLINE rule322 #-} rule322 = \ ((_lhsIpmprf) :: PMP_R) -> _lhsIpmprf {-# INLINE rule323 #-} rule323 = \ ((_lhsIps) :: PLabel) -> _lhsIps {-# INLINE rule324 #-} rule324 = \ ((_lhsIruleMap) :: Map.Map MyOccurrence Identifier) -> _lhsIruleMap {-# INLINE rule325 #-} rule325 = \ ((_lhsItdp) :: TDPRes) -> _lhsItdp {-# INLINE rule326 #-} rule326 = \ ((_lhsIvisMapf) :: IMap.IntMap Int) -> _lhsIvisMapf {-# INLINE rule327 #-} rule327 = \ ((_lhsIvisitnum) :: Int) -> _lhsIvisitnum {-# INLINE rule328 #-} rule328 = \ ((_lhsIain) :: MyType -> MyAttributes) -> _lhsIain {-# INLINE rule329 #-} rule329 = \ ((_lhsIasn) :: MyType -> MyAttributes) -> _lhsIasn {-# INLINE rule330 #-} rule330 = \ ((_lhsIfty) :: FTY) -> _lhsIfty {-# INLINE rule331 #-} rule331 = \ ((_lhsIhoMapf) :: HOMap) -> _lhsIhoMapf {-# INLINE rule332 #-} rule332 = \ ((_lhsIlfpf) :: SF_P) -> _lhsIlfpf {-# INLINE rule333 #-} rule333 = \ ((_lhsInmp) :: NMP) -> _lhsInmp {-# INLINE rule334 #-} rule334 = \ ((_lhsInmprf) :: NMP_R) -> _lhsInmprf {-# INLINE rule335 #-} rule335 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule336 #-} rule336 = \ ((_lhsIpmpf) :: PMP) -> _lhsIpmpf {-# INLINE rule337 #-} rule337 = \ ((_lhsIpmprf) :: PMP_R) -> _lhsIpmprf {-# INLINE rule338 #-} rule338 = \ ((_lhsIps) :: PLabel) -> _lhsIps {-# INLINE rule339 #-} rule339 = \ ((_lhsIruleMap) :: Map.Map MyOccurrence Identifier) -> _lhsIruleMap {-# INLINE rule340 #-} rule340 = \ ((_lhsItdp) :: TDPRes) -> _lhsItdp {-# INLINE rule341 #-} rule341 = \ ((_lhsIvisMapf) :: IMap.IntMap Int) -> _lhsIvisMapf {-# INLINE rule342 #-} rule342 = \ ((_hdIvisitnum) :: Int) -> _hdIvisitnum {-# NOINLINE sem_MySegments_Nil #-} sem_MySegments_Nil :: T_MySegments sem_MySegments_Nil = T_MySegments (return st68) where {-# NOINLINE st68 #-} st68 = let v67 :: T_MySegments_v67 v67 = \ (T_MySegments_vIn67 _lhsIain _lhsIasn _lhsIdone _lhsIfty _lhsIhoMapf _lhsIlfpf _lhsInmp _lhsInmprf _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIps _lhsIruleMap _lhsItdp _lhsIvisMapf _lhsIvisitnum) -> ( let _lhsOevisits :: Visits _lhsOevisits = rule343 () _self = rule344 () _lhsOself :: MySegments _lhsOself = rule345 _self _lhsOvisitnum :: Int _lhsOvisitnum = rule346 _lhsIvisitnum __result_ = T_MySegments_vOut67 _lhsOevisits _lhsOself _lhsOvisitnum in __result_ ) in C_MySegments_s68 v67 {-# INLINE rule343 #-} rule343 = \ (_ :: ()) -> [] {-# INLINE rule344 #-} rule344 = \ (_ :: ()) -> [] {-# INLINE rule345 #-} rule345 = \ _self -> _self {-# INLINE rule346 #-} rule346 = \ ((_lhsIvisitnum) :: Int) -> _lhsIvisitnum -- Nonterminal ------------------------------------------------- -- wrapper data Inh_Nonterminal = Inh_Nonterminal { ain_Inh_Nonterminal :: (MyType -> MyAttributes), an_Inh_Nonterminal :: (MyType -> MyAttributes), aroundMap_Inh_Nonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), asn_Inh_Nonterminal :: (MyType -> MyAttributes), augM_Inh_Nonterminal :: (Map.Map Identifier (Map.Map Identifier (Set.Set Dependency))), classContexts_Inh_Nonterminal :: (ContextMap), closedHoNtDeps_Inh_Nonterminal :: (Map NontermIdent (Set NontermIdent)), closedHoNtRevDeps_Inh_Nonterminal :: (Map NontermIdent (Set NontermIdent)), closedNtDeps_Inh_Nonterminal :: (Map NontermIdent (Set NontermIdent)), flab_Inh_Nonterminal :: (Int), fty_Inh_Nonterminal :: (FTY), ftyf_Inh_Nonterminal :: (FTY), hoMapf_Inh_Nonterminal :: (HOMap), lfpf_Inh_Nonterminal :: (SF_P), mergeMap_Inh_Nonterminal :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))), nmp_Inh_Nonterminal :: (NMP), nmprf_Inh_Nonterminal :: (NMP_R), olab_Inh_Nonterminal :: (Int), options_Inh_Nonterminal :: (Options), pmpf_Inh_Nonterminal :: (PMP), pmprf_Inh_Nonterminal :: (PMP_R), res_ads_Inh_Nonterminal :: ([Edge]), rulenumber_Inh_Nonterminal :: (Int), sched_Inh_Nonterminal :: (InterfaceRes), tdp_Inh_Nonterminal :: (TDPRes), visMapf_Inh_Nonterminal :: (IMap.IntMap Int), visitnum_Inh_Nonterminal :: (Int) } data Syn_Nonterminal = Syn_Nonterminal { ads_Syn_Nonterminal :: ([Edge]), ap_Syn_Nonterminal :: (A_P), enonts_Syn_Nonterminal :: (ENonterminals), fdps_Syn_Nonterminal :: (AttrOrderMap), fieldMap_Syn_Nonterminal :: (FMap), flab_Syn_Nonterminal :: (Int), fsInP_Syn_Nonterminal :: (FsInP), fty_Syn_Nonterminal :: (FTY), gen_Syn_Nonterminal :: (Map Int Int), hoMap_Syn_Nonterminal :: (HOMap), inhmap_Syn_Nonterminal :: (Map.Map NontermIdent Attributes), inhs_Syn_Nonterminal :: (AI_N), inss_Syn_Nonterminal :: (Map Int [Int]), lfp_Syn_Nonterminal :: (SF_P), lfpr_Syn_Nonterminal :: (SF_P), localSigMap_Syn_Nonterminal :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))), ntDeps_Syn_Nonterminal :: (Map NontermIdent (Set NontermIdent)), ntHoDeps_Syn_Nonterminal :: (Map NontermIdent (Set NontermIdent)), ofld_Syn_Nonterminal :: ([(Int, Int)]), olab_Syn_Nonterminal :: (Int), pmp_Syn_Nonterminal :: (PMP), pmpr_Syn_Nonterminal :: (PMP_R), ps_Syn_Nonterminal :: ([PLabel]), ruleMap_Syn_Nonterminal :: (Map.Map MyOccurrence Identifier), rulenumber_Syn_Nonterminal :: (Int), self_Syn_Nonterminal :: (Nonterminal), sfp_Syn_Nonterminal :: (SF_P), synmap_Syn_Nonterminal :: (Map.Map NontermIdent Attributes), syns_Syn_Nonterminal :: (AS_N), visMap_Syn_Nonterminal :: (IMap.IntMap Int), visitnum_Syn_Nonterminal :: (Int) } {-# INLINABLE wrap_Nonterminal #-} wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal ) wrap_Nonterminal (T_Nonterminal act) (Inh_Nonterminal _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIaugM _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIflab _lhsIfty _lhsIftyf _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIres_ads _lhsIrulenumber _lhsIsched _lhsItdp _lhsIvisMapf _lhsIvisitnum) = Control.Monad.Identity.runIdentity ( do sem <- act let arg70 = T_Nonterminal_vIn70 _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIaugM _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIflab _lhsIfty _lhsIftyf _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIres_ads _lhsIrulenumber _lhsIsched _lhsItdp _lhsIvisMapf _lhsIvisitnum (T_Nonterminal_vOut70 _lhsOads _lhsOap _lhsOenonts _lhsOfdps _lhsOfieldMap _lhsOflab _lhsOfsInP _lhsOfty _lhsOgen _lhsOhoMap _lhsOinhmap _lhsOinhs _lhsOinss _lhsOlfp _lhsOlfpr _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOps _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOsynmap _lhsOsyns _lhsOvisMap _lhsOvisitnum) <- return (inv_Nonterminal_s71 sem arg70) return (Syn_Nonterminal _lhsOads _lhsOap _lhsOenonts _lhsOfdps _lhsOfieldMap _lhsOflab _lhsOfsInP _lhsOfty _lhsOgen _lhsOhoMap _lhsOinhmap _lhsOinhs _lhsOinss _lhsOlfp _lhsOlfpr _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOps _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOsynmap _lhsOsyns _lhsOvisMap _lhsOvisitnum) ) -- cata {-# INLINE sem_Nonterminal #-} sem_Nonterminal :: Nonterminal -> T_Nonterminal sem_Nonterminal ( Nonterminal nt_ params_ inh_ syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ ) -- semantic domain newtype T_Nonterminal = T_Nonterminal { attach_T_Nonterminal :: Identity (T_Nonterminal_s71 ) } newtype T_Nonterminal_s71 = C_Nonterminal_s71 { inv_Nonterminal_s71 :: (T_Nonterminal_v70 ) } data T_Nonterminal_s72 = C_Nonterminal_s72 type T_Nonterminal_v70 = (T_Nonterminal_vIn70 ) -> (T_Nonterminal_vOut70 ) data T_Nonterminal_vIn70 = T_Nonterminal_vIn70 (MyType -> MyAttributes) (MyType -> MyAttributes) (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) (MyType -> MyAttributes) (Map.Map Identifier (Map.Map Identifier (Set.Set Dependency))) (ContextMap) (Map NontermIdent (Set NontermIdent)) (Map NontermIdent (Set NontermIdent)) (Map NontermIdent (Set NontermIdent)) (Int) (FTY) (FTY) (HOMap) (SF_P) (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) (NMP) (NMP_R) (Int) (Options) (PMP) (PMP_R) ([Edge]) (Int) (InterfaceRes) (TDPRes) (IMap.IntMap Int) (Int) data T_Nonterminal_vOut70 = T_Nonterminal_vOut70 ([Edge]) (A_P) (ENonterminals) (AttrOrderMap) (FMap) (Int) (FsInP) (FTY) (Map Int Int) (HOMap) (Map.Map NontermIdent Attributes) (AI_N) (Map Int [Int]) (SF_P) (SF_P) (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) (Map NontermIdent (Set NontermIdent)) (Map NontermIdent (Set NontermIdent)) ([(Int, Int)]) (Int) (PMP) (PMP_R) ([PLabel]) (Map.Map MyOccurrence Identifier) (Int) (Nonterminal) (SF_P) (Map.Map NontermIdent Attributes) (AS_N) (IMap.IntMap Int) (Int) {-# NOINLINE sem_Nonterminal_Nonterminal #-} sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal sem_Nonterminal_Nonterminal arg_nt_ arg_params_ arg_inh_ arg_syn_ arg_prods_ = T_Nonterminal (return st71) where {-# NOINLINE st71 #-} st71 = let v70 :: T_Nonterminal_v70 v70 = \ (T_Nonterminal_vIn70 _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIaugM _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIflab _lhsIfty _lhsIftyf _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIres_ads _lhsIrulenumber _lhsIsched _lhsItdp _lhsIvisMapf _lhsIvisitnum) -> ( let _prodsX86 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) (T_Productions_vOut85 _prodsIads _prodsIap _prodsIeprods _prodsIfdps _prodsIfieldMap _prodsIflab _prodsIfsInP _prodsIfty _prodsIgen _prodsIhoMap _prodsIinss _prodsIlfp _prodsIlfpr _prodsIlocalSigMap _prodsIofld _prodsIolab _prodsIpmp _prodsIpmpr _prodsIps _prodsIrefHoNts _prodsIrefNts _prodsIruleMap _prodsIrulenumber _prodsIself _prodsIsfp _prodsIvisitnum) = inv_Productions_s86 _prodsX86 (T_Productions_vIn85 _prodsOain _prodsOan _prodsOaroundMap _prodsOasn _prodsOaugM _prodsOdty _prodsOflab _prodsOfty _prodsOftyf _prodsOhoMapf _prodsOlfpf _prodsOmergeMap _prodsOmysegments _prodsOnmp _prodsOnmprf _prodsOolab _prodsOoptions _prodsOpmpf _prodsOpmprf _prodsOres_ads _prodsOrulenumber _prodsOtdp _prodsOvisMapf _prodsOvisitnum) _lhsOntDeps :: Map NontermIdent (Set NontermIdent) _lhsOntDeps = rule347 _prodsIrefNts arg_nt_ _lhsOntHoDeps :: Map NontermIdent (Set NontermIdent) _lhsOntHoDeps = rule348 _prodsIrefHoNts arg_nt_ _closedNtDeps = rule349 _lhsIclosedNtDeps arg_nt_ _closedHoNtDeps = rule350 _lhsIclosedHoNtDeps arg_nt_ _closedHoNtRevDeps = rule351 _lhsIclosedHoNtRevDeps arg_nt_ _recursive = rule352 _closedNtDeps arg_nt_ _nontrivAcyc = rule353 _closedHoNtDeps arg_nt_ _hoInfo = rule354 _closedHoNtDeps _closedHoNtRevDeps _nontrivAcyc _classContexts = rule355 _lhsIclassContexts arg_nt_ _aroundMap = rule356 _lhsIaroundMap arg_nt_ _mergeMap = rule357 _lhsImergeMap arg_nt_ _lhsOinhmap :: Map.Map NontermIdent Attributes _lhsOinhmap = rule358 arg_inh_ arg_nt_ _lhsOsynmap :: Map.Map NontermIdent Attributes _lhsOsynmap = rule359 arg_nt_ arg_syn_ _lhsOlocalSigMap :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type)) _lhsOlocalSigMap = rule360 _prodsIlocalSigMap arg_nt_ _lhsOinhs :: AI_N _lhsOinhs = rule361 arg_inh_ arg_nt_ _lhsOsyns :: AS_N _lhsOsyns = rule362 arg_nt_ arg_syn_ _prodsOaugM = rule363 _lhsIaugM arg_nt_ _dty = rule364 arg_nt_ _lhsOfdps :: AttrOrderMap _lhsOfdps = rule365 _prodsIfdps arg_nt_ _initial = rule366 _lhsIvisitnum _vnums = rule367 _initial _segments _initialVisit = rule368 _vnums _nextVis = rule369 _initial _vnums _prevVis = rule370 _initial _vnums _visMap = rule371 _initial _mysegments _lhsOenonts :: ENonterminals _lhsOenonts = rule372 _classContexts _hoInfo _initial _initialVisit _nextVis _prevVis _prodsIeprods _recursive arg_nt_ arg_params_ _assigned = rule373 _lhsIsched arg_nt_ _mx = rule374 _assigned _lhsIsched _mysegments = rule375 _assigned _mx _segments = rule376 _lhsInmp _mysegments _lhsOads :: [Edge] _lhsOads = rule377 _prodsIads _lhsOap :: A_P _lhsOap = rule378 _prodsIap _lhsOfieldMap :: FMap _lhsOfieldMap = rule379 _prodsIfieldMap _lhsOfsInP :: FsInP _lhsOfsInP = rule380 _prodsIfsInP _lhsOfty :: FTY _lhsOfty = rule381 _prodsIfty _lhsOgen :: Map Int Int _lhsOgen = rule382 _prodsIgen _lhsOhoMap :: HOMap _lhsOhoMap = rule383 _prodsIhoMap _lhsOinss :: Map Int [Int] _lhsOinss = rule384 _prodsIinss _lhsOlfp :: SF_P _lhsOlfp = rule385 _prodsIlfp _lhsOlfpr :: SF_P _lhsOlfpr = rule386 _prodsIlfpr _lhsOofld :: [(Int, Int)] _lhsOofld = rule387 _prodsIofld _lhsOpmp :: PMP _lhsOpmp = rule388 _prodsIpmp _lhsOpmpr :: PMP_R _lhsOpmpr = rule389 _prodsIpmpr _lhsOps :: [PLabel] _lhsOps = rule390 _prodsIps _lhsOruleMap :: Map.Map MyOccurrence Identifier _lhsOruleMap = rule391 _prodsIruleMap _lhsOsfp :: SF_P _lhsOsfp = rule392 _prodsIsfp _lhsOvisMap :: IMap.IntMap Int _lhsOvisMap = rule393 _visMap _self = rule394 _prodsIself arg_inh_ arg_nt_ arg_params_ arg_syn_ _lhsOself :: Nonterminal _lhsOself = rule395 _self _lhsOflab :: Int _lhsOflab = rule396 _prodsIflab _lhsOolab :: Int _lhsOolab = rule397 _prodsIolab _lhsOrulenumber :: Int _lhsOrulenumber = rule398 _prodsIrulenumber _lhsOvisitnum :: Int _lhsOvisitnum = rule399 _prodsIvisitnum _prodsOain = rule400 _lhsIain _prodsOan = rule401 _lhsIan _prodsOaroundMap = rule402 _aroundMap _prodsOasn = rule403 _lhsIasn _prodsOdty = rule404 _dty _prodsOflab = rule405 _lhsIflab _prodsOfty = rule406 _lhsIfty _prodsOftyf = rule407 _lhsIftyf _prodsOhoMapf = rule408 _lhsIhoMapf _prodsOlfpf = rule409 _lhsIlfpf _prodsOmergeMap = rule410 _mergeMap _prodsOmysegments = rule411 _mysegments _prodsOnmp = rule412 _lhsInmp _prodsOnmprf = rule413 _lhsInmprf _prodsOolab = rule414 _lhsIolab _prodsOoptions = rule415 _lhsIoptions _prodsOpmpf = rule416 _lhsIpmpf _prodsOpmprf = rule417 _lhsIpmprf _prodsOres_ads = rule418 _lhsIres_ads _prodsOrulenumber = rule419 _lhsIrulenumber _prodsOtdp = rule420 _lhsItdp _prodsOvisMapf = rule421 _lhsIvisMapf _prodsOvisitnum = rule422 _lhsIvisitnum __result_ = T_Nonterminal_vOut70 _lhsOads _lhsOap _lhsOenonts _lhsOfdps _lhsOfieldMap _lhsOflab _lhsOfsInP _lhsOfty _lhsOgen _lhsOhoMap _lhsOinhmap _lhsOinhs _lhsOinss _lhsOlfp _lhsOlfpr _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOps _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOsynmap _lhsOsyns _lhsOvisMap _lhsOvisitnum in __result_ ) in C_Nonterminal_s71 v70 {-# INLINE rule347 #-} {-# LINE 16 "src-ag/ExecutionPlanCommon.ag" #-} rule347 = \ ((_prodsIrefNts) :: Set NontermIdent) nt_ -> {-# LINE 16 "src-ag/ExecutionPlanCommon.ag" #-} Map.singleton nt_ _prodsIrefNts {-# LINE 3482 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule348 #-} {-# LINE 17 "src-ag/ExecutionPlanCommon.ag" #-} rule348 = \ ((_prodsIrefHoNts) :: Set NontermIdent) nt_ -> {-# LINE 17 "src-ag/ExecutionPlanCommon.ag" #-} Map.singleton nt_ _prodsIrefHoNts {-# LINE 3488 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule349 #-} {-# LINE 19 "src-ag/ExecutionPlanCommon.ag" #-} rule349 = \ ((_lhsIclosedNtDeps) :: Map NontermIdent (Set NontermIdent)) nt_ -> {-# LINE 19 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Set.empty nt_ _lhsIclosedNtDeps {-# LINE 3494 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule350 #-} {-# LINE 20 "src-ag/ExecutionPlanCommon.ag" #-} rule350 = \ ((_lhsIclosedHoNtDeps) :: Map NontermIdent (Set NontermIdent)) nt_ -> {-# LINE 20 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Set.empty nt_ _lhsIclosedHoNtDeps {-# LINE 3500 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule351 #-} {-# LINE 21 "src-ag/ExecutionPlanCommon.ag" #-} rule351 = \ ((_lhsIclosedHoNtRevDeps) :: Map NontermIdent (Set NontermIdent)) nt_ -> {-# LINE 21 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Set.empty nt_ _lhsIclosedHoNtRevDeps {-# LINE 3506 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule352 #-} {-# LINE 23 "src-ag/ExecutionPlanCommon.ag" #-} rule352 = \ _closedNtDeps nt_ -> {-# LINE 23 "src-ag/ExecutionPlanCommon.ag" #-} nt_ `Set.member` _closedNtDeps {-# LINE 3512 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule353 #-} {-# LINE 24 "src-ag/ExecutionPlanCommon.ag" #-} rule353 = \ _closedHoNtDeps nt_ -> {-# LINE 24 "src-ag/ExecutionPlanCommon.ag" #-} nt_ `Set.member` _closedHoNtDeps {-# LINE 3518 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule354 #-} {-# LINE 25 "src-ag/ExecutionPlanCommon.ag" #-} rule354 = \ _closedHoNtDeps _closedHoNtRevDeps _nontrivAcyc -> {-# LINE 25 "src-ag/ExecutionPlanCommon.ag" #-} HigherOrderInfo { hoNtDeps = _closedHoNtDeps , hoNtRevDeps = _closedHoNtRevDeps , hoAcyclic = _nontrivAcyc } {-# LINE 3527 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule355 #-} {-# LINE 54 "src-ag/ExecutionPlanCommon.ag" #-} rule355 = \ ((_lhsIclassContexts) :: ContextMap) nt_ -> {-# LINE 54 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault [] nt_ _lhsIclassContexts {-# LINE 3533 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule356 #-} {-# LINE 88 "src-ag/ExecutionPlanCommon.ag" #-} rule356 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) nt_ -> {-# LINE 88 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIaroundMap {-# LINE 3539 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule357 #-} {-# LINE 113 "src-ag/ExecutionPlanCommon.ag" #-} rule357 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) nt_ -> {-# LINE 113 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Map.empty nt_ _lhsImergeMap {-# LINE 3545 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule358 #-} {-# LINE 149 "src-ag/ExecutionPlanCommon.ag" #-} rule358 = \ inh_ nt_ -> {-# LINE 149 "src-ag/ExecutionPlanCommon.ag" #-} Map.singleton nt_ inh_ {-# LINE 3551 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule359 #-} {-# LINE 150 "src-ag/ExecutionPlanCommon.ag" #-} rule359 = \ nt_ syn_ -> {-# LINE 150 "src-ag/ExecutionPlanCommon.ag" #-} Map.singleton nt_ syn_ {-# LINE 3557 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule360 #-} {-# LINE 159 "src-ag/ExecutionPlanCommon.ag" #-} rule360 = \ ((_prodsIlocalSigMap) :: Map.Map ConstructorIdent (Map.Map Identifier Type)) nt_ -> {-# LINE 159 "src-ag/ExecutionPlanCommon.ag" #-} Map.singleton nt_ _prodsIlocalSigMap {-# LINE 3563 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule361 #-} {-# LINE 65 "src-ag/LOAG/Prepare.ag" #-} rule361 = \ inh_ nt_ -> {-# LINE 65 "src-ag/LOAG/Prepare.ag" #-} let dty = TyData (getName nt_) in Map.singleton dty (toMyAttr Inh dty inh_) {-# LINE 3570 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule362 #-} {-# LINE 67 "src-ag/LOAG/Prepare.ag" #-} rule362 = \ nt_ syn_ -> {-# LINE 67 "src-ag/LOAG/Prepare.ag" #-} let dty = TyData (getName nt_) in Map.singleton dty (toMyAttr Syn dty syn_) {-# LINE 3577 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule363 #-} {-# LINE 69 "src-ag/LOAG/Prepare.ag" #-} rule363 = \ ((_lhsIaugM) :: Map.Map Identifier (Map.Map Identifier (Set.Set Dependency))) nt_ -> {-# LINE 69 "src-ag/LOAG/Prepare.ag" #-} case Map.lookup nt_ _lhsIaugM of Nothing -> Map.empty Just a -> a {-# LINE 3585 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule364 #-} {-# LINE 131 "src-ag/LOAG/Prepare.ag" #-} rule364 = \ nt_ -> {-# LINE 131 "src-ag/LOAG/Prepare.ag" #-} TyData (getName nt_) {-# LINE 3591 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule365 #-} {-# LINE 82 "src-ag/LOAG/Order.ag" #-} rule365 = \ ((_prodsIfdps) :: Map.Map ConstructorIdent (Set Dependency)) nt_ -> {-# LINE 82 "src-ag/LOAG/Order.ag" #-} Map.singleton nt_ _prodsIfdps {-# LINE 3597 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule366 #-} {-# LINE 138 "src-ag/LOAG/Order.ag" #-} rule366 = \ ((_lhsIvisitnum) :: Int) -> {-# LINE 138 "src-ag/LOAG/Order.ag" #-} _lhsIvisitnum {-# LINE 3603 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule367 #-} {-# LINE 139 "src-ag/LOAG/Order.ag" #-} rule367 = \ _initial _segments -> {-# LINE 139 "src-ag/LOAG/Order.ag" #-} zipWith const [_initial ..] _segments {-# LINE 3609 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule368 #-} {-# LINE 140 "src-ag/LOAG/Order.ag" #-} rule368 = \ _vnums -> {-# LINE 140 "src-ag/LOAG/Order.ag" #-} _vnums {-# LINE 3615 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule369 #-} {-# LINE 141 "src-ag/LOAG/Order.ag" #-} rule369 = \ _initial _vnums -> {-# LINE 141 "src-ag/LOAG/Order.ag" #-} Map.fromList $ (_initial + length _vnums, NoneVis) : [(v, OneVis v) | v <- _vnums ] {-# LINE 3622 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule370 #-} {-# LINE 143 "src-ag/LOAG/Order.ag" #-} rule370 = \ _initial _vnums -> {-# LINE 143 "src-ag/LOAG/Order.ag" #-} Map.fromList $ (_initial , NoneVis) : [(v+1, OneVis v) | v <- _vnums ] {-# LINE 3629 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule371 #-} {-# LINE 145 "src-ag/LOAG/Order.ag" #-} rule371 = \ _initial _mysegments -> {-# LINE 145 "src-ag/LOAG/Order.ag" #-} let op vnr (MySegment visnr ins syns _ _) = IMap.fromList $ zip syns (repeat vnr) in IMap.unions $ zipWith op [_initial ..] _mysegments {-# LINE 3637 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule372 #-} {-# LINE 148 "src-ag/LOAG/Order.ag" #-} rule372 = \ _classContexts _hoInfo _initial _initialVisit _nextVis _prevVis ((_prodsIeprods) :: EProductions) _recursive nt_ params_ -> {-# LINE 148 "src-ag/LOAG/Order.ag" #-} [ENonterminal nt_ params_ _classContexts _initial _initialVisit _nextVis _prevVis _prodsIeprods _recursive _hoInfo ] {-# LINE 3653 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule373 #-} {-# LINE 322 "src-ag/LOAG/Order.ag" #-} rule373 = \ ((_lhsIsched) :: InterfaceRes) nt_ -> {-# LINE 322 "src-ag/LOAG/Order.ag" #-} findWithErr _lhsIsched "could not const. interfaces" (getName nt_) {-# LINE 3660 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule374 #-} {-# LINE 324 "src-ag/LOAG/Order.ag" #-} rule374 = \ _assigned ((_lhsIsched) :: InterfaceRes) -> {-# LINE 324 "src-ag/LOAG/Order.ag" #-} if Map.null _lhsIsched then 0 else let mx = fst $ IMap.findMax _assigned in if even mx then mx else mx + 1 {-# LINE 3669 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule375 #-} {-# LINE 329 "src-ag/LOAG/Order.ag" #-} rule375 = \ _assigned _mx -> {-# LINE 329 "src-ag/LOAG/Order.ag" #-} map (\i -> MySegment ((_mx - i) `div` 2) (maybe [] id $ IMap.lookup i _assigned ) (maybe [] id $ IMap.lookup (i-1) _assigned ) Nothing Nothing) [_mx ,_mx -2 .. 2] {-# LINE 3679 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule376 #-} {-# LINE 335 "src-ag/LOAG/Order.ag" #-} rule376 = \ ((_lhsInmp) :: NMP) _mysegments -> {-# LINE 335 "src-ag/LOAG/Order.ag" #-} map (\(MySegment visnr is ss _ _) -> CSegment (Map.unions $ map (vertexToAttr _lhsInmp) is) (Map.unions $ map (vertexToAttr _lhsInmp) ss)) _mysegments {-# LINE 3688 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule377 #-} rule377 = \ ((_prodsIads) :: [Edge]) -> _prodsIads {-# INLINE rule378 #-} rule378 = \ ((_prodsIap) :: A_P) -> _prodsIap {-# INLINE rule379 #-} rule379 = \ ((_prodsIfieldMap) :: FMap) -> _prodsIfieldMap {-# INLINE rule380 #-} rule380 = \ ((_prodsIfsInP) :: FsInP) -> _prodsIfsInP {-# INLINE rule381 #-} rule381 = \ ((_prodsIfty) :: FTY) -> _prodsIfty {-# INLINE rule382 #-} rule382 = \ ((_prodsIgen) :: Map Int Int) -> _prodsIgen {-# INLINE rule383 #-} rule383 = \ ((_prodsIhoMap) :: HOMap) -> _prodsIhoMap {-# INLINE rule384 #-} rule384 = \ ((_prodsIinss) :: Map Int [Int]) -> _prodsIinss {-# INLINE rule385 #-} rule385 = \ ((_prodsIlfp) :: SF_P) -> _prodsIlfp {-# INLINE rule386 #-} rule386 = \ ((_prodsIlfpr) :: SF_P) -> _prodsIlfpr {-# INLINE rule387 #-} rule387 = \ ((_prodsIofld) :: [(Int, Int)]) -> _prodsIofld {-# INLINE rule388 #-} rule388 = \ ((_prodsIpmp) :: PMP) -> _prodsIpmp {-# INLINE rule389 #-} rule389 = \ ((_prodsIpmpr) :: PMP_R) -> _prodsIpmpr {-# INLINE rule390 #-} rule390 = \ ((_prodsIps) :: [PLabel]) -> _prodsIps {-# INLINE rule391 #-} rule391 = \ ((_prodsIruleMap) :: Map.Map MyOccurrence Identifier) -> _prodsIruleMap {-# INLINE rule392 #-} rule392 = \ ((_prodsIsfp) :: SF_P) -> _prodsIsfp {-# INLINE rule393 #-} rule393 = \ _visMap -> _visMap {-# INLINE rule394 #-} rule394 = \ ((_prodsIself) :: Productions) inh_ nt_ params_ syn_ -> Nonterminal nt_ params_ inh_ syn_ _prodsIself {-# INLINE rule395 #-} rule395 = \ _self -> _self {-# INLINE rule396 #-} rule396 = \ ((_prodsIflab) :: Int) -> _prodsIflab {-# INLINE rule397 #-} rule397 = \ ((_prodsIolab) :: Int) -> _prodsIolab {-# INLINE rule398 #-} rule398 = \ ((_prodsIrulenumber) :: Int) -> _prodsIrulenumber {-# INLINE rule399 #-} rule399 = \ ((_prodsIvisitnum) :: Int) -> _prodsIvisitnum {-# INLINE rule400 #-} rule400 = \ ((_lhsIain) :: MyType -> MyAttributes) -> _lhsIain {-# INLINE rule401 #-} rule401 = \ ((_lhsIan) :: MyType -> MyAttributes) -> _lhsIan {-# INLINE rule402 #-} rule402 = \ _aroundMap -> _aroundMap {-# INLINE rule403 #-} rule403 = \ ((_lhsIasn) :: MyType -> MyAttributes) -> _lhsIasn {-# INLINE rule404 #-} rule404 = \ _dty -> _dty {-# INLINE rule405 #-} rule405 = \ ((_lhsIflab) :: Int) -> _lhsIflab {-# INLINE rule406 #-} rule406 = \ ((_lhsIfty) :: FTY) -> _lhsIfty {-# INLINE rule407 #-} rule407 = \ ((_lhsIftyf) :: FTY) -> _lhsIftyf {-# INLINE rule408 #-} rule408 = \ ((_lhsIhoMapf) :: HOMap) -> _lhsIhoMapf {-# INLINE rule409 #-} rule409 = \ ((_lhsIlfpf) :: SF_P) -> _lhsIlfpf {-# INLINE rule410 #-} rule410 = \ _mergeMap -> _mergeMap {-# INLINE rule411 #-} rule411 = \ _mysegments -> _mysegments {-# INLINE rule412 #-} rule412 = \ ((_lhsInmp) :: NMP) -> _lhsInmp {-# INLINE rule413 #-} rule413 = \ ((_lhsInmprf) :: NMP_R) -> _lhsInmprf {-# INLINE rule414 #-} rule414 = \ ((_lhsIolab) :: Int) -> _lhsIolab {-# INLINE rule415 #-} rule415 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule416 #-} rule416 = \ ((_lhsIpmpf) :: PMP) -> _lhsIpmpf {-# INLINE rule417 #-} rule417 = \ ((_lhsIpmprf) :: PMP_R) -> _lhsIpmprf {-# INLINE rule418 #-} rule418 = \ ((_lhsIres_ads) :: [Edge]) -> _lhsIres_ads {-# INLINE rule419 #-} rule419 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber {-# INLINE rule420 #-} rule420 = \ ((_lhsItdp) :: TDPRes) -> _lhsItdp {-# INLINE rule421 #-} rule421 = \ ((_lhsIvisMapf) :: IMap.IntMap Int) -> _lhsIvisMapf {-# INLINE rule422 #-} rule422 = \ ((_lhsIvisitnum) :: Int) -> _lhsIvisitnum -- Nonterminals ------------------------------------------------ -- wrapper data Inh_Nonterminals = Inh_Nonterminals { ain_Inh_Nonterminals :: (MyType -> MyAttributes), an_Inh_Nonterminals :: (MyType -> MyAttributes), aroundMap_Inh_Nonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), asn_Inh_Nonterminals :: (MyType -> MyAttributes), augM_Inh_Nonterminals :: (Map.Map Identifier (Map.Map Identifier (Set.Set Dependency))), classContexts_Inh_Nonterminals :: (ContextMap), closedHoNtDeps_Inh_Nonterminals :: (Map NontermIdent (Set NontermIdent)), closedHoNtRevDeps_Inh_Nonterminals :: (Map NontermIdent (Set NontermIdent)), closedNtDeps_Inh_Nonterminals :: (Map NontermIdent (Set NontermIdent)), flab_Inh_Nonterminals :: (Int), fty_Inh_Nonterminals :: (FTY), ftyf_Inh_Nonterminals :: (FTY), hoMapf_Inh_Nonterminals :: (HOMap), lfpf_Inh_Nonterminals :: (SF_P), mergeMap_Inh_Nonterminals :: (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))), nmp_Inh_Nonterminals :: (NMP), nmprf_Inh_Nonterminals :: (NMP_R), olab_Inh_Nonterminals :: (Int), options_Inh_Nonterminals :: (Options), pmpf_Inh_Nonterminals :: (PMP), pmprf_Inh_Nonterminals :: (PMP_R), res_ads_Inh_Nonterminals :: ([Edge]), rulenumber_Inh_Nonterminals :: (Int), sched_Inh_Nonterminals :: (InterfaceRes), tdp_Inh_Nonterminals :: (TDPRes), visMapf_Inh_Nonterminals :: (IMap.IntMap Int), visitnum_Inh_Nonterminals :: (Int) } data Syn_Nonterminals = Syn_Nonterminals { ads_Syn_Nonterminals :: ([Edge]), ap_Syn_Nonterminals :: (A_P), enonts_Syn_Nonterminals :: (ENonterminals), fdps_Syn_Nonterminals :: (AttrOrderMap), fieldMap_Syn_Nonterminals :: (FMap), flab_Syn_Nonterminals :: (Int), fsInP_Syn_Nonterminals :: (FsInP), fty_Syn_Nonterminals :: (FTY), gen_Syn_Nonterminals :: (Map Int Int), hoMap_Syn_Nonterminals :: (HOMap), inhmap_Syn_Nonterminals :: (Map.Map NontermIdent Attributes), inhs_Syn_Nonterminals :: (AI_N), inss_Syn_Nonterminals :: (Map Int [Int]), lfp_Syn_Nonterminals :: (SF_P), lfpr_Syn_Nonterminals :: (SF_P), localSigMap_Syn_Nonterminals :: (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))), ntDeps_Syn_Nonterminals :: (Map NontermIdent (Set NontermIdent)), ntHoDeps_Syn_Nonterminals :: (Map NontermIdent (Set NontermIdent)), ofld_Syn_Nonterminals :: ([(Int, Int)]), olab_Syn_Nonterminals :: (Int), pmp_Syn_Nonterminals :: (PMP), pmpr_Syn_Nonterminals :: (PMP_R), ps_Syn_Nonterminals :: ([PLabel]), ruleMap_Syn_Nonterminals :: (Map.Map MyOccurrence Identifier), rulenumber_Syn_Nonterminals :: (Int), self_Syn_Nonterminals :: (Nonterminals), sfp_Syn_Nonterminals :: (SF_P), synmap_Syn_Nonterminals :: (Map.Map NontermIdent Attributes), syns_Syn_Nonterminals :: (AS_N), visMap_Syn_Nonterminals :: (IMap.IntMap Int), visitnum_Syn_Nonterminals :: (Int) } {-# INLINABLE wrap_Nonterminals #-} wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals ) wrap_Nonterminals (T_Nonterminals act) (Inh_Nonterminals _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIaugM _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIflab _lhsIfty _lhsIftyf _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIres_ads _lhsIrulenumber _lhsIsched _lhsItdp _lhsIvisMapf _lhsIvisitnum) = Control.Monad.Identity.runIdentity ( do sem <- act let arg73 = T_Nonterminals_vIn73 _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIaugM _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIflab _lhsIfty _lhsIftyf _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIres_ads _lhsIrulenumber _lhsIsched _lhsItdp _lhsIvisMapf _lhsIvisitnum (T_Nonterminals_vOut73 _lhsOads _lhsOap _lhsOenonts _lhsOfdps _lhsOfieldMap _lhsOflab _lhsOfsInP _lhsOfty _lhsOgen _lhsOhoMap _lhsOinhmap _lhsOinhs _lhsOinss _lhsOlfp _lhsOlfpr _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOps _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOsynmap _lhsOsyns _lhsOvisMap _lhsOvisitnum) <- return (inv_Nonterminals_s74 sem arg73) return (Syn_Nonterminals _lhsOads _lhsOap _lhsOenonts _lhsOfdps _lhsOfieldMap _lhsOflab _lhsOfsInP _lhsOfty _lhsOgen _lhsOhoMap _lhsOinhmap _lhsOinhs _lhsOinss _lhsOlfp _lhsOlfpr _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOps _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOsynmap _lhsOsyns _lhsOvisMap _lhsOvisitnum) ) -- cata {-# NOINLINE sem_Nonterminals #-} sem_Nonterminals :: Nonterminals -> T_Nonterminals sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) -- semantic domain newtype T_Nonterminals = T_Nonterminals { attach_T_Nonterminals :: Identity (T_Nonterminals_s74 ) } newtype T_Nonterminals_s74 = C_Nonterminals_s74 { inv_Nonterminals_s74 :: (T_Nonterminals_v73 ) } data T_Nonterminals_s75 = C_Nonterminals_s75 type T_Nonterminals_v73 = (T_Nonterminals_vIn73 ) -> (T_Nonterminals_vOut73 ) data T_Nonterminals_vIn73 = T_Nonterminals_vIn73 (MyType -> MyAttributes) (MyType -> MyAttributes) (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) (MyType -> MyAttributes) (Map.Map Identifier (Map.Map Identifier (Set.Set Dependency))) (ContextMap) (Map NontermIdent (Set NontermIdent)) (Map NontermIdent (Set NontermIdent)) (Map NontermIdent (Set NontermIdent)) (Int) (FTY) (FTY) (HOMap) (SF_P) (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) (NMP) (NMP_R) (Int) (Options) (PMP) (PMP_R) ([Edge]) (Int) (InterfaceRes) (TDPRes) (IMap.IntMap Int) (Int) data T_Nonterminals_vOut73 = T_Nonterminals_vOut73 ([Edge]) (A_P) (ENonterminals) (AttrOrderMap) (FMap) (Int) (FsInP) (FTY) (Map Int Int) (HOMap) (Map.Map NontermIdent Attributes) (AI_N) (Map Int [Int]) (SF_P) (SF_P) (Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) (Map NontermIdent (Set NontermIdent)) (Map NontermIdent (Set NontermIdent)) ([(Int, Int)]) (Int) (PMP) (PMP_R) ([PLabel]) (Map.Map MyOccurrence Identifier) (Int) (Nonterminals) (SF_P) (Map.Map NontermIdent Attributes) (AS_N) (IMap.IntMap Int) (Int) {-# NOINLINE sem_Nonterminals_Cons #-} sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st74) where {-# NOINLINE st74 #-} st74 = let v73 :: T_Nonterminals_v73 v73 = \ (T_Nonterminals_vIn73 _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIaugM _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIflab _lhsIfty _lhsIftyf _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIres_ads _lhsIrulenumber _lhsIsched _lhsItdp _lhsIvisMapf _lhsIvisitnum) -> ( let _hdX71 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) _tlX74 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) (T_Nonterminal_vOut70 _hdIads _hdIap _hdIenonts _hdIfdps _hdIfieldMap _hdIflab _hdIfsInP _hdIfty _hdIgen _hdIhoMap _hdIinhmap _hdIinhs _hdIinss _hdIlfp _hdIlfpr _hdIlocalSigMap _hdIntDeps _hdIntHoDeps _hdIofld _hdIolab _hdIpmp _hdIpmpr _hdIps _hdIruleMap _hdIrulenumber _hdIself _hdIsfp _hdIsynmap _hdIsyns _hdIvisMap _hdIvisitnum) = inv_Nonterminal_s71 _hdX71 (T_Nonterminal_vIn70 _hdOain _hdOan _hdOaroundMap _hdOasn _hdOaugM _hdOclassContexts _hdOclosedHoNtDeps _hdOclosedHoNtRevDeps _hdOclosedNtDeps _hdOflab _hdOfty _hdOftyf _hdOhoMapf _hdOlfpf _hdOmergeMap _hdOnmp _hdOnmprf _hdOolab _hdOoptions _hdOpmpf _hdOpmprf _hdOres_ads _hdOrulenumber _hdOsched _hdOtdp _hdOvisMapf _hdOvisitnum) (T_Nonterminals_vOut73 _tlIads _tlIap _tlIenonts _tlIfdps _tlIfieldMap _tlIflab _tlIfsInP _tlIfty _tlIgen _tlIhoMap _tlIinhmap _tlIinhs _tlIinss _tlIlfp _tlIlfpr _tlIlocalSigMap _tlIntDeps _tlIntHoDeps _tlIofld _tlIolab _tlIpmp _tlIpmpr _tlIps _tlIruleMap _tlIrulenumber _tlIself _tlIsfp _tlIsynmap _tlIsyns _tlIvisMap _tlIvisitnum) = inv_Nonterminals_s74 _tlX74 (T_Nonterminals_vIn73 _tlOain _tlOan _tlOaroundMap _tlOasn _tlOaugM _tlOclassContexts _tlOclosedHoNtDeps _tlOclosedHoNtRevDeps _tlOclosedNtDeps _tlOflab _tlOfty _tlOftyf _tlOhoMapf _tlOlfpf _tlOmergeMap _tlOnmp _tlOnmprf _tlOolab _tlOoptions _tlOpmpf _tlOpmprf _tlOres_ads _tlOrulenumber _tlOsched _tlOtdp _tlOvisMapf _tlOvisitnum) _lhsOads :: [Edge] _lhsOads = rule423 _hdIads _tlIads _lhsOap :: A_P _lhsOap = rule424 _hdIap _tlIap _lhsOenonts :: ENonterminals _lhsOenonts = rule425 _hdIenonts _tlIenonts _lhsOfdps :: AttrOrderMap _lhsOfdps = rule426 _hdIfdps _tlIfdps _lhsOfieldMap :: FMap _lhsOfieldMap = rule427 _hdIfieldMap _tlIfieldMap _lhsOfsInP :: FsInP _lhsOfsInP = rule428 _hdIfsInP _tlIfsInP _lhsOfty :: FTY _lhsOfty = rule429 _hdIfty _tlIfty _lhsOgen :: Map Int Int _lhsOgen = rule430 _hdIgen _tlIgen _lhsOhoMap :: HOMap _lhsOhoMap = rule431 _hdIhoMap _tlIhoMap _lhsOinhmap :: Map.Map NontermIdent Attributes _lhsOinhmap = rule432 _hdIinhmap _tlIinhmap _lhsOinhs :: AI_N _lhsOinhs = rule433 _hdIinhs _tlIinhs _lhsOinss :: Map Int [Int] _lhsOinss = rule434 _hdIinss _tlIinss _lhsOlfp :: SF_P _lhsOlfp = rule435 _hdIlfp _tlIlfp _lhsOlfpr :: SF_P _lhsOlfpr = rule436 _hdIlfpr _tlIlfpr _lhsOlocalSigMap :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type)) _lhsOlocalSigMap = rule437 _hdIlocalSigMap _tlIlocalSigMap _lhsOntDeps :: Map NontermIdent (Set NontermIdent) _lhsOntDeps = rule438 _hdIntDeps _tlIntDeps _lhsOntHoDeps :: Map NontermIdent (Set NontermIdent) _lhsOntHoDeps = rule439 _hdIntHoDeps _tlIntHoDeps _lhsOofld :: [(Int, Int)] _lhsOofld = rule440 _hdIofld _tlIofld _lhsOpmp :: PMP _lhsOpmp = rule441 _hdIpmp _tlIpmp _lhsOpmpr :: PMP_R _lhsOpmpr = rule442 _hdIpmpr _tlIpmpr _lhsOps :: [PLabel] _lhsOps = rule443 _hdIps _tlIps _lhsOruleMap :: Map.Map MyOccurrence Identifier _lhsOruleMap = rule444 _hdIruleMap _tlIruleMap _lhsOsfp :: SF_P _lhsOsfp = rule445 _hdIsfp _tlIsfp _lhsOsynmap :: Map.Map NontermIdent Attributes _lhsOsynmap = rule446 _hdIsynmap _tlIsynmap _lhsOsyns :: AS_N _lhsOsyns = rule447 _hdIsyns _tlIsyns _lhsOvisMap :: IMap.IntMap Int _lhsOvisMap = rule448 _hdIvisMap _tlIvisMap _self = rule449 _hdIself _tlIself _lhsOself :: Nonterminals _lhsOself = rule450 _self _lhsOflab :: Int _lhsOflab = rule451 _tlIflab _lhsOolab :: Int _lhsOolab = rule452 _tlIolab _lhsOrulenumber :: Int _lhsOrulenumber = rule453 _tlIrulenumber _lhsOvisitnum :: Int _lhsOvisitnum = rule454 _tlIvisitnum _hdOain = rule455 _lhsIain _hdOan = rule456 _lhsIan _hdOaroundMap = rule457 _lhsIaroundMap _hdOasn = rule458 _lhsIasn _hdOaugM = rule459 _lhsIaugM _hdOclassContexts = rule460 _lhsIclassContexts _hdOclosedHoNtDeps = rule461 _lhsIclosedHoNtDeps _hdOclosedHoNtRevDeps = rule462 _lhsIclosedHoNtRevDeps _hdOclosedNtDeps = rule463 _lhsIclosedNtDeps _hdOflab = rule464 _lhsIflab _hdOfty = rule465 _lhsIfty _hdOftyf = rule466 _lhsIftyf _hdOhoMapf = rule467 _lhsIhoMapf _hdOlfpf = rule468 _lhsIlfpf _hdOmergeMap = rule469 _lhsImergeMap _hdOnmp = rule470 _lhsInmp _hdOnmprf = rule471 _lhsInmprf _hdOolab = rule472 _lhsIolab _hdOoptions = rule473 _lhsIoptions _hdOpmpf = rule474 _lhsIpmpf _hdOpmprf = rule475 _lhsIpmprf _hdOres_ads = rule476 _lhsIres_ads _hdOrulenumber = rule477 _lhsIrulenumber _hdOsched = rule478 _lhsIsched _hdOtdp = rule479 _lhsItdp _hdOvisMapf = rule480 _lhsIvisMapf _hdOvisitnum = rule481 _lhsIvisitnum _tlOain = rule482 _lhsIain _tlOan = rule483 _lhsIan _tlOaroundMap = rule484 _lhsIaroundMap _tlOasn = rule485 _lhsIasn _tlOaugM = rule486 _lhsIaugM _tlOclassContexts = rule487 _lhsIclassContexts _tlOclosedHoNtDeps = rule488 _lhsIclosedHoNtDeps _tlOclosedHoNtRevDeps = rule489 _lhsIclosedHoNtRevDeps _tlOclosedNtDeps = rule490 _lhsIclosedNtDeps _tlOflab = rule491 _hdIflab _tlOfty = rule492 _hdIfty _tlOftyf = rule493 _lhsIftyf _tlOhoMapf = rule494 _lhsIhoMapf _tlOlfpf = rule495 _lhsIlfpf _tlOmergeMap = rule496 _lhsImergeMap _tlOnmp = rule497 _lhsInmp _tlOnmprf = rule498 _lhsInmprf _tlOolab = rule499 _hdIolab _tlOoptions = rule500 _lhsIoptions _tlOpmpf = rule501 _lhsIpmpf _tlOpmprf = rule502 _lhsIpmprf _tlOres_ads = rule503 _lhsIres_ads _tlOrulenumber = rule504 _hdIrulenumber _tlOsched = rule505 _lhsIsched _tlOtdp = rule506 _lhsItdp _tlOvisMapf = rule507 _lhsIvisMapf _tlOvisitnum = rule508 _hdIvisitnum __result_ = T_Nonterminals_vOut73 _lhsOads _lhsOap _lhsOenonts _lhsOfdps _lhsOfieldMap _lhsOflab _lhsOfsInP _lhsOfty _lhsOgen _lhsOhoMap _lhsOinhmap _lhsOinhs _lhsOinss _lhsOlfp _lhsOlfpr _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOps _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOsynmap _lhsOsyns _lhsOvisMap _lhsOvisitnum in __result_ ) in C_Nonterminals_s74 v73 {-# INLINE rule423 #-} rule423 = \ ((_hdIads) :: [Edge]) ((_tlIads) :: [Edge]) -> ((++) _hdIads _tlIads) {-# INLINE rule424 #-} rule424 = \ ((_hdIap) :: A_P) ((_tlIap) :: A_P) -> (Map.unionWith (++) _hdIap _tlIap) {-# INLINE rule425 #-} rule425 = \ ((_hdIenonts) :: ENonterminals) ((_tlIenonts) :: ENonterminals) -> ((++) _hdIenonts _tlIenonts) {-# INLINE rule426 #-} rule426 = \ ((_hdIfdps) :: AttrOrderMap) ((_tlIfdps) :: AttrOrderMap) -> (Map.union _hdIfdps _tlIfdps) {-# INLINE rule427 #-} rule427 = \ ((_hdIfieldMap) :: FMap) ((_tlIfieldMap) :: FMap) -> ((Map.union) _hdIfieldMap _tlIfieldMap) {-# INLINE rule428 #-} rule428 = \ ((_hdIfsInP) :: FsInP) ((_tlIfsInP) :: FsInP) -> ((Map.union) _hdIfsInP _tlIfsInP) {-# INLINE rule429 #-} rule429 = \ ((_hdIfty) :: FTY) ((_tlIfty) :: FTY) -> (Map.union _hdIfty _tlIfty) {-# INLINE rule430 #-} rule430 = \ ((_hdIgen) :: Map Int Int) ((_tlIgen) :: Map Int Int) -> (Map.union _hdIgen _tlIgen) {-# INLINE rule431 #-} rule431 = \ ((_hdIhoMap) :: HOMap) ((_tlIhoMap) :: HOMap) -> ((Map.union) _hdIhoMap _tlIhoMap) {-# INLINE rule432 #-} rule432 = \ ((_hdIinhmap) :: Map.Map NontermIdent Attributes) ((_tlIinhmap) :: Map.Map NontermIdent Attributes) -> _hdIinhmap `Map.union` _tlIinhmap {-# INLINE rule433 #-} rule433 = \ ((_hdIinhs) :: AI_N) ((_tlIinhs) :: AI_N) -> (Map.union _hdIinhs _tlIinhs) {-# INLINE rule434 #-} rule434 = \ ((_hdIinss) :: Map Int [Int]) ((_tlIinss) :: Map Int [Int]) -> (Map.unionWith (++) _hdIinss _tlIinss) {-# INLINE rule435 #-} rule435 = \ ((_hdIlfp) :: SF_P) ((_tlIlfp) :: SF_P) -> (Map.unionWith (Set.union) _hdIlfp _tlIlfp) {-# INLINE rule436 #-} rule436 = \ ((_hdIlfpr) :: SF_P) ((_tlIlfpr) :: SF_P) -> (Map.unionWith (Set.union) _hdIlfpr _tlIlfpr) {-# INLINE rule437 #-} rule437 = \ ((_hdIlocalSigMap) :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) ((_tlIlocalSigMap) :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))) -> _hdIlocalSigMap `Map.union` _tlIlocalSigMap {-# INLINE rule438 #-} rule438 = \ ((_hdIntDeps) :: Map NontermIdent (Set NontermIdent)) ((_tlIntDeps) :: Map NontermIdent (Set NontermIdent)) -> _hdIntDeps `mappend` _tlIntDeps {-# INLINE rule439 #-} rule439 = \ ((_hdIntHoDeps) :: Map NontermIdent (Set NontermIdent)) ((_tlIntHoDeps) :: Map NontermIdent (Set NontermIdent)) -> _hdIntHoDeps `mappend` _tlIntHoDeps {-# INLINE rule440 #-} rule440 = \ ((_hdIofld) :: [(Int, Int)]) ((_tlIofld) :: [(Int, Int)]) -> ((++) _hdIofld _tlIofld) {-# INLINE rule441 #-} rule441 = \ ((_hdIpmp) :: PMP) ((_tlIpmp) :: PMP) -> (Map.union _hdIpmp _tlIpmp) {-# INLINE rule442 #-} rule442 = \ ((_hdIpmpr) :: PMP_R) ((_tlIpmpr) :: PMP_R) -> (Map.union _hdIpmpr _tlIpmpr) {-# INLINE rule443 #-} rule443 = \ ((_hdIps) :: [PLabel]) ((_tlIps) :: [PLabel]) -> ((++) _hdIps _tlIps) {-# INLINE rule444 #-} rule444 = \ ((_hdIruleMap) :: Map.Map MyOccurrence Identifier) ((_tlIruleMap) :: Map.Map MyOccurrence Identifier) -> (Map.union _hdIruleMap _tlIruleMap) {-# INLINE rule445 #-} rule445 = \ ((_hdIsfp) :: SF_P) ((_tlIsfp) :: SF_P) -> (Map.unionWith (Set.union) _hdIsfp _tlIsfp) {-# INLINE rule446 #-} rule446 = \ ((_hdIsynmap) :: Map.Map NontermIdent Attributes) ((_tlIsynmap) :: Map.Map NontermIdent Attributes) -> _hdIsynmap `Map.union` _tlIsynmap {-# INLINE rule447 #-} rule447 = \ ((_hdIsyns) :: AS_N) ((_tlIsyns) :: AS_N) -> (Map.union _hdIsyns _tlIsyns) {-# INLINE rule448 #-} rule448 = \ ((_hdIvisMap) :: IMap.IntMap Int) ((_tlIvisMap) :: IMap.IntMap Int) -> (IMap.union _hdIvisMap _tlIvisMap) {-# INLINE rule449 #-} rule449 = \ ((_hdIself) :: Nonterminal) ((_tlIself) :: Nonterminals) -> (:) _hdIself _tlIself {-# INLINE rule450 #-} rule450 = \ _self -> _self {-# INLINE rule451 #-} rule451 = \ ((_tlIflab) :: Int) -> _tlIflab {-# INLINE rule452 #-} rule452 = \ ((_tlIolab) :: Int) -> _tlIolab {-# INLINE rule453 #-} rule453 = \ ((_tlIrulenumber) :: Int) -> _tlIrulenumber {-# INLINE rule454 #-} rule454 = \ ((_tlIvisitnum) :: Int) -> _tlIvisitnum {-# INLINE rule455 #-} rule455 = \ ((_lhsIain) :: MyType -> MyAttributes) -> _lhsIain {-# INLINE rule456 #-} rule456 = \ ((_lhsIan) :: MyType -> MyAttributes) -> _lhsIan {-# INLINE rule457 #-} rule457 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> _lhsIaroundMap {-# INLINE rule458 #-} rule458 = \ ((_lhsIasn) :: MyType -> MyAttributes) -> _lhsIasn {-# INLINE rule459 #-} rule459 = \ ((_lhsIaugM) :: Map.Map Identifier (Map.Map Identifier (Set.Set Dependency))) -> _lhsIaugM {-# INLINE rule460 #-} rule460 = \ ((_lhsIclassContexts) :: ContextMap) -> _lhsIclassContexts {-# INLINE rule461 #-} rule461 = \ ((_lhsIclosedHoNtDeps) :: Map NontermIdent (Set NontermIdent)) -> _lhsIclosedHoNtDeps {-# INLINE rule462 #-} rule462 = \ ((_lhsIclosedHoNtRevDeps) :: Map NontermIdent (Set NontermIdent)) -> _lhsIclosedHoNtRevDeps {-# INLINE rule463 #-} rule463 = \ ((_lhsIclosedNtDeps) :: Map NontermIdent (Set NontermIdent)) -> _lhsIclosedNtDeps {-# INLINE rule464 #-} rule464 = \ ((_lhsIflab) :: Int) -> _lhsIflab {-# INLINE rule465 #-} rule465 = \ ((_lhsIfty) :: FTY) -> _lhsIfty {-# INLINE rule466 #-} rule466 = \ ((_lhsIftyf) :: FTY) -> _lhsIftyf {-# INLINE rule467 #-} rule467 = \ ((_lhsIhoMapf) :: HOMap) -> _lhsIhoMapf {-# INLINE rule468 #-} rule468 = \ ((_lhsIlfpf) :: SF_P) -> _lhsIlfpf {-# INLINE rule469 #-} rule469 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> _lhsImergeMap {-# INLINE rule470 #-} rule470 = \ ((_lhsInmp) :: NMP) -> _lhsInmp {-# INLINE rule471 #-} rule471 = \ ((_lhsInmprf) :: NMP_R) -> _lhsInmprf {-# INLINE rule472 #-} rule472 = \ ((_lhsIolab) :: Int) -> _lhsIolab {-# INLINE rule473 #-} rule473 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule474 #-} rule474 = \ ((_lhsIpmpf) :: PMP) -> _lhsIpmpf {-# INLINE rule475 #-} rule475 = \ ((_lhsIpmprf) :: PMP_R) -> _lhsIpmprf {-# INLINE rule476 #-} rule476 = \ ((_lhsIres_ads) :: [Edge]) -> _lhsIres_ads {-# INLINE rule477 #-} rule477 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber {-# INLINE rule478 #-} rule478 = \ ((_lhsIsched) :: InterfaceRes) -> _lhsIsched {-# INLINE rule479 #-} rule479 = \ ((_lhsItdp) :: TDPRes) -> _lhsItdp {-# INLINE rule480 #-} rule480 = \ ((_lhsIvisMapf) :: IMap.IntMap Int) -> _lhsIvisMapf {-# INLINE rule481 #-} rule481 = \ ((_lhsIvisitnum) :: Int) -> _lhsIvisitnum {-# INLINE rule482 #-} rule482 = \ ((_lhsIain) :: MyType -> MyAttributes) -> _lhsIain {-# INLINE rule483 #-} rule483 = \ ((_lhsIan) :: MyType -> MyAttributes) -> _lhsIan {-# INLINE rule484 #-} rule484 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> _lhsIaroundMap {-# INLINE rule485 #-} rule485 = \ ((_lhsIasn) :: MyType -> MyAttributes) -> _lhsIasn {-# INLINE rule486 #-} rule486 = \ ((_lhsIaugM) :: Map.Map Identifier (Map.Map Identifier (Set.Set Dependency))) -> _lhsIaugM {-# INLINE rule487 #-} rule487 = \ ((_lhsIclassContexts) :: ContextMap) -> _lhsIclassContexts {-# INLINE rule488 #-} rule488 = \ ((_lhsIclosedHoNtDeps) :: Map NontermIdent (Set NontermIdent)) -> _lhsIclosedHoNtDeps {-# INLINE rule489 #-} rule489 = \ ((_lhsIclosedHoNtRevDeps) :: Map NontermIdent (Set NontermIdent)) -> _lhsIclosedHoNtRevDeps {-# INLINE rule490 #-} rule490 = \ ((_lhsIclosedNtDeps) :: Map NontermIdent (Set NontermIdent)) -> _lhsIclosedNtDeps {-# INLINE rule491 #-} rule491 = \ ((_hdIflab) :: Int) -> _hdIflab {-# INLINE rule492 #-} rule492 = \ ((_hdIfty) :: FTY) -> _hdIfty {-# INLINE rule493 #-} rule493 = \ ((_lhsIftyf) :: FTY) -> _lhsIftyf {-# INLINE rule494 #-} rule494 = \ ((_lhsIhoMapf) :: HOMap) -> _lhsIhoMapf {-# INLINE rule495 #-} rule495 = \ ((_lhsIlfpf) :: SF_P) -> _lhsIlfpf {-# INLINE rule496 #-} rule496 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> _lhsImergeMap {-# INLINE rule497 #-} rule497 = \ ((_lhsInmp) :: NMP) -> _lhsInmp {-# INLINE rule498 #-} rule498 = \ ((_lhsInmprf) :: NMP_R) -> _lhsInmprf {-# INLINE rule499 #-} rule499 = \ ((_hdIolab) :: Int) -> _hdIolab {-# INLINE rule500 #-} rule500 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule501 #-} rule501 = \ ((_lhsIpmpf) :: PMP) -> _lhsIpmpf {-# INLINE rule502 #-} rule502 = \ ((_lhsIpmprf) :: PMP_R) -> _lhsIpmprf {-# INLINE rule503 #-} rule503 = \ ((_lhsIres_ads) :: [Edge]) -> _lhsIres_ads {-# INLINE rule504 #-} rule504 = \ ((_hdIrulenumber) :: Int) -> _hdIrulenumber {-# INLINE rule505 #-} rule505 = \ ((_lhsIsched) :: InterfaceRes) -> _lhsIsched {-# INLINE rule506 #-} rule506 = \ ((_lhsItdp) :: TDPRes) -> _lhsItdp {-# INLINE rule507 #-} rule507 = \ ((_lhsIvisMapf) :: IMap.IntMap Int) -> _lhsIvisMapf {-# INLINE rule508 #-} rule508 = \ ((_hdIvisitnum) :: Int) -> _hdIvisitnum {-# NOINLINE sem_Nonterminals_Nil #-} sem_Nonterminals_Nil :: T_Nonterminals sem_Nonterminals_Nil = T_Nonterminals (return st74) where {-# NOINLINE st74 #-} st74 = let v73 :: T_Nonterminals_v73 v73 = \ (T_Nonterminals_vIn73 _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIaugM _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIflab _lhsIfty _lhsIftyf _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIres_ads _lhsIrulenumber _lhsIsched _lhsItdp _lhsIvisMapf _lhsIvisitnum) -> ( let _lhsOads :: [Edge] _lhsOads = rule509 () _lhsOap :: A_P _lhsOap = rule510 () _lhsOenonts :: ENonterminals _lhsOenonts = rule511 () _lhsOfdps :: AttrOrderMap _lhsOfdps = rule512 () _lhsOfieldMap :: FMap _lhsOfieldMap = rule513 () _lhsOfsInP :: FsInP _lhsOfsInP = rule514 () _lhsOfty :: FTY _lhsOfty = rule515 () _lhsOgen :: Map Int Int _lhsOgen = rule516 () _lhsOhoMap :: HOMap _lhsOhoMap = rule517 () _lhsOinhmap :: Map.Map NontermIdent Attributes _lhsOinhmap = rule518 () _lhsOinhs :: AI_N _lhsOinhs = rule519 () _lhsOinss :: Map Int [Int] _lhsOinss = rule520 () _lhsOlfp :: SF_P _lhsOlfp = rule521 () _lhsOlfpr :: SF_P _lhsOlfpr = rule522 () _lhsOlocalSigMap :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type)) _lhsOlocalSigMap = rule523 () _lhsOntDeps :: Map NontermIdent (Set NontermIdent) _lhsOntDeps = rule524 () _lhsOntHoDeps :: Map NontermIdent (Set NontermIdent) _lhsOntHoDeps = rule525 () _lhsOofld :: [(Int, Int)] _lhsOofld = rule526 () _lhsOpmp :: PMP _lhsOpmp = rule527 () _lhsOpmpr :: PMP_R _lhsOpmpr = rule528 () _lhsOps :: [PLabel] _lhsOps = rule529 () _lhsOruleMap :: Map.Map MyOccurrence Identifier _lhsOruleMap = rule530 () _lhsOsfp :: SF_P _lhsOsfp = rule531 () _lhsOsynmap :: Map.Map NontermIdent Attributes _lhsOsynmap = rule532 () _lhsOsyns :: AS_N _lhsOsyns = rule533 () _lhsOvisMap :: IMap.IntMap Int _lhsOvisMap = rule534 () _self = rule535 () _lhsOself :: Nonterminals _lhsOself = rule536 _self _lhsOflab :: Int _lhsOflab = rule537 _lhsIflab _lhsOolab :: Int _lhsOolab = rule538 _lhsIolab _lhsOrulenumber :: Int _lhsOrulenumber = rule539 _lhsIrulenumber _lhsOvisitnum :: Int _lhsOvisitnum = rule540 _lhsIvisitnum __result_ = T_Nonterminals_vOut73 _lhsOads _lhsOap _lhsOenonts _lhsOfdps _lhsOfieldMap _lhsOflab _lhsOfsInP _lhsOfty _lhsOgen _lhsOhoMap _lhsOinhmap _lhsOinhs _lhsOinss _lhsOlfp _lhsOlfpr _lhsOlocalSigMap _lhsOntDeps _lhsOntHoDeps _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOps _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOsynmap _lhsOsyns _lhsOvisMap _lhsOvisitnum in __result_ ) in C_Nonterminals_s74 v73 {-# INLINE rule509 #-} rule509 = \ (_ :: ()) -> [] {-# INLINE rule510 #-} rule510 = \ (_ :: ()) -> Map.empty {-# INLINE rule511 #-} rule511 = \ (_ :: ()) -> [] {-# INLINE rule512 #-} rule512 = \ (_ :: ()) -> Map.empty {-# INLINE rule513 #-} rule513 = \ (_ :: ()) -> Map.empty {-# INLINE rule514 #-} rule514 = \ (_ :: ()) -> Map.empty {-# INLINE rule515 #-} rule515 = \ (_ :: ()) -> Map.empty {-# INLINE rule516 #-} rule516 = \ (_ :: ()) -> Map.empty {-# INLINE rule517 #-} rule517 = \ (_ :: ()) -> Map.empty {-# INLINE rule518 #-} rule518 = \ (_ :: ()) -> Map.empty {-# INLINE rule519 #-} rule519 = \ (_ :: ()) -> Map.empty {-# INLINE rule520 #-} rule520 = \ (_ :: ()) -> Map.empty {-# INLINE rule521 #-} rule521 = \ (_ :: ()) -> Map.empty {-# INLINE rule522 #-} rule522 = \ (_ :: ()) -> Map.empty {-# INLINE rule523 #-} rule523 = \ (_ :: ()) -> Map.empty {-# INLINE rule524 #-} rule524 = \ (_ :: ()) -> mempty {-# INLINE rule525 #-} rule525 = \ (_ :: ()) -> mempty {-# INLINE rule526 #-} rule526 = \ (_ :: ()) -> [] {-# INLINE rule527 #-} rule527 = \ (_ :: ()) -> Map.empty {-# INLINE rule528 #-} rule528 = \ (_ :: ()) -> Map.empty {-# INLINE rule529 #-} rule529 = \ (_ :: ()) -> ([]) {-# INLINE rule530 #-} rule530 = \ (_ :: ()) -> Map.empty {-# INLINE rule531 #-} rule531 = \ (_ :: ()) -> Map.empty {-# INLINE rule532 #-} rule532 = \ (_ :: ()) -> Map.empty {-# INLINE rule533 #-} rule533 = \ (_ :: ()) -> Map.empty {-# INLINE rule534 #-} rule534 = \ (_ :: ()) -> IMap.empty {-# INLINE rule535 #-} rule535 = \ (_ :: ()) -> [] {-# INLINE rule536 #-} rule536 = \ _self -> _self {-# INLINE rule537 #-} rule537 = \ ((_lhsIflab) :: Int) -> _lhsIflab {-# INLINE rule538 #-} rule538 = \ ((_lhsIolab) :: Int) -> _lhsIolab {-# INLINE rule539 #-} rule539 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber {-# INLINE rule540 #-} rule540 = \ ((_lhsIvisitnum) :: Int) -> _lhsIvisitnum -- Pattern ----------------------------------------------------- -- wrapper data Inh_Pattern = Inh_Pattern { } data Syn_Pattern = Syn_Pattern { afs_Syn_Pattern :: ([(FLabel, ALabel, Bool)]), copy_Syn_Pattern :: (Pattern), self_Syn_Pattern :: (Pattern) } {-# INLINABLE wrap_Pattern #-} wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg76 = T_Pattern_vIn76 (T_Pattern_vOut76 _lhsOafs _lhsOcopy _lhsOself) <- return (inv_Pattern_s77 sem arg76) return (Syn_Pattern _lhsOafs _lhsOcopy _lhsOself) ) -- cata {-# NOINLINE sem_Pattern #-} sem_Pattern :: Pattern -> T_Pattern sem_Pattern ( Constr name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) sem_Pattern ( Product pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) sem_Pattern ( Alias field_ attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) sem_Pattern ( Underscore pos_ ) = sem_Pattern_Underscore pos_ -- semantic domain newtype T_Pattern = T_Pattern { attach_T_Pattern :: Identity (T_Pattern_s77 ) } newtype T_Pattern_s77 = C_Pattern_s77 { inv_Pattern_s77 :: (T_Pattern_v76 ) } data T_Pattern_s78 = C_Pattern_s78 type T_Pattern_v76 = (T_Pattern_vIn76 ) -> (T_Pattern_vOut76 ) data T_Pattern_vIn76 = T_Pattern_vIn76 data T_Pattern_vOut76 = T_Pattern_vOut76 ([(FLabel, ALabel, Bool)]) (Pattern) (Pattern) {-# NOINLINE sem_Pattern_Constr #-} sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern sem_Pattern_Constr arg_name_ arg_pats_ = T_Pattern (return st77) where {-# NOINLINE st77 #-} st77 = let v76 :: T_Pattern_v76 v76 = \ (T_Pattern_vIn76 ) -> ( let _patsX80 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut79 _patsIafs _patsIcopy _patsIself) = inv_Patterns_s80 _patsX80 (T_Patterns_vIn79 ) _lhsOafs :: [(FLabel, ALabel, Bool)] _lhsOafs = rule541 _patsIafs _copy = rule542 _patsIcopy arg_name_ _self = rule543 _patsIself arg_name_ _lhsOcopy :: Pattern _lhsOcopy = rule544 _copy _lhsOself :: Pattern _lhsOself = rule545 _self __result_ = T_Pattern_vOut76 _lhsOafs _lhsOcopy _lhsOself in __result_ ) in C_Pattern_s77 v76 {-# INLINE rule541 #-} rule541 = \ ((_patsIafs) :: [(FLabel, ALabel, Bool)]) -> _patsIafs {-# INLINE rule542 #-} rule542 = \ ((_patsIcopy) :: Patterns) name_ -> Constr name_ _patsIcopy {-# INLINE rule543 #-} rule543 = \ ((_patsIself) :: Patterns) name_ -> Constr name_ _patsIself {-# INLINE rule544 #-} rule544 = \ _copy -> _copy {-# INLINE rule545 #-} rule545 = \ _self -> _self {-# NOINLINE sem_Pattern_Product #-} sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern sem_Pattern_Product arg_pos_ arg_pats_ = T_Pattern (return st77) where {-# NOINLINE st77 #-} st77 = let v76 :: T_Pattern_v76 v76 = \ (T_Pattern_vIn76 ) -> ( let _patsX80 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) (T_Patterns_vOut79 _patsIafs _patsIcopy _patsIself) = inv_Patterns_s80 _patsX80 (T_Patterns_vIn79 ) _lhsOafs :: [(FLabel, ALabel, Bool)] _lhsOafs = rule546 _patsIafs _copy = rule547 _patsIcopy arg_pos_ _self = rule548 _patsIself arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule549 _copy _lhsOself :: Pattern _lhsOself = rule550 _self __result_ = T_Pattern_vOut76 _lhsOafs _lhsOcopy _lhsOself in __result_ ) in C_Pattern_s77 v76 {-# INLINE rule546 #-} rule546 = \ ((_patsIafs) :: [(FLabel, ALabel, Bool)]) -> _patsIafs {-# INLINE rule547 #-} rule547 = \ ((_patsIcopy) :: Patterns) pos_ -> Product pos_ _patsIcopy {-# INLINE rule548 #-} rule548 = \ ((_patsIself) :: Patterns) pos_ -> Product pos_ _patsIself {-# INLINE rule549 #-} rule549 = \ _copy -> _copy {-# INLINE rule550 #-} rule550 = \ _self -> _self {-# NOINLINE sem_Pattern_Alias #-} sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern sem_Pattern_Alias arg_field_ arg_attr_ arg_pat_ = T_Pattern (return st77) where {-# NOINLINE st77 #-} st77 = let v76 :: T_Pattern_v76 v76 = \ (T_Pattern_vIn76 ) -> ( let _patX77 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut76 _patIafs _patIcopy _patIself) = inv_Pattern_s77 _patX77 (T_Pattern_vIn76 ) _lhsOafs :: [(FLabel, ALabel, Bool)] _lhsOafs = rule551 _patIafs arg_attr_ arg_field_ _copy = rule552 _patIcopy arg_attr_ arg_field_ _self = rule553 _patIself arg_attr_ arg_field_ _lhsOcopy :: Pattern _lhsOcopy = rule554 _copy _lhsOself :: Pattern _lhsOself = rule555 _self __result_ = T_Pattern_vOut76 _lhsOafs _lhsOcopy _lhsOself in __result_ ) in C_Pattern_s77 v76 {-# INLINE rule551 #-} {-# LINE 260 "src-ag/LOAG/Prepare.ag" #-} rule551 = \ ((_patIafs) :: [(FLabel, ALabel, Bool)]) attr_ field_ -> {-# LINE 260 "src-ag/LOAG/Prepare.ag" #-} let isLocal = (field_ == _LOC || field_ == _INST) in [(getName field_, (getName attr_, dlhs field_), isLocal)] ++ _patIafs {-# LINE 4548 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule552 #-} rule552 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy {-# INLINE rule553 #-} rule553 = \ ((_patIself) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIself {-# INLINE rule554 #-} rule554 = \ _copy -> _copy {-# INLINE rule555 #-} rule555 = \ _self -> _self {-# NOINLINE sem_Pattern_Irrefutable #-} sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st77) where {-# NOINLINE st77 #-} st77 = let v76 :: T_Pattern_v76 v76 = \ (T_Pattern_vIn76 ) -> ( let _patX77 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) (T_Pattern_vOut76 _patIafs _patIcopy _patIself) = inv_Pattern_s77 _patX77 (T_Pattern_vIn76 ) _lhsOafs :: [(FLabel, ALabel, Bool)] _lhsOafs = rule556 _patIafs _copy = rule557 _patIcopy _self = rule558 _patIself _lhsOcopy :: Pattern _lhsOcopy = rule559 _copy _lhsOself :: Pattern _lhsOself = rule560 _self __result_ = T_Pattern_vOut76 _lhsOafs _lhsOcopy _lhsOself in __result_ ) in C_Pattern_s77 v76 {-# INLINE rule556 #-} rule556 = \ ((_patIafs) :: [(FLabel, ALabel, Bool)]) -> _patIafs {-# INLINE rule557 #-} rule557 = \ ((_patIcopy) :: Pattern) -> Irrefutable _patIcopy {-# INLINE rule558 #-} rule558 = \ ((_patIself) :: Pattern) -> Irrefutable _patIself {-# INLINE rule559 #-} rule559 = \ _copy -> _copy {-# INLINE rule560 #-} rule560 = \ _self -> _self {-# NOINLINE sem_Pattern_Underscore #-} sem_Pattern_Underscore :: (Pos) -> T_Pattern sem_Pattern_Underscore arg_pos_ = T_Pattern (return st77) where {-# NOINLINE st77 #-} st77 = let v76 :: T_Pattern_v76 v76 = \ (T_Pattern_vIn76 ) -> ( let _lhsOafs :: [(FLabel, ALabel, Bool)] _lhsOafs = rule561 () _copy = rule562 arg_pos_ _self = rule563 arg_pos_ _lhsOcopy :: Pattern _lhsOcopy = rule564 _copy _lhsOself :: Pattern _lhsOself = rule565 _self __result_ = T_Pattern_vOut76 _lhsOafs _lhsOcopy _lhsOself in __result_ ) in C_Pattern_s77 v76 {-# INLINE rule561 #-} rule561 = \ (_ :: ()) -> [] {-# INLINE rule562 #-} rule562 = \ pos_ -> Underscore pos_ {-# INLINE rule563 #-} rule563 = \ pos_ -> Underscore pos_ {-# INLINE rule564 #-} rule564 = \ _copy -> _copy {-# INLINE rule565 #-} rule565 = \ _self -> _self -- Patterns ---------------------------------------------------- -- wrapper data Inh_Patterns = Inh_Patterns { } data Syn_Patterns = Syn_Patterns { afs_Syn_Patterns :: ([(FLabel, ALabel, Bool)]), copy_Syn_Patterns :: (Patterns), self_Syn_Patterns :: (Patterns) } {-# INLINABLE wrap_Patterns #-} wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg79 = T_Patterns_vIn79 (T_Patterns_vOut79 _lhsOafs _lhsOcopy _lhsOself) <- return (inv_Patterns_s80 sem arg79) return (Syn_Patterns _lhsOafs _lhsOcopy _lhsOself) ) -- cata {-# NOINLINE sem_Patterns #-} sem_Patterns :: Patterns -> T_Patterns sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) -- semantic domain newtype T_Patterns = T_Patterns { attach_T_Patterns :: Identity (T_Patterns_s80 ) } newtype T_Patterns_s80 = C_Patterns_s80 { inv_Patterns_s80 :: (T_Patterns_v79 ) } data T_Patterns_s81 = C_Patterns_s81 type T_Patterns_v79 = (T_Patterns_vIn79 ) -> (T_Patterns_vOut79 ) data T_Patterns_vIn79 = T_Patterns_vIn79 data T_Patterns_vOut79 = T_Patterns_vOut79 ([(FLabel, ALabel, Bool)]) (Patterns) (Patterns) {-# NOINLINE sem_Patterns_Cons #-} sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st80) where {-# NOINLINE st80 #-} st80 = let v79 :: T_Patterns_v79 v79 = \ (T_Patterns_vIn79 ) -> ( let _hdX77 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) _tlX80 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) (T_Pattern_vOut76 _hdIafs _hdIcopy _hdIself) = inv_Pattern_s77 _hdX77 (T_Pattern_vIn76 ) (T_Patterns_vOut79 _tlIafs _tlIcopy _tlIself) = inv_Patterns_s80 _tlX80 (T_Patterns_vIn79 ) _lhsOafs :: [(FLabel, ALabel, Bool)] _lhsOafs = rule566 _hdIafs _tlIafs _copy = rule567 _hdIcopy _tlIcopy _self = rule568 _hdIself _tlIself _lhsOcopy :: Patterns _lhsOcopy = rule569 _copy _lhsOself :: Patterns _lhsOself = rule570 _self __result_ = T_Patterns_vOut79 _lhsOafs _lhsOcopy _lhsOself in __result_ ) in C_Patterns_s80 v79 {-# INLINE rule566 #-} rule566 = \ ((_hdIafs) :: [(FLabel, ALabel, Bool)]) ((_tlIafs) :: [(FLabel, ALabel, Bool)]) -> _hdIafs ++ _tlIafs {-# INLINE rule567 #-} rule567 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> (:) _hdIcopy _tlIcopy {-# INLINE rule568 #-} rule568 = \ ((_hdIself) :: Pattern) ((_tlIself) :: Patterns) -> (:) _hdIself _tlIself {-# INLINE rule569 #-} rule569 = \ _copy -> _copy {-# INLINE rule570 #-} rule570 = \ _self -> _self {-# NOINLINE sem_Patterns_Nil #-} sem_Patterns_Nil :: T_Patterns sem_Patterns_Nil = T_Patterns (return st80) where {-# NOINLINE st80 #-} st80 = let v79 :: T_Patterns_v79 v79 = \ (T_Patterns_vIn79 ) -> ( let _lhsOafs :: [(FLabel, ALabel, Bool)] _lhsOafs = rule571 () _copy = rule572 () _self = rule573 () _lhsOcopy :: Patterns _lhsOcopy = rule574 _copy _lhsOself :: Patterns _lhsOself = rule575 _self __result_ = T_Patterns_vOut79 _lhsOafs _lhsOcopy _lhsOself in __result_ ) in C_Patterns_s80 v79 {-# INLINE rule571 #-} rule571 = \ (_ :: ()) -> [] {-# INLINE rule572 #-} rule572 = \ (_ :: ()) -> [] {-# INLINE rule573 #-} rule573 = \ (_ :: ()) -> [] {-# INLINE rule574 #-} rule574 = \ _copy -> _copy {-# INLINE rule575 #-} rule575 = \ _self -> _self -- Production -------------------------------------------------- -- wrapper data Inh_Production = Inh_Production { ain_Inh_Production :: (MyType -> MyAttributes), an_Inh_Production :: (MyType -> MyAttributes), aroundMap_Inh_Production :: (Map ConstructorIdent (Map Identifier [Expression])), asn_Inh_Production :: (MyType -> MyAttributes), augM_Inh_Production :: (Map.Map Identifier (Set.Set Dependency)), dty_Inh_Production :: (MyType), flab_Inh_Production :: (Int), fty_Inh_Production :: (FTY), ftyf_Inh_Production :: (FTY), hoMapf_Inh_Production :: (HOMap), lfpf_Inh_Production :: (SF_P), mergeMap_Inh_Production :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))), mysegments_Inh_Production :: (MySegments), nmp_Inh_Production :: (NMP), nmprf_Inh_Production :: (NMP_R), olab_Inh_Production :: (Int), options_Inh_Production :: (Options), pmpf_Inh_Production :: (PMP), pmprf_Inh_Production :: (PMP_R), res_ads_Inh_Production :: ([Edge]), rulenumber_Inh_Production :: (Int), tdp_Inh_Production :: (TDPRes), visMapf_Inh_Production :: (IMap.IntMap Int), visitnum_Inh_Production :: (Int) } data Syn_Production = Syn_Production { ads_Syn_Production :: ([Edge]), ap_Syn_Production :: (A_P), eprods_Syn_Production :: (EProductions), fdps_Syn_Production :: (Map.Map ConstructorIdent (Set Dependency)), fieldMap_Syn_Production :: (FMap), flab_Syn_Production :: (Int), fsInP_Syn_Production :: (FsInP), fty_Syn_Production :: (FTY), gen_Syn_Production :: (Map Int Int), hoMap_Syn_Production :: (HOMap), inss_Syn_Production :: (Map Int [Int]), lfp_Syn_Production :: (SF_P), lfpr_Syn_Production :: (SF_P), localSigMap_Syn_Production :: (Map.Map ConstructorIdent (Map.Map Identifier Type)), ofld_Syn_Production :: ([(Int, Int)]), olab_Syn_Production :: (Int), pmp_Syn_Production :: (PMP), pmpr_Syn_Production :: (PMP_R), ps_Syn_Production :: (PLabel), refHoNts_Syn_Production :: (Set NontermIdent), refNts_Syn_Production :: (Set NontermIdent), ruleMap_Syn_Production :: (Map.Map MyOccurrence Identifier), rulenumber_Syn_Production :: (Int), self_Syn_Production :: (Production), sfp_Syn_Production :: (SF_P), visitnum_Syn_Production :: (Int) } {-# INLINABLE wrap_Production #-} wrap_Production :: T_Production -> Inh_Production -> (Syn_Production ) wrap_Production (T_Production act) (Inh_Production _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIaugM _lhsIdty _lhsIflab _lhsIfty _lhsIftyf _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsImysegments _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIres_ads _lhsIrulenumber _lhsItdp _lhsIvisMapf _lhsIvisitnum) = Control.Monad.Identity.runIdentity ( do sem <- act let arg82 = T_Production_vIn82 _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIaugM _lhsIdty _lhsIflab _lhsIfty _lhsIftyf _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsImysegments _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIres_ads _lhsIrulenumber _lhsItdp _lhsIvisMapf _lhsIvisitnum (T_Production_vOut82 _lhsOads _lhsOap _lhsOeprods _lhsOfdps _lhsOfieldMap _lhsOflab _lhsOfsInP _lhsOfty _lhsOgen _lhsOhoMap _lhsOinss _lhsOlfp _lhsOlfpr _lhsOlocalSigMap _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOps _lhsOrefHoNts _lhsOrefNts _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOvisitnum) <- return (inv_Production_s83 sem arg82) return (Syn_Production _lhsOads _lhsOap _lhsOeprods _lhsOfdps _lhsOfieldMap _lhsOflab _lhsOfsInP _lhsOfty _lhsOgen _lhsOhoMap _lhsOinss _lhsOlfp _lhsOlfpr _lhsOlocalSigMap _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOps _lhsOrefHoNts _lhsOrefNts _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOvisitnum) ) -- cata {-# INLINE sem_Production #-} sem_Production :: Production -> T_Production sem_Production ( Production con_ params_ constraints_ children_ rules_ typeSigs_ macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_ -- semantic domain newtype T_Production = T_Production { attach_T_Production :: Identity (T_Production_s83 ) } newtype T_Production_s83 = C_Production_s83 { inv_Production_s83 :: (T_Production_v82 ) } data T_Production_s84 = C_Production_s84 type T_Production_v82 = (T_Production_vIn82 ) -> (T_Production_vOut82 ) data T_Production_vIn82 = T_Production_vIn82 (MyType -> MyAttributes) (MyType -> MyAttributes) (Map ConstructorIdent (Map Identifier [Expression])) (MyType -> MyAttributes) (Map.Map Identifier (Set.Set Dependency)) (MyType) (Int) (FTY) (FTY) (HOMap) (SF_P) (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) (MySegments) (NMP) (NMP_R) (Int) (Options) (PMP) (PMP_R) ([Edge]) (Int) (TDPRes) (IMap.IntMap Int) (Int) data T_Production_vOut82 = T_Production_vOut82 ([Edge]) (A_P) (EProductions) (Map.Map ConstructorIdent (Set Dependency)) (FMap) (Int) (FsInP) (FTY) (Map Int Int) (HOMap) (Map Int [Int]) (SF_P) (SF_P) (Map.Map ConstructorIdent (Map.Map Identifier Type)) ([(Int, Int)]) (Int) (PMP) (PMP_R) (PLabel) (Set NontermIdent) (Set NontermIdent) (Map.Map MyOccurrence Identifier) (Int) (Production) (SF_P) (Int) {-# NOINLINE sem_Production_Production #-} sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production sem_Production_Production arg_con_ arg_params_ arg_constraints_ arg_children_ arg_rules_ arg_typeSigs_ arg_macro_ = T_Production (return st83) where {-# NOINLINE st83 #-} st83 = let v82 :: T_Production_v82 v82 = \ (T_Production_vIn82 _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIaugM _lhsIdty _lhsIflab _lhsIfty _lhsIftyf _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsImysegments _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIres_ads _lhsIrulenumber _lhsItdp _lhsIvisMapf _lhsIvisitnum) -> ( let _childrenX38 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) _rulesX92 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) _typeSigsX101 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) _segsX68 = Control.Monad.Identity.runIdentity (attach_T_MySegments ((sem_MySegments segs_val_))) (T_Children_vOut37 _childrenIap _childrenIechilds _childrenIfieldMap _childrenIflab _childrenIfty _childrenIgen _childrenIhoMap _childrenIinss _childrenIofld _childrenIolab _childrenIpmp _childrenIpmpr _childrenIpts _childrenIrefHoNts _childrenIrefNts _childrenIself) = inv_Children_s38 _childrenX38 (T_Children_vIn37 _childrenOain _childrenOan _childrenOaroundMap _childrenOasn _childrenOdty _childrenOflab _childrenOfty _childrenOhoMapf _childrenOlfpf _childrenOmergeMap _childrenOmergedChildren _childrenOnmp _childrenOnmprf _childrenOolab _childrenOoptions _childrenOpll _childrenOpmpf _childrenOpmprf) (T_Rules_vOut91 _rulesIerules _rulesIlfp _rulesIlfpr _rulesIruleMap _rulesIrulenumber _rulesIself _rulesIsfp _rulesIusedLocals) = inv_Rules_s92 _rulesX92 (T_Rules_vIn91 _rulesOdty _rulesOlfpf _rulesOpll _rulesOpts _rulesOrulenumber) (T_TypeSigs_vOut100 _typeSigsIlocalSigMap _typeSigsIself) = inv_TypeSigs_s101 _typeSigsX101 (T_TypeSigs_vIn100 ) (T_MySegments_vOut67 _segsIevisits _segsIself _segsIvisitnum) = inv_MySegments_s68 _segsX68 (T_MySegments_vIn67 _segsOain _segsOasn _segsOdone _segsOfty _segsOhoMapf _segsOlfpf _segsOnmp _segsOnmprf _segsOoptions _segsOpmpf _segsOpmprf _segsOps _segsOruleMap _segsOtdp _segsOvisMapf _segsOvisitnum) _aroundMap = rule576 _lhsIaroundMap arg_con_ _mergeMap = rule577 _lhsImergeMap arg_con_ _mergedChildren = rule578 _mergeMap _lhsOlocalSigMap :: Map.Map ConstructorIdent (Map.Map Identifier Type) _lhsOlocalSigMap = rule579 _typeSigsIlocalSigMap arg_con_ _ps = rule580 _lhsIdty arg_con_ _lhsOads :: [Edge] _lhsOads = rule581 _childrenIpmpr _lhsIaugM _pll arg_con_ _childrenOdty = rule582 _lhsIdty _pll = rule583 _lhsIdty arg_con_ _rulesOpll = rule584 _pll _rulesOpts = rule585 _childrenIpts _lhsOfsInP :: FsInP _lhsOfsInP = rule586 _childrenIfieldMap _pll _lhsOfdps :: Map.Map ConstructorIdent (Set Dependency) _lhsOfdps = rule587 _lhsIdty _lhsIpmpf _lhsIres_ads arg_con_ _segsOruleMap = rule588 _rulesIruleMap _segsOdone = rule589 () _intros = rule590 _childrenIself _lhsOeprods :: EProductions _lhsOeprods = rule591 _childrenIechilds _intros _rulesIerules _segsIevisits arg_con_ arg_constraints_ arg_params_ segs_val_ = rule592 _lhsImysegments _lhsInmp _lhsIpmprf _ps _lhsOap :: A_P _lhsOap = rule593 _childrenIap _lhsOfieldMap :: FMap _lhsOfieldMap = rule594 _childrenIfieldMap _lhsOfty :: FTY _lhsOfty = rule595 _childrenIfty _lhsOgen :: Map Int Int _lhsOgen = rule596 _childrenIgen _lhsOhoMap :: HOMap _lhsOhoMap = rule597 _childrenIhoMap _lhsOinss :: Map Int [Int] _lhsOinss = rule598 _childrenIinss _lhsOlfp :: SF_P _lhsOlfp = rule599 _rulesIlfp _lhsOlfpr :: SF_P _lhsOlfpr = rule600 _rulesIlfpr _lhsOofld :: [(Int, Int)] _lhsOofld = rule601 _childrenIofld _lhsOpmp :: PMP _lhsOpmp = rule602 _childrenIpmp _lhsOpmpr :: PMP_R _lhsOpmpr = rule603 _childrenIpmpr _lhsOrefHoNts :: Set NontermIdent _lhsOrefHoNts = rule604 _childrenIrefHoNts _lhsOrefNts :: Set NontermIdent _lhsOrefNts = rule605 _childrenIrefNts _lhsOruleMap :: Map.Map MyOccurrence Identifier _lhsOruleMap = rule606 _rulesIruleMap _lhsOsfp :: SF_P _lhsOsfp = rule607 _rulesIsfp _self = rule608 _childrenIself _rulesIself _typeSigsIself arg_con_ arg_constraints_ arg_macro_ arg_params_ _lhsOself :: Production _lhsOself = rule609 _self _lhsOflab :: Int _lhsOflab = rule610 _childrenIflab _lhsOolab :: Int _lhsOolab = rule611 _childrenIolab _lhsOps :: PLabel _lhsOps = rule612 _ps _lhsOrulenumber :: Int _lhsOrulenumber = rule613 _rulesIrulenumber _lhsOvisitnum :: Int _lhsOvisitnum = rule614 _segsIvisitnum _childrenOain = rule615 _lhsIain _childrenOan = rule616 _lhsIan _childrenOaroundMap = rule617 _aroundMap _childrenOasn = rule618 _lhsIasn _childrenOflab = rule619 _lhsIflab _childrenOfty = rule620 _lhsIfty _childrenOhoMapf = rule621 _lhsIhoMapf _childrenOlfpf = rule622 _lhsIlfpf _childrenOmergeMap = rule623 _mergeMap _childrenOmergedChildren = rule624 _mergedChildren _childrenOnmp = rule625 _lhsInmp _childrenOnmprf = rule626 _lhsInmprf _childrenOolab = rule627 _lhsIolab _childrenOoptions = rule628 _lhsIoptions _childrenOpll = rule629 _pll _childrenOpmpf = rule630 _lhsIpmpf _childrenOpmprf = rule631 _lhsIpmprf _rulesOdty = rule632 _lhsIdty _rulesOlfpf = rule633 _lhsIlfpf _rulesOrulenumber = rule634 _lhsIrulenumber _segsOain = rule635 _lhsIain _segsOasn = rule636 _lhsIasn _segsOfty = rule637 _childrenIfty _segsOhoMapf = rule638 _lhsIhoMapf _segsOlfpf = rule639 _lhsIlfpf _segsOnmp = rule640 _lhsInmp _segsOnmprf = rule641 _lhsInmprf _segsOoptions = rule642 _lhsIoptions _segsOpmpf = rule643 _lhsIpmpf _segsOpmprf = rule644 _lhsIpmprf _segsOps = rule645 _ps _segsOtdp = rule646 _lhsItdp _segsOvisMapf = rule647 _lhsIvisMapf _segsOvisitnum = rule648 _lhsIvisitnum __result_ = T_Production_vOut82 _lhsOads _lhsOap _lhsOeprods _lhsOfdps _lhsOfieldMap _lhsOflab _lhsOfsInP _lhsOfty _lhsOgen _lhsOhoMap _lhsOinss _lhsOlfp _lhsOlfpr _lhsOlocalSigMap _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOps _lhsOrefHoNts _lhsOrefNts _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOvisitnum in __result_ ) in C_Production_s83 v82 {-# INLINE rule576 #-} {-# LINE 89 "src-ag/ExecutionPlanCommon.ag" #-} rule576 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Map Identifier [Expression])) con_ -> {-# LINE 89 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Map.empty con_ _lhsIaroundMap {-# LINE 4883 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule577 #-} {-# LINE 114 "src-ag/ExecutionPlanCommon.ag" #-} rule577 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) con_ -> {-# LINE 114 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Map.empty con_ _lhsImergeMap {-# LINE 4889 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule578 #-} {-# LINE 120 "src-ag/ExecutionPlanCommon.ag" #-} rule578 = \ _mergeMap -> {-# LINE 120 "src-ag/ExecutionPlanCommon.ag" #-} Set.unions [ Set.fromList ms | (_,ms,_) <- Map.elems _mergeMap ] {-# LINE 4895 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule579 #-} {-# LINE 160 "src-ag/ExecutionPlanCommon.ag" #-} rule579 = \ ((_typeSigsIlocalSigMap) :: Map Identifier Type) con_ -> {-# LINE 160 "src-ag/ExecutionPlanCommon.ag" #-} Map.singleton con_ _typeSigsIlocalSigMap {-# LINE 4901 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule580 #-} {-# LINE 115 "src-ag/LOAG/Prepare.ag" #-} rule580 = \ ((_lhsIdty) :: MyType) con_ -> {-# LINE 115 "src-ag/LOAG/Prepare.ag" #-} (_lhsIdty,getName con_) {-# LINE 4907 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule581 #-} {-# LINE 117 "src-ag/LOAG/Prepare.ag" #-} rule581 = \ ((_childrenIpmpr) :: PMP_R) ((_lhsIaugM) :: Map.Map Identifier (Set.Set Dependency)) _pll con_ -> {-# LINE 117 "src-ag/LOAG/Prepare.ag" #-} case Map.lookup con_ _lhsIaugM of Nothing -> [] Just a -> Set.toList $ Set.map (depToEdge _childrenIpmpr _pll ) a {-# LINE 4915 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule582 #-} {-# LINE 120 "src-ag/LOAG/Prepare.ag" #-} rule582 = \ ((_lhsIdty) :: MyType) -> {-# LINE 120 "src-ag/LOAG/Prepare.ag" #-} _lhsIdty {-# LINE 4921 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule583 #-} {-# LINE 214 "src-ag/LOAG/Prepare.ag" #-} rule583 = \ ((_lhsIdty) :: MyType) con_ -> {-# LINE 214 "src-ag/LOAG/Prepare.ag" #-} (_lhsIdty,getName con_) {-# LINE 4927 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule584 #-} {-# LINE 215 "src-ag/LOAG/Prepare.ag" #-} rule584 = \ _pll -> {-# LINE 215 "src-ag/LOAG/Prepare.ag" #-} _pll {-# LINE 4933 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule585 #-} {-# LINE 216 "src-ag/LOAG/Prepare.ag" #-} rule585 = \ ((_childrenIpts) :: Set.Set FLabel) -> {-# LINE 216 "src-ag/LOAG/Prepare.ag" #-} _childrenIpts {-# LINE 4939 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule586 #-} {-# LINE 217 "src-ag/LOAG/Prepare.ag" #-} rule586 = \ ((_childrenIfieldMap) :: FMap) _pll -> {-# LINE 217 "src-ag/LOAG/Prepare.ag" #-} Map.singleton _pll $ Map.keys _childrenIfieldMap {-# LINE 4945 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule587 #-} {-# LINE 89 "src-ag/LOAG/Order.ag" #-} rule587 = \ ((_lhsIdty) :: MyType) ((_lhsIpmpf) :: PMP) ((_lhsIres_ads) :: [Edge]) con_ -> {-# LINE 89 "src-ag/LOAG/Order.ag" #-} let op d@(f,t) ds | fst (argsOf $ findWithErr _lhsIpmpf "fdps" f) == (_lhsIdty,getName con_) = Set.insert (edgeToDep _lhsIpmpf d) ds | otherwise = ds in Map.singleton con_ $ foldr op Set.empty _lhsIres_ads {-# LINE 4956 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule588 #-} {-# LINE 167 "src-ag/LOAG/Order.ag" #-} rule588 = \ ((_rulesIruleMap) :: Map.Map MyOccurrence Identifier) -> {-# LINE 167 "src-ag/LOAG/Order.ag" #-} _rulesIruleMap {-# LINE 4962 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule589 #-} {-# LINE 168 "src-ag/LOAG/Order.ag" #-} rule589 = \ (_ :: ()) -> {-# LINE 168 "src-ag/LOAG/Order.ag" #-} (Set.empty, Set.empty, Set.empty, Set.empty) {-# LINE 4968 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule590 #-} {-# LINE 169 "src-ag/LOAG/Order.ag" #-} rule590 = \ ((_childrenIself) :: Children) -> {-# LINE 169 "src-ag/LOAG/Order.ag" #-} let intro (Child nm _ kind) | kind == ChildAttr = Nothing | otherwise = Just $ ChildIntro nm in catMaybes $ map intro _childrenIself {-# LINE 4977 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule591 #-} {-# LINE 174 "src-ag/LOAG/Order.ag" #-} rule591 = \ ((_childrenIechilds) :: EChildren) _intros ((_rulesIerules) :: ERules) ((_segsIevisits) :: Visits) con_ constraints_ params_ -> {-# LINE 174 "src-ag/LOAG/Order.ag" #-} let ((Visit ident from to inh syn steps kind):vss) = _segsIevisits steps' = _intros ++ steps visits | null _segsIevisits = [] | otherwise = ((Visit ident from to inh syn steps' kind):vss) in [EProduction con_ params_ constraints_ _rulesIerules _childrenIechilds visits ] {-# LINE 4994 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule592 #-} {-# LINE 346 "src-ag/LOAG/Order.ag" #-} rule592 = \ ((_lhsImysegments) :: MySegments) ((_lhsInmp) :: NMP) ((_lhsIpmprf) :: PMP_R) _ps -> {-# LINE 346 "src-ag/LOAG/Order.ag" #-} map (\(MySegment visnr inhs syns _ _) -> MySegment visnr inhs syns (Just $ map (_lhsIpmprf Map.!) $ handAllOut (_ps ,"lhs") $ map (_lhsInmp Map.!) inhs) (Just $ map (_lhsIpmprf Map.!) $ handAllOut (_ps ,"lhs") $ map (_lhsInmp Map.!) syns) ) _lhsImysegments {-# LINE 5008 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule593 #-} rule593 = \ ((_childrenIap) :: A_P) -> _childrenIap {-# INLINE rule594 #-} rule594 = \ ((_childrenIfieldMap) :: FMap) -> _childrenIfieldMap {-# INLINE rule595 #-} rule595 = \ ((_childrenIfty) :: FTY) -> _childrenIfty {-# INLINE rule596 #-} rule596 = \ ((_childrenIgen) :: Map Int Int) -> _childrenIgen {-# INLINE rule597 #-} rule597 = \ ((_childrenIhoMap) :: HOMap) -> _childrenIhoMap {-# INLINE rule598 #-} rule598 = \ ((_childrenIinss) :: Map Int [Int]) -> _childrenIinss {-# INLINE rule599 #-} rule599 = \ ((_rulesIlfp) :: SF_P) -> _rulesIlfp {-# INLINE rule600 #-} rule600 = \ ((_rulesIlfpr) :: SF_P) -> _rulesIlfpr {-# INLINE rule601 #-} rule601 = \ ((_childrenIofld) :: [(Int, Int)]) -> _childrenIofld {-# INLINE rule602 #-} rule602 = \ ((_childrenIpmp) :: PMP) -> _childrenIpmp {-# INLINE rule603 #-} rule603 = \ ((_childrenIpmpr) :: PMP_R) -> _childrenIpmpr {-# INLINE rule604 #-} rule604 = \ ((_childrenIrefHoNts) :: Set NontermIdent) -> _childrenIrefHoNts {-# INLINE rule605 #-} rule605 = \ ((_childrenIrefNts) :: Set NontermIdent) -> _childrenIrefNts {-# INLINE rule606 #-} rule606 = \ ((_rulesIruleMap) :: Map.Map MyOccurrence Identifier) -> _rulesIruleMap {-# INLINE rule607 #-} rule607 = \ ((_rulesIsfp) :: SF_P) -> _rulesIsfp {-# INLINE rule608 #-} rule608 = \ ((_childrenIself) :: Children) ((_rulesIself) :: Rules) ((_typeSigsIself) :: TypeSigs) con_ constraints_ macro_ params_ -> Production con_ params_ constraints_ _childrenIself _rulesIself _typeSigsIself macro_ {-# INLINE rule609 #-} rule609 = \ _self -> _self {-# INLINE rule610 #-} rule610 = \ ((_childrenIflab) :: Int) -> _childrenIflab {-# INLINE rule611 #-} rule611 = \ ((_childrenIolab) :: Int) -> _childrenIolab {-# INLINE rule612 #-} rule612 = \ _ps -> _ps {-# INLINE rule613 #-} rule613 = \ ((_rulesIrulenumber) :: Int) -> _rulesIrulenumber {-# INLINE rule614 #-} rule614 = \ ((_segsIvisitnum) :: Int) -> _segsIvisitnum {-# INLINE rule615 #-} rule615 = \ ((_lhsIain) :: MyType -> MyAttributes) -> _lhsIain {-# INLINE rule616 #-} rule616 = \ ((_lhsIan) :: MyType -> MyAttributes) -> _lhsIan {-# INLINE rule617 #-} rule617 = \ _aroundMap -> _aroundMap {-# INLINE rule618 #-} rule618 = \ ((_lhsIasn) :: MyType -> MyAttributes) -> _lhsIasn {-# INLINE rule619 #-} rule619 = \ ((_lhsIflab) :: Int) -> _lhsIflab {-# INLINE rule620 #-} rule620 = \ ((_lhsIfty) :: FTY) -> _lhsIfty {-# INLINE rule621 #-} rule621 = \ ((_lhsIhoMapf) :: HOMap) -> _lhsIhoMapf {-# INLINE rule622 #-} rule622 = \ ((_lhsIlfpf) :: SF_P) -> _lhsIlfpf {-# INLINE rule623 #-} rule623 = \ _mergeMap -> _mergeMap {-# INLINE rule624 #-} rule624 = \ _mergedChildren -> _mergedChildren {-# INLINE rule625 #-} rule625 = \ ((_lhsInmp) :: NMP) -> _lhsInmp {-# INLINE rule626 #-} rule626 = \ ((_lhsInmprf) :: NMP_R) -> _lhsInmprf {-# INLINE rule627 #-} rule627 = \ ((_lhsIolab) :: Int) -> _lhsIolab {-# INLINE rule628 #-} rule628 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule629 #-} rule629 = \ _pll -> _pll {-# INLINE rule630 #-} rule630 = \ ((_lhsIpmpf) :: PMP) -> _lhsIpmpf {-# INLINE rule631 #-} rule631 = \ ((_lhsIpmprf) :: PMP_R) -> _lhsIpmprf {-# INLINE rule632 #-} rule632 = \ ((_lhsIdty) :: MyType) -> _lhsIdty {-# INLINE rule633 #-} rule633 = \ ((_lhsIlfpf) :: SF_P) -> _lhsIlfpf {-# INLINE rule634 #-} rule634 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber {-# INLINE rule635 #-} rule635 = \ ((_lhsIain) :: MyType -> MyAttributes) -> _lhsIain {-# INLINE rule636 #-} rule636 = \ ((_lhsIasn) :: MyType -> MyAttributes) -> _lhsIasn {-# INLINE rule637 #-} rule637 = \ ((_childrenIfty) :: FTY) -> _childrenIfty {-# INLINE rule638 #-} rule638 = \ ((_lhsIhoMapf) :: HOMap) -> _lhsIhoMapf {-# INLINE rule639 #-} rule639 = \ ((_lhsIlfpf) :: SF_P) -> _lhsIlfpf {-# INLINE rule640 #-} rule640 = \ ((_lhsInmp) :: NMP) -> _lhsInmp {-# INLINE rule641 #-} rule641 = \ ((_lhsInmprf) :: NMP_R) -> _lhsInmprf {-# INLINE rule642 #-} rule642 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule643 #-} rule643 = \ ((_lhsIpmpf) :: PMP) -> _lhsIpmpf {-# INLINE rule644 #-} rule644 = \ ((_lhsIpmprf) :: PMP_R) -> _lhsIpmprf {-# INLINE rule645 #-} rule645 = \ _ps -> _ps {-# INLINE rule646 #-} rule646 = \ ((_lhsItdp) :: TDPRes) -> _lhsItdp {-# INLINE rule647 #-} rule647 = \ ((_lhsIvisMapf) :: IMap.IntMap Int) -> _lhsIvisMapf {-# INLINE rule648 #-} rule648 = \ ((_lhsIvisitnum) :: Int) -> _lhsIvisitnum -- Productions ------------------------------------------------- -- wrapper data Inh_Productions = Inh_Productions { ain_Inh_Productions :: (MyType -> MyAttributes), an_Inh_Productions :: (MyType -> MyAttributes), aroundMap_Inh_Productions :: (Map ConstructorIdent (Map Identifier [Expression])), asn_Inh_Productions :: (MyType -> MyAttributes), augM_Inh_Productions :: (Map.Map Identifier (Set.Set Dependency)), dty_Inh_Productions :: (MyType), flab_Inh_Productions :: (Int), fty_Inh_Productions :: (FTY), ftyf_Inh_Productions :: (FTY), hoMapf_Inh_Productions :: (HOMap), lfpf_Inh_Productions :: (SF_P), mergeMap_Inh_Productions :: (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))), mysegments_Inh_Productions :: (MySegments), nmp_Inh_Productions :: (NMP), nmprf_Inh_Productions :: (NMP_R), olab_Inh_Productions :: (Int), options_Inh_Productions :: (Options), pmpf_Inh_Productions :: (PMP), pmprf_Inh_Productions :: (PMP_R), res_ads_Inh_Productions :: ([Edge]), rulenumber_Inh_Productions :: (Int), tdp_Inh_Productions :: (TDPRes), visMapf_Inh_Productions :: (IMap.IntMap Int), visitnum_Inh_Productions :: (Int) } data Syn_Productions = Syn_Productions { ads_Syn_Productions :: ([Edge]), ap_Syn_Productions :: (A_P), eprods_Syn_Productions :: (EProductions), fdps_Syn_Productions :: (Map.Map ConstructorIdent (Set Dependency)), fieldMap_Syn_Productions :: (FMap), flab_Syn_Productions :: (Int), fsInP_Syn_Productions :: (FsInP), fty_Syn_Productions :: (FTY), gen_Syn_Productions :: (Map Int Int), hoMap_Syn_Productions :: (HOMap), inss_Syn_Productions :: (Map Int [Int]), lfp_Syn_Productions :: (SF_P), lfpr_Syn_Productions :: (SF_P), localSigMap_Syn_Productions :: (Map.Map ConstructorIdent (Map.Map Identifier Type)), ofld_Syn_Productions :: ([(Int, Int)]), olab_Syn_Productions :: (Int), pmp_Syn_Productions :: (PMP), pmpr_Syn_Productions :: (PMP_R), ps_Syn_Productions :: ([PLabel]), refHoNts_Syn_Productions :: (Set NontermIdent), refNts_Syn_Productions :: (Set NontermIdent), ruleMap_Syn_Productions :: (Map.Map MyOccurrence Identifier), rulenumber_Syn_Productions :: (Int), self_Syn_Productions :: (Productions), sfp_Syn_Productions :: (SF_P), visitnum_Syn_Productions :: (Int) } {-# INLINABLE wrap_Productions #-} wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions ) wrap_Productions (T_Productions act) (Inh_Productions _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIaugM _lhsIdty _lhsIflab _lhsIfty _lhsIftyf _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsImysegments _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIres_ads _lhsIrulenumber _lhsItdp _lhsIvisMapf _lhsIvisitnum) = Control.Monad.Identity.runIdentity ( do sem <- act let arg85 = T_Productions_vIn85 _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIaugM _lhsIdty _lhsIflab _lhsIfty _lhsIftyf _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsImysegments _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIres_ads _lhsIrulenumber _lhsItdp _lhsIvisMapf _lhsIvisitnum (T_Productions_vOut85 _lhsOads _lhsOap _lhsOeprods _lhsOfdps _lhsOfieldMap _lhsOflab _lhsOfsInP _lhsOfty _lhsOgen _lhsOhoMap _lhsOinss _lhsOlfp _lhsOlfpr _lhsOlocalSigMap _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOps _lhsOrefHoNts _lhsOrefNts _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOvisitnum) <- return (inv_Productions_s86 sem arg85) return (Syn_Productions _lhsOads _lhsOap _lhsOeprods _lhsOfdps _lhsOfieldMap _lhsOflab _lhsOfsInP _lhsOfty _lhsOgen _lhsOhoMap _lhsOinss _lhsOlfp _lhsOlfpr _lhsOlocalSigMap _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOps _lhsOrefHoNts _lhsOrefNts _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOvisitnum) ) -- cata {-# NOINLINE sem_Productions #-} sem_Productions :: Productions -> T_Productions sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) -- semantic domain newtype T_Productions = T_Productions { attach_T_Productions :: Identity (T_Productions_s86 ) } newtype T_Productions_s86 = C_Productions_s86 { inv_Productions_s86 :: (T_Productions_v85 ) } data T_Productions_s87 = C_Productions_s87 type T_Productions_v85 = (T_Productions_vIn85 ) -> (T_Productions_vOut85 ) data T_Productions_vIn85 = T_Productions_vIn85 (MyType -> MyAttributes) (MyType -> MyAttributes) (Map ConstructorIdent (Map Identifier [Expression])) (MyType -> MyAttributes) (Map.Map Identifier (Set.Set Dependency)) (MyType) (Int) (FTY) (FTY) (HOMap) (SF_P) (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) (MySegments) (NMP) (NMP_R) (Int) (Options) (PMP) (PMP_R) ([Edge]) (Int) (TDPRes) (IMap.IntMap Int) (Int) data T_Productions_vOut85 = T_Productions_vOut85 ([Edge]) (A_P) (EProductions) (Map.Map ConstructorIdent (Set Dependency)) (FMap) (Int) (FsInP) (FTY) (Map Int Int) (HOMap) (Map Int [Int]) (SF_P) (SF_P) (Map.Map ConstructorIdent (Map.Map Identifier Type)) ([(Int, Int)]) (Int) (PMP) (PMP_R) ([PLabel]) (Set NontermIdent) (Set NontermIdent) (Map.Map MyOccurrence Identifier) (Int) (Productions) (SF_P) (Int) {-# NOINLINE sem_Productions_Cons #-} sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st86) where {-# NOINLINE st86 #-} st86 = let v85 :: T_Productions_v85 v85 = \ (T_Productions_vIn85 _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIaugM _lhsIdty _lhsIflab _lhsIfty _lhsIftyf _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsImysegments _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIres_ads _lhsIrulenumber _lhsItdp _lhsIvisMapf _lhsIvisitnum) -> ( let _hdX83 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) _tlX86 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) (T_Production_vOut82 _hdIads _hdIap _hdIeprods _hdIfdps _hdIfieldMap _hdIflab _hdIfsInP _hdIfty _hdIgen _hdIhoMap _hdIinss _hdIlfp _hdIlfpr _hdIlocalSigMap _hdIofld _hdIolab _hdIpmp _hdIpmpr _hdIps _hdIrefHoNts _hdIrefNts _hdIruleMap _hdIrulenumber _hdIself _hdIsfp _hdIvisitnum) = inv_Production_s83 _hdX83 (T_Production_vIn82 _hdOain _hdOan _hdOaroundMap _hdOasn _hdOaugM _hdOdty _hdOflab _hdOfty _hdOftyf _hdOhoMapf _hdOlfpf _hdOmergeMap _hdOmysegments _hdOnmp _hdOnmprf _hdOolab _hdOoptions _hdOpmpf _hdOpmprf _hdOres_ads _hdOrulenumber _hdOtdp _hdOvisMapf _hdOvisitnum) (T_Productions_vOut85 _tlIads _tlIap _tlIeprods _tlIfdps _tlIfieldMap _tlIflab _tlIfsInP _tlIfty _tlIgen _tlIhoMap _tlIinss _tlIlfp _tlIlfpr _tlIlocalSigMap _tlIofld _tlIolab _tlIpmp _tlIpmpr _tlIps _tlIrefHoNts _tlIrefNts _tlIruleMap _tlIrulenumber _tlIself _tlIsfp _tlIvisitnum) = inv_Productions_s86 _tlX86 (T_Productions_vIn85 _tlOain _tlOan _tlOaroundMap _tlOasn _tlOaugM _tlOdty _tlOflab _tlOfty _tlOftyf _tlOhoMapf _tlOlfpf _tlOmergeMap _tlOmysegments _tlOnmp _tlOnmprf _tlOolab _tlOoptions _tlOpmpf _tlOpmprf _tlOres_ads _tlOrulenumber _tlOtdp _tlOvisMapf _tlOvisitnum) _tlOvisitnum = rule649 _lhsIvisitnum _lhsOvisitnum :: Int _lhsOvisitnum = rule650 _hdIvisitnum _lhsOads :: [Edge] _lhsOads = rule651 _hdIads _tlIads _lhsOap :: A_P _lhsOap = rule652 _hdIap _tlIap _lhsOeprods :: EProductions _lhsOeprods = rule653 _hdIeprods _tlIeprods _lhsOfdps :: Map.Map ConstructorIdent (Set Dependency) _lhsOfdps = rule654 _hdIfdps _tlIfdps _lhsOfieldMap :: FMap _lhsOfieldMap = rule655 _hdIfieldMap _tlIfieldMap _lhsOfsInP :: FsInP _lhsOfsInP = rule656 _hdIfsInP _tlIfsInP _lhsOfty :: FTY _lhsOfty = rule657 _hdIfty _tlIfty _lhsOgen :: Map Int Int _lhsOgen = rule658 _hdIgen _tlIgen _lhsOhoMap :: HOMap _lhsOhoMap = rule659 _hdIhoMap _tlIhoMap _lhsOinss :: Map Int [Int] _lhsOinss = rule660 _hdIinss _tlIinss _lhsOlfp :: SF_P _lhsOlfp = rule661 _hdIlfp _tlIlfp _lhsOlfpr :: SF_P _lhsOlfpr = rule662 _hdIlfpr _tlIlfpr _lhsOlocalSigMap :: Map.Map ConstructorIdent (Map.Map Identifier Type) _lhsOlocalSigMap = rule663 _hdIlocalSigMap _tlIlocalSigMap _lhsOofld :: [(Int, Int)] _lhsOofld = rule664 _hdIofld _tlIofld _lhsOpmp :: PMP _lhsOpmp = rule665 _hdIpmp _tlIpmp _lhsOpmpr :: PMP_R _lhsOpmpr = rule666 _hdIpmpr _tlIpmpr _lhsOps :: [PLabel] _lhsOps = rule667 _hdIps _tlIps _lhsOrefHoNts :: Set NontermIdent _lhsOrefHoNts = rule668 _hdIrefHoNts _tlIrefHoNts _lhsOrefNts :: Set NontermIdent _lhsOrefNts = rule669 _hdIrefNts _tlIrefNts _lhsOruleMap :: Map.Map MyOccurrence Identifier _lhsOruleMap = rule670 _hdIruleMap _tlIruleMap _lhsOsfp :: SF_P _lhsOsfp = rule671 _hdIsfp _tlIsfp _self = rule672 _hdIself _tlIself _lhsOself :: Productions _lhsOself = rule673 _self _lhsOflab :: Int _lhsOflab = rule674 _tlIflab _lhsOolab :: Int _lhsOolab = rule675 _tlIolab _lhsOrulenumber :: Int _lhsOrulenumber = rule676 _tlIrulenumber _hdOain = rule677 _lhsIain _hdOan = rule678 _lhsIan _hdOaroundMap = rule679 _lhsIaroundMap _hdOasn = rule680 _lhsIasn _hdOaugM = rule681 _lhsIaugM _hdOdty = rule682 _lhsIdty _hdOflab = rule683 _lhsIflab _hdOfty = rule684 _lhsIfty _hdOftyf = rule685 _lhsIftyf _hdOhoMapf = rule686 _lhsIhoMapf _hdOlfpf = rule687 _lhsIlfpf _hdOmergeMap = rule688 _lhsImergeMap _hdOmysegments = rule689 _lhsImysegments _hdOnmp = rule690 _lhsInmp _hdOnmprf = rule691 _lhsInmprf _hdOolab = rule692 _lhsIolab _hdOoptions = rule693 _lhsIoptions _hdOpmpf = rule694 _lhsIpmpf _hdOpmprf = rule695 _lhsIpmprf _hdOres_ads = rule696 _lhsIres_ads _hdOrulenumber = rule697 _lhsIrulenumber _hdOtdp = rule698 _lhsItdp _hdOvisMapf = rule699 _lhsIvisMapf _hdOvisitnum = rule700 _lhsIvisitnum _tlOain = rule701 _lhsIain _tlOan = rule702 _lhsIan _tlOaroundMap = rule703 _lhsIaroundMap _tlOasn = rule704 _lhsIasn _tlOaugM = rule705 _lhsIaugM _tlOdty = rule706 _lhsIdty _tlOflab = rule707 _hdIflab _tlOfty = rule708 _hdIfty _tlOftyf = rule709 _lhsIftyf _tlOhoMapf = rule710 _lhsIhoMapf _tlOlfpf = rule711 _lhsIlfpf _tlOmergeMap = rule712 _lhsImergeMap _tlOmysegments = rule713 _lhsImysegments _tlOnmp = rule714 _lhsInmp _tlOnmprf = rule715 _lhsInmprf _tlOolab = rule716 _hdIolab _tlOoptions = rule717 _lhsIoptions _tlOpmpf = rule718 _lhsIpmpf _tlOpmprf = rule719 _lhsIpmprf _tlOres_ads = rule720 _lhsIres_ads _tlOrulenumber = rule721 _hdIrulenumber _tlOtdp = rule722 _lhsItdp _tlOvisMapf = rule723 _lhsIvisMapf __result_ = T_Productions_vOut85 _lhsOads _lhsOap _lhsOeprods _lhsOfdps _lhsOfieldMap _lhsOflab _lhsOfsInP _lhsOfty _lhsOgen _lhsOhoMap _lhsOinss _lhsOlfp _lhsOlfpr _lhsOlocalSigMap _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOps _lhsOrefHoNts _lhsOrefNts _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOvisitnum in __result_ ) in C_Productions_s86 v85 {-# INLINE rule649 #-} {-# LINE 192 "src-ag/LOAG/Order.ag" #-} rule649 = \ ((_lhsIvisitnum) :: Int) -> {-# LINE 192 "src-ag/LOAG/Order.ag" #-} _lhsIvisitnum {-# LINE 5328 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule650 #-} {-# LINE 193 "src-ag/LOAG/Order.ag" #-} rule650 = \ ((_hdIvisitnum) :: Int) -> {-# LINE 193 "src-ag/LOAG/Order.ag" #-} _hdIvisitnum {-# LINE 5334 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule651 #-} rule651 = \ ((_hdIads) :: [Edge]) ((_tlIads) :: [Edge]) -> ((++) _hdIads _tlIads) {-# INLINE rule652 #-} rule652 = \ ((_hdIap) :: A_P) ((_tlIap) :: A_P) -> (Map.unionWith (++) _hdIap _tlIap) {-# INLINE rule653 #-} rule653 = \ ((_hdIeprods) :: EProductions) ((_tlIeprods) :: EProductions) -> ((++) _hdIeprods _tlIeprods) {-# INLINE rule654 #-} rule654 = \ ((_hdIfdps) :: Map.Map ConstructorIdent (Set Dependency)) ((_tlIfdps) :: Map.Map ConstructorIdent (Set Dependency)) -> (Map.union _hdIfdps _tlIfdps) {-# INLINE rule655 #-} rule655 = \ ((_hdIfieldMap) :: FMap) ((_tlIfieldMap) :: FMap) -> ((Map.union) _hdIfieldMap _tlIfieldMap) {-# INLINE rule656 #-} rule656 = \ ((_hdIfsInP) :: FsInP) ((_tlIfsInP) :: FsInP) -> ((Map.union) _hdIfsInP _tlIfsInP) {-# INLINE rule657 #-} rule657 = \ ((_hdIfty) :: FTY) ((_tlIfty) :: FTY) -> (Map.union _hdIfty _tlIfty) {-# INLINE rule658 #-} rule658 = \ ((_hdIgen) :: Map Int Int) ((_tlIgen) :: Map Int Int) -> (Map.union _hdIgen _tlIgen) {-# INLINE rule659 #-} rule659 = \ ((_hdIhoMap) :: HOMap) ((_tlIhoMap) :: HOMap) -> ((Map.union) _hdIhoMap _tlIhoMap) {-# INLINE rule660 #-} rule660 = \ ((_hdIinss) :: Map Int [Int]) ((_tlIinss) :: Map Int [Int]) -> (Map.unionWith (++) _hdIinss _tlIinss) {-# INLINE rule661 #-} rule661 = \ ((_hdIlfp) :: SF_P) ((_tlIlfp) :: SF_P) -> (Map.unionWith (Set.union) _hdIlfp _tlIlfp) {-# INLINE rule662 #-} rule662 = \ ((_hdIlfpr) :: SF_P) ((_tlIlfpr) :: SF_P) -> (Map.unionWith (Set.union) _hdIlfpr _tlIlfpr) {-# INLINE rule663 #-} rule663 = \ ((_hdIlocalSigMap) :: Map.Map ConstructorIdent (Map.Map Identifier Type)) ((_tlIlocalSigMap) :: Map.Map ConstructorIdent (Map.Map Identifier Type)) -> _hdIlocalSigMap `Map.union` _tlIlocalSigMap {-# INLINE rule664 #-} rule664 = \ ((_hdIofld) :: [(Int, Int)]) ((_tlIofld) :: [(Int, Int)]) -> ((++) _hdIofld _tlIofld) {-# INLINE rule665 #-} rule665 = \ ((_hdIpmp) :: PMP) ((_tlIpmp) :: PMP) -> (Map.union _hdIpmp _tlIpmp) {-# INLINE rule666 #-} rule666 = \ ((_hdIpmpr) :: PMP_R) ((_tlIpmpr) :: PMP_R) -> (Map.union _hdIpmpr _tlIpmpr) {-# INLINE rule667 #-} rule667 = \ ((_hdIps) :: PLabel) ((_tlIps) :: [PLabel]) -> _hdIps : _tlIps {-# INLINE rule668 #-} rule668 = \ ((_hdIrefHoNts) :: Set NontermIdent) ((_tlIrefHoNts) :: Set NontermIdent) -> _hdIrefHoNts `mappend` _tlIrefHoNts {-# INLINE rule669 #-} rule669 = \ ((_hdIrefNts) :: Set NontermIdent) ((_tlIrefNts) :: Set NontermIdent) -> _hdIrefNts `mappend` _tlIrefNts {-# INLINE rule670 #-} rule670 = \ ((_hdIruleMap) :: Map.Map MyOccurrence Identifier) ((_tlIruleMap) :: Map.Map MyOccurrence Identifier) -> (Map.union _hdIruleMap _tlIruleMap) {-# INLINE rule671 #-} rule671 = \ ((_hdIsfp) :: SF_P) ((_tlIsfp) :: SF_P) -> (Map.unionWith (Set.union) _hdIsfp _tlIsfp) {-# INLINE rule672 #-} rule672 = \ ((_hdIself) :: Production) ((_tlIself) :: Productions) -> (:) _hdIself _tlIself {-# INLINE rule673 #-} rule673 = \ _self -> _self {-# INLINE rule674 #-} rule674 = \ ((_tlIflab) :: Int) -> _tlIflab {-# INLINE rule675 #-} rule675 = \ ((_tlIolab) :: Int) -> _tlIolab {-# INLINE rule676 #-} rule676 = \ ((_tlIrulenumber) :: Int) -> _tlIrulenumber {-# INLINE rule677 #-} rule677 = \ ((_lhsIain) :: MyType -> MyAttributes) -> _lhsIain {-# INLINE rule678 #-} rule678 = \ ((_lhsIan) :: MyType -> MyAttributes) -> _lhsIan {-# INLINE rule679 #-} rule679 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Map Identifier [Expression])) -> _lhsIaroundMap {-# INLINE rule680 #-} rule680 = \ ((_lhsIasn) :: MyType -> MyAttributes) -> _lhsIasn {-# INLINE rule681 #-} rule681 = \ ((_lhsIaugM) :: Map.Map Identifier (Set.Set Dependency)) -> _lhsIaugM {-# INLINE rule682 #-} rule682 = \ ((_lhsIdty) :: MyType) -> _lhsIdty {-# INLINE rule683 #-} rule683 = \ ((_lhsIflab) :: Int) -> _lhsIflab {-# INLINE rule684 #-} rule684 = \ ((_lhsIfty) :: FTY) -> _lhsIfty {-# INLINE rule685 #-} rule685 = \ ((_lhsIftyf) :: FTY) -> _lhsIftyf {-# INLINE rule686 #-} rule686 = \ ((_lhsIhoMapf) :: HOMap) -> _lhsIhoMapf {-# INLINE rule687 #-} rule687 = \ ((_lhsIlfpf) :: SF_P) -> _lhsIlfpf {-# INLINE rule688 #-} rule688 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) -> _lhsImergeMap {-# INLINE rule689 #-} rule689 = \ ((_lhsImysegments) :: MySegments) -> _lhsImysegments {-# INLINE rule690 #-} rule690 = \ ((_lhsInmp) :: NMP) -> _lhsInmp {-# INLINE rule691 #-} rule691 = \ ((_lhsInmprf) :: NMP_R) -> _lhsInmprf {-# INLINE rule692 #-} rule692 = \ ((_lhsIolab) :: Int) -> _lhsIolab {-# INLINE rule693 #-} rule693 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule694 #-} rule694 = \ ((_lhsIpmpf) :: PMP) -> _lhsIpmpf {-# INLINE rule695 #-} rule695 = \ ((_lhsIpmprf) :: PMP_R) -> _lhsIpmprf {-# INLINE rule696 #-} rule696 = \ ((_lhsIres_ads) :: [Edge]) -> _lhsIres_ads {-# INLINE rule697 #-} rule697 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber {-# INLINE rule698 #-} rule698 = \ ((_lhsItdp) :: TDPRes) -> _lhsItdp {-# INLINE rule699 #-} rule699 = \ ((_lhsIvisMapf) :: IMap.IntMap Int) -> _lhsIvisMapf {-# INLINE rule700 #-} rule700 = \ ((_lhsIvisitnum) :: Int) -> _lhsIvisitnum {-# INLINE rule701 #-} rule701 = \ ((_lhsIain) :: MyType -> MyAttributes) -> _lhsIain {-# INLINE rule702 #-} rule702 = \ ((_lhsIan) :: MyType -> MyAttributes) -> _lhsIan {-# INLINE rule703 #-} rule703 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Map Identifier [Expression])) -> _lhsIaroundMap {-# INLINE rule704 #-} rule704 = \ ((_lhsIasn) :: MyType -> MyAttributes) -> _lhsIasn {-# INLINE rule705 #-} rule705 = \ ((_lhsIaugM) :: Map.Map Identifier (Set.Set Dependency)) -> _lhsIaugM {-# INLINE rule706 #-} rule706 = \ ((_lhsIdty) :: MyType) -> _lhsIdty {-# INLINE rule707 #-} rule707 = \ ((_hdIflab) :: Int) -> _hdIflab {-# INLINE rule708 #-} rule708 = \ ((_hdIfty) :: FTY) -> _hdIfty {-# INLINE rule709 #-} rule709 = \ ((_lhsIftyf) :: FTY) -> _lhsIftyf {-# INLINE rule710 #-} rule710 = \ ((_lhsIhoMapf) :: HOMap) -> _lhsIhoMapf {-# INLINE rule711 #-} rule711 = \ ((_lhsIlfpf) :: SF_P) -> _lhsIlfpf {-# INLINE rule712 #-} rule712 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) -> _lhsImergeMap {-# INLINE rule713 #-} rule713 = \ ((_lhsImysegments) :: MySegments) -> _lhsImysegments {-# INLINE rule714 #-} rule714 = \ ((_lhsInmp) :: NMP) -> _lhsInmp {-# INLINE rule715 #-} rule715 = \ ((_lhsInmprf) :: NMP_R) -> _lhsInmprf {-# INLINE rule716 #-} rule716 = \ ((_hdIolab) :: Int) -> _hdIolab {-# INLINE rule717 #-} rule717 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions {-# INLINE rule718 #-} rule718 = \ ((_lhsIpmpf) :: PMP) -> _lhsIpmpf {-# INLINE rule719 #-} rule719 = \ ((_lhsIpmprf) :: PMP_R) -> _lhsIpmprf {-# INLINE rule720 #-} rule720 = \ ((_lhsIres_ads) :: [Edge]) -> _lhsIres_ads {-# INLINE rule721 #-} rule721 = \ ((_hdIrulenumber) :: Int) -> _hdIrulenumber {-# INLINE rule722 #-} rule722 = \ ((_lhsItdp) :: TDPRes) -> _lhsItdp {-# INLINE rule723 #-} rule723 = \ ((_lhsIvisMapf) :: IMap.IntMap Int) -> _lhsIvisMapf {-# NOINLINE sem_Productions_Nil #-} sem_Productions_Nil :: T_Productions sem_Productions_Nil = T_Productions (return st86) where {-# NOINLINE st86 #-} st86 = let v85 :: T_Productions_v85 v85 = \ (T_Productions_vIn85 _lhsIain _lhsIan _lhsIaroundMap _lhsIasn _lhsIaugM _lhsIdty _lhsIflab _lhsIfty _lhsIftyf _lhsIhoMapf _lhsIlfpf _lhsImergeMap _lhsImysegments _lhsInmp _lhsInmprf _lhsIolab _lhsIoptions _lhsIpmpf _lhsIpmprf _lhsIres_ads _lhsIrulenumber _lhsItdp _lhsIvisMapf _lhsIvisitnum) -> ( let _lhsOads :: [Edge] _lhsOads = rule724 () _lhsOap :: A_P _lhsOap = rule725 () _lhsOeprods :: EProductions _lhsOeprods = rule726 () _lhsOfdps :: Map.Map ConstructorIdent (Set Dependency) _lhsOfdps = rule727 () _lhsOfieldMap :: FMap _lhsOfieldMap = rule728 () _lhsOfsInP :: FsInP _lhsOfsInP = rule729 () _lhsOfty :: FTY _lhsOfty = rule730 () _lhsOgen :: Map Int Int _lhsOgen = rule731 () _lhsOhoMap :: HOMap _lhsOhoMap = rule732 () _lhsOinss :: Map Int [Int] _lhsOinss = rule733 () _lhsOlfp :: SF_P _lhsOlfp = rule734 () _lhsOlfpr :: SF_P _lhsOlfpr = rule735 () _lhsOlocalSigMap :: Map.Map ConstructorIdent (Map.Map Identifier Type) _lhsOlocalSigMap = rule736 () _lhsOofld :: [(Int, Int)] _lhsOofld = rule737 () _lhsOpmp :: PMP _lhsOpmp = rule738 () _lhsOpmpr :: PMP_R _lhsOpmpr = rule739 () _lhsOps :: [PLabel] _lhsOps = rule740 () _lhsOrefHoNts :: Set NontermIdent _lhsOrefHoNts = rule741 () _lhsOrefNts :: Set NontermIdent _lhsOrefNts = rule742 () _lhsOruleMap :: Map.Map MyOccurrence Identifier _lhsOruleMap = rule743 () _lhsOsfp :: SF_P _lhsOsfp = rule744 () _self = rule745 () _lhsOself :: Productions _lhsOself = rule746 _self _lhsOflab :: Int _lhsOflab = rule747 _lhsIflab _lhsOolab :: Int _lhsOolab = rule748 _lhsIolab _lhsOrulenumber :: Int _lhsOrulenumber = rule749 _lhsIrulenumber _lhsOvisitnum :: Int _lhsOvisitnum = rule750 _lhsIvisitnum __result_ = T_Productions_vOut85 _lhsOads _lhsOap _lhsOeprods _lhsOfdps _lhsOfieldMap _lhsOflab _lhsOfsInP _lhsOfty _lhsOgen _lhsOhoMap _lhsOinss _lhsOlfp _lhsOlfpr _lhsOlocalSigMap _lhsOofld _lhsOolab _lhsOpmp _lhsOpmpr _lhsOps _lhsOrefHoNts _lhsOrefNts _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOvisitnum in __result_ ) in C_Productions_s86 v85 {-# INLINE rule724 #-} rule724 = \ (_ :: ()) -> [] {-# INLINE rule725 #-} rule725 = \ (_ :: ()) -> Map.empty {-# INLINE rule726 #-} rule726 = \ (_ :: ()) -> [] {-# INLINE rule727 #-} rule727 = \ (_ :: ()) -> Map.empty {-# INLINE rule728 #-} rule728 = \ (_ :: ()) -> Map.empty {-# INLINE rule729 #-} rule729 = \ (_ :: ()) -> Map.empty {-# INLINE rule730 #-} rule730 = \ (_ :: ()) -> Map.empty {-# INLINE rule731 #-} rule731 = \ (_ :: ()) -> Map.empty {-# INLINE rule732 #-} rule732 = \ (_ :: ()) -> Map.empty {-# INLINE rule733 #-} rule733 = \ (_ :: ()) -> Map.empty {-# INLINE rule734 #-} rule734 = \ (_ :: ()) -> Map.empty {-# INLINE rule735 #-} rule735 = \ (_ :: ()) -> Map.empty {-# INLINE rule736 #-} rule736 = \ (_ :: ()) -> Map.empty {-# INLINE rule737 #-} rule737 = \ (_ :: ()) -> [] {-# INLINE rule738 #-} rule738 = \ (_ :: ()) -> Map.empty {-# INLINE rule739 #-} rule739 = \ (_ :: ()) -> Map.empty {-# INLINE rule740 #-} rule740 = \ (_ :: ()) -> ([]) {-# INLINE rule741 #-} rule741 = \ (_ :: ()) -> mempty {-# INLINE rule742 #-} rule742 = \ (_ :: ()) -> mempty {-# INLINE rule743 #-} rule743 = \ (_ :: ()) -> Map.empty {-# INLINE rule744 #-} rule744 = \ (_ :: ()) -> Map.empty {-# INLINE rule745 #-} rule745 = \ (_ :: ()) -> [] {-# INLINE rule746 #-} rule746 = \ _self -> _self {-# INLINE rule747 #-} rule747 = \ ((_lhsIflab) :: Int) -> _lhsIflab {-# INLINE rule748 #-} rule748 = \ ((_lhsIolab) :: Int) -> _lhsIolab {-# INLINE rule749 #-} rule749 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber {-# INLINE rule750 #-} rule750 = \ ((_lhsIvisitnum) :: Int) -> _lhsIvisitnum -- Rule -------------------------------------------------------- -- wrapper data Inh_Rule = Inh_Rule { dty_Inh_Rule :: (MyType), lfpf_Inh_Rule :: (SF_P), pll_Inh_Rule :: (PLabel), pts_Inh_Rule :: (Set.Set (FLabel)), rulenumber_Inh_Rule :: (Int) } data Syn_Rule = Syn_Rule { erules_Syn_Rule :: (ERule), lfp_Syn_Rule :: (SF_P), lfpr_Syn_Rule :: (SF_P), ruleMap_Syn_Rule :: (Map.Map MyOccurrence Identifier), rulenumber_Syn_Rule :: (Int), self_Syn_Rule :: (Rule), sfp_Syn_Rule :: (SF_P), used_Syn_Rule :: (Set.Set MyOccurrence), usedLocals_Syn_Rule :: (Set.Set MyOccurrence) } {-# INLINABLE wrap_Rule #-} wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule ) wrap_Rule (T_Rule act) (Inh_Rule _lhsIdty _lhsIlfpf _lhsIpll _lhsIpts _lhsIrulenumber) = Control.Monad.Identity.runIdentity ( do sem <- act let arg88 = T_Rule_vIn88 _lhsIdty _lhsIlfpf _lhsIpll _lhsIpts _lhsIrulenumber (T_Rule_vOut88 _lhsOerules _lhsOlfp _lhsOlfpr _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOused _lhsOusedLocals) <- return (inv_Rule_s89 sem arg88) return (Syn_Rule _lhsOerules _lhsOlfp _lhsOlfpr _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOused _lhsOusedLocals) ) -- cata {-# INLINE sem_Rule #-} sem_Rule :: Rule -> T_Rule sem_Rule ( Rule mbName_ pattern_ rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ -- semantic domain newtype T_Rule = T_Rule { attach_T_Rule :: Identity (T_Rule_s89 ) } newtype T_Rule_s89 = C_Rule_s89 { inv_Rule_s89 :: (T_Rule_v88 ) } data T_Rule_s90 = C_Rule_s90 type T_Rule_v88 = (T_Rule_vIn88 ) -> (T_Rule_vOut88 ) data T_Rule_vIn88 = T_Rule_vIn88 (MyType) (SF_P) (PLabel) (Set.Set (FLabel)) (Int) data T_Rule_vOut88 = T_Rule_vOut88 (ERule) (SF_P) (SF_P) (Map.Map MyOccurrence Identifier) (Int) (Rule) (SF_P) (Set.Set MyOccurrence) (Set.Set MyOccurrence) {-# NOINLINE sem_Rule_Rule #-} sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule sem_Rule_Rule arg_mbName_ arg_pattern_ arg_rhs_ arg_owrt_ arg_origin_ arg_explicit_ arg_pure_ arg_identity_ arg_mbError_ arg_eager_ = T_Rule (return st89) where {-# NOINLINE st89 #-} st89 = let v88 :: T_Rule_v88 v88 = \ (T_Rule_vIn88 _lhsIdty _lhsIlfpf _lhsIpll _lhsIpts _lhsIrulenumber) -> ( let _patternX77 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) _rhsX41 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) (T_Pattern_vOut76 _patternIafs _patternIcopy _patternIself) = inv_Pattern_s77 _patternX77 (T_Pattern_vIn76 ) (T_Expression_vOut40 _rhsIcopy _rhsIself _rhsIused) = inv_Expression_s41 _rhsX41 (T_Expression_vIn40 _rhsOpll _rhsOpts) _lhsOerules :: ERule _lhsOerules = rule751 _patternIcopy _rhsIcopy _rulename arg_explicit_ arg_mbError_ arg_origin_ arg_owrt_ arg_pure_ _lhsOrulenumber :: Int _lhsOrulenumber = rule752 _lhsIrulenumber _rulename = rule753 _lhsIrulenumber arg_mbName_ _usedLocals = rule754 _rhsIused _usesLocals = rule755 _usedLocals _lhsOsfp :: SF_P _lhsOruleMap :: Map.Map MyOccurrence Identifier _lhsOlfp :: SF_P _lhsOlfpr :: SF_P (_lhsOsfp,_lhsOruleMap,_lhsOlfp,_lhsOlfpr) = rule756 _lhsIlfpf _lhsIpll _patternIafs _rhsIused _rulename _usedLocals _usesLocals _lhsOused :: Set.Set MyOccurrence _lhsOused = rule757 _rhsIused _lhsOusedLocals :: Set.Set MyOccurrence _lhsOusedLocals = rule758 _usedLocals _self = rule759 _patternIself _rhsIself arg_eager_ arg_explicit_ arg_identity_ arg_mbError_ arg_mbName_ arg_origin_ arg_owrt_ arg_pure_ _lhsOself :: Rule _lhsOself = rule760 _self _rhsOpll = rule761 _lhsIpll _rhsOpts = rule762 _lhsIpts __result_ = T_Rule_vOut88 _lhsOerules _lhsOlfp _lhsOlfpr _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOused _lhsOusedLocals in __result_ ) in C_Rule_s89 v88 {-# INLINE rule751 #-} {-# LINE 65 "src-ag/ExecutionPlanCommon.ag" #-} rule751 = \ ((_patternIcopy) :: Pattern) ((_rhsIcopy) :: Expression) _rulename explicit_ mbError_ origin_ owrt_ pure_ -> {-# LINE 65 "src-ag/ExecutionPlanCommon.ag" #-} ERule _rulename _patternIcopy _rhsIcopy owrt_ origin_ explicit_ pure_ mbError_ {-# LINE 5776 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule752 #-} {-# LINE 12 "src-ag/ExecutionPlanPre.ag" #-} rule752 = \ ((_lhsIrulenumber) :: Int) -> {-# LINE 12 "src-ag/ExecutionPlanPre.ag" #-} _lhsIrulenumber + 1 {-# LINE 5782 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule753 #-} {-# LINE 13 "src-ag/ExecutionPlanPre.ag" #-} rule753 = \ ((_lhsIrulenumber) :: Int) mbName_ -> {-# LINE 13 "src-ag/ExecutionPlanPre.ag" #-} maybe (identifier $ "rule" ++ show _lhsIrulenumber) id mbName_ {-# LINE 5788 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule754 #-} {-# LINE 230 "src-ag/LOAG/Prepare.ag" #-} rule754 = \ ((_rhsIused) :: Set.Set MyOccurrence) -> {-# LINE 230 "src-ag/LOAG/Prepare.ag" #-} Set.filter (\(MyOccurrence (_,f) _) -> f == "loc") _rhsIused {-# LINE 5794 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule755 #-} {-# LINE 231 "src-ag/LOAG/Prepare.ag" #-} rule755 = \ _usedLocals -> {-# LINE 231 "src-ag/LOAG/Prepare.ag" #-} not $ Set.null _usedLocals {-# LINE 5800 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule756 #-} {-# LINE 233 "src-ag/LOAG/Prepare.ag" #-} rule756 = \ ((_lhsIlfpf) :: SF_P) ((_lhsIpll) :: PLabel) ((_patternIafs) :: [(FLabel, ALabel, Bool)]) ((_rhsIused) :: Set.Set MyOccurrence) _rulename _usedLocals _usesLocals -> {-# LINE 233 "src-ag/LOAG/Prepare.ag" #-} foldr (\(f, a, b) (m',rm', l', lr') -> let att = (_lhsIpll, f) >.< a rm = Map.insert att _rulename rm' l = if _usesLocals && not b then Map.insert att _usedLocals l' else l' lr = if _usesLocals && not b then Set.fold (\k m -> Map.insertWith (Set.union) k (Set.singleton att) m) lr' _usedLocals else lr' sfpins = Map.insert att (_rhsIused `Set.union` fromHO) m' fromHO = maybe Set.empty id (Map.lookup hOcc _lhsIlfpf) where hOcc = (_lhsIpll, "inst") >.< (f, AnyDir) in if b then (m',rm, Map.insert att _rhsIused l, Set.fold (\k m -> Map.insertWith (Set.union) k (Set.singleton att) m) lr _rhsIused) else (sfpins,rm,l,lr)) (Map.empty,Map.empty,Map.empty,Map.empty) _patternIafs {-# LINE 5824 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule757 #-} rule757 = \ ((_rhsIused) :: Set.Set MyOccurrence) -> _rhsIused {-# INLINE rule758 #-} rule758 = \ _usedLocals -> _usedLocals {-# INLINE rule759 #-} rule759 = \ ((_patternIself) :: Pattern) ((_rhsIself) :: Expression) eager_ explicit_ identity_ mbError_ mbName_ origin_ owrt_ pure_ -> Rule mbName_ _patternIself _rhsIself owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ {-# INLINE rule760 #-} rule760 = \ _self -> _self {-# INLINE rule761 #-} rule761 = \ ((_lhsIpll) :: PLabel) -> _lhsIpll {-# INLINE rule762 #-} rule762 = \ ((_lhsIpts) :: Set.Set (FLabel)) -> _lhsIpts -- Rules ------------------------------------------------------- -- wrapper data Inh_Rules = Inh_Rules { dty_Inh_Rules :: (MyType), lfpf_Inh_Rules :: (SF_P), pll_Inh_Rules :: (PLabel), pts_Inh_Rules :: (Set.Set (FLabel)), rulenumber_Inh_Rules :: (Int) } data Syn_Rules = Syn_Rules { erules_Syn_Rules :: (ERules), lfp_Syn_Rules :: (SF_P), lfpr_Syn_Rules :: (SF_P), ruleMap_Syn_Rules :: (Map.Map MyOccurrence Identifier), rulenumber_Syn_Rules :: (Int), self_Syn_Rules :: (Rules), sfp_Syn_Rules :: (SF_P), usedLocals_Syn_Rules :: (Set.Set MyOccurrence) } {-# INLINABLE wrap_Rules #-} wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules ) wrap_Rules (T_Rules act) (Inh_Rules _lhsIdty _lhsIlfpf _lhsIpll _lhsIpts _lhsIrulenumber) = Control.Monad.Identity.runIdentity ( do sem <- act let arg91 = T_Rules_vIn91 _lhsIdty _lhsIlfpf _lhsIpll _lhsIpts _lhsIrulenumber (T_Rules_vOut91 _lhsOerules _lhsOlfp _lhsOlfpr _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOusedLocals) <- return (inv_Rules_s92 sem arg91) return (Syn_Rules _lhsOerules _lhsOlfp _lhsOlfpr _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOusedLocals) ) -- cata {-# NOINLINE sem_Rules #-} sem_Rules :: Rules -> T_Rules sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) -- semantic domain newtype T_Rules = T_Rules { attach_T_Rules :: Identity (T_Rules_s92 ) } newtype T_Rules_s92 = C_Rules_s92 { inv_Rules_s92 :: (T_Rules_v91 ) } data T_Rules_s93 = C_Rules_s93 type T_Rules_v91 = (T_Rules_vIn91 ) -> (T_Rules_vOut91 ) data T_Rules_vIn91 = T_Rules_vIn91 (MyType) (SF_P) (PLabel) (Set.Set (FLabel)) (Int) data T_Rules_vOut91 = T_Rules_vOut91 (ERules) (SF_P) (SF_P) (Map.Map MyOccurrence Identifier) (Int) (Rules) (SF_P) (Set.Set MyOccurrence) {-# NOINLINE sem_Rules_Cons #-} sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st92) where {-# NOINLINE st92 #-} st92 = let v91 :: T_Rules_v91 v91 = \ (T_Rules_vIn91 _lhsIdty _lhsIlfpf _lhsIpll _lhsIpts _lhsIrulenumber) -> ( let _hdX89 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) _tlX92 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) (T_Rule_vOut88 _hdIerules _hdIlfp _hdIlfpr _hdIruleMap _hdIrulenumber _hdIself _hdIsfp _hdIused _hdIusedLocals) = inv_Rule_s89 _hdX89 (T_Rule_vIn88 _hdOdty _hdOlfpf _hdOpll _hdOpts _hdOrulenumber) (T_Rules_vOut91 _tlIerules _tlIlfp _tlIlfpr _tlIruleMap _tlIrulenumber _tlIself _tlIsfp _tlIusedLocals) = inv_Rules_s92 _tlX92 (T_Rules_vIn91 _tlOdty _tlOlfpf _tlOpll _tlOpts _tlOrulenumber) _lhsOerules :: ERules _lhsOerules = rule763 _hdIerules _tlIerules _lhsOlfp :: SF_P _lhsOlfp = rule764 _hdIlfp _tlIlfp _lhsOlfpr :: SF_P _lhsOlfpr = rule765 _hdIlfpr _tlIlfpr _lhsOruleMap :: Map.Map MyOccurrence Identifier _lhsOruleMap = rule766 _hdIruleMap _tlIruleMap _lhsOsfp :: SF_P _lhsOsfp = rule767 _hdIsfp _tlIsfp _lhsOusedLocals :: Set.Set MyOccurrence _lhsOusedLocals = rule768 _hdIusedLocals _tlIusedLocals _self = rule769 _hdIself _tlIself _lhsOself :: Rules _lhsOself = rule770 _self _lhsOrulenumber :: Int _lhsOrulenumber = rule771 _tlIrulenumber _hdOdty = rule772 _lhsIdty _hdOlfpf = rule773 _lhsIlfpf _hdOpll = rule774 _lhsIpll _hdOpts = rule775 _lhsIpts _hdOrulenumber = rule776 _lhsIrulenumber _tlOdty = rule777 _lhsIdty _tlOlfpf = rule778 _lhsIlfpf _tlOpll = rule779 _lhsIpll _tlOpts = rule780 _lhsIpts _tlOrulenumber = rule781 _hdIrulenumber __result_ = T_Rules_vOut91 _lhsOerules _lhsOlfp _lhsOlfpr _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOusedLocals in __result_ ) in C_Rules_s92 v91 {-# INLINE rule763 #-} rule763 = \ ((_hdIerules) :: ERule) ((_tlIerules) :: ERules) -> _hdIerules : _tlIerules {-# INLINE rule764 #-} rule764 = \ ((_hdIlfp) :: SF_P) ((_tlIlfp) :: SF_P) -> (Map.unionWith (Set.union) _hdIlfp _tlIlfp) {-# INLINE rule765 #-} rule765 = \ ((_hdIlfpr) :: SF_P) ((_tlIlfpr) :: SF_P) -> (Map.unionWith (Set.union) _hdIlfpr _tlIlfpr) {-# INLINE rule766 #-} rule766 = \ ((_hdIruleMap) :: Map.Map MyOccurrence Identifier) ((_tlIruleMap) :: Map.Map MyOccurrence Identifier) -> (Map.union _hdIruleMap _tlIruleMap) {-# INLINE rule767 #-} rule767 = \ ((_hdIsfp) :: SF_P) ((_tlIsfp) :: SF_P) -> (Map.unionWith (Set.union) _hdIsfp _tlIsfp) {-# INLINE rule768 #-} rule768 = \ ((_hdIusedLocals) :: Set.Set MyOccurrence) ((_tlIusedLocals) :: Set.Set MyOccurrence) -> ((Set.union) _hdIusedLocals _tlIusedLocals) {-# INLINE rule769 #-} rule769 = \ ((_hdIself) :: Rule) ((_tlIself) :: Rules) -> (:) _hdIself _tlIself {-# INLINE rule770 #-} rule770 = \ _self -> _self {-# INLINE rule771 #-} rule771 = \ ((_tlIrulenumber) :: Int) -> _tlIrulenumber {-# INLINE rule772 #-} rule772 = \ ((_lhsIdty) :: MyType) -> _lhsIdty {-# INLINE rule773 #-} rule773 = \ ((_lhsIlfpf) :: SF_P) -> _lhsIlfpf {-# INLINE rule774 #-} rule774 = \ ((_lhsIpll) :: PLabel) -> _lhsIpll {-# INLINE rule775 #-} rule775 = \ ((_lhsIpts) :: Set.Set (FLabel)) -> _lhsIpts {-# INLINE rule776 #-} rule776 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber {-# INLINE rule777 #-} rule777 = \ ((_lhsIdty) :: MyType) -> _lhsIdty {-# INLINE rule778 #-} rule778 = \ ((_lhsIlfpf) :: SF_P) -> _lhsIlfpf {-# INLINE rule779 #-} rule779 = \ ((_lhsIpll) :: PLabel) -> _lhsIpll {-# INLINE rule780 #-} rule780 = \ ((_lhsIpts) :: Set.Set (FLabel)) -> _lhsIpts {-# INLINE rule781 #-} rule781 = \ ((_hdIrulenumber) :: Int) -> _hdIrulenumber {-# NOINLINE sem_Rules_Nil #-} sem_Rules_Nil :: T_Rules sem_Rules_Nil = T_Rules (return st92) where {-# NOINLINE st92 #-} st92 = let v91 :: T_Rules_v91 v91 = \ (T_Rules_vIn91 _lhsIdty _lhsIlfpf _lhsIpll _lhsIpts _lhsIrulenumber) -> ( let _lhsOerules :: ERules _lhsOerules = rule782 () _lhsOlfp :: SF_P _lhsOlfp = rule783 () _lhsOlfpr :: SF_P _lhsOlfpr = rule784 () _lhsOruleMap :: Map.Map MyOccurrence Identifier _lhsOruleMap = rule785 () _lhsOsfp :: SF_P _lhsOsfp = rule786 () _lhsOusedLocals :: Set.Set MyOccurrence _lhsOusedLocals = rule787 () _self = rule788 () _lhsOself :: Rules _lhsOself = rule789 _self _lhsOrulenumber :: Int _lhsOrulenumber = rule790 _lhsIrulenumber __result_ = T_Rules_vOut91 _lhsOerules _lhsOlfp _lhsOlfpr _lhsOruleMap _lhsOrulenumber _lhsOself _lhsOsfp _lhsOusedLocals in __result_ ) in C_Rules_s92 v91 {-# INLINE rule782 #-} rule782 = \ (_ :: ()) -> [] {-# INLINE rule783 #-} rule783 = \ (_ :: ()) -> Map.empty {-# INLINE rule784 #-} rule784 = \ (_ :: ()) -> Map.empty {-# INLINE rule785 #-} rule785 = \ (_ :: ()) -> Map.empty {-# INLINE rule786 #-} rule786 = \ (_ :: ()) -> Map.empty {-# INLINE rule787 #-} rule787 = \ (_ :: ()) -> Set.empty {-# INLINE rule788 #-} rule788 = \ (_ :: ()) -> [] {-# INLINE rule789 #-} rule789 = \ _self -> _self {-# INLINE rule790 #-} rule790 = \ ((_lhsIrulenumber) :: Int) -> _lhsIrulenumber -- Sequence ---------------------------------------------------- -- wrapper data Inh_Sequence = Inh_Sequence { } data Syn_Sequence = Syn_Sequence { self_Syn_Sequence :: (Sequence) } {-# INLINABLE wrap_Sequence #-} wrap_Sequence :: T_Sequence -> Inh_Sequence -> (Syn_Sequence ) wrap_Sequence (T_Sequence act) (Inh_Sequence ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg94 = T_Sequence_vIn94 (T_Sequence_vOut94 _lhsOself) <- return (inv_Sequence_s95 sem arg94) return (Syn_Sequence _lhsOself) ) -- cata {-# NOINLINE sem_Sequence #-} sem_Sequence :: Sequence -> T_Sequence sem_Sequence list = Prelude.foldr sem_Sequence_Cons sem_Sequence_Nil (Prelude.map sem_CRule list) -- semantic domain newtype T_Sequence = T_Sequence { attach_T_Sequence :: Identity (T_Sequence_s95 ) } newtype T_Sequence_s95 = C_Sequence_s95 { inv_Sequence_s95 :: (T_Sequence_v94 ) } data T_Sequence_s96 = C_Sequence_s96 type T_Sequence_v94 = (T_Sequence_vIn94 ) -> (T_Sequence_vOut94 ) data T_Sequence_vIn94 = T_Sequence_vIn94 data T_Sequence_vOut94 = T_Sequence_vOut94 (Sequence) {-# NOINLINE sem_Sequence_Cons #-} sem_Sequence_Cons :: T_CRule -> T_Sequence -> T_Sequence sem_Sequence_Cons arg_hd_ arg_tl_ = T_Sequence (return st95) where {-# NOINLINE st95 #-} st95 = let v94 :: T_Sequence_v94 v94 = \ (T_Sequence_vIn94 ) -> ( let _hdX20 = Control.Monad.Identity.runIdentity (attach_T_CRule (arg_hd_)) _tlX95 = Control.Monad.Identity.runIdentity (attach_T_Sequence (arg_tl_)) (T_CRule_vOut19 _hdIself) = inv_CRule_s20 _hdX20 (T_CRule_vIn19 ) (T_Sequence_vOut94 _tlIself) = inv_Sequence_s95 _tlX95 (T_Sequence_vIn94 ) _self = rule791 _hdIself _tlIself _lhsOself :: Sequence _lhsOself = rule792 _self __result_ = T_Sequence_vOut94 _lhsOself in __result_ ) in C_Sequence_s95 v94 {-# INLINE rule791 #-} rule791 = \ ((_hdIself) :: CRule) ((_tlIself) :: Sequence) -> (:) _hdIself _tlIself {-# INLINE rule792 #-} rule792 = \ _self -> _self {-# NOINLINE sem_Sequence_Nil #-} sem_Sequence_Nil :: T_Sequence sem_Sequence_Nil = T_Sequence (return st95) where {-# NOINLINE st95 #-} st95 = let v94 :: T_Sequence_v94 v94 = \ (T_Sequence_vIn94 ) -> ( let _self = rule793 () _lhsOself :: Sequence _lhsOself = rule794 _self __result_ = T_Sequence_vOut94 _lhsOself in __result_ ) in C_Sequence_s95 v94 {-# INLINE rule793 #-} rule793 = \ (_ :: ()) -> [] {-# INLINE rule794 #-} rule794 = \ _self -> _self -- TypeSig ----------------------------------------------------- -- wrapper data Inh_TypeSig = Inh_TypeSig { } data Syn_TypeSig = Syn_TypeSig { localSigMap_Syn_TypeSig :: (Map Identifier Type), self_Syn_TypeSig :: (TypeSig) } {-# INLINABLE wrap_TypeSig #-} wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig ) wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg97 = T_TypeSig_vIn97 (T_TypeSig_vOut97 _lhsOlocalSigMap _lhsOself) <- return (inv_TypeSig_s98 sem arg97) return (Syn_TypeSig _lhsOlocalSigMap _lhsOself) ) -- cata {-# INLINE sem_TypeSig #-} sem_TypeSig :: TypeSig -> T_TypeSig sem_TypeSig ( TypeSig name_ tp_ ) = sem_TypeSig_TypeSig name_ tp_ -- semantic domain newtype T_TypeSig = T_TypeSig { attach_T_TypeSig :: Identity (T_TypeSig_s98 ) } newtype T_TypeSig_s98 = C_TypeSig_s98 { inv_TypeSig_s98 :: (T_TypeSig_v97 ) } data T_TypeSig_s99 = C_TypeSig_s99 type T_TypeSig_v97 = (T_TypeSig_vIn97 ) -> (T_TypeSig_vOut97 ) data T_TypeSig_vIn97 = T_TypeSig_vIn97 data T_TypeSig_vOut97 = T_TypeSig_vOut97 (Map Identifier Type) (TypeSig) {-# NOINLINE sem_TypeSig_TypeSig #-} sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig sem_TypeSig_TypeSig arg_name_ arg_tp_ = T_TypeSig (return st98) where {-# NOINLINE st98 #-} st98 = let v97 :: T_TypeSig_v97 v97 = \ (T_TypeSig_vIn97 ) -> ( let _lhsOlocalSigMap :: Map Identifier Type _lhsOlocalSigMap = rule795 arg_name_ arg_tp_ _self = rule796 arg_name_ arg_tp_ _lhsOself :: TypeSig _lhsOself = rule797 _self __result_ = T_TypeSig_vOut97 _lhsOlocalSigMap _lhsOself in __result_ ) in C_TypeSig_s98 v97 {-# INLINE rule795 #-} {-# LINE 161 "src-ag/ExecutionPlanCommon.ag" #-} rule795 = \ name_ tp_ -> {-# LINE 161 "src-ag/ExecutionPlanCommon.ag" #-} Map.singleton name_ tp_ {-# LINE 6150 "dist/build/LOAG/Order.hs"#-} {-# INLINE rule796 #-} rule796 = \ name_ tp_ -> TypeSig name_ tp_ {-# INLINE rule797 #-} rule797 = \ _self -> _self -- TypeSigs ---------------------------------------------------- -- wrapper data Inh_TypeSigs = Inh_TypeSigs { } data Syn_TypeSigs = Syn_TypeSigs { localSigMap_Syn_TypeSigs :: (Map Identifier Type), self_Syn_TypeSigs :: (TypeSigs) } {-# INLINABLE wrap_TypeSigs #-} wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs ) wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) = Control.Monad.Identity.runIdentity ( do sem <- act let arg100 = T_TypeSigs_vIn100 (T_TypeSigs_vOut100 _lhsOlocalSigMap _lhsOself) <- return (inv_TypeSigs_s101 sem arg100) return (Syn_TypeSigs _lhsOlocalSigMap _lhsOself) ) -- cata {-# NOINLINE sem_TypeSigs #-} sem_TypeSigs :: TypeSigs -> T_TypeSigs sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) -- semantic domain newtype T_TypeSigs = T_TypeSigs { attach_T_TypeSigs :: Identity (T_TypeSigs_s101 ) } newtype T_TypeSigs_s101 = C_TypeSigs_s101 { inv_TypeSigs_s101 :: (T_TypeSigs_v100 ) } data T_TypeSigs_s102 = C_TypeSigs_s102 type T_TypeSigs_v100 = (T_TypeSigs_vIn100 ) -> (T_TypeSigs_vOut100 ) data T_TypeSigs_vIn100 = T_TypeSigs_vIn100 data T_TypeSigs_vOut100 = T_TypeSigs_vOut100 (Map Identifier Type) (TypeSigs) {-# NOINLINE sem_TypeSigs_Cons #-} sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st101) where {-# NOINLINE st101 #-} st101 = let v100 :: T_TypeSigs_v100 v100 = \ (T_TypeSigs_vIn100 ) -> ( let _hdX98 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_)) _tlX101 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_)) (T_TypeSig_vOut97 _hdIlocalSigMap _hdIself) = inv_TypeSig_s98 _hdX98 (T_TypeSig_vIn97 ) (T_TypeSigs_vOut100 _tlIlocalSigMap _tlIself) = inv_TypeSigs_s101 _tlX101 (T_TypeSigs_vIn100 ) _lhsOlocalSigMap :: Map Identifier Type _lhsOlocalSigMap = rule798 _hdIlocalSigMap _tlIlocalSigMap _self = rule799 _hdIself _tlIself _lhsOself :: TypeSigs _lhsOself = rule800 _self __result_ = T_TypeSigs_vOut100 _lhsOlocalSigMap _lhsOself in __result_ ) in C_TypeSigs_s101 v100 {-# INLINE rule798 #-} rule798 = \ ((_hdIlocalSigMap) :: Map Identifier Type) ((_tlIlocalSigMap) :: Map Identifier Type) -> _hdIlocalSigMap `Map.union` _tlIlocalSigMap {-# INLINE rule799 #-} rule799 = \ ((_hdIself) :: TypeSig) ((_tlIself) :: TypeSigs) -> (:) _hdIself _tlIself {-# INLINE rule800 #-} rule800 = \ _self -> _self {-# NOINLINE sem_TypeSigs_Nil #-} sem_TypeSigs_Nil :: T_TypeSigs sem_TypeSigs_Nil = T_TypeSigs (return st101) where {-# NOINLINE st101 #-} st101 = let v100 :: T_TypeSigs_v100 v100 = \ (T_TypeSigs_vIn100 ) -> ( let _lhsOlocalSigMap :: Map Identifier Type _lhsOlocalSigMap = rule801 () _self = rule802 () _lhsOself :: TypeSigs _lhsOself = rule803 _self __result_ = T_TypeSigs_vOut100 _lhsOlocalSigMap _lhsOself in __result_ ) in C_TypeSigs_s101 v100 {-# INLINE rule801 #-} rule801 = \ (_ :: ()) -> Map.empty {-# INLINE rule802 #-} rule802 = \ (_ :: ()) -> [] {-# INLINE rule803 #-} rule803 = \ _self -> _self uuagc-0.9.52.2/src-ag/0000755000000000000000000000000013433540502012414 5ustar0000000000000000uuagc-0.9.52.2/src-ag/ExecutionPlanCommon.ag0000644000000000000000000001650513433540502016663 0ustar0000000000000000------------------------------------------------------------------------------- -- Distributing options ------------------------------------------------------------------------------- ATTR Grammar Nonterminals Nonterminal Productions Production Children Child [ options : {Options} | | ] ------------------------------------------------------------------------------- -- Find out which nonterminals are recursive ------------------------------------------------------------------------------- ATTR Nonterminals Nonterminal [ | | ntDeps, ntHoDeps USE {`mappend`} {mempty} : {Map NontermIdent (Set NontermIdent)} ] ATTR Nonterminals Nonterminal [ closedNtDeps, closedHoNtDeps, closedHoNtRevDeps : {Map NontermIdent (Set NontermIdent)} | | ] ATTR Productions Production Children Child [ | | refNts, refHoNts USE {`mappend`} {mempty} : {Set NontermIdent} ] SEM Nonterminal | Nonterminal lhs.ntDeps = Map.singleton @nt @prods.refNts lhs.ntHoDeps = Map.singleton @nt @prods.refHoNts loc.closedNtDeps = Map.findWithDefault Set.empty @nt @lhs.closedNtDeps loc.closedHoNtDeps = Map.findWithDefault Set.empty @nt @lhs.closedHoNtDeps loc.closedHoNtRevDeps = Map.findWithDefault Set.empty @nt @lhs.closedHoNtRevDeps loc.recursive = @nt `Set.member` @loc.closedNtDeps loc.nontrivAcyc = @nt `Set.member` @loc.closedHoNtDeps loc.hoInfo = HigherOrderInfo { hoNtDeps = @loc.closedHoNtDeps , hoNtRevDeps = @loc.closedHoNtRevDeps , hoAcyclic = @loc.nontrivAcyc } SEM Child | Child loc.refNts = case @tp of NT nt _ _ -> Set.singleton nt _ -> mempty loc.refHoNts = if @loc.isHigherOrder then @loc.refNts else mempty loc.isHigherOrder = case @kind of ChildSyntax -> False _ -> True SEM Grammar | Grammar loc.closedNtDeps = closeMap @nonts.ntDeps loc.closedHoNtDeps = closeMap @nonts.ntHoDeps loc.closedHoNtRevDeps = revDeps @loc.closedHoNtDeps ------------------------------------------------------------------------------- -- Distribute the ContextMap to nonterminals ------------------------------------------------------------------------------- ATTR Nonterminals Nonterminal [ classContexts : ContextMap | | ] SEM Grammar | Grammar nonts.classContexts = @contextMap SEM Nonterminal | Nonterminal loc.classContexts = Map.findWithDefault [] @nt @lhs.classContexts ------------------------------------------------------------------------------- -- Gather all rules per production for the execution plan ------------------------------------------------------------------------------- ATTR Expression [ | | copy : SELF ] ATTR Rule [ | | erules : ERule ] ATTR Rules [ | | erules USE {:} {[]} : ERules ] SEM Rule | Rule lhs.erules = ERule @loc.rulename @pattern.copy @rhs.copy @owrt @origin @explicit @pure @mbError ------------------------------------------------------------------------------- -- Determine which children have an around-rule ------------------------------------------------------------------------------- -- Propagate the around-map downward ATTR Nonterminals Nonterminal [ aroundMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} || ] ATTR Productions Production [ aroundMap : {Map ConstructorIdent (Map Identifier [Expression])} || ] ATTR Children Child [ aroundMap : {Map Identifier [Expression]} | | ] SEM Nonterminal | Nonterminal loc.aroundMap = Map.findWithDefault Map.empty @nt @lhs.aroundMap SEM Production | Production loc.aroundMap = Map.findWithDefault Map.empty @con @lhs.aroundMap SEM Grammar | Grammar nonts.aroundMap = @aroundsMap SEM Child | Child loc.hasArounds = case Map.lookup @name @lhs.aroundMap of Nothing -> False Just as -> not (null as) ------------------------------------------------------------------------------- -- Determine which children are used by merges ------------------------------------------------------------------------------- -- Propagate the around-map downward ATTR Nonterminals Nonterminal [ mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} || ] ATTR Productions Production [ mergeMap : {Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))} || ] ATTR Children Child [ mergeMap : {Map Identifier (Identifier, [Identifier], Expression)} mergedChildren : {Set Identifier} | | ] SEM Nonterminal | Nonterminal loc.mergeMap = Map.findWithDefault Map.empty @nt @lhs.mergeMap SEM Production | Production loc.mergeMap = Map.findWithDefault Map.empty @con @lhs.mergeMap SEM Grammar | Grammar nonts.mergeMap = @mergeMap SEM Production | Production loc.mergedChildren = Set.unions [ Set.fromList ms | (_,ms,_) <- Map.elems @loc.mergeMap ] SEM Child | Child loc.merges = maybe Nothing (\(_,ms,_) -> Just ms) $ Map.lookup @name @lhs.mergeMap loc.isMerged = @name `Set.member` @lhs.mergedChildren ------------------------------------------------------------------------------- -- Gather all childs per production for the execution plan ------------------------------------------------------------------------------- ATTR Child [ | | echilds : EChild ] ATTR Children [ | | echilds USE {:} {[]} : EChildren ] SEM Child | Child lhs.echilds = case @tp of NT _ _ _ -> EChild @name @tp @kind @loc.hasArounds @loc.merges @loc.isMerged _ -> ETerm @name @tp ------------------------------------------------------------------------------- -- Output nonterminal type mappings ------------------------------------------------------------------------------- ATTR Grammar Nonterminals [ | | inhmap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent Attributes} synmap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent Attributes} ] ATTR Nonterminal [ | | inhmap : {Map.Map NontermIdent Attributes} synmap : {Map.Map NontermIdent Attributes} ] SEM Nonterminal | Nonterminal lhs.inhmap = Map.singleton @nt @inh lhs.synmap = Map.singleton @nt @syn ------------------------------------------------------------------------------- -- Output nonterminal type mappings ------------------------------------------------------------------------------- ATTR Grammar Nonterminals Nonterminal [ | | localSigMap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))} ] ATTR Productions Production [ | | localSigMap USE {`Map.union`} {Map.empty} : {Map.Map ConstructorIdent (Map.Map Identifier Type)} ] ATTR TypeSigs TypeSig [ | | localSigMap USE {`Map.union`} {Map.empty} : {Map Identifier Type} ] SEM Nonterminal | Nonterminal lhs.localSigMap = Map.singleton @nt @prods.localSigMap SEM Production | Production lhs.localSigMap = Map.singleton @con @typeSigs.localSigMap SEM TypeSig | TypeSig lhs.localSigMap = Map.singleton @name @tp uuagc-0.9.52.2/src-ag/DistChildAttr.ag0000644000000000000000000000213213433540502015425 0ustar0000000000000000------------------------------------------------------------------------------- -- Map of all inherited and synthesized attributes per nonterminal ------------------------------------------------------------------------------- ATTR Nonterminals Nonterminal [ || inhMap', synMap' USE {`Map.union`} {Map.empty} : {Map Identifier Attributes} ] SEM Nonterminal | Nonterminal lhs.inhMap' = Map.singleton @nt @inh lhs.synMap' = Map.singleton @nt @syn ATTR Nonterminals Nonterminal Productions Production Children Child [ inhMap, synMap : {Map Identifier Attributes} | | ] SEM Grammar | Grammar nonts.inhMap = @nonts.inhMap' nonts.synMap = @nonts.synMap' SEM Child | Child loc.chnt = case @tp of NT nt _ _ -> nt Self -> error ("The type of child " ++ show @name ++ " should not be a Self type.") Haskell t -> identifier "" -- should be ignored because the child is a terminal loc.inh = Map.findWithDefault Map.empty @loc.chnt @lhs.inhMap loc.syn = Map.findWithDefault Map.empty @loc.chnt @lhs.synMap uuagc-0.9.52.2/src-ag/ExecutionPlanPre.ag0000644000000000000000000000075613433540502016162 0ustar0000000000000000------------------------------------------------------------------------------- -- Give unique names to rules ------------------------------------------------------------------------------- ATTR Nonterminal Nonterminals Production Productions Rule Rules [ | rulenumber : Int | ] SEM Grammar | Grammar nonts.rulenumber = 0 SEM Rule | Rule lhs.rulenumber = @lhs.rulenumber + 1 loc.rulename = maybe (identifier $ "rule" ++ show @lhs.rulenumber) id @mbName uuagc-0.9.52.2/src-ag/LOAG/0000755000000000000000000000000013433540502013136 5ustar0000000000000000uuagc-0.9.52.2/src-ag/LOAG/Prepare.ag0000644000000000000000000003021313433540502015044 0ustar0000000000000000INCLUDE "AbstractSyntax.ag" INCLUDE "Patterns.ag" INCLUDE "CodeSyntax.ag" INCLUDE "Expression.ag" INCLUDE "HsToken.ag" INCLUDE "LOAG/Rep" INCLUDE "ExecutionPlanPre" MODULE {LOAG.Prepare} {} {} { -- | Translating UUAGC types to MyTypes drhs f | f == _LHS = Inh | f == _LOC = AnyDir | f == _INST = AnyDir | otherwise = Syn dlhs f | f == _LHS = Syn | f == _LOC = AnyDir | f == _INST = AnyDir | otherwise = Inh depToEdge :: PMP_R -> PLabel -> Dependency -> Edge depToEdge pmpr p e = (findWithErr pmpr "depToEdge" $ MyOccurrence (p,getName f1) (getName i1, drhs f1), findWithErr pmpr "depToEdge" $ MyOccurrence (p,getName f2) (getName i2, dlhs f2)) where Dependency (OccAttr f1 i1) (OccAttr f2 i2) = e vertexToAttr :: NMP -> Vertex -> Attributes vertexToAttr nmp v = Map.singleton (identifier a) (fromMyTy ty) where (MyAttribute ty (a,_)) = findWithErr nmp "vertexToAttr" v } SEM Grammar | Grammar inst.smf : LOAGRep loc.initO= if Map.null @nonts.pmp then 1 else fst $ Map.findMin @nonts.pmp inst.smf = LOAGRep @nonts.ps @nonts.ap @loc.an @loc.ain @loc.asn @loc.sfp @nonts.pmp @nonts.pmpr @loc.nmp @loc.nmpr (A.array (@loc.initO, @loc.initO + Map.size @nonts.gen) $ Map.toList $ @nonts.gen) (A.array (1,Map.size @nonts.inss) $ Map.toList $ @nonts.inss) (A.array (@loc.initO, @loc.initO + length @nonts.ofld) $ @nonts.ofld) @nonts.fty @nonts.fieldMap @nonts.fsInP loc.nmp = Map.fromList $ zip [1..] @loc.atts loc.nmpr = Map.fromList $ zip @loc.atts [1..] loc.an = Map.unionWith (++) @loc.ain @loc.asn loc.ain = @nonts.inhs loc.asn = @nonts.syns loc.atts = concat $ Map.elems @loc.an loc.occs = concat $ Map.elems @nonts.ap nonts.augM = @manualAttrOrderMap -- Collecting the attributes ATTR Nonterminals Nonterminal [ augM : {Map.Map Identifier (Map.Map Identifier (Set.Set Dependency))} || inhs USE {Map.union} {Map.empty} : AI_N syns USE {Map.union} {Map.empty} : AS_N ] SEM Nonterminal | Nonterminal lhs.inhs = let dty = TyData (getName @nt) in Map.singleton dty (toMyAttr Inh dty @inh) lhs.syns = let dty = TyData (getName @nt) in Map.singleton dty (toMyAttr Syn dty @syn) prods.augM = case Map.lookup @nt @lhs.augM of Nothing -> Map.empty Just a -> a -- Adding all attribute sets to the AG type -- and sending it all down the abstract tree ATTR Nonterminals Nonterminal Productions Production Children Child MySegments MySegment [ ain : {MyType -> MyAttributes} asn : {MyType -> MyAttributes} pmpf : PMP pmprf : PMP_R lfpf : SF_P hoMapf: HOMap fty : FTY nmp : NMP || ] SEM Grammar | Grammar nonts.ain = map2F @loc.ain nonts.asn = map2F @loc.asn nonts.pmpf = @nonts.pmp nonts.pmprf = @nonts.pmpr nonts.lfpf = @nonts.lfp nonts.hoMapf= @nonts.hoMap nonts.ftyf = @nonts.fty nonts.fty = @nonts.fty -- Make sure TDP AND LFPRF are passed around correctly to code-generation ATTR Nonterminals Nonterminal Productions Production [ ftyf: FTY ||] -- Calculate the set of production labels SEM Grammar | Grammar loc.ps = @nonts.ps ATTR Nonterminals Nonterminal Productions Production [ || ads USE {(++)} {[]} : {[Edge]} fieldMap USE {(Map.union)} {Map.empty} : FMap hoMap USE {(Map.union)} {Map.empty} : HOMap fsInP USE {(Map.union)} {Map.empty} : FsInP] SEM Nonterminals Nonterminal [ || ps USE {(++)} {([])} : {[PLabel]} ] SEM Productions [ || ps USE {:} {([])} : {[PLabel]} ] SEM Production [ || ps : PLabel ] | Production loc.ps = (@lhs.dty,getName @con) lhs.ads = case Map.lookup @con @lhs.augM of Nothing -> [] Just a -> Set.toList $ Set.map (depToEdge @children.pmpr @loc.pll) a children.dty = @lhs.dty ATTR Productions Production [ augM : {Map.Map Identifier (Set.Set Dependency)} || ] -- We didnt calculate A_P yet, inheriting A_N we can ATTR Productions Production Rules Rule [ -- result type of this constructor dty : {MyType} || ] ATTR Rules Rule Children Child Expression HsTokensRoot HsTokens HsToken [ pll : {PLabel} || ] SEM Nonterminal | Nonterminal loc.dty = TyData (getName @nt) ATTR Nonterminals Nonterminal Productions Production Children Child FieldAtts FieldAtt [ an : {MyType -> MyAttributes} nmprf : NMP_R| olab : Int -- chained attribute for handing out labels to occurrences flab : Int |--chained attribute for handing out labels to fields ap USE {Map.unionWith (++)} {Map.empty} : A_P gen USE {Map.union} {Map.empty} : {Map Int Int} inss USE {Map.unionWith (++)} {Map.empty} : {Map Int [Int]} pmp USE {Map.union} {Map.empty} : PMP pmpr USE {Map.union} {Map.empty} : PMP_R -- maps for each occurrence to which field it belongs ofld USE {(++)} {[]} : {[(Int, Int)]} fty USE {Map.union} {Map.empty} : FTY ] SEM Grammar | Grammar nonts.an = map2F @loc.an nonts.nmprf= @loc.nmpr nonts.olab = if Map.null @loc.nmp then 0 else (fst $ Map.findMax @loc.nmp) nonts.flab = 0 ATTR Children Child [|| fieldMap USE {Map.union} {Map.empty} : FMap hoMap USE {Map.unionWith (Set.union)} {Map.empty} : HOMap ] SEM Children [ dty : {MyType} || ] | Nil loc.flab = @lhs.flab + 1 loc.atp = fst @lhs.pll inst.fatts : FieldAtts inst.fatts = map ((FieldAtt @loc.atp @lhs.pll "lhs") . alab) $ @lhs.an @loc.atp fatts.flab = @loc.flab loc.label = (@lhs.pll, "lhs") loc.foccsI = Set.fromList $ handAllOut @loc.label $ @lhs.ain @loc.atp loc.foccsS = Set.fromList $ handAllOut @loc.label $ @lhs.asn @loc.atp loc.fieldMap= Map.singleton @loc.label (@loc.foccsI, @loc.foccsS) lhs.fty = Map.singleton @loc.label @lhs.dty SEM Child | Child loc.flab = @lhs.flab + 1 loc.atp = toMyTy @tp inst.fatts : FieldAtts inst.fatts = map ((FieldAtt @loc.atp @lhs.pll (getName @name)) . alab) $ @lhs.an @loc.atp fatts.flab = @loc.flab loc.ident = getName @name loc.label = (@lhs.pll, @loc.ident) loc.foccsI = Set.fromList $ handAllOut @loc.label $ @lhs.ain @loc.atp loc.foccsS = Set.fromList $ handAllOut @loc.label $ @lhs.asn @loc.atp loc.fieldMap= if Set.null @loc.foccsI && Set.null @loc.foccsS then Map.empty else Map.singleton @loc.label (@loc.foccsS,@loc.foccsI) loc.hoMap = case @kind of ChildAttr -> Map.singleton @lhs.pll (Set.singleton @loc.ident) _ -> Map.empty lhs.fty = Map.singleton (@lhs.pll, getName @name) @loc.atp SEM FieldAtt | FieldAtt loc.olab = @lhs.olab + 1 loc.alab = findWithErr @lhs.nmprf "getting attr label" @loc.att loc.att = @t <.> @a loc.occ = (@p, @f) >.< @a loc.pmp = Map.singleton @loc.olab @loc.occ loc.pmpr = Map.singleton @loc.occ @loc.olab loc.inss = Map.singleton @loc.alab [@loc.olab] loc.gen = Map.singleton @loc.olab @loc.alab lhs.ap = Map.singleton @p [@loc.occ] lhs.ofld = [(@loc.olab, @lhs.flab)] -- calculate representation of semantic function -- definitions per non-terminal and from it, calculate E_P SEM Grammar | Grammar loc.sfp = repLocRefs @nonts.lfp $ addHigherOrders @nonts.lfp @nonts.sfp ATTR Nonterminals Nonterminal Productions Production Rules Rule [ || sfp USE {Map.unionWith (Set.union)} {Map.empty} : SF_P -- deps of non-locals ruleMap USE {Map.union} {Map.empty} : {Map.Map MyOccurrence Identifier} lfp USE {Map.unionWith (Set.union)} {Map.empty} : SF_P -- deps of local attrs lfpr USE {Map.unionWith (Set.union)} {Map.empty} : SF_P ]-- reverse SEM Production | Production loc.pll = (@lhs.dty,getName @con) rules.pll = @pll rules.pts = @children.pts lhs.fsInP = Map.singleton @pll $ Map.keys @children.fieldMap ATTR Children Child [ || pts USE {Set.union} {Set.empty} : {Set.Set FLabel} ] SEM Child | Child lhs.pts = Set.singleton $ getName @name ATTR Rules Rule [ lfpf : SF_P || usedLocals USE {(Set.union)} {Set.empty} : {Set.Set MyOccurrence}] SEM Rule | Rule loc.usedLocals = Set.filter (\(MyOccurrence (_,f) _) -> f == "loc") @rhs.used loc.usesLocals = not $ Set.null @loc.usedLocals (lhs.sfp,lhs.ruleMap,lhs.lfp,lhs.lfpr) = foldr (\(f, a, b) (m',rm', l', lr') -> let att = (@lhs.pll, f) >.< a rm = Map.insert att @rulename rm' l = if @loc.usesLocals && not b then Map.insert att @loc.usedLocals l' else l' lr = if @loc.usesLocals && not b then Set.fold (\k m -> Map.insertWith (Set.union) k (Set.singleton att) m) lr' @loc.usedLocals else lr' sfpins = Map.insert att (@rhs.used `Set.union` fromHO) m' fromHO = maybe Set.empty id (Map.lookup hOcc @lhs.lfpf) where hOcc = (@lhs.pll, "inst") >.< (f, AnyDir) in if b then (m',rm, Map.insert att @rhs.used l, Set.fold (\k m -> Map.insertWith (Set.union) k (Set.singleton att) m) lr @rhs.used) else (sfpins,rm,l,lr)) (Map.empty,Map.empty,Map.empty,Map.empty) @pattern.afs ATTR Patterns Pattern [ || -- the boolean represents whether this occurrence is -- an transparent occurrence (only there to pass on dependencies) afs USE {++} {[]} : {[(FLabel, ALabel, Bool)]} ] SEM Pattern | Alias lhs.afs = let isLocal = (@field == _LOC || @field == _INST) in [(getName @field, (getName @attr, dlhs @field), isLocal)] ++ @pat.afs ATTR Rules Rule Expression HsTokensRoot HsTokens HsToken [ -- the terminals of current production pts : {Set.Set (FLabel)} || ] ATTR Rule Expression HsTokensRoot HsTokens HsToken [ || used USE {Set.union} {Set.empty} : {Set.Set MyOccurrence} ] SEM Expression | Expression inst.tokens : HsTokensRoot inst.tokens = HsTokensRoot @tks tokens.pll = @lhs.pll tokens.pts = @lhs.pts lhs.used = @tokens.used -- reference to terminals of which some are local attributes SEM HsToken | AGLocal lhs.used = case getName @var `Set.member` @lhs.pts of True -> Set.empty -- local found without flabel False -> Set.singleton $ (@lhs.pll, getName _LOC) >.< (getName @var, drhs _LOC) -- includes both locals and attributes -- locals will be replaced later by repLocRefs SEM HsToken | AGField lhs.used = Set.singleton $ (@lhs.pll, getName @field) >.< (getName @attr, drhs @field) { -- | Replace the references to local attributes, by his attrs dependencies, -- | rendering the local attributes 'transparent'. repLocRefs :: SF_P -> SF_P -> SF_P repLocRefs lfp sfp = Map.map (setConcatMap $ rep Set.empty) sfp where rep :: Set.Set MyOccurrence -> MyOccurrence -> Set.Set MyOccurrence rep done occ | occ `Set.member` done = Set.empty | isLoc occ = setConcatMap (rep $ Set.insert occ done) $ findWithErr lfp "repping locals" occ | otherwise = Set.singleton occ -- | Add dependencies from a higher order child to all its attributes addHigherOrders :: SF_P -> SF_P -> SF_P addHigherOrders lfp sfp = Map.mapWithKey f $ Map.map (setConcatMap (\mo -> f mo (Set.singleton mo))) sfp where f :: MyOccurrence -> Set.Set MyOccurrence -> Set.Set MyOccurrence f mo@(MyOccurrence (p,f) _) deps = let ho = ((p,"inst") >.< (f,AnyDir)) in if ho `Map.member` lfp then ho `Set.insert` deps else deps } uuagc-0.9.52.2/src-options/0000755000000000000000000000000013433540502013520 5ustar0000000000000000uuagc-0.9.52.2/src-options/Options.hs0000644000000000000000000010341413433540502015512 0ustar0000000000000000module Options where import System.Console.GetOpt import Data.Set(Set) import UU.Scanner.Position(Pos,noPos) import Data.List(intercalate) import qualified Data.Set as Set import System.IO import System.Exit -- From CommonTypes data Identifier = Ident { getName::String, getPos::Pos } type NontermIdent = Identifier identifier :: String -> Identifier identifier x = Ident x noPos instance Eq Identifier where Ident x _ == Ident y _ = x == y instance Ord Identifier where compare (Ident x _) (Ident y _) = compare x y instance Show Identifier where show ident = getName ident -- Make options serializable data MyOptDescr = MyOpt [Char] [String] (ArgDescr (Options -> Options)) (Options -> String -> [String]) String fromMyOpt :: MyOptDescr -> OptDescr (Options -> Options) fromMyOpt (MyOpt sh ln desc _ s) = Option sh ln desc s noOpt :: Options -> String -> [String] noOpt _ _ = [] boolOpt :: (Options -> Bool) -> Options -> String -> [String] boolOpt get opt strArg = let oldVal = get noOptions newVal = get opt in if oldVal /= newVal then [strArg] else [] stringOpt :: (Options -> String) -> Options -> String -> [String] stringOpt get opt strArg = let oldVal = get noOptions newVal = get opt in if oldVal /= newVal then [strArg, newVal] else [] mbStringOpt :: (Options -> Maybe String) -> Options -> String -> [String] mbStringOpt get opts nm = maybe [] (\s -> [nm++"="++s]) (get opts) serializeOption :: Options -> MyOptDescr -> [String] serializeOption opt (MyOpt sh ln _ get _) = get opt strArg where strArg = if null sh then '-' : '-' : head ln else '-' : head sh : [] -- All options allOptions :: [MyOptDescr] allOptions = [ MyOpt ['m'] [] (NoArg (moduleOpt Nothing)) noOpt "generate default module header" , MyOpt [] ["module"] (OptArg moduleOpt "name") moduleOptGet "generate module header, specify module name" , MyOpt ['d'] ["data"] (NoArg dataOpt) (boolOpt dataTypes) "generate data type definition" , MyOpt [] ["datarecords"] (NoArg dataRecOpt) (boolOpt dataRecords) "generate record data types" , MyOpt [] ["strictdata"] (NoArg strictDataOpt) (boolOpt strictData) "generate strict data fields (when data is generated)" , MyOpt [] ["strictwrap"] (NoArg strictWrapOpt) (boolOpt strictWrap) "generate strict wrap fields for WRAPPER generated data" , MyOpt ['c'] ["catas"] (NoArg cataOpt) (boolOpt folds) "generate catamorphisms" , MyOpt ['f'] ["semfuns"] (NoArg semfunsOpt) (boolOpt semfuns) "generate semantic functions" , MyOpt ['s'] ["signatures"] (NoArg signaturesOpt) (boolOpt typeSigs) "generate signatures for semantic functions" , MyOpt [] ["newtypes"] (NoArg newtypesOpt) (boolOpt newtypes) "use newtypes instead of type synonyms" , MyOpt ['p'] ["pretty"] (NoArg prettyOpt) (boolOpt attrInfo) "generate pretty printed list of attributes" , MyOpt ['w'] ["wrappers"] (NoArg wrappersOpt) (boolOpt wrappers) "generate wappers for semantic domains" , MyOpt ['r'] ["rename"] (NoArg renameOpt) (boolOpt rename) "rename data constructors" , MyOpt [] ["modcopy"] (NoArg modcopyOpt) (boolOpt modcopy) "use modified copy rule" , MyOpt [] ["nest"] (NoArg nestOpt) (boolOpt nest) "use nested tuples" , MyOpt [] ["syntaxmacro"] (NoArg smacroOpt) (boolOpt smacro) "experimental: generate syntax macro code (using knit catas)" , MyOpt ['o'] ["output"] (ReqArg outputOpt "file") outputOptGet "specify output file" , MyOpt ['v'] ["verbose"] (NoArg verboseOpt) (boolOpt verbose) "verbose error message format" , MyOpt ['h','?'] ["help"] (NoArg helpOpt) (boolOpt showHelp) "get (this) usage information" , MyOpt ['a'] ["all"] (NoArg allOpt) noOpt ("do everything (-" ++ allc ++ ")") , MyOpt ['P'] [""] (ReqArg searchPathOpt "search path") searchPathOptGet ("specify seach path") , MyOpt [] ["prefix"] (ReqArg prefixOpt "prefix") (stringOpt prefix) "set prefix for semantic functions" , MyOpt [] ["self"] (NoArg selfOpt) (boolOpt withSelf) "generate self attribute" , MyOpt [] ["cycle"] (NoArg cycleOpt) (boolOpt withCycle) "check for cyclic definitions" , MyOpt [] ["version"] (NoArg versionOpt) (boolOpt showVersion) "get version information" , MyOpt ['O'] ["optimize"] (NoArg optimizeOpt) noOpt "optimize generated code (--visit --case)" , MyOpt [] ["visit"] (NoArg visitOpt) (boolOpt visit) "try generating visit functions" , MyOpt [] ["loag"] (OptArg loagOpt "Bool") (boolOpt loag) "recognises all linear ordered attribute grammars by generting a SAT problem, uses --verbose to print out numbers of clauses and variables" , MyOpt [] ["aoag"] (NoArg aoagOpt) (boolOpt aoag) "recognises all linear ordered attribute grammars by finding fake dependencies, uses --verbose to print out the selected fake dependencies" , MyOpt [] ["seq"] (NoArg seqOpt) (boolOpt withSeq) "force evaluation using function seq (visit functions only)" , MyOpt [] ["unbox"] (NoArg unboxOpt) (boolOpt unbox) "use unboxed tuples" , MyOpt [] ["bangpats"] (NoArg bangpatsOpt) (boolOpt bangpats) "use bang patterns (visit functions only)" , MyOpt [] ["case"] (NoArg casesOpt) (boolOpt cases) "Use nested cases instead of let (visit functions only)" , MyOpt [] ["strictcase"] (NoArg strictCasesOpt) (boolOpt strictCases) "Force evaluation of the scrutinee of cases (in generated code, visit functions only)" , MyOpt [] ["strictercase"] (NoArg stricterCasesOpt) (boolOpt stricterCases) "Force evaluation of all variables bound by a case statement (in generated code)" , MyOpt [] ["strictsem"] (NoArg strictSemOpt) (boolOpt strictSems) "Force evaluation of sem-function arguments (in generated code)" , MyOpt [] ["localcps"] (NoArg localCpsOpt) (boolOpt localCps) "Apply a local CPS transformation (in generated code, visit functions only)" , MyOpt [] ["splitsems"] (NoArg splitSemsOpt) (boolOpt splitSems) "Split semantic functions into smaller pieces" , MyOpt [] ["Werrors"] (NoArg werrorsOpt) (boolOpt werrors) "Turn warnings into fatal errors" , MyOpt [] ["Wignore"] (NoArg wignoreOpt) (boolOpt wignore) "Ignore warnings" , MyOpt [] ["Wmax"] (ReqArg wmaxErrsOpt "") wmaxErrsOptGet "Sets the maximum number of errors that are reported" , MyOpt [] ["dumpgrammar"] (NoArg dumpgrammarOpt) (boolOpt dumpgrammar) "Dump internal grammar representation (in generated code)" , MyOpt [] ["dumpcgrammar"] (NoArg dumpcgrammarOpt) (boolOpt dumpcgrammar)"Dump internal cgrammar representation (in generated code)" , MyOpt [] ["gentraces"] (NoArg genTracesOpt) (boolOpt genTraces) "Generate trace expressions (in generated code)" , MyOpt [] ["genusetraces"] (NoArg genUseTracesOpt) (boolOpt genUseTraces)"Generate trace expressions at attribute use sites (in generated code)" , MyOpt [] ["gencostcentres"] (NoArg genCostCentresOpt) (boolOpt genCostCentres) "Generate cost centre pragmas (in generated code)" , MyOpt [] ["genlinepragmas"] (NoArg genLinePragmasOpt) (boolOpt genLinePragmas) "Generate GHC LINE pragmas (in generated code)" , MyOpt [] ["sepsemmods"] (NoArg sepSemModsOpt) (boolOpt sepSemMods) "Generate separate modules for semantic functions (in generated code)" , MyOpt ['M'] ["genfiledeps"] (NoArg genFileDepsOpt) (boolOpt genFileDeps) "Generate a list of dependencies on the input AG files" , MyOpt [] ["genvisage"] (NoArg genVisageOpt) (boolOpt genvisage) "Generate output for the AG visualizer Visage" , MyOpt [] ["aspectag"] (NoArg genAspectAGOpt) (boolOpt genAspectAG) "Generate AspectAG file" , MyOpt [] ["nogroup"] (ReqArg noGroupOpt "attributes") noGroupOptGet "specify the attributes that won't be grouped in AspectAG" , MyOpt [] ["extends"] (ReqArg extendsOpt "module") (mbStringOpt extends) "specify a module to be extended" , MyOpt [] ["genattrlist"] (NoArg genAttrListOpt) (boolOpt genAttributeList) "Generate a list of all explicitly defined attributes (outside irrefutable patterns)" , MyOpt [] ["forceirrefutable"] (OptArg forceIrrefutableOpt "file") (mbStringOpt forceIrrefutables) "Force a set of explicitly defined attributes to be irrefutable, specify file containing the attribute set" , MyOpt [] ["uniquedispenser"] (ReqArg uniqueDispenserOpt "name") (stringOpt uniqueDispenser) "The Haskell function to call in the generated code" , MyOpt [] ["lckeywords"] (NoArg lcKeywordsOpt) (boolOpt lcKeywords) "Use lowercase keywords (sem, attr) instead of the uppercase ones (SEM, ATTR)" , MyOpt [] ["doublecolons"] (NoArg doubleColonsOpt) (boolOpt doubleColons)"Use double colons for type signatures instead of single colons" , MyOpt ['H'] ["haskellsyntax"] (NoArg haskellSyntaxOpt) noOpt "Use Haskell like syntax (equivalent to --lckeywords and --doublecolons --genlinepragmas)" , MyOpt [] ["reference"] (NoArg referenceOpt) (boolOpt reference) "Use reference attributes" , MyOpt [] ["monadic"] (NoArg monadicOpt) (boolOpt monadic) "Experimental: generate monadic code" , MyOpt [] ["ocaml"] (NoArg ocamlOpt) (boolOpt ocaml) "Generate Ocaml code" , MyOpt [] ["cleanlang"] (NoArg cleanOpt) (boolOpt clean) "Generate Clean code" , MyOpt [] ["breadthfirst"] (NoArg breadthfirstOpt) (boolOpt breadthFirst)"Experimental: generate breadth-first code" , MyOpt [] ["breadthfirst-strict"] (NoArg breadthfirstStrictOpt) (boolOpt breadthFirstStrict) "Experimental: outermost breadth-first evaluator is strict instead of lazy" , MyOpt [] ["visitcode"] (NoArg visitorsOutputOpt) (boolOpt visitorsOutput) "Experimental: generate visitors code" , MyOpt [] ["kennedywarren"] (NoArg kennedyWarrenOpt) (boolOpt kennedyWarren) "Use Kennedy-Warren's algorithm for ordering" , MyOpt [] ["statistics"] (ReqArg statisticsOpt "FILE to append to") (mbStringOpt statsFile) "Append statistics to FILE" , MyOpt [] ["checkParseRhs"] (NoArg parseHsRhsOpt) (boolOpt checkParseRhs) "Parse RHS of rules with Haskell parser" , MyOpt [] ["checkParseTys"] (NoArg parseHsTpOpt) (boolOpt checkParseTy) "Parse types of attrs with Haskell parser" , MyOpt [] ["checkParseBlocks"] (NoArg parseHsBlockOpt) (boolOpt checkParseBlock) "Parse blocks with Haskell parser" , MyOpt [] ["checkParseHaskell"] (NoArg parseHsOpt) noOpt "Parse Haskell code (recognizer)" , MyOpt [] ["nocatas"] (ReqArg nocatasOpt "list of nonterms") nocatasOptGet "Nonterminals not to generate catas for" , MyOpt [] ["nooptimize"] (NoArg noOptimizeOpt) (boolOpt noOptimizations) "Disable optimizations" , MyOpt [] ["parallel"] (NoArg parallelOpt) (boolOpt parallelInvoke) "Generate a parallel evaluator (if possible)" , MyOpt [] ["monadicwrapper"] (NoArg monadicWrappersOpt) (boolOpt monadicWrappers) "Generate monadic wrappers" , MyOpt [] ["helpinlining"] (NoArg helpInliningOpt) (boolOpt helpInlining) "Generate inline directives for GHC" , MyOpt [] ["dummytokenvisit"] (NoArg dummyTokenVisitOpt) (boolOpt dummyTokenVisit) "Add an additional dummy parameter to visit functions" , MyOpt [] ["tupleasdummytoken"] (NoArg tupleAsDummyTokenOpt) (boolOpt tupleAsDummyToken) "Use conventional tuples as dummy parameter instead of a RealWorld state token" , MyOpt [] ["stateasdummytoken"] (NoArg stateAsDummyTokenOpt) noOpt "Use RealWorld state token as dummy parameter instead of conventional tuples (default)" , MyOpt [] ["strictdummytoken"] (NoArg strictDummyTokenOpt) (boolOpt strictDummyToken) "Strictify the dummy token that makes states and rules functions" , MyOpt [] ["noperruletypesigs"] (NoArg noPerRuleTypeSigsOpt) (boolOpt noPerRuleTypeSigs) "Do not generate type sigs for attrs passed to rules" , MyOpt [] ["noperstatetypesigs"] (NoArg noPerStateTypeSigsOpt) (boolOpt noPerStateTypeSigs) "Do not generate type sigs for attrs saved in node states" , MyOpt [] ["noeagerblackholing"] (NoArg noEagerBlackholingOpt) (boolOpt noEagerBlackholing) "Do not automatically add the eager blackholing feature for parallel programs" , MyOpt [] ["noperrulecostcentres"] (NoArg noPerRuleCostCentresOpt) (boolOpt noPerRuleCostCentres) "Do not generate cost centres for rules" , MyOpt [] ["nopervisitcostcentres"] (NoArg noPerVisitCostCentresOpt) (boolOpt noPerVisitCostCentres) "Do not generate cost centres for visits" , MyOpt [] ["noinlinepragmas"] (NoArg noInlinePragmasOpt) (boolOpt noInlinePragmas) "Definitely not generate inline directives" , MyOpt [] ["aggressiveinlinepragmas"] (NoArg aggressiveInlinePragmasOpt) (boolOpt aggressiveInlinePragmas) "Generate more aggressive inline directives" , MyOpt [] ["latehigherorderbinding"] (NoArg lateHigherOrderBindingOpt) (boolOpt lateHigherOrderBinding) "Generate an attribute and wrapper for late binding of higher-order attributes" , MyOpt [] ["noincludes"] (NoArg noIncludesOpt) (boolOpt noIncludes) "Ignore include directives in .ag files" , MyOpt [] ["quiet"] (NoArg beQuietOpt) (boolOpt beQuiet) "Dont print some compilation information" ] -- For compatibility options :: [OptDescr (Options -> Options)] options = map fromMyOpt allOptions allc :: String allc = "dcfsprm" data ModuleHeader = NoName | Name String | Default deriving (Eq, Show) data Options = Options{ moduleName :: ModuleHeader , dataTypes :: Bool , dataRecords :: Bool , strictData :: Bool , strictWrap :: Bool , folds :: Bool , semfuns :: Bool , typeSigs :: Bool , attrInfo :: Bool , rename :: Bool , wrappers :: Bool , modcopy :: Bool , newtypes :: Bool , nest :: Bool , smacro :: Bool , outputFiles :: [String] , searchPath :: [String] , verbose :: Bool , prefix :: String , withSelf :: Bool , withCycle :: Bool , showHelp :: Bool , showVersion :: Bool , visit :: Bool , loag :: Bool , minvisits :: Bool , aoag :: Bool , withSeq :: Bool , unbox :: Bool , bangpats :: Bool , cases :: Bool , strictCases :: Bool , stricterCases :: Bool , strictSems :: Bool , localCps :: Bool , splitSems :: Bool , werrors :: Bool , wignore :: Bool , wmaxerrs :: Int , dumpgrammar :: Bool , dumpcgrammar :: Bool , sepSemMods :: Bool , allowSepSemMods :: Bool , genFileDeps :: Bool , genLinePragmas :: Bool , genvisage :: Bool , genAspectAG :: Bool , noGroup :: [String] , extends :: Maybe String , genAttributeList :: Bool , forceIrrefutables :: Maybe String , uniqueDispenser :: String , lcKeywords :: Bool , doubleColons :: Bool , monadic :: Bool , ocaml :: Bool , clean :: Bool , visitorsOutput :: Bool , statsFile :: Maybe String , breadthFirst :: Bool , breadthFirstStrict :: Bool , checkParseRhs :: Bool , checkParseTy :: Bool , checkParseBlock :: Bool , nocatas :: Set NontermIdent , noOptimizations :: Bool , reference :: Bool , noIncludes :: Bool , outputStr :: String -> IO () , failWithCode :: Int -> IO () , mainFilename :: Maybe String , beQuiet :: Bool -- KW code path , kennedyWarren :: Bool , parallelInvoke :: Bool , tupleAsDummyToken :: Bool -- use the empty tuple as dummy token instead of State# RealWorld (Lambda State Hack GHC?) , dummyTokenVisit :: Bool -- add a dummy argument/pass dummy extra token to visits (should not really have an effect ... Lambda State Hack GHC?) , strictDummyToken :: Bool -- make the dummy token strict (to prevent its removal -- should not really have an effect) , noPerRuleTypeSigs :: Bool -- do not print type signatures for attributes of rules , noPerStateTypeSigs :: Bool -- do not print type signatures for attributes contained in the state , noEagerBlackholing :: Bool -- disable the use of eager black holing in the parallel evaluator code , lateHigherOrderBinding :: Bool -- generate code to allow late binding of higher-order children semantics , monadicWrappers :: Bool -- tracing , genTraces :: Bool , genUseTraces :: Bool , genCostCentres :: Bool , noPerRuleCostCentres :: Bool , noPerVisitCostCentres :: Bool -- inline pragma generation , helpInlining :: Bool , noInlinePragmas :: Bool , aggressiveInlinePragmas :: Bool } -- deriving (Eq, Show) noOptions :: Options noOptions = Options { moduleName = NoName , dataTypes = False , dataRecords = False , strictData = False , strictWrap = False , folds = False , semfuns = False , typeSigs = False , attrInfo = False , rename = False , wrappers = False , modcopy = False , newtypes = False , nest = False , smacro = False , outputFiles = [] , searchPath = [] , verbose = False , showHelp = False , showVersion = False , prefix = "sem_" , withSelf = False , withCycle = False , visit = False , loag = False , minvisits = False , aoag = False , withSeq = False , unbox = False , bangpats = False , cases = False , strictCases = False , stricterCases = False , strictSems = False , localCps = False , splitSems = False , werrors = False , wignore = False , wmaxerrs = 99999 , dumpgrammar = False , dumpcgrammar = False , sepSemMods = False , allowSepSemMods = True , genFileDeps = False , genLinePragmas = False , genvisage = False , genAspectAG = False , noGroup = [] , extends = Nothing , genAttributeList = False , forceIrrefutables = Nothing , uniqueDispenser = "nextUnique" , lcKeywords = False , doubleColons = False , monadic = False , ocaml = False , clean = False , visitorsOutput = False , statsFile = Nothing , breadthFirst = False , breadthFirstStrict = False , checkParseRhs = False , checkParseTy = False , checkParseBlock = False , nocatas = Set.empty , noOptimizations = False , reference = False , noIncludes = False , outputStr = hPutStr stderr , failWithCode = exitWith . ExitFailure , mainFilename = Nothing , beQuiet = False -- defaults for the KW-code path , kennedyWarren = False , parallelInvoke = False , tupleAsDummyToken = True , dummyTokenVisit = False , strictDummyToken = False , noPerRuleTypeSigs = False , noPerStateTypeSigs = False , noEagerBlackholing = False , lateHigherOrderBinding = False , monadicWrappers = False -- defaults for tracing , genTraces = False , genUseTraces = False , genCostCentres = False , noPerRuleCostCentres = False , noPerVisitCostCentres = False -- defaults for inline pragma generation , helpInlining = False , noInlinePragmas = False , aggressiveInlinePragmas = False } loagOpt :: (Maybe String) -> Options -> Options loagOpt mstr opts = case mstr of Nothing -> opts' Just "0" -> opts' Just _ -> opts' {minvisits = True} where opts'=opts{loag = True, visit = True} aoagOpt :: Options -> Options aoagOpt opts = opts{loag = True, visit = True, aoag = True} --Options -> String -> [String] moduleOpt :: Maybe String -> Options -> Options moduleOpt nm opts = opts{moduleName = maybe Default Name nm} moduleOptGet :: Options -> String -> [String] moduleOptGet opts nm = case moduleName opts of NoName -> [] Name s -> [nm++"="++s] Default -> [nm] dataOpt, dataRecOpt, strictDataOpt, strictWrapOpt, cataOpt, semfunsOpt, signaturesOpt, prettyOpt,renameOpt, wrappersOpt, modcopyOpt, newtypesOpt, nestOpt, smacroOpt, verboseOpt, helpOpt, versionOpt, selfOpt, cycleOpt, visitOpt, seqOpt, unboxOpt, bangpatsOpt, casesOpt, strictCasesOpt, stricterCasesOpt, strictSemOpt, localCpsOpt, splitSemsOpt, werrorsOpt, wignoreOpt, dumpgrammarOpt, dumpcgrammarOpt, genTracesOpt, genUseTracesOpt, genCostCentresOpt, sepSemModsOpt, genFileDepsOpt, genLinePragmasOpt, genVisageOpt, genAspectAGOpt, dummyTokenVisitOpt, tupleAsDummyTokenOpt, stateAsDummyTokenOpt, strictDummyTokenOpt, noPerRuleTypeSigsOpt, noPerStateTypeSigsOpt, noEagerBlackholingOpt, noPerRuleCostCentresOpt, noPerVisitCostCentresOpt, helpInliningOpt, noInlinePragmasOpt, aggressiveInlinePragmasOpt, lateHigherOrderBindingOpt, monadicWrappersOpt, referenceOpt, genAttrListOpt, lcKeywordsOpt, doubleColonsOpt, haskellSyntaxOpt, monadicOpt, parallelOpt, ocamlOpt, cleanOpt, visitorsOutputOpt, breadthfirstOpt, breadthfirstStrictOpt, parseHsRhsOpt, parseHsTpOpt, parseHsBlockOpt, parseHsOpt, kennedyWarrenOpt, noOptimizeOpt, allOpt, optimizeOpt, noIncludesOpt, beQuietOpt, condDisableOptimizations :: Options -> Options dataOpt opts = opts{dataTypes = True} dataRecOpt opts = opts{dataRecords = True} strictDataOpt opts = opts{strictData = True} strictWrapOpt opts = opts{strictWrap = True} cataOpt opts = opts{folds = True} semfunsOpt opts = opts{semfuns = True} signaturesOpt opts = opts{typeSigs = True} prettyOpt opts = opts{attrInfo = True} renameOpt opts = opts{rename = True} wrappersOpt opts = opts{wrappers = True} modcopyOpt opts = opts{modcopy = True} newtypesOpt opts = opts{newtypes = True} nestOpt opts = opts{nest = True} smacroOpt opts = opts{smacro = True} verboseOpt opts = opts{verbose = True} helpOpt opts = opts{showHelp = True} versionOpt opts = opts{showVersion = True} prefixOpt :: String -> Options -> Options prefixOpt pre opts = opts{prefix = pre } selfOpt opts = opts{withSelf = True} cycleOpt opts = opts{withCycle = True} visitOpt opts = opts{visit = True, withCycle = True} seqOpt opts = opts{withSeq = True} unboxOpt opts = opts{unbox = True} bangpatsOpt opts = opts{bangpats = True} casesOpt opts = opts{cases = True} strictCasesOpt opts = opts{strictCases = True} stricterCasesOpt opts = opts{strictCases = True, stricterCases = True} strictSemOpt opts = opts{strictSems = True} localCpsOpt opts = opts{localCps = True} splitSemsOpt opts = opts{splitSems = True} werrorsOpt opts = opts{werrors = True} wignoreOpt opts = opts{wignore = True} wmaxErrsOpt :: String -> Options -> Options wmaxErrsOpt n opts = opts{wmaxerrs = read n} wmaxErrsOptGet :: Options -> String -> [String] wmaxErrsOptGet opts nm = if wmaxerrs opts /= wmaxerrs noOptions then [nm,show (wmaxerrs opts)] else [] dumpgrammarOpt opts = opts{dumpgrammar = True} dumpcgrammarOpt opts = opts{dumpcgrammar = True} genTracesOpt opts = opts{genTraces = True} genUseTracesOpt opts = opts{genUseTraces = True} genCostCentresOpt opts = opts{genCostCentres = True} sepSemModsOpt opts = opts{sepSemMods = allowSepSemMods opts} genFileDepsOpt opts = opts{genFileDeps = True} genLinePragmasOpt opts = opts{genLinePragmas = True} genVisageOpt opts = opts{genvisage = True } genAspectAGOpt opts = opts{genAspectAG = True} dummyTokenVisitOpt opts = opts { dummyTokenVisit = True } tupleAsDummyTokenOpt opts = opts { tupleAsDummyToken = True } stateAsDummyTokenOpt opts = opts { tupleAsDummyToken = False } strictDummyTokenOpt opts = opts { strictDummyToken = True } noPerRuleTypeSigsOpt opts = opts { noPerRuleTypeSigs = True } noPerStateTypeSigsOpt opts = opts { noPerStateTypeSigs = True } noEagerBlackholingOpt opts = opts { noEagerBlackholing = True } noPerRuleCostCentresOpt opts = opts { noPerRuleCostCentres = True } noPerVisitCostCentresOpt opts = opts { noPerVisitCostCentres = True } helpInliningOpt opts = opts { helpInlining = True } noInlinePragmasOpt opts = opts { noInlinePragmas = True } aggressiveInlinePragmasOpt opts = opts { aggressiveInlinePragmas = True } lateHigherOrderBindingOpt opts = opts { lateHigherOrderBinding = True } monadicWrappersOpt opts = opts { monadicWrappers = True } referenceOpt opts = opts { reference = True } noGroupOpt :: String -> Options -> Options noGroupOpt att opts = opts{noGroup = wordsBy (== ':') att ++ noGroup opts} noGroupOptGet :: Options -> String -> [String] noGroupOptGet opts nm = if null (noGroup opts) then [] else [nm, intercalate ":" (noGroup opts)] extendsOpt :: String -> Options -> Options extendsOpt m opts = opts{extends = Just m } genAttrListOpt opts = opts { genAttributeList = True } forceIrrefutableOpt :: Maybe String -> Options -> Options forceIrrefutableOpt mbNm opts = opts { forceIrrefutables = mbNm } uniqueDispenserOpt :: String -> Options -> Options uniqueDispenserOpt nm opts = opts { uniqueDispenser = nm } lcKeywordsOpt opts = opts { lcKeywords = True } doubleColonsOpt opts = opts { doubleColons = True } haskellSyntaxOpt = lcKeywordsOpt . doubleColonsOpt . genLinePragmasOpt monadicOpt opts = opts { monadic = True } parallelOpt opts = opts { parallelInvoke = True } ocamlOpt opts = opts { ocaml = True, kennedyWarren = True, withCycle = True, visit = True } cleanOpt opts = opts { clean = True } --TODO: More? visitorsOutputOpt opts = opts { visitorsOutput = True } statisticsOpt :: String -> Options -> Options statisticsOpt nm opts = opts { statsFile = Just nm } breadthfirstOpt opts = opts { breadthFirst = True } breadthfirstStrictOpt opts = opts { breadthFirstStrict = True } parseHsRhsOpt opts = opts { checkParseRhs = True } parseHsTpOpt opts = opts { checkParseTy = True } parseHsBlockOpt opts = opts { checkParseBlock = True } parseHsOpt = parseHsRhsOpt . parseHsTpOpt . parseHsBlockOpt kennedyWarrenOpt opts = opts { kennedyWarren = True } noOptimizeOpt opts = opts { noOptimizations = True } nocatasOpt :: String -> Options -> Options nocatasOpt str opts = opts { nocatas = set `Set.union` nocatas opts } where set = Set.fromList ids ids = map identifier lst lst = wordsBy (== ',') str nocatasOptGet :: Options -> String -> [String] nocatasOptGet opts nm = if Set.null (nocatas opts) then [] else [nm,intercalate "," . map getName . Set.toList . nocatas $ opts] outputOpt :: String -> Options -> Options outputOpt file opts = opts{outputFiles = file : outputFiles opts} outputOptGet :: Options -> String -> [String] outputOptGet opts nm = concat [ [nm, file] | file <- outputFiles opts] searchPathOpt :: String -> Options -> Options searchPathOpt path opts = opts{searchPath = wordsBy (\x -> x == ';' || x == ':') path ++ searchPath opts} searchPathOptGet :: Options -> String -> [String] searchPathOptGet opts nm = if null (searchPath opts) then [] else [nm, intercalate ":" (searchPath opts)] allOpt = moduleOpt Nothing . dataOpt . cataOpt . semfunsOpt . signaturesOpt . prettyOpt . renameOpt . dataRecOpt optimizeOpt = visitOpt . casesOpt noIncludesOpt opts = opts { noIncludes = True } beQuietOpt opts = opts { beQuiet = True } condDisableOptimizations opts | noOptimizations opts = opts { strictData = False , strictWrap = False , withSeq = False , unbox = False , bangpats = False , cases = False , strictCases = False , stricterCases = False , strictSems = False , localCps = False , splitSems = False , breadthFirstStrict = False } | otherwise = opts -- | Inverse of intercalate wordsBy :: (Char -> Bool) -> String -> [String] wordsBy p = f where f s = let (x,xs) = break p s in if null x then [] else x : f (drop 1 xs) -- | Use all parsed options to generate real options constructOptions :: [Options -> Options] -> Options constructOptions = foldl (flip ($)) noOptions -- | Create Options type from string arguments getOptions :: [String] -> (Options,[String],[String]) getOptions args = let (flags,files,errors) = getOpt Permute options args appliedOpts = constructOptions flags finOpts = condDisableOptimizations appliedOpts in (finOpts,files,errors) -- | Convert options back to commandline string optionsToString :: Options -> [String] optionsToString opt = concatMap (serializeOption opt) allOptions -- | Combine 2 sets of options combineOptions :: Options -> Options -> Options combineOptions o1 o2 = let str1 = optionsToString o1 str2 = optionsToString o2 (opt,_,_) = getOptions (str1 ++ str2) in opt uuagc-0.9.52.2/src-main/0000755000000000000000000000000013433540502012751 5ustar0000000000000000uuagc-0.9.52.2/src-main/Main.hs0000644000000000000000000000011613433540502014167 0ustar0000000000000000module Main where import UU.UUAGC (uuagcMain) main :: IO () main = uuagcMainuuagc-0.9.52.2/src-version/0000755000000000000000000000000013433540502013512 5ustar0000000000000000uuagc-0.9.52.2/src-version/Version.hs0000644000000000000000000000075513433540502015502 0ustar0000000000000000-- | This module is a placeholder. It it installed in combination with the UUAGC application, -- so that the uuagc-package shows up as an explicit dependency. -- -- Note: this is the Version.hs of the bootstrapped UUAG compiler. module Version where import UU.UUAGC.Version import Data.Version -- | Description of the application including the application's version number banner :: String banner = ("Attribute Grammar compiler / HUT project. Version " ++ showVersion version) uuagc-0.9.52.2/src/0000755000000000000000000000000013433540502012027 5ustar0000000000000000uuagc-0.9.52.2/src/GrammarInfo.hs0000644000000000000000000000417113433540502014570 0ustar0000000000000000module GrammarInfo where import SequentialTypes import CodeSyntax import Data.Map(Map) import qualified Data.Map as Map import Data.Set(Set) import qualified Data.Set as Set import CommonTypes import Data.List(intersect,(\\)) import Options type LMH = (Vertex,Vertex,Vertex) data Info = Info { tdpToTds :: Table Vertex , tdsToTdp :: Table [Vertex] , attrTable :: Table NTAttr , ruleTable :: Table CRule , lmh :: [LMH] , nonts :: [(NontermIdent,[ConstructorIdent])] , wraps :: Set NontermIdent } deriving Show instance Show CRule where show (CRule name _ _ nt con field childnt _ _ rhs _ _ _ uses _ _) = "CRule " ++ show name ++ " nt: " ++ show nt ++ " con: " ++ show con ++ " field: " ++ show field ++ " childnt: " ++ show childnt ++ " rhs: " ++ concat rhs ++ " uses: " ++ show [ attrname noOptions True fld nm | (fld,nm) <- Set.toList uses ] show _ = error "Only CRule is supported" type CInterfaceMap = Map NontermIdent CInterface type CVisitsMap = Map NontermIdent (Map ConstructorIdent CVisits) data CycleStatus = CycleFree CInterfaceMap CVisitsMap | LocalCycle [Route] | InstCycle [Route] | DirectCycle [EdgeRoutes] | InducedCycle CInterfaceMap [EdgeRoutes] showsSegment :: CSegment -> [String] showsSegment (CSegment inh syn) = let syn' = map toString (Map.toList syn) inh' = map toString (Map.toList inh) toString (a,t) = (getName a, case t of (NT nt tps _) -> getName nt ++ " " ++ unwords tps; Haskell t' -> t'; Self -> error "Self type not supported.") chnn = inh' `intersect` syn' inhn = inh' \\ chnn synn = syn' \\ chnn disp _ [] = [] disp name as = (name ++ if length as == 1 then " attribute:" else " attributes:") : map (\(x,y) -> ind x ++ replicate ((20 - length x) `max` 0) ' ' ++ " : " ++ y) as in disp "inherited" inhn ++ disp "chained" chnn ++ disp "synthesized" synn uuagc-0.9.52.2/src/SequentialComputation.lhs0000644000000000000000000004212013433540502017073 0ustar0000000000000000\begin{code} module SequentialComputation (computeSequential,Vertex,Edge,Table) where import SequentialTypes import InterfacesRules import CodeSyntax import GrammarInfo import Control.Monad(when,unless) import Control.Monad.ST(ST, runST) import Data.Array(Array,(!),bounds) import Data.Array.ST(STArray, newArray, readArray, writeArray, freeze) import Data.Maybe(isJust,fromJust) import Data.List(partition,(\\)) import qualified Data.Set as Set import qualified Data.Map as Map \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Collecting information} In the Data.Graph library, a graph is represented as |Array Vertex [Vertex]|, mapping each vertex to a list of adjacent vertices. A |Vertex| is simply encoded by an |Int|. So to test whether an edge |(x,y)| belongs to |g| we can evaluate |y `elem` g!x| For more efficiency, we use Maps instead of lists. Sets would also have done, but we also want to each edge to have a path as a witness. Moreover, as we will mostly be adding edges to the graph, we use a mutable array. If we want to use any of the library functions, we can convert our representation by |fmap Map.keys . freeze|. \begin{code} type Graph = Array Vertex [Vertex] type MGraph = Array Vertex (Map.Map Vertex Path) type MMGraph s = STArray s Vertex (Map.Map Vertex Path) singleStep :: (Vertex->Vertex->PathStep) -> Edge -> EdgePath singleStep f e@(s,t) = (e, [f s t]) \end{code} We can add an edge to a graph, or remove it. These functions return whether they did something (resp. addition or removal) or not. hasEdge only checks whether a graph contains an edge or not. \begin{code} addEdge :: MMGraph s -> EdgePath -> ST s Bool addEdge graph ((s,t),p) = do m <- readArray graph s let b = not (Map.member t m) when b (writeArray graph s (Map.insert t p m)) return b hasEdge :: MMGraph s -> EdgePath -> ST s Bool hasEdge graph ((s,t),_) = do m <- readArray graph s return (Map.member t m) \end{code} The first step is to assign a number to all attributes, and a different one to all attribute occurrences. We create an array mapping the numbers to the information about the attribute occurrences (|ruleTable|), so we can look up this information in $O(1)$ time. We also build mappings from attributes to their occurrences (|tdsToTdp|) and vice versa (|tdpToTds|). |LMH| indicates the division of the attributes - an element |(l,m,h) `elem` LMH| means that vertices |i, l <= i <= h| are attributes of the same nonterminal, with vertices |j, l <= j < m| being inherited and |k, m <= k <= h| being synthesized attributes. See the |SequentialTypes.Info| and |SequentialTypes.LMH| Then we collect the direct dependencies, using the integer representations. This list of tuples (edges in the dependency graph) all information that is collected is passed to a function that will compute the interfaces and visit sub-sequences. We cannot do this computation in AG, because mutable arrays require the ST monad, which cannot be used inside AG. Now we can build a graph for attributes, and a graph for ao's, and add the direct dependencies to the ao graph. Like Pennings we will call the attribte graph Tds (transitive dependencies of symbols), and the ao-graph Tdp (transitive dependencies of productions). Unlike him, we will have only one Tds and one Tdp graph. In |STGraph|, we can lookup outgoing edges in |O(1)| time, but looking up incoming edges will take |O(e)| time, where |e| is the number of edges in the graph. As we will be doing this quite often it is worthwhile to keep both Tdp and its transposed version. The computation will involve both Tds and Tdp. It treats specially. TODO elaborate on that. \begin{code} type Tdp s = (MMGraph s, MMGraph s) type Tds s = MMGraph s type Comp s = (Tds s, Tdp s) \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Generating IDS} As we insert edges into Tdp we keep it transitively closed, so every time we add the edge $(s,t)$ to V, we also add the edges $\{ (r,t) || (r,s) \in V \}$ and $\{ (s,u) || (t,u) \in V \}$. \begin{code} insertTdp :: Info -> Comp s -> EdgePath -> ST s () insertTdp info comp@(_,(tdpN,tdpT)) e@((s,t),ee) -- how to insert an edge (s,t): = do b <- hasEdge tdpN e -- if it's not yet present unless b (do rs <- readArray tdpT s -- find all sources r for an edge to s us <- readArray tdpN t -- find all targets u for an edge from t let edges = e :[ ((r,t),er++ee ) | (r,er) <- Map.toList rs ] ++ [ ((s,u), ee++eu) | (u,eu) <- Map.toList us ] ++ [ ((r,u),er++ee++eu) | (r,er) <- Map.toList rs, (u,eu) <- Map.toList us ] mapM_ (addTdpEdge info comp) edges -- and add all of them, without having to bother about transitive closure anymore ) \end{code} Edges in |Tdp| can induce edges in |Tds|, so whenever we add an edge, we also add the induced edge if necessary \begin{code} addTdpEdge :: Info -> Comp s -> EdgePath -> ST s () -- how to add an edge (s,t) when not having to bother about the transitive closure: addTdpEdge info comp@(_,(tdpN,tdpT)) e@((s,t),ee) = do b <- addEdge tdpN e -- add it to the normal graph when b -- if it was a new edge (do addEdge tdpT ((t,s),ee) -- also add it to the transposed graph let u = tdpToTds info ! s -- find the corresponding attributes... v = tdpToTds info ! t nonlocal = u /= -1 && v /= -1 equalfield = isEqualField (ruleTable info ! s) (ruleTable info ! t) when (nonlocal && equalfield) -- ...and when necessary... (insertTds info comp ((u,v),ee)) -- ...insert it to the Tds graph ) \end{code} Inserting edges into |Tds| will insert edges between the occurrences of the attributes into |Tdp|. \begin{code} insertTds :: Info -> Comp s -> EdgePath -> ST s () insertTds info comp@(tds,_) e@((u,v),ee) = do b <- addEdge tds e when b (mapM_ (insertTdp info comp) [ ( (s,t), [AttrStep u v] ) | s <- tdsToTdp info ! u , not (getIsIn (ruleTable info ! s)) -- inherited at LHS, or synthesized at RHS , t <- tdsToTdp info ! v , getIsIn (ruleTable info ! t) -- synthesized at LHS, or inherited at RHS , isEqualField (ruleTable info ! s) (ruleTable info ! t) ] ) \end{code} If we add the direct dependencies to the Tdp graph in the way above, the Tds graph is filled with IDS. Below is a way to only build up the Tdp graph, without reflect the changes in the Tds graph. \begin{code} simpleInsert :: Tdp s -> EdgePath -> ST s () simpleInsert tdp@(tdpN,tdpT) e@((s,t),ee) = do b <- hasEdge tdpT ((t,s),undefined) unless b (do rs <- readArray tdpT s us <- readArray tdpN t let edges = e :[ ((r,t),er++ee ) | (r,er) <- Map.toList rs ] ++ [ ((s,u), ee++eu) | (u,eu) <- Map.toList us ] ++ [ ((r,u),er++ee++eu) | (r,er) <- Map.toList rs, (u,eu) <- Map.toList us ] mapM_ (addSimpleEdge tdp) edges ) addSimpleEdge :: Tdp s -> EdgePath -> ST s () addSimpleEdge (tdpN,tdpT) e@((s,t),ee) = do b <- addEdge tdpN e when b (do addEdge tdpT ((t,s),ee) return () ) \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Interfaces} In absence of cycles we can find the interfaces. We only take attributes that are used. When an attribute has no incoming edges it can be computed. As the emphasis is on incoming edges, we will work with the transposed Tds graph. The funtion |used| indicates which vertices are included in the interfaces. See modules Interfaces and InterfacesRules for more information. %format sem_IRoot_IRoot = "sem_{IRoot}" %format sem_Interface_Interface = "sem_{Interface}" %format sem_Interfaces_Cons = ":_{Interfaces}" %format sem_Interfaces_Nil = "[]_{Interfaces}" %format sem_Segments_Cons = ":_{Segments}" %format sem_Segments_Nil = "[]_{Segments}" \begin{code} makeInterfaces :: Info -> Graph -> T_IRoot makeInterfaces info tds = let interslist = reverse . makeInterface tds [] mkSegments = foldr (sem_Segments_Cons . uncurry sem_Segment_Segment) sem_Segments_Nil . interslist mkInter ((nt,cons),lmh) = sem_Interface_Interface nt cons (mkSegments lmh) inters = foldr (sem_Interfaces_Cons . mkInter) sem_Interfaces_Nil (zip (nonts info) (lmh info)) in sem_IRoot_IRoot inters \end{code} The sinks of a graph are those vertices that have no outgoing edges. We define a function that determines whether a vertex is a sink if a set |del| of vertices had been removed from the graph. This means that the attribute can be computed if all attributes in |del| have been computed. \begin{code} isSink :: Graph -> [Vertex] -> Vertex -> Bool isSink graph del v = null (graph ! v \\ del) \end{code} Now we can make interfaces by taking inherited sinks and synthesized sinks alternatively. If there are no synthesized attributes at all, generate an interface with one visit computing nothing. \begin{code} makeInterface :: Graph -> [Vertex] -> LMH -> [([Vertex],[Vertex])] makeInterface tds del (l,m,h) | m > h = [([],[])] | otherwise = let syn = filter (isSink tds del) ([m..h] \\ del) del' = del ++ syn inh = filter (isSink tds del') ([l..(m-1)] \\ del') del'' = del' ++ inh rest = makeInterface tds del'' (l,m,h) in if null inh && null syn then [] else (inh,syn) : rest \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Detecting of cycles} We only want to return s2i edges. \begin{code} findCycles :: Info -> MGraph -> [EdgePaths] findCycles info tds = [ ((u,v),p1,p2) | (l,m,h) <- lmh info -- for every nonterminal: [l..m-1] are inherited, [m..h] are synthesized , v <- [m..h] -- for every synthesized attribute , (u,p1) <- Map.toList (tds ! v) -- find dependent attributes... , l <= u, u < m -- ...that are inherited... , let mbp2 = Map.lookup v (tds ! u) -- ...and have a cycle back , isJust mbp2 , let p2 = fromJust mbp2 ] findLocCycles :: MGraph -> [EdgePath] findLocCycles tdp = let (low, high) = bounds tdp in [ ((u,u),p) | u <- [low..high] , (v,p) <- Map.toList (tdp ! u) , v==u ] findInstCycles :: [Edge] -> MGraph -> [EdgePath] findInstCycles instToSynEdges tdp = [ ((i,s), fromJust mbp) | (i, s) <- instToSynEdges , let mbp = Map.lookup i (tdp ! s) , isJust mbp ] \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Tying it together} \begin{code} generateVisits :: Info -> MGraph -> MGraph -> [Edge] -> (CInterfaceMap, CVisitsMap, [Edge]) generateVisits info tds tdp dpr = let inters = makeInterfaces info (fmap Map.keys tds) inhs = Inh_IRoot{ info_Inh_IRoot = info , tdp_Inh_IRoot = fmap Map.keys tdp , dpr_Inh_IRoot = dpr } iroot = wrap_IRoot inters inhs in (inters_Syn_IRoot iroot, visits_Syn_IRoot iroot, edp_Syn_IRoot iroot) reportLocalCycle :: MGraph -> [EdgePath] -> [[Vertex]] reportLocalCycle tds cyc = fst (foldr f ([],Set.empty) (map (edgePathToEdgeRoute tds) cyc)) where f ((x,_),p) res@(paths,syms) | Set.member x syms = res -- don't report a cyclic vertex if it appears on a path of an earlier reported one | otherwise = (p:paths, Set.union syms (Set.fromList p)) reportCycle :: Info -> MGraph -> [EdgePaths] -> [EdgeRoutes] reportCycle info tds cyc = fst (foldr f ([],Set.empty) (map (edgePathsToEdgeRoutes tds) cyc)) where f epp@((x,y),p1,p2) res@(paths,syms) | Set.member x syms && Set.member y syms = res -- don't report mutually dependent vertices if both appear on paths reported earlier | otherwise = (epp:paths, Set.union syms (Set.fromList (map tdp2tds (p1++p2)))) tdp2tds (-2) = -2 tdp2tds v = tdpToTds info ! v edgePathsToEdgeRoutes :: MGraph -> EdgePaths -> EdgeRoutes edgePathsToEdgeRoutes tds (e,p1,p2) = ( e, pathToRoute tds p1, pathToRoute tds p2 ) edgePathToEdgeRoute :: MGraph -> EdgePath -> EdgeRoute edgePathToEdgeRoute tds (e,p) = ( e, pathToRoute tds p ) pathToRoute :: MGraph -> Path -> Route pathToRoute tds p = convertPath (expandAll p) where expandAll :: Path -> Path expandAll p | hasAttrStep p = expandAll (expandOne p) | otherwise = p expandOne :: Path -> Path expandOne p = shortcut (concatMap expandStep p) expandStep :: PathStep -> Path expandStep (AttrStep u v) = fromJust (Map.lookup v (tds!u)) expandStep x = [x] convertPath :: Path -> Route convertPath p = concatMap convertStep p convertStep :: PathStep -> Route convertStep (AtOcStep s t) = [s,t] convertStep (AttrIndu s t) = [-2,-2] hasAttrStep :: Path -> Bool hasAttrStep [] = False hasAttrStep (AttrStep _ _ : _ ) = True hasAttrStep (_ : xs) = hasAttrStep xs shortcut :: Eq a => [a] -> [a] shortcut [] = [] shortcut (x:xs) = x : shortcut (removeBefore x xs) removeBefore :: Eq a => a -> [a] -> [a] removeBefore x ys = reverse (takeWhile (/=x) (reverse ys)) isLocLoc :: Table CRule -> EdgePath -> Bool isLocLoc rt ((s,t),_) = isLocal (rt ! s) && isLocal (rt ! t) -- || (isInst (rt ! s) && isInst (rt ! t)) computeSequential :: Info -> [Edge] -> [Edge] -> CycleStatus computeSequential info dpr instToSynEdges = runST (do let bigBounds = bounds (tdpToTds info) smallBounds = bounds (tdsToTdp info) (ll,es) = partition (isLocLoc (ruleTable info)) (map (singleStep AtOcStep) (dpr ++ instToSynEdges)) tds <- newArray smallBounds Map.empty tdpN <- newArray bigBounds Map.empty tdpT <- newArray bigBounds Map.empty let tdp = (tdpN,tdpT) comp = (tds,tdp) mapM_ (simpleInsert tdp) ll -- insert the local dependencies tdp1 <- freeze tdpN let cyc1 = findLocCycles tdp1 if not (null cyc1) -- are they cyclic? then do return (LocalCycle (reportLocalCycle undefined cyc1)) -- then report an error. else do mapM_ (insertTdp info comp) es -- insert the other dependencies tds2 <- freeze tds let cyc2 = findCycles info tds2 if not (null cyc2) -- are they cyclic? then do return (DirectCycle (reportCycle info tds2 cyc2)) -- then report an error. else do tdp2 <- freeze tdpN let cyc4 = findInstCycles instToSynEdges tdp2 if not (null cyc4) then do return (InstCycle (reportLocalCycle tds2 cyc4)) -- then report an error. else do let (cim,cvm,edp) = generateVisits info tds2 tdp2 dpr mapM_ (insertTds info comp) (map (singleStep AttrIndu) edp) -- insert dependencies induced by visit scheduling tds3 <- freeze tds let cyc3 = findCycles info tds3 if not (null cyc3) -- are they cyclic? then return (InducedCycle cim (reportCycle info tds3 cyc3)) -- then report an error. else do tdp3 <- freeze tdpN let cyc5 = findInstCycles instToSynEdges tdp3 if not (null cyc5) then do return (InstCycle (reportLocalCycle tds3 cyc5)) -- then report an error. else do return (CycleFree cim cvm) -- otherwise we succeed. ) \end{code} \end{document} uuagc-0.9.52.2/src/CommonTypes.hs0000644000000000000000000002325413433540502014646 0ustar0000000000000000module CommonTypes (module Options, module CommonTypes) where import Options import UU.Scanner.Position(Pos) import qualified Data.Map as Map import Data.Map(Map) import Data.Set(Set) import qualified Data.Set as Set import Data.Monoid(mappend,Monoid) import Data.Char import Pretty type Blocks = Map BlockInfo [([String], Pos)] type BlockInfo = (BlockKind, Maybe NontermIdent) data BlockKind = BlockImport | BlockPragma | BlockMain | BlockData | BlockRec | BlockOther deriving (Eq, Ord, Show) instance PP Identifier where pp = text . getName data Type = Haskell String | NT Identifier [String] Bool -- True: deforested nonterminal, False: nonterminal type | Self -- reference to the enclosing nonterminal type deriving (Eq) data ComplexType = List Type | Tuple [(Identifier, Type)] | Maybe Type | Either Type Type | Map Type Type | IntMap Type | OrdSet Type | IntSet instance Show ComplexType where show (List t ) = "[" ++ show t ++ "]" show (Tuple ts) = "(" ++ showList [ show n ++ ": " ++ show t | (n,t) <- ts ] "" ++ ")" show (Maybe t ) = "Maybe " ++ show t show (Either t1 t2) = "Either " ++ show t1 ++ " " ++ show t2 show (Map t1 t2) = "Map " ++ show t1 ++ " " ++ show t2 show (IntMap t1) = "IntMap " ++ show t1 show (OrdSet t1) = "Set" ++ show t1 show IntSet = "IntSet" instance Show Type where show = typeToHaskellString Nothing [] type Attributes = Map Identifier Type type TypeSyns = [(NontermIdent,ComplexType)] type ParamMap = Map NontermIdent [Identifier] type AttrNames = [(Identifier,Type,(String,String,String))] type UseMap = Map NontermIdent (Map Identifier (String,String,String)) type PragmaMap = Map NontermIdent (Map ConstructorIdent (Set Identifier)) type AttrMap = Map NontermIdent (Map ConstructorIdent (Set (Identifier,Identifier))) type UniqueMap = Map NontermIdent (Map ConstructorIdent (Map Identifier Identifier)) type Derivings = Map NontermIdent (Set Identifier) type ClassContext = [(Identifier, [String])] type ContextMap = Map NontermIdent ClassContext type QuantMap = Map NontermIdent [String] type Strings = [String] type ConstructorIdent = Identifier type AttrOrderMap = Map NontermIdent (Map ConstructorIdent (Set Dependency)) type VisitIdentifier = Int type StateIdentifier = Int data Dependency = Dependency Occurrence Occurrence deriving (Eq,Ord,Show) data Occurrence = OccAttr Identifier Identifier | OccRule Identifier deriving (Eq,Ord,Show) data ConstructorType = DataConstructor | RecordConstructor deriving (Eq,Ord,Show) type AttrEnv = ( [Identifier] , [(Identifier,Identifier)] ) nullIdent, _LHS, _SELF, _LOC, _INST, _INST', _FIELD, _FIRST, _LAST :: Identifier nullIdent = identifier "" _LHS = identifier "lhs" _SELF = identifier "SELF" _LOC = identifier "loc" _INST = identifier "inst" _INST' = identifier "inst'" _FIELD = identifier "field" _FIRST = identifier "first__" _LAST = identifier "last__" idLateBindingAttr :: Identifier idLateBindingAttr = identifier "lateSemDict" lateBindingTypeNm :: String -> String lateBindingTypeNm modNm = "Late_" ++ modNm ++ "_" lateBindingFieldNm :: String -> String lateBindingFieldNm modNm = "late_" ++ modNm ++ "_" lateBindingType :: String -> Type lateBindingType modNm = Haskell (lateBindingTypeNm modNm) lateSemNtLabel :: NontermIdent -> String lateSemNtLabel nt = "mk_" ++ getName nt lateSemConLabel :: NontermIdent -> ConstructorIdent -> String lateSemConLabel nt con = "mk_" ++ getName nt ++ "_" ++ getName con sdtype :: NontermIdent -> String sdtype nt = "T_"++getName nt mkNtType :: Identifier -> [String] -> Type mkNtType nt args | take 2 (getName nt) == "T_" = let nt' = Ident (drop 2 (getName nt)) (getPos nt) in NT nt' args True | otherwise = NT nt args False cataname :: String -> Identifier -> String cataname pre name = pre++getName name conname :: Bool -> NontermIdent -> ConstructorIdent -> String conname ren nt con | ren = capitalize (getName nt) ++ "_" ++ getName con | otherwise = getName con capitalize :: String -> String capitalize [] = [] capitalize (c:cs) = toUpper c : cs semname :: String -> NontermIdent -> ConstructorIdent -> String semname pre nt con = pre ++ (getName nt ++ "_" ++ getName con) recordFieldname :: NontermIdent -> ConstructorIdent -> Identifier -> String recordFieldname nt con nm = getName nm ++ "_" ++ getName nt ++ "_" ++ getName con lhsname :: Options -> Bool -> Identifier -> String lhsname opts isIn = attrname opts isIn _LHS attrname :: Options -> Bool -> Identifier -> Identifier -> String attrname opts isIn field attr | field == _LOC = locname opts attr | field == _INST = instname attr | field == _INST' = inst'name attr | field == _FIELD = fieldname attr | otherwise = let direction | isIn = "I" | otherwise = "O" pref = if clean opts then 'a' else '_' in pref : getName field ++ direction ++ getName attr locname :: Options -> Identifier -> String locname opts v = (if clean opts then 'l' else '_') : getName v instname, inst'name, fieldname :: Identifier -> String instname v = getName v ++ "_val_" inst'name v = getName v ++ "_inst_" fieldname v = getName v++"_" typeToAGString :: Type -> String typeToAGString tp = case tp of Haskell t -> t NT nt tps for -> formatNonterminalToHaskell for (getName nt) (map (\s -> "{" ++ s ++ "}") tps) Self -> error "Self type is not allowed here." removeDeforested :: Type -> Type removeDeforested (NT nt args _) = NT nt args False removeDeforested tp = tp forceDeforested :: Type -> Type forceDeforested (NT nt args _) = NT nt args True forceDeforested tp = tp typeToHaskellString :: Maybe NontermIdent -> [String] -> Type -> String typeToHaskellString mbNt params tp = case tp of Haskell t -> filter (/= '@') t -- Apparently haskell types can contain @ to refer to -- a type parameter, removing @ makes it backwards compatible NT nt tps for | nt == _SELF -> formatNonterminalToHaskell for (maybe "?SELF?" getName mbNt) params | otherwise -> formatNonterminalToHaskell for (getName nt) tps Self -> maybe "?SELF?" getName mbNt formatNonterminalToHaskell :: Bool -> String -> [String] -> String formatNonterminalToHaskell for nt tps = unwords ((pref ++ nt) : tps) where pref | for = "T_" | otherwise = "" ind :: String -> String ind s = replicate 3 ' ' ++ s _NOCASE :: Identifier _NOCASE = identifier "nocase" hasPragma :: PragmaMap -> NontermIdent -> ConstructorIdent -> Identifier -> Bool hasPragma mp nt con nm = nm `Set.member` Map.findWithDefault Set.empty con (Map.findWithDefault Map.empty nt mp) isNonterminal :: Type -> Bool isNonterminal (NT _ _ _) = True isNonterminal _ = False isSELFNonterminal :: Type -> Bool -- isSELFNonterminal (NT nt _ _) | nt == _SELF = True isSELFNonterminal Self = True isSELFNonterminal _ = False extractNonterminal :: Type -> NontermIdent extractNonterminal (NT n _ _) = n extractNonterminal _ = error "Must be NT" nontermArgs :: Type -> [String] nontermArgs tp = case tp of NT _ args _ -> args _ -> [] deforestedNt :: Identifier -> Maybe Identifier deforestedNt nm | take 2 (getName nm) == "T_" = Just (Ident (drop 2 (getName nm)) (getPos nm)) | otherwise = Nothing data StateCtx = NoneVis | OneVis !Int | ManyVis deriving (Eq, Show, Ord) data ChildKind = ChildSyntax -- This child is defined by syntax | ChildAttr -- This child is defined by an attribute | ChildReplace Type -- This child replaces a child with type Type deriving (Eq, Show) -- Given a map that represents a relation, returns the transitive closure of this relation closeMap :: Ord a => Map a (Set a) -> Map a (Set a) closeMap mp0 = close (Map.keysSet mp0) mp0 where rev = revDeps mp0 close todo mp0' = case Set.minView todo of Nothing -> mp0' Just (k, todo1) -> let find x = Map.findWithDefault Set.empty x mp0' vals0 = find k valsL = Set.toList vals0 vals1 = foldr Set.union vals0 $ map find valsL in if Set.size vals0 == Set.size vals1 then close todo1 mp0' -- note: monotonically increasing set else let mp1 = Map.insert k vals1 mp0' refs = Map.findWithDefault Set.empty k rev todo2 = Set.union refs todo1 in close todo2 mp1 revDeps :: Ord a => Map a (Set a) -> Map a (Set a) revDeps mp = Map.fromListWith Set.union [ (a,Set.singleton k) | (k,s) <- Map.assocs mp, a <- Set.toList s ] data HigherOrderInfo = HigherOrderInfo { hoNtDeps :: Set NontermIdent , hoNtRevDeps :: Set NontermIdent , hoAcyclic :: Bool } data VisitKind = VisitPure Bool -- ordered or not | VisitMonadic deriving (Eq,Ord) isLazyKind :: VisitKind -> Bool isLazyKind (VisitPure False) = True isLazyKind _ = False instance Show VisitKind where show (VisitPure False) = "Lazy" show (VisitPure True) = "Ordered" show VisitMonadic = "Monadic" unionWithMappend :: (Monoid a, Ord k) => Map k a -> Map k a -> Map k a unionWithMappend = Map.unionWith mappend data FormatMode = FormatDo | FormatLetDecl | FormatLetLine deriving (Eq, Ord, Show) uuagc-0.9.52.2/src/RhsCheck.hs0000644000000000000000000000432013433540502014054 0ustar0000000000000000module RhsCheck(checkRhs,checkBlock,checkTy) where import Language.Haskell.Exts (parseExpWithMode, parseModuleWithMode, parseTypeWithMode, srcLine, srcColumn, srcFilename, baseFixities, glasgowExts, ParseMode (..), defaultParseMode, ParseResult (..), Extension (..)) import ErrorMessages import Expression import HsToken import UU.Scanner.Position checkRhs,checkBlock,checkTy :: Expression -> Errors checkRhs = check parseExpWithMode checkBlock = check parseModuleWithMode checkTy = check parseTypeWithMode check :: (ParseMode -> String -> ParseResult a) -> Expression -> Errors check p (Expression pos tks) = case res of ParseOk _ -> [] ParseFailed loc msg -> let pos' = Pos (srcLine loc + line pos - 1) (srcColumn loc) (srcFilename loc) in [HsParseError pos' msg] where pos0 = Pos (line pos) 1 (file pos) str = toString pos0 tks res = p mode str bf = case baseFixities of [] -> Nothing xs -> Just xs mode = defaultParseMode { parseFilename = file pos, ignoreLanguagePragmas = False, extensions = exts , ignoreLinePragmas = False, fixities = bf } exts :: [Extension] exts = glasgowExts toString :: Pos -> HsTokens -> String toString _ [] = "" toString cPos (tk:tks) = move ++ current ++ next where tkPos = getPos tk move = addSpacing (line tkPos - line cPos) (column cPos) (column tkPos) current = fmt tk nPos = upd tkPos current next = toString nPos tks getPos :: HsToken -> Pos getPos (AGLocal _ pos _) = pos getPos (AGField _ _ pos _) = pos getPos (HsToken _ pos) = pos getPos (CharToken _ pos) = pos getPos (StrToken _ pos) = pos getPos (Err _ pos) = pos fmt :: HsToken -> String fmt (AGLocal var _ _) = "_" ++ show var fmt (AGField field attr _ _) = "_" ++ show field ++ "_" ++ show attr fmt (HsToken val _) = val fmt (CharToken val _) = show val fmt (StrToken val _) = show val fmt (Err val _) = val upd :: Pos -> String -> Pos upd p s = foldl adv p s addSpacing :: Int -> Int -> Int -> String addSpacing l c1 c2 = replicate l '\n' ++ replicate c ' ' where c | l == 0 = c2 - c1 | otherwise = c2 - 1 uuagc-0.9.52.2/src/Pretty.hs0000644000000000000000000001202313433540502013650 0ustar0000000000000000------------------------------------------------------------------------- -- Subset of UU.Pretty, based on very simple pretty printing -- Extended with line-nr tracking ------------------------------------------------------------------------- module Pretty ( PP_Doc, PP(..) , disp , (>|<), (>-<) , (>#<) , ppWithLineNr , hlist, vlist, hv , fill , indent , pp_block , vlist_sep , pp_parens , pp_braces , hv_sp , empty, empty1, text , isEmpty ) where import Data.List(intersperse) ------------------------------------------------------------------------- -- Doc structure ------------------------------------------------------------------------- data Doc = Emp | Emp1 | Str !String -- basic string | Hor Doc !Doc -- horizontal positioning | Ver Doc !Doc -- vertical positioning | Ind !Int Doc -- indent | Line (Int -> Doc) -- line nr type PP_Doc = Doc ------------------------------------------------------------------------- -- Basic combinators ------------------------------------------------------------------------- infixr 3 >|<, >#< infixr 2 >-< (>|<) :: (PP a, PP b) => a -> b -> PP_Doc l >|< r = pp l `Hor` pp r (>-<) :: (PP a, PP b) => a -> b -> PP_Doc l >-< r | isEmpty a = b | isEmpty b = a | otherwise = a `Ver` b where a = pp l b = pp r (>#<) :: (PP a, PP b) => a -> b -> PP_Doc l >#< r | isEmpty a = b | isEmpty b = a | otherwise = a >|< " " >|< b where a = pp l b = pp r indent :: PP a => Int -> a -> PP_Doc indent i d = Ind i $ pp d text :: String -> PP_Doc text s = let ls = lines s ls' | null ls = [""] | otherwise = ls in vlist (map Str ls') empty :: PP_Doc empty = Emp -- empty1 is not a zero for >#< empty1 :: PP_Doc empty1 = Emp1 ppWithLineNr :: PP a => (Int -> a) -> PP_Doc ppWithLineNr f = Line (pp . f) ------------------------------------------------------------------------- -- Derived combinators ------------------------------------------------------------------------- hlist, vlist :: PP a => [a] -> PP_Doc vlist [] = empty vlist as = foldr (>-<) empty as hlist [] = empty hlist as = foldr (>|<) empty as hv :: PP a => [a] -> PP_Doc hv = vlist hv_sp :: PP a => [a] -> PP_Doc hv_sp = foldr (>#<) empty fill :: PP a => [a] -> PP_Doc fill = hlist pp_block:: (PP a, PP b, PP c) => a -> b -> c -> [PP_Doc] -> PP_Doc pp_block o c s as = pp o >|< hlist (intersperse (pp s) as) >|< pp c pp_parens :: PP a => a -> PP_Doc pp_parens p = '(' >|< p >|< ')' pp_braces :: PP a => a -> PP_Doc pp_braces p = '{' >-< p >-< '}' vlist_sep :: (PP a, PP b) => a -> [b] -> PP_Doc vlist_sep sep lst = vlist (intersperse (pp sep) (map pp lst)) ------------------------------------------------------------------------- -- PP class ------------------------------------------------------------------------- class Show a => PP a where pp :: a -> PP_Doc pp = text . show ppList :: [a] -> PP_Doc ppList as = hlist as instance PP Doc where pp = id instance PP Char where pp c = text [c] ppList = text instance PP a => PP [a] where pp = ppList instance Show Doc where show p = disp p 200 "" instance PP Int where pp = text . show instance PP Float where pp = text . show ------------------------------------------------------------------------- -- Observation ------------------------------------------------------------------------- isEmpty :: PP_Doc -> Bool isEmpty Emp = True isEmpty Emp1 = False isEmpty (Ver d1 d2) = isEmpty d1 && isEmpty d2 isEmpty (Hor d1 d2) = isEmpty d1 && isEmpty d2 isEmpty (Ind _ d ) = isEmpty d isEmpty _ = False ------------------------------------------------------------------------- -- Rendering ------------------------------------------------------------------------- disp :: PP_Doc -> Int -> ShowS disp d0 _ s0 = r where (r,_,_) = put 0 1 d0 s0 put p l d s = case d of Emp -> (s,p,l) Emp1 -> (s,p,l) Str s' -> (s' ++ s,p + length s',l) Ind i d1 -> (ind ++ r',p', l') where (r',p',l') = put (p+i) l d1 s ind = replicate i ' ' Hor d1 d2 -> (r1,p2,l2) where (r1,p1,l1) = put p l d1 r2 (r2,p2,l2) = put p1 l1 d2 s Ver d1 d2 | isEmpty d1 -> put p l d2 s Ver d1 d2 | isEmpty d2 -> put p l d1 s Ver d1 d2 -> (r1,p2,l2) where (r1,_ ,l1) = put p l d1 $ "\n" ++ ind ++ r2 (r2,p2,l2) = put p (l1+1) d2 s ind = replicate p ' ' Line f -> (r',p',l') where (r',p',l') = put p l (f l) s uuagc-0.9.52.2/src/SequentialTypes.hs0000644000000000000000000001632213433540502015526 0ustar0000000000000000module SequentialTypes where import CodeSyntax import CommonTypes import Data.Array(Array) import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set import Data.Maybe(fromJust) import Data.List(partition) type Vertex = Int data PathStep = AttrStep Vertex Vertex | AtOcStep Vertex Vertex | AttrIndu Vertex Vertex deriving (Show, Eq) type Path = [PathStep] type Route = [Vertex] type Edge = (Int,Int) type EdgePath = (Edge,Path) type EdgePaths = (Edge,Path,Path) type EdgeRoute = (Edge,Route) type EdgeRoutes= (Edge,Route,Route) type Table a = Array Vertex a data ChildVisit = ChildVisit Identifier Identifier Int [Vertex] [Vertex] deriving (Eq,Show) -- field, rhs nt, visit nr., inh, syn data NTAttr = NTAInh NontermIdent Identifier Type -- nt, attribute, type | NTASyn NontermIdent Identifier Type -- nt, attribute, type deriving Show getNtaNameType :: NTAttr -> (Identifier, Type) getNtaNameType (NTAInh _ name tp) = (name,tp) getNtaNameType (NTASyn _ name tp) = (name,tp) getAttr :: CRule -> Identifier getAttr (CRule name _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) = name getAttr _ = error "Only defined for CRule" getIsIn :: CRule -> Bool getIsIn (CRule _ ii _ _ _ _ _ _ _ _ _ _ _ _ _ _) = ii getIsIn _ = error "Only defined for CRule" getHasCode :: CRule -> Bool getHasCode (CRule _ _ hc _ _ _ _ _ _ _ _ _ _ _ _ _) = hc getHasCode _ = error "Only defined for CRule" getLhsNt :: CRule -> NontermIdent getLhsNt (CRule _ _ _ nt _ _ _ _ _ _ _ _ _ _ _ _) = nt getLhsNt _ = error "Only defined for CRule" getCon :: CRule -> ConstructorIdent getCon (CRule _ _ _ _ con _ _ _ _ _ _ _ _ _ _ _) = con getCon _ = error "Only defined for CRule" getField :: CRule -> Identifier getField (CRule _ _ _ _ _ field _ _ _ _ _ _ _ _ _ _) = field getField _ = error "Only defined for CRule" getRhsNt :: CRule -> Maybe NontermIdent getRhsNt (CRule _ _ _ _ _ _ childnt _ _ _ _ _ _ _ _ _) = childnt getRhsNt _ = error "Only defined for CRule" getType :: CRule -> Maybe Type getType (CRule _ _ _ _ _ _ _ tp _ _ _ _ _ _ _ _) = tp getType _ = error "Only defined for CRule" getDefines :: CRule -> Map Int (Identifier, Identifier, Maybe Type) getDefines (CRule _ _ _ _ _ _ _ _ _ _ defines _ _ _ _ _) = defines getDefines _ = error "Only defined for CRule" getUses :: CRule -> Set (Identifier, Identifier) getUses (CRule _ _ _ _ _ _ _ _ _ _ _ _ _ uses _ _) = uses getUses _ = error "Only defined for CRule" getExplicit :: CRule -> Bool getExplicit (CRule _ _ _ _ _ _ _ _ _ _ _ _ _ _ expl _) = expl getExplicit _ = error "Only defined for CRule" isLocal, isInst, isLhs, isRhs, isSyn, isInh, hasCode :: CRule -> Bool isLocal = (_LOC==) . getField isInst = (_INST==) . getField isLhs = (_LHS==) . getField isRhs cr = not (isLhs cr || isLocal cr) isSyn cr | isLocal cr = False | getIsIn cr = isRhs cr | otherwise = isLhs cr isInh = not . isSyn hasCode cr = isLocal cr || (isLhs cr && isInh cr) || (isRhs cr && isSyn cr) isEqualField, isDifferentField, isEqualCon, isRhsOfSameCon :: CRule -> CRule -> Bool isEqualField a b = isEqualCon a b && getField a == getField b isDifferentField a b = isEqualCon a b && getField a /= getField b isEqualCon a b = getLhsNt a == getLhsNt b && getCon a == getCon b isRhsOfSameCon a b = isEqualCon a b && isRhs a && isRhs b isSynAttr, isInhAttr :: NTAttr -> Bool isSynAttr (NTAInh _ _ _) = False isSynAttr (NTASyn _ _ _) = True isInhAttr = not . isSynAttr ntattr :: CRule -> Maybe NTAttr ntattr cr | isLocal cr = Nothing | isInst cr = Nothing -- an inst definition is just considered as a local attribute definition | otherwise = let at = if isSyn cr then NTASyn else NTAInh getNt cr' = if isRhs cr' then fromJust (getRhsNt cr') else getLhsNt cr' in Just (at (getNt cr) (getAttr cr) (fromJust (getType cr))) cRuleLhsInh :: Identifier -> NontermIdent -> ConstructorIdent -> Type -> CRule cRuleLhsInh attr nt con tp = CRule attr True False nt con _LHS Nothing (Just tp) (error "cRuleLhsInh") [] Map.empty False "" Set.empty False Nothing cRuleTerminal :: Identifier -> NontermIdent -> ConstructorIdent -> Type -> CRule cRuleTerminal attr nt con tp = CRule attr True False nt con _LOC Nothing (Just tp) (error ("cRuleTerminal: " ++ show (attr, nt, con, tp))) [] Map.empty False "" Set.empty False Nothing cRuleRhsSyn :: Identifier -> NontermIdent -> ConstructorIdent -> Type -> Identifier -> NontermIdent -> CRule cRuleRhsSyn attr nt con tp field childnt = CRule attr True False nt con field (Just childnt) (Just tp) (error ("cRuleRhsSyn: " ++ show (attr, nt, con, tp, field))) [] Map.empty False "" Set.empty False Nothing defaultRule :: Identifier -> NontermIdent -> ConstructorIdent -> Identifier -> CRule defaultRule attr nt con field = CRule attr (er 1) (er 2) nt con field (er 3) (er 4) (er 5) (er 6) (er 7) (er 8) (er 9) (er 10) False Nothing where er :: Int -> a er i = error ("Default rule has no code " ++ show i) instance Eq CRule where a == b = getAttr a == getAttr b && isEqualField a b instance Ord CRule where compare a b = compare (getLhsNt a) (getLhsNt b) >/< compare (getCon a) (getCon b) >/< compare (getField a) (getField b) >/< compare (getAttr a) (getAttr b) instance Eq NTAttr where (NTAInh _ _ _) == (NTASyn _ _ _) = False (NTASyn _ _ _) == (NTAInh _ _ _) = False (NTAInh nt name _) == (NTAInh nt' name' _) = nt == nt' && name == name' (NTASyn nt name _) == (NTASyn nt' name' _) = nt == nt' && name == name' instance Ord NTAttr where compare (NTAInh _ _ _) (NTASyn _ _ _) = LT compare (NTASyn _ _ _) (NTAInh _ _ _) = GT compare (NTAInh nt name _) (NTAInh nt' name' _) = compare nt nt' >/< compare name name' compare (NTASyn nt name _) (NTASyn nt' name' _) = compare nt nt' >/< compare name name' eqCRuleDefines :: CRule -> CRule -> Bool eqCRuleDefines a b = Map.keys (getDefines a) == Map.keys (getDefines b) (>/<) :: Ordering -> Ordering -> Ordering EQ >/< b = b a >/< _ = a eqClasses :: (a -> a -> Bool) -> [a] -> [[a]] eqClasses _ [] = [] eqClasses p (a:as) = let (isA,rest) = partition (p a) as in (a:isA):eqClasses p rest lhsshow :: Options -> NTAttr -> String lhsshow opts (NTAInh _ attr _) = lhsname opts True attr lhsshow opts (NTASyn _ attr _) = lhsname opts False attr rhsshow :: Options -> Identifier -> NTAttr -> String rhsshow opts field (NTAInh _ attr _) = attrname opts False field attr rhsshow opts field (NTASyn _ attr _) = attrname opts True field attr prettyCRule :: CRule -> String prettyCRule cr = let descr | isLocal cr = "local attribute " ++ show (getAttr cr) | otherwise = (if isSyn cr then "synthesized " else "inherited ") ++ "attribute " ++ (if isRhs cr then show (getField cr) ++ "." else "") ++ (if isLhs cr then "lhs." else "") ++ (show (getAttr cr)) in show (getLhsNt cr) ++ "." ++ show (getCon cr) ++ ", " ++ descr uuagc-0.9.52.2/src/Parser.hs0000644000000000000000000006231613433540502013627 0ustar0000000000000000module Parser where import Data.Maybe import UU.Parsing import UU.Parsing.Machine(RealParser(..),RealRecogn(..),anaDynE,mkPR) import ConcreteSyntax import CommonTypes import Patterns import UU.Pretty(text,PP_Doc,empty,(>-<)) import TokenDef import Data.List (intersperse) import Data.Char import Scanner (Input(..),scanLit,input) import System.FilePath import Data.List import Expression import Macro --marcos import UU.Scanner.Token import UU.Scanner.TokenParser import UU.Scanner.GenToken import UU.Scanner.GenTokenOrd import UU.Scanner.GenTokenParser import UU.Scanner.Position import UU.Scanner.TokenShow() import System.Directory import System.FilePath import HsTokenScanner import Options import Scanner(lowercaseKeywords) type AGParser = AnaParser Input Pair Token Pos pIdentifier, pIdentifierU, pIdentifierExcl :: AGParser Identifier pIdentifierU = uncurry Ident <$> pConidPos -- Jeroen (3-10-2012): for some reason using pKeywordAsIdent -- drastically slows down parsing of some of my AG files, as -- in: I thought there was some infinite loop in there, but I -- guess that eventually it could have given an answer. So -- probably this does generate a lot of ambiguity. pIdentifier = pIdentifierExcl -- <|> pKeywordAsIdent pIdentifierExcl = uncurry Ident <$> pVaridPos -- see Scanner.lowercaseKeywords for the list of keywords that may -- be used as an identifier. To prevent ambiguities, it's probably -- sufficient when the keyword is always followed by a token that -- can never follow an identifier for any possible prefix. pKeywordAsIdent :: AGParser Identifier pKeywordAsIdent = pAny (\nm -> Ident nm <$> pKeyPos nm) lowercaseKeywords parseAG :: Options -> [FilePath] -> String -> IO (AG,[Message Token Pos]) parseAG opts searchPath file = do (es,_,_,_,mesg) <- parseFile False opts searchPath file return (AG es, mesg) --marcos parseAGI :: Options -> [FilePath] -> String -> IO (AG, Maybe String) parseAGI opts searchPath file = do (es,_,_,ext,_) <- parseFile True opts searchPath file return (AG es, ext) depsAG :: Options -> [FilePath] -> String -> IO ([String], [Message Token Pos]) depsAG opts searchPath file = do let fn = normalise file (_,_,fs,_,mesgs) <- parseFile False opts searchPath fn return (filter (/= fn) fs, mesgs) -- marcos: added the parameter 'agi' and the 'ext' part parseFile :: Bool -> Options -> [FilePath] -> String -> IO ([Elem],[String],[String], Maybe String,[Message Token Pos ]) parseFile = parseFile' [] parseFile' :: [String] -> Bool -> Options -> [FilePath] -> String -> IO ([Elem],[String],[String], Maybe String,[Message Token Pos ]) parseFile' parsedfiles agi opts searchPath filename = do file <- normalise `fmap` resolveFile opts searchPath filename if file `elem` parsedfiles then return ([], [], parsedfiles, Nothing, []) else do txt <- readFile file let searchPath' = takeDirectory file : searchPath -- search first relative to the including file litMode = ".lag" `isSuffixOf` file (files,text) = if litMode then scanLit txt else ([],txt) tokens = input opts (initPos file) text steps = parse (pElemsFiles agi) tokens stop (_,fs,_,_,_) = null fs cont (es,f:fs,allfs,ext,msg) = do (ess,fss,allfss,_, msgs) <- parseFile' allfs agi opts searchPath' f return (ess ++ es, fss ++ fs, allfss, ext, msg ++ msgs) let (Pair (es,fls,ext) _ ,mesg) = evalStepsMessages steps loopp stop cont (es,files ++ fls,file : parsedfiles, ext,mesg) where -- -- Option dependent AG Parsers inlined here -- to have access to the opts -- while retaining sharing -- pElemsFiles :: Bool -> AGParser ([Elem],[String],Maybe String) pElemsFiles agi = pFoldr (($),([],[],Nothing)) pElem' where pElem' = addElem <$> pElem <|> pINCLUDE *> (addInc <$> pStringPos) <|> pEXTENDS *> (addExt <$> pStringPos) addElem e (es,fs,ext) = (e:es, fs, ext) addInc (fn,_) (es,fs,ext) | noIncludes opts = (es, fs, ext) -- skip includes | otherwise = (es,normalise fn:fs, ext) addExt (fn,_) (es,fs,ext) | noIncludes opts = (es, fs, ext) -- skip includes | otherwise = if agi then (es,fs, Just fn') else (es,fn':fs, ext) --marcos where fn' = normalise fn pCodescrapL = (\(ValToken _ str pos) -> (str, pos))<$> parseScrapL "a code block" parseScrapL :: AGParser Token parseScrapL = let p acc = (\k (Input pos str next) -> let (sc,rest) = case next of Just (t@(ValToken TkTextln _ _), rs) -> (t,rs) _ -> let (tok,p2,inp2) = codescrapL pos str in (tok, input opts p2 inp2) steps = k ( rest) in (val (acc sc) steps) ) in anaDynE (mkPR (P (p ), R (p (const id)))) pElems :: AGParser Elems pElems = pList_ng pElem pComplexType = List <$> pBracks pTypeEncapsulated <|> Maybe <$ pMAYBE <*> pType <|> Either <$ pEITHER <*> pType <*> pType <|> Map <$ pMAP <*> pTypePrimitive <*> pType <|> IntMap <$ pINTMAP <*> pType <|> OrdSet <$ pSET <*> pType <|> IntSet <$ pINTSET <|> tuple <$> pParens (pListSep pComma field) where field = (,) <$> ((Just <$> pIdentifier <* pTypeColon) `opt` Nothing) <*> pTypeEncapsulated tuple xs = Tuple [(fromMaybe (Ident ("x"++show n) noPos) f, t) | (n,(f,t)) <- zip [1..] xs ] pOptClassContext' :: AGParser ClassContext pOptClassContext' | ocaml opts = pSucceed [] | otherwise = pOptClassContext pTyVars :: AGParser [Identifier] pTyVars | ocaml opts = return <$> pTypeVar <|> pSucceed [] <|> pParens (pListSep pComma pTypeVar) | otherwise = pList pIdentifier pElem :: AGParser Elem pElem = (\(pos, ct) -> Data pos ct) <$> ( (\x -> (x, DataConstructor)) <$> (pDATA <|> pTYPE) <|> (\x -> (x, RecordConstructor)) <$> pRECORD ) <*> pOptClassContext' <*> pNontSet <*> pTyVars <*> pOptAttrs <*> pAlts <*> pSucceed False <|> Attr <$> pATTR <*> pOptClassContext' <*> pNontSet <*> pOptQuantifiers <*> pAttrs <|> Type <$> pTYPE <*> pOptClassContext' <*> pTypeCon <*> pTyVars <* pEquals <*> pComplexType <|> Sem <$> pSEM <*> pOptClassContext' <*> pNontSet <*> pOptAttrs <*> pOptQuantifiers <*> pSemAlts <|> Set <$> pSET <*> pTypeCon <*> ( False <$ pEquals <|> True <$ pColon ) <*> pNontSet <|> Deriving <$> pDERIVING <*> pNontSet <* pColon <*> pListSep pComma pIdentifierU <|> Wrapper <$> pWRAPPER <*> pNontSet <|> Nocatas <$> pNOCATAS <*> pNontSet <|> Pragma <$> pPRAGMA <*> pList1 pIdentifier <|> Module <$> pMODULE <*> pCodescrap' <*> pCodescrap' <*> pCodescrap' <|> codeBlock <$> pBlockKind <*> ((Just <$ pATTACH <*> pTypeCon) <|> pSucceed Nothing) <*> pCodeBlock "a statement" where codeBlock knd mbNt (txt,pos) = Txt pos knd mbNt (lines txt) pBlockKind :: AGParser BlockKind pBlockKind = BlockPragma <$ pOPTPRAGMAS <|> BlockImport <$ pIMPORTS <|> BlockMain <$ pTOPLEVEL -- block is moved to the toplevel ("main") module when "sepsemmods" is used <|> BlockData <$ pDATABLOCK <|> BlockRec <$ pRECBLOCK <|> pSucceed BlockOther pAttrs :: AGParser Attrs pAttrs = Attrs <$> pOBrackPos <*> (concat <$> pList pInhAttrNames "inherited attribute declarations") <* pBar <*> (concat <$> pList pAttrNames "chained attribute declarations" ) <* pBar <*> (concat <$> pList pAttrNames "synthesised attribute declarations" ) <* pCBrack <|> (\ds -> Attrs (fst $ head ds) [n | (_,(nms,_,_)) <- ds, n <- nms] [n | (_,(_,nms,_)) <- ds, n <- nms] [n | (_,(_,_,nms)) <- ds, n <- nms]) <$> pList1 pSingleAttrDefs pSingleAttrDefs :: AGParser (Pos, (AttrNames, AttrNames, AttrNames)) pSingleAttrDefs = (\p is -> (p, (is,[],[]))) <$> pINH <*> pList1Sep pComma pSingleInhAttrDef <|> (\p is -> (p, ([],[],is))) <$> pSYN <*> pList1Sep pComma pSingleSynAttrDef <|> (\p is -> (p, ([],is,[]))) <$> pCHN <*> pList1Sep pComma pSingleChnAttrDef pSingleInhAttrDef :: AGParser (Identifier,Type,(String,String,String)) pSingleInhAttrDef = (\v tp -> (v,tp,("","",""))) <$> pAttrIdentifier <* pTypeColon <*> pTypeOrSelf "inh attribute declaration" pSingleSynAttrDef :: AGParser (Identifier,Type,(String,String,String)) pSingleSynAttrDef = (\v u tp -> (v,tp,u)) <$> pAttrIdentifier <*> pUse <* pTypeColon <*> pTypeOrSelf "syn attribute declaration" pSingleChnAttrDef :: AGParser (Identifier,Type,(String,String,String)) pSingleChnAttrDef = (\v tp -> (v,tp,("","",""))) <$> pAttrIdentifier <* pTypeColon <*> pTypeOrSelf "chn attribute declaration" pOptAttrs :: AGParser Attrs pOptAttrs = pAttrs `opt` Attrs noPos [] [] [] pInhAttrNames :: AGParser AttrNames pInhAttrNames = (\vs tp -> map (\v -> (v,tp,("","",""))) vs) <$> pAttrIdentifiers <* pTypeColon <*> pTypeOrSelf "attribute declarations" pAttrNames :: AGParser AttrNames pAttrNames = (\vs use tp -> map (\v -> (v,tp,use)) vs) <$> pAttrIdentifiers <*> pUse <* pTypeColon <*> pTypeOrSelf "attribute declarations" pAlt :: AGParser Alt pAlt = (Alt <$> pBar <*> pSimpleConstructorSet <*> (pList1_ng pTypeVar <* pDot <|> pSucceed []) <*> pFields <*> pMaybeMacro "a datatype alternative") pAlts :: AGParser Alts pAlts = pList_ng pAlt "datatype alternatives" pFields :: AGParser Fields pFields = concat <$> pList_ng pField "fields" pField :: AGParser Fields pField = (\nms tp -> map (\nm -> FChild nm tp) nms) <$> pAttrIdentifiers <* pTypeColon <*> pType <|> (\s -> [FChild (Ident (mklower $ getName s) (getPos s)) (NT s [] False)]) <$> pIdentifierU <|> (\t -> [FCtx [t]]) <$ pSmallerEqual <*> pTypePrimitive pSemAlt :: AGParser SemAlt pSemAlt = SemAlt <$> pBar <*> pConstructorSet <*> pSemDefs "SEM alternative" pSemAlts :: AGParser SemAlts pSemAlts = pList pSemAlt "SEM alternatives" pSemDef :: AGParser [SemDef] pSemDef = (\x y fs -> map (\f -> f x y) fs) <$> pMaybeRuleName <*> pFieldIdentifier <*> pList1 pAttrDef <|> pLOC *> pList1 pLocDecl <|> pINST *> pList1 pInstDecl <|> pSEMPRAGMA *> pList1 (SemPragma <$> pNames) <|> (\n e -> [AugmentDef n e]) <$ pAugmentToken <*> pAttrIdentifier <* pAssign <*> pExpr <|> (\n e -> [AroundDef n e]) <$ pAROUND <*> pAttrIdentifier <* pAssign <*> pExpr <|> (\a b -> [AttrOrderBefore a [b]]) <$> pList1 pAttrOrIdent <* pSmaller <*> pAttrOrIdent <|> (\sources target nt expr -> [MergeDef target nt sources expr]) <$ pMERGE <*> (pList1_ng pIdentifier <* pAS <|> pSucceed []) <*> pIdentifier <* pTypeColon <*> pIdentifierU <* pAssign <*> pExpr <|> (\mbNm pat (owrt,pos,pur,eager) exp -> [Def pos mbNm (pat ()) exp owrt pur eager]) <$> pMaybeRuleName <*> pPattern (const <$> pAttr) <*> pRuleSym <*> pExpr pMaybeRuleName :: AGParser (Maybe Identifier) pMaybeRuleName = (Just <$> pIdentifier <* pColon "rule name") <|> pSucceed Nothing pAttrDef :: AGParser (Maybe Identifier -> Identifier -> SemDef) pAttrDef = (\pat (owrt,pos,pur,eager) exp mbNm fld -> Def pos mbNm (pat fld) exp owrt pur eager) <$ pDot <*> pattern <*> pRuleSym <*> pExpr where pattern = pPattern pVar <|> (\ir a fld -> ir $ Alias fld a (Underscore noPos)) <$> ((Irrefutable <$ pTilde) `opt` id) <*> pAttrIdentifier pLocDecl :: AGParser SemDef pLocDecl = pDot <**> (pIdentifier <**> (pTypeColon <**> ( (\(tp,pos) _ ident _ -> TypeDef pos ident tp) <$> pLocType <|> (\ref _ ident _ -> UniqueDef ident ref) <$ pUNIQUEREF <*> pIdentifier ))) pLocType :: AGParser (Type, Pos) pLocType = (\u -> (Haskell $ getName u, getPos u)) <$> pTypeCon <|> (\(s,p) -> (Haskell s,p)) <$> pCodescrap "a type" pInstDecl :: AGParser SemDef pInstDecl = (\ident tp -> TypeDef (getPos ident) ident tp) <$ pDot <*> pIdentifier <* pTypeColon <*> pTypeNt pSemDefs :: AGParser SemDefs pSemDefs = concat <$> pList_ng pSemDef "attribute rules" pExpr :: AGParser Expression pExpr = (\(str,pos) -> Expression pos (lexTokens opts pos str)) <$> pCodescrapL "an expression" pTypeColon :: AGParser Pos pTypeColon = if doubleColons opts then pDoubleColon else pColon --marcos pMaybeMacro :: AGParser MaybeMacro pMaybeMacro = Just <$ pDoubleArrow <*> pMacro <|> pSucceed Nothing pMacro :: AGParser Macro pMacro = Macro <$> pIdentifierU <*> pList1 pMacroChild "macro" pMacroChild :: AGParser MacroChild pMacroChild = (pIdentifier <* pEquals) <**> (flip RuleChild <$> pMacro <|> flip ChildChild <$> pIdentifier <|> flip ValueChild <$> pCodescrap' ) pTypeNt :: AGParser Type pTypeNt = ((\nt -> mkNtType nt []) <$> pTypeCon "nonterminal name (no brackets)") <|> (pParens (mkNtType <$> pTypeCon <*> pList pTypeHaskellAnyAsString) "nonterminal name with parameters (using parenthesis)") pTypeCon :: AGParser Identifier pTypeCon | ocaml opts = pIdentifierExcl | otherwise = pIdentifierU pTypeVar :: AGParser Identifier pTypeVar | ocaml opts = (\(nm, pos) -> Ident nm pos) <$> pTextnmPos | otherwise = pIdentifier pTypeHaskellAnyAsString :: AGParser String pTypeHaskellAnyAsString = getName <$> pTypeVar <|> getName <$> pTypeCon <|> pCodescrap' "a type" -- if the type is within some kind of parentheses or brackets (then we allow lowercase identifiers as well) pTypeEncapsulated :: AGParser Type pTypeEncapsulated = pParens pTypeEncapsulated <|> mkNtType <$> pTypeCon <*> pList pTypeHaskellAnyAsString <|> (Haskell . getName) <$> pTypeVar <|> pTypePrimitive pTypePrimitive :: AGParser Type pTypePrimitive = Haskell <$> pCodescrap' "a type" pType :: AGParser Type pType = pTypeNt <|> pTypePrimitive pTypeOrSelf :: AGParser Type pTypeOrSelf = pType <|> Self <$ pSELF pOptClassContext :: AGParser ClassContext pOptClassContext = pClassContext <* pDoubleArrow <|> pSucceed [] pClassContext :: AGParser ClassContext pClassContext = pListSep pComma ((,) <$> pIdentifierU <*> pList pTypeHaskellAnyAsString) pNontSet = set0 where set0 = pChainr (Intersect <$ pIntersect) set1 set1 = pChainl (Difference <$ pMinus) set2 set2 = pChainr (pSucceed Union) set3 set3 = pTypeCon <**> opt (flip Path <$ pArrow <*> pTypeCon) NamedSet <|> All <$ pStar <|> pParens set0 -- -- End of AG Parser -- resolveFile :: Options -> [FilePath] -> FilePath -> IO FilePath resolveFile opts path fname = search (path ++ ["."]) where search (p:ps) = do let filename = joinPath [p, fname] fExists <- doesFileExist filename if fExists then return filename else do let filename' = joinPath [p, replaceExtension fname "ag"] fExists' <- doesFileExist filename' if fExists' then return filename' else search ps search [] = do outputStr opts ("File: " ++ show fname ++ " not found in search path: " ++ show (concat (intersperse ";" (path ++ ["."]))) ++ "\n") failWithCode opts 1 return (error "resolveFile: file not found") evalStepsMessages :: (Eq s, Show s, Show p) => Steps a s p -> (a,[Message s p]) evalStepsMessages steps = case steps of OkVal v rest -> let (arg,ms) = evalStepsMessages rest in (v arg,ms) Ok rest -> evalStepsMessages rest Cost _ rest -> evalStepsMessages rest StRepair _ msg rest -> let (v,ms) = evalStepsMessages rest in (v, msg:ms) Best _ rest _ -> evalStepsMessages rest NoMoreSteps v -> (v,[]) loopp ::(a->Bool) -> (a->IO a) -> a -> IO a loopp pred cont x | pred x = return x | otherwise = do x' <- cont x loopp pred cont x' codescrapL p [] = (valueToken TkTextln "" p,p,[]) codescrapL p (x:xs) | isSpace x = (updPos' x p) codescrapL xs | otherwise = let refcol = column p (p',sc,rest) = scrapL refcol p (x:xs) in (valueToken TkTextln sc p,p',rest) scrapL ref p (x:xs) | isSpace x || column p >= ref = let (p'',sc,inp) = updPos' x p (scrapL ref) xs in (p'',x:sc,inp) | otherwise =(p,[],x:xs) scrapL ref p [] = (p,[],[]) pNames :: AGParser [Identifier] pNames = pIdentifiers -- Insertion is expensive for pCodeBlock in order to prevent infinite inserts. pCodeBlock :: AGParser (String,Pos) pCodeBlock = pCostValToken 90 TkTextln "" "a code block" pOptQuantifiers :: AGParser [String] pOptQuantifiers = (return <$ pDoubleColon <*> pCodescrap') `opt` [] pIdentifiers :: AGParser [Identifier] pIdentifiers = pList1Sep pComma pIdentifier "lowercase identifiers" pAttrIdentifier :: AGParser Identifier pAttrIdentifier = pIdentifier <|> (\pos -> Ident "imports" pos) <$> pIMPORTS <|> (\pos -> Ident "toplevel" pos) <$> pTOPLEVEL pAttrIdentifiers :: AGParser [Identifier] pAttrIdentifiers = pList1Sep pComma pAttrIdentifier "lowercase identifiers" pUse :: AGParser (String,String,String) pUse = ( (\u x y->(x,y,show u)) <$> pUSE <*> pCodescrap' <*> pCodescrap') `opt` ("","","") "USE declaration" mklower :: String -> String mklower (x:xs) = toLower x : xs mklower [] = [] pSimpleConstructorSet :: AGParser ConstructorSet pSimpleConstructorSet = CName <$> pIdentifierU <|> CAll <$ pStar <|> pParens pConstructorSet pConstructorSet :: AGParser ConstructorSet pConstructorSet = pChainl (CDifference <$ pMinus) term2 where term2 = pChainr (pSucceed CUnion) term1 term1 = CName <$> pIdentifierU <|> CAll <$ pStar pFieldIdentifier :: AGParser Identifier pFieldIdentifier = pIdentifier <|> Ident "lhs" <$> pLHS <|> Ident "loc" <$> pLOC <|> Ident "inst" <$> pINST pAugmentToken :: AGParser () pAugmentToken = () <$ (pAUGMENT <|> pPlus) pAttr = (,) <$> pFieldIdentifier <* pDot <*> pAttrIdentifier pAttrOrIdent = OccAttr <$> pFieldIdentifier <* pDot <*> pAttrIdentifier <|> OccRule <$> pIdentifier nl2sp :: Char -> Char nl2sp '\n' = ' ' nl2sp '\r' = ' ' nl2sp x = x pVar :: AGParser (Identifier -> (Identifier, Identifier)) pVar = (\att fld -> (fld,att)) <$> pAttrIdentifier pAssign :: AGParser Bool pAssign = False <$ pReserved "=" <|> True <$ pReserved ":=" pRuleSym :: AGParser (Bool, Pos, Bool, Bool) pRuleSym = (\p -> (False, p, True, False)) <$> pReserved "=" <|> (\p -> (True, p, True, False)) <$> pReserved ":=" <|> (\p -> (False, p, True, False)) <$> pReserved "<-" <|> (\p -> (False, p, True, True)) <$> pReserved "<<-" pPattern :: AGParser (a -> (Identifier,Identifier)) -> AGParser (a -> Pattern) pPattern pvar = pPattern2 where pPattern0 = (\i pats a -> Constr i (map ($ a) pats)) <$> pIdentifierU <*> pList pPattern1 <|> pPattern1 "a pattern" pPattern1 = pvariable <|> pPattern2 pvariable = (\ir var pat a -> case var a of (fld,att) -> ir $ Alias fld att (pat a)) <$> ((Irrefutable <$ pTilde) `opt` id) <*> pvar <*> ((pAt *> pPattern1) `opt` const (Underscore noPos)) pPattern2 = (mkTuple <$> pOParenPos <*> pListSep pComma pPattern0 <* pCParen ) <|> (const . Underscore) <$> pUScore "a pattern" where mkTuple _ [x] a = x a mkTuple p xs a = Product p (map ($ a) xs) pCostSym' c t = pCostSym c t t pCodescrap' :: AGParser String pCodescrap' = fst <$> pCodescrap pCodescrap :: AGParser (String,Pos) pCodescrap = pCodeBlock pSEM, pATTR, pDATA, pRECORD, pUSE, pLOC,pINCLUDE, pTYPE, pEquals, pColonEquals, pTilde, pEXTENDS, --marcos pBar, pColon, pLHS,pINST,pSET,pDERIVING,pMinus,pIntersect,pDoubleArrow,pArrow, pDot, pUScore, pEXT,pAt,pStar, pSmaller, pWRAPPER, pNOCATAS, pPRAGMA, pMAYBE, pEITHER, pMAP, pINTMAP, pMODULE, pATTACH, pUNIQUEREF, pINH, pSYN, pAUGMENT, pPlus, pAROUND, pSEMPRAGMA, pMERGE, pAS, pSELF, pIMPORTS, pOPTPRAGMAS, pSmallerEqual, pINTSET, pDATABLOCK, pRECBLOCK :: AGParser Pos pSET = pCostReserved 90 "SET" "SET" pDERIVING = pCostReserved 90 "DERIVING" "DERIVING" pWRAPPER = pCostReserved 90 "WRAPPER" "WRAPPER" pNOCATAS = pCostReserved 90 "NOCATAS" "NOCATAS" pPRAGMA = pCostReserved 90 "PRAGMA" "PRAGMA" pSEMPRAGMA = pCostReserved 90 "SEMPRAGMA" "SEMPRAGMA" pATTACH = pCostReserved 90 "ATTACH" "ATTACH" pDATA = pCostReserved 90 "DATA" "DATA" pRECORD = pCostReserved 90 "RECORD" "RECORD" pEXT = pCostReserved 90 "EXT" "EXT" pATTR = pCostReserved 90 "ATTR" "ATTR" pSEM = pCostReserved 90 "SEM" "SEM" pINCLUDE = pCostReserved 90 "INCLUDE" "INCLUDE" pEXTENDS = pCostReserved 90 "EXTENDS" "EXTENDS" --marcos pTYPE = pCostReserved 90 "TYPE" "TYPE" pINH = pCostReserved 90 "INH" "INH" pSYN = pCostReserved 90 "SYN" "SYN" pCHN = pCostReserved 90 "CHN" "CHN" pMAYBE = pCostReserved 5 "MAYBE" "MAYBE" pEITHER = pCostReserved 5 "EITHER" "EITHER" pMAP = pCostReserved 5 "MAP" "MAP" pINTMAP = pCostReserved 5 "INTMAP" "INTMAP" pINTSET = pCostReserved 5 "INTSET" "INTSET" pUSE = pCostReserved 5 "USE" "USE" pLOC = pCostReserved 5 "loc" "loc" pLHS = pCostReserved 5 "lhs" "loc" pINST = pCostReserved 5 "inst" "inst" pAt = pCostReserved 5 "@" "@" pDot = pCostReserved 5 "." "." pUScore = pCostReserved 5 "_" "_" pColon = pCostReserved 5 ":" ":" pDoubleColon = pCostReserved 5 "::" "::" pEquals = pCostReserved 5 "=" "=" pColonEquals = pCostReserved 5 ":=" ":=" pTilde = pCostReserved 5 "~" "~" pPlus = pCostReserved 5 "+" "+" pBar = pCostReserved 5 "|" "|" pIntersect = pCostReserved 5 "/\\" "/\\" pMinus = pCostReserved 5 "-" "-" pDoubleArrow = pCostReserved 5 "=>" "=>" pSmallerEqual= pCostReserved 5 "<=" "<=" pArrow = pCostReserved 5 "->" "->" pStar = pCostReserved 5 "*" "*" pSmaller = pCostReserved 5 "<" "<" pMODULE = pCostReserved 5 "MODULE" "MODULE" pUNIQUEREF = pCostReserved 5 "UNIQUEREF" "UNIQUEREF" pAUGMENT = pCostReserved 5 "AUGMENT" "AUGMENT" pAROUND = pCostReserved 5 "AROUND" "AROUND" pMERGE = pCostReserved 5 "MERGE" "MERGE" pAS = pCostReserved 5 "AS" "AS" pSELF = pCostReserved 5 "SELF" "SELF" pIMPORTS = pCostReserved 5 "imports" "imports" pOPTPRAGMAS = pCostReserved 5 "optpragmas" "optpragmas" pTOPLEVEL = pCostReserved 5 "toplevel" "toplevel" pDATABLOCK = pCostReserved 5 "datablock" "datadecl block" pRECBLOCK = pCostReserved 5 "recblock" "recursive block" uuagc-0.9.52.2/src/TokenDef.hs0000644000000000000000000000576113433540502014073 0ustar0000000000000000{-# LANGUAGE MagicHash, UnboxedTuples, FlexibleInstances #-} module TokenDef where import UU.Scanner.Token import UU.Scanner.GenToken import UU.Scanner.Position import UU.Parsing.MachineInterface(Symbol(..)) import Data.Char(isPrint,ord) import HsToken import CommonTypes instance Symbol Token where deleteCost (Reserved key _) = case key of "DATA" -> 7# "EXT" -> 7# "ATTR" -> 7# "SEM" -> 7# "USE" -> 7# "INCLUDE" -> 7# _ -> 5# deleteCost (ValToken v _ _) = case v of TkError -> 0# _ -> 5# tokensToStrings :: [HsToken] -> [(Pos,String)] tokensToStrings = map tokenToString tokenToString :: HsToken -> (Pos, String) tokenToString tk = case tk of AGLocal var pos _ -> (pos, "@" ++ getName var) AGField field attr pos _ -> (pos, "@" ++ getName field ++ "." ++ getName attr) HsToken value pos -> (pos, value) CharToken value pos -> (pos, show value) StrToken value pos -> (pos, show value) Err mesg pos -> (pos, " ***" ++ mesg ++ "*** ") showTokens :: [(Pos,String)] -> [String] showTokens [] = [] showTokens xs = map showLine . shiftLeft . getLines $ xs getLines :: [(Pos, a)] -> [[(Pos, a)]] getLines [] = [] getLines ((p,t):xs) = let (txs,rest) = span sameLine xs sameLine (q,_) = line p == line q in ((p,t):txs) : getLines rest shiftLeft :: [[(Pos, a)]] -> [[(Pos, a)]] shiftLeft lns = let sh = let m = minimum . checkEmpty . filter (>=1) . map (column.fst.head) $ lns checkEmpty [] = [1] checkEmpty x = x in if m >= 1 then m-1 else 0 shift (p,t) = (if column p >= 1 then case p of (Pos l c f) -> Pos l (c - sh) f else p, t) in map (map shift) lns showLine :: [(Pos, [Char])] -> [Char] showLine ts = let f (p,t) r = let ct = column p in \c -> spaces (ct-c) ++ t ++ r (length t+ct) spaces x | x < 0 = "" | otherwise = replicate x ' ' in foldr f (const "") ts 1 showStrShort :: String -> String showStrShort xs = "\"" ++ concatMap f xs ++ "\"" where f '"' = "\\\"" f x = showCharShort' x showCharShort :: Char -> String showCharShort '\'' = "'" ++ "\\'" ++ "'" showCharShort c = "'" ++ showCharShort' c ++ "'" showCharShort' :: Char -> String showCharShort' '\a' = "\\a" showCharShort' '\b' = "\\b" showCharShort' '\t' = "\\t" showCharShort' '\n' = "\\n" showCharShort' '\r' = "\\r" showCharShort' '\f' = "\\f" showCharShort' '\v' = "\\v" showCharShort' '\\' = "\\\\" showCharShort' x | isPrint x = [x] | otherwise = '\\' : show (ord x) uuagc-0.9.52.2/src/ATermAbstractSyntax.hs0000644000000000000000000000126313433540502016270 0ustar0000000000000000{----------------------------------------------------------------------------- Haskell ATerm Library Joost Visser CWI, Amsterdam This module is part of the ATerm library for Haskell. It defines the abstract syntax of ATerms as a Haskell datatype. ------------------------------------------------------------------------------} module ATermAbstractSyntax where -- Abstract syntax ----------------------------------------------------------- data ATerm = AAppl String [ATerm] | AList [ATerm] | AInt Integer | AString String deriving (Read,Show,Eq,Ord) ------------------------------------------------------------------------------ uuagc-0.9.52.2/src/Knuth1.hs0000644000000000000000000007435113433540502013547 0ustar0000000000000000module Knuth1 where import Pretty import ExecutionPlan import CommonTypes import Control.Monad import Control.Monad.ST import Data.Maybe import Data.List import Data.STRef import Debug.Trace import Data.Array (Array) import qualified Data.Array as Array import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set -- | Trace a message in the ST monad traceST :: String -> ST s () traceST s = trace s (return ()) ------------------------------------------------------------------------------- -- Dependency graph representation ------------------------------------------------------------------------------- -- Vertices data AttrType = Inh | Syn | Loc deriving (Eq, Ord, Show) data Vertex = VAttr AttrType Identifier Identifier | VChild Identifier | VRule Identifier deriving (Eq, Ord) instance Show Vertex where show (VAttr ty ch at) = show ty ++ " @" ++ show ch ++ "." ++ show at show (VChild ch) = "Child " ++ show ch show (VRule ru) = "Rule " ++ show ru -- | Check if a vertex is an attribute isVertexAttr :: Vertex -> Bool isVertexAttr (VAttr _ _ _) = True isVertexAttr _ = False -- | Get the child name of an attribute getAttrChildName :: Vertex -> Identifier getAttrChildName (VAttr _ n _) = n -- | Set the child name of an attribute setAttrChildName :: Vertex -> Identifier -> Vertex setAttrChildName (VAttr t _ a) n = VAttr t n a -- | Get the type of an attribute getAttrType :: Vertex -> AttrType getAttrType (VAttr t _ _) = t -- | Get the name of an attribute getAttrName :: Vertex -> Identifier getAttrName (VAttr _ _ a) = a -- Edges type Edge = (Vertex, Vertex) -- Internal representation of a vertex type IVertex = Int type IEdge = (IVertex, IVertex) -- Representation of the graph data DependencyGraph s = DependencyGraph { vertexIMap :: Map Vertex IVertex , vertexOMap :: Array IVertex Vertex , successors :: Array IVertex (STRef s (Set IVertex)) , predecessors :: Array IVertex (STRef s (Set IVertex)) } ------------------------------------------------------------------------------- -- Dependency graph fuctions ------------------------------------------------------------------------------- -- | Construct a dependency graph graphConstruct :: [Vertex] -> ST s (DependencyGraph s) graphConstruct vs = do let nv = length vs let ivs = [0..nv-1] let ivb = (0,nv-1) let vimap = Map.fromList (zip vs ivs) let vomap = Array.array ivb (zip ivs vs) succs <- replicateM nv (newSTRef Set.empty) preds <- replicateM nv (newSTRef Set.empty) let su = Array.array ivb (zip ivs succs) let pr = Array.array ivb (zip ivs preds) let graph = DependencyGraph { vertexIMap = vimap , vertexOMap = vomap , successors = su , predecessors = pr } return graph -- | Construct a transitivelly closed graph graphConstructTRC :: [Vertex] -> [Edge] -> ST s (DependencyGraph s) graphConstructTRC vs es = do g <- graphConstruct vs -- Insert all initial edges graphInsertEdgesTRC g es return g -- | Return all successors of a vertex graphSuccessors :: DependencyGraph s -> Vertex -> ST s (Set Vertex) graphSuccessors g v = do sucs <- readSTRef $ (successors g) Array.! (graphGetIVertex g v) return $ Set.map (graphGetVertex g) sucs -- | Return all predecessors of a vertex graphPredecessors :: DependencyGraph s -> Vertex -> ST s (Set Vertex) graphPredecessors g v = do sucs <- readSTRef $ (predecessors g) Array.! (graphGetIVertex g v) return $ Set.map (graphGetVertex g) sucs -- | Check if the graph contains an edge graphContainsEdge :: DependencyGraph s -> Edge -> ST s Bool graphContainsEdge g (v1,v2) = do let iv1 = graphGetIVertex g v1 let iv2 = graphGetIVertex g v2 sucs <- readSTRef $ (successors g) Array.! iv1 return $ iv2 `Set.member` sucs -- | Insert an edge in the graph graphInsert :: DependencyGraph s -> Edge -> ST s () graphInsert g (v1,v2) = do let iv1 = graphGetIVertex g v1 let iv2 = graphGetIVertex g v2 -- Add v2 to the successors of v1 and v1 to predecessors of v2 modifySTRef ((successors g) Array.! iv1) $ Set.insert iv2 modifySTRef ((predecessors g) Array.! iv2) $ Set.insert iv1 -- | Insert an edge in a transtive closed graph and return all other edges that were -- added due to transtivity graphInsertTRC :: DependencyGraph s -> Edge -> ST s [(IVertex, Set IVertex)] graphInsertTRC g (v1,v2) = do let iv1 = graphGetIVertex g v1 let iv2 = graphGetIVertex g v2 -- Read predecessors of v1 and successors of v2 pred1 <- readSTRef $ (predecessors g) Array.! iv1 succ2 <- readSTRef $ (successors g) Array.! iv2 -- First insert all edges from v1 let rsucc1 = (successors g) Array.! iv1 succ1 <- readSTRef rsucc1 let add1 = succ2 `Set.difference` succ1 modifySTRef rsucc1 (Set.union add1 . Set.insert iv2) -- All edges to v2 let rpred2 = (predecessors g) Array.! iv2 modifySTRef rpred2 (Set.union pred1 . Set.insert iv1) -- Connect every predecessor of v1 to every successor of v2 sucl <- forM (Set.toList pred1) $ \pred -> do -- Connect pred to v2 and all successors of v2 let rsucc = (successors g) Array.! pred csucc <- readSTRef rsucc let cadd = (Set.insert iv2 succ2) `Set.difference` csucc modifySTRef rsucc (Set.union cadd) return (pred, cadd) -- Connect every successor of v2 to every predecessor of v1 forM_ (Set.toList succ2) $ \succ -> do -- Connect succ to v1 and all predecessors of v1 let rpred = (predecessors g) Array.! succ cpred <- readSTRef rpred let cadd = (Set.insert iv1 pred1) `Set.difference` cpred modifySTRef rpred (Set.union cadd) -- Create return return $ (iv1,add1) : sucl -- | Return all vertices of the graph graphVertices :: DependencyGraph s -> ST s [Vertex] graphVertices = return . Array.elems . vertexOMap -- | Return all edges of the graph graphEdges :: DependencyGraph s -> ST s [Edge] graphEdges g = do let vs = Array.indices $ vertexOMap g perv <- forM vs $ \v -> do let rv = graphGetVertex g v sucs <- readSTRef $ (successors g) Array.! v let sucl = Set.toList sucs return $ map ((,) rv . graphGetVertex g) sucl return $ concat perv -- | Insert a list of edges in the graph graphInsertEdges :: DependencyGraph s -> [Edge] -> ST s () graphInsertEdges g ed = mapM_ (graphInsert g) ed -- | Insert a list of edges in the graph and return all other edges that -- were added due to transitivity graphInsertEdgesTRC :: DependencyGraph s -> [Edge] -> ST s [Edge] graphInsertEdgesTRC g ed = do -- rets :: [[(IVertex, Set IVertex)]] rets <- mapM (graphInsertTRC g) ed -- Combine all successor sets let f :: (IVertex, (Set IVertex)) -> [(IVertex, IVertex)] f (v,s) = map ((,) v) (Set.toList s) let comb :: [(IVertex, IVertex)] comb = concatMap (concatMap f) rets -- Construct edges from this return $ map (graphGetEdge g) $ comb -- | Check whether the graph is cyclic graphIsCyclic :: DependencyGraph s -> ST s Bool graphIsCyclic g = do s <- graphCyclicVertices g return $ not $ Set.null s graphCyclicVertices :: DependencyGraph s -> ST s (Set IVertex) graphCyclicVertices g = do vs <- return $ Array.indices $ vertexOMap g sets <- forM vs $ \v -> do sucs <- readSTRef $ (successors g) Array.! v let res | v `Set.member` sucs = Set.singleton v | otherwise = Set.empty return res return (Set.unions sets) graphCyclicVerticesExt :: DependencyGraph s -> ST s [Vertex] graphCyclicVerticesExt g = (map (graphGetVertex g) . Set.elems) `fmap` graphCyclicVertices g -- | Get internal representation of a vertex graphGetIVertex :: DependencyGraph s -> Vertex -> IVertex graphGetIVertex g v = vertexIMap g Map.! v -- | Get external representation of a vertex graphGetVertex :: DependencyGraph s -> IVertex -> Vertex graphGetVertex g v = vertexOMap g Array.! v -- | Get external representation of an edge graphGetEdge :: DependencyGraph s -> IEdge -> Edge graphGetEdge g (v1,v2) = (graphGetVertex g v1, graphGetVertex g v2) -- | Check if the graph is transitively closed graphIsTRC :: DependencyGraph s -> ST s Bool graphIsTRC g = do let vs = Array.indices $ vertexOMap g bs <- forM vs $ \v -> do succs <- readSTRef $ (successors g) Array.! v bs2 <- forM (Set.toList succs) $ \v2 -> do succs2 <- readSTRef $ (successors g) Array.! v2 return $ succs2 `Set.isSubsetOf` succs return $ and bs2 return $ and bs -- | Check consistency of the graph (successor and predecessor sets) graphCheckConsistency :: DependencyGraph s -> ST s Bool graphCheckConsistency g = do let vs = Array.indices $ vertexOMap g ret <- forM vs $ \v -> do -- V must appear in every predecessor set of its successors succs <- readSTRef $ (successors g) Array.! v r1 <- forM (Set.toList succs) $ \succ -> do preds2 <- readSTRef $ (predecessors g) Array.! succ return (v `Set.member` preds2) -- V must appear in every successor set of its predecessors preds <- readSTRef $ (predecessors g) Array.! v r2 <- forM (Set.toList preds) $ \pred -> do succs2 <- readSTRef $ (successors g) Array.! pred return (v `Set.member` succs2) return $ and $ r1 ++ r2 return $ and $ ret -- | Add edges to the graph so that it is topologically sorted (this will not work if graph is cyclic) graphTopSort :: DependencyGraph s -> ST s [Edge] graphTopSort g = do let vs = Array.indices $ vertexOMap g order <- foldM (graphTopSort' g) [] vs mb <- forM (zip order (tail order)) $ \(v1,v2) -> do let edg = graphGetEdge g (v2,v1) -- order is actually reverse order ce <- graphContainsEdge g edg if ce then return Nothing else do graphInsert g edg return $ Just edg return $ catMaybes mb -- | Helper function for graphTopSort graphTopSort' :: DependencyGraph s -> [IVertex] -> IVertex -> ST s [IVertex] graphTopSort' g prev cur | cur `elem` prev = return prev | otherwise = do pred <- readSTRef $ (predecessors g) Array.! cur order <- foldM (graphTopSort' g) prev $ Set.toList pred return $ cur : order ------------------------------------------------------------------------------- -- Dependency graph information wrappers ------------------------------------------------------------------------------- -- | Special wrapper for nonterminal dependency graphs (so that we can easily add other meta-information) data NontDependencyGraph = NontDependencyGraph { ndgVertices :: [Vertex] , ndgEdges :: [Edge] } -- | Special wrapper for production dependency graphs, including mapping between child names and nonterminals data ProdDependencyGraph = ProdDependencyGraph { pdgVertices :: [Vertex] , pdgEdges :: [Edge] , pdgRules :: ERules , pdgChilds :: EChildren , pdgProduction :: Identifier , pdgChildMap :: [(Identifier, Identifier)] , pdgConstraints :: [Type] , pdgParams :: [Identifier] } -- | Represent all information from the dependency graphs for a nonterminal data NontDependencyInformation = NontDependencyInformation { ndiNonterminal :: Identifier , ndiParams :: [Identifier] , ndiInh :: [Identifier] , ndiSyn :: [Identifier] , ndiDepGraph :: NontDependencyGraph , ndiProds :: [ProdDependencyGraph] , ndiRecursive :: Bool , ndiHoInfo :: HigherOrderInfo , ndiClassCtxs :: ClassContext } --- Monadic versions of these records, for use with the ST monad -- | Monadic wrapper of NontDependencyGraph data NontDependencyGraphM s = NontDependencyGraphM { ndgmDepGraph :: DependencyGraph s , ndgmOrig :: NontDependencyGraph } -- | Monadic wrapper of ProdDependencyGraph data ProdDependencyGraphM s = ProdDependencyGraphM { pdgmDepGraph :: DependencyGraph s , pdgmOrig :: ProdDependencyGraph } -- | Monadic wrapper of NontDependencyInformation data NontDependencyInformationM s = NontDependencyInformationM { ndimOrig :: NontDependencyInformation , ndimDepGraph :: NontDependencyGraphM s , ndimProds :: [ProdDependencyGraphM s] } -- | Convert a NontDependencyGraph to the corresponding monadic version mkNontDependencyGraphM :: NontDependencyGraph -> ST s (NontDependencyGraphM s) mkNontDependencyGraphM ndg = do g <- graphConstructTRC (ndgVertices ndg) (ndgEdges ndg) return $ NontDependencyGraphM { ndgmDepGraph = g , ndgmOrig = ndg } -- | Convert a ProdDependencyGraph to the corresponding monadic version mkProdDependencyGraphM :: Bool -> ProdDependencyGraph -> ST s (ProdDependencyGraphM s) mkProdDependencyGraphM trc pdg = do g <- if trc then graphConstructTRC (pdgVertices pdg) (pdgEdges pdg) else do g <- graphConstruct (pdgVertices pdg) mapM_ (graphInsert g) (pdgEdges pdg) return g return $ ProdDependencyGraphM { pdgmDepGraph = g , pdgmOrig = pdg } -- | Convert a NontDependencyInformation to the corresponding monadic version mkNontDependencyInformationM :: NontDependencyInformation -> ST s (NontDependencyInformationM s) mkNontDependencyInformationM ndi = do dg <- mkNontDependencyGraphM (ndiDepGraph ndi) prods <- mapM (mkProdDependencyGraphM True) (ndiProds ndi) return $ NontDependencyInformationM { ndimOrig = ndi , ndimDepGraph = dg , ndimProds = prods } -- | Construct the production graphs from the transitivelly closed graphs undoTransitiveClosure :: [NontDependencyInformationM s] -> ST s [NontDependencyInformationM s] undoTransitiveClosure ndis = do edgesl <- mapM (\ndi -> graphEdges (ndgmDepGraph $ ndimDepGraph ndi)) ndis let edges = concat edgesl forM ndis $ \ndi -> do prods <- mapM (mkProdDependencyGraphM False) (ndiProds $ ndimOrig ndi) forM_ (zip prods (ndimProds ndi)) $ \(nprod,oprod) -> do -- All possible edges let possa = do (v1,v2) <- edges -- Take a child of this nonterminal type guard $ isVertexAttr v1 guard $ isVertexAttr v2 let tp = getAttrChildName v1 (ch,chtp) <- pdgChildMap $ pdgmOrig nprod guard $ tp == chtp -- Construct edge as it should be in the production graph let nv1 = setAttrChildName v1 ch let nv2 = setAttrChildName v2 ch return (nv1, nv2) toadd <- filterM (graphContainsEdge (pdgmDepGraph oprod)) possa graphInsertEdges (pdgmDepGraph nprod) toadd return $ NontDependencyInformationM { ndimOrig = ndimOrig ndi , ndimDepGraph = ndimDepGraph ndi , ndimProds = prods } ------------------------------------------------------------------------------- -- Knuth-1 algorithm ------------------------------------------------------------------------------- -- | Combine the dependency and nonterminal graphs using Knuth-1 -- this function assumes that the nonterminal graphs initially contains no edges knuth1 :: [NontDependencyInformationM s] -> ST s () knuth1 ndis = do -- Create initial list of pending edges for each ndi per production (initially all prod edges) -- pndis :: [([[Edge]], NontDependencyInformation)] pndis <- forM ndis $ \ndi -> do ipend <- mapM (graphEdges . pdgmDepGraph) . ndimProds $ ndi return (ipend, ndi) knuth1' pndis -- | Helper function for |knuth1| which repeats the process until we are done knuth1' :: [([[Edge]], NontDependencyInformationM s)] -> ST s () knuth1' ndis = do -- Add edges from the production graphs to the nonterminal graph -- ndis' :: [[Edge]] ndis' <- mapM addProdNont ndis -- List of all newly added edges -- ntedge :: [Edge] let pntedge = concat ndis' -- Add backedges --bedges <- addBackEdges ndis -- All added nonterminal edges let ntedge = pntedge -- ++ bedges if null ntedge -- When no new edges have been added we are done then return () else do -- Otherwise, the next step is to add edges from nonterminal to production graphs -- ndis'' :: [[[Edge]]] ndis'' <- mapM (\(_,x) -> addNontProd True (ntedge, x)) ndis -- List of new states (production edges + dependency graphs) -- nndis' :: [([[Edge]], NontDependencyInformation)] nndis' <- zipWithM (\(_,ndi) me -> return (me, ndi)) ndis ndis'' if any (not . null) ndis'' -- We have added some edges, so continue the process then knuth1' nndis' -- No new edges added, we are done else return () -- | Add pending edges from the production graphs to the nonterminal graph -- and return the list of newly added nonterminal edges addProdNont :: ([[Edge]], NontDependencyInformationM s) -> ST s [Edge] addProdNont (pending, ndi) = do -- Unwrapping of the records let nontDepGraph = ndimDepGraph ndi let nontGraph = ndgmDepGraph nontDepGraph -- nub the list because multiple productions can result in the same new edges let possa = nub $ do (v1,v2) <- concat pending -- Take only edges from syn.lhs to inh.lhs guard $ isVertexAttr v1 guard $ getAttrChildName v1 == _LHS guard $ getAttrType v1 == Syn guard $ isVertexAttr v2 guard $ getAttrChildName v2 == _LHS guard $ getAttrType v2 == Inh -- Construct edge as it should be in nonterminal graph let nv1 = setAttrChildName v1 (ndiNonterminal $ ndimOrig ndi) let nv2 = setAttrChildName v2 (ndiNonterminal $ ndimOrig ndi) return (nv1, nv2) -- Edges that are not in the nonterminal graph yet toadd <- filterM (\e -> return not `ap` graphContainsEdge nontGraph e) possa -- Check whether new edges are to be added and return the added edges when (not $ null toadd) $ do graphInsertEdgesTRC nontGraph toadd return () return toadd -- | Add edges from the nonterminal graphs to the production graphs -- and return the list of newly added production edges and the updated graph addNontProd :: Bool -> ([Edge], NontDependencyInformationM s) -> ST s [[Edge]] addNontProd trc (pending, ndi) = do -- Just call the helper function for each nonterminal mapM (addNontProd' trc pending) (ndimProds ndi) -- | Helper function for |addNontProd| for a single production addNontProd' :: Bool -> [Edge] -> ProdDependencyGraphM s -> ST s [Edge] addNontProd' trc pend pdg = do -- Unwrapping of the records prodGraph <- return $ pdgmDepGraph pdg -- Construct all possible new edges let possa = do (v1,v2) <- pend -- Take a child of this nonterminal type guard $ isVertexAttr v1 guard $ isVertexAttr v2 let tp = getAttrChildName v1 (ch,chtp) <- pdgChildMap $ pdgmOrig pdg guard $ tp == chtp -- Construct edge as it should be in the production graph let nv1 = setAttrChildName v1 ch let nv2 = setAttrChildName v2 ch return (nv1, nv2) -- Edges that are not in the production graph yet toadd <- filterM (\e -> return not `ap` graphContainsEdge prodGraph e) possa -- Check whether new edges are to be added and return the result if null toadd then return [] else do -- Insert all edges and return transitive edges that are added in this process ret <- if trc then graphInsertEdgesTRC prodGraph toadd else do mapM_ (graphInsert prodGraph) toadd return [] -- Debug output --mapM_ (\edge -> traceST $ "Adding production edge " ++ show edge) toadd return ret -- | Add the "back edges" to the nonterminal graphs for creating a global ordering addBackEdges :: [([[Edge]], NontDependencyInformationM s)] -> ST s [Edge] addBackEdges ndis = do -- gather all backedges lBackEdges <- forM ndis $ \(aedg,ndi) -> do -- For every production bs <- forM (zip aedg (ndimProds ndi)) $ \(edg,prod) -> do -- Filter out the backedges return $ do (v1,v2) <- edg -- Backedges are from inh.ch to syn.ch guard $ isVertexAttr v1 guard $ getAttrChildName v1 /= _LHS guard $ getAttrType v1 == Inh guard $ isVertexAttr v2 guard $ getAttrChildName v2 /= _LHS guard $ getAttrType v2 == Syn guard $ getAttrChildName v1 == getAttrChildName v2 -- Find the correct child name (ch,chtp) <- pdgChildMap $ pdgmOrig prod let tp = getAttrChildName v1 guard $ tp == ch -- Construct the edge as it should be in the nonterminal graph let nv1 = setAttrChildName v1 chtp let nv2 = setAttrChildName v2 chtp return (nv1, nv2) return $ foldl' union [] bs -- Concatenate all lists of backedges let backedges = foldl' union [] lBackEdges -- Add backedges to every nonterminal graph ret <- forM ndis $ \(_,ndi) -> do -- Find the backedges for this nonterminal let nont = ndiNonterminal . ndimOrig $ ndi let thisbe = filter ((==) nont . getAttrChildName . fst) backedges -- Add them to the graph graphInsertEdgesTRC (ndgmDepGraph . ndimDepGraph $ ndi) thisbe return $ backedges ++ concat ret -- | Add all resulting edges from a topsort on the nonterminal graph to the production graph -- this will ignore edges that will make the graph cyclic addTopSortEdges :: [Edge] -> ProdDependencyGraphM s -> ST s () addTopSortEdges pend pdg = do -- Unwrapping of the records prodGraph <- return $ pdgmDepGraph pdg -- Construct all possible new edges let possa = do (v1,v2) <- pend -- Take a child of this nonterminal type guard $ isVertexAttr v1 guard $ isVertexAttr v2 let tp = getAttrChildName v1 (ch,chtp) <- pdgChildMap $ pdgmOrig pdg guard $ tp == chtp -- Construct edge as it should be in the production graph let nv1 = setAttrChildName v1 ch let nv2 = setAttrChildName v2 ch return (nv1, nv2) -- Edges that are not in the production graph yet forM_ possa $ \(v1,v2) -> do e1 <- graphContainsEdge prodGraph (v1,v2) e2 <- graphContainsEdge prodGraph (v2,v1) when (not $ e1 || e2) $ do graphInsertTRC prodGraph (v1,v2) return () uuagc-0.9.52.2/src/Scanner.hs0000644000000000000000000002653713433540502013771 0ustar0000000000000000{-# LANGUAGE MagicHash, UnboxedTuples, FlexibleInstances #-} module Scanner where import GHC.Prim import TokenDef import UU.Scanner.Position import UU.Scanner.Token import UU.Parsing(InputState(..),Either'(..)) import Data.Maybe import Data.List import Data.Char import UU.Scanner.GenToken import Options (Options (..)) data Input = Input !Pos String (Maybe (Token, Input)) instance InputState Input Token Pos where splitStateE input@(Input _ _ next) = case next of Nothing -> Right' input Just (s, rest) -> Left' s rest splitState (Input _ _ next) = case next of Nothing -> error "splitState on empty input" Just (s, rest) -> (# s, rest #) getPosition (Input pos _ next) = case next of Just (s,_) -> position s Nothing -> pos -- end of file input :: Options -> Pos -> String -> Input input opts pos inp = Input pos inp (case scan opts pos inp of Nothing -> Nothing Just (s,p,r) -> Just (s, input opts p r) ) type Lexer s = Pos -> String -> Maybe (s,Pos,String) scan :: Options -> Lexer Token scan opts p0 | column p0 == 1 = scanBeginOfLine p0 | otherwise = scan p0 where keywords' = if lcKeywords opts then map (map toLower) keywords else keywords mkKeyword s | s `elem` lowercaseKeywords = s | otherwise = map toUpper s scan :: Lexer Token scan p [] = Nothing scan p ('/':'/':xs) | clean opts = let (com,rest) = span (/= '\n') xs in advc' (2+length com) p scan rest scan p ('-':'-':xs) | null xs || not (head xs `elem` "<>!?#@:%$^&") = let (com,rest) = span (/= '\n') xs in advc' (2+length com) p scan rest scan p ('{':'-':xs) = advc' 2 p (ncomment scan) xs scan p ('/':'*':xs) | clean opts = advc' 2 p (cleancomment scan) xs scan p ('{' :xs) = advc' 1 p codescrap xs scan p ('\CR':xs) = case xs of '\LF':ys -> newl' p scanBeginOfLine ys --ms newline _ -> newl' p scanBeginOfLine xs --mac newline scan p ('\LF':xs) = newl' p scanBeginOfLine xs --unix newline scan p (x:xs) | isSpace x = updPos' x p scan xs scan p xs = Just (scan' xs) where scan' ('.' :rs) = (reserved "." p, advc 1 p, rs) scan' ('@' :rs) = (reserved "@" p, advc 1 p, rs) scan' (',' :rs) = (reserved "," p, advc 1 p, rs) scan' ('_' :rs) = (reserved "_" p, advc 1 p, rs) scan' ('~' :rs) = (reserved "~" p, advc 1 p, rs) scan' ('+' :rs) = (reserved "+" p, advc 1 p, rs) scan' ('<' : '-' : rs) = (reserved "<-" p, advc 2 p, rs) scan' ('<' : '=' : rs) = (reserved "<=" p, advc 2 p, rs) scan' ('<' : '<' : '-' : rs) = (reserved "<<-" p, advc 3 p, rs) scan' ('<' :rs) = (reserved "<" p, advc 1 p, rs) scan' ('[' :rs) = (reserved "[" p, advc 1 p, rs) scan' (']' :rs) = (reserved "]" p, advc 1 p, rs) scan' ('(' :rs) = (reserved "(" p, advc 1 p, rs) scan' (')' :rs) = (reserved ")" p, advc 1 p, rs) -- scan' ('{' :rs) = (OBrace p, advc 1 p, rs) -- scan' ('}' :rs) = (CBrace p, advc 1 p, rs) scan' ('\"' :rs) = let isOk c = c /= '"' && c /= '\n' (str,rest) = span isOk rs in if null rest || head rest /= '"' then (errToken "unterminated string literal" p , advc (1+length str) p,rest) else (valueToken TkString str p, advc (2+length str) p, tail rest) scan' ('=' : '>' : rs) = (reserved "=>" p, advc 2 p, rs) scan' ('=' :rs) = (reserved "=" p, advc 1 p, rs) scan' (':':'=':rs) = (reserved ":=" p, advc 2 p, rs) scan' (':':':':rs) = (reserved "::" p, advc 2 p, rs) scan' ('∷':rs) = (reserved "::" p, advc 1 p, rs) -- recognize unicode double colons too scan' (':' :rs) = (reserved ":" p, advc 1 p, rs) scan' ('|' :rs) = (reserved "|" p, advc 1 p, rs) scan' ('/':'\\':rs) = (reserved "/\\" p, advc 2 p, rs) scan' ('-':'>' :rs) = (reserved "->" p, advc 2 p, rs) scan' ('-' :rs) = (reserved "-" p, advc 1 p, rs) scan' ('*' :rs) = (reserved "*" p, advc 1 p, rs) scan' ('\'' :rs) | ocaml opts = -- note: ocaml type variables are encoded as 'TkTextnm' tokens let (var,rest) = ident opts rs str = '\'' : var in (valueToken TkTextnm str p, advc (length str) p, rest) scan' (x:rs) | isLower x = let (var,rest) = ident opts rs str = (x:var) tok | str `elem` keywords' = reserved (mkKeyword str) | otherwise = valueToken TkVarid str in (tok p, advc (length var+1) p, rest) | isUpper x = let (var,rest) = ident opts rs str = (x:var) tok | str `elem` keywords' = reserved (mkKeyword str) | otherwise = valueToken TkConid str in (tok p, advc (length var+1) p,rest) | otherwise = (errToken ("unexpected character " ++ show x) p, advc 1 p, rs) scanBeginOfLine :: Lexer Token scanBeginOfLine p ('{' : '-' : ' ' : 'L' : 'I' : 'N' : 'E' : ' ' : xs) | isOkBegin rs && isOkEnd rs' = scan (advc (8 + length r + 2 + length s + 4) p') (drop 4 rs') | otherwise = Just (errToken ("Invalid LINE pragma: " ++ show r) p, advc 8 p, xs) where (r,rs) = span isDigit xs (s, rs') = span (/= '"') (drop 2 rs) p' = Pos (read r - 1) (column p) s -- LINE pragma indicates the line number of the /next/ line! isOkBegin (' ' : '"' : _) = True isOkBegin _ = False isOkEnd ('"' : ' ' : '-' : '}' : _) = True isOkEnd _ = False scanBeginOfLine p xs = scan p xs ident opts = span isValid where isValid x = isAlphaNum x || x == '_' || (not (clean opts) && x == '\'') || (clean opts && x == '`') lowercaseKeywords = ["loc","lhs", "inst", "optpragmas", "imports", "toplevel", "datablock", "recblock"] keywords = lowercaseKeywords ++ [ "DATA", "RECORD", "EXT", "ATTR", "SEM","TYPE", "USE", "INCLUDE" , "EXTENDS" -- marcos , "SET","DERIVING","FOR", "WRAPPER", "NOCATAS", "MAYBE", "EITHER", "MAP", "INTMAP" , "PRAGMA", "SEMPRAGMA", "MODULE", "ATTACH", "UNIQUEREF", "INH", "SYN", "CHN" , "AUGMENT", "AROUND", "MERGE", "AS", "SELF", "INTSET" ] ncomment c p ('-':'}':xs) = advc' 2 p c xs ncomment c p ('{':'-':xs) = advc' 2 p (ncomment (ncomment c)) xs ncomment c p (x:xs) = updPos' x p (ncomment c) xs ncomment c p [] = Just (errToken "unterminated nested comment" p, p,[]) cleancomment c p ('*':'/':xs) = advc' 2 p c xs cleancomment c p ('/':'*':xs) = advc' 2 p (cleancomment (cleancomment c)) xs cleancomment c p (x:xs) = updPos' x p (cleancomment c) xs cleancomment c p [] = Just (errToken "unterminated nested comment" p, p,[]) codescrap p xs = let (p2,xs2,sc) = codescrap' 1 p xs in case xs2 of ('}':rest) -> Just (valueToken TkTextln sc p,advc 1 p2,rest) _ -> Just (errToken "unterminated codescrap" p,p2,xs2) codescrap' d p [] = (p,[],[]) {- codescrap' d p ('{':'{':xs) = let (p2,xs2,sc) = advc' 2 p (codescrap' d) xs in (p2,xs2,'{':' ':sc) codescrap' d p ('}':'}':xs) = let (p2,xs2,sc) = advc' 2 p (codescrap' d) xs in (p2,xs2,'}':' ':sc) -} codescrap' d p ('{':xs) = let (p2,xs2,sc) = advc' 1 p (codescrap' (d+1)) xs in (p2,xs2,'{' : sc) codescrap' d p ('}':xs) | d == 1 = (p,'}':xs,[]) | otherwise = let (p2,xs2,sc) = advc' 1 p (codescrap' (d-1)) xs in (p2,xs2,'}' : sc) codescrap' d p (x :xs) = let (p2,xs2,sc) = updPos' x p (codescrap' d) xs in (p2,xs2,x:sc) --Literate Mode scanLit xs = (fs, foldr insNL (const "") codeLns 1) where insNL (n,line) r = \n1 -> replicate (n-n1) '\n' ++ line ++ r n (fs,codeLns,_) = getBlocks ([1..] `zip` toLines xs) getBlocks [] = ([],[],[]) getBlocks xs = let (files1,txt1,r1) = getBlock xs (files2,txt2,r2) = getBlocks r1 in (files1++files2, txt1++txt2, r2) getBlock = getLines . dropWhile comment getLines [] = ([],[],[]) getLines ((n,l):ls) | "\\begin{code}" `isPrefixOf` l = let (lns,rest) = codelines ls in ([],lns,rest) | "\\begin{Code}" `isPrefixOf` l = let (lns,rest) = codeLines ls in ([],lns,rest) | "\\IN{" `isPrefixOf` l = let name = getName l in ([name],[],ls) | otherwise = getBlock ls comment = not . ("\\" `isPrefixOf`) .snd toLines :: String -> [String] toLines "" = [] toLines s = let (l,s') = breakLine s in l : toLines s' breakLine xs = case xs of '\CR' : ys -> case ys of '\LF' : zs -> ([],zs) _ -> ([],ys) '\LF' : ys -> ([], ys) x : ys -> let (l,s) = breakLine ys in (x:l,s) [] -> ([],[]) codelines [] = error "Unterminated literate code block" codelines ((n,l):ls) | "\\end{code}" `isPrefixOf` l = ([],ls) | otherwise = let (lns,r) = codelines ls in ((n,l):lns,r) codeLines [] = error "Unterminated literate Code block" codeLines ((n,l):ls) | "\\end{Code}" `isPrefixOf` l = ([],ls) | otherwise = let (lns,r) = codeLines ls in ((n,l):lns,r) getName l = case r of ('}':_) -> nm _ -> error $ "missing '}' in \\IN" where (nm,r) = span (/='}') (drop 4 l) uuagc-0.9.52.2/src/Ag.hs0000644000000000000000000010754413433540502012725 0ustar0000000000000000-- Todo: we should make a nicer pipeline. Perhaps use Atze's "compile run" combinators. module Ag (uuagcLib, uuagcExe,compile) where import System.Environment (getArgs, getProgName) import System.Console.GetOpt (usageInfo) import Data.List (partition) import Control.Monad (zipWithM_,when) import Data.Maybe import System.FilePath import System.IO import qualified Data.Set as Set import qualified Data.Map as Map import qualified Data.Sequence as Seq ((><),null) import Data.Foldable(toList) import Pretty import PPUtil import UU.Parsing (Message(..), Action(..)) import UU.Scanner.Position (Pos, line, file) import UU.Scanner.Token (Token) import qualified Transform as Pass1 (sem_AG , wrap_AG , Syn_AG (..), Inh_AG (..)) import qualified Desugar as Pass1a (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) import qualified DefaultRules as Pass2 (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) import qualified ResolveLocals as Pass2a (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) import qualified Order as Pass3 (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) import qualified LOAG.Order as Pass3b (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) import qualified KWOrder as Pass3a (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) import qualified GenerateCode as Pass4 (sem_CGrammar, wrap_CGrammar, Syn_CGrammar(..), Inh_CGrammar(..)) import qualified PrintVisitCode as Pass4a (sem_CGrammar, wrap_CGrammar, Syn_CGrammar(..), Inh_CGrammar(..)) import qualified ExecutionPlan2Hs as Pass4b (sem_ExecutionPlan, wrap_ExecutionPlan, Syn_ExecutionPlan(..), Inh_ExecutionPlan(..), warrenFlagsPP) import qualified ExecutionPlan2Caml as Pass4c (sem_ExecutionPlan, wrap_ExecutionPlan, Syn_ExecutionPlan(..), Inh_ExecutionPlan(..)) import qualified ExecutionPlan2Clean as Pass4d (sem_ExecutionPlan, wrap_ExecutionPlan, Syn_ExecutionPlan(..), Inh_ExecutionPlan(..), mkIclModuleHeader, mkDclModuleHeader, cleanIclModuleHeader, cleanDclModuleHeader) import qualified PrintCode as Pass5 (sem_Program, wrap_Program, Syn_Program (..), Inh_Program (..)) import qualified PrintOcamlCode as Pass5a (sem_Program, wrap_Program, Syn_Program (..), Inh_Program (..)) import qualified PrintCleanCode as Pass5b (sem_Program, wrap_Program, Syn_Program (..), Inh_Program (..)) import qualified PrintErrorMessages as PrErr (sem_Errors , wrap_Errors , Syn_Errors (..), Inh_Errors (..), isError) import qualified TfmToVisage as PassV (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) import qualified AbstractSyntaxDump as GrammarDump (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) import qualified CodeSyntaxDump as CGrammarDump (sem_CGrammar, wrap_CGrammar, Syn_CGrammar (..), Inh_CGrammar (..)) import qualified Visage as VisageDump (sem_VisageGrammar, wrap_VisageGrammar, Syn_VisageGrammar(..), Inh_VisageGrammar(..)) import qualified AG2AspectAG as AspectAGDump (pragmaAspectAG, sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) --marcos import Options import Version (banner) import Parser (parseAG, depsAG, parseAGI) import ErrorMessages (Error(ParserError)) import CommonTypes import ATermWrite -- Library version import System.Exit (ExitCode(..), exitWith) uuagcLib :: [String] -> FilePath -> IO (ExitCode, [FilePath]) uuagcLib args fileP = do let (flags,_,errs) = getOptions args if showVersion flags || showHelp flags then do putStrLn "Cannot display help or version in library mode." return (ExitFailure 1, []) else if (not.null) errs then do putStrLn "One or more errors occured:" mapM_ putStrLn errs return (ExitFailure 2, []) else if genFileDeps flags then do deps <- getDeps flags [fileP] return (ExitSuccess, deps) else do compile flags fileP (head $ outputFiles flags++repeat "") return (ExitSuccess, []) -- Executable version uuagcExe :: IO () uuagcExe = do args <- getArgs progName <- getProgName let usageheader = "Usage info:\n " ++ progName ++ " options file ...\n\nList of options:" (flags,files,errs) = getOptions args if showVersion flags then putStrLn banner else if showHelp flags then putStrLn (usageInfo usageheader options) else if null files || (not.null) errs then do mapM_ putStrLn (usageInfo usageheader options : errs) exitWith (ExitFailure 2) else if genFileDeps flags then reportDeps flags files else zipWithM_ (compile flags) files (outputFiles flags++repeat "") compile :: Options -> FilePath -> FilePath -> IO () compile flags input output = do (output0,parseErrors) <- parseAG flags (searchPath flags) input irrefutableMap <- readIrrefutableMap flags let printStr = outputStr flags failWith = failWithCode flags inputfile = maybe input id (mainFilename flags) let output1 = Pass1.wrap_AG (Pass1.sem_AG output0 ) Pass1.Inh_AG {Pass1.options_Inh_AG = flags} flags' = condDisableOptimizations (Pass1.pragmas_Syn_AG output1 flags) grammar1 = Pass1.output_Syn_AG output1 output1a = Pass1a.wrap_Grammar (Pass1a.sem_Grammar grammar1 ) Pass1a.Inh_Grammar {Pass1a.options_Inh_Grammar = flags', Pass1a.forcedIrrefutables_Inh_Grammar = irrefutableMap, Pass1a.mainName_Inh_Grammar = mainName } grammar1a = Pass1a.output_Syn_Grammar output1a output2 = Pass2.wrap_Grammar (Pass2.sem_Grammar grammar1a ) Pass2.Inh_Grammar {Pass2.options_Inh_Grammar = flags', Pass2.constructorTypeMap_Inh_Grammar = Pass1.constructorTypeMap_Syn_AG output1} grammar2 = Pass2.output_Syn_Grammar output2 outputV = PassV.wrap_Grammar (PassV.sem_Grammar grammar2 ) PassV.Inh_Grammar {} grammarV = PassV.visage_Syn_Grammar outputV output2a = Pass2a.wrap_Grammar (Pass2a.sem_Grammar grammar2 ) Pass2a.Inh_Grammar {Pass2a.options_Inh_Grammar = flags'} grammar2a = Pass2a.output_Syn_Grammar output2a output3 = Pass3.wrap_Grammar (Pass3.sem_Grammar grammar2a ) Pass3.Inh_Grammar {Pass3.options_Inh_Grammar = flags'} grammar3 = Pass3.output_Syn_Grammar output3 output3a = Pass3a.wrap_Grammar (Pass3a.sem_Grammar grammar2a ) Pass3a.Inh_Grammar {Pass3a.options_Inh_Grammar = flags'} output3b = Pass3b.wrap_Grammar (Pass3b.sem_Grammar grammar2a ) Pass3b.Inh_Grammar {Pass3b.options_Inh_Grammar = flags'} grammar3a | loag flags' = Pass3b.output_Syn_Grammar output3b | otherwise = Pass3a.output_Syn_Grammar output3a output4 = Pass4.wrap_CGrammar (Pass4.sem_CGrammar(Pass3.output_Syn_Grammar output3)) Pass4.Inh_CGrammar {Pass4.options_Inh_CGrammar = flags'} output4a = Pass4a.wrap_CGrammar (Pass4a.sem_CGrammar(Pass3.output_Syn_Grammar output3)) Pass4a.Inh_CGrammar {Pass4a.options_Inh_CGrammar = flags'} output4b = Pass4b.wrap_ExecutionPlan (Pass4b.sem_ExecutionPlan grammar3a) Pass4b.Inh_ExecutionPlan {Pass4b.options_Inh_ExecutionPlan = flags', Pass4b.inhmap_Inh_ExecutionPlan = Pass3a.inhmap_Syn_Grammar output3a, Pass4b.synmap_Inh_ExecutionPlan = Pass3a.synmap_Syn_Grammar output3a, Pass4b.pragmaBlocks_Inh_ExecutionPlan = pragmaBlocksTxt, Pass4b.importBlocks_Inh_ExecutionPlan = importBlocksTxt, Pass4b.textBlocks_Inh_ExecutionPlan = textBlocksDoc, Pass4b.moduleHeader_Inh_ExecutionPlan = mkModuleHeader $ Pass1.moduleDecl_Syn_AG output1, Pass4b.mainName_Inh_ExecutionPlan = mkMainName mainName $ Pass1.moduleDecl_Syn_AG output1, Pass4b.mainFile_Inh_ExecutionPlan = mainFile, Pass4b.textBlockMap_Inh_ExecutionPlan = textBlockMap, Pass4b.mainBlocksDoc_Inh_ExecutionPlan = mainBlocksDoc,Pass4b.localAttrTypes_Inh_ExecutionPlan = Pass3a.localSigMap_Syn_Grammar output3a} output4c = Pass4c.wrap_ExecutionPlan (Pass4c.sem_ExecutionPlan grammar3a) Pass4c.Inh_ExecutionPlan {Pass4c.options_Inh_ExecutionPlan = flags', Pass4c.inhmap_Inh_ExecutionPlan = Pass3a.inhmap_Syn_Grammar output3a, Pass4c.synmap_Inh_ExecutionPlan = Pass3a.synmap_Syn_Grammar output3a, Pass4c.mainName_Inh_ExecutionPlan = mkMainName mainName $ Pass1.moduleDecl_Syn_AG output1, Pass4c.mainFile_Inh_ExecutionPlan = mainFile, Pass4c.localAttrTypes_Inh_ExecutionPlan = Pass3a.localSigMap_Syn_Grammar output3a} output4d = Pass4d.wrap_ExecutionPlan (Pass4d.sem_ExecutionPlan grammar3a) Pass4d.Inh_ExecutionPlan {Pass4d.options_Inh_ExecutionPlan = flags', Pass4d.inhmap_Inh_ExecutionPlan = Pass3a.inhmap_Syn_Grammar output3a, Pass4d.synmap_Inh_ExecutionPlan = Pass3a.synmap_Syn_Grammar output3a, Pass4d.importBlocks_Inh_ExecutionPlan = importBlocksTxt, Pass4d.textBlocks_Inh_ExecutionPlan = textBlocksDoc, Pass4d.iclModuleHeader_Inh_ExecutionPlan = Pass4d.mkIclModuleHeader $ Pass1.moduleDecl_Syn_AG output1, Pass4d.dclModuleHeader_Inh_ExecutionPlan = Pass4d.mkDclModuleHeader $ Pass1.moduleDecl_Syn_AG output1, Pass4d.mainName_Inh_ExecutionPlan = mkMainName mainName $ Pass1.moduleDecl_Syn_AG output1, Pass4d.mainFile_Inh_ExecutionPlan = mainFile, Pass4d.textBlockMap_Inh_ExecutionPlan = textBlockMap, Pass4d.mainBlocksDoc_Inh_ExecutionPlan = mainBlocksDoc,Pass4d.localAttrTypes_Inh_ExecutionPlan = Pass3a.localSigMap_Syn_Grammar output3a, Pass4d.constructorTypeMap_Inh_ExecutionPlan = Pass1.constructorTypeMap_Syn_AG output1} output5 = Pass5.wrap_Program (Pass5.sem_Program (Pass4.output_Syn_CGrammar output4)) Pass5.Inh_Program {Pass5.options_Inh_Program = flags', Pass5.pragmaBlocks_Inh_Program = pragmaBlocksTxt, Pass5.importBlocks_Inh_Program = importBlocksTxt, Pass5.textBlocks_Inh_Program = textBlocksDoc, Pass5.textBlockMap_Inh_Program = textBlockMap, Pass5.mainBlocksDoc_Inh_Program = mainBlocksDoc, Pass5.optionsLine_Inh_Program = optionsLine, Pass5.mainFile_Inh_Program = mainFile, Pass5.moduleHeader_Inh_Program = mkModuleHeader $ Pass1.moduleDecl_Syn_AG output1, Pass5.mainName_Inh_Program = mkMainName mainName $ Pass1.moduleDecl_Syn_AG output1} output5a = Pass5a.wrap_Program (Pass5a.sem_Program (Pass4.output_Syn_CGrammar output4)) Pass5a.Inh_Program { Pass5a.options_Inh_Program = flags', Pass5a.textBlockMap_Inh_Program = textBlockMap } output5b = Pass5b.wrap_Program (Pass5b.sem_Program (Pass4.output_Syn_CGrammar output4)) Pass5b.Inh_Program {Pass5b.options_Inh_Program = flags', Pass5b.pragmaBlocks_Inh_Program = pragmaBlocksTxt, Pass5b.importBlocks_Inh_Program = importBlocksTxt, Pass5b.textBlocks_Inh_Program = textBlocksDoc, Pass5b.textBlockMap_Inh_Program = textBlockMap, Pass5b.mainBlocksDoc_Inh_Program = mainBlocksDoc, Pass5b.optionsLine_Inh_Program = optionsLine, Pass5b.mainFile_Inh_Program = mainFile, Pass5b.moduleHeader_Inh_Program = mkModuleHeader $ Pass1.moduleDecl_Syn_AG output1, Pass5b.mainName_Inh_Program = mkMainName mainName $ Pass1.moduleDecl_Syn_AG output1} output6 = PrErr.wrap_Errors (PrErr.sem_Errors errorsToReport) PrErr.Inh_Errors {PrErr.options_Inh_Errors = flags', PrErr.dups_Inh_Errors = [] } dump1 = GrammarDump.wrap_Grammar (GrammarDump.sem_Grammar grammar1 ) GrammarDump.Inh_Grammar dump2 = GrammarDump.wrap_Grammar (GrammarDump.sem_Grammar grammar2 ) GrammarDump.Inh_Grammar dump3 = CGrammarDump.wrap_CGrammar (CGrammarDump.sem_CGrammar grammar3 ) CGrammarDump.Inh_CGrammar outputVisage = VisageDump.wrap_VisageGrammar (VisageDump.sem_VisageGrammar grammarV) VisageDump.Inh_VisageGrammar aterm = VisageDump.aterm_Syn_VisageGrammar outputVisage parseErrorList = map message2error (parseErrors) mainErrors = toList ( Pass1.errors_Syn_AG output1 Seq.>< Pass1a.errors_Syn_Grammar output1a Seq.>< Pass2.errors_Syn_Grammar output2 Seq.>< Pass2a.errors_Syn_Grammar output2a) furtherErrors = if loag flags' then toList (Pass3b.errors_Syn_Grammar output3b) else if kennedyWarren flags' then let errs3a = Pass3a.errors_Syn_Grammar output3a in if Seq.null errs3a then if ocaml flags' then toList ( Pass4c.errors_Syn_ExecutionPlan output4c ) else if clean flags' then toList ( Pass4d.errors_Syn_ExecutionPlan output4d ) else toList ( Pass4b.errors_Syn_ExecutionPlan output4b ) else toList errs3a else toList ( Pass3.errors_Syn_Grammar output3 Seq.>< Pass4.errors_Syn_CGrammar output4) errorList = if null parseErrorList then mainErrors ++ if null (filter (PrErr.isError flags') mainErrors) then furtherErrors else [] else [head parseErrorList] fatalErrorList = filter (PrErr.isError flags') errorList allErrors = if wignore flags' then fatalErrorList else errorsToFront flags' errorList errorsToReport = take (wmaxerrs flags') allErrors errorsToStopOn = if werrors flags' then errorList else fatalErrorList blocks1 = (Pass1.blocks_Syn_AG output1) {-SM `Map.unionWith (++)` (Pass3.blocks_Syn_Grammar output3)-} (pragmaBlocks, blocks2) = Map.partitionWithKey (\(k, at) _->k==BlockPragma && at == Nothing) blocks1 (importBlocks, textBlocks) = Map.partitionWithKey (\(k, at) _->k==BlockImport && at == Nothing) blocks2 importBlocksTxt = vlist_sep "" . map addLocationPragma . concat . Map.elems $ importBlocks textBlocksDoc = vlist_sep "" . map addLocationPragma . Map.findWithDefault [] (BlockOther, Nothing) $ textBlocks mainBlocksDoc = vlist_sep "" . map addLocationPragma . Map.findWithDefault [] (BlockMain, Nothing) $ textBlocks dataBlocksDoc = vlist_sep "" . map addLocationPragma . Map.findWithDefault [] (BlockData, Nothing) $ textBlocks recBlocksDoc = vlist_sep "" . map addLocationPragma . Map.findWithDefault [] (BlockRec, Nothing) $ textBlocks pragmaBlocksTxt = unlines . concat . map fst . concat . Map.elems $ pragmaBlocks textBlockMap = Map.map (vlist_sep "" . map addLocationPragma) . Map.filterWithKey (\(_, at) _ -> at /= Nothing) $ textBlocks outputfile = if null output then outputFile flags' inputfile else output mainFile | null output = outputFile flags' inputfile | otherwise = output mainName = dropExtension $ takeFileName inputfile addLocationPragma :: ([String], Pos) -> PP_Doc addLocationPragma (strs, p) | genLinePragmas flags' = ppLinePragma flags' (line p) (file p) >-< vlist (map pp strs) >-< ppWithLineNr (\l -> ppLinePragma flags' (l+1) outputfile) | otherwise = vlist (map pp strs) optionsGHC = option (unbox flags') "-fglasgow-exts" ++ option (bangpats flags') "-XBangPatterns" option True s = [s] option False _ = [] optionsLine | null optionsGHC = "" | otherwise = "{-# OPTIONS_GHC " ++ unwords optionsGHC ++ " #-}" nrOfErrorsToReport = length $ filter (PrErr.isError flags') errorsToReport nrOfWarningsToReport = length $ filter (not.(PrErr.isError flags')) errorsToReport totalNrOfErrors = length $ filter (PrErr.isError flags') allErrors totalNrOfWarnings = length $ filter (not.(PrErr.isError flags')) allErrors additionalErrors = totalNrOfErrors - nrOfErrorsToReport additionalWarnings = totalNrOfWarnings - nrOfWarningsToReport pluralS n = if n == 1 then "" else "s" (outAgi, ext) <- --marcos if genAspectAG flags' then parseAGI flags (searchPath flags) (agiFile input) else return (undefined, undefined) let ext' = fmap remAgi ext outAgi1 = Pass1.wrap_AG (Pass1.sem_AG outAgi ) Pass1.Inh_AG {Pass1.options_Inh_AG = flags'} agi = Pass1.agi_Syn_AG outAgi1 aspectAG = AspectAGDump.wrap_Grammar (AspectAGDump.sem_Grammar grammar2 ) AspectAGDump.Inh_Grammar { AspectAGDump.options_Inh_Grammar = flags' , AspectAGDump.agi_Inh_Grammar = agi , AspectAGDump.ext_Inh_Grammar = ext' } --marcos printStr . formatErrors $ PrErr.pp_Syn_Errors output6 if additionalErrors > 0 then printStr $ "\nPlus " ++ show additionalErrors ++ " more error" ++ pluralS additionalErrors ++ if additionalWarnings > 0 then " and " ++ show additionalWarnings ++ " more warning" ++ pluralS additionalWarnings ++ ".\n" else ".\n" else if additionalWarnings > 0 then printStr $ "\nPlus " ++ show additionalWarnings ++ " more warning" ++ pluralS additionalWarnings ++ ".\n" else return () -- show fake dependencies when found with --aoag when (aoag flags' && verbose flags' && isJust (Pass3b.ads_Syn_Grammar output3b)) $ putStrLn (show $ fromJust $ Pass3b.ads_Syn_Grammar output3b) if not (null errorsToStopOn) -- note: this may already run quite a part of the compilation... then failWith 1 else do if genvisage flags' then writeFile (outputfile++".visage") (writeATerm aterm) else return () if genAttributeList flags' then writeAttributeList (outputfile++".attrs") (Pass1a.allAttributes_Syn_Grammar output1a) else return () if sepSemMods flags' then do -- alternative module gen if loag flags || kennedyWarren flags' then if ocaml flags' then error "sepsemmods is not implemented for the ocaml output generation" else Pass4b.genIO_Syn_ExecutionPlan output4b else Pass5.genIO_Syn_Program output5 if not (null errorsToStopOn) then failWith 1 else return () else do -- conventional module gen let doc | visitorsOutput flags' = vlist [ pp_braces importBlocksTxt , pp_braces textBlocksDoc , vlist $ Pass4a.output_Syn_CGrammar output4a ] -- marcos AspectAG gen | genAspectAG flags' = vlist [ AspectAGDump.pragmaAspectAG , pp optionsLine , pp pragmaBlocksTxt , pp $ take 70 ("-- UUAGC2AspectAG " ++ drop 50 banner ++ " (" ++ input) ++ ")" , pp $ if isNothing $ Pass1.moduleDecl_Syn_AG output1 then moduleHeader flags' mainName ext' else mkModuleHeader (Pass1.moduleDecl_Syn_AG output1) mainName "" "" False , pp importBlocksTxt , AspectAGDump.imp_Syn_Grammar aspectAG , pp "\n\n{-- AspectAG Code --}\n\n" , AspectAGDump.pp_Syn_Grammar aspectAG , dataBlocksDoc , mainBlocksDoc , textBlocksDoc , if dumpgrammar flags' then vlist [ pp "{- Dump of AGI" , pp (show agi) , pp "-}" , pp "{- Dump of grammar with default rules" , GrammarDump.pp_Syn_Grammar dump2 , pp "-}" ] else empty] | loag flags' || kennedyWarren flags' = if ocaml flags' then vlist [ text "(* generated by UUAG from" >#< mainFile >#< "*)" , pp pragmaBlocksTxt , text "(* module imports *)" , pp importBlocksTxt , Pass4c.modules_Syn_ExecutionPlan output4c , text "" , text "(* generated data types *)" , text "module Data__ = struct" , indent 2 $ vlist [ text "type __generated_by_uuagc__ = Generated_by_uuagc__" , Pass4c.datas_Syn_ExecutionPlan output4c ] , text "end" , text "open Data__" , text "" , text "(* embedded data types *)" , dataBlocksDoc , text "" , text "(* embedded utilty functions *)" , textBlocksDoc , text "(* generated evaluationcode *)" , text "module Code__ = struct" , indent 2 $ vlist [ text "let rec __generated_by_uuagc__ = Generated_by_uuagc__" , Pass4c.code_Syn_ExecutionPlan output4c , recBlocksDoc ] , text "end" , text "open Code__" , text "" , text "(* main code *)" , mainBlocksDoc ] else if clean flags' then vlist [ pp $ if isNothing $ Pass1.moduleDecl_Syn_AG output1 then Pass4d.cleanIclModuleHeader flags' mainName else Pass4d.mkIclModuleHeader (Pass1.moduleDecl_Syn_AG output1) mainName "" "" False , pp importBlocksTxt , dataBlocksDoc , vlist [ pp $ "from Control.Monad.Identity import :: Identity" , pp $ "import qualified Control.Monad.Identity as Control.Monad.Identity" , pp $ "import Control.Monad.Identity" , pp $ "from Control.Applicative import lift" , pp $ "from Control.Monad import class Monad (..)" ] , mainBlocksDoc , textBlocksDoc , recBlocksDoc --, pp $ "{-" --, Pass3a.depgraphs_Syn_Grammar output3a --, Pass3a.visitgraph_Syn_Grammar output3a --, pp $ "-}" , Pass4d.output_Syn_ExecutionPlan output4d , if dumpgrammar flags' then vlist [ pp "/* Dump of grammar with default rules" , GrammarDump.pp_Syn_Grammar dump2 , pp "*/" ] else empty] else vlist [ Pass4b.warrenFlagsPP flags' , pp pragmaBlocksTxt , pp $ if isNothing $ Pass1.moduleDecl_Syn_AG output1 then moduleHeader flags' mainName Nothing else mkModuleHeader (Pass1.moduleDecl_Syn_AG output1) mainName "" "" False , pp importBlocksTxt , ( if tupleAsDummyToken flags' then empty else pp "import GHC.Prim" -- need it to pass State# ) , if parallelInvoke flags' then vlist [ pp $ "import qualified System.IO.Unsafe(unsafePerformIO)" , pp $ "import System.IO(IO)" , pp $ "import Control.Concurrent(newEmptyMVar,forkIO,putMVar,takeMVar)"] else vlist [ pp $ "import Control.Monad.Identity (Identity)" , pp $ "import qualified Control.Monad.Identity" ] , dataBlocksDoc , mainBlocksDoc , textBlocksDoc , recBlocksDoc --, pp $ "{-" --, Pass3a.depgraphs_Syn_Grammar output3a --, Pass3a.visitgraph_Syn_Grammar output3a --, pp $ "-}" , Pass4b.output_Syn_ExecutionPlan output4b , if dumpgrammar flags' then vlist [ pp "{- Dump of grammar with default rules" , GrammarDump.pp_Syn_Grammar dump2 , pp "-}" ] else empty] | otherwise = vlist [ vlist ( if (ocaml flags' || clean flags') then [] else [ pp optionsLine , pp pragmaBlocksTxt , pp $ take 70 ("-- UUAGC " ++ drop 50 banner ++ " (" ++ input) ++ ")" , pp $ if isNothing $ Pass1.moduleDecl_Syn_AG output1 then moduleHeader flags' mainName Nothing else mkModuleHeader (Pass1.moduleDecl_Syn_AG output1) mainName "" "" False ] ) , pp importBlocksTxt , dataBlocksDoc , mainBlocksDoc , textBlocksDoc , vlist $ if (ocaml flags') then Pass5a.output_Syn_Program output5a else if (clean flags') then Pass5b.output_Syn_Program output5b else Pass5.output_Syn_Program output5 , if dumpgrammar flags' then vlist [ pp "{- Dump of grammar without default rules" , GrammarDump.pp_Syn_Grammar dump1 , pp "-}" , pp "{- Dump of grammar with default rules" , GrammarDump.pp_Syn_Grammar dump2 , pp "-}" ] else empty , if dumpcgrammar flags' then vlist [ pp "{- Dump of cgrammar" , CGrammarDump.pp_Syn_CGrammar dump3 , pp "-}" ] else empty ] let docTxt = disp doc 50000 "" writeFile outputfile docTxt -- HACK: write Clean DCL file if clean flags' then do let dclDoc = vlist [ pp $ if isNothing $ Pass1.moduleDecl_Syn_AG output1 then Pass4d.cleanDclModuleHeader flags' mainName Nothing -- TODO: What should be there instead of Nothing? else Pass4d.mkDclModuleHeader (Pass1.moduleDecl_Syn_AG output1) mainName "" "" False , vlist [ pp $ "from Control.Monad.Identity import :: Identity" , pp $ "import qualified Control.Monad.Identity as Control.Monad.Identity" , pp $ "import Control.Monad.Identity" , pp $ "from Control.Applicative import lift" , pp $ "from Control.Monad import class Monad (..)" ] , Pass4d.output_dcl_Syn_ExecutionPlan output4d ] writeFile (replaceExtension outputfile ".dcl") (disp dclDoc 50000 "") else return () -- HACK: write statistics let nAuto = Pass3.nAutoRules_Syn_Grammar output3 nExpl = Pass3.nExplicitRules_Syn_Grammar output3 line' = inputfile ++ "," ++ show nAuto ++ "," ++ show nExpl ++ "\r\n" case statsFile flags' of Nothing -> return () Just f -> appendFile f line' if not (null errorsToStopOn) then failWith 1 else return () formatErrors :: PP_Doc -> String formatErrors doc = disp doc 5000 "" message2error :: Message Token Pos -> Error message2error (Msg expect pos action) = ParserError pos (show expect) actionString where actionString = case action of Insert s -> "inserting: " ++ show s Delete s -> "deleting: " ++ show s Other ms -> ms errorsToFront :: Options -> [Error] -> [Error] errorsToFront flags mesgs = errs ++ warnings where (errs,warnings) = partition (PrErr.isError flags) mesgs moduleHeader :: Options -> String -> Maybe String -> String moduleHeader flags input export = case moduleName flags of Name nm -> genMod nm Default -> genMod (defaultModuleName input) NoName -> "" where genMod x = "module " ++ x ++ genExp export x ++ " where" genExp Nothing _ = "" genExp (Just e) x = "(module " ++ x ++ ", module " ++ e ++ ")" --marcos agiFile :: String -> String agiFile name = replaceExtension name "agi" remAgi :: String -> String remAgi = dropExtension outputFile :: Options -> String -> String outputFile opts name | ocaml opts = replaceExtension name "ml" | clean opts = replaceExtension name "icl" | otherwise = replaceExtension name "hs" defaultModuleName :: String -> String defaultModuleName = dropExtension mkMainName :: String -> Maybe (String, String,String) -> String mkMainName defaultName Nothing = defaultName mkMainName _ (Just (name, _, _)) = name mkModuleHeader :: Maybe (String,String,String) -> String -> String -> String -> Bool -> String mkModuleHeader Nothing defaultName suffix _ _ = "module " ++ defaultName ++ suffix ++ " where" mkModuleHeader (Just (name, exports, imports)) _ suffix addExports replaceExports = "module " ++ name ++ suffix ++ ex ++ " where\n" ++ imports ++ "\n" where ex = if null exports || (replaceExports && null addExports) then "" else if null addExports then "(" ++ exports ++ ")" else if replaceExports then "(" ++ addExports ++ ")" else "(" ++ exports ++ "," ++ addExports ++ ")" reportDeps :: Options -> [String] -> IO () reportDeps flags files = do deps <- getDeps flags files mapM_ putStrLn deps getDeps :: Options -> [String] -> IO [String] getDeps flags files = do results <- mapM (depsAG flags (searchPath flags)) files let (fs, mesgs) = foldr comb ([],[]) results let errs = take (min 1 (wmaxerrs flags)) (map message2error mesgs) let ppErrs = PrErr.wrap_Errors (PrErr.sem_Errors errs) PrErr.Inh_Errors {PrErr.options_Inh_Errors = flags, PrErr.dups_Inh_Errors = []} if null errs then return fs else do hPutStrLn stderr . formatErrors $ PrErr.pp_Syn_Errors ppErrs failWithCode flags 1 return [] where comb :: ([a],[b]) -> ([a], [b]) -> ([a], [b]) comb (fs, mesgs) (fsr, mesgsr) = (fs ++ fsr, mesgs ++ mesgsr) writeAttributeList :: String -> AttrMap -> IO () writeAttributeList fileP mp = writeFile fileP s where s = show $ map (\(x,y) -> (show x, y)) $ Map.toList $ Map.map (map (\(x,y) -> (show x, y)) . Map.toList . Map.map (map (\(x,y) -> (show x, show y)) . Set.toList)) $ mp readIrrefutableMap :: Options -> IO AttrMap readIrrefutableMap flags = case forceIrrefutables flags of Just fileP -> do s <- readFile fileP seq (length s) (return ()) let lists :: [(String,[(String,[(String, String)])])] lists = read s return $ Map.fromList [ (identifier n, Map.fromList [(identifier c, Set.fromList [ (identifier fld, identifier attr) | (fld,attr) <- ss ]) | (c,ss) <- cs ]) | (n,cs) <- lists ] Nothing -> return Map.empty uuagc-0.9.52.2/src/KennedyWarren.hs0000644000000000000000000011165413433540502015147 0ustar0000000000000000module KennedyWarren where import Prelude hiding (init, succ) import CommonTypes import Pretty import Knuth1 import ExecutionPlan import Debug.Trace import Control.Monad.ST import Control.Monad.State import Control.Monad.Error import Data.STRef import Data.Maybe import Data.List (intersperse, groupBy, partition, sortBy) import Data.Ord import qualified ErrorMessages as Err import PrintErrorMessages () import Data.Set (Set) import qualified Data.Set as Set import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Map.Strict as MapStrict import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet -- lazy version (does not return errors) -- FIXME: construct map from nonterminal to intial visit (or state?) and use it in the generation of invokes kennedyWarrenLazy :: Options -> Set NontermIdent -> [NontDependencyInformation] -> TypeSyns -> Derivings -> ExecutionPlan kennedyWarrenLazy _ wr ndis typesyns derivings = plan where plan = ExecutionPlan nonts typesyns wr derivings nonts = zipWith mkNont ndis nontIds nontIds = enumFromThen 1 4 initvMap = Map.fromList $ zipWith (\ndi initv -> (ndiNonterminal ndi, initv)) ndis nontIds mkNont ndi initv = nont where nont = ENonterminal (ndiNonterminal ndi) (ndiParams ndi) (ndiClassCtxs ndi) initst [initv] nextMap prevMap prods (ndiRecursive ndi) (ndiHoInfo ndi) initst = initv + 1 finals = initv + 2 nextMap = Map.fromList [(initst, OneVis initv), (finals, NoneVis)] prevMap = Map.fromList [(initst, NoneVis), (finals, OneVis initv)] prods = map mkProd (ndiProds ndi) mkProd pdi = prod where prod = EProduction (pdgProduction pdi) (pdgParams pdi) (pdgConstraints pdi) (pdgRules pdi) (pdgChilds pdi) visits visits = [vis] vis = Visit initv initst finals inh syn steps kind inh = Set.fromList $ ndiInh ndi syn = Set.fromList $ ndiSyn ndi kind = VisitPure False steps = childSteps ++ invokeSteps ++ ruleSteps childSteps = [ ChildIntro nm | EChild nm _ _ _ _ _ <- pdgChilds pdi ] invokeSteps = [ ChildVisit nm nt v | EChild nm tp _ _ _ _ <- pdgChilds pdi , let nt = extractNonterminal tp v = Map.findWithDefault (error "child not in initv-map") nt initvMap ] ruleSteps = [ Sem nm | (ERule nm _ _ _ _ _ _ _) <- pdgRules pdi ] -- ordered version (may return errors) kennedyWarrenOrder :: Options -> Set NontermIdent -> [NontDependencyInformation] -> TypeSyns -> Derivings -> Either Err.Error (ExecutionPlan, PP_Doc, PP_Doc) kennedyWarrenOrder opts wr ndis typesyns derivings = runST $ runErrorT $ do indi <- lift $ mapM mkNontDependencyInformationM ndis lift $ knuth1 indi -- Check all graphs for cyclicity, transitive closure and consistency -- traceST $ "Checking graphs..." forM_ indi $ \ndi -> do let nont = ndiNonterminal . ndimOrig $ ndi let g = ndgmDepGraph . ndimDepGraph $ ndi -- Topological sort --tsedg <- graphTopSort g -- Cyclicity check ntCycVerts <- lift $ graphCyclicVerticesExt g when (not $ null ntCycVerts) $ do throwError $ Err.Cyclic nont Nothing (map show ntCycVerts) -- let msg = "Nonterminal graph " ++ show nont ++ " is cylic!" -- fail msg -- Transtive closure check trc <- lift $ graphIsTRC g when (not trc) $ do let msg = "Nonterminal graph " ++ show nont ++ " is not transitively closed!" fail msg -- Consistency check cons <- lift $ graphCheckConsistency g when (not cons) $ do let msg = "Nonterminal graph " ++ show nont ++ " is not consistent!" fail msg -- Loop trough all productions forM_ (ndimProds ndi) $ \prod -> do let pr = pdgProduction $ pdgmOrig prod let g' = pdgmDepGraph $ prod -- Topsort --addTopSortEdges tsedg prod -- Check for cyclicity pdCycVerts <- lift $ graphCyclicVerticesExt g' when (not $ null pdCycVerts) $ do throwError $ Err.Cyclic nont (Just pr) (map show pdCycVerts) -- let msg = "Production graph " ++ show pr ++ " of nonterminal " -- ++ show nont ++ " is cylic!" -- fail msg -- Transtive closure check trc' <- lift $ graphIsTRC g' when (not trc') $ do lift $ traceST $ "Production graph " ++ show pr ++ " of nonterminal " ++ show nont ++ " is not transitively closed!" fail "Production graph is not transitively closed." -- Check consistency consistent <- lift $ graphCheckConsistency g' when (not consistent) $ do let msg = "Production graph " ++ show pr ++ " of nonterminal " ++ show nont ++ " is not consistent!" fail msg -- reachable when everything is ok lift $ do -- Create non-transitive closed graph for efficiency indi' <- undoTransitiveClosure indi -- Graphviz output of dependency graphs gvs <- mapM toGVNontDependencyInfo indi' -- Doing kennedywarren (ret, visitg) <- runVG $ do -- traceVG $ "Running kennedy-warren..." initvs <- kennedyWarrenVisitM wr indi' -- Print some debug info nodes <- gets vgNodeNum edges <- gets vgEdgeNum when (not $ beQuiet opts) $ do traceVG $ "Number of nodes = " ++ show nodes traceVG $ "Number of edges = " ++ show edges -- Generate execution plan ex <- kennedyWarrenExecutionPlan opts indi' initvs wr typesyns derivings -- Get visit graph visitg <- toGVVisitGraph return (ex,visitg) -- Return the result return (ret, vlist gvs, visitg) ------------------------------------------------------------------------------- -- Debugging functionality ------------------------------------------------------------------------------- -- | Pretty print a vertex in GraphViz format toGVVertex :: Bool -> Vertex -> ST s PP_Doc toGVVertex l (VAttr t a b) = return $ (text $ "attr_" ++ show t ++ "_" ++ show a ++ "_" ++ show b) >#< if l then text ("[shape=box,label=\"" ++ show t ++ " @" ++ show a ++ "." ++ show b ++ "\"]") else empty toGVVertex l (VChild c) = return $ (text $ "child_" ++ show c) >#< if l then text ("[shape=ellipse,label=\"Child " ++ show c ++ "\"]") else empty toGVVertex l (VRule r) = return $ (text $ "rule_" ++ show r) >#< if l then text ("[shape=diamond,label=\"" ++ show r ++ "\"]") else empty -- | Pretty print an edge in GraphViz format toGVEdge :: Edge -> ST s PP_Doc toGVEdge (v1, v2) = do r1 <- toGVVertex False v1 r2 <- toGVVertex False v2 return $ r1 >|< text "->" >#< r2 -- | Pretty print a NontDependencyInformation in GraphViz format toGVNontDependencyInfo :: NontDependencyInformationM s -> ST s PP_Doc toGVNontDependencyInfo ndi = do dg <- return $ ndgmDepGraph . ndimDepGraph $ ndi verts <- graphVertices dg edges <- graphEdges dg vtexts <- mapM (toGVVertex True) verts etexts <- mapM toGVEdge edges ptexts <- mapM toGVProdDependencyGraph (ndimProds ndi) return $ (text ("digraph ndg_" ++ show (ndiNonterminal $ ndimOrig ndi) ++ " {") >-< vlist vtexts >-< vlist etexts >-< text "}" >-< text "" -- empty line >-< vlist ptexts) -- | Pretty print a ProdDependencyGraph in GraphViz format toGVProdDependencyGraph :: ProdDependencyGraphM s -> ST s PP_Doc toGVProdDependencyGraph pdg = do dg <- return $ pdgmDepGraph pdg verts <- graphVertices dg edges <- graphEdges dg vtexts <- mapM (toGVVertex True) verts etexts <- mapM toGVEdge edges return $ (text ("digraph pdg_" ++ show (pdgProduction $ pdgmOrig pdg) ++ " {") >-< (vlist vtexts) >-< (vlist etexts) >-< text ("info [shape=box,label=\"" ++ show (pdgChildMap $ pdgmOrig pdg) ++ "\"];") >-< text "}" >-< text "") toGVVisitGraph :: VG s PP_Doc toGVVisitGraph = do ndis <- gets vgNDI noded <- forM (IntMap.toList ndis) $ \(n,rndi) -> do ndi <- vgInST $ readSTRef rndi return $ "node_" >|< n >#< "[label=\"" >|< ndiNonterminal (ndimOrig ndi) >|< "_" >|< n >|< "\"];" edges <- gets vgEdges edged <- forM (IntMap.toList edges) $ \(edg,(VGNode from,VGNode to)) -> do inh <- getInherited (VGEdge edg) syn <- getSynthesized (VGEdge edg) return $ "node_" >|< from >#< "-> node_" >|< to >#< "[label=\"visit v" >|< edg >|< "\\ninh:" >#< (concat $ intersperse ", " $ map show $ Set.toList inh) >|< "\\nsyn: " >|< (concat $ intersperse ", " $ map show $ Set.toList syn) >|< "\"];" return $ "digraph visitgraph { " >-< vlist noded >-< vlist edged >-< "}" ------------------------------------------------------------------------------- -- Kennedy-Warren in monadic style ------------------------------------------------------------------------------- {- runVG :: VG s a -> ST s a insertInitialNode :: NontDependencyInformationM s -> VG s VGNode createPending :: VGNode -> Set Identifier -> Set Identifier -> VG s VGEdge selectPending :: VG s VGEdge getInherited :: VGEdge -> VG s (Set Identifier) getSynthesized :: VGEdge -> VG s (Set Identifier) markFinal :: VGEdge -> VG s () getProductions :: VGEdge -> VG s [VGProd] onMarkedDepGraph :: (ProdDependencyGraphM s -> ST s a) -> VGProd -> VG s a isDepGraphVertexFinal :: VGProd -> Vertex -> VG s Bool setDepGraphVerticesFinal :: VGProd -> [Vertex] -> VG s () getChildState :: VGProd -> Identifier -> VG s VGNode addChildVisit :: VGProd -> Identifier -> VGEdge -> VG s VisitStep addVisitStep :: VGProd -> VisitStep -> VG s () repeatM :: VG s () -> VG s () -} newtype VGNode = VGNode Int deriving (Show,Eq,Ord) newtype VGEdge = VGEdge Int deriving (Show,Eq,Ord) newtype VGProd = VGProd (VGEdge,Int) deriving (Show,Eq,Ord) data VGState s = VGState { vgNodeNum :: Int , vgEdgeNum :: Int -- Node maps , vgOutgoing :: IntMap (STRef s (Set VGEdge)) , vgIncoming :: IntMap (Maybe VGEdge) , vgNDI :: IntMap (STRef s (NontDependencyInformationM s)) , vgInhSynNode :: Map (Identifier, Set Identifier, Set Identifier) VGNode , vgNodeInhSyn :: IntMap (Set Identifier, Set Identifier) , vgInitial :: Map Identifier VGNode -- Edge maps , vgEdges :: IntMap (VGNode, VGNode) , vgEdgesR :: Map (VGNode,VGNode) VGEdge , vgInherited :: IntMap (Set Identifier) , vgSynthesized :: IntMap (Set Identifier) , vgPending :: IntSet , vgChildVisits :: IntMap (STRef s (Map (Identifier,Int) [VGNode])) -- Final vertices in production graphs , vgFinalVertices :: IntMap (STRef s (Set (Vertex,Int))) -- Construction of execution plan (Nonterminal,Production,Visit) , vgProdVisits :: Map (Identifier,Identifier,VGEdge) (STRef s [VisitStep]) } type VG s a = ErrorT String (StateT (VGState s) (ST s)) a ------------------------------------------------------------ --- Public functions --- ------------------------------------------------------------ -- | Run the VG monad in the ST monad runVG :: VG s a -> ST s a runVG vg = do (Right a,_) <- runStateT (runErrorT vg) vgEmptyState return a -- | Insert an initial node for this nonterminal into the visit graph insertInitialNode :: NontDependencyInformationM s -> VG s VGNode insertInitialNode ndi = do rndi <- vgInST $ newSTRef ndi (VGNode node) <- vgCreateNode rndi Set.empty Set.empty initial <- gets vgInitial incoming <- gets vgIncoming modify $ \st -> st { vgInitial = Map.insert (ndiNonterminal $ ndimOrig ndi) (VGNode node) initial , vgIncoming = IntMap.insert node Nothing incoming } return (VGNode node) -- | Create a pending edge from this node with a set of inherited and synthesized attributes createPending :: VGNode -> Set Identifier -> Set Identifier -> VG s VGEdge createPending vgn@(VGNode n) inh syn = do -- Check if target node already exists ninhsyn <- gets vgNodeInhSyn let (pinh,psyn) = imLookup n ninhsyn let ninh = Set.union pinh inh let nsyn = Set.union psyn syn mndi <- gets vgNDI let rndi = imLookup n mndi ndi <- vgInST $ readSTRef rndi inhsynn <- gets vgInhSynNode case Map.lookup (ndiNonterminal $ ndimOrig ndi, ninh, nsyn) inhsynn of Just tn -> do when (tn == vgn) $ do traceVG $ "Source and target nodes are the same!" traceVG $ "Maybe there is a wrapper with no inherited or synthesized attributes." traceVG $ "Inh: " ++ show inh traceVG $ "Syn: " ++ show syn traceVG $ "PInh: " ++ show pinh traceVG $ "PSyn: " ++ show psyn -- tn is target node, now check if edge exists and create if not edgesr <- gets vgEdgesR case Map.lookup (vgn,tn) edgesr of Just e -> return e Nothing -> vgCreatePendingEdge vgn tn inh syn Nothing -> do -- target node does not exist, create it and then create the new edge tn <- vgCreateNode rndi ninh nsyn vgCreatePendingEdge vgn tn inh syn -- | Return an arbitrary pending edge of which the from node is ready selectPending :: VG s VGEdge selectPending = do pending <- gets vgPending incoming <- gets vgIncoming edges <- gets vgEdges let readyPend = filter (\p -> let (VGNode fr,_) = imLookup p edges in isJust $ IntMap.lookup fr incoming) $ IntSet.toList pending guard $ not $ null readyPend return $ VGEdge $ head $ readyPend -- | Get the inherited attributes of an edge getInherited :: VGEdge -> VG s (Set Identifier) getInherited (VGEdge edg) = do inhs <- gets vgInherited return $ imLookup edg inhs -- | Get the synthesized attributes of an edge getSynthesized :: VGEdge -> VG s (Set Identifier) getSynthesized (VGEdge edg) = do syns <- gets vgSynthesized return $ imLookup edg syns -- | Mark an edge as final markFinal :: VGEdge -> VG s () markFinal vgedg@(VGEdge edg) = do incoming <- gets vgIncoming edges <- gets vgEdges pending <- gets vgPending let (_,VGNode to) = imLookup edg edges modify $ \st -> st { vgIncoming = IntMap.insert to (Just vgedg) incoming , vgPending = IntSet.delete edg pending } -- | Get all productions for an edge getProductions :: VGEdge -> VG s [VGProd] getProductions vedg@(VGEdge edg) = do edges <- gets vgEdges let (VGNode fr,_) = imLookup edg edges ndis <- gets vgNDI let rndi = imLookup fr ndis ndi <- vgInST $ readSTRef rndi return $ map (\x -> VGProd (vedg,x)) [0..(length $ ndimProds ndi)-1] -- | Execute a function on the dependency graph for this production onMarkedDepGraph :: (ProdDependencyGraphM s -> ST s a) -> VGProd -> VG s a onMarkedDepGraph f (VGProd (VGEdge edg, n)) = do edges <- gets vgEdges let (VGNode fr,_) = imLookup edg edges ndis <- gets vgNDI let rndi = imLookup fr ndis ndi <- vgInST $ readSTRef rndi vgInST $ f $ (ndimProds ndi) !! n -- not efficient, but lists are usually short -- | Check whether this vertex has been marked as final isDepGraphVertexFinal :: VGProd -> Vertex -> VG s Bool isDepGraphVertexFinal (VGProd (VGEdge edg, p)) v = do edges <- gets vgEdges let (from,_) = imLookup edg edges vgDepGraphVertexFinal from p v -- | Mark these vertices final in this production setDepGraphVerticesFinal :: VGProd -> [Vertex] -> VG s () setDepGraphVerticesFinal (VGProd (VGEdge edg, p)) vs = do edges <- gets vgEdges let (_,VGNode to) = imLookup edg edges finalv <- gets vgFinalVertices let rfinalv = imLookup to finalv vgInST $ modifySTRef rfinalv $ Set.union (Set.fromList $ map (\v -> (v,p)) vs) -- | Add a child visit to this production and return the step for the execution plan addChildVisit :: VGProd -> Identifier -> VGEdge -> VG s VisitStep addChildVisit (VGProd (VGEdge edg, p)) ide (VGEdge vs) = do edges <- gets vgEdges let (VGNode from,vgto) = imLookup vs edges -- from must be equal to the current state childvs <- gets vgChildVisits let rchildv = imLookup edg childvs vgInST $ modifySTRef rchildv $ MapStrict.insertWith (++) (ide,p) [vgto] ndis <- gets vgNDI let rndi = imLookup from ndis ndi <- vgInST $ readSTRef rndi let nt = ndiNonterminal $ ndimOrig ndi return $ ChildVisit ide nt vs -- | Add a step to the execution plan of this visit addVisitStep :: VGProd -> VisitStep -> VG s () addVisitStep (VGProd (VGEdge edg, p)) st = do edges <- gets vgEdges let (VGNode fr,_) = imLookup edg edges ndis <- gets vgNDI let rndi = imLookup fr ndis ndi <- vgInST $ readSTRef rndi prodvs <- gets vgProdVisits let nont = ndiNonterminal $ ndimOrig ndi let prod = pdgProduction $ pdgmOrig $ ndimProds ndi !! p let Just rprodv = Map.lookup (nont, prod, VGEdge edg) prodvs vgInST $ modifySTRef rprodv (++ [st]) -- | Get the state of a child in a certain production getChildState :: VGProd -> Identifier -> VG s VGNode getChildState (VGProd (VGEdge edg,p)) ide = do childvs <- gets vgChildVisits let rchildv = imLookup edg childvs childv <- vgInST $ readSTRef rchildv case Map.lookup (ide,p) childv of Just (n:_) -> return n _ -> do -- Look for previous edge edges <- gets vgEdges let (VGNode from,_) = imLookup edg edges incoming <- gets vgIncoming case IntMap.lookup from incoming of Just (Just iedg) -> getChildState (VGProd (iedg,p)) ide Just Nothing -> do -- Lookup initial state ndis <- gets vgNDI let rndi = imLookup from ndis ndi <- vgInST $ readSTRef rndi let Just nt = lookup ide $ pdgChildMap $ pdgmOrig $ (ndimProds ndi) !! p vgFindInitial nt Nothing -> error "getChildState" -- | Repeat action untill mzero is encountered repeatM :: VG s () -> VG s () repeatM m = catchError (m >> repeatM m) (const $ return ()) ------------------------------------------------------------ --- Internal functions --- ------------------------------------------------------------ -- | Execute a ST action inside the VG monad vgInST :: ST s a -> VG s a vgInST = lift . lift vgEmptyState :: VGState s vgEmptyState = VGState { vgNodeNum = 0 , vgEdgeNum = 0 , vgOutgoing = IntMap.empty , vgIncoming = IntMap.empty , vgNDI = IntMap.empty , vgInhSynNode = Map.empty , vgNodeInhSyn = IntMap.empty , vgInitial = Map.empty , vgEdges = IntMap.empty , vgEdgesR = Map.empty , vgInherited = IntMap.empty , vgSynthesized = IntMap.empty , vgPending = IntSet.empty , vgChildVisits = IntMap.empty , vgFinalVertices = IntMap.empty , vgProdVisits = Map.empty } -- | Create a new node vgCreateNode :: STRef s (NontDependencyInformationM s) -> Set Identifier -> Set Identifier -> VG s VGNode vgCreateNode rndi inh syn = do num <- gets vgNodeNum outgoing <- gets vgOutgoing inhsyn <- gets vgInhSynNode ninhsyn <- gets vgNodeInhSyn ndi <- gets vgNDI finalv <- gets vgFinalVertices rout <- vgInST $ newSTRef Set.empty rfinalv <- vgInST $ newSTRef Set.empty nndi <- vgInST $ readSTRef rndi modify $ \st -> st { vgNodeNum = num + 1 , vgOutgoing = IntMap.insert num rout outgoing , vgInhSynNode = Map.insert (ndiNonterminal $ ndimOrig nndi,inh,syn) (VGNode num) inhsyn , vgNodeInhSyn = IntMap.insert num (inh,syn) ninhsyn , vgNDI = IntMap.insert num rndi ndi , vgFinalVertices = IntMap.insert num rfinalv finalv } return $ VGNode num -- | Create a new pending edge vgCreatePendingEdge :: VGNode -> VGNode -> Set Identifier -> Set Identifier -> VG s VGEdge vgCreatePendingEdge vgn1@(VGNode n1) vgn2 inh syn = do num <- gets vgEdgeNum edges <- gets vgEdges edgesr <- gets vgEdgesR inhs <- gets vgInherited syns <- gets vgSynthesized outgoing <- gets vgOutgoing pend <- gets vgPending childv <- gets vgChildVisits rchildv <- vgInST $ newSTRef Map.empty let outr = imLookup n1 outgoing let ret = VGEdge num vgInST $ modifySTRef outr (Set.insert ret) modify $ \st -> st { vgEdgeNum = num + 1 , vgEdges = IntMap.insert num (vgn1,vgn2) edges , vgEdgesR = Map.insert (vgn1,vgn2) ret edgesr , vgPending = IntSet.insert num pend , vgInherited = IntMap.insert num inh inhs , vgSynthesized = IntMap.insert num syn syns , vgChildVisits = IntMap.insert num rchildv childv } -- Add prod visits (for constructing an execution plan) ndis <- gets vgNDI let rndi = imLookup n1 ndis ndi <- vgInST $ readSTRef rndi prodv <- gets vgProdVisits refs <- forM (ndimProds ndi) $ \prod -> do rprod <- vgInST $ newSTRef [] return ((ndiNonterminal $ ndimOrig ndi, pdgProduction $ pdgmOrig prod, ret),rprod) modify $ \st -> st { vgProdVisits = Map.union (Map.fromList refs) prodv } return $ ret -- | Check whether a vertex is marked final on this node in this production vgDepGraphVertexFinal :: VGNode -> Int -> Vertex -> VG s Bool vgDepGraphVertexFinal (VGNode n) p v = do finalv <- gets vgFinalVertices let rfinalv = imLookup n finalv curset <- vgInST $ readSTRef rfinalv if Set.member (v,p) curset then return True else do incoming <- gets vgIncoming case IntMap.lookup n incoming of Just (Just (VGEdge edg)) -> do edges <- gets vgEdges let (fr,_) = imLookup edg edges vgDepGraphVertexFinal fr p v Just Nothing -> return False Nothing -> error "This can never happen" -- | Find the initial node for a nonterminal vgFindInitial :: Identifier -> VG s VGNode vgFindInitial nt = do initial <- gets vgInitial let Just r = Map.lookup nt initial return r -- | Always succeeding IntMap lookup imLookup :: Int -> IntMap a -> a imLookup k m = let Just r = IntMap.lookup k m in r -- | Trace inside the vg monad traceVG :: String -> VG s () traceVG s = trace s (return ()) ------------------------------------------------------------ --- The kennedy warren algorithm --- ------------------------------------------------------------ {- runVG :: VG s a -> ST s a insertInitialNode :: NontDependencyInformationM s -> VG s VGNode createPending :: VGNode -> Set Identifier -> Set Identifier -> VG s VGEdge selectPending :: VG s VGEdge getInherited :: VGEdge -> VG s (Set Identifier) getSynthesized :: VGEdge -> VG s (Set Identifier) markFinal :: VGEdge -> VG s () getProductions :: VGEdge -> VG s [VGProd] onMarkedDepGraph :: (ProdDependencyGraphM s -> ST s a) -> VGProd -> VG s a isDepGraphVertexFinal :: VGProd -> Vertex -> VG s Bool setDepGraphVerticesFinal :: VGProd -> [Vertex] -> VG s () getChildState :: VGProd -> Identifier -> VG s VGNode addChildVisit :: VGProd -> Identifier -> VGEdge -> VG s VisitStep addVisitStep :: VGProd -> VisitStep -> VG s () repeatM :: VG s () -> VG s () -} kennedyWarrenVisitM :: Set NontermIdent -> [NontDependencyInformationM s] -> VG s [[VisitIdentifier]] kennedyWarrenVisitM wr ndis = do -- Create initial nodes and edges (edges only for wrapper nodes) initvs <- forM ndis $ \ndi -> do nd <- insertInitialNode ndi let inh = Set.fromList $ ndiInh $ ndimOrig ndi let syn = Set.fromList $ ndiSyn $ ndimOrig ndi if (Set.member (ndiNonterminal $ ndimOrig $ ndi) wr) && (not (Set.null inh) || not (Set.null syn)) then do VGEdge initv <- createPending nd inh syn return [initv] else return [] -- Handle all pending edges while there are any repeatM $ do pend <- selectPending prods <- getProductions pend inhs <- getInherited pend syns <- getSynthesized pend -- Handle each production for this edge forM_ prods $ \prod -> do -- Mark all inherited attributes as final setDepGraphVerticesFinal prod (map createLhsInh . Set.toList $ inhs) -- Find depth of all synthesized child visits (vis,_) <- foldM (foldChildVisits prod) ([],0) (map createLhsSyn . Set.toList $ syns) -- Mark them as final setDepGraphVerticesFinal prod (map fst vis) -- Change the inherited child visits vis2 <- correctInhChilds prod vis -- Add all synthesized attributes that are also ready but are not needed extravis <- extraChildSyn prod vis2 setDepGraphVerticesFinal prod (map fst extravis) -- Group by visit number and do visit for every num let gvis = groupSortBy (comparing snd) $ vis2 ++ extravis forM_ gvis $ \vis3 -> do -- Split child visits from rules let (chattrs, rules) = partition isChildAttr $ map fst vis3 -- Evaluate all rules forM_ (reverse $ rules) $ \rule -> case rule of VRule r -> addVisitStep prod $ Sem r VChild c -> addVisitStep prod $ ChildIntro c _ -> return () -- Now group by child, and do a visit for each child let chs = groupSortBy (comparing getAttrChildName) $ chattrs chvs <- forM chs $ \childvs -> do -- childs :: [Vertex] let cinhs = map getAttrName $ filter isChildInh childvs let csyns = map getAttrName $ filter isChildSyn childvs let cname = getAttrChildName $ head childvs -- Insert a new pending edge for this visit curstate <- getChildState prod cname target <- createPending curstate (Set.fromList cinhs) (Set.fromList csyns) addChildVisit prod cname target -- Add child visits as simultanuous step when (not $ null chvs) $ if (length chvs == 1) then addVisitStep prod $ head chvs else addVisitStep prod $ Sim chvs -- Mark this edge as final markFinal pend -- We are done -- traceVG "Done." return initvs -- | groupBy that groups all equal (according to the function) elements instead of consequtive equal elements groupSortBy :: (a -> a -> Ordering) -> [a] -> [[a]] groupSortBy f = groupBy (\x y -> f x y == EQ) . sortBy f type ChildVisits = [(Vertex,Int)] -- | Helper function for folding over child visits foldChildVisits :: VGProd -> (ChildVisits, Int) -> Vertex -> VG s (ChildVisits, Int) foldChildVisits prod (vis,i) v = do (nvis,ni) <- findChildVisits prod v vis return (nvis, ni `max` i) -- | Recursively find all visits to childs findChildVisits :: VGProd -> Vertex -> ChildVisits -> VG s (ChildVisits, Int) findChildVisits prod v vis = do case lookup v vis of Just i -> return (vis,i) Nothing -> do final <- isDepGraphVertexFinal prod v if final then return (vis,0) else do succs <- onMarkedDepGraph (liftM Set.toList . flip graphSuccessors v . pdgmDepGraph) prod (nvis,ni) <- foldM (foldChildVisits prod) (vis,0) succs if isChildSyn v then return ((v,ni + 1) : nvis, ni + 1) else return ((v,ni) : nvis, ni) -- | Correct inherited child visits after foldChildVisits correctInhChilds :: VGProd -> ChildVisits -> VG s ChildVisits correctInhChilds prod vis = forM vis $ \(v,i) -> do if isChildInh v then do preds <- onMarkedDepGraph (liftM Set.toList . flip graphPredecessors v . pdgmDepGraph) prod let ni = foldl min 99999999 $ mapMaybe (`lookup` vis) preds return (v,ni) else if not $ isChildSyn v then do succs <- onMarkedDepGraph (liftM Set.toList . flip graphSuccessors v . pdgmDepGraph) prod let ni = foldl max (-1) $ mapMaybe (`lookup` vis) succs return (v,ni+1) else return (v,i) -- | Synthesized attributes that can also be evaluated extraChildSyn :: VGProd -> ChildVisits -> VG s ChildVisits extraChildSyn prod vis = do allpreds <- forM vis $ \(v,_) -> do if isChildInh v then do preds <- onMarkedDepGraph (liftM Set.toList . flip graphPredecessors v . pdgmDepGraph) prod return $ Set.fromList $ filter isChildSyn preds else return Set.empty lextravis <- forM (Set.toList $ Set.unions allpreds) $ \v -> do ready <- isReadyVertex prod vis v return $ maybe Nothing (\i -> Just (v,i)) ready return $ catMaybes lextravis -- | Check if a vertex can be marked final in this step (and is not final yet) and return the visit num isReadyVertex :: VGProd -> ChildVisits -> Vertex -> VG s (Maybe Int) isReadyVertex prod vis v = do final <- isDepGraphVertexFinal prod v if v `elem` (map fst vis) || final then return Nothing else do succ <- onMarkedDepGraph (flip graphSuccessors v . pdgmDepGraph) prod rd <- mapM (\x -> do case lookup x vis of Just i -> return $ Just i Nothing -> do fin <- isDepGraphVertexFinal prod x return $ if fin then Just 1 else Nothing) (Set.toList succ) if all isJust rd then return $ Just $ foldl1 max $ catMaybes rd else return $ Nothing -- | Check if this vertex is a synthesized attribute of a child isChildSyn :: Vertex -> Bool isChildSyn v = isChildAttr v && getAttrType v == Syn -- | Check if this vertex is an inherited attribute of a child isChildInh :: Vertex -> Bool isChildInh v = isChildAttr v && getAttrType v == Inh -- | Check if this vertex is an attribute of a child isChildAttr :: Vertex -> Bool isChildAttr v = isVertexAttr v && getAttrChildName v /= _LHS && getAttrType v /= Loc -- | Create lhs.inh vertex createLhsInh :: Identifier -> Vertex createLhsInh = VAttr Inh _LHS -- | Create lhs.inh vertex createLhsSyn :: Identifier -> Vertex createLhsSyn = VAttr Syn _LHS ------------------------------------------------------------ --- Construction of the execution plan --- ------------------------------------------------------------ kennedyWarrenExecutionPlan :: Options -> [NontDependencyInformationM s] -> [[VisitIdentifier]] -> Set NontermIdent -> TypeSyns -> Derivings -> VG s ExecutionPlan kennedyWarrenExecutionPlan opts ndis initvs wr typesyns derivings = do -- Loop over all nonterminals nonts <- forM (zip ndis initvs) $ \(ndi, initv) -> do -- Loop over all productions of this nonterminal prods <- forM (ndimProds ndi) $ \prod -> do -- Construct the visits for this production let inont = ndiNonterminal $ ndimOrig ndi let iprod = pdgProduction $ pdgmOrig prod prodvs <- gets vgProdVisits let thisvisits = filter (\((int,ipr,_),_) -> int == inont && ipr == iprod) $ Map.toList prodvs visits <- forM thisvisits $ \((_,_,vgedg@(VGEdge edg)),rprodvs) -> do edges <- gets vgEdges let (VGNode fr, VGNode to) = imLookup edg edges steps <- vgInST $ readSTRef rprodvs inh <- getInherited vgedg syn <- getSynthesized vgedg let kind | monadic opts = VisitMonadic | otherwise = VisitPure True return $ Visit edg fr to inh syn steps kind -- Return execution plan for this production return $ EProduction (pdgProduction $ pdgmOrig prod) (pdgParams $ pdgmOrig prod) (pdgConstraints $ pdgmOrig prod) (pdgRules $ pdgmOrig prod) (pdgChilds $ pdgmOrig prod) visits -- Find initial state for this nonterminal VGNode init <- vgFindInitial $ ndiNonterminal $ ndimOrig ndi -- Construct an environment that specifies the next visit of the states that have exactly one nextMap <- mkNextMap init prevMap <- mkPrevMap init -- Return execution plan for this nonterminal return $ ENonterminal (ndiNonterminal $ ndimOrig ndi) (ndiParams $ ndimOrig ndi) (ndiClassCtxs $ ndimOrig ndi) init initv nextMap prevMap prods (ndiRecursive $ ndimOrig ndi) (ndiHoInfo $ ndimOrig ndi) -- Return complete execution plan return $ ExecutionPlan nonts typesyns wr derivings ------------------------------------------------------------ --- Construction of the single-exit states map --- ------------------------------------------------------------ -- depth-first traversal over the graph that starts at 'init' and maintains a state 'a' -- the function 'f' can inspect the prev/next edges per state exploreGraph :: (VGNode -> Set VGEdge -> Set VGEdge -> a -> VG s a) -> VGNode -> a -> VG s a exploreGraph f (VGNode init) a0 = do exploredRef <- vgInST $ newSTRef IntSet.empty pendingRef <- vgInST $ newSTRef [init] resRef <- vgInST $ newSTRef a0 outgoingMap <- gets vgOutgoing edgesInfo <- gets vgEdges let explore = do pending <- vgInST $ readSTRef pendingRef case pending of [] -> return () (p:ps) -> do vgInST $ writeSTRef pendingRef ps explored <- vgInST $ readSTRef exploredRef if IntSet.member p explored then return () else do vgInST $ writeSTRef exploredRef (IntSet.insert p explored) case IntMap.lookup p outgoingMap of Nothing -> return () Just outRef -> case IntMap.lookup p outgoingMap of Nothing -> return () Just inRef -> do outSet <- vgInST $ readSTRef outRef inSet <- vgInST $ readSTRef inRef sol0 <- vgInST $ readSTRef resRef sol1 <- f (VGNode p) inSet outSet sol0 vgInST $ writeSTRef resRef sol1 forM_ (Set.elems outSet) $ \(VGEdge edge) -> case IntMap.lookup edge edgesInfo of Nothing -> return () Just (_,VGNode to) -> vgInST $ modifySTRef pendingRef (to :) explore explore vgInST $ readSTRef resRef mkNextMap :: Int -> VG s (Map Int StateCtx) mkNextMap start = exploreGraph f (VGNode start) Map.empty where f (VGNode nd) _ edges = updateCountMap nd edges mkPrevMap :: Int -> VG s (Map Int StateCtx) mkPrevMap start = exploreGraph f (VGNode start) Map.empty where f (VGNode nd) edges _ = updateCountMap nd edges updateCountMap :: Int -> Set VGEdge -> Map Int StateCtx -> VG s (Map Int StateCtx) updateCountMap nd edges mp = return $ Map.insert nd v mp where s = Set.size edges v | s == 0 = NoneVis | s == 1 = let [VGEdge v'] = Set.elems edges in OneVis v' | otherwise = ManyVis uuagc-0.9.52.2/src/HsTokenScanner.hs0000644000000000000000000002055713433540502015261 0ustar0000000000000000 module HsTokenScanner where import HsToken import UU.Scanner.Position import Data.List(sort) import UU.Util.BinaryTrees import CommonTypes import Data.Maybe import Data.Char isAGesc :: Char -> Bool isAGesc c = c == '@' lexTokens :: Options -> Pos -> String -> [HsToken] lexTokens = scanTokens keywordstxt keywordsops specialchars opchars where keywordstxt = [] keywordsops = [".","=", ":=", ":","|","@"] specialchars = ";()[],_{}`" opchars = "!#$%&*+./<=>?@\\^|-~:" scanTokens :: [String] -> [String] -> String -> String -> Options -> Pos -> String -> [HsToken] scanTokens keywordstxt keywordsops specchars opchars opts pos input = doScan pos input where locatein :: Ord a => [a] -> a -> Bool locatein es = isJust . btLocateIn compare (tab2tree (sort es)) iskw = locatein keywordstxt isop = locatein keywordsops isSymb = locatein specchars -- See http://stackoverflow.com/questions/10548170/what-characters-are-permitted-for-haskell-operators isOpsym c = locatein opchars c -- For unicode operators || (not (isAscii c) && (isSymbol c || isPunctuation c)) isIdStart c = isLower c || c == '_' isIdChar c = isAlphaNum c || c == '\'' || c == '_' scanIdent p s = let (name,rest) = span isIdChar s in (name,advc (length name) p,rest) doScan _ [] = [] doScan p (c:s) | isSpace c = let (sp,next) = span isSpace s in doScan (foldl (flip updPos) p (c:sp)) next doScan p (c:d:s) | isAGesc c && isIdStart d = let (fld,p2,rest) = scanIdent (advc 2 p) s field = d:fld in case rest of ('.':r:rs) | isIdStart r -> let (at,p3,rest2) = scanIdent (advc 2 p2) rs attr = r : at in AGField (Ident field p) (Ident attr p) p Nothing : doScan p3 rest2 _ -> AGLocal (Ident field p) p Nothing : doScan p2 rest doScan p ('/':'/':s) | clean opts = doScan p (dropWhile (/= '\n') s) doScan p ('/':'*':s) | clean opts = advc' 2 p (lexCleanNest doScan) s -- } doScan p ('-':'-':s) = doScan p (dropWhile (/= '\n') s) doScan p ('{':'-':s) = advc' 2 p (lexNest doScan) s -- } doScan p ('"':ss) = let (s,swidth,rest) = scanString ss in if null rest || head rest /= '"' then Err "Unterminated string literal" p : advc' swidth p doScan rest else StrToken s p : advc' (swidth+2) p doScan (tail rest) doScan p ('\'':ss) | clean opts = let (str,nswidth,rest) = scanQualName ss in HsToken ('\'' : str ++ "'") p : advc' (nswidth + 2) p doScan (tail rest) | otherwise = let (mc,cwidth,rest) = scanChar ss in case mc of Nothing -> Err "Error in character literal" p : advc' cwidth p doScan rest Just c -> if null rest || head rest /= '\'' then Err "Unterminated character literal" p : advc' (cwidth+1) p doScan rest else CharToken [c] p : advc' (cwidth+2) p doScan (tail rest) doScan p cs@(c:s) | isIdStart c || isUpper c = let (name', p', s') = scanIdent (advc 1 p) s name = c:name' tok = if iskw name then HsToken name p -- keyword else if null name' && isSymb c then HsToken [c] p -- '_' else HsToken name p -- varid / conid in tok : doScan p' s' | isOpsym c = let (name, s') = span isOpsym cs tok | isop name = HsToken name p | otherwise = HsToken name p in tok : doScan (foldl (flip updPos) p name) s' | isDigit c = let (base,digs,width,s') = getNumber cs number = case base of 8 -> "0o"++digs 10 -> digs 16 -> "0x"++digs _ -> error $ "Base " ++ show base ++ " is not supported." in HsToken number p : advc' width p doScan s' | isSymb c = HsToken [c] p : advc' 1 p doScan s | otherwise = Err ("Unexpected character " ++ show c) p : updPos' c p doScan s lexNest :: (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken] lexNest cont pos inp = lexNest' cont pos inp where lexNest' c p ('{':'-':s) = lexNest' (lexNest' c) (advc 2 p) s lexNest' c p ('-':'}':s) = c (advc 2 p) s lexNest' c p (x:s) = lexNest' c (updPos x p) s lexNest' _ _ [] = [Err "Unterminated nested comment" pos] lexCleanNest :: (Pos -> String -> [HsToken]) -> Pos -> String -> [HsToken] lexCleanNest cont pos inp = lexNest' cont pos inp where lexNest' c p ('/':'*':s) = lexNest' (lexNest' c) (advc 2 p) s lexNest' c p ('*':'/':s) = c (advc 2 p) s lexNest' c p (x:s) = lexNest' c (updPos x p) s lexNest' _ _ [] = [Err "Unterminated nested comment" pos] scanString :: String -> (String, Int, String) scanString [] = ("",0,[]) scanString ('\\':'&':xs) = let (str,w,r) = scanString xs in (str,w+2,r) scanString ('\'':xs) = let (str,w,r) = scanString xs in ('\'': str,w+1,r) scanString xs = let (ch,cw,cr) = getchar xs (str,w,r) = scanString cr -- str' = maybe "" (:str) ch in maybe ("",0,xs) (\c -> (c:str,cw+w,r)) ch scanQualName :: String -> (String, Int, String) scanQualName [] = ("",0,[]) scanQualName r@('\'':_) = ("",0,r) scanQualName xs = let (ch,cw,cr) = getchar xs (str,w,r) = scanQualName cr in maybe ("",0,xs) (\c -> (c:str,cw+w,r)) ch scanChar :: String -> (Maybe Char, Int, String) scanChar ('"' :xs) = (Just '"',1,xs) scanChar xs = getchar xs getchar :: String -> (Maybe Char, Int, String) getchar [] = (Nothing,0,[]) getchar s@('\n':_ ) = (Nothing,0,s ) getchar s@('\t':_ ) = (Nothing,0,s) getchar s@('\'':_ ) = (Nothing,0,s) getchar s@('"' :_ ) = (Nothing,0,s) getchar ('\\':xs) = let (c,l,r) = getEscChar xs in (c,l+1,r) getchar (x:xs) = (Just x,1,xs) getEscChar :: String -> (Maybe Char, Int, String) getEscChar [] = (Nothing,0,[]) getEscChar s@(x:xs) | isDigit x = let (base,n,len,rest) = getNumber s val = readn base n in if val >= 0 && val <= 255 then (Just (chr val),len, rest) else (Nothing,1,rest) | otherwise = case x `lookup` cntrChars of Nothing -> (Nothing,0,s) Just c -> (Just c,1,xs) where cntrChars = [('a','\a'),('b','\b'),('f','\f'),('n','\n'),('r','\r'),('t','\t') ,('v','\v'),('\\','\\'),('"','\"'),('\'','\'')] readn :: Int -> String -> Int readn base n = foldl (\r x -> value x + base * r) 0 n getNumber :: String -> (Int,String,Int,String) getNumber [] = error "Empty string" getNumber cs@(c:s) | c /= '0' = num10 | null s = const0 | hs == 'x' || hs == 'X' = num16 | hs == 'o' || hs == 'O' = num8 | otherwise = num10 where (hs:ts) = s const0 = (10, "0",1,s) num10 = let (n,r) = span isDigit cs in (10,n,length n,r) num16 = readNum isHexaDigit ts 16 num8 = readNum isOctalDigit ts 8 readNum p ts' tk = let (n,rs) = span p ts' in if null n then const0 else (tk, n, 2+length n,rs) isHexaDigit :: Char -> Bool isHexaDigit d = isDigit d || (d >= 'A' && d <= 'F') || (d >= 'a' && d <= 'f') isOctalDigit :: Char -> Bool isOctalDigit d = d >= '0' && d <= '7' value :: Char -> Int value c | isDigit c = ord c - ord '0' | isUpper c = ord c - ord 'A' + 10 | isLower c = ord c - ord 'a' + 10 value _ = error "Not a valid value" uuagc-0.9.52.2/src/PPUtil.hs0000644000000000000000000000341713433540502013545 0ustar0000000000000000module PPUtil where -- -- Some additional pretty-print functions -- for pretty-printing abstract syntax trees. -- import Data.List import qualified Data.Map as Map import Pretty import Options ppListSep :: (PP s, PP c, PP o, PP a) => o -> c -> s -> [a] -> PP_Doc ppListSep o c s pps = o >|< hlist (intersperse (pp s) (map pp pps)) >|< c ppSpaced :: PP a => [a] -> PP_Doc ppSpaced = ppListSep "" "" " " ppCommas :: PP a => [a] -> PP_Doc ppCommas = ppListSep "" "" ", " ppVList :: PP a => [a] -> PP_Doc ppVList [] = "[" >#< "]" ppVList (x:xs) = vlist (("[" >#< pp x) : (map (\y -> "," >#< pp y) xs)) >#< "]" ppMap :: (Show a, Show b) => Map.Map a b -> PP_Doc ppMap m = ppVList [ ppF (show k) $ ppShow v | (k,v) <- Map.toList m ] ppAssocL :: (Show a, Show b) => [(a,b)] -> PP_Doc ppAssocL m = ppVList [ ppF (show k) $ ppShow v | (k,v) <- m ] ppF :: String -> PP_Doc -> PP_Doc ppF s x = s >|< ":" >#< x ppNest :: PP a => [a] -> [PP_Doc] -> [PP_Doc] -> PP_Doc ppNest nms attrs ps = ppNestInfo {- defaultEHCOpts -} nms attrs ps [] ppNestInfo :: PP a => {- EHCOpts -> -} [a] -> [PP_Doc] -> [PP_Doc] -> [(String,PP_Doc)] -> PP_Doc ppNestInfo {- opts -} nms attrs ps infos = ppListSep "" "" "_" nms >#< ( (if null attrs then empty else ppSpaced attrs) >-< (if False {- ehcOptDebug opts -} then vlist (map (\(i,p) -> pp i >|< ":" >#< p) infos) else empty) ) >-< indent 2 (vlist ps) ppNm :: String -> PP_Doc ppNm = text . show ppShow :: Show x => x -> PP_Doc ppShow x = pp $ show x mkInfo1 :: String -> PP_Doc -> (String,PP_Doc) mkInfo1 = (,) ppLinePragma :: Options -> Int -> String -> PP_Doc ppLinePragma opts ln fl | ocaml opts = "#" >#< show ln >#< show fl | clean opts = "//" >#< show ln >#< show fl | otherwise = "{-# LINE" >#< show ln >#< show fl >#< "#-}" uuagc-0.9.52.2/src/ATermWrite.hs0000644000000000000000000000206113433540502014405 0ustar0000000000000000module ATermWrite where import ATermAbstractSyntax import Data.List (intersperse) writeATerm :: ATerm -> String writeATerm t = writeAT 0 t writeAT :: Int -> ATerm -> String writeAT n (AAppl c ts) = (if (n > 0) then "\n" else "") ++ replicate n ' ' ++ writeATermAux c (map (writeAT (n+2)) ts) writeAT n (AList ts) = bracket (commaSep (map (writeAT n) ts)) writeAT _ (AInt i) = show i writeAT _ (AString s) = quote s writeATermAux :: [Char] -> [[Char]] -> [Char] writeATermAux c [] = c++(parenthesise "") writeATermAux c ts = c++(parenthesise (commaSep ts)) commaSep :: [[Char]] -> [Char] commaSep strs = concat (intersperse "," strs) bracket :: [Char] -> [Char] bracket str = "["++str++"]" parenthesise :: [Char] -> [Char] parenthesise str = "("++str++")" quote :: [Char] -> [Char] quote str = "\""++str++"\"" uuagc-0.9.52.2/src/UU/0000755000000000000000000000000013433540502012360 5ustar0000000000000000uuagc-0.9.52.2/src/UU/UUAGC.hs0000644000000000000000000000042213433540502013556 0ustar0000000000000000module UU.UUAGC (uuagc, uuagcMain, compile, module Options) where import Ag (uuagcLib, uuagcExe, compile) import Options import System.Exit (ExitCode(..)) uuagc :: [String] -> FilePath -> IO (ExitCode, [FilePath]) uuagc = uuagcLib uuagcMain :: IO () uuagcMain = uuagcExeuuagc-0.9.52.2/src/UU/UUAGC/0000755000000000000000000000000013433540502013224 5ustar0000000000000000uuagc-0.9.52.2/src/UU/UUAGC/Version.hs0000644000000000000000000000014613433540502015206 0ustar0000000000000000-- | Get current version of UUAGC module UU.UUAGC.Version(version) where import Paths_uuagc(version) uuagc-0.9.52.2/src/LOAG/0000755000000000000000000000000013433540502012551 5ustar0000000000000000uuagc-0.9.52.2/src/LOAG/Common.hs0000644000000000000000000002540613433540502014344 0ustar0000000000000000 module LOAG.Common where import qualified Data.Array as A import qualified Data.Map as M import qualified Data.IntMap as IM import qualified Data.IntSet as IS import qualified Data.Set as S import qualified Data.Sequence as Seq import Data.Maybe (isNothing) import Data.STRef import Data.Array.ST import Data.List (intercalate, foldl', nub) import CommonTypes import Control.Arrow import Control.Monad.ST import Control.Monad (forM, when, forM_, forM_, foldM) import LOAG.Graphs data Ag = Ag (Int,Int) -- attribute range (Int,Int) -- occurrence range [Edge] -- direct dependencies [Nt] -- non-terminals data Nt = Nt String [Edge] -- direct dps from inh -> syn [Edge] -- direct dps from syn -> inh -- inh attributes with direction and instances [(Vertex,[Vertex],Direction)] -- syn attributes with direction and instances [(Vertex,[Vertex],Direction)] [Pr] -- productions of this Nt deriving (Show) data Pr = Pr PLabel [Edge] -- direct dependencies between fields [(Edge,Edge,Bool)] -- all siblings pairs, with generalised version, and boolean that denotes whether if it is an edge of LHS [Fd] -- the fields of this production, including lhs deriving (Show) data Fd = Fd String -- field name String -- type of the field [(Vertex,Vertex)] -- inherited atts (gen, inst) [(Vertex,Vertex)] -- synthesized atts (gen, inst) deriving (Show) type Attrs = [Attr] data Attr = Attr String Direction MyType deriving (Show, Eq, Ord) data Direction = Inh | AnyDir | Syn deriving (Show, Ord, Enum) foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a foldM' _ a [] = return a foldM' f a (x:xs) = f a x >>= \fax -> fax `seq` foldM f fax xs modifyArray r k f = do v <- readArray r k writeArray r k (f v) setConcatMap f = S.foldr (S.union . f) S.empty isLoc (MyOccurrence (_,f) _) = f == "loc" || f == "inst" -- transparent occr ? instance Eq Direction where Inh == Syn = False Syn == Inh = False _ == _ = True data MyType = TyInt | TyBool | TyString | TyData String | TyLit String | TyArr MyType MyType | NoType -- the empty set of values (no members) | AnyType -- the set of all values (union of all types) type SchedRef s = (STArray s Vertex (Maybe Int),ThreadRef s) type AttrAssRef s = STArray s Vertex (Maybe Int) type ThreadRef s = STRef s InterfaceRes -- production is identified by its name and its parent non-terminal type PLabel = (MyType,String) type FLabel = String -- field label -- attribute is identified by its name and its direction type ALabel = (String, Direction) type AI_N = M.Map MyType MyAttributes type AS_N = M.Map MyType MyAttributes type A_N = M.Map MyType MyAttributes type A_P = M.Map PLabel MyOccurrences -- Get the (data)type of a certain child at a certain production type FTY = M.Map (PLabel, FLabel) MyType -- Get the fields corresponding to a certain type type TYFS = M.Map MyType [(PLabel, FLabel)] -- the definition of given occ uses these occs type SF_P = M.Map MyOccurrence (S.Set MyOccurrence) type PMP = M.Map Int MyOccurrence type PMP_R = M.Map MyOccurrence Int type NMP = M.Map Int MyAttribute type NMP_R = M.Map MyAttribute Int type FMap = M.Map (PLabel,FLabel) (S.Set MyOccurrence, S.Set MyOccurrence) type FsInP = M.Map PLabel [(PLabel, FLabel)] type LOAGRes = ( Maybe TDPRes , InterfaceRes , ADSRes) type VisCount= (Int, Int, Float) type ADSRes = [Edge] type TDPRes = A.Array Vertex Vertices --M.Map PLabel TDPGraph type TDPGraph = (IM.IntMap Vertices, IM.IntMap Vertices) type InterfaceRes = M.Map String (IM.IntMap [Vertex]) type HOMap = M.Map PLabel (S.Set FLabel) data CType = T1 | T2 | T3 [Edge] -- completing edges from which to select candidates deriving (Show) findWithErr :: (Ord k, Show k, Show a) => M.Map k a -> String -> k -> a findWithErr m err k = maybe (error err) id $ M.lookup k m findWithErr' m err k= maybe (error err) id $ IM.lookup k m -- Defining the MyAttribute (attribute at non-terimal -- and the MyOccurrences (attribute at a production) type MyAttributes = [MyAttribute] data MyAttribute = MyAttribute {typeOf :: MyType, alab :: ALabel} deriving (Ord, Eq) (<.>) = MyAttribute infixl 7 <.> instance Show MyAttribute where show (MyAttribute t a) = show t ++ "<.>" ++ show a type MyOccurrences = [MyOccurrence] data MyOccurrence = MyOccurrence {argsOf :: (PLabel, FLabel), attr :: ALabel} deriving (Ord, Eq) (>.<) = MyOccurrence infixl 8 >.< instance Show MyOccurrence where show (MyOccurrence ((t,p),f) a) = intercalate "." [show t,p,f] ++ "."++ show a dirOfOcc :: MyOccurrence -> Direction dirOfOcc = snd . attr handOut :: (PLabel, FLabel) -> MyAttribute -> MyOccurrence handOut p = (p >.<) . alab handAllOut :: (PLabel, FLabel) -> MyAttributes -> MyOccurrences handAllOut p os = map (handOut p) os map2F :: (Ord a) => M.Map a [b] -> a -> [b] map2F m a = case M.lookup a m of Nothing -> [] Just bs -> bs map2F' :: (Ord a) => M.Map a (S.Set b) -> a -> (S.Set b) map2F' m a = case M.lookup a m of Nothing -> S.empty Just bs -> bs flipDir :: Direction -> Direction flipDir Syn = Inh flipDir Inh = Syn -- creates all pairs of elements such that no equal elements end up in a pair -- and considering only one direction pairs :: [a] -> [(a,a)] pairs [] = [] pairs (x:xs) = map ((,) x) xs ++ pairs xs toMyTy :: Type -> MyType toMyTy (Haskell str) = TyLit str toMyTy (NT id _ _ ) = TyData $ getName id toMyTy Self = error "Type Self in phase 3" fromMyTy :: MyType -> Type fromMyTy (TyLit str) = (Haskell str) fromMyTy (TyData id) = NT (identifier id) [] False toMyAttr :: Direction -> MyType -> Attributes -> MyAttributes toMyAttr d dty = M.foldrWithKey (\ident ty as -> dty <.> (getName ident,d):as) [] completing :: FrGraph -> SchedRef s -> [Nt] -> ST s InterfaceRes completing ids sched nts = do ims <- forM nts $ completingN ids (fst sched) let threads = (M.fromList ims) writeSTRef (snd sched) threads return $ threads completingN :: FrGraph -> AttrAssRef s -> Nt -> ST s ((String, IM.IntMap [Vertex])) completingN ids@(idsf, idst) schedA (Nt nt_id _ _ inhs syns _) = do schedS <- newSTRef IM.empty let attrs = inhs ++ syns dty = TyData nt_id assign (attr,_,dAttr) = do let succs = idsf A.! attr assigned <- freeze schedA when (isNothing $ assigned A.! attr) $ do case IS.toList succs of [] ->wrap_up attr(if Syn==dAttr then 1 else 2) ss ->case selMax $ map (id&&&(assigned A.!)) ss of Nothing -> return () Just (a,mx) -> do let dA | even mx = Inh | otherwise = Syn wrap_up attr (if dA == dAttr then mx else mx+1) wrap_up attr k = do modifySTRef schedS (IM.insertWith (++) k [attr]) writeArray schedA attr (Just k) forM_ attrs assign selMax :: [(Vertex, Maybe Int)] -> Maybe (Vertex, Int) selMax [(v,mi)] = fmap ((,) v) mi selMax (x:xs) = case x of (a', Nothing) -> Nothing (a', Just i') -> case selMax xs of Nothing -> Nothing Just (a,i) -> case compare i i' of LT -> Just (a',i') _ -> Just (a,i) --make sure all are assigned case attrs of [] -> return (nt_id, IM.fromList [(1,[]),(2,[])]) as -> forM_ as assign >> readSTRef schedS >>= return . ((,) nt_id) fetchEdges :: FrGraph -> InterfaceRes -> [Nt] -> ([Edge],[Edge]) fetchEdges ids threads nts = let ivdNs = map (fetchEdgesN ids threads) nts in (concat *** concat) $ unzip ivdNs fetchEdgesN :: FrGraph -> InterfaceRes -> Nt -> ([Edge],[Edge]) fetchEdgesN (idsf, idst) threads (Nt nt_id _ _ _ _ _) = let sched = findWithErr threads "schedule err" nt_id mx = if IM.null sched then 0 else fst $ IM.findMax sched findK 0 = [] findK k = (maybe [] id $ IM.lookup k sched) ++ findK (k-1) ivd = [ (f,t) | k <- [2..mx] , f <- maybe [] id $ IM.lookup k sched , t <- findK (k-1)] in (ivd, [ (f, t) | (f, t) <- ivd , not $ IS.member t (idsf A.! f) ]) instance Show MyType where show TyInt = "Int" show TyBool = "Bool" show TyString = "String" show (TyData t) = t show (TyLit t) = show t show (TyArr a b) = show a ++ " -> (" ++ show b ++ ")" show NoType = error "Trying to show NoType" show AnyType = "AnyType" -- | Instance for Eq and Ord are required to make sure that AnyType -- | Equals every other type in every other situation instance Eq MyType where TyInt == TyInt = True TyBool == TyBool = True TyString == TyString = True TyData n == TyData n' = n == n' TyLit ty == TyLit ty' = ty == ty' TyArr l r == TyArr l' r' = l == l' && r == r' NoType == _ = False _ == NoType = False AnyType == _ = True _ == AnyType = True _ == _ = False instance Ord MyType where NoType `compare` _ = LT _ `compare` NoType = GT AnyType `compare` _ = EQ _ `compare` AnyType = EQ TyInt `compare` TyInt = EQ TyInt `compare` _ = LT TyBool `compare` TyInt = GT TyBool `compare` TyBool = EQ TyBool `compare` _ = LT TyString `compare` TyInt = GT TyString `compare` TyBool = GT TyString `compare` TyString = EQ TyString `compare` _ = LT TyData _ `compare` TyInt = GT TyData _ `compare` TyBool = GT TyData _ `compare` TyString = GT TyData a `compare` TyData b = compare a b TyData _ `compare` _ = LT TyLit a `compare` TyLit b = compare a b TyLit _ `compare` TyArr _ _= LT TyLit _ `compare` _ = GT TyArr a a' `compare` TyArr b b' = case compare a b of LT -> LT GT -> GT EQ -> compare a' b' TyArr _ _ `compare` _ = GT uuagc-0.9.52.2/src/LOAG/AOAG.hs0000644000000000000000000003070013433540502013614 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} module LOAG.AOAG where import LOAG.Common import LOAG.Graphs import LOAG.Rep import AbstractSyntax import CommonTypes import Control.Arrow ((&&&), (***)) import Control.Monad (forM, forM_, MonadPlus(..), when, unless) import Control.Monad.ST import Control.Monad.Error (ErrorT(..)) import Control.Monad.State (MonadState(..)) import Data.Maybe (fromMaybe, catMaybes, fromJust, isNothing) import Data.List (elemIndex, foldl', delete, (\\), insert, nub) import Data.STRef import Data.Tuple (swap) import qualified Data.Set as S import qualified Data.IntSet as IS import qualified Data.IntMap as IM import qualified Data.Map as M import Data.Array.MArray import qualified Data.Array as A import Data.Array.ST import ErrorMessages as Err import Pretty import UU.Scanner.Position data Settings = Settings { -- current minimum ads size prune_val :: Int -- whether to minimize the number of fake dependencies -- could be very costly , min_ads :: Bool } default_settings = Settings 999 False type AOAG s a = ST s a -- | Catch a type 3 cycle-error made by a given constructor -- | two alternatives are given to proceed type ADS = [Edge] type AOAGRes = Either Error LOAGRes -- | Calculate a total order if the semantics given -- originate from a linearly-ordered AG type2error,limiterror,aoagerror :: Error type2error = Err.CustomError False noPos $ text "Type 2 cycle" limiterror = Err.CustomError False noPos $ text "Limit reached" aoagerror = Err.CustomError False noPos $ text "Not an LOAG/AOAG" schedule :: LOAGRep -> Grammar -> Ag -> [Edge] -> AOAGRes schedule sem gram@(Grammar _ _ _ _ dats _ _ _ _ _ _ _ _ _) ag@(Ag bounds_s bounds_p de nts) ads = runST $ aoag default_settings ads where -- get the maps from semantics and translate them to functions nmp = (nmp_LOAGRep_LOAGRep sem) ofld = (ofld_LOAGRep_LOAGRep sem) genA = gen_LOAGRep_LOAGRep sem inss = inss_LOAGRep_LOAGRep sem -- select candidates, using the edge that caused the cycle -- from the list of intra-thread dependencies -- (intra-visit dependencies without edges in ids) candidates :: Edge -> Cycle -> [Edge] -> [Edge] candidates _ c = foldr (\(f,t) acc -> if f `IS.member` c &&t `IS.member` c then (t,f):acc else acc) [] -- | Move occurrence to its corresponding attribute gen :: Vertex -> Vertex gen v = genA A.! v genEdge :: Edge -> Edge genEdge (f,t) = (gen f, gen t) -- | Decide for a given production edge whether the vertices -- belong to the same field siblings :: Edge -> Bool siblings (f, t) = ofld A.! f == ofld A.! t -- | Given an nonterminal-edge, instantiate it -- assumes that the occurrences of fields are added in the same order instEdge :: Edge -> [Edge] instEdge (f, t) = zip (inss A.! f) (inss A.! t) aoag :: Settings -> [Edge] -> AOAG s AOAGRes aoag cfg init_ads = run where run :: AOAG s AOAGRes run = induced ads >>= detect detect (Left err) = return $ Left err detect (Right (dp,idp,ids@(idsf,idst))) = do -- Attribute -> TimeSlot schedA <- mapArray (const Nothing) idsf -- map TimeSlot -> [Attribute] schedS <- newSTRef $ foldr (\(Nonterminal nt _ _ _ _) -> M.insert (getName nt) (IM.singleton 1 [])) M.empty dats fr_ids <- freeze_graph ids threads <- completing fr_ids (schedA, schedS) nts let (ivd, comp) = fetchEdges fr_ids threads nts eRoC <- m_edp dp init_ads ivd comp (schedA, schedS) case eRoC of Left res -> return $ Right res Right (e,c,T3 cs) -> find_ads dp idp ids (schedA, schedS) e c cs find_ads :: Graph s -> Graph s -> Graph s -> SchedRef s -> Edge -> Cycle -> [Edge] -> AOAG s AOAGRes find_ads dp idp ids sched e cycle comp = do pruner <- newSTRef 999 explore dp idp ids sched init_ads pruner e cycle comp explore :: Graph s -> Graph s -> Graph s -> SchedRef s -> [Edge] -> STRef s Int -> Edge -> Cycle -> [Edge] -> AOAG s AOAGRes explore dp idp ids sched@(schedA, schedS) ads pruner e c comp = explore' dp idp ids sched ads (candidates e c comp) pruner where explore' :: Graph s -> Graph s -> Graph s -> SchedRef s -> [Edge] -> [Edge] -> STRef s Int -> AOAG s AOAGRes explore' _ _ _ _ _ [] _ = return $ Left aoagerror explore' dp idp ids sched@(schedA,schedS) ads (fd:cs) pruner = do p_val <- readSTRef pruner if length ads >= p_val -1 then return $ Left limiterror else do idpf_clone <- mapArray id (fst idp) idpt_clone <- mapArray id (snd idp) let idp_c = (idpf_clone, idpt_clone) idsf_clone <- mapArray id (fst ids) idst_clone <- mapArray id (snd ids) let ids_c = (idsf_clone, idst_clone) schedA_c <- mapArray id schedA schedS_v <- readSTRef schedS schedS_c <- newSTRef schedS_v let sched_c = (schedA_c, schedS_c) let runM = reschedule dp idp ids sched (fd:ads) fd pruner let backtrack = explore' dp idp_c ids_c sched_c ads cs pruner maoag <- runM case maoag of Left _ -> backtrack Right (tdp1,inf1,ads1) -> if LOAG.AOAG.min_ads cfg then do writeSTRef pruner (length ads1) maoag' <- backtrack case maoag' of Right (tdp2,inf2,ads2) -> return $ Right (tdp2,inf2,ads2) otherwise -> return $ Right (tdp1,inf1,ads1) else return $ Right (tdp1,inf1,ads1) -- step 1, 2 and 3 induced :: [Edge] -> AOAG s (Either Error (Graph s, Graph s, Graph s)) induced ads = do dpf <- newArray bounds_p IS.empty dpt <- newArray bounds_p IS.empty idpf <- newArray bounds_p IS.empty idpt <- newArray bounds_p IS.empty idsf <- newArray bounds_s IS.empty idst <- newArray bounds_s IS.empty let ids = (idsf,idst) let idp = (idpf,idpt) let dp = (dpf ,dpt) inducing dp idp ids (de ++ ads) inducing :: Graph s -> Graph s -> Graph s -> [Edge] -> AOAG s (Either Error (Graph s, Graph s, Graph s)) inducing dp idp ids es = do res <- adds (addD dp idp ids) [] es case res of Left _ -> return $ Left $ type2error Right _ -> return $ Right (dp, idp, ids) addD :: Graph s -> Graph s -> Graph s -> Edge -> AOAG s (Either Error [Edge]) addD dp' idp' ids' e = do resd <- e `insErt` dp' resdp <- e `inserT` idp' case resdp of Right es -> adds (addN idp' ids') [] (e:es) Left c -> return $ Left $ type2error addI :: Graph s -> Graph s -> Edge -> AOAG s (Either Error [Edge]) addI idp' ids' e = do exists <- member e idp' if not exists then do res <- e `inserT` idp' case res of Right es -> adds (addN idp' ids') [] es Left c -> return $ Left $ type2error else return $ Right [] adds f acc [] = return $ Right acc adds f acc (e:es) = do mes <- f e case mes of Left err -> return $ Left err Right news -> adds f (acc++news) es addN :: Graph s -> Graph s -> Edge -> AOAG s (Either Error [Edge]) addN idp' ids' e = do if (siblings e) then do let s_edge = genEdge e exists <- member s_edge ids' if not exists then do _ <- inserT s_edge ids' let es = instEdge s_edge addedEx <- adds (addI idp' ids') [] es case addedEx of Right news -> return $ Right (s_edge : news) Left err -> return $ Left err else return $ Right [] else return $ Right [] -- step 6, 7 m_edp :: Graph s -> [Edge] -> [Edge] -> [Edge] -> SchedRef s -> AOAG s (Either LOAGRes (Edge,Cycle,CType)) m_edp (dpf, dpt) ads ivd comp sched = do edpf <- mapArray id dpf edpt <- mapArray id dpt mc <- addEDs (edpf,edpt) (concatMap instEdge ivd) case mc of Just (e, c) -> return $ Right (e,c,T3 $ concatMap instEdge comp) Nothing -> do tdp <- freeze edpt infs <- readSTRef (snd sched) return $ Left (Just tdp,infs,ads) reschedule :: Graph s -> Graph s -> Graph s -> SchedRef s -> [Edge] -> Edge -> STRef s Int -> AOAG s AOAGRes reschedule dp idp ids sched@(_,threadRef) ads e pruner = do extra <- addN idp ids e case extra of Left err -> return $ Left err Right extra -> do forM_ extra $ swap_ivd ids sched fr_ids <- freeze_graph ids threads <- readSTRef threadRef let (ivd, comp) = fetchEdges fr_ids threads nts eRoC <- m_edp dp ads ivd comp sched case eRoC of Left res -> return $ Right res Right (e,c,(T3 cs)) -> explore dp idp ids sched ads pruner e c cs where swap_ivd :: Graph s -> SchedRef s -> Edge -> AOAG s () swap_ivd ids@(idsf, idst) sr@(schedA, schedS) (f,t) = do --the edge should point from higher to lower timeslot assigned <- freeze schedA let oldf = maybe (error "unassigned f") id $ assigned A.! f oldt = maybe (error "unassigned t") id $ assigned A.! t dirf = snd $ alab $ nmp M.! f dirt = snd $ alab $ nmp M.! t newf | oldf < oldt = oldt + (if dirf /= dirt then 1 else 0) | otherwise = oldf nt = show $ typeOf $ nmp M.! f -- the edge was pointing in wrong direction so we moved -- the attribute to a new interaction, now some of its -- predecessors/ancestors might need to be moved too unless (oldf == newf) $ do writeArray schedA f (Just newf) modifySTRef schedS (M.adjust (IM.update (Just . delete f) oldf) nt) modifySTRef schedS (M.adjust(IM.alter(Just. maybe [f] (insert f))newf)nt) predsf <- readArray idst f succsf <- readArray idsf f let rest = (map (flip (,) f) $ IS.toList predsf) ++ (map ((,) f) $ IS.toList succsf) in mapM_ (swap_ivd ids sr) rest uuagc-0.9.52.2/src/LOAG/Graphs.hs0000644000000000000000000001323113433540502014331 0ustar0000000000000000module LOAG.Graphs where import Control.Monad (forM, forM_) import Control.Monad.ST import Control.Monad.State import CommonTypes import Data.STRef import Data.Maybe (catMaybes, isNothing, fromJust) import Data.Tuple (swap) import qualified Data.Array as A import Data.Array.IArray (amap) import qualified Data.IntMap as IM import qualified Data.IntSet as IS import qualified Data.Map as M import qualified Data.Set as S import Data.Array.MArray (mapArray) import Data.Array.ST type Schedule = (A.Array Vertex (Maybe Int), A.Array Int [Vertex]) type Vertex = Int type Cycle = IS.IntSet type Vertices = IS.IntSet type Edge = (Vertex, Vertex) type Edges = S.Set Edge -- Maps that are suitable for Graphs (from 1 node to a set of nodes) type Graph s = (DirGraphRef s, DirGraphRef s) -- | Frozen version of a graph type FrGraph = (DirGraph, DirGraph) type DirGraph = A.Array Vertex Vertices type DirGraphRef s = STArray s Vertex Vertices -- |---------------------------------------------------------------------- -- | Functions for changing the state within AOAG -- | possibly catching errors from creating cycles addEDs :: Graph s -> [Edge] -> (ST s) (Maybe (Edge, Cycle)) addEDs _ [] = return Nothing addEDs edp (e:es) = do res <- e `inserT` edp case res of Right _ -> addEDs edp es Left c -> return $ Just (e,c) -- | Draws an edge from one node to another, by adding the latter to the -- node set of the first insErt :: Edge -> Graph s -> (ST s) () insErt (f, t) g@(ft,tf) = do ts <- readArray ft f fs <- readArray tf t writeArray ft f (t `IS.insert` ts) writeArray tf t (f `IS.insert` fs) removE :: Edge -> Graph s -> (ST s) () removE e@(f,t) g@(ft,tf) = do ts <- readArray ft f fs <- readArray tf t writeArray ft f (t `IS.delete` ts) writeArray tf t (f `IS.delete` fs) -- | Revert an edge in the graph revErt :: Edge -> Graph s -> (ST s) () revErt e g = do present <- member e g when present $ removE e g >> insErt (swap e) g -- | Assuming the given graph is already transitively closed, and -- | not cyclic, insert an -- | edge such that the graph maintains transitively closed. -- | returns the cycle if this results in a cycle or returns a pair -- | (graph, edges) if not. Where graph is the new Graph and -- | edges represent the edges that were required for transitively -- | closing the graph. inserT :: Edge -> Graph s -> (ST s) (Either Cycle [Edge]) inserT e@(f, t) g@(gft,gtf) | f == t = return $ Left $ IS.singleton f | otherwise = do present <- member e g if present then (return $ Right []) else do rs <- readArray gtf f us <- readArray gft t pointsToF <- readArray gtf f pointsToT <- readArray gtf t tPointsTo <- readArray gft t let new2t = pointsToF IS.\\ pointsToT -- extras from f connects all new nodes pointing to f with t let extraF = IS.foldl' (\acc tf -> (tf,t) : acc) [] new2t -- extras of t connects all nodes that will be pointing to t -- in the new graph, with all the nodes t points to in the -- current graph all2tPointsTo <- newSTRef [] forM_ (IS.toList tPointsTo) $ \ft -> do current <- readSTRef all2tPointsTo existing <- readArray gtf ft let new4ft = map (flip (,) ft) $ IS.toList $ -- removing existing here matters a lot (f `IS.insert` pointsToF) IS.\\ existing writeSTRef all2tPointsTo $ current ++ new4ft extraT <- readSTRef all2tPointsTo -- the extras consists of extras from f and extras from t -- both these extra sets dont contain edges if they are already -- present in the old graph let extra = extraF ++ extraT mapM_ (`insErt` g) (e : extra) -- the new graph contains a cycle if there is a self-edge -- this cycle will contain both f and t cyclic <- member (f,f) g if cyclic then do cycle <- getCycle gft return $ Left cycle else return $ Right extra where -- given that there is a cycle,all elements of this cycle are being -- pointed at by f. However, not all elements that f points to are -- part of the cycle. Only those that point back to f. getCycle :: STArray s Vertex Vertices -> (ST s) Cycle getCycle gft = do ts <- readArray gft f mnodes <- forM (IS.toList ts) $ \t' -> do fs' <- readArray gft t' if f `IS.member` fs' then return $ Just t' else return $ Nothing return $ IS.fromList $ catMaybes mnodes -- | Check if a certain edge is part of a graph which means that, -- | the receiving node must be in the node set of the sending member :: Edge -> Graph s -> (ST s) Bool member (f, t) (ft, tf) = do ts <- readArray ft f return $ IS.member t ts -- | Check whether an edge is part of a frozen graph fr_member :: FrGraph -> Edge -> Bool fr_member (ft, tf) (f, t) = IS.member t (ft A.! f) -- | Flatten a graph, meaning that we transform this graph to -- | a set of Edges by combining a sending node with all the -- | receiving nodes in its node set flatten :: Graph s -> (ST s) Edges flatten (gft, _) = do list <- getAssocs gft return $ S.fromList $ concatMap (\(f, ts) -> map ((,) f) $ IS.toList ts) list freeze_graph :: Graph s -> (ST s) FrGraph freeze_graph (mf, mt) = do fr_f <- freeze mf fr_t <- freeze mt return (fr_f, fr_t) uuagc-0.9.52.2/src/LOAG/Optimise.hs0000644000000000000000000002711013433540502014677 0ustar0000000000000000 module LOAG.Optimise where import LOAG.Common import LOAG.Graphs import LOAG.Solver.MiniSat import Control.Arrow ((&&&)) import Control.Monad (forM, forM_, when, foldM) import Control.Monad.ST import Data.Array.MArray import Data.Array.IO import Data.Function (on) import qualified Data.IntMap as IM import qualified Data.IntSet as IS import qualified Data.Map as M import Data.Maybe (fromJust, isJust) import Data.List (intercalate, sort, sortBy) type Opts = [Opt] data Opt= Smaller (Vertex) (Vertex) -- x < y | Greater (Vertex) (Vertex) -- x > y | AllSmaller (Vertex) Direction -- _ < x | AllGreater (Vertex) Direction -- _ > x | MinVisits deriving (Ord, Eq) instance Show Opt where show (Smaller f t) = show f ++ " --> " ++ show t show (Greater f t) = show f ++ " <-- " ++ show t show (AllSmaller f _) = " _ --> " ++ show f show (AllGreater f _) = " _ <-- " ++ show f show MinVisits = " Minimising #visits " optimise :: Sat -> VarMap -> Opts -> (Int,Int) -> [Nt] -> InterfaceRes -> IO () optimise sat varMap opts nbounds nts interfaces = do let scheduler = newSchedule sat varMap nbounds mapM_ (singleOpt sat varMap scheduler nts interfaces) (sort opts) b <- satsolve sat [] return () -- | Given a non-terminal and a current best schedule -- return a new best schedule and whether the new schedule is truely new type SchedulerNt = Nt -> IM.IntMap [Vertex] -> IO (Bool, IM.IntMap [Vertex]) type Scheduler = IM.IntMap [Vertex] -> IO (Bool, IM.IntMap [Vertex]) singleOpt :: Sat -> VarMap -> SchedulerNt -> [Nt] -> InterfaceRes -> Opt -> IO () singleOpt sat varMap scheduler nts interfaces opt = do success <- case opt of Smaller f t -> tryPair sat $ varOf f t Greater f t -> tryPair sat $ varOf t f AllSmaller f d -> trySingle sat False f d varMap AllGreater f d -> trySingle sat True f d varMap MinVisits -> do mapM_ (minPaths sat varMap scheduler interfaces) $ sortNfilter weigh nts return True return () where weigh (Nt _ _ _ is ss _) = size where size = length is + length ss varOf f t = case M.lookup (f,t) varMap of Just v -> v Nothing -> case M.lookup (t,f) varMap of Just v -> varnot v Nothing -> error "invalid optimisation.." sortNfilter :: (a -> Int) -> [a] -> [a] sortNfilter f = map fst . sortBy (on compare snd) . filter (((/=) 0) . snd) . map (id &&& f) minPaths :: Sat -> VarMap -> SchedulerNt -> InterfaceRes -> Nt -> IO Bool minPaths sat varMap scheduler interfaces tp@(Nt nt _ _ is ss _) = do forM_ neckCs $ attemptGroup sat (scheduler tp) mym . map varnot return True where neckCs= map (\(_,es,b) -> map (uncurry (mvar b)) es) $ bottlenecks mx mym mvar b f t | b = varMap M.! (f,t) | not b = varnot $ varMap M.! (t,f) mym = interfaces M.! nt mx | IM.null mym = 0 | otherwise = fst $ IM.findMax mym bottlenecks :: Int -> IM.IntMap [Vertex] -> [(((Int,[Vertex]),(Int,[Vertex])),[Edge],Bool)] bottlenecks x shd = sortNfilter cost $ pairs x where pairs x | x <= 1 = [] | x > 1 = let pair = ((x,maybe [] id $ IM.lookup x shd) ,(x-1,maybe [] id$IM.lookup (x-1) shd)) in (pair,edges pair,even x) : pairs (x-1) cost (((p1,p1s),(p2,p2s)),es,_) = size where size = length es edges ((p1,p1s),(p2,p2s)) = [ (f,t) | f <- p1s, t <- p2s ] -- | get all combinations of partitions from different `directions' -- ordered by distance (shortest paths first) edgeCombs :: Int -> IM.IntMap [Vertex] -> [(Int,Int)] edgeCombs x shd = sortBy (on compare cost) $ concat $ takeWhile (not . null) $ map (\(n,es) -> filter ((>0) . snd) (map (\(f,t) -> (f+n,t+n)) es)) $ zip [-0,-1..] $ repeat (map ((,) x) [x-1,x-3..1]) where cost (x1,x2) = length $ findK (x1 -1) where findK n | n < x2 = [] | n >= x2 = (shd IM.! n) ++ findK (n-2) tryPair :: Sat -> MyVar -> IO Bool tryPair sat p = do b <- satsolve sat [p] if b then addClause sat [p] else return False attemptGroup :: Sat -> Scheduler -> IM.IntMap [Vertex] -> [MyVar] -> IO (IM.IntMap [Vertex]) attemptGroup sat scheduler interfaces = tryGroup sat scheduler interfaces . filter notSet where notSet (Var _) = True notSet (VarNot v) = notSet v notSet _ = False tryGroup :: Sat -> Scheduler -> IM.IntMap [Vertex] -> [MyVar] -> IO (IM.IntMap [Vertex]) tryGroup _ _ interfaces [] = return interfaces tryGroup sat scheduler interfaces ps = do xs <- mapM (const (newLit sat)) ps mapM (\(a,r) -> addClause sat [varnot a, r]) $ zip xs ps b <- satsolve sat xs let success = assertVars sat xs fail = assertVars sat (map varnot (xs++ps)) >> satsolve sat [] if b then do (improved, sched) <- scheduler interfaces if improved then success >> return sched else fail >> return interfaces else fail >> return interfaces assertVars :: Sat -> [MyVar] -> IO () assertVars sat vars = do bs <- mapM (addClause sat . (:[])) vars return () trySingle :: Sat -> Bool -> Vertex -> Direction -> VarMap -> IO Bool trySingle sat des f dir varMap = do vars <- tryExtreme sat des literals assertVars sat vars return True where literals = M.foldWithKey select [] varMap select k a b | fst k == f = a : b --inh | snd k == f = varnot a : b --syn | otherwise = b tryExtreme :: Sat -> Bool -> [MyVar] -> IO [MyVar] tryExtreme sat des xs = do a <- newLit sat switch <- newLit sat let try xs = do --putStrLn ("currently, " ++ show (length xs) ++ " literals") let assertOne | des = map varnot (a : xs) | otherwise = varnot a : xs addClause sat assertOne --"if a, then one of xs must be ~des" b <- satsolve sat [a] if b then do xbs <- sequence [ do v <- value sat x return (x,v) | x <- xs ] sequence_ [ do let desx | des = x | otherwise = varnot x addClause sat [varnot a, desx] addClause sat [varnot switch, desx] | (x,b) <- xbs, b /= Just des ] try [ x | (x,Just des) <- xbs ] else do addClause sat [varnot a] return [switch] in try xs -- | Recalculate interface based on SAT and compare with a given one newSchedule :: Sat -> VarMap -> (Int,Int) -> Nt -> IM.IntMap [Vertex] -> IO (Bool, IM.IntMap [Vertex]) newSchedule sat varMap nbounds tp@(Nt nt _ _ inhs outs _ ) sched = do idsf <- newArray nbounds IS.empty :: IO (IOArray Vertex Vertices) idst <- newArray nbounds IS.empty :: IO (IOArray Vertex Vertices) let ids = (idsf,idst) sequence_ [ do v <- value sat pred case v of Nothing -> error "no val" Just True -> addEdges (i,s) ids Just False-> addEdges (s,i) ids | (i,ios,_) <- inhs , (s,sos,_) <- outs , let pred = varMap M.! (i,s) ] f_idsf <- freeze idsf f_idst <- freeze idst let (_,newinterface) = runST $ do schedA <- newArray nbounds Nothing completingN (f_idsf,f_idst) schedA tp newmx | IM.null newinterface = 0 | otherwise = fst $ IM.findMax newinterface oldmx | IM.null sched = 0 | otherwise = fst $ IM.findMax sched newsched | newmx < oldmx = newinterface | otherwise = sched return $ (newmx < oldmx, newsched) where addEdges (f,t) (idsf,idst) = do modifyArray idsf f (t `IS.insert`) modifyArray idst t (f `IS.insert`) -- | count the (max, avg, total) number of visits getVisCount :: [Nt] -> InterfaceRes -> VisCount getVisCount nts interfaces = (mx, tot, (fromIntegral tot) / (fromIntegral $ length nts)) where count (mx,tot) (Nt nt _ _ _ _ _) = (max mx k,tot + k) where m = interfaces M.! nt k | IM.null m = 0 | otherwise = ((fst $ IM.findMax m) + 1) `div` 2 (mx, tot) = foldl count (0,0) nts --- minimisation functions ------------------------------------------------------------------------------- globalMinimum :: Sat -> Bool -> [MyVar] -> IO [MyVar] globalMinimum sat des xs = do ys <- sort sat xs let mini (i,j) | i >= j = return [] mini (i,j) = do putStrLn ("trying " ++ show (i,j)) b <- satsolve sat [varnot (ys !! k)] if b then mini (k+1,j) else mini (i,k) where k = (i+j) `div` 2 in mini (0,length ys) xbs <- sequence [ do v <- value sat x return (x,v) | x <- xs ] return [ x | (x,Just True) <- xbs ] where sort sat [] = do return [] sort sat [x] = do return [x] sort sat xs = do as <- sort sat (take k xs) bs <- sort sat (drop k xs) map fromJust `fmap` merge (map Just as) (map Just bs) where k = length xs `div` 2 merge2 Nothing b = return (b, Nothing) merge2 a Nothing = return (a, Nothing) merge2 (Just x) (Just y) = do a <- newLit sat b <- newLit sat addClause sat [varnot x, b] -- x => b addClause sat [varnot y, b] -- y => b addClause sat [varnot x, varnot y, a] -- x => ~y || a addClause sat [x, varnot a] -- ~x => ~a addClause sat [y, varnot a] -- ~y => ~a addClause sat [x, y, varnot b] -- ~x => y || ~b return (Just a,Just b) merge [] bs = return bs merge as [] = return as merge [a] [b] = (\(a,b) -> [a,b]) `fmap` merge2 a b merge as bs = take (a+b) `fmap` merge' (as ++ xas) (bs ++ xbs) where a = length as b = length bs m = a `max` b n = if even m then m else m+1 xas = replicate (n-a) Nothing xbs = replicate (n-b) Nothing -- pre: as and bs have the same, even length merge' as bs = do xs <- merge eas ebs ys <- merge oas obs let x:xys = weave xs ys xys' <- sequence [ merge2 a b | (a,b) <- pairs xys ] return (x : unpairs xys' ++ [last xys]) where (eas,oas) = evenOdds as (ebs,obs) = evenOdds bs evenOdds [] = ([], []) evenOdds [x] = ([x], []) evenOdds (x:y:xs) = (x:es,y:os) where (es,os) = evenOdds xs pairs (x:y:xs) = (x,y) : pairs xs pairs _ = [] unpairs ((x,y):xys) = x : y : unpairs xys unpairs [] = [] weave (x:xs) (y:ys) = x : y : weave xs ys weave xs ys = xs ++ ys ------------------------------------------------------------------------------ uuagc-0.9.52.2/src/LOAG/Chordal.hs0000644000000000000000000002473113433540502014470 0ustar0000000000000000{-# LANGUAGE CPP #-} module LOAG.Chordal where #ifdef WITH_LOAG import LOAG.Common import LOAG.Graphs import LOAG.Optimise import LOAG.Solver.MiniSat import Options import Control.Monad (unless, forM, when, foldM) import Control.Monad.ST import qualified Data.Array as A import Data.Array.IO import Data.Array.ST as ST import qualified Data.IntMap as IM import qualified Data.IntSet as IS import qualified Data.Map as M import Data.Maybe (isNothing, catMaybes) import qualified Data.Set as S import Data.STRef type Neigh = (Vertex, EdgeType) data EdgeType = Sib MyVar -- Edge between siblings | Any MyVar -- Unknown | NSib MyVar -- Edge between non-siblings deriving (Show) extract (Sib l) = l extract (Any l) = l extract (NSib l)= l neg :: EdgeType -> EdgeType neg (Sib p) = Sib $ varnot p neg (NSib p) = NSib $ varnot p neg (Any p) = Any $ varnot p type NtGraph = IM.IntMap [(Vertex,MyVar)] type ToChordal = IM.IntMap [Neigh] type SatEdge = (Vertex, Neigh) addClauses :: Sat -> [[EdgeType]] -> IO () addClauses sat = mapM_ (addClause sat . map extract) toChordal :: [(Edge,EdgeType)] -> IO ToChordal toChordal es = let edges = concatMap (\((a,b),c) -> [(a,[(b,c)]),(b,[(a,neg c)])]) es in return $ IM.fromListWith (++) edges toNtGraph :: [(Edge,MyVar)] -> IO NtGraph toNtGraph es = let edges = concatMap (\((a,b),c) -> [(a,[(b,c)]),(b,[(a,varnot c)])]) es in return $ IM.fromListWith (++) edges remove :: Vertex -> [Neigh] -> ToChordal -> ToChordal remove v ns g = foldr (IM.adjust remN . fst) (IM.delete v g) ns where remN ns = filter ((/= v).fst) ns adds :: ToChordal -> [SatEdge] -> ToChordal adds g = foldl add g add :: ToChordal -> SatEdge -> ToChordal add g (v,n@(v2,c)) = IM.adjust (n:) v $ IM.adjust ((v,neg c):) v2 g removeNt :: Vertex -> [(Vertex,MyVar)] -> NtGraph -> NtGraph removeNt v ns g = foldr (IM.adjust remN . fst) (IM.delete v g) ns where remN ns = filter ((/= v).fst) ns addsNt g = foldl addNt g addNt g (v,n@(v2,c)) = IM.adjust (n:) v $ IM.adjust ((v,varnot c):) v2 g scheduleLOAG :: Ag -> (String -> IO ()) -> Options -> IO LOAGRes scheduleLOAG ag@(Ag nbounds pbounds dps nts) putStrLn opts = do let optim | minvisits opts = [MinVisits] -- todo: allow specification of more optimisations | otherwise = [] putStrLn "--- Starting ---" sat <- newSolvable varMap <- noNtCycles sat nts putStrLn noPrCycles sat prs varMap putStrLn (v,p) <- satValues sat putStrLn $ "nr. of variables: " ++ show v putStrLn $ "nr. of clauses: " ++ show p putStrLn "--- Solving ---" b <- satsolve sat [] if not b then error "Not LOAG" else do putStrLn "--- Constructing Interfaces ---" (ids,edp,interfaces) <- loagRes sat varMap dps let oldct = getVisCount nts interfaces when (minvisits opts) $ putStrLn "--- Minimising #Visit" optimise sat varMap optim nbounds nts interfaces (ids',edp',interfaces') <- loagRes sat varMap dps let visC@newct = getVisCount nts interfaces' when (minvisits opts) $ do putStrLn ("--- #Visits (max,sum,avg) " ++(show oldct) ++" --> " ++(show newct)) putStrLn "--- Code Generation ---" return (Just edp',interfaces',[]) where loagRes sat varMap dps = do (ids,edp) <- mkGraphs sat varMap dps interfaces <- mkInterfaces ids return (ids,edp,interfaces) prs = [ p | (Nt _ _ _ _ _ ps) <- nts, p <- ps] mkInterfaces ids = return $ runST $ do schedA <- newArray nbounds Nothing schedS <- newSTRef $ foldr (\(Nt nt _ _ _ _ _) -> M.insert nt (IM.singleton 1 [])) M.empty nts completing ids (schedA, schedS) nts mkGraphs :: Sat -> M.Map Edge MyVar -> [Edge] -> IO (FrGraph,TDPRes) mkGraphs sat varMap dps = do idsf <- newArray nbounds IS.empty :: IO (IOArray Vertex Vertices) idst <- newArray nbounds IS.empty :: IO (IOArray Vertex Vertices) edp <- newArray pbounds IS.empty :: IO (IOArray Vertex Vertices) let (ids) = (idsf,idst) sequence_ [ do v <- value sat pred case v of Nothing -> error "no val" Just True -> addEdges (i,s) (zip ios sos) ids edp Just False-> addEdges (s,i) (zip sos ios) ids edp | Nt _ _ _ inhs outs _ <- nts , (i,ios,_) <- inhs , (s,sos,_) <- outs , let pred = varMap M.! (i,s) ] forM dps $ \(f,t) -> do modifyArray edp t (f `IS.insert`) f_idsf <- freeze idsf f_idst <- freeze idst f_edp <- freeze edp return ((f_idsf,f_idst),f_edp) where addEdges (f,t) es (idsf,idst) edp = do modifyArray idsf f (t `IS.insert`) modifyArray idst t (f `IS.insert`) forM es $ \(f,t) -> do --edp does not reflect flow modifyArray edp t (f `IS.insert`) noCyclesNt :: Sat -> NtGraph -> IO () noCyclesNt sat g | IM.null g = return () | otherwise = do news <- sequence [ noTriangleNt sat g p q | (p,q) <- pairs neighs] let g' = addsNt (removeNt node neighs g) (concat news) noCyclesNt sat g' where node = snd $ minimum [ (length xs, a) | (a,xs) <- IM.toList g ] Just neighs = IM.lookup node g noTriangleNt :: Sat -> NtGraph -> (Vertex, MyVar) -> (Vertex, MyVar) -> IO [(Vertex,(Vertex,MyVar))] noTriangleNt sat g e1@(t1,c1) e2@(t2,c2) = case IM.lookup t1 g of Just ns -> case [ c | (t2',c) <- ns, t2' == t2 ] of [] -> do c3 <- newLit sat ruleOut c1 c2 c3 return [(t1,(t2,c3))] [c3] -> ruleOut c1 c2 c3 >> return [] _ -> error "multiple edges between two nodes" Nothing -> error "pointer outside of graph" where ruleOut ea eb ab= do addClause sat [ea, ab, varnot eb] addClause sat [varnot ea,varnot ab,eb] noCyclesPr :: Sat -> ToChordal -> IO () noCyclesPr sat g | IM.null g = return () | otherwise = do news <- sequence [ noTriangle sat g p q | (p,q) <- validPairs neighs] let g' = adds (remove node neighs g) (concat news) noCyclesPr sat g' where node = snd $ minimum [ (weight xs, a) | (a,xs) <- IM.toList g ] Just neighs = IM.lookup node g validPairs ns = [ (p,q) | p <- sibs, q <- nsibs ] ++ [ (p,q) | p <- nsibs, q <- anys ] ++ [ (p,q) | p <- sibs, q <- anys ] ++ (pairs anys) where sibs = [ n | n@(_,Sib _) <- ns ] nsibs= [ n | n@(_,NSib _) <- ns ] anys = [ n | n@(_,Any _) <- ns ] weight :: [Neigh] -> Int weight xs = ss*3 * (ds + cs) + (ds + cs)^2 where ss = length [ x | x@(_,Sib _) <- xs ] ds = length [ x | x@(_,NSib _) <- xs ] cs = length [ x | x@(_,Any _) <- xs ] noTriangle :: Sat -> ToChordal -> Neigh -> Neigh -> IO [SatEdge] noTriangle sat g e1@(t1,c1) e2@(t2,c2) = case IM.lookup t1 g of Just ns -> case [ c | (t2',c) <- ns, t2' == t2 ] of [] -> do p <- newLit sat ruleOut c1 c2 (Any p) return [(t1,(t2,(Any p)))] [c3] -> ruleOut c1 c2 c3 >> return [] _ -> error "multiple edges between two nodes" Nothing -> error "pointer outside of graph" where ruleOut ea eb ab= addClauses sat [[ea, ab, neg eb],[neg ea,neg ab,eb]] noNtCycles :: Sat -> [Nt] -> (String -> IO ()) -> IO VarMap noNtCycles sat tps putStrLn = do putStrLn "--- Non-Terminals ---" maps <- mapM forNt tps return $ M.unions maps where -- at non-terminal level, all cycles are between siblings -- that is why we force all the edges to be the same -- (not filtered by validPairs) forNt tp@(Nt tid dpf dpt inhs syns _) = do vars <- satValues sat putStrLn ("nt : " ++ tid ++ " ... " ++ show vars ++ " ...") when (not $ S.null $ S.fromList dpf `S.intersection` S.fromList (map (\(a,b) -> (b,a)) dpt)) $ error "Type 2 cycle of length 2" ass <- sequence $ [ return ((i,s),VarTrue) | ((i,s)) <- dpf ]++ [ return ((i,s),VarFalse)| ((s,i)) <- dpt ] let assM = M.fromList ass mvars<- sequence [ if new then do p <- newLit sat return $ Just ((i,s),p) else return Nothing | (i,_,_) <- inhs , (s,_,_) <- syns , let mmv = maybe (M.lookup (s,i) assM) Just (M.lookup (i,s) assM) new = isNothing mmv ] let vars = ass ++ catMaybes mvars g <- toNtGraph vars noCyclesNt sat g return $ M.fromList vars noPrCycles :: Sat -> [Pr] -> VarMap -> (String -> IO ()) -> IO () noPrCycles sat prods varMap putStrLn = do putStrLn "--- Productions ---" mapM_ forProd prods where forProd (Pr prod es ses fs) | length fs ==1 = return () --taken care of | otherwise = do vars <- satValues sat putStrLn ("prod: " ++ show prod ++ " ... " ++ show vars ++ " ...") g <- toChordal (sibs ++ dps) noCyclesPr sat g where sibs= [ ((f,t),Sib c) | (e@(f,t),ge,_) <- ses , let c = case M.lookup ge varMap of Just p -> p Nothing -> error "no var found"] dps = [ (e,NSib VarTrue) | e <- es ] #else scheduleLOAG = error "You need to install uuagc with the -fwith-loag flag in order to use the --loag option." #endif uuagc-0.9.52.2/src/LOAG/Solver/0000755000000000000000000000000013433540502014023 5ustar0000000000000000uuagc-0.9.52.2/src/LOAG/Solver/MiniSat.hs0000644000000000000000000000504313433540502015725 0ustar0000000000000000 module LOAG.Solver.MiniSat ( newSolvable,-- IO SatContainer newLit, -- Sat -> IO MyVar satValues, -- Sat -> IO (Int, Int) addClause, -- Sat -> [MyVar] -> IO () satsolve, -- Sat -> IO Bool value, -- Sat -> IO (Maybe Bool) fixed, -- Sat -> IO Bool MyVar(..), Sat, varnot, VarMap, Mini.conflict ) where import LOAG.Graphs import Control.Monad import Data.Maybe import qualified Data.Map as M import qualified MiniSat as Mini type Sat = Mini.Solver type VarMap = M.Map Edge MyVar data MyVar = Var Mini.Lit | VarTrue | VarFalse | VarNot MyVar deriving (Show, Eq) varnot :: MyVar -> MyVar varnot v@(Var i) = Var (Mini.neg i) varnot (VarNot v)= v varnot VarFalse = VarTrue varnot VarTrue = VarFalse newSolvable :: IO Mini.Solver newSolvable = do sat <- Mini.newSolver Mini.eliminate sat True return sat newLit :: Sat -> IO MyVar newLit sat = do p <- Mini.newLit sat return (Var (Mini.neg p)) satValues :: Sat -> IO (Int,Int) satValues sat = do v <- Mini.minisat_num_vars sat p <- Mini.minisat_num_clauses sat return (v,p) addClause :: Sat -> [MyVar] -> IO Bool addClause sat [] = return True addClause sat es = do if satisfied then return True else case fes of [] -> error "unsatisfiable" fes -> Mini.addClause sat $ map toMini fes where satisfied = any (True ==?) es fes = filter (not . (False ==?)) es b ==? v = case v of VarTrue -> b VarFalse -> not b _ -> False toMini :: MyVar -> Mini.Lit toMini (Var v) = v toMini (VarNot v) = Mini.neg (toMini v) _ = error "incorrect clause filtering" satsolve :: Sat -> [MyVar] -> IO Bool satsolve sat = Mini.solve sat . map extract extract :: MyVar -> Mini.Lit extract VarTrue = error "cannot extract True" extract VarFalse = error "cannot extract False" extract (VarNot v) = Mini.neg (extract v) extract (Var l) = l value :: Sat -> MyVar -> IO (Maybe Bool) value _ VarTrue = return $ Just True value _ VarFalse = return $ Just False value sat (VarNot v) = value sat v >>= return . fmap not value sat (Var v) = Mini.modelValue sat v fixed :: Sat -> MyVar -> IO Bool fixed _ VarTrue = return $ True fixed _ VarFalse = return $ True fixed sat (VarNot v)= fixed sat v fixed sat (Var l) = Mini.value sat l >>= return . isJust