uuagc 0.9.53 → 0.9.53.1
raw patch · 82 files changed
+94732/−80075 lines, 82 files
Files
- src-ag/AG2AspectAG.ag +857/−0
- src-ag/AbstractSyntax.ag +76/−0
- src-ag/AbstractSyntaxDump.ag +76/−0
- src-ag/Code.ag +163/−0
- src-ag/CodeSyntax.ag +90/−0
- src-ag/CodeSyntaxDump.ag +103/−0
- src-ag/ConcreteSyntax.ag +132/−0
- src-ag/DeclBlocks.ag +20/−0
- src-ag/DefaultRules.ag +821/−0
- src-ag/Desugar.ag +332/−0
- src-ag/DistChildAttr.ag +4/−4
- src-ag/ErrorMessages.ag +148/−0
- src-ag/ExecutionPlan.ag +83/−0
- src-ag/ExecutionPlan2Caml.ag +1487/−0
- src-ag/ExecutionPlan2Clean.ag +1684/−0
- src-ag/ExecutionPlan2Hs.ag +1711/−0
- src-ag/ExecutionPlanCommon.ag +3/−3
- src-ag/ExecutionPlanPre.ag +1/−1
- src-ag/Expression.ag +12/−0
- src-ag/GenerateCode.ag +1191/−0
- src-ag/HsToken.ag +33/−0
- src-ag/Interfaces.ag +16/−0
- src-ag/KWOrder.ag +217/−0
- src-ag/LOAG/Order.ag +435/−0
- src-ag/LOAG/Rep.ag +49/−0
- src-ag/Macro.ag +24/−0
- src-ag/Order.ag +809/−0
- src-ag/Patterns.ag +25/−0
- src-ag/PrintCleanCode.ag +563/−0
- src-ag/PrintCode.ag +542/−0
- src-ag/PrintErrorMessages.ag +656/−0
- src-ag/PrintOcamlCode.ag +222/−0
- src-ag/PrintVisitCode.ag +53/−0
- src-ag/ResolveLocals.ag +157/−0
- src-ag/SemHsTokens.ag +144/−0
- src-ag/TfmToVisage.ag +147/−0
- src-ag/Transform.ag +1371/−0
- src-ag/Visage.ag +122/−0
- src-ag/VisagePatterns.ag +19/−0
- src-ag/VisageSyntax.ag +42/−0
- src-generated/AG2AspectAG.hs +2928/−2928
- src-generated/AbstractSyntax.hs +127/−127
- src-generated/AbstractSyntaxDump.hs +1083/−1083
- src-generated/Code.hs +333/−333
- src-generated/CodeSyntax.hs +145/−145
- src-generated/CodeSyntaxDump.hs +1109/−1109
- src-generated/ConcreteSyntax.hs +254/−254
- src-generated/DeclBlocks.hs +25/−25
- src-generated/DefaultRules.hs +4726/−4726
- src-generated/Desugar.hs +4468/−4468
- src-generated/ErrorMessages.hs +193/−193
- src-generated/ExecutionPlan.hs +162/−162
- src-generated/ExecutionPlan2Caml.hs +6147/−6147
- src-generated/ExecutionPlan2Clean.hs +7001/−7001
- src-generated/ExecutionPlan2Hs.hs +7007/−7007
- src-generated/Expression.hs +13/−13
- src-generated/GenerateCode.hs +5291/−5287
- src-generated/HsToken.hs +53/−53
- src-generated/Interfaces.hs +47/−47
- src-generated/InterfacesRules.hs +1213/−1213
- src-generated/KWOrder.hs +2305/−2305
- src-generated/LOAG/Order.hs +6251/−6238
- src-generated/LOAG/Rep.hs +95/−95
- src-generated/Macro.hs +50/−50
- src-generated/Order.hs +3846/−3846
- src-generated/Patterns.hs +58/−58
- src-generated/PrintCleanCode.hs +4407/−4407
- src-generated/PrintCode.hs +4135/−4135
- src-generated/PrintErrorMessages.hs +1665/−1665
- src-generated/PrintOcamlCode.hs +2662/−2662
- src-generated/PrintVisitCode.hs +966/−966
- src-generated/ResolveLocals.hs +2005/−2005
- src-generated/SemHsTokens.hs +689/−689
- src-generated/TfmToVisage.hs +1324/−1324
- src-generated/Transform.hs +6258/−6258
- src-generated/Visage.hs +902/−902
- src-generated/VisagePatterns.hs +38/−38
- src-generated/VisageSyntax.hs +90/−90
- src/ATermAbstractSyntax.hs +4/−4
- src/LOAG/Chordal.hs +7/−1
- src/LOAG/Optimise.hs +6/−2
- uuagc.cabal +4/−6
+ src-ag/AG2AspectAG.ag view
@@ -0,0 +1,857 @@+INCLUDE "AbstractSyntax.ag" +INCLUDE "Patterns.ag" +INCLUDE "Expression.ag" +INCLUDE "HsToken.ag" +INCLUDE "DistChildAttr.ag" + +imports +{ +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 +} + +{ +pragmaAspectAG = pp "{-# LANGUAGE EmptyDataDecls, NoMonomorphismRestriction , TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}" + +} + +{ +ppName l = ppListSep "" "" "_" l +} + + +ATTR Grammar [ options : Options | | ] + + +ATTR Nonterminals Nonterminal Productions Production Children Child [ o_rename : Bool | | ] +SEM Grammar + | Grammar nonts.o_rename = rename @lhs.options + +ATTR Nonterminals Nonterminal Productions Production Children Child Rules Rule [ o_noGroup : {[String]} | | ] +SEM Grammar + | Grammar loc.o_noGroup = sort $ noGroup @lhs.options + nonts.o_noGroup = @loc.o_noGroup + +SEM Nonterminal + | Nonterminal loc.inhNoGroup = Map.filterWithKey (\att _ -> elem (getName att) @lhs.o_noGroup) @prods.prdInh + | Nonterminal loc.synNoGroup = Map.filterWithKey (\att _ -> elem (getName att) @lhs.o_noGroup) @syn + + +ATTR Productions Production Children Child Rules Rule [ inhNoGroup, synNoGroup : {[String]} | | ] +SEM Nonterminal + | Nonterminal prods.inhNoGroup = map show $ Map.keys @loc.inhNoGroup + | Nonterminal prods.synNoGroup = map show $ Map.keys @loc.synNoGroup + + +SEM Productions + | Cons hd.inhNoGroup = filter (flip Map.member @hd.prdInh . identifier) @lhs.inhNoGroup + + +ATTR Productions Production Children Child [ | | prdInh USE {`Map.union`} {Map.empty} : {Attributes} ] +SEM Child + | Child lhs.prdInh = @loc.inh + + +{ +type FieldMap = [(Identifier, Type)] +type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap) +} + +ATTR Grammar [ agi : {(Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))} | | ] + + +ATTR Nonterminals Nonterminal Productions Production Children Child Rules Rule [ newAtts : { Attributes } | | ] + +SEM Grammar | Grammar loc.newAtts = case @lhs.agi of + (_,_,atts) -> ( Map.unions . (\(a,b) -> a++b) . unzip . Map.elems) atts + nonts.newAtts = @loc.newAtts + + +ATTR Nonterminals Nonterminal [ newProds : { DataTypes } | | ] +ATTR Productions Production [ newProds : { Map.Map ConstructorIdent FieldMap } | | ] + +SEM Grammar | Grammar loc.newProds = case @lhs.agi of + (_,prods,_) -> prods + nonts.newProds = @loc.newProds + + +SEM Nonterminal + | Nonterminal prods.newProds = case Map.lookup @nt @lhs.newProds of + Just prds -> prds + Nothing -> Map.empty + + +ATTR Nonterminals Nonterminal [ newNTs : {Set NontermIdent} | | ] + +ATTR Productions Production [ | | hasMoreProds USE { || } {False} : { Bool } ] + +SEM Production | Production lhs.hasMoreProds = not $ Map.member @con @lhs.newProds + +ATTR Nonterminals Nonterminal [ | | extendedNTs USE {`Set.union`} {Set.empty} : {Set NontermIdent} ] + +SEM Nonterminal | Nonterminal lhs.extendedNTs = if @prods.hasMoreProds + then Set.singleton @nt + else Set.empty + + +SEM Grammar | Grammar nonts.newNTs = case @lhs.agi of + (newNTs,_,_) -> Set.difference newNTs @nonts.extendedNTs + + + + + +ATTR Grammar Nonterminals Nonterminal Productions Production Children Child Rules Rule [ ext : {Maybe String} | | ] + + +-- IMPORT + +ATTR Grammar [ | | imp USE {>-<} {empty} : PP_Doc ] + +SEM Grammar + | Grammar lhs . imp = "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" >#<) @lhs.ext >-< + maybe empty (\ext -> "import" >#< ext >#< ppListSep "(" ")" "," (@nonts.ppDI ++ @nonts.ppLI ++ @loc.ppAI ++ @loc.ppANT)) @lhs.ext + +-- CODE + +ATTR Grammar [ | | pp USE {>-<} {empty} : PP_Doc ] + +SEM Grammar + | Grammar lhs . pp = (if dataTypes @lhs.options + then "-- datatypes" >-< @nonts.ppD >-< + "-- labels" >-< @nonts.ppL + else empty) + + >-< + + (if folds @lhs.options + then "-- attributes" >-< @loc.ppA >-< + "-- rules" >-< @loc.ppR >-< + "-- catas" >-< @nonts.ppCata + + else empty) + + >-< + + + (if semfuns @lhs.options + then "-- semantic functions" >-< @nonts.ppSF + else empty) + + + >-< + + (if wrappers @lhs.options + then "-- wrappers" >-< @nonts.ppW + else empty) + + + +-- data definitions + +SEM Nonterminal + | Nonterminal loc . ppNt = pp @nt + +SEM Production + | Production loc . ppProd = pp @con + loc . prodName = ppName [@lhs.ppNt, @loc.ppProd] + loc . conName = if @lhs.o_rename + then @loc.prodName + else @loc.ppProd +SEM Child + | Child loc . ppCh = pp @name + loc . ppTCh = ppShow @tp + loc . chName = ppName [@loc.ppCh, @lhs.ppNt, @lhs.ppProd] + + +ATTR Productions Production Rules Rule Children Child Expression [ ppNt : PP_Doc | | ] + +SEM Nonterminal + | Nonterminal prods . ppNt = @loc.ppNt + +ATTR Rules Rule Children Child Expression [ ppProd : PP_Doc | | ] + +SEM Production + | Production children . ppProd = @loc.ppProd + rules . ppProd = @loc.ppProd + + +ATTR Nonterminals Nonterminal [ derivs : {Derivings} | | ] + +SEM Grammar + | Grammar nonts . derivs = @derivings + + +ATTR Nonterminals Nonterminal Production [ | | ppD USE {>-<} {empty} : {PP_Doc} ppDI USE {++} {[]} : {[PP_Doc]} ] + +SEM Nonterminal + | Nonterminal lhs . ppD = + if (Set.member @nt @lhs.newNTs) + then case (lookup @nt @lhs.tSyns) of + -- if it's a data type + Nothing -> "data " >|< @loc.ppNt + >|< " = " >|< vlist_sep " | " @prods.ppDL >-< + case (Map.lookup @nt @lhs.derivs) of + Just ntds -> pp " deriving " >|< (ppListSep "(" ")" ", " $ Set.elems ntds) + Nothing -> empty -- uncommented for testing purposes + -- if it's a type synonym + Just tp -> "type " >|< @loc.ppNt >|< " = " >|< ppShow tp + else empty + + lhs . ppDI = + if (not $ Set.member @nt @lhs.newNTs) + then [ @loc.ppNt ] + else [ ] +-- uncommented for testing purposes + +SEM Production + | Production lhs . ppD = @loc.conName >|< ppListSep " {" "}" ", " @children.ppDL + + +ATTR Productions Children Child [ | | ppDL : {[PP_Doc]} ] + +SEM Productions + | Cons lhs . ppDL = @hd.ppD : @tl.ppDL + | Nil lhs . ppDL = [] + +SEM Children + | Cons lhs . ppDL = @hd.ppDL ++ @tl.ppDL + | Nil lhs . ppDL = [] + +SEM Child + | Child lhs . ppDL = case @kind of + ChildSyntax -> [ @loc.chName >|< pp " :: " >|< @loc.ppTCh ] + _ -> [] + + + +ATTR Nonterminals Nonterminal [ tSyns : {TypeSyns} | | ] + +SEM Grammar + | Grammar nonts . tSyns = @typeSyns + + + + +-- grammar labels + + +ATTR Nonterminals Nonterminal Productions Production Children Child [ | | ppL USE {>-<} {empty} : PP_Doc ppLI USE {++} {[]} : {[PP_Doc]} ] + +SEM Nonterminal + | Nonterminal loc . ntLabel = "nt_" >|< @loc.ppNt + + lhs . ppL = ( if (Set.member @nt @lhs.newNTs) + then @loc.ntLabel >|< " = proxy :: Proxy " >|< @loc.ppNt + else empty) >-< + @prods.ppL + + lhs . ppLI = ( if (not $ Set.member @nt @lhs.newNTs) + then [ @loc.ntLabel ] + else [ ]) ++ + @prods.ppLI + +SEM Production + | Production lhs . ppL = if (Map.member @con @lhs.newProds) + then @children.ppL + else empty + + lhs . ppLI = if (not $ Map.member @con @lhs.newProds) + then @children.ppLI + else [] + + +SEM Child + | Child loc . chLabel = "ch_" >|< @loc.chName + loc . chTLabel = "Ch_" >|< @loc.chName + lhs . ppL = "data " >|< @loc.chTLabel >|< "; " >|< @loc.chLabel >|< pp " = proxy :: " >|< + case @kind of + ChildSyntax -> "Proxy " >|< "(" >|< @loc.chTLabel >|< ", " >|< @loc.ppTCh >|< ")" + _ -> "SemType " >|< @loc.ppTCh >|< pp " nt => Proxy " >|< + "(" >|< @loc.chTLabel >|< ", nt)" + + lhs . ppLI = [ @loc.chLabel, @loc.chTLabel ] + + +-- attributes + + +SEM Grammar + | Grammar loc . ppA = vlist (map defAtt (filterAtts @loc.newAtts @loc.o_noGroup)) >-< -- not grouped + defAtt "loc" >-< -- local + (case @lhs.ext of + Nothing -> defAtt "inh" >-< defAtt "syn" -- grouped + otherwise -> empty) >-< + @nonts.ppA -- record definitions + + loc . ppAI = + let atts = filterNotAtts @loc.newAtts @loc.o_noGroup + in (foldr (\a as -> attName a : as) [] atts) ++ + (foldr (\a as -> attTName a : as) [] atts) ++ + (case @lhs.ext of + Nothing -> [] + otherwise -> [ attName "inh", attName "syn", attTName "inh", attTName "syn" ]) ++ + @nonts.ppAI + + + loc . ppANT = + let atts = filterNotAtts @loc.newAtts @loc.o_noGroup + in (foldr (\a as -> ("nts_" >|< a) : as) [] atts) + +ATTR Nonterminals Nonterminal Productions Production [ | | ppA USE {>-<} {empty} : PP_Doc ] + +SEM Nonterminal + | Nonterminal lhs . ppA = ( if (Set.member @nt @lhs.newNTs) + then + defAttRec (pp "InhG") @loc.ppNt @inh @loc.inhNoGroup >-< + defAttRec (pp "SynG") @loc.ppNt @syn @loc.synNoGroup + else empty) >-< + @prods.ppA + +SEM Production + | Production lhs . ppA = defLocalAtts @loc.prodName (length @rules.locals) 1 $ sort @rules.locals + + +ATTR Nonterminals Nonterminal [ | | ppAI USE {++} {[]} : {[PP_Doc]} ] + +SEM Nonterminal + | Nonterminal lhs . ppAI = if (not $ Set.member @nt @lhs.newNTs) + then [ ppName [(pp "InhG"), @loc.ppNt ] >#< pp "(..)", ppName [(pp "SynG"), @loc.ppNt ] >#< pp "(..)" ] + else [ ] + +{ +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 + +} + + +ATTR Rules Rule [ | | locals USE {++} {[]} : {[Identifier]} ] + + +SEM Rule + | Rule lhs . locals = if (show (fst @pattern.info) == "loc") + then [ snd @pattern.info ] + else [ ] + + +ATTR Pattern [ || info : {(Identifier, Identifier)} ] +SEM Pattern + | Alias lhs . info = (@field, @attr) + | Constr lhs . info = error "Pattern Constr undefined!!" + | Product lhs . info = error "Pattern Product undefined!!" + | Underscore lhs . info = error "Pattern Underscore undefined!!" + + + +-- rules + +SEM Grammar + | Grammar loc . ppNtL = @nonts.ppNtL + loc . ppR = ntsList "group" @loc.ppNtL >-< + vlist (map (\att -> ntsList att (filterNts att @loc.ppNtL)) (filterAtts @newAtts @loc.o_noGroup)) >-< + @nonts.ppR + +{ +ntsList att ppNtL = "nts_" ++ att ++ " = " >|< ppListSep "" "" " .*. " ((map fst ppNtL) ++ [pp "hNil"]) + +filterNts att = filter ( Map.member (identifier att) . snd ) +} + +ATTR Nonterminals Nonterminal [ | | ppNtL USE {++} {[]} : {[(PP_Doc, Attributes)]} ] -- list of nonterminals and its attributes + +SEM Nonterminal + | Nonterminal lhs . ppNtL = [ ("nt_" >|< @nt, Map.union @inh @syn) ] + + + + +ATTR Productions Production [ newNT : {Bool} | | ] +ATTR Rules Rule [ newProd : {Bool} | | ] + +SEM Nonterminal + | Nonterminal prods . newNT = Set.member @nt @lhs.newNTs + + +ATTR Nonterminals Nonterminal Productions Production Children Child [ | | ppR USE {>-<} {empty} : PP_Doc ] +ATTR Productions Production [ | | ppRA USE {++} {[]} : {[PP_Doc]} ] + + + + +SEM Nonterminal + | Nonterminal lhs . ppR = pp "----" >|< pp @nt >-< @prods.ppR + +SEM Production + | Production loc . newProd = Map.member @con @lhs.newProds + loc . (ppR,ppRA) + = let (instR, instRA) = defInstRules @lhs.ppNt @con @lhs.newNT @loc.newProd + @children.ppR @rules.ppRL @children.idCL @rules.locals + (locR, locRA) = defLocRule @lhs.ppNt @con @lhs.newNT @loc.newProd + @children.ppR @rules.ppRL @lhs.inhNoGroup @lhs.synNoGroup @children.idCL @rules.locals + (inhGR, inhGRA) = defInhGRule @lhs.ppNt @loc.prodName @lhs.newNT @loc.newProd + @children.ppR @rules.ppRL @lhs.inhNoGroup @lhs.synNoGroup @children.idCL @rules.locals + (synGR, synGRA) = defSynGRule @lhs.ppNt @con @lhs.newNT @loc.newProd + @children.ppR @rules.ppRL @lhs.inhNoGroup @lhs.synNoGroup @children.idCL @rules.locals + (inhR, inhRA) = defInhRules @lhs.ppNt @loc.prodName @lhs.newNT @loc.newProd @lhs.newAtts + @children.ppR @rules.ppRL @lhs.inhNoGroup @lhs.synNoGroup @children.idCL @rules.locals + (synR, synRA) = defSynRules @lhs.ppNt @con @lhs.newNT @loc.newProd @lhs.newAtts + @children.ppR @rules.ppRL @lhs.inhNoGroup @lhs.synNoGroup @children.idCL @rules.locals + (inhMR, inhMRA) = modInhRules @lhs.ppNt @loc.prodName @lhs.newNT @loc.newProd @lhs.newAtts + @children.ppR @rules.ppRL @lhs.inhNoGroup @lhs.synNoGroup @children.idCL @rules.locals + (synMR, synMRA) = modSynRules @lhs.ppNt @con @lhs.newNT @loc.newProd @lhs.newAtts + @children.ppR @rules.ppRL @lhs.inhNoGroup @lhs.synNoGroup @children.idCL @rules.locals + in ( vlist [instR,locR,inhGR,synGR,inhR,synR,inhMR,synMR] + , instRA ++ locRA ++ inhGRA ++ synGRA ++ inhMRA ++ synMRA ++ inhRA ++ synRA) + + +SEM Child + | Child lhs . ppR = let chName = ppListSep "" "" "_" [pp @name, @lhs.ppNt, @lhs.ppProd] + in pp @name >|< " <- at ch_" >|< chName + + +{ +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 + +} +ATTR Rules Rule [ | | ppRL : {[ PPRule ]} ] + +SEM Rules + | Cons lhs . ppRL = @hd.ppRL ++ @tl.ppRL + | Nil lhs . ppRL = [] + +SEM Rule + | Rule lhs . ppRL = if (not @explicit && not @lhs.newProd && not (Map.member (snd @pattern.info) @lhs.newAtts) ) + then [] + else [ ppRule @pattern.info @owrt (defRule @lhs.ppNt @pattern.info @lhs.o_noGroup @rhs.ppRE) ] + +{- +ATTR Expression [ | | ppRE : {Identifier -> [String] -> [String] -> [(Identifier,Type)] -> [Identifier] -> PP_Doc} ] +SEM Expression + | Expression lhs . ppRE = rhsRule @lhs.ppNt @lhs.ppProd @tks +-} + +ATTR Expression [ | | ppRE : {[String] -> Identifier -> [(Identifier,Type)] -> [Identifier] -> PP_Doc} ] +SEM Expression + | Expression lhs . ppRE = rhsRule @lhs.ppNt @lhs.ppProd @tks + + +ATTR Children Child [ || idCL USE {++} {[]} : {[(Identifier,Type)]} ] +SEM Child + | Child lhs . idCL = [ (@name, removeDeforested @tp ) ] + + + + +{ + +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 + +} + +---------------------------------------------------------------------------------------------------------------------------------------------- + + +{ +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] +} + +-- catamorphisms + +ATTR Nonterminals Nonterminal Productions Production [ | | ppCata USE {>-<} {empty} : PP_Doc ] + +SEM Nonterminal + | Nonterminal lhs . ppCata = "----" >|< @loc.ppNt >-< @prods.ppCata + + +SEM Production + | Production lhs . ppCata = + let extend = maybe [] + ( \ext -> if (@lhs.newNT || (not @lhs.newNT && @loc.newProd)) + then [] + else [ ext >|< ".atts_" >|< @loc.prodName ]) + @lhs.ext + macro = case @macro of + Nothing -> [] + Just macro -> [ "agMacro " >|< ppMacro macro ] + atts = sortBy (\a b -> compare (show a) (show b)) @loc.ppRA + in "atts_" >|< @loc.prodName >|< " = " >|< + ppListSep "" "" " `ext` " + (atts ++ macro ++ extend ) >-< + "semP_" >|< @loc.prodName >|< pp " = knit atts_" >|< @loc.prodName + +{ +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 +} + +ATTR Productions Production [ syn, inh : { Attributes } | | ] + +SEM Nonterminal + | Nonterminal prods . syn = @syn + prods . inh = @inh + + + +-- semantic functions + +ATTR Nonterminals Nonterminal Productions Production [ | | ppSF USE {>-<} {empty} : PP_Doc ] +ATTR Productions Production [ | | ppSPF USE {>-<} {empty} : PP_Doc ] + + +SEM Nonterminal + | Nonterminal lhs . ppSF = + let inhAtts = attTypes @loc.inhNoGroup + synAtts = attTypes @loc.synNoGroup + in + "----" >|< @loc.ppNt >-< + "type T_" >|< @loc.ppNt >|< " = " >|< + "(Record " >|< + inhAtts >|< + "(HCons (LVPair (Proxy Att_inh) InhG_" >|< @loc.ppNt >|< ") HNil))" >|< + replicate (length inhAtts) ")" >|< " -> " >|< + "(Record " >|< + synAtts >|< + "(HCons (LVPair (Proxy Att_syn) SynG_" >|< @loc.ppNt >|< ") HNil))" >|< + replicate (length synAtts) ")" >-< + "-- instance SemType T_" >|< @loc.ppNt >|< " " >|< @loc.ppNt >-< + "-- sem_" >|< @loc.ppNt >|< " :: " >|< @loc.ppNt >|< " -> T_" >|< @loc.ppNt >-< + @prods.ppSPF -- >-< + -- @prods.ppSF + +{ +attTypes atts = map (\(a,t) -> "(HCons (LVPair (Proxy Att_" >|< a >|< ") " >|< ppShow t >|< ") ") $ Map.toAscList atts +} + + +SEM Production + | Production lhs . ppSF = + let chi = @children.ppCSF + ppPattern = case (show @con) of + -- hardcoded list support + "Cons" -> ppParams (ppListSep "" "" " : ") + "Nil" -> pp "[]" + -- general case + otherwise -> @loc.conName >|< " " >|< (ppParams ppSpaced) + + ppParams f = f $ map (((>|<) (pp "_")) . fst) chi + in "sem_" >|< @lhs.ppNt >|< " (" >|< ppPattern >|< ") = sem_" >|< @loc.prodName >|< + " (" >|< map (fst . snd) chi >|< "emptyRecord)" + lhs . ppSPF = + let chi = @children.ppCSF + ppParams f = f $ map (((>|<) (pp "_")) . fst) chi + in "sem_" >|< @lhs.ppNt >|< "_" >|< @con >#< ppParams ppSpaced >|< " = semP_" >|< @loc.prodName >|< + " (" >|< map (snd . snd) chi >|< "emptyRecord)" + + +ATTR Children Child [ | | ppCSF USE {++} {[]} : {[(Identifier,(PP_Doc,PP_Doc))]} ] + + +SEM Child + | Child lhs . ppCSF = + let + semC = if (isNonterminal @tp) + then "sem_" >|< ppShow @tp >|< " _" >|< @name + else "sem_Lit _" >|< @name + in case @kind of + ChildSyntax -> [(@name, ( @loc.chLabel >|< " .=. (" >|< semC >|< ") .*. " + , @loc.chLabel >|< " .=. _" >|< @name >|< " .*. "))] + _ -> [] + + + + +-- wrappers + +--TODO: create the records Inh_nt and Syn_nt to wrap the attributes + +ATTR Nonterminals Nonterminal [ | | ppW USE {>-<} {empty} : PP_Doc ] + +SEM Nonterminal + | Nonterminal lhs . ppW = + ppName [pp "wrap", @loc.ppNt] >|< " sem " >|< attVars @inh >|< " = " >-< + " sem " >|< attFields @inh @loc.inhNoGroup @loc.ppNt + + +{ +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)" +}
+ src-ag/AbstractSyntax.ag view
@@ -0,0 +1,76 @@+imports +{ +-- 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 +} + +DATA Grammar | Grammar typeSyns : {TypeSyns} + useMap : {UseMap} + derivings : {Derivings} + wrappers : {Set NontermIdent} + nonts : Nonterminals + pragmas : {PragmaMap} -- pragmas defined at a certain alternative + manualAttrOrderMap : {AttrOrderMap} -- manually enforced dependencies between attributes + paramMap : {ParamMap} + contextMap : {ContextMap} + quantMap : {QuantMap} + uniqueMap : {UniqueMap} + augmentsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + aroundsMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} + +TYPE Nonterminals = [Nonterminal] + +TYPE Productions = [Production] + +TYPE Children = [Child] + +TYPE Rules = [Rule] + +TYPE TypeSigs = [TypeSig] + +DATA Nonterminal | Nonterminal nt : {NontermIdent} + params : {[Identifier]} + inh : {Attributes} + syn : {Attributes} + prods : Productions + +DATA Production | Production con : {ConstructorIdent} + params : {[Identifier]} + constraints : {[Type]} + children : Children + rules : Rules + typeSigs : TypeSigs + macro : MaybeMacro --marcos + +DATA Child | Child name : {Identifier} + tp : {Type} + kind : {ChildKind} + +DATA Rule | Rule mbName : {Maybe Identifier} + pattern : Pattern + rhs : Expression + owrt : {Bool} + origin : String -- just for documentation (and maybe errors) + explicit : Bool -- True if this rule defined in the source code + pure : Bool -- True if this rule is pure (does not have side effects) + identity : Bool -- True if this rule is an identity rule + mbError : {Maybe Error} -- scheduling this rule yields the given error, if present + eager : Bool -- for ordered scheduling: use an eager semantics + +DATA TypeSig | TypeSig name : {Identifier} + tp : {Type} + +SET AllAbstractSyntax + = Grammar + Nonterminal Nonterminals + Production Productions + Child Children + Rule Rules + TypeSig TypeSigs
+ src-ag/AbstractSyntaxDump.ag view
@@ -0,0 +1,76 @@+INCLUDE "AbstractSyntax.ag" +INCLUDE "Patterns.ag" +INCLUDE "Expression.ag" + +imports +{ +import Data.List +import qualified Data.Map as Map + +import Pretty +import PPUtil + +import AbstractSyntax +import TokenDef +} + +ATTR AllPattern AllAbstractSyntax AllExpression [ | | pp USE {>-<} {empty} : PP_Doc ] + +SEM Grammar + | Grammar lhs . pp = 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 @nonts.ppL + ] [] + +SEM Nonterminal + | Nonterminal lhs . pp = ppNestInfo ["Nonterminal","Nonterminal"] (pp @nt : map pp @params) [ppF "inh" $ ppMap @inh, ppF "syn" $ ppMap @syn, ppF "prods" $ ppVList @prods.ppL] [] + +SEM Production + | Production lhs . pp = ppNestInfo ["Production","Production"] [pp @con] [ppF "children" $ ppVList @children.ppL,ppF "rules" $ ppVList @rules.ppL,ppF "typeSigs" $ ppVList @typeSigs.ppL] [] + +SEM Child + | Child lhs . pp = ppNestInfo ["Child","Child"] [pp @name, ppShow @tp] [ppF "kind" $ ppShow @kind] [] + +SEM Rule + | Rule lhs . pp = ppNestInfo ["Rule","Rule"] [ppShow @owrt, pp @origin] [ppF "pattern" $ @pattern.pp, ppF "rhs" $ @rhs.pp] [] + +SEM TypeSig + | TypeSig lhs . pp = ppNestInfo ["TypeSig","TypeSig"] [pp @name, ppShow @tp] [] [] + +SEM Pattern + | Constr lhs . pp = ppNestInfo ["Pattern","Constr"] [pp @name] [ppF "pats" $ ppVList @pats.ppL] [] + | Product lhs . pp = ppNestInfo ["Pattern","Product"] [ppShow @pos] [ppF "pats" $ ppVList @pats.ppL] [] + | Alias lhs . pp = ppNestInfo ["Pattern","Alias"] [pp @field, pp @attr] [ppF "pat" $ @pat.pp] [] + | Underscore lhs . pp = ppNestInfo ["Pattern","Underscore"] [ppShow @pos] [] [] + +SEM Expression + | Expression lhs . pp = ppNestInfo ["Expression","Expression"] [ppShow @pos] [ppF "txt" $ vlist . showTokens . tokensToStrings $ @tks] [] + +ATTR Productions Nonterminals Children Rules TypeSigs Patterns [ | | ppL: {[PP_Doc]} ] + +SEM Patterns + | Cons lhs . ppL = @hd.pp : @tl.ppL + | Nil lhs . ppL = [] + +SEM TypeSigs + | Cons lhs . ppL = @hd.pp : @tl.ppL + | Nil lhs . ppL = [] + +SEM Rules + | Cons lhs . ppL = @hd.pp : @tl.ppL + | Nil lhs . ppL = [] + +SEM Children + | Cons lhs . ppL = @hd.pp : @tl.ppL + | Nil lhs . ppL = [] + +SEM Productions + | Cons lhs . ppL = @hd.pp : @tl.ppL + | Nil lhs . ppL = [] + +SEM Nonterminals + | Cons lhs . ppL = @hd.pp : @tl.ppL + | Nil lhs . ppL = []
+ src-ag/Code.ag view
@@ -0,0 +1,163 @@+imports +{ +import Patterns +import Data.Set(Set) +import qualified Data.Set as Set +import Data.Map(Map) +import qualified Data.Map as Map +} + +TYPE Exprs = [Expr] +TYPE Decls = [Decl] +TYPE Chunks = [Chunk] +TYPE DataAlts = [DataAlt] +TYPE CaseAlts = [CaseAlt] +TYPE Types = [Type] +TYPE NamedTypes = [NamedType] + +DATA Program | Program chunks : Chunks + ordered : Bool + +DATA Chunk | Chunk name : String + comment : Decl + info : Decls + dataDef : Decls + cataFun : Decls + semDom : Decls + semWrapper : Decls + semFunctions : Decls + semNames : {[String]} + +DATA Expr | Let decls : Decls + body : Expr + | Case expr : Expr + alts : CaseAlts + | Do stmts : Decls + body : Expr + | Lambda args : Exprs + body : Expr + | TupleExpr exprs : Exprs + | UnboxedTupleExpr exprs : Exprs + | App name : {String} + args : Exprs + | SimpleExpr txt : {String} + | TextExpr lns : {[String]} + | Trace txt : {String} + expr : Expr + | PragmaExpr onLeftSide : {Bool} + onNewLine : {Bool} + txt : {String} + expr : Expr + | LineExpr expr : Expr + | TypedExpr expr : Expr + tp : Type + | ResultExpr nt : String + expr : Expr + | InvokeExpr nt : String + expr : Expr + args : Exprs + | ResumeExpr nt : String + expr : Expr + left : Lhs + rhs : Expr + | SemFun nt : {String} + args : Exprs + body : Expr + +DATA CaseAlt | CaseAlt left : Lhs + expr : Expr + +DATA Decl | Decl left : Lhs + rhs : Expr + binds : {Set String} -- set of variable names bound by the left-hand side + uses : {Set String} -- set of variable names used by the right-hand side + | Bind left : Lhs + rhs : Expr + | BindLet left : Lhs + rhs : Expr + | Data name : {String} + params: {[String]} + alts : DataAlts + strict: Bool + derivings : {[String]} + | NewType name : {String} + params: {[String]} + con : {String} + tp : Type + | Type name : {String} + params: {[String]} + tp : Type + | TSig name : {String} + tp : Type + | Comment txt : {String} + | PragmaDecl txt : {String} + + | Resume monadic : {Bool} + nt : String + left : Lhs + rhs : Expr + | EvalDecl nt : String + left : Lhs + rhs : Expr + +DATA DataAlt | DataAlt name : {String} + args : Types + | Record name : {String} + args : NamedTypes + +DATA NamedType | Named strict: {Bool} + name : {String} + tp : Type + +DATA Type | Arr left : Type + right : Type + | CtxApp left : {[(String, [String])]} + right : Type + | QuantApp left : String + right : Type + | TypeApp func : Type + args : Types + | TupleType tps : Types + | UnboxedTupleType tps : Types + | List tp : Type + | SimpleType txt : {String} + | NontermType name : String + params : {[String]} + deforested : Bool + | TMaybe tp : Type + | TEither left : Type + right : Type + | TMap key : Type + value : Type + | TIntMap value : Type + | TSet tp : Type + | TIntSet + +DATA Lhs | Pattern3 pat3 : Pattern + | Pattern3SM pat3 : Pattern + | TupleLhs comps : {[String]} -- \ [Lhs] appears to be more sensible + | UnboxedTupleLhs comps : {[String]} -- / + | Fun name : {String} + args : Exprs + | Unwrap name : {String} sub : Lhs + +DERIVING Type : Show + +{ +-- 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 +} +
+ src-ag/CodeSyntax.ag view
@@ -0,0 +1,90 @@+imports +{ +import Patterns +import CommonTypes +import Data.Map(Map) +import Data.Set(Set) +} + +DATA CGrammar + | CGrammar typeSyns : {TypeSyns} + derivings : {Derivings} + wrappers : {Set NontermIdent} + nonts : CNonterminals + pragmas : {PragmaMap} + paramMap : {ParamMap} + contextMap: {ContextMap} + quantMap : {QuantMap} + aroundsMap: {Map NontermIdent (Map ConstructorIdent (Set Identifier))} + mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))} + multivisit : {Bool} + +TYPE CNonterminals = [CNonterminal] + +DATA CNonterminal + | CNonterminal nt : NontermIdent + params : {[Identifier]} + inh : Attributes + syn : Attributes + prods : CProductions + inter : CInterface + +DATA CInterface + | CInterface seg:CSegments + +TYPE CSegments = [CSegment] + +DATA CSegment + | CSegment inh : Attributes + syn : Attributes + +TYPE CProductions = [CProduction] + +DATA CProduction + | CProduction con : ConstructorIdent + visits : CVisits + children : {[(Identifier,Type,ChildKind)]} + terminals : {[Identifier]} + +TYPE CVisits = [CVisit] + +DATA CVisit + | CVisit inh : Attributes + syn : Attributes + vss : Sequence -- sequence of "steps", where each "step" is either an attribute definition or a child visit + intra : Sequence -- how to glue the visits together (child visits are child-intra's, attr-defs are attr-intra's) + ordered : Bool -- indicates that vss is ordered + +TYPE Sequence = [CRule] + +DATA CRule + | CRule name : Identifier + isIn : Bool -- True iff there is a definition for an inherited attribute + hasCode : Bool -- True iff there is an RHS + nt : NontermIdent + con : ConstructorIdent + field : Identifier + childnt : {Maybe NontermIdent} -- Just n: 'field' of 'nt' and 'con' is a nonterminal 'n', Nothing: it is a terminal + tp : {Maybe Type} -- type of the attribute + pattern : Pattern -- only defined if 'isIn' is False + rhs : {[String]} -- empty string if 'hasCode' is False + defines : {Map Int (Identifier,Identifier,Maybe Type)} -- the attributes defined by this rule + owrt : {Bool} + origin : String -- just for documentation (and maybe errors) + uses : {Set (Identifier, Identifier)} + explicit : Bool -- True if this an explicit rule found in the source file + mbNamed : {Maybe Identifier} + | CChildVisit name : Identifier -- corresponding to the name of the child + nt : NontermIdent + nr : Int -- visit number + inh : Attributes + syn : Attributes + isLast : Bool -- indicates whether this is the last visit to this child + +SET AllCodeSyntax + = CGrammar + CNonterminal CNonterminals + CInterface CSegments CSegment + CProduction CProductions + CVisits CVisit + CRule
+ src-ag/CodeSyntaxDump.ag view
@@ -0,0 +1,103 @@+INCLUDE "CodeSyntax.ag" +INCLUDE "Patterns.ag" + +imports +{ +import Data.List +import qualified Data.Map as Map + +import Pretty +import PPUtil + +import CodeSyntax +} + +{ +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 +} + + +ATTR AllPattern AllCodeSyntax [ | | pp USE {>-<} {empty} : PP_Doc ] + +SEM CGrammar + | CGrammar lhs . pp = ppNestInfo ["CGrammar","CGrammar"] [] + [ ppF "typeSyns" $ ppAssocL @typeSyns + , ppF "derivings" $ ppMap $ @derivings + , ppF "nonts" $ ppVList @nonts.ppL + ] [] + +SEM CNonterminal + | CNonterminal lhs . pp = ppNestInfo ["CNonterminal","CNonterminal"] (pp @nt : map pp @params) [ppF "inh" $ ppMap @inh, ppF "syn" $ ppMap @syn, ppF "prods" $ ppVList @prods.ppL, ppF "inter" @inter.pp] [] + +SEM CInterface + | CInterface lhs . pp = ppNestInfo ["CInterface","CInterface"] [] [ppF "seg" $ ppVList @seg.ppL] [] + +SEM CSegment + | CSegment lhs . pp = ppNestInfo ["CSegment","CSegment"] [] [ppF "inh" $ ppMap @inh, ppF "syn" $ ppMap @syn] [] + +SEM CProduction + | CProduction lhs . pp = ppNestInfo ["CProduction","CProduction"] [pp @con] [ppF "visits" $ ppVList @visits.ppL, ppF "children" $ ppVList (map ppChild @children),ppF "terminals" $ ppVList (map ppShow @terminals)] [] + +SEM CVisit + | CVisit lhs . pp = ppNestInfo ["CVisit","CVisit"] [] [ppF "inh" $ ppMap @inh, ppF "syn" $ ppMap @syn, ppF "sequence" $ ppVList @vss.ppL, ppF "intra" $ ppVList @intra.ppL, ppF "ordered" $ ppBool @ordered] [] + +SEM CRule + | CRule lhs . pp = 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 "<no pat because In>" else @pattern.pp, ppF "rhs" $ ppStrings @rhs, ppF "defines" $ ppVertexMap @defines, ppF "owrt" $ ppBool @owrt, ppF "origin" $ pp @origin] [] + | CChildVisit lhs . pp = 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] [] + +SEM Pattern + | Constr lhs . pp = ppNestInfo ["Pattern","Constr"] [pp @name] [ppF "pats" $ ppVList @pats.ppL] [] + | Product lhs . pp = ppNestInfo ["Pattern","Product"] [ppShow @pos] [ppF "pats" $ ppVList @pats.ppL] [] + | Alias lhs . pp = ppNestInfo ["Pattern","Alias"] [pp @field, pp @attr] [ppF "pat" $ @pat.pp] [] + | Underscore lhs . pp = ppNestInfo ["Pattern","Underscore"] [ppShow @pos] [] [] + + +ATTR CNonterminals CSegments CProductions CVisits Sequence Patterns [ | | ppL: {[PP_Doc]} ] + +SEM Patterns + | Cons lhs . ppL = @hd.pp : @tl.ppL + | Nil lhs . ppL = [] + +SEM Sequence + | Cons lhs . ppL = @hd.pp : @tl.ppL + | Nil lhs . ppL = [] + +SEM CVisits + | Cons lhs . ppL = @hd.pp : @tl.ppL + | Nil lhs . ppL = [] + +SEM CProductions + | Cons lhs . ppL = @hd.pp : @tl.ppL + | Nil lhs . ppL = [] + +SEM CSegments + | Cons lhs . ppL = @hd.pp : @tl.ppL + | Nil lhs . ppL = [] + +SEM CNonterminals + | Cons lhs . ppL = @hd.pp : @tl.ppL + | Nil lhs . ppL = []
+ src-ag/ConcreteSyntax.ag view
@@ -0,0 +1,132 @@+imports +{ +import UU.Scanner.Position (Pos) +import Patterns (Pattern) +import Expression (Expression) +import CommonTypes +import Macro --marcos +} + + +TYPE Elems = [Elem] + +TYPE Alts = [Alt] + +TYPE Fields = [Field] + +TYPE SemAlts = [SemAlt] + +TYPE SemDefs = [SemDef] + +DATA AG | AG elems : Elems + +DATA Elem | Data pos : {Pos} + contype : {ConstructorType} + ctx : {ClassContext} + names : NontSet + params : {[Identifier]} + attrs : Attrs + alts : Alts + ext : {Bool} + + | Type pos : {Pos} + ctx : {ClassContext} + name : {NontermIdent} + params : {[Identifier]} + type : {ComplexType} + + | Attr pos : {Pos} + ctx : {ClassContext} + names : NontSet + quants : {[String]} + attrs : Attrs + + | Sem pos : {Pos} + ctx : {ClassContext} + names : NontSet + attrs : Attrs + quants : {[String]} + alts : SemAlts + + | Txt pos : {Pos} + kind : {BlockKind} + mbNt : {Maybe NontermIdent} + lines : {[String]} + + | Set pos : {Pos} + name : {NontermIdent} + merge : Bool + set : NontSet + + | Deriving pos : {Pos} + set : NontSet + classes : {[NontermIdent]} + + | Wrapper pos : {Pos} + set : NontSet + + | Nocatas pos : {Pos} + set : NontSet + + | Pragma pos : {Pos} + names: {[NontermIdent]} + + | Module pos : {Pos} + name : {String} -- name of the haskell module + exports : {String} -- exports of the haskell module + imports : {String} -- imports to replicate to generated haskell modules + +DATA Attrs | Attrs pos : {Pos} + inh,chn,syn : {AttrNames} + +DATA Alt | Alt pos : {Pos} + names : ConstructorSet + tyvars : {[Identifier]} + fields : Fields + macro : MaybeMacro --marcos: macro extension + +DATA Field | FChild name : Identifier + tp : Type + | FCtx tps : {[Type]} + +DATA SemAlt | SemAlt pos : {Pos} + constructorSet : ConstructorSet + rules : SemDefs + +DATA SemDef | Def pos : Pos + mbName : {Maybe Identifier} + pattern: Pattern + rhs : {Expression} + owrt : {Bool} + pure : Bool + eager : Bool + | TypeDef pos : {Pos} + ident : {Identifier} + tp : Type + | UniqueDef ident : {Identifier} + ref : {Identifier} + | AugmentDef ident : {Identifier} + rhs : {Expression} + | AroundDef ident : {Identifier} + rhs : {Expression} + | MergeDef target : {Identifier} + nt : {Identifier} + sources : {[Identifier]} + rhs : {Expression} + | SemPragma names : {[NontermIdent]} + | AttrOrderBefore before : {[Occurrence]} + after : {[Occurrence]} + +DATA ConstructorSet | CName name : {ConstructorIdent} + | CUnion set1,set2 : ConstructorSet + | CDifference set1,set2 : ConstructorSet + | CAll + +DATA NontSet | NamedSet name : {NontermIdent} + | All + | Union set1,set2 : NontSet + | Intersect set1,set2 : NontSet + | Difference set1,set2 : NontSet + | Path from,to : {NontermIdent} + +
+ src-ag/DeclBlocks.ag view
@@ -0,0 +1,20 @@+imports +{ +import Code (Decl,Expr) +} + + +DATA DeclBlocksRoot + | DeclBlocksRoot + blocks : DeclBlocks + + +DATA DeclBlocks + | DeclBlock + defs : {[Decl]} + visit : {Decl} + next : DeclBlocks + | DeclTerminator + defs : {[Decl]} + result : {Expr} +
+ src-ag/DefaultRules.ag view
@@ -0,0 +1,821 @@+-- 13 okt 2011: eliminated the "multiRule" transformation for all but the Kastens-code +-- the SELF types are also eliminated in this phase: in a Type value, there should not be +-- a Self constructor anymore. + +PRAGMA strictdata +PRAGMA optimize +PRAGMA bangpats +PRAGMA strictwrap + +INCLUDE "AbstractSyntax.ag" +INCLUDE "Patterns.ag" +INCLUDE "DistChildAttr.ag" + +imports +{ +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 +} + +------------------------------------------------------------------------------- +-- Passing down corresponding nonterminal and constructor names +------------------------------------------------------------------------------- +ATTR Rule Rules Child Children Production Productions TypeSigs TypeSig Pattern Patterns [ nt:NontermIdent | | ] +ATTR Rule Rules Child Children Pattern Patterns [ con:ConstructorIdent | | ] + +ATTR Productions Production Children Child TypeSigs TypeSig [ params : {[Identifier]} | | ] +SEM Nonterminal | Nonterminal + prods.params = @params + + +------------------------------------------------------------------------------- +-- Distributing options +------------------------------------------------------------------------------- + +ATTR Grammar Nonterminals Nonterminal Productions Production Rules Rule + [ options:{Options} + constructorTypeMap : {Map NontermIdent ConstructorType} | | ] +ATTR Nonterminals Nonterminal Productions Production [ o_rename:{Bool} + cr:Bool {- copy rule -} + | | ] + +ATTR Children Child [ cr:Bool {- copy rule -} | | ] +SEM Grammar + | Grammar nonts.o_rename = rename @lhs.options + nonts.cr = modcopy @lhs.options + +------------------------------------------------------------------------------- +-- Passing down the set of wrapper names +------------------------------------------------------------------------------- + +ATTR Nonterminals Nonterminal Productions Production [ wrappers : {Set NontermIdent} | | ] +SEM Grammar | Grammar + nonts.wrappers = @wrappers + +------------------------------------------------------------------------------- +-- Type synonyms environment +------------------------------------------------------------------------------- +ATTR Nonterminals Nonterminal Productions Production [ typeSyns : {TypeSyns} | | ] + + +------------------------------------------------------------------------------- +-- some auxiliary functions +------------------------------------------------------------------------------- +{ +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) + ] + ) + +} + +------------------------------------------------------------------------------- +-- Errors +------------------------------------------------------------------------------- + +ATTR Grammar Nonterminals Nonterminal Productions Production + Child Children Rule Rules Pattern Patterns + [ | | errors USE {Seq.><} {Seq.empty}:{Seq Error} ] + +------------------------------------------------------------------------------- +-- Set of all defined nonterminals +------------------------------------------------------------------------------- + +ATTR Nonterminals Nonterminal [ || collect_nts USE {`Set.union`} {Set.empty} : {Set NontermIdent} ] +SEM Nonterminal + | Nonterminal lhs.collect_nts = Set.singleton @nt + +ATTR Nonterminals Nonterminal Productions Production [ nonterminals : {Set NontermIdent} || ] +SEM Grammar + | Grammar nonts.nonterminals = @nonts.collect_nts + +------------------------------------------------------------------------------- +-- Pass down the lhs-attributes and the USE's to each alternative of a nonterminal +------------------------------------------------------------------------------- + +ATTR Nonterminals Nonterminal [ useMap : {UseMap} || ] +ATTR Productions Production [ inh, syn, inhOrig, synOrig : {Attributes} useMap : {Map Identifier (String,String,String)}|| ] + +SEM Nonterminal + | Nonterminal prods.inh = @loc.inh1 + prods.syn = @loc.syn1 + prods.inhOrig = @inh + prods.synOrig = @syn + prods.useMap = Map.findWithDefault Map.empty @nt @lhs.useMap + +SEM Production + | Production rules.con = @con + children.con = @con +SEM Child + | Child lhs . name = @name +SEM Grammar + | Grammar nonts . useMap = @useMap +SEM Grammar + | Grammar nonts . typeSyns = @typeSyns +SEM Nonterminal + | Nonterminal prods . nt = @nt + +SEM Child [ | | name:{Identifier} inherited,synthesized:{Attributes} ] + | Child lhs.inherited = @loc.inh1 + lhs.synthesized = if @name `Set.member` @lhs.merged + then Map.empty + else @loc.syn1 + +SEM Children [ | | inputs,outputs:{[(Identifier, Attributes)]} ] + | Cons lhs.inputs = (@hd.name, @hd.inherited) : @tl.inputs + .outputs = (@hd.name, @hd.synthesized) : @tl.outputs + | Nil lhs.inputs = [] + .outputs = [] + + + +------------------------------------------------------------------------------- +-- Implementation of Use-rule and Copy-rule +------------------------------------------------------------------------------- + +{ + + + +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 +} + + + + +SEM Production + | Production + + lhs.errors = @children.errors >< @errs >< @rules.errors >< @loc.orderErrs + + loc.(newRls, errs) + = + let locals = @rules.locals + initenv = Map.fromList ( [ (a,_ACHILD) -- _ACHILD is used to mark identifiers in the environment that are terminals + | (a,_,_) <- @children.fields + ] + ++ attrs(_LHS, @lhs.inh) + ++ [ (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 ) @children.outputs) + + child_envs = init envs + lhs_env = last envs + + (selfAttrs, normalAttrs) + = Map.partitionWithKey (\k _ -> maybe False isSELFNonterminal $ Map.lookup k @lhs.synOrig) @lhs.syn + + (_,undefAttrs) + = removeDefined @rules.definedAttrs (_LHS, normalAttrs) + + (useAttrs,others) + = splitAttrs @lhs.useMap undefAttrs + + (rules1, errors1) + = concatRE $ map (copyRule @lhs.options @lhs.wrappers @lhs.nt @con @lhs.cr locals) + (zip envs (map (removeDefined @rules.definedAttrs) @children.inputs)) + + uRules + = map (useRule @lhs.options locals @children.outputs) useAttrs + + -- creates a loc.xxx if there is a synthesized attr xxx of type SELF and no + -- loc.xxx exists yet. If there exists a terminal yyy and a local loc.yyy, then + -- the local is chosen as value for the terminal. + selfLocRules + = [ selfRule False attr $ + lexTokens @lhs.options noPos $ -- building a string and lexing it again is not so nice... but practical here + constructor [(childSelf attr nm tp, nm) | (nm,tp,virt) <- @children.fields, 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 @lhs.options) (clean @lhs.options) @lhs.constructorTypeMap @lhs.typeSyns @lhs.o_rename @lhs.nt @con fs + + childExists ChildAttr = False + childExists _ = True + + selfRules + = [ selfRule True attr [mkLocVar attr noPos Nothing] + | attr <- Map.keys selfAttrs + , not (Set.member (_LHS,attr) @rules.definedAttrs) + ] + + (rules5, errs5) + = copyRule @lhs.options + @lhs.wrappers + @lhs.nt + @con + @lhs.cr + locals + (lhs_env, (_LHS, others)) + in (uRules++selfLocRules++selfRules++rules5++rules1, errors1><errs5) + +{ +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 "<child>_around" and <child> 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: "<child>_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) +} + + +ATTR Rule Rules Pattern Patterns + [ | | locals USE {`Set.union`} {Set.empty} : {Set Identifier} + definedAttrs USE {`Set.union`} {Set.empty} : {Set (Identifier,Identifier)} + ] + + +SEM Pattern + | Alias lhs.definedAttrs = Set.insert (@field,@attr) @pat.definedAttrs + .locals = if @field == _LOC + then Set.insert @attr @pat.locals + else @pat.locals + +SEM Children [ | | fields : {[(Identifier,Type,ChildKind)]} ] + | Cons lhs.fields = @hd.field : @tl.fields + | Nil lhs.fields = [] + +SEM Child [ | | field : { (Identifier,Type,ChildKind) } ] + | Child lhs.field = (@name,@tp,@kind) + +------------------------------------------------------------------------------- +-- +------------------------------------------------------------------------------- +ATTR Rule Pattern Patterns [ || containsVars USE {||} {False} : Bool ] + +SEM Pattern + | Alias lhs.containsVars = True + +ATTR Rule [ | | isPure : Bool ] +SEM Rule | Rule lhs.isPure = @pure + +------------------------------------------------------------------------------- +-- Eliminate SELF types +------------------------------------------------------------------------------- + +SEM Nonterminal | Nonterminal + loc.inh1 = Map.map (elimSelfId @nt @params) @inh + loc.syn1 = Map.map (elimSelfId @nt @params) @syn + +SEM Child | Child + (loc.nt, loc.params) = 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, []) -- should be ignored because the child is a terminal + loc.inh1 = Map.map (elimSelfStr @loc.nt @loc.params) @loc.inh + loc.syn1 = Map.map (elimSelfStr @loc.nt @loc.params) @loc.syn + +SEM TypeSig | TypeSig + loc.tp1 = elimSelfId @lhs.nt @lhs.params @tp + +{ +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 +} + +------------------------------------------------------------------------------- +-- Reconstructing the tree +------------------------------------------------------------------------------- + +ATTR Nonterminals Nonterminal Productions Production Rules Rule [ | uniq:Int | ] + +SEM Grammar + | Grammar nonts.uniq = 1 + +ATTR Grammar Nonterminals Nonterminal Productions + Production Children Child Rules Rule Pattern Patterns TypeSigs TypeSig + [ | | output:SELF ] + +ATTR Rule [ | | outputs:Rules ] + +SEM Nonterminal | Nonterminal + lhs.output = Nonterminal @nt @params @loc.inh1 @loc.syn1 @prods.output + +SEM Production + | Production + loc.extra1 = foldr addAugments (@rules.output ++ @newRls) (Map.assocs @loc.augmentsIn) + loc.extra2 = foldr addArounds @loc.extra1 (Map.assocs @loc.aroundsIn) + loc.extra3 = foldr addMerges @loc.extra2 (Map.assocs @loc.mergesIn) + lhs.output = Production @con @params @constraints @children.output @loc.extra3 @typeSigs.output @macro + +SEM Child | Child + lhs.output = Child @name @tp @kind + +SEM TypeSig | TypeSig + lhs.output = TypeSig @name @loc.tp1 + +SEM Rules + | Cons lhs.output = if @hd.containsVars && @hd.isPure then @hd.outputs ++ @tl.output else @tl.output + -- remove rules that define nothing and do not have side effects + +SEM Rule + | Rule (loc.output1, loc.mbAlias) = mkRuleAlias @loc.output + (loc.outputs, lhs.uniq) = if needsMultiRules @lhs.options -- check if this works for UHC + then multiRule @loc.output1 @lhs.uniq + else ([@loc.output1], @lhs.uniq) + lhs.outputs = maybe [] return @loc.mbAlias ++ @loc.outputs + +{ +-- 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 +} + + +-- Work towards removing the need of the "multiRule". +-- It's currently only needed for the Kastens code generation +{ +needsMultiRules :: Options -> Bool +needsMultiRules opts = (visit opts || withCycle opts) && not (kennedyWarren opts) +} + +{ +{- +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) + +} + +------------------------------------------------------------------------------- +-- Check the order definitions +------------------------------------------------------------------------------- + +ATTR Nonterminals Nonterminal Productions Production [ manualAttrOrderMap : {AttrOrderMap} | | ] + +SEM Grammar + | Grammar + nonts.manualAttrOrderMap = @manualAttrOrderMap + +ATTR Rules Rule [ | | ruleNames USE {`Set.union`} {Set.empty} : {Set Identifier} ] + +SEM Rule | Rule lhs.ruleNames = case @mbName of + Nothing -> Set.empty + Just nm -> Set.singleton nm + +SEM Production + | Production + loc.orderDeps = Set.toList $ Map.findWithDefault Set.empty @con $ Map.findWithDefault Map.empty @lhs.nt @lhs.manualAttrOrderMap + + loc.orderErrs + = let chldOutMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- @children.outputs ] + chldInMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- @children.inputs ] + + -- a local attribute + -- or an inherited attribute of the production + -- or an out-attribute of a child + isInAttribute :: Identifier -> Identifier -> [Error] + isInAttribute fld nm + | fld == _LOC = if nm `Set.member` @rules.locals + then [] + else [UndefAttr @lhs.nt @con fld nm False] + | fld == _LHS = if nm `Map.member` @lhs.inh + then [] + else [UndefAttr @lhs.nt @con fld nm False] + | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldOutMap) + then [] + else [UndefAttr @lhs.nt @con fld nm False] + + -- a local attribute + -- or a synthesized attribute of the production + -- or an in-attribute of a child + isOutAttribute :: Identifier -> Identifier -> [Error] + isOutAttribute fld nm + | fld == _LOC = if nm `Set.member` @rules.locals + then [] + else [UndefAttr @lhs.nt @con fld nm True] + | fld == _LHS = if nm `Map.member` @lhs.syn + then [] + else [UndefAttr @lhs.nt @con fld nm True] + | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldInMap) + then [] + else [UndefAttr @lhs.nt @con fld nm True] + + existsRule nm = if nm `Set.member` @rules.ruleNames + then [] + else [MissingNamedRule @lhs.nt @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) <- @loc.orderDeps + ] + +------------------------------------------------------------------------------- +-- Decompose augment +------------------------------------------------------------------------------- + +ATTR Nonterminals Nonterminal [ augmentsIn : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} | | ] +ATTR Productions Production [ augmentsIn : {Map ConstructorIdent (Map Identifier [Expression])} | | ] + +SEM Grammar | Grammar nonts.augmentsIn = @augmentsMap +SEM Nonterminal | Nonterminal loc.augmentsIn = Map.findWithDefault Map.empty @nt @lhs.augmentsIn +SEM Production | Production loc.augmentsIn = Map.findWithDefault Map.empty @con @lhs.augmentsIn + +ATTR Nonterminals Nonterminal [ aroundsIn : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} | | ] +ATTR Productions Production [ aroundsIn : {Map ConstructorIdent (Map Identifier [Expression])} | | ] + +SEM Grammar | Grammar nonts.aroundsIn = @aroundsMap +SEM Nonterminal | Nonterminal loc.aroundsIn = Map.findWithDefault Map.empty @nt @lhs.aroundsIn +SEM Production | Production loc.aroundsIn = Map.findWithDefault Map.empty @con @lhs.aroundsIn + +ATTR Nonterminals Nonterminal [ mergesIn : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))} | | ] +ATTR Productions Production [ mergesIn : {Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))} | | ] +ATTR Children Child [ merged : {Set Identifier} | | ] + +SEM Grammar | Grammar nonts.mergesIn = @mergeMap +SEM Nonterminal | Nonterminal loc.mergesIn = Map.findWithDefault Map.empty @nt @lhs.mergesIn +SEM Production | Production loc.mergesIn = Map.findWithDefault Map.empty @con @lhs.mergesIn + loc.merged = Set.fromList [ c | (_,cs,_) <- Map.elems @loc.mergesIn, c <- cs ]
+ src-ag/Desugar.ag view
@@ -0,0 +1,332 @@+PRAGMA strictdata +PRAGMA optimize +PRAGMA bangpats +PRAGMA strictwrap + +INCLUDE "AbstractSyntax.ag" +INCLUDE "Patterns.ag" +INCLUDE "Expression.ag" +INCLUDE "HsToken.ag" +INCLUDE "DistChildAttr.ag" + + +imports +{ +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 +} + +WRAPPER HsTokensRoot + + +ATTR Grammar Nonterminals Nonterminal Productions Production Children Child Rule Rules Expression [ options:{Options} | | ] + +ATTR Grammar Nonterminals Nonterminal Productions Production Rule Rules Pattern Patterns Expression HsTokensRoot HsToken HsTokens [ | | errors USE {Seq.><} {Seq.empty} : {Seq Error} ] + +ATTR Grammar Nonterminals Nonterminal Productions Production Child Children Rule Rules Pattern Patterns TypeSig TypeSigs Expression [ | | output : SELF ] + + +------------------------------------------------------------------------------- +-- Deal with RHS +------------------------------------------------------------------------------- + +SEM Expression + | Expression + (loc.tks', lhs.errors) = let inh = Inh_HsTokensRoot { childInhs_Inh_HsTokensRoot = @lhs.childInhs + , childSyns_Inh_HsTokensRoot = @lhs.childSyns + , nt_Inh_HsTokensRoot = @lhs.nt + , con_Inh_HsTokensRoot = @lhs.con + , ruleDescr_Inh_HsTokensRoot = @lhs.ruleDescr + , useFieldIdent_Inh_HsTokensRoot = genUseTraces @lhs.options + } + sem = sem_HsTokensRoot (HsTokensRoot @tks) + syn = wrap_HsTokensRoot sem inh + in (tks_Syn_HsTokensRoot syn, errors_Syn_HsTokensRoot syn) + lhs.output = Expression @pos @tks' + + +ATTR HsTokensRoot HsTokens HsToken [ useFieldIdent : Bool | | ] + +ATTR HsToken HsTokens [ | addLines : Int | ] +SEM HsTokensRoot + | HsTokensRoot + tokens.addLines = 0 + +ATTR HsTokensRoot [ | | tks : {[HsToken]} ] +ATTR HsToken HsTokens [ | | tks : SELF ] + +SEM HsToken + | AGLocal + lhs.addLines = if @lhs.useFieldIdent + then @lhs.addLines + 1 + else @lhs.addLines + loc.tks = AGLocal @var (addl @lhs.addLines @pos) (if @lhs.useFieldIdent then Just @lhs.ruleDescr else Nothing) + | AGField + loc.mField = findField @field @attr @lhs.childSyns + + loc.field' = maybe @field id @loc.mField + lhs.errors = maybe (Seq.singleton (UndefAttr @lhs.nt @lhs.con @field (Ident "<ANY>" (getPos @field)) False)) (const Seq.empty) @loc.mField + + lhs.addLines = if @lhs.useFieldIdent || length (getName @field) < length (getName @loc.field') + then @lhs.addLines + 1 + else @lhs.addLines + + loc.tks = AGField @loc.field' @attr (addl @lhs.addLines @pos) (if @lhs.useFieldIdent then Just @lhs.ruleDescr else Nothing) + | HsToken + loc.tks = HsToken @value (addl @lhs.addLines @pos) + | CharToken + loc.tks = CharToken @value (addl @lhs.addLines @pos) + | StrToken + loc.tks = StrToken @value (addl @lhs.addLines @pos) + | Err + loc.tks = Err @mesg (addl @lhs.addLines @pos) + +{ +addl :: Int -> Pos -> Pos +addl n (Pos l c f) = Pos (l+n) c f +} + + +------------------------------------------------------------------------------- +-- Deal with LHS +------------------------------------------------------------------------------- + +SEM Pattern + | Alias + (loc.field', loc.err1) = maybeError @field (UndefAttr @lhs.nt @lhs.con (Ident "<ANY>" (getPos @field)) @attr True) $ + findField @field @attr @lhs.childInhs + loc.err2 = if @loc.field' == @field + then Seq.empty + else if (@loc.field', @attr) `Set.member` @lhs.defs + then Seq.singleton $ DupRule @lhs.nt @lhs.con @field @attr @loc.field' + else Seq.empty + lhs.errors = @loc.err1 Seq.>< @loc.err2 Seq.>< @pat.errors + loc.output = Alias @loc.field' @attr @pat.output + + +------------------------------------------------------------------------------- +-- Distribute attributes of children +------------------------------------------------------------------------------- + +ATTR Children Child [ | | childInhs, childSyns USE {++} {[]} : {[(Identifier, Identifier)]} ] +ATTR Rules Rule Pattern Patterns Expression HsTokensRoot HsToken HsTokens [ childInhs, childSyns : {[(Identifier, Identifier)]} | | ] + +SEM Child + | Child + lhs.childInhs = [(i, @name) | i <- Map.keys @loc.inh ] + lhs.childSyns = [(s, @name) | s <- Map.keys @loc.syn ] + +{ +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 +} + + +------------------------------------------------------------------------------- +-- Distribute nt and con +------------------------------------------------------------------------------- + +ATTR Productions Production Rule Rules Pattern Patterns Expression HsTokensRoot HsToken HsTokens [ nt : NontermIdent | | ] +ATTR Rule Rules Pattern Patterns Expression HsTokensRoot HsToken HsTokens [ con : ConstructorIdent | | ] + +SEM Nonterminal + | Nonterminal + prods.nt = @nt + +SEM Production + | Production + rules.con = @con + + +------------------------------------------------------------------------------- +-- Distribute a pattern description +------------------------------------------------------------------------------- + +ATTR Expression HsTokensRoot HsToken HsTokens [ ruleDescr : String | | ] + +SEM Rule + | Rule + loc.ruleDescr = show @lhs.nt ++ " :: " ++ show @lhs.con ++ " :: " ++ (concat $ intersperse "," $ map (\(f,a) -> show f ++ "." ++ show a) $ Set.toList @pattern.defsCollect) + + +------------------------------------------------------------------------------- +-- Distribute all defined attributes +------------------------------------------------------------------------------- + +ATTR Rule Rules Pattern Patterns [ | | defsCollect USE {`Set.union`} {Set.empty} : {Set (Identifier, Identifier)} ] +SEM Pattern + | Alias + loc.def = Set.singleton (@field, @attr) + lhs.defsCollect = @loc.def `Set.union` @pat.defsCollect + +ATTR Rule Rules Pattern Patterns [ defs : {Set (Identifier, Identifier)} | | ] +SEM Production + | Production + rules.defs = @rules.defsCollect + + +------------------------------------------------------------------------------- +-- Collect a list of all attributes (that are not irrefutable) +------------------------------------------------------------------------------- + +ATTR Grammar Nonterminals Nonterminal Productions Production Rule Rules Pattern Patterns + [ | | allAttributes USE {`mergeAttributes`} {Map.empty} : {AttrMap} ] + +SEM Pattern + | Alias + lhs.allAttributes = (Map.singleton @lhs.nt $ Map.singleton @lhs.con $ Set.singleton (@field, @attr)) `mergeAttributes` @pat.allAttributes + | Irrefutable + lhs.allAttributes = Map.empty + +{ +mergeAttributes :: AttrMap -> AttrMap -> AttrMap +mergeAttributes = Map.unionWith $ Map.unionWith $ Set.union +} + + +------------------------------------------------------------------------------- +-- Distribute a list of attributes forced to irrefutables +------------------------------------------------------------------------------- + +ATTR Grammar Nonterminals Nonterminal Productions Production Rule Rules Pattern Patterns + [ forcedIrrefutables : {AttrMap} | | ] + +SEM Pattern + | Alias + lhs.output = if Set.member (@field, @attr) $ Map.findWithDefault Set.empty @lhs.con $ Map.findWithDefault Map.empty @lhs.nt $ @lhs.forcedIrrefutables + then Irrefutable @loc.output + else @loc.output + + +------------------------------------------------------------------------------- +-- Decompose augment map and rebuild it +------------------------------------------------------------------------------- + +ATTR Nonterminals Nonterminal [ augmentsIn : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} + | | augmentsOut USE {`Map.union`} {Map.empty} : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} ] +ATTR Productions Production [ augmentsIn : {Map ConstructorIdent (Map Identifier [Expression])} + | | augmentsOut USE {`Map.union`} {Map.empty} : {Map ConstructorIdent (Map Identifier [Expression])} ] + +SEM Grammar + | Grammar + nonts.augmentsIn = @augmentsMap + +SEM Nonterminal + | Nonterminal + loc.augmentsIn = Map.findWithDefault Map.empty @nt @lhs.augmentsIn + loc.augmentsOut = Map.singleton @nt @prods.augmentsOut + +SEM Production + | Production + loc.augmentsIn = Map.findWithDefault Map.empty @con @lhs.augmentsIn + loc.augmentsOut = Map.singleton @con @loc.augmentsOut1 + + (loc.augmentErrs, loc.augmentsOut1) = Map.mapAccum (desugarExprs @lhs.options @lhs.nt @con @children.childInhs @children.childSyns) Seq.empty @loc.augmentsIn + +WRAPPER Expression + +{ +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 +} + + +------------------------------------------------------------------------------- +-- Errors of a production +------------------------------------------------------------------------------- + +SEM Production + | Production + lhs.errors = @rules.errors Seq.>< @loc.augmentErrs + +------------------------------------------------------------------------------- +-- Support for late binding of higher order children +------------------------------------------------------------------------------- + +ATTR Grammar Nonterminals Nonterminal Productions Production Children Child [ mainName : {String} | | ] + +SEM Nonterminal | Nonterminal + loc.extraInh = addLateAttr @lhs.options @lhs.mainName + +{ +addLateAttr :: Options -> String -> Attributes +addLateAttr options mainName + | kennedyWarren options && lateHigherOrderBinding options = + let tp = lateBindingType mainName + in Map.singleton idLateBindingAttr tp + | otherwise = Map.empty +} + +------------------------------------------------------------------------------- +-- Reconstruct the grammar +------------------------------------------------------------------------------- + +SEM Nonterminal | Nonterminal + lhs.output = Nonterminal + @nt @params + (@loc.extraInh `Map.union` @inh) + @syn + @prods.output + +SEM Child | Child + lhs.output = Child @name @tp @kind + +SEM Grammar + | Grammar + lhs.output = Grammar @typeSyns + @useMap + @derivings + @wrappers + @nonts.output + @pragmas + @manualAttrOrderMap + @paramMap + @contextMap + @quantMap + @uniqueMap + @nonts.augmentsOut + @aroundsMap + @mergeMap
src-ag/DistChildAttr.ag view
@@ -5,7 +5,7 @@ SEM Nonterminal | Nonterminal lhs.inhMap' = Map.singleton @nt @inh - lhs.synMap' = Map.singleton @nt @syn + lhs.synMap' = Map.singleton @nt @syn ATTR Nonterminals Nonterminal Productions Production @@ -13,12 +13,12 @@ SEM Grammar | Grammar nonts.inhMap = @nonts.inhMap' - nonts.synMap = @nonts.synMap' + 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 + loc.inh = Map.findWithDefault Map.empty @loc.chnt @lhs.inhMap + loc.syn = Map.findWithDefault Map.empty @loc.chnt @lhs.synMap
+ src-ag/ErrorMessages.ag view
@@ -0,0 +1,148 @@+imports +{ +import UU.Scanner.Position(Pos) +import Pretty +import CodeSyntax +import CommonTypes +} + +TYPE Errors = [Error] + +DATA Error | ParserError pos : {Pos} + problem : {String} + action : {String} + + | HsParseError pos : {Pos} + msg : {String} + + | DupAlt nt : {NontermIdent} + con,occ1 : {ConstructorIdent} + + | DupSynonym nt,occ1 : {NontermIdent} + + | DupSet name,occ1 : {NontermIdent} + + | DupInhAttr nt : {NontermIdent} + attr,occ1 :{Identifier} + + | DupSynAttr nt : {NontermIdent} + attr,occ1 : {Identifier} + + | DupChild nt : {NontermIdent} + con : {ConstructorIdent} + name,occ1 : {Identifier} + + | DupRule nt : {NontermIdent} + con : {ConstructorIdent} + field : {Identifier} + attr,occ1 : {Identifier} + + | DupRuleName nt : {NontermIdent} + con : {ConstructorIdent} + nm : {Identifier} + + | DupSig nt : {NontermIdent} + con : {ConstructorIdent} + attr : {Identifier} + + | UndefNont nt : {NontermIdent} + + | UndefAlt nt : {NontermIdent} + con : {ConstructorIdent} + + | UndefChild nt : {NontermIdent} + con : {ConstructorIdent} + name : {Identifier} + + | MissingRule --pos : {Pos} + nt : {NontermIdent} + con : {ConstructorIdent} + field : {Identifier} + attr : {Identifier} + + | MissingNamedRule nt : {NontermIdent} + con : {Identifier} + name : {Identifier} + + | SuperfluousRule nt : {NontermIdent} + con : {ConstructorIdent} + field : {Identifier} + attr : {Identifier} + +-- | SuperfluousSig nt : {NontermIdent} +-- con : {ConstructorIdent} +-- attr : {Identifier} + + | UndefLocal nt : {NontermIdent} + con : {ConstructorIdent} + var : {Identifier} + + | ChildAsLocal nt : {NontermIdent} + con : {ConstructorIdent} + var : {Identifier} + + | UndefAttr nt : {NontermIdent} + con : {ConstructorIdent} + field : {Identifier} + attr : {Identifier} + isOut : {Bool} + + | Cyclic nt : {NontermIdent} + mbCon : {Maybe ConstructorIdent} + verts : {[String]} + + | CyclicSet name:{Identifier} + + | CustomError isWarning : {Bool} + pos : {Pos} + mesg : {PP_Doc} + + | LocalCirc nt : {NontermIdent} + con : {ConstructorIdent} + attr : {Identifier} + o_visit : {Bool} + path : {[String]} + + | InstCirc nt : {NontermIdent} + con : {ConstructorIdent} + attr : {Identifier} + o_visit : {Bool} + path : {[String]} + + | DirectCirc nt : {NontermIdent} + o_visit : {Bool} + cyclic : {[((Identifier,Identifier),[String],[String])]} + + | InducedCirc nt : {NontermIdent} + cinter : {CInterface} + cyclic : {[((Identifier,Identifier),[String],[String])]} + + | MissingTypeSig nt : {NontermIdent} + con : {ConstructorIdent} + attr : {Identifier} + + | MissingInstSig nt : {NontermIdent} + con : {ConstructorIdent} + attr : {Identifier} + + | DupUnique nt : {NontermIdent} + con : {ConstructorIdent} + attr : {Identifier} + + | MissingUnique nt : {NontermIdent} + attr : {Identifier} + + | MissingSyn nt : {NontermIdent} + attr : {Identifier} + + | IncompatibleVisitKind + child : {Identifier} + vis : {VisitIdentifier} + from : {VisitKind} + to : {VisitKind} + | IncompatibleRuleKind + rule : {Identifier} + kind : {VisitKind} + | IncompatibleAttachKind + child : {Identifier} + kind : {VisitKind}
+ src-ag/ExecutionPlan.ag view
@@ -0,0 +1,83 @@+imports +{ +-- 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) +} + +DATA ExecutionPlan | ExecutionPlan nonts : ENonterminals + typeSyns : {TypeSyns} + wrappers : {Set NontermIdent} + derivings : {Derivings} + +TYPE ENonterminals = [ENonterminal] + +TYPE EProductions = [EProduction] + +TYPE ERules = [ERule] + +TYPE EChildren = [EChild] + +TYPE VisitSteps = [VisitStep] + +TYPE Visits = [Visit] + +DATA ENonterminal | ENonterminal nt : {NontermIdent} + params : {[Identifier]} + classCtxs : {ClassContext} -- class context at the datatype level + initial : {StateIdentifier} + initialv : {[VisitIdentifier]} + nextVisits : {Map StateIdentifier StateCtx} -- info about the next visits from a given state + prevVisits : {Map StateIdentifier StateCtx} -- info about the previous visits to a given state + prods : EProductions + recursive : {Bool} + hoInfo : {HigherOrderInfo} + +DATA EProduction | EProduction con : {ConstructorIdent} + params : {[Identifier]} + constraints : {[Type]} -- (class/equality) constraints on types (requires GADTs) + rules : ERules + children : EChildren + visits : Visits + +DATA EChild | EChild name : {Identifier} + tp : {Type} + kind : {ChildKind} + hasAround : {Bool} -- if there exists a rule <name>_around that transforms the child's sem + merges : {Maybe [Identifier]} -- Nothing: not the result of a merge of other children (ignored for now) + isMerged : {Bool} -- False: not being used to merge other children (ignored for now) + | ETerm name : {Identifier} + tp : {Type} + +DATA ERule | ERule name : {Identifier} + pattern : Pattern + rhs : Expression + owrt : {Bool} + origin : String -- just for documentation (and maybe errors) + explicit : Bool -- True if this rule defined in the source code + pure : Bool -- True if this rule is pure (not monadic/no side effect) + mbError : {Maybe Error} -- the rule may contain an error that is yielded when the rule is scheduled + +DATA Visit | Visit ident : {VisitIdentifier} + from : {StateIdentifier} + to : {StateIdentifier} + inh : {Set Identifier} + syn : {Set Identifier} + steps : VisitSteps + kind : {VisitKind} + +DATA VisitStep | Sem name : {Identifier} + | ChildVisit child : {Identifier} + nonterm : {NontermIdent} + visit : {VisitIdentifier} + | PureGroup steps : VisitSteps -- A group of steps that should be executed purely + ordered : {Bool} + | Sim steps : VisitSteps + | ChildIntro child : {Identifier}
+ src-ag/ExecutionPlan2Caml.ag view
@@ -0,0 +1,1487 @@+-- As expected, the code generation for ML resembles the code generation for Haskell quite a bit. +-- However, there are several differences: +-- * no inline pragmas +-- * no strictness annotations (not needed) +-- * separating data types from code +-- +-- Generator conventions: +-- * we generate functions definitions with an 'and' binding and a match statement +-- * for some type aliasses, we'll introduce module decls in addition to a type +-- +-- Future work: +-- * abuse the module system more? +-- * parse ocaml blocks? +-- * lazy evaluation? +-- +-- Other comments: +-- * Empty records are not allowed in Ocaml. Mapping them to units. +-- * line pragmas. There are now line pragmas around the body of rules. +-- There cannot be syntactical mistakes in the patterns. However, there can be +-- type errors if a function returns a value with a type that differs from what +-- is expected. It's then not clear which location is reported. +-- Also, errors in type signatures are not caught. +-- However, usually, the problematic cases are syntax errors, and these are +-- prevented by parsing the definitions first. + +INCLUDE "ExecutionPlan.ag" +INCLUDE "Patterns.ag" +INCLUDE "Expression.ag" +INCLUDE "HsToken.ag" + +imports +{ +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) +} + +ATTR ExecutionPlan ENonterminals ENonterminal EProductions EProduction ERules ERule EChildren EChild + [ mainFile, mainName : String | | ] + +------------------------------------------------------------------------------- +-- Options +------------------------------------------------------------------------------- +ATTR ExecutionPlan + ENonterminals ENonterminal + EProductions EProduction + ERules ERule + EChildren EChild + Expression + HsToken HsTokens HsTokensRoot + Pattern Patterns + Visits Visit + VisitSteps VisitStep [ options : {Options} | | ] +ATTR EProductions EProduction [ rename : {Bool} | | ] + +SEM ENonterminal | ENonterminal + prods.rename = rename @lhs.options + +------------------------------------------------------------------------------- +-- Context info (nonterminal ident, constructor ident, nonterm params, etc.) +------------------------------------------------------------------------------- + +ATTR Visit Visits EProduction EProductions EChildren EChild ERules ERule [ nt : NontermIdent | | ] +SEM ENonterminal | ENonterminal + prods.nt = @nt + +ATTR EChildren EChild ERules ERule Visits Visit [ con : ConstructorIdent | | ] + +SEM EProduction | EProduction children.con = @con + rules.con = @con + visits.con = @con + +ATTR EProductions EProduction Visits Visit [ params : {[Identifier]} | | ] +SEM ENonterminal | ENonterminal + prods.params = @params + +------------------------------------------------------------------------------- +-- output attributes: we make a distinction between data declarations +-- and code +------------------------------------------------------------------------------- +ATTR ExecutionPlan [ | | datas, code, modules : {PP_Doc} ] + +SEM ExecutionPlan | ExecutionPlan + lhs.code = @nonts.code >-< @loc.wrappersExtra + lhs.datas = @nonts.datas >-< @loc.commonExtra + +ATTR ENonterminal ENonterminals + [ wrappers : {Set NontermIdent} | | datas,code,modules USE {>-<} {empty} : {PP_Doc} ] + +SEM ExecutionPlan | ExecutionPlan + nonts.wrappers = @wrappers + +SEM ENonterminal | ENonterminal + lhs.datas = ( text "" + >-< "(* *** " ++ getName @nt ++ " *** [data] *)") + >-< (if dataTypes @lhs.options + then pp "(* data *)" + >-< @loc.datatypeNt + >-< @loc.datatypeProds + >-< "" + else empty) + >-< (if @loc.hasWrapper + then pp "(* wrapper *)" + >-< @loc.wr_inh + >-< @loc.wr_syn + >-< "" + else empty) + >-< (if semfuns @lhs.options + then pp "(* semantic domain *)" + >-< @loc.t_init + >-< @loc.t_states + >-< @loc.c_states + >-< @prods.t_visits + >-< "" + else empty) + + lhs.code = ( text "" + >-< "(* *** " ++ getName @nt ++ " *** [code] *)") + >-< (if dataTypes @lhs.options + then pp "(* constructor functions *)" + >-< @loc.datatypeCon + else empty) + >-< (if @loc.hasWrapper + then pp "(* wrapper *)" + >-< @loc.wrapper + >-< "" + else empty) + >-< (if folds @lhs.options + then "(* cata *)" + >-< @loc.sem_nt + >-< "" + else empty) + >-< (if semfuns @lhs.options + then "(* semantic domain *)" + >-< @prods.sem_prod + >-< "" + else empty) + + -- note: we assume that these module declarations are not recursive, and + -- that their parameters do not depends on types generated by AG in the + -- same file. + lhs.modules = @loc.moduleDecl + + loc.hasWrapper = @nt `Set.member` @lhs.wrappers + +------------------------------------------------------------------------------- +-- Nonterminal datatype +------------------------------------------------------------------------------- +ATTR ENonterminal ENonterminals [ typeSyns : {TypeSyns} | | ] + +SEM ExecutionPlan | ExecutionPlan + nonts.typeSyns = @typeSyns + +{ +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 ] +} + + +-- for each nonterminal, the following data types in ocmal: +-- * data type for the nonterminal, with a constructor for +-- each production. The constructor takes a single field +-- with the type explained below. +-- * for each production, a record type comprising the +-- children of the production. +-- +-- * class contexts are ignored +-- * at most one type variable +-- +-- aliasses: lists, tuples +-- *** think about maps, sets, etc. Perhaps the name of +-- the alias should become a local module name. +-- + +SEM ENonterminal | ENonterminal + loc.t_params = ppTypeParams @params + loc.aliasPre = "and" >#< @loc.t_params >#< @nt >#< "=" + loc.aliasMod = @loc.aliasPre >#< modName @nt >|< ".t" + loc.datatypeNt + = case lookup @nt @lhs.typeSyns of + -- generate special code for certain type aliasses + Just (List t) -> @loc.aliasPre >#< ppTp t >#< "list" + Just (Maybe t) -> @loc.aliasPre >#< ppTp t >#< "option" + Just (Tuple ts) -> @loc.aliasPre >#< (pp_block "(" ")" " * " $ map (ppTp . snd) ts) + + Just (Map k v) -> @loc.aliasMod + Just (IntMap t) -> @loc.aliasMod + Just (OrdSet t) -> @loc.aliasMod + Just IntSet -> @loc.aliasMod + + -- use the constructor-based data-type generation for all other types + _ -> "and" >#< @loc.t_params >#< @nt >#< "=" + >-< ( if null @prods.datatype + then pp "unit" + else indent 2 $ vlist @prods.datatype_call + ) + + loc.datatypeCon + = case lookup @nt @lhs.typeSyns of + Just _ -> empty -- no constructor funs for type aliasses + Nothing -> vlist @prods.datatype_con + + loc.moduleDecl + = let ppModule :: PP a => a -> PP_Doc + ppModule expr = "module" >#< modName @nt >#< "=" + in case lookup @nt @lhs.typeSyns 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 + + loc.datatypeProds = vlist @prods.datatype + +ATTR EProduction [ | | datatype, datatype_call, datatype_con : {PP_Doc} ] +ATTR EProductions [ | | datatype, datatype_call, datatype_con USE {:} {[]} : {[PP_Doc]} ] + +SEM EProduction | EProduction + loc.o_records = dataRecords @lhs.options + loc.t_params = ppTypeParams @lhs.params + loc.t_c_params = ppTypeParams (cont_tvar : map pp @params) + loc.conname = conname @lhs.rename @lhs.nt @con + loc.recname = pp "fields_" >|< @loc.conname + lhs.datatype = "and" >#< @loc.t_params >#< @loc.recname >#< "=" + >#< ppFieldsType @loc.o_records False @children.sigs + lhs.datatype_call = pp "|" >#< @loc.conname >#< "of" >#< pp_parens (@loc.t_params >#< @loc.recname) + lhs.datatype_con + = let funNm = @lhs.nt >|< "_" >|< @con + decl = "and" >#< ppFunDecl @loc.o_sigs funNm params (@loc.t_params >#< @lhs.nt) body + params = [ (x, t) | (_,x,_,t) <- @children.sigs ] + body = @loc.conname >#< ppFieldsVal @loc.o_records @children.sigs + in decl + +ATTR EChild EChildren [ | | sigs USE {++} {[]} : {[(PP_Doc,PP_Doc,PP_Doc,PP_Doc)]} ] + +SEM EChild + | EChild ETerm + loc.tpDocFor = ppTp $ removeDeforested @tp + loc.tpDocDefor = ppTp $ forceDeforested @tp + loc.fieldNm = text $ recordFieldname @lhs.nt @lhs.con @name + loc.childNm = text (fieldname @name) + loc.field = (@loc.fieldNm, @loc.childNm, @loc.tpDocDefor, @loc.tpDocFor) + | EChild lhs.sigs = case @kind of + ChildAttr -> [] -- higher order attributes are not part of the data type + _ -> [@loc.field] + | ETerm lhs.sigs = [@loc.field] + +{ +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) +} + +------------------------------------------------------------------------------- +-- Nonterminal semantic function +------------------------------------------------------------------------------- +SEM ENonterminal | ENonterminal + loc.fsemname = \x -> prefix @lhs.options ++ show x + loc.semname = @loc.fsemname @nt + loc.frecarg = \t x -> case t of + NT nt _ _ -> pp_parens (@fsemname nt >#< x) + _ -> x + + loc.sem_param_tp = @loc.t_params >#< @nt + loc.sem_res_tp = @loc.t_params >#< @loc.t_type + loc.sem_tp = @loc.sem_param_tp >#< "->" >#< @loc.sem_res_tp + + loc.o_sigs = typeSigs @lhs.options + loc.sem_nt_body = "match arg with" >-< (indent 2 $ @prods.sem_nt) + loc.sem_nt = let genSem :: PP a => a -> PP_Doc -> PP_Doc + genSem nm body = "and" >#< ppFunDecl @loc.o_sigs (pp @loc.semname) [(pp nm, @loc.sem_param_tp)] @loc.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" >#< @loc.semname >|< "_Entry" >#< @loc.semname >|< "_Nil" >#< els + els = case v of + NT nt _ _ -> pp_parens (modName @nt >|< ".map" >#< @loc.fsemname nt >#< "m") + _ -> pp "m" + in genSem "m" body + genSet mbNt = let body = "List.fold_right" >#< @loc.semname >|< "_Entry" >#< + els (pp_parens (modName @nt >|< ".elements" >#< "s")) >#< @loc.semname >|< "_Nil" + els r = maybe r (\nt -> pp_parens ("List.map" >#< @loc.fsemname nt >#< r)) mbNt + in genSem "s" body + in case lookup @nt @lhs.typeSyns of + -- generate special code for some aliasses + Just (List t) -> let body = "List.fold_right" >#< @loc.semname >|< "_Cons" >#< els >#< @loc.semname >|< "_Nil" + els = case t of + NT nt _ _ -> pp_parens ("List.map" >#< @loc.fsemname nt >#< "list") + _ -> pp "list" + in genSem "list" body + Just (Tuple ts) -> let pat = pp_parens (ppCommas $ map fst ts) + body = @loc.semname >|< "_Tuple" >#< ppSpaced (map (\t -> @loc.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" >#< "->" >#< "=" >#< @loc.semname >|< "_Nothing" + , "Some" >#< "just" >#< "->" >#< @loc.semname >|< "_Just" >#< @frecarg t (pp "just") + ] + Just (OrdSet t) -> genSet $ case t of + NT nt _ _ -> Just nt + _ -> Nothing + Just (IntSet) -> genSet Nothing + + -- structural fold for the remaining cases + _ -> genSem "arg" @loc.sem_nt_body + +{ +-- 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 + +} + +-- The number of productions +ATTR EProductions EProduction [ | | count USE {+} {0} : {Int} ] +SEM EProduction | EProduction lhs.count = {1} + +-- The per-production match-expr cases for the sem_NT function +ATTR EProduction EProductions [ | | sem_nt USE {>-<} {empty} : {PP_Doc} ] +SEM EProduction | EProduction + lhs.sem_nt = "|" >#< conname @lhs.rename @lhs.nt @con >#< ppFieldsVal @loc.o_records @children.sigs >#< "->" >#< + prefix @lhs.options >|< @lhs.nt >|< "_" >|< @con >#< ppSpaced @children.argnamesw + +ATTR EChild [ | | argnamesw : { PP_Doc } ] +ATTR EChildren [ | | argnamesw USE {:} {[]} : {[PP_Doc]} ] + +SEM EChild + | EChild lhs.argnamesw = case @kind of + ChildSyntax -> "(" >#< prefix @lhs.options >|< @loc.nt >#< @name >|< "_" >#< ")" + ChildAttr -> empty -- no sem-case for a higher-order child + ChildReplace tp -> "(" >#< prefix @lhs.options >|< extractNonterminal tp >#< @name >|< "_" >#< ")" + | ETerm lhs.argnamesw = text $ fieldname @name + +------------------------------------------------------------------------------- +-- Types of attributes +------------------------------------------------------------------------------- +ATTR ExecutionPlan + ENonterminals + ENonterminal [ inhmap : {Map NontermIdent Attributes} + synmap : {Map NontermIdent Attributes} | | ] + +ATTR EProductions EProduction + ERules ERule + Patterns Pattern + Visits + Visit [ inhmap : {Attributes} + synmap : {Attributes} + allInhmap : {Map NontermIdent Attributes} + allSynmap : {Map NontermIdent Attributes} | | ] + +SEM ENonterminal + | ENonterminal (Just prods.inhmap) = Map.lookup @nt @lhs.inhmap + (Just prods.synmap) = Map.lookup @nt @lhs.synmap + prods.allInhmap = @lhs.inhmap + prods.allSynmap = @lhs.synmap + +------------------------------------------------------------------------------- +-- State datatypes +------------------------------------------------------------------------------- +{type VisitStateState = (VisitIdentifier,StateIdentifier, StateIdentifier)} + +ATTR Visit [ | | allvisits : { VisitStateState }] +ATTR Visits [ | | allvisits USE {:} {[]} : {[VisitStateState]}] +ATTR EProduction + EProductions [ | | allvisits: {[VisitStateState]}] + +SEM Visit + | Visit lhs.allvisits = (@ident, @from, @to) + +SEM EProductions + | Cons lhs.allvisits = @hd.allvisits -- just pick the first production + | Nil lhs.allvisits = error "Every nonterminal should have at least 1 production" + +-- type of tree in a given state s +SEM ENonterminal | ENonterminal + loc.allstates = orderStates @initial @prods.allvisits + loc.stvisits = \st -> filter (\(v,f,t) -> f == st) @prods.allvisits + loc.t_type = type_nt_sem_top @nt + loc.t_c_params = ppTypeParams (cont_tvar : map pp @params) + + -- the initial "s" type: contains the "attach" function that delivers the initial st + loc.t_init = "and" >#< @loc.t_params >#< @loc.t_type >#< "=" >#< pp_braces ( nm_attach @nt >#< ":" >#< "unit" >#< "->" >#< @loc.t_params >#< type_nt_sem @nt @initial) + + -- the "s" type in a given state: contains the invoke function to go to a next state + loc.t_states = 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" >#< @loc.t_params >#< t_st >#< "=" + in case nextVisits of + NoneVis -> decl >#< "unit" -- final state: no more subsequent visits + _ -> decl >#< ppRecordVal [ nm_invoke @nt st >#< ":" >#< cont_tvar >#< "." >#< @loc.t_c_params >#< c_st >#< "->" >#< cont_tvar ] + ) @loc.allstates + +{ +-- +-- 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 +} + +-- type of a caller that selects a visit v from state s of the child, and +-- provides a continuation of the caller after the visit to the child +SEM ENonterminal | ENonterminal + loc.c_states = vlist $ map (\st -> + let nt_st = type_nt_state @nt st + c_st = type_caller @nt st + outg = filter (\(_,f,_) -> f == st) @prods.allvisits + nextVisits = Map.findWithDefault ManyVis st @nextVisits + declHead = "and" >#< @loc.t_c_params >#< c_st >#< "=" + visitcons = vlist $ map (\(v,_,_) -> + "|" >#< con_visit @nt v >#< "of" >#< @loc.t_c_params >#< type_caller_visit @nt v + ) outg + in case nextVisits of -- slight optimization for when there is only one visit + NoneVis -> empty -- st is final state, no subsequent visits, thus no more caller info + OneVis v -> declHead >#< @loc.t_c_params >#< type_caller_visit @nt v + ManyVis -> declHead >-< indent 3 visitcons + ) @loc.allstates + +{ +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 +} + +-- type t_visit of a call to a visit v (inputs to the visit + continuation of the parents that gets the output + new state of the child) +ATTR Visit Visits EProduction EProductions [ | | t_visits USE {>-<} {empty} : {PP_Doc} ] + +SEM EProductions | Cons + lhs.t_visits = @hd.t_visits + -- just pick the first production (these results are the same for all of them) + -- todo: that means we should actually represent visit declarations in the AST... + +SEM Visit | Visit + loc.nameTIn_visit = conNmTVisitIn @lhs.nt @ident + loc.nameTOut_visit = conNmTVisitOut @lhs.nt @ident + loc.nameNextState = type_nt_sem @lhs.nt @to + loc.nameCaller_visit = type_caller_visit @lhs.nt @ident + + loc.nextVisitInfo = Map.findWithDefault ManyVis @to @lhs.nextVisits -- which visits can we do after we reach the @to state? + + loc.t_params = ppTypeParams @lhs.params + loc.t_c_params = ppTypeParams (cont_tvar : map pp @lhs.params) + + -- data type decls for the t_visit type + -- we generate a type for the caller of a visit, the arguments of the visit and the result of the visit + lhs.t_visits = "and" >#< @loc.t_c_params >#< @loc.nameCaller_visit >#< "=" >#< ppRecordTp + [ nm_inh @lhs.nt @ident >#< ":" >#< @loc.t_params >#< conNmTVisitIn @lhs.nt @ident + , nm_cont @lhs.nt @ident >#< ":" >#< @loc.t_params >#< conNmTVisitOut @lhs.nt @ident >#< "->" >#< cont_tvar + ] + >-< "and" >#< @loc.t_params >#< @loc.nameTIn_visit >#< "=" >#< ppRecordTp @loc.inhpart + >-< "and" >#< @loc.t_params >#< @loc.nameTOut_visit >#< "=" >#< ppRecordTp (@loc.synpart ++ @loc.contpart) + + loc.contpart = case @loc.nextVisitInfo of + NoneVis -> [] -- don't provide a continuation at all + _ -> [ nm_outarg_cont @lhs.nt @ident >#< ":" >#< @loc.t_params >#< @loc.nameNextState ] -- normal route: select the next semantics + + loc.inhpart = @loc.ppTypeList nm_inarg @inh @lhs.inhmap + loc.synpart = @loc.ppTypeList nm_outarg @syn @lhs.synmap + loc.ppTypeList = \f s m -> map (\i -> case Map.lookup i m of + Just tp -> f i @lhs.nt @ident >#< ":" >#< ppTp tp ) $ Set.toList s + +{ +-- 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" +} + +------------------------------------------------------------------------------- +-- Inh and Syn wrappers +------------------------------------------------------------------------------- +SEM ENonterminal | ENonterminal + loc.wr_inh = @loc.genwrap "inh" @loc.wr_inhs1 -- todo: is perhaps a mistake in 2hs + loc.wr_syn = @loc.genwrap "syn" @loc.wr_syns + loc.genwrap = \nm attrs -> + "and" >#< @loc.t_params >#< nm >|< "_" >|< @nt >#< "=" >#< ppRecordTp + [ i >|< "_" >|< nm >|< "_" >|< @nt >#< ":" >#< ppTp t | (i,t) <- attrs ] + + loc.inhAttrs = fromJust $ Map.lookup @nt @lhs.inhmap + loc.wr_inhs = Map.toList $ @loc.wr_filter $ @loc.inhAttrs + loc.wr_inhs1 = Map.toList @loc.inhAttrs + loc.wr_filter = if kennedyWarren @lhs.options && lateHigherOrderBinding @lhs.options + then Map.delete idLateBindingAttr + else id + loc.wr_syns = Map.toList $ fromJust $ Map.lookup @nt @lhs.synmap + + loc.wrapname = text ("wrap_" ++ show @nt) + loc.inhname = text ("inh_" ++ show @nt) + loc.synname = text ("syn_" ++ show @nt) + loc.firstVisitInfo = Map.findWithDefault ManyVis @initial @nextVisits + + loc.wrapArgSemTp = @loc.t_params >#< @loc.t_type + loc.wrapArgInhTp = @loc.t_params >#< @loc.inhname + loc.wrapArgPats = ppRecordVal [ i >|< "_inh_" >|< @nt >#< "=" >#< lhsname @lhs.options True i | (i,_) <- @loc.wr_inhs1 ] + loc.wrapResTp = @loc.t_params >#< @loc.synname + loc.wrapper = "and" >#< ppFunDecl @loc.o_sigs @loc.wrapname [(pp "act", @loc.wrapArgSemTp), (@loc.wrapArgPats, @loc.wrapArgInhTp)] @loc.wrapResTp @loc.wrapperPreamble + loc.wrapperPreamble + = ( if lateHigherOrderBinding @lhs.options + then "let" >#< lhsname @lhs.options True idLateBindingAttr >#< "=" >#< lateBindingFieldNm @lhs.mainName >#< "in" + else empty + ) -- initial attribute for late binding + >-< @loc.wrapperBody + loc.wrapperBody + = case @initialv of + [] -> text "{ }" -- case where there are no inherited or synthesized attributes + (initv:_) -> -- TODO: take care of multiple visits + let attach = "let" >#< "sem" >#< "=" >#< "act." >|< nm_attach @nt >#< "()" >#< "in" -- run attach code + + -- result transformer to wrapper output record + pat = ppRecordVal [ nm_outarg i @nt initv >#< "=" >#< lhsname @lhs.options False i | (i,_) <- @loc.wr_syns ] + bld = ppRecordVal [ i >|< "_syn_" >|< @nt >#< "=" >#< lhsname @lhs.options False i | (i,_) <- @loc.wr_syns ] + res = "let res = function" >#< pat >#< "->" >#< bld >#< "in" + + -- input to the visit (inh attrs + continuation) + inps = "let" >#< "inps" >#< "=" >#< ppRecordVal [ nm_inarg i @nt initv >#< "=" >#< lhsname @lhs.options True i | (i,_) <- @loc.wr_inhs ] >#< "in" + arg = "let" >#< "arg" >#< "=" >#< argcon >#< argrec >#< "in" + argcon = case @loc.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" -- invoke the visit + in attach >-< res >-< inps >-< arg >-< invoke + +------------------------------------------------------------------------------- +-- Collection of NT / Production sem funs references +------------------------------------------------------------------------------- + +ATTR ENonterminals ENonterminal EProductions EProduction [ | | semFunBndDefs, semFunBndTps USE {Seq.><} {Seq.empty} : {Seq PP_Doc} ] +SEM ENonterminal | ENonterminal + lhs.semFunBndDefs = @loc.semFunBndDef Seq.<| @prods.semFunBndDefs + lhs.semFunBndTps = @loc.semFunBndTp Seq.<| @prods.semFunBndTps + loc.semFunBndDef = @loc.semFunBndNm >#< "=" >#< @loc.semname + loc.semFunBndTp = @loc.semFunBndNm >#< ":" >#< @loc.sem_tp + loc.semFunBndNm = lateSemNtLabel @nt + +SEM EProduction | EProduction + lhs.semFunBndDefs = Seq.singleton @loc.semFunBndDef + lhs.semFunBndTps = Seq.singleton @loc.semFunBndTp + loc.semFunBndDef = @loc.semFunBndNm >#< "=" >#< @loc.semname + loc.semFunBndTp = @loc.semFunBndNm >#< ":" >#< @loc.sem_tp + loc.semFunBndNm = lateSemConLabel @lhs.nt @con + +-- Generate a dictionary that contains the semantics of all semantic functions +SEM ExecutionPlan | ExecutionPlan + loc.wrappersExtra = if lateHigherOrderBinding @lhs.options + then @loc.lateSemBndDef + else empty + loc.commonExtra = if lateHigherOrderBinding @lhs.options + then @loc.lateSemBndTp + else empty + loc.lateSemBndTp = "and" >#< lateBindingTypeNm @lhs.mainName >#< "=" >#< ppRecordTp (toList @nonts.semFunBndTps) + loc.lateSemBndDef = "and" >#< lateBindingFieldNm @lhs.mainName >#< ":" >#< lateBindingTypeNm @lhs.mainName >#< "=" + >-< (indent 2 $ ppRecordVal $ toList @nonts.semFunBndDefs) + +------------------------------------------------------------------------------- +-- Production semantic functions +------------------------------------------------------------------------------- +ATTR EProduction [ | | sem_prod : {PP_Doc} ] +ATTR EProductions [ | | sem_prod USE {>-<} {empty} : {PP_Doc} ] + +ATTR EProduction EProductions [ initial : {StateIdentifier} + allstates : {[StateIdentifier]} | | ] +SEM ENonterminal | ENonterminal + prods.initial = @initial + prods.allstates = @loc.allstates + +SEM EProduction | EProduction + loc.o_sigs = typeSigs @lhs.options + loc.t_type = type_nt_sem_top @lhs.nt + loc.semname = prefix @lhs.options >|< @lhs.nt >|< "_" >|< @con + loc.sem_res_tp = @loc.t_params >#< @loc.t_type + loc.sem_tp = pp_block "" "" "->" [ d | (_,_,d,_) <- @children.sigs ] >#< "->" >#< @loc.sem_res_tp + + loc.initializer + = -- some actions, performed upon attaching a child, can + -- be specified here in the form of a let-expression. + -- The resulting bindings of these actions are + -- in scope of the rules of the production + empty -- nothing for now + + loc.sem_prod = "and" >#< ppFunDecl @loc.o_sigs @loc.semname [ (x,d) | (_,x,d,_) <- @children.sigs ] @loc.sem_res_tp @loc.prod_body + loc.prod_body + = @loc.initializer + >-< "{" >#< nm_attach @lhs.nt >#< "=" >#< "function () ->" + >-< indent 2 + ( "(* rules of production" >#< @con >#< "*)" + >-< @rules.sem_rules + >-< "(* states of production" >#< @con >#< "*)" + >-< vlist @loc.statefuns + >-< nm_st @lhs.initial + ) + >#< "}" + + -- the semantic function of a production: defines a series of states and + -- their transitions. Two sorts of functions are important: + -- k-functions: inspect the caller_type to find out which visit the + -- caller wants and then dispatches that visit and continuation. + -- v-functions: the actual code of the visit. + loc.statefuns = map @loc.genstfn @lhs.allstates + loc.genstfn + = \st -> let nextVisitInfo = Map.findWithDefault ManyVis st @lhs.nextVisits + stNm = nm_st st + + -- note about the initial state: the initial state should be the only + -- state-binding that is not a function. It is non-recursive, its definition does + -- not involve side effect, and its not needed + -- anywhere except to be delivered as initial result. + stDef body = "let" >#< stNm >#< (if st == @lhs.initial then empty else @loc.stargs st) >#< "=" + >-< indent 2 body >#< "in" + + in case nextVisitInfo of + NoneVis -> -- the (empty) closure of a (non-initial) end state is not referenced + -- thus generating it is not needed (and omitting it may catch some small mistakes). + if st == @lhs.initial + then stDef (pp "unit") -- empty state + else empty -- no state generated + _ -> stDef $ mklets (@loc.stvs st ++ @loc.stks st) $ ppRecordVal + [ nm_invoke @lhs.nt st >#< "=" >#< nm_k st ] + + loc.stargs + = \st -> let attrs = maybe Map.empty id $ Map.lookup st @visits.intramap in ppSpaced + [ case mbAttr of + Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs @lhs.options) -> + case Map.lookup nm @loc.localAttrTypes of + Just tp -> pp_parens (strNm >#< ":" >#< ppTp tp) + Nothing -> pp strNm + Just attr | not (noPerStateTypeSigs @lhs.options) -> + case lookupAttrType attr @lhs.allInhmap @lhs.allSynmap @loc.childTypes of + Just tpDoc -> pp_parens (strNm >#< ":" >#< tpDoc) + Nothing -> pp strNm + _ -> pp strNm + | (strNm, mbAttr) <- Map.assocs attrs + ] >#< dummyPat @lhs.options (Map.null attrs) + + -- produces the "k" function that inspect the caller argument to dispatch a visit + loc.stvisits = \st -> filter (\(_,f,_) -> f == st) @visits.allvisits + loc.stks + = \st -> let stvisits = @loc.stvisits st + def = ppFunDecl False {- @loc.o_sigs -} (pp $ nm_k st) + [(pp "arg", @loc.t_c_params >#< type_caller @lhs.nt st)] (pp cont_tvar) body + + nextVisitInfo = Map.findWithDefault ManyVis st @lhs.nextVisits + body = case nextVisitInfo of + NoneVis -> text "?no next visit?" + OneVis v -> dispatch "arg" v + ManyVis -> let alt (v,_,_) = "|" >#< con_visit @lhs.nt v >#< "chosen" >#< "->" >-< indent 2 (dispatch "chosen" v) + in "match arg with" >-< (indent 2 $ vlist $ map alt stvisits) + + dispatch nm v = "let" >#< ppRecordVal + [ nm_inh @lhs.nt v >#< "=" >#< "inp" + , nm_cont @lhs.nt v >#< "=" >#< "cont" ] + >#< "=" >#< pp nm + >-< "in" >#< "cont" >#< pp_parens (nm_visit v >#< "inp") -- call cont with res of visit + + in if null stvisits + then [] + else [ "(* k-function for production" >#< @con >#< " *)" >-< def ] + + loc.stvs = \st -> [ppf | (f,ppf) <- @visits.sem_visit, f == st] + visits.mrules = @rules.mrules + +{ +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 +} + +------------------------------------------------------------------------------- +-- Visit semantic functions +------------------------------------------------------------------------------- +ATTR Visit [ | | sem_visit : { (StateIdentifier,PP_Doc) } ] +ATTR Visits [ | | sem_visit USE {:} {[]} : { [(StateIdentifier,PP_Doc)] } ] + +SEM Visit | Visit + loc.o_sigs = typeSigs @lhs.options + lhs.sem_visit = ( @from + , let resTp = @loc.t_params >#< @loc.nameTOut_visit + argTp = @loc.t_params >#< @loc.nameTIn_visit + argMatch = ppRecordVal [ nm_inarg i @lhs.nt @ident >#< "=" >#< lhsname @lhs.options True i | i <- Set.toList @inh ] + in ppFunDecl @loc.o_sigs (nm_visit @ident) [(argMatch, argTp)] resTp @steps.sem_steps + ) + + steps.follow = @loc.nextStBuild >-< @loc.resultval + + loc.nextArgsMp = maybe Map.empty id $ Map.lookup @to @lhs.allintramap + loc.nextArgs = ppSpaced $ Map.keys $ @loc.nextArgsMp + loc.nextStExp = nm_st @to >#< @loc.nextArgs >#< dummyArg @lhs.options (Map.null @loc.nextArgsMp) + + loc.resultval = ppRecordVal + ( [ nm_outarg i @lhs.nt @ident >#< "=" >#< lhsname @lhs.options False i | i <- Set.toList @syn ] + ++ [ @loc.nextStRefExp ]) + + (loc.nextStBuild, loc.nextStRefExp) + = case @loc.nextVisitInfo of + NoneVis -> (empty, empty) + _ -> ( "let" >#< nextStName >#< "=" >#< @loc.nextStExp >#< "in" + , nm_outarg_cont @lhs.nt @ident >#< "=" >#< nextStName) + +{ +resultValName :: String +resultValName = "__result_" + +nextStName :: String +nextStName = "__st_" +} + +-- Propagate the visit kind to the steps +ATTR VisitStep VisitSteps [ kind : VisitKind | | ] +SEM Visit | Visit steps.kind = @kind + +-- the steps in this group should be executed in a pure fashion +SEM VisitStep | PureGroup + steps.kind = VisitPure @ordered + +-- follow: the code of steps that follows after the VisitStep +ATTR Visits Visit VisitStep VisitSteps [ mrules : {Map Identifier (VisitKind -> Either Error PP_Doc)} | | ] +ATTR VisitStep VisitSteps [ follow : PP_Doc | | sem_steps USE {>-<} {empty} : PP_Doc ] + +-- continuation flow (passing the right steps as left follow steps) +SEM VisitSteps + | Cons hd.follow = @tl.sem_steps + lhs.sem_steps = @hd.sem_steps + | Nil lhs.sem_steps = @lhs.follow + +SEM VisitStep + | Sem loc.ruleItf = Map.findWithDefault (error $ "Rule " ++ show @name ++ " not found") @name @lhs.mrules + (lhs.errors, loc.sem_steps) = case @loc.ruleItf @lhs.kind of + Left e -> (Seq.singleton e, empty) + Right stmt -> (Seq.empty, stmt) + lhs.sem_steps = @loc.sem_steps >-< @lhs.follow + | ChildIntro loc.attachItf = Map.findWithDefault (error $ "Child " ++ show @child ++ " not found") @child @lhs.childintros + (lhs.errors,loc.sem_steps,lhs.defs,lhs.uses) + = case @loc.attachItf @lhs.kind of + Left e -> (Seq.singleton e, empty, Set.empty, Map.empty) + Right (code, defs, uses) -> (Seq.empty, code, defs, uses) + lhs.sem_steps = @loc.sem_steps >-< @lhs.follow + | ChildVisit loc.visitItf = Map.findWithDefault (error $ "Visit " ++ show @visit ++ " not found") @visit @lhs.allchildvisit + loc.childType = Map.findWithDefault (error ("type of child " ++ show @child ++ " is not in the childTypes map! " ++ show @lhs.childTypes)) @child @lhs.childTypes + (lhs.errors, lhs.sem_steps) = case @loc.visitItf @child @loc.childType @lhs.kind @lhs.follow of + Left e -> (Seq.singleton e, empty) + Right steps -> (Seq.empty, steps) + | Sim -- simply propagates + | PureGroup -- simply propagates + +-- +-- Some properties of VisitStep(s) +-- + +-- Number of steps in a 'Sim' block +ATTR VisitSteps [ | | size : Int ] +SEM VisitSteps + | Nil lhs.size = 0 + | Cons lhs.size = 1 + @tl.size + +-- Number the steps in a 'Sim' block +ATTR VisitSteps VisitStep [ | index : Int | ] +SEM VisitSteps | Cons + hd.index = @lhs.index -- copy rule + tl.index = 1 + @lhs.index + lhs.index = @tl.index -- copy rule +SEM Visit | Visit steps.index = 0 +SEM VisitStep | Sim steps.index = 0 + lhs.index = @lhs.index -- needed for if we ever allow nested Sims + +-- Biggest number of steps in previous blocks that used parallel invocation +-- This number - 1 (minimum 0) is the number of references for parallel invocation created +ATTR VisitSteps VisitStep [ | prevMaxSimRefs : Int | ] +SEM Visit | Visit steps.prevMaxSimRefs = 0 +SEM VisitStep | Sim + lhs.prevMaxSimRefs = if @loc.useParallel + then @lhs.prevMaxSimRefs `max` (@steps.index - 1) -- possibly new references made + else @lhs.prevMaxSimRefs -- no references created + +-- Is this the last step? +ATTR VisitSteps VisitStep [ | | isLast : Bool ] +ATTR VisitStep [ isLast : Bool | | ] +SEM VisitSteps + | Nil lhs.isLast = True + | Cons lhs.isLast = False + hd.isLast = @tl.isLast + +-- Use parallel invocation: only when option enabled and there is more than one visit to a child +-- Todo: implement a parallel evaluator +SEM VisitSteps VisitStep [ useParallel : Bool | | ] +SEM Visit | Visit steps.useParallel = False +SEM VisitStep | Sim loc.useParallel = parallelInvoke @lhs.options && @steps.size > 1 + +-- Child introduction +ATTR EChild EChildren + [ | | childintros USE {`Map.union`} {Map.empty} : {Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))} ] + +ATTR Visits Visit VisitSteps VisitStep + [ childintros : {Map Identifier (VisitKind -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))} | | ] + +SEM EProduction | EProduction + visits.childintros = @children.childintros + +SEM EChild + | ETerm lhs.childintros = Map.singleton @name (\_ -> Right (empty, Set.empty, Map.empty)) + | EChild lhs.childintros = Map.singleton @name @loc.introcode + loc.isDefor = case @tp of + NT _ _ defor -> defor + _ -> False + loc.valcode = case @kind of + ChildSyntax -> @name >|< "_" + ChildAttr -> -- decide if we need to invoke the sem-function under the hood + let head | not @loc.isDefor = if lateHigherOrderBinding @lhs.options + then lateSemNtLabel @loc.nt >#< lhsname @lhs.options True idLateBindingAttr + else prefix @lhs.options >|< @loc.nt + | otherwise = empty -- no need to intro a terminal + in pp_parens (head >#< instname @name) + ChildReplace _ -> -- the higher-order attribute is actually a function that transforms + -- the semantics of the child (always deforested) + pp_parens (instname @name >#< @name >|< "_") + loc.aroundcode = if @hasAround + then locname @lhs.options @name >|< "_around" + else empty + loc.introcode = \kind -> let pat = text $ stname @name @loc.initSt + attach = pp_parens (@loc.aroundcode >#< @loc.valcode) >|< "." >|< nm_attach @loc.nt >#< "()" + decl = pat >#< "=" >#< attach + in if compatibleAttach kind @loc.nt @lhs.options + then Right ( "let" >#< decl >#< "in" + , Set.singleton (stname @name @loc.initSt) -- variables defined by the child intro + , case @kind of -- variables used by the child introduction + ChildAttr -> Map.insert (instname @name) Nothing $ -- the sem attr + ( if @loc.isDefor || not (lateHigherOrderBinding @lhs.options) + then id -- the sem dictionary attr is not used + else Map.insert (lhsname @lhs.options True idLateBindingAttr) (Just $ AttrInh _LHS idLateBindingAttr) + ) $ + ( if @hasAround + then Map.insert (locname @lhs.options (@name) ++ "_around") Nothing + else id + ) $ Map.empty + ChildReplace _ -> Map.singleton (instname @name) Nothing -- uses the transformation function + ChildSyntax -> Map.empty + ) + else Left $ IncompatibleAttachKind @name kind + loc.nt = extractNonterminal @tp + +{ +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 +} + +-- rules +ATTR ERules ERule [ | | sem_rules USE {>-<} {empty} : {PP_Doc} + mrules USE {`Map.union`} {Map.empty} : {Map Identifier (VisitKind -> Either Error PP_Doc)} ] + +SEM ERule | ERule + lhs.sem_rules = if @loc.used == 0 + then empty + else @loc.rulecode + loc.rulecode = ( if @loc.genpragma + then @loc.pragma -- this additional pragma *may* help to give some AG source location in the presence of + -- type errors in the rule. It will definitely not be precise, and may take some additional + -- source space, but let's see if it's worth it in practice. + else empty + ) + >-< @loc.declHead + >-< indent ((column @rhs.pos - 2) `max` 2) + ( if @loc.genpragma + then @loc.pragma >-< @rhs.semfunc >-< @loc.endpragma + else @rhs.semfunc + ) + >#< "in" + loc.pragma = ppLinePragma @lhs.options (line @rhs.pos) (file @rhs.pos) + loc.endpragma = ppWithLineNr (\ln -> ppLinePragma @lhs.options (ln+1) @lhs.mainFile) + loc.genpragma = genLinePragmas @lhs.options && @explicit && @loc.haspos + loc.haspos = line @rhs.pos > 0 && column @rhs.pos >= 0 && not (null (file @rhs.pos)) + + -- Note: we also ensure that all rules are functions, so that they are not made part of any closures + -- but are lambda-lifted instead. + loc.declHead = "let" >#< @name >#< @loc.argPats >#< dummyPat @lhs.options (Map.null @rhs.attrs) >#< "=" + loc.argPats + = ppSpaced + [ case mbAttr of + Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs @lhs.options) -> + case Map.lookup nm @lhs.localAttrTypes of + Just tp -> pp_parens (strNm >#< ":" >#< ppTp tp) + Nothing -> pp strNm + Just attr | not (noPerStateTypeSigs @lhs.options) -> + case lookupAttrType attr @lhs.allInhmap @lhs.allSynmap @lhs.childTypes of + Just tpDoc -> pp_parens (strNm >#< ":" >#< tpDoc) + Nothing -> pp strNm + _ -> pp strNm + | (strNm, mbAttr) <- Map.assocs @rhs.attrs + ] + + loc.argExprs = ppSpaced $ Map.keys @rhs.attrs + loc.stepcode = \kind -> + let mkBind (pat,expr) = "let" >#< pat >#< "=" >#< expr >#< "in" + in if kind `compatibleRule` @pure + then Right $ mkBind (@pattern.sem_lhs, @name >#< @loc.argExprs >#< dummyArg @lhs.options (Map.null @rhs.attrs)) + >-< vlist (map mkBind @pattern.extraDefs) + else Left $ IncompatibleRuleKind @name kind + + lhs.mrules = Map.singleton @name @loc.stepcode + +ATTR Expression [ | | tks : {[HsToken]} ] +SEM Expression + | Expression lhs.tks = @tks + +{ +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" +} + +ATTR Expression [ | | pos : {Pos} ] +SEM Expression | Expression lhs.pos = @pos + +-- pattern and expression semantics +ATTR Pattern [ | | sem_lhs : { PP_Doc } ] +ATTR Patterns [ | | sem_lhs USE {:} {[]} : {[PP_Doc]} ] +ATTR Pattern Patterns [ | | extraDefs USE {++} {[]} : {[(PP_Doc,PP_Doc)]} ] + +SEM Pattern + | Alias loc.var = text $ attrname @lhs.options False @field @attr + loc.hasTp = isJust @loc.mbTp + loc.o_sigs = typeSigs @lhs.options + + lhs.sem_lhs = ppArg (@loc.hasTp && @loc.o_sigs) @loc.var (maybe (text "?no type?") ppTp @loc.mbTp) + lhs.extraDefs = if @pat.isUnderscore + then [] + else [ (@pat.sem_lhs, @loc.var) ] + | Product lhs.sem_lhs = pp_block "(" ")" "," @pats.sem_lhs + | Constr lhs.sem_lhs = pp_parens $ @name >#< pp_block "(" ")" "," @pats.sem_lhs + | Underscore lhs.sem_lhs = text "_" + | Irrefutable lhs.sem_lhs = pp_parens (text "lazy" >#< @pat.sem_lhs) + -- note that the above has the inverse meaning compared to Haskell: + -- the above forces the evaluation of a lazy value. It seems appropriate though. + +-- Check if a pattern is just an underscore +ATTR Pattern [ | | isUnderscore:{Bool}] +SEM Pattern + | Constr lhs.isUnderscore = False + | Product lhs.isUnderscore = False + | Alias lhs.isUnderscore = False + | Underscore lhs.isUnderscore = True + +-- Collect the attributes defined by a pattern +ATTR Pattern Patterns [ | | attrs USE {`Set.union`} {Set.empty} : {Set String} ] +SEM Pattern | Alias + lhs.attrs = Set.insert (attrname @lhs.options False @field @attr) @pat.attrs + +-- All attribute types of this pattern +-- Todo: if possible, make attribute types part of the pattern +ATTR Pattern Patterns [ | | attrTypes USE {>-<} {empty} : {PP_Doc} ] +SEM Pattern | Alias + loc.mbTp = if @field == _LHS + then Map.lookup @attr @lhs.synmap + else if @field == _LOC + then Map.lookup @attr @lhs.localAttrTypes + else Nothing + lhs.attrTypes = maybe empty (\tp -> (attrname @lhs.options False @field @attr) >#< "::" >#< ppTp tp) @loc.mbTp + >-< @pat.attrTypes + +-- Collect the attributes used by the right-hand side +ATTR HsToken Expression [ | | attrs USE {`Map.union`} {Map.empty} : {Map String (Maybe NonLocalAttr)} ] +SEM HsToken + | AGLocal lhs.attrs = Map.singleton (fieldname @var) Nothing + | AGField loc.mbAttr = if @field == _INST || @field == _FIELD || @field == _INST' + then Nothing -- should not be used in the first place + else Just $ mkNonLocalAttr (@field == _LHS) @field @attr + lhs.attrs = Map.singleton (attrname @lhs.options True @field @attr) @loc.mbAttr + +{ +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 +} + +ATTR Expression [ | | semfunc : {PP_Doc} ] + +SEM Expression + | Expression lhs.attrs = Map.unions $ map (\tok -> attrs_Syn_HsToken (wrap_HsToken (sem_HsToken tok) @loc.inhhstoken)) @tks + lhs.semfunc = vlist $ showTokens $ map (\tok -> tok_Syn_HsToken (wrap_HsToken (sem_HsToken tok) @loc.inhhstoken)) @tks + loc.inhhstoken = Inh_HsToken @lhs.options + +-- child visit map +ATTR Visit + Visits + EProduction + EProductions + ENonterminal + ENonterminals [ allchildvisit : {Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)} + | | childvisit USE {`Map.union`} {Map.empty} : {Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)} ] + +ATTR VisitSteps VisitStep [ allchildvisit : {Map VisitIdentifier (Identifier -> Type -> VisitKind -> PP_Doc -> Either Error PP_Doc)} | | ] + +SEM ExecutionPlan + | ExecutionPlan nonts.allchildvisit = @nonts.childvisit + +-- code for the invocation of the visit: +-- * "follow" is the pretty print of the code that follows this step, and is thus the code that comprises the continuation. +-- * the child state contain a field which is the operation to invoke +-- * we create a parameter with the inputs to the visit and the continuation +-- * the continuation obtains the resulting outputs plus the updated state +SEM Visit | Visit + loc.prevVisitInfo = Map.findWithDefault ManyVis @from @lhs.nextVisits + lhs.childvisit = Map.singleton @ident @loc.invokecode + loc.invokecode + = \chld childTp kind follow -> -- "chld" is the name of the child at the place of invocation, and "kind" the kind of the calling visit + 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 is parameterized with the outputs of the child and brings them in scope + cont = "let" >#< contNm >#< ppArg @loc.o_sigs (ppRecordVal cont_in) cont_in_tp >#< "=" + >-< indent 2 follow -- the continuation-code + >#< "in" + cont_in = [ nm_outarg i @lhs.nt @ident >#< "=" >#< attrname @lhs.options True chld i | i <- Set.toList @syn ] + ++ case @loc.nextVisitInfo of + NoneVis -> [] + _ -> [ nm_outarg_cont @lhs.nt @ident >#< "=" >#< childNmTo ] + cont_in_tp = ppTypeParams childTpArgs >#< @loc.nameTOut_visit + + -- defines the input records to the visit function + inps = "let" >#< inpsNm >#< "=" >#< ppRecordVal + [ nm_inh @lhs.nt @ident >#< "=" >#< ppRecordVal inps_in + , nm_cont @lhs.nt @ident >#< "=" >#< contNm + ] >#< "in" + inps_in = [ nm_inarg i @lhs.nt @ident >#< "=" >#< attrname @lhs.options False chld i | i <- Set.toList @inh ] + + -- the call to the visit function, with possible the need to specify which visit function to dispatch to + call = childNmFrom >|< "." >|< nm_invoke @lhs.nt @from >#< arg + arg = case @loc.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 @lhs.nt @ident >#< inpsNm) + in if kind `compatibleKind` @kind + then Right code + else Left $ IncompatibleVisitKind chld @ident kind @kind + +{ +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 +} + +------------------------------------------------------------------------------- +-- Properties of rules +------------------------------------------------------------------------------- + +-- Construct an environment that counts how often certain rules are used +ATTR Visits Visit VisitSteps VisitStep [ | | ruleUsage USE {`unionWithSum`} {Map.empty} : {Map Identifier Int} ] +ATTR ERules ERule [ usageInfo : {Map Identifier Int} | | ] + +SEM EProduction | EProduction rules.usageInfo = @visits.ruleUsage +SEM VisitStep | Sem lhs.ruleUsage = Map.singleton @name 1 +SEM ERule | ERule loc.used = Map.findWithDefault 0 @name @lhs.usageInfo + +{ +unionWithSum = Map.unionWith (+) +} + +-- Collect in what visit-kinds a rule is used +ATTR Visits Visit VisitSteps VisitStep [ | | ruleKinds USE {`unionWithMappend`} {Map.empty} : {Map Identifier (Set VisitKind)} ] +SEM VisitStep | Sem + lhs.ruleKinds = Map.singleton @name (Set.singleton @lhs.kind) + +ATTR ERules ERule [ ruleKinds : {Map Identifier (Set VisitKind)} | | ] +SEM EProduction | EProduction + rules.ruleKinds = @visits.ruleKinds + +SEM ERule | ERule + loc.kinds = Map.findWithDefault Set.empty @name @lhs.ruleKinds + loc.anyLazyKind = Set.fold (\k r -> isLazyKind k || r) False @loc.kinds + +ATTR Pattern Patterns [ anyLazyKind : Bool | | ] + + +------------------------------------------------------------------------------- +-- Intra attributes +------------------------------------------------------------------------------- +{ +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 +} +ATTR Visit Visits [ allintramap : {Map StateIdentifier (Map String (Maybe NonLocalAttr))} + | | intramap USE {`uwMapUnion`} {Map.empty} : {Map StateIdentifier (Map String (Maybe NonLocalAttr))} ] + +ATTR Visit Visits [ terminaldefs : {Set String} | | ] +ATTR EChild EChildren [ | | terminaldefs USE {`Set.union`} {Set.empty} : {Set String} ] + +SEM EChild | ETerm + lhs.terminaldefs = Set.singleton $ fieldname @name + +SEM EProduction | EProduction + visits.allintramap = @visits.intramap + visits.terminaldefs = @children.terminaldefs + +SEM Visit + | Visit loc.thisintra = (@loc.uses `Map.union` @loc.nextintra) `Map.difference` @loc.defsAsMap + lhs.intramap = Map.singleton @from @loc.thisintra + loc.nextintra = maybe Map.empty id $ Map.lookup @to @lhs.allintramap + loc.uses = let mp1 = @steps.uses + mp2 = Map.fromList [ (lhsname @lhs.options False i, Just (AttrSyn _LHS i)) | i <- Set.elems @syn ] + in mp1 `Map.union` mp2 + loc.inhVarNms = Set.map (lhsname @lhs.options True) @inh + loc.defs = @steps.defs `Set.union` @loc.inhVarNms `Set.union` @lhs.terminaldefs + loc.defsAsMap = Map.fromList [ (a, Nothing) | a <- Set.elems @loc.defs ] + +ATTR ERule ERules [ | | ruledefs USE {`uwSetUnion`} {Map.empty} : {Map Identifier (Set String)} + ruleuses USE {`uwMapUnion`} {Map.empty} : {Map Identifier (Map String (Maybe NonLocalAttr))} ] +ATTR Visit Visits + VisitSteps VisitStep [ ruledefs : {Map Identifier (Set String)} + ruleuses : {Map Identifier (Map String (Maybe NonLocalAttr))} | | ] + +SEM ERule + | ERule lhs.ruledefs = Map.singleton @name @pattern.attrs + lhs.ruleuses = Map.singleton @name @rhs.attrs + +SEM EProduction + | EProduction visits.ruledefs = @rules.ruledefs + visits.ruleuses = @rules.ruleuses + +ATTR Visit Visits + EProduction + EProductions + ENonterminal + ENonterminals [ | | visitdefs USE {`uwSetUnion`} {Map.empty} : {Map VisitIdentifier (Set Identifier)} + visituses USE {`uwSetUnion`} {Map.empty} : {Map VisitIdentifier (Set Identifier)} ] + +SEM Visit + | Visit lhs.visitdefs = Map.singleton @ident @syn + lhs.visituses = Map.singleton @ident @inh + +ATTR Visit Visits + VisitSteps VisitStep + EProduction EProductions + ENonterminal ENonterminals [ avisitdefs : {Map VisitIdentifier (Set Identifier)} + avisituses : {Map VisitIdentifier (Set Identifier)} | | ] + +SEM ExecutionPlan + | ExecutionPlan nonts.avisitdefs = @nonts.visitdefs + nonts.avisituses = @nonts.visituses + +ATTR VisitSteps VisitStep [ | | defs USE {`Set.union`} {Set.empty} : {Set String} + uses USE {`Map.union`} {Map.empty} : {Map String (Maybe NonLocalAttr)} ] +SEM VisitStep + | Sem lhs.defs = maybe (error "Rule not found") id $ Map.lookup @name @lhs.ruledefs + lhs.uses = maybe (error "Rule not found") id $ Map.lookup @name @lhs.ruleuses + | ChildVisit lhs.defs = Set.insert (stname @child @to) $ maybe (error "Visit not found") (Set.map $ attrname @lhs.options True @child) $ Map.lookup @visit @lhs.avisitdefs + lhs.uses = let convert attrs = Map.fromList [ (attrname @lhs.options 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 @lhs.avisituses + +------------------------------------------------------------------------------- +-- Identification of lazy intra defs within a production +-- +-- These identifiers will not be marked as strict in rules and state closures +------------------------------------------------------------------------------- + +ATTR Visits Visit VisitSteps VisitStep [ | | lazyIntras USE {`Set.union`} {Set.empty} : {Set String} ] +ATTR ERules ERule [ lazyIntras : {Set String} | | ] + +SEM Visit | Visit + loc.lazyIntrasInh = case @kind of + VisitPure False -> @loc.inhVarNms `Set.union` @steps.defs + _ -> Set.empty + lhs.lazyIntras = @loc.lazyIntrasInh `Set.union` @steps.lazyIntras + +SEM VisitStep | PureGroup + lhs.lazyIntras = if @ordered + then @steps.lazyIntras + else @steps.defs + +SEM EProduction | EProduction + loc.lazyIntras = @visits.lazyIntras + +------------------------------------------------------------------------------- +-- Pretty printing of haskell code +------------------------------------------------------------------------------- + +-- note: this function produces strings, which are passed to showTokens which +-- preserves layout. +-- note: this may not be that important for ocaml code in comparison to Haskell +SEM HsTokens [ || tks : {[(Pos,String)]} ] + | Cons lhs.tks = @hd.tok : @tl.tks + | Nil lhs.tks = [] + +SEM HsToken + | AGLocal loc.tok = (@pos,fieldname @var) + +SEM HsToken [ || tok:{(Pos,String)}] + | AGField + loc.addTrace = case @rdesc of + Just d -> \x -> "(prerr_endline " ++ show (d ++ " -> " ++ show @field ++ "." ++ show @attr) ++ "; " ++ x ++ ")" + Nothing -> id + lhs.tok = (@pos, @loc.addTrace $ attrname @lhs.options True @field @attr) + + | HsToken lhs.tok = (@pos, @value) + + | CharToken lhs.tok = (@pos, if null @value + then "" + else showCharShort (head @value) + ) + + | StrToken lhs.tok = (@pos, showStrShort @value) + | Err lhs.tok = (@pos, "") + +-- +-- Distribute single-visit-next map downward +-- + +ATTR EProductions EProduction Visits Visit + [ prevVisits, nextVisits : {Map StateIdentifier StateCtx} | | ] + +SEM ENonterminal | ENonterminal + prods.nextVisits = @nextVisits + prods.prevVisits = @prevVisits + +-- +-- Collect and distribute the from/to states of a visit +-- + +ATTR ENonterminals ENonterminal EProductions EProduction Visits Visit + [ | | fromToStates USE {`mappend`} {mempty} : {Map VisitIdentifier (Int,Int)} ] + +ATTR ENonterminals ENonterminal EProductions EProduction Visits Visit VisitSteps VisitStep + [ allFromToStates : {Map VisitIdentifier (Int,Int)} | | ] + +SEM Visit | Visit + lhs.fromToStates = Map.singleton @ident (@from, @to) + +SEM ExecutionPlan | ExecutionPlan + nonts.allFromToStates = @nonts.fromToStates + +SEM VisitStep | ChildVisit + (loc.from, loc.to) = Map.findWithDefault (error "visit not in allFromToStates") @visit @lhs.allFromToStates + + +-- +-- Collect and distribute the actual types of children of productions +-- + +ATTR EChildren EChild [ | | childTypes USE {`mappend`} {mempty} : {Map Identifier Type} ] +ATTR ERules ERule Visits Visit VisitSteps VisitStep [ childTypes : {Map Identifier Type} | | ] + +SEM EProduction | EProduction + loc.childTypes = Map.singleton _LHS @lhs.ntType `Map.union` @children.childTypes + +SEM EChild | EChild ETerm + lhs.childTypes = Map.singleton @name @tp + +-- +-- Distribute types of local attributes +-- + +ATTR ExecutionPlan ENonterminals ENonterminal [ localAttrTypes : {Map NontermIdent (Map ConstructorIdent (Map Identifier Type))} | | ] +ATTR EProductions EProduction [ localAttrTypes : {Map ConstructorIdent (Map Identifier Type)} | | ] +ATTR ERules ERule Pattern Patterns [ localAttrTypes : {Map Identifier Type} | | ] + +SEM ENonterminal | ENonterminal + prods.localAttrTypes = Map.findWithDefault Map.empty @nt @lhs.localAttrTypes + +SEM EProduction | EProduction + loc.localAttrTypes = Map.findWithDefault Map.empty @con @lhs.localAttrTypes + +-- +-- Collect and distribute visit kinds +-- + +ATTR ENonterminals ENonterminal EProductions EProduction Visits Visit VisitSteps VisitStep + [ allVisitKinds : {Map VisitIdentifier VisitKind} | | visitKinds USE {`mappend`} {mempty} : {Map VisitIdentifier VisitKind} ] + +SEM Visit | Visit + lhs.visitKinds = Map.singleton @ident @kind + +SEM ExecutionPlan | ExecutionPlan + nonts.allVisitKinds = @nonts.visitKinds + +-- +-- Collect and distribute the initial state of nonterminals +-- + +ATTR ENonterminals ENonterminal [ | | initStates USE {`mappend`} {mempty} : {Map NontermIdent Int} ] +ATTR ENonterminals ENonterminal EProductions EProduction EChildren EChild Visits Visit VisitSteps VisitStep + [ allInitStates : {Map NontermIdent Int} | | ] + +SEM ENonterminal | ENonterminal + lhs.initStates = Map.singleton @nt @initial + +SEM ExecutionPlan | ExecutionPlan + nonts.allInitStates = @nonts.initStates + +SEM EChild | EChild + loc.initSt = Map.findWithDefault (error "nonterminal not in allInitStates map") @loc.nt @lhs.allInitStates + +-- +-- Push the nonterminal type downward +-- + +ATTR EProductions EProduction [ ntType : Type | | ] +SEM ENonterminal | ENonterminal + loc.ntType = NT @nt (map show @params) False + +-- +-- Collect errors contained in rules that should be yielded when the +-- rules are scheduled. +-- + +ATTR ExecutionPlan ENonterminals ENonterminal EProductions EProduction ERules ERule Visits Visit VisitSteps VisitStep [ | | errors USE {Seq.><} {Seq.empty} : {Seq Error} ] +SEM ERule | ERule + lhs.errors = case @mbError of + Just e | @loc.used > 0 -> Seq.singleton e + _ -> Seq.empty
+ src-ag/ExecutionPlan2Clean.ag view
@@ -0,0 +1,1684 @@+INCLUDE "ExecutionPlan.ag" +INCLUDE "Patterns.ag" +INCLUDE "Expression.ag" +INCLUDE "HsToken.ag" + +imports +{ +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) +} + +ATTR ExecutionPlan ENonterminals ENonterminal EProductions EProduction ERules ERule EChildren EChild + [ importBlocks : PP_Doc + textBlocks : PP_Doc + iclModuleHeader : {String -> String -> String -> Bool -> String} + dclModuleHeader : {String -> String -> String -> Bool -> String} + mainFile : String + mainName : String + constructorTypeMap : {Map NontermIdent ConstructorType} | | ] + +------------------------------------------------------------------------------- +-- Options +------------------------------------------------------------------------------- +ATTR ExecutionPlan + ENonterminals ENonterminal + EProductions EProduction + ERules ERule + EChildren EChild + Expression + HsToken HsTokens HsTokensRoot + Pattern Patterns + Visits Visit + VisitSteps VisitStep [ options : {Options} | | ] +ATTR EProductions EProduction [ rename : {Bool} | | ] + +SEM ENonterminal + | ENonterminal prods.rename = rename @lhs.options + +------------------------------------------------------------------------------- +-- Context info (nonterminal ident, constructor ident, nonterm params, etc.) +------------------------------------------------------------------------------- + +ATTR Visit Visits EProduction EProductions EChildren EChild ERules ERule [ nt : NontermIdent | | ] +SEM ENonterminal + | ENonterminal prods.nt = @nt + +ATTR EChildren EChild ERules ERule Visits Visit + [ con : ConstructorIdent | | ] + +SEM EProduction + | EProduction children.con = @con + rules.con = @con + visits.con = @con + +ATTR EProductions EProduction Visits Visit [ params : {[Identifier]} | | ] +SEM ENonterminal | ENonterminal + prods.params = @params + +ATTR EProductions EProduction [ classCtxs : ClassContext | | ] +SEM ENonterminal | ENonterminal + prods.classCtxs = @classCtxs + +------------------------------------------------------------------------------- +-- Default output +------------------------------------------------------------------------------- +ATTR ExecutionPlan [ | | output : {PP_Doc} + output_dcl : {PP_Doc} ] + +SEM ExecutionPlan + | ExecutionPlan lhs.output = @nonts.output >-< @loc.commonExtra >-< @loc.wrappersExtra + lhs.output_dcl = @nonts.output_dcl + +ATTR ENonterminal ENonterminals [ wrappers : {Set NontermIdent} + | | output USE {>-<} {empty} : {PP_Doc} + output_dcl USE {>-<} {empty} : {PP_Doc}] + +SEM ExecutionPlan + | ExecutionPlan nonts.wrappers = @wrappers + +SEM ENonterminal + | ENonterminal lhs.output = ("// " ++ getName @nt ++ " " ++ replicate (60 - length (getName @nt)) '-') + >-< (if @loc.hasWrapper + then "// wrapper" + >-< @loc.wr_inh_icl + >-< @loc.wr_syn_icl + >-< @loc.wrapper_icl + >-< "" + else empty) + >-< (if folds @lhs.options + then "// cata" + >-< @loc.sem_nt + >-< "" + else empty) + >-< (if semfuns @lhs.options + then "// semantic domain" + >-< @loc.t_init_icl + >-< @loc.t_states_icl + >-< @loc.k_states + >-< @prods.sem_prod + >-< "" + else empty) + loc.hasWrapper = @nt `Set.member` @lhs.wrappers + + lhs.output_dcl = ("// " ++ getName @nt ++ " " ++ replicate (60 - length (getName @nt)) '-') + >-< (if dataTypes @lhs.options + then "// data" + >-< @loc.datatype + >-< "" + else empty) + >-< (if @loc.hasWrapper + then "// wrapper" + >-< @loc.wr_inh_dcl + >-< @loc.wr_syn_dcl + >-< @loc.wrapper_dcl + >-< "" + else empty) + >-< (if folds @lhs.options + then "// cata" + >-< @loc.semname >#< "::" >#< @loc.sem_tp + >-< "" + else empty) + >-< (if semfuns @lhs.options + then "// semantic domain" + >-< @loc.t_init_dcl + >-< @loc.t_states_dcl + >-< @prods.t_visits + >-< @prods.sem_prod_tys + >-< "" + else empty) + +------------------------------------------------------------------------------- +-- Nonterminal datatype +------------------------------------------------------------------------------- +ATTR ENonterminal ENonterminals [ typeSyns : {TypeSyns} + derivings : {Derivings} | | ] + +SEM ExecutionPlan + | ExecutionPlan nonts.typeSyns = @typeSyns + nonts.derivings = @derivings + +SEM ENonterminal + | ENonterminal loc.classPP = ppClasses $ classCtxsToDocs @classCtxs + loc.aliasPre = "::" >#< @loc.classPP >#< @nt >#< @loc.t_params >#< ":==" + loc.datatype = case lookup @nt @lhs.typeSyns of + Nothing -> "::" >#< @loc.classPP >#< @nt >#< @loc.t_params + >-< ( if null @prods.datatype + then empty + else if isRecordConstructor @nt @lhs.constructorTypeMap + then indent 2 $ "=" >#< @prods.recordtype + else indent 2 $ vlist $ ( ("=" >#< head @prods.datatype) + : (map ("|" >#<) $ tail @prods.datatype)) + ) + >-< indent 2 @loc.derivings + Just (List t) -> @loc.aliasPre >#< "[" >#< show t >#< "]" + Just (Maybe t) -> @loc.aliasPre >#< "Data.Maybe" >#< pp_parens (show t) + Just (Tuple ts) -> @loc.aliasPre >#< pp_parens (ppCommas $ map (show . snd) ts) + Just (Either l r) -> @loc.aliasPre >#< "Data.Either" >#< pp_parens (show l) >#< pp_parens (show r) + Just (Map k v) -> @loc.aliasPre >#< "Data.Map" >#< pp_parens (show k) >#< pp_parens (show v) + Just (IntMap t) -> @loc.aliasPre >#< "Data.IntMap.IntMap" >#< pp_parens (show t) + Just (OrdSet t) -> @loc.aliasPre >#< "Data.Set.Set" >#< pp_parens (show t) + Just IntSet -> @loc.aliasPre >#< "Data.IntSet.IntSet" +-- Just x -> error $ "Type " ++ show x ++ " is not supported" + loc.derivings = case Map.lookup @nt @lhs.derivings of + Nothing -> empty + Just s -> if Set.null s + then empty + else "deriving" >#< (pp_parens $ ppCommas $ map pp $ Set.toList s) + +{ +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 >#< ":" +} + +ATTR EProduction [ | | datatype : {PP_Doc} + recordtype : {PP_Doc} ] +ATTR EProductions [ | | datatype USE {:} {[]} : {[PP_Doc]} + recordtype : {PP_Doc} ] + +-- we generate the data type in the type-class style instead of the GADT style +-- the GADT extension may be required if equality constraints are used +SEM EProduction + | EProduction lhs.datatype = @loc.quantPP1 >#< @loc.classPP1 + >#< conname @lhs.rename @lhs.nt @con + >#< ppConFields (dataRecords @lhs.options) @children.datatype + lhs.recordtype = @loc.quantPP1 >#< @loc.classPP1 + >#< ppConFields True @children.recordtype + loc.classPP1 = ppClasses (classConstrsToDocs @constraints) + loc.quantPP1 = ppQuants @params + +SEM EProductions + | Cons lhs.recordtype = @hd.recordtype + | Nil lhs.recordtype = empty + +{ +-- first parameter indicates: generate a record or not +ppConFields :: Bool -> [PP_Doc] -> PP_Doc +ppConFields True flds = ppListSep "{" "}" ", " flds +ppConFields False flds = ppSpaced flds +} + + +ATTR EChild [ | | datatype : {PP_Doc} + recordtype : {PP_Doc} ] +ATTR EChildren [ | | datatype USE {:} {[]} : {[PP_Doc]} + recordtype USE {:} {[]} : {[PP_Doc]} ] + +-- Note: the child may be a higher-order attribute, and its semantics may be deforested +SEM EChild + | EChild ETerm + loc.tpDoc = @loc.addStrict $ pp_parens $ ppTp $ removeDeforested @tp + loc.strNm = recordFieldname @lhs.nt @lhs.con @name + loc.field = if dataRecords @lhs.options + then @loc.strNm >#< "::" >#< @loc.tpDoc + else @loc.tpDoc + loc.recordfield = @loc.strNm >#< "::" >#< @loc.tpDoc + loc.addStrict = \x -> if strictData @lhs.options then "!" >|< x else x + | EChild lhs.datatype = case @kind of + ChildAttr -> empty -- higher order attributes are not part of the data type + _ -> @loc.field + + lhs.recordtype = case @kind of + ChildAttr -> empty -- higher order attributes are not part of the data type + _ -> @loc.recordfield + | ETerm lhs.datatype = @loc.field + lhs.recordtype = @loc.recordfield + +{ +ppTp :: Type -> PP_Doc +ppTp = text . typeToHaskellString Nothing [] +} + +------------------------------------------------------------------------------- +-- Nonterminal semantic function +------------------------------------------------------------------------------- +SEM ENonterminal + | ENonterminal loc.fsemname = \x -> "sem_" ++ show x + loc.semname = @loc.fsemname @nt + loc.frecarg = \t x -> case t of + NT nt _ _ -> pp_parens (@fsemname nt >#< x) + _ -> pp x + + -- The sem_NT function is lazy in the AST: it depends on the application of "child" + -- rules to which extend the AST needs to be constructed. + loc.sem_tp = @loc.quantPP >#< @loc.classPP >#< @nt >#< @loc.t_params >#< "->" >#< @loc.t_type >#< @loc.t_params + loc.quantPP = ppQuants @params + + loc.sem_nt = @loc.semname >#< "::" >#< @loc.sem_tp + >-< case lookup @nt @lhs.typeSyns of + Nothing -> @prods.sem_nt + Just (List t) -> @loc.semname >#< "list" >#< "=" >#< "foldr" >#< @loc.semname >|< "_Cons" + >#< @loc.semname >|< "_Nil" + >#< case t of + NT nt _ _ -> pp_parens ("map" >#< @fsemname nt >#< "list") + _ -> pp "list" + Just (Maybe t) -> @loc.semname >#< "'Data.Maybe'.Nothing" >#< "=" >#< @loc.semname >|< "_Nothing" + >-< @loc.semname >#< pp_parens ("'Data.Maybe'.Just just") >#< "=" + >#< @loc.semname >|< "_Just" >#< @frecarg t "just" + Just (Tuple ts) -> @loc.semname >#< pp_parens (ppCommas $ map fst ts) >#< "=" + >#< @loc.semname >|< "_Tuple" >#< ppSpaced (map (\t -> @frecarg (snd t) (show $ fst t)) ts) + Just (Either l r) -> @loc.semname >#< "('Data.Either'.Left left)" >#< "=" >#< @loc.semname >|< "_Left" >#< @frecarg l "left" + >-< @loc.semname >#< "('Data.Either'.Right right)" >#< "=" >#< @loc.semname >|< "_Right" >#< @frecarg r "right" + Just (Map k v) -> @loc.semname >#< "m" >#< "=" >#< "'Data.Map'.foldrWithKey" + >#< @loc.semname >|< "_Entry" >#< @loc.semname >|< "_Nil" + >#< case v of + NT nt _ _ -> pp_parens ("'Data.Map'.map" >#< @fsemname nt >#< "m") + _ -> pp "m" + Just (IntMap v) -> @loc.semname >#< "m" >#< "=" >#< "'Data.IntMap'.foldWithKey" + >#< @loc.semname >|< "_Entry" >#< @loc.semname >|< "_Nil" + >#< case v of + NT nt _ _ -> pp_parens ("'Data.IntMap'.map" >#< @fsemname nt >#< "m") + _ -> pp "m" + Just (OrdSet t) -> @loc.semname >#< "s" >#< "=" >#< "foldr" >#< @loc.semname >|< "_Entry" + >#< @loc.semname >|< "_Nil" + >#< pp_parens ( + ( case t of + NT nt _ _ -> pp_parens ("map" >#< @fsemname nt) + _ -> empty + ) >#< pp_parens ("'Data.IntSet'.elems" >#< "s") + ) + Just IntSet -> @loc.semname >#< "s" >#< "=" >#< "foldr" >#< @loc.semname >|< "_Entry" + >#< @loc.semname >|< "_Nil" + >#< pp_parens ("'Data.IntSet'.elems" >#< "s") +-- Just x -> error $ "Type " ++ show x ++ " is not supported yet" -- TODO: other typeSyns + +-- The number of productions +ATTR EProductions EProduction [ | | count USE {+} {0} : {Int} ] +SEM EProduction | EProduction lhs.count = {1} + +-- The per-production cases for the sem_NT function +ATTR EProduction EProductions [ | | sem_nt USE {>-<} {empty} : {PP_Doc} ] +SEM EProduction + | EProduction lhs.sem_nt = let lhs = "sem_" >|< @lhs.nt + rhs = "=" >#< "sem_" >|< @lhs.nt >|< "_" >|< @con >#< ppSpaced @children.argnamesw + cnnm = conname @lhs.rename @lhs.nt @con + in if isRecordConstructor @lhs.nt @lhs.constructorTypeMap + then lhs >#< "{" >#< cnnm >#< "|" >#< + pp_block "" "" "," (zipWith (\l r -> l >#< "=" >#< r) @children.recfields @children.argpats) >#< "}" >#< rhs + else lhs >#< "(" >#< cnnm >#< ppSpaced @children.argpats >#< ")" >#< rhs + +{ +isRecordConstructor :: NontermIdent -> Map NontermIdent ConstructorType -> Bool +isRecordConstructor nt ctm = Map.lookup nt ctm == Just RecordConstructor +} + +ATTR EChild [ | | argnamesw : { PP_Doc } ] +ATTR EChildren [ | | argnamesw USE {:} {[]} : {[PP_Doc]} ] + +SEM EChild + | EChild lhs.argnamesw = case @kind of + ChildSyntax -> "(" >#< "sem_" >|< @loc.nt >#< @name >|< "_" >#< ")" + ChildAttr -> empty -- no sem-case for a higher-order child + ChildReplace tp -> "(" >#< "sem_" >|< extractNonterminal tp >#< @name >|< "_" >#< ")" + | ETerm lhs.argnamesw = text $ fieldname @name + +------------------------------------------------------------------------------- +-- Types of attributes +------------------------------------------------------------------------------- +ATTR ExecutionPlan + ENonterminals + ENonterminal [ inhmap : {Map NontermIdent Attributes} + synmap : {Map NontermIdent Attributes} | | ] + +ATTR EProductions EProduction + ERules ERule + Patterns Pattern + Visits + Visit [ inhmap : {Attributes} + synmap : {Attributes} + allInhmap : {Map NontermIdent Attributes} + allSynmap : {Map NontermIdent Attributes} | | ] + +SEM ENonterminal + | ENonterminal (Just prods.inhmap) = Map.lookup @nt @lhs.inhmap + (Just prods.synmap) = Map.lookup @nt @lhs.synmap + prods.allInhmap = @lhs.inhmap + prods.allSynmap = @lhs.synmap + +------------------------------------------------------------------------------- +-- State datatypes +------------------------------------------------------------------------------- +{type VisitStateState = (VisitIdentifier,StateIdentifier, StateIdentifier)} + +ATTR Visit [ | | allvisits : { VisitStateState }] +ATTR Visits [ | | allvisits USE {:} {[]} : {[VisitStateState]}] +ATTR EProduction + EProductions [ | | allvisits: {[VisitStateState]}] + +SEM Visit + | Visit lhs.allvisits = (@ident, @from, @to) + +SEM EProductions + | Cons lhs.allvisits = @hd.allvisits -- just pick the first production + | Nil lhs.allvisits = error "Every nonterminal should have at least 1 production" + +-- type of tree in a given state s +SEM ENonterminal + | ENonterminal loc.outedges = Set.fromList $ map (\(_,f,_) -> f) @prods.allvisits + loc.inedges = Set.fromList $ map (\(_,_,t) -> t) @prods.allvisits + loc.allstates = Set.insert @initial $ @loc.inedges `Set.union` @loc.outedges + loc.stvisits = \st -> filter (\(v,f,t) -> f == st) @prods.allvisits + loc.t_type = "T_" >|< @nt + loc.lt_type = "t_" >|< @nt + loc.t_params = ppSpaced @params + loc.t_init_icl = @loc.t_init_dcl >-< + "attach_" >|< @loc.t_type >#< pp_parens (@loc.t_type >#< @loc.lt_type) >#< "=" >#< @loc.lt_type + loc.t_init_dcl = "::" >#< @loc.t_type >#< @loc.t_params >#< "=" >#< @loc.t_type + >#< + pp_parens ( + ppMonadType @lhs.options >#< pp_parens (@loc.t_type >|< "_s" >|< @initial >#< @loc.t_params)) + loc.t_states_icl = 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 -- empty semantics + OneVis vId -> inv_st >#< pp_parens (c_st >#< "x") >#< "=" >#< "x" + ManyVis -> empty + ) $ Set.toList @loc.allstates + loc.t_states_dcl = 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 >#< @loc.t_params >#< "=" >#< c_st -- empty semantics + OneVis vId -> "::" >#< t_st >#< @loc.t_params >#< "=" >#< c_st >#< (pp_parens (conNmTVisit @nt vId >#< @loc.t_params)) + ManyVis -> "::" >#< t_st >#< @loc.t_params >#< "where" >#< c_st >#< "::" -- TODO : Cleanify + >#< (pp_braces $ inv_st >#< "::" >#< "!" >|< pp_parens ("E.t:" >#< k_st >#< @loc.t_params >#< "t" >#< "->" >#< "t")) + >#< "->" >#< t_st >#< @loc.t_params -- this is a conventional data type, but declared with GADT syntax + ) $ Set.toList @loc.allstates + +-- type of a key which identifies a visit v from state s +SEM ENonterminal + | ENonterminal loc.k_type = "K_" ++ show @nt + loc.k_states = vlist $ map (\st -> + let nt_st = @nt >|< "_s" >|< st + k_st = "K_" >|< nt_st + outg = filter (\(v,f,t) -> f == st) @prods.allvisits + visitlist = vlist $ map (\(v,f,t) -> + @loc.k_type >|< "_v" >|< v >#< "::" >#< k_st >#< @loc.t_params >#< pp_parens (@loc.t_type >|< "_v" >|< v >#< @loc.t_params) + ) outg + nextVisit = Map.findWithDefault ManyVis st @nextVisits + decl = "::" >#< k_st >#< "k" >#< @loc.t_params >#< "where" >-< indent 3 visitlist + in case nextVisit of + NoneVis -> empty + OneVis _ -> empty + ManyVis -> decl + ) $ Set.toList @loc.allstates + +-- type of a visit v, with continuation as new state s +ATTR Visit Visits EProduction EProductions [ | | t_visits USE {>-<} {empty} : {PP_Doc} ] + +SEM EProductions + | Cons lhs.t_visits = @hd.t_visits -- just pick the first production + +SEM Visit + | Visit loc.nameT_visit = conNmTVisit @lhs.nt @ident + loc.nameTIn_visit = conNmTVisitIn @lhs.nt @ident + loc.nameTOut_visit = conNmTVisitOut @lhs.nt @ident + loc.nameTNext_visit = conNmTNextVisit @lhs.nt @to + + loc.nextVisitInfo = Map.findWithDefault ManyVis @to @lhs.nextVisits -- which visits can we do after we reach the @to state? + loc.typecon = case @kind of + VisitPure _ -> empty + VisitMonadic -> ppMonadType @lhs.options + + loc.t_params = ppSpaced @lhs.params + lhs.t_visits = "::" >#< @loc.nameT_visit >#< @loc.t_params >#< ":==" >#< + pp_parens (@loc.nameTIn_visit >#< @loc.t_params) + >#< ( if dummyTokenVisit @lhs.options + then "->" >#< dummyType @lhs.options True -- Additional (unused though) argument + else empty + ) + >#< "->" >#< @loc.typecon >#< pp_parens (@loc.nameTOut_visit >#< @loc.t_params) + >-< "::" >#< @loc.nameTIn_visit >#< @loc.t_params >#< "=" >#< @loc.nameTIn_visit >#< + @loc.inhpart + >-< "::" >#< @loc.nameTOut_visit >#< @loc.t_params >#< "=" >#< @loc.nameTOut_visit >#< + @loc.synpart >#< case @loc.nextVisitInfo of + NoneVis -> empty -- don't return a continuation at all + _ -> @loc.addbang1 $ pp_parens (@loc.nameTNext_visit >#< @loc.t_params) -- normal route: select the next semantics + + loc.inhpart = @loc.ppTypeList @inh @lhs.inhmap + loc.synpart = @loc.ppTypeList @syn @lhs.synmap + loc.ppTypeList = \s m -> ppSpaced $ map (\i -> @loc.addbang1 $ pp_parens $ case Map.lookup i m of + Just tp -> ppTp tp ) $ Set.toList s + +{ +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" +} + +------------------------------------------------------------------------------- +-- Inh and Syn wrappers +------------------------------------------------------------------------------- +SEM ENonterminal + | ENonterminal loc.wr_inh_icl = @loc.genwrap_icl "Inh" @loc.wr_inhs + loc.wr_syn_icl = @loc.genwrap_icl "Syn" @loc.wr_syns + loc.genwrap_icl = \nm attr -> + let tyConName = nm >|< "_" >|< @nt + in (let (d, _, _) = foldr (\(i, t) (d, c, n) -> (d >-< + i >|< "_" >|< tyConName >#< "::" >#< tyConName >#< "->" >#< (@loc.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) + loc.wr_inh_dcl = @loc.genwrap_dcl "Inh" @loc.wr_inhs + loc.wr_syn_dcl = @loc.genwrap_dcl "Syn" @loc.wr_syns + loc.genwrap_dcl = \nm attr -> + let tyConName = nm >|< "_" >|< @nt + in "::" >#< tyConName >#< @loc.t_params >#< "=" >#< tyConName -- >#< "{" + >#< (ppSpaced $ map (\(_,t) -> @loc.addbang $ pp_parens $ typeToHaskellString (Just @nt) [] t) attr) -- >#< "}" + >-< + (let (d, _, _) = foldr (\(i, t) (d, c, n) -> (d >-< + i >|< "_" >|< tyConName >#< "::" >#< tyConName >#< "->" >#< (@loc.addbang $ pp_parens $ typeToHaskellString (Just @nt) [] t) + , c + 1, n) + ) (empty, 0, length attr) attr + in d) + loc.synAttrs = fromJust $ Map.lookup @nt @lhs.inhmap + loc.wr_inhs = Map.toList $ @loc.wr_filter $ @loc.synAttrs + loc.wr_inhs1 = Map.toList @loc.synAttrs + loc.wr_filter = if lateHigherOrderBinding @lhs.options + then Map.delete idLateBindingAttr + else id + loc.wr_syns = Map.toList $ fromJust $ Map.lookup @nt @lhs.synmap + loc.inhlist = map (lhsname @lhs.options True . fst) @loc.wr_inhs + loc.inhlist1 = map (lhsname @lhs.options True . fst) @loc.wr_inhs1 + loc.synlist = map (lhsname @lhs.options False . fst) @loc.wr_syns + loc.wrapname = "wrap_" ++ show @nt + loc.inhname = "Inh_" ++ show @nt + loc.synname = "Syn_" ++ show @nt + loc.firstVisitInfo = Map.findWithDefault ManyVis @initial @nextVisits + loc.wrapper_icl = (@loc.wrapname >#< "::" >#< @loc.quantPP >#< @loc.classPP >#< @loc.t_type >#< @loc.t_params -- TODO : Remove ? >#< "->" + >#< @loc.inhname >#< @loc.t_params >#< "->" >#< ( if monadicWrappers @lhs.options then ppMonadType @lhs.options else empty) >#< pp_parens (@loc.synname >#< @loc.t_params)) + >-< (@loc.wrapname >#< (@loc.addbang $ pp_parens (@loc.t_type >#< pp "act")) + >#< (@loc.addbang $ pp_parens (@loc.inhname + >#< (ppSpaced $ map (@loc.addbangWrap . pp) @loc.inhlist)) >#< "=")) + >-< + indent 3 (case @initialv of + -- case where there are no inherited or synthesized attributes + [] -> text @loc.synname -- TODO : Remove? >#< " { }" + (initv:_) -> -- TODO: take care of multiple visits + let inCon = conNmTVisitIn @nt initv + outCon = conNmTVisitOut @nt initv + pat = @loc.addbang $ pp_parens $ pat0 + pat0 = outCon >#< ppSpaced @loc.synlist -- should be an "end" state, thus no continuation expected here + arg = inCon >#< ppSpaced @loc.inhlist1 + ind = case @loc.firstVisitInfo of + NoneVis -> error "wrapper: initial state should have a next visit but it has none" + OneVis _ -> empty + ManyVis -> @loc.k_type >|< "_v" >|< initv + extra = if dummyTokenVisit @lhs.options + then pp $ dummyArg @lhs.options True + else empty + convert = case Map.lookup initv @lhs.allVisitKinds of + Just kind -> case kind of + VisitPure _ -> text "lift" + VisitMonadic -> empty + _ -> empty + unMonad | monadicWrappers @lhs.options = empty + | otherwise = unMon @lhs.options + in unMonad >#< "(" + >-< indent 2 + ("act >>= \\" >#< @loc.addbang (pp "sem") >#< "->" -- run the per-node monadic code to get the initial state (of the root) + >-< "lift" >#< pp_parens arg >#< ">>= \\" >#< @loc.addbangWrap (pp "arg") >#< "->" + >-< convert >#< pp_parens ("inv_" >|< @nt >|< "_s" >|< @initial >#< "sem" >#< ind >#< "arg" >#< extra) >#< ">>= \\" >#< pat >#< "->" -- invoke initial state (of the root) + >-< "lift" >#< pp_parens (@loc.synname >#< ppSpaced @loc.synlist) + ) + >-< ")" ) + >-< if lateHigherOrderBinding @lhs.options + then indent 2 ("where" >#< lhsname @lhs.options True idLateBindingAttr >#< "=" >#< lateBindingFieldNm @lhs.mainName) + else empty + loc.wrapper_dcl = (@loc.wrapname >#< "::" >#< @loc.quantPP >#< @loc.classPP >#< @loc.t_type >#< @loc.t_params -- TODO : Remove ? >#< "->" + >#< @loc.inhname >#< @loc.t_params >#< "->" >#< ( if monadicWrappers @lhs.options then ppMonadType @lhs.options else empty) >#< pp_parens (@loc.synname >#< @loc.t_params)) + +------------------------------------------------------------------------------- +-- Collection of NT / Production sem funs references +------------------------------------------------------------------------------- + +ATTR ENonterminals ENonterminal EProductions EProduction [ | | semFunBndDefs, semFunBndTps USE {Seq.><} {Seq.empty} : {Seq PP_Doc} ] +SEM ENonterminal | ENonterminal + lhs.semFunBndDefs = @loc.semFunBndDef Seq.<| @prods.semFunBndDefs + lhs.semFunBndTps = @loc.semFunBndTp Seq.<| @prods.semFunBndTps + loc.semFunBndDef = @loc.semFunBndNm >#< "=" >#< @loc.semname + loc.semFunBndTp = @loc.semFunBndNm >#< "::" >#< @loc.sem_tp + loc.semFunBndNm = lateSemNtLabel @nt + +SEM EProduction | EProduction + lhs.semFunBndDefs = Seq.singleton @loc.semFunBndDef + lhs.semFunBndTps = Seq.singleton @loc.semFunBndTp + loc.semFunBndDef = @loc.semFunBndNm >#< "=" >#< @loc.semname + loc.semFunBndTp = @loc.semFunBndNm >#< "::" >#< @loc.sem_tp + loc.semFunBndNm = lateSemConLabel @lhs.nt @con + +-- Generate a dictionary that contains the semantics of all semantic functions +SEM ExecutionPlan | ExecutionPlan + loc.wrappersExtra = if lateHigherOrderBinding @lhs.options + then @loc.lateSemBndDef + else empty + loc.commonExtra = if lateHigherOrderBinding @lhs.options + then @loc.lateSemBndTp + else empty + loc.lateSemBndTp = "::" >#< lateBindingTypeNm @lhs.mainName >#< "=" >#< lateBindingTypeNm @lhs.mainName + >-< (indent 2 $ pp_block "{" "}" "," $ toList @nonts.semFunBndTps) + loc.lateSemBndDef = lateBindingFieldNm @lhs.mainName >#< "::" >#< lateBindingTypeNm @lhs.mainName + >-< lateBindingFieldNm @lhs.mainName >#< "=" >#< lateBindingTypeNm @lhs.mainName + >-< (indent 2 $ pp_block "{" "}" "," $ toList @nonts.semFunBndDefs ) + +------------------------------------------------------------------------------- +-- Production semantic functions +------------------------------------------------------------------------------- +ATTR EProduction [ | | sem_prod : {PP_Doc} + sem_prod_tys : {PP_Doc} ] +ATTR EProductions [ | | sem_prod USE {>-<} {empty} : {PP_Doc} + sem_prod_tys USE {>-<} {empty} : {PP_Doc} ] + +ATTR EProduction EProductions [ initial : {StateIdentifier} + allstates : {Set StateIdentifier} | | ] +SEM ENonterminal + | ENonterminal prods.initial = @initial + prods.allstates = @loc.allstates + +ATTR EChild [ | | argtps : { PP_Doc } + argpats : { PP_Doc } + recfields USE {++} {[]} : { [Identifier] }] +ATTR EChildren [ | | argtps USE {:} {[]} : { [PP_Doc] } + argpats USE {:} {[]} : { [PP_Doc] } + recfields USE {++} {[]} : { [Identifier] }] + +SEM EChild + | EChild lhs.argtps = case @kind of + ChildSyntax -> pp_parens $ ppDefor @tp -- TODO Remove? >#< "->" + ChildReplace tp -> pp_parens $ ppDefor tp -- TODO Remove? >#< "->" + _ -> empty -- higher order attribute + loc.argpats = case @kind of + ChildSyntax -> @name >|< "_" -- no strictification of children semantics to allow infinite trees + ChildReplace _ -> @name >|< "_" + _ -> empty + + lhs.recfields = case @kind of + ChildSyntax -> [@name] -- no strictification of children semantics to allow infinite trees + ChildReplace _ -> [@name] + _ -> [] + + -- | ETerm lhs.argtps = (pp_parens $ show @tp) >#< "572->" -- TODO Remove? + | ETerm lhs.argtps = pp_parens $ show @tp + loc.argpats = @loc.addbang $ text $ fieldname @name -- terminals may be strict (perhaps this should become an option) + lhs.recfields = [@name] + +{ +ppDefor :: Type -> PP_Doc +ppDefor (NT nt args _) = "T_" >|< nt >#< ppSpaced (map pp_parens args) +ppDefor (Haskell s) = text s +} + +SEM EProduction + | EProduction loc.t_type = "T_" >|< @lhs.nt + loc.t_params = ppSpaced @lhs.params + loc.usedArgs = @children.usedArgs `Set.union` @visits.usedArgs `Set.union` @rules.usedArgs + -- A bit ugly, but this code renames arguments and puts an underscore when the argument + -- is never used. This avoids compiler warnings of unused variables. + loc.args = 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` @loc.usedArgs + then arg + else text "_") @children.argpats + loc.semname = "sem_" ++ show @lhs.nt ++ "_" ++ show @con + loc.sem_tp = @loc.quantPP2 >#< @loc.classPP2 >#< ppSpaced @children.argtps + >#< (if length @children.argtps > 0 then "->" else "") + >#< @loc.t_type >#< @loc.t_params -- TODO Keep -> here? + loc.classPP2 = ppClasses (classCtxsToDocs @lhs.classCtxs ++ classConstrsToDocs @constraints) + loc.quantPP2 = ppQuants (@lhs.params ++ @params) + + lhs.sem_prod_tys = @loc.semname >#< " ::" >#< @loc.sem_tp + + loc.sem_prod = @loc.semname >#< " ::" >#< @loc.sem_tp + >-< @loc.mkSemBody (@loc.semname >#< ppSpaced @loc.args >#< "=" >#< @loc.t_type) + @loc.mbInitializer @loc.outerlet ("lift" >#< "st" >|< @lhs.initial) + loc.mkSemBody = \prefix mbInit outerlet ret -> + case mbInit of + Nothing -> prefix >#< pp_parens ret >#< "where" + >-< indent 3 outerlet -- code for states and visits + Just m -> prefix >#< "(" >#< "do" -- TODO: desugar + >-< indent 1 ( + m + >-< "let" + >-< indent 2 outerlet -- code for the states and visits + >-< ret ) + >-< indent 1 ")" + + loc.mbInitializer = --some monadic actions, performed upon attaching a child, can + -- be specified here. The resulting bindings of these actions are + -- in scope of the rules of the production + if parallelInvoke @lhs.options + then (Nothing :: Maybe PP_Doc) -- perhaps do some per-node registation, etc. For now: nothing + else Nothing -- nothing special here + loc.outerlet = vlist @loc.statefns >-< @rules.sem_rules + loc.statefns = map @loc.genstfn $ Set.toList @lhs.allstates + loc.genstfn = \st -> let nextVisitInfo = Map.findWithDefault ManyVis st @lhs.nextVisits + prevVisitInfo = Map.findWithDefault ManyVis st @lhs.prevVisits + stNm = "st" >|< st + lhs = bang stNm >#< "=" >#< + ( -- generating a lambda for the same reasons as generating + -- a lambda for rules: to ensure that overloading is + -- resolved for all visit functions and rules together. + if st == @lhs.initial + then empty + else "\\" >#< @loc.stargs st >#< "->" + ) + + cCon = "C_" >|< @lhs.nt >|< "_s" >|< st + bang | st == @lhs.initial = @loc.addbang -- initial state is not parameterized + | otherwise = id + + -- note about the initial state: the initial state should be the only + -- state-binding that is not a function. It is non-recursive and not needed + -- anywhere except delivered as initial result. This binding therefore does + -- not end up needlessly in any closure. + in case nextVisitInfo of + NoneVis -> -- the (empty) closure of a (non-initial) end state is not referenced + -- thus generating it is not needed (and omitting it may catch some small mistakes). + if st == @lhs.initial + then lhs >#< cCon -- empty state + else empty -- no state generated + OneVis vId -> mklet lhs (@loc.stvs st False) (cCon >#< "v" >|< vId) + ManyVis -> mklet lhs (@loc.stks st >-< @loc.stvs st True) (cCon >#< "k" >|< st) + loc.stargs = \st -> let attrs = maybe Map.empty id $ Map.lookup st @visits.intramap + in ppSpaced [ let match | str `Set.member` @loc.lazyIntras = pp str + | otherwise = @loc.addbang (pp str) + in case mbAttr of + Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs @lhs.options) -> + case Map.lookup nm @loc.localAttrTypes of + Just tp -> pp_parens (pp_parens match >#< "::" >#< ppTp tp) + Nothing -> match + Just attr | not (noPerStateTypeSigs @lhs.options) -> + case lookupAttrType attr @lhs.allInhmap @lhs.allSynmap @loc.childTypes of + Just tpDoc -> pp_parens (pp_parens match >#< "::" >#< tpDoc) + Nothing -> match + _ -> match + | (str,mbAttr) <- Map.assocs attrs + ] >#< dummyPat @lhs.options (Map.null attrs) + + loc.stks = \st -> if null (@loc.stvisits st) + then empty + else "k" >|< st >#< "::" >#< "K_" >|< @lhs.nt >|< "_s" >|< st >#< @loc.t_params >#< "t" >#< "->" >#< "t" + >-< vlist (map (\(v,f,t) -> "k" >|< st >#< "K_" >|< @lhs.nt >|< "_v" >|< v >#< "=" + >#< "v" >|< v) $ @loc.stvisits st) + loc.stvisits = \st -> filter (\(v,f,t) -> f == st) @visits.allvisits + loc.stvs = \st inlinePragma -> vlist [ppf inlinePragma | (f,ppf) <- @visits.sem_visit, f == st] + visits.mrules = @rules.mrules + +{ +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) +} + +------------------------------------------------------------------------------- +-- Visit semantic functions +------------------------------------------------------------------------------- +ATTR Visit [ | | sem_visit : { (StateIdentifier,Bool -> PP_Doc) } ] +ATTR Visits [ | | sem_visit USE {:} {[]} : { [(StateIdentifier,Bool -> PP_Doc)] } ] + +SEM Visit + | Visit lhs.sem_visit = ( @from + , \_ -> + -- TODO: Generate type signature "v" >|< @ident >#< "::" >#< @loc.nameTIn_visit >#< "->" >#< @loc.nameT_visit >#< @loc.t_params >-< + + -- Haskell: generate a lambda here as well instead of a function definition + -- >-< "v" >|< @ident >#< "=" >#< "\\" >#< (@loc.addbang $ pp_parens (@loc.nameTIn_visit >#< @loc.inhpats)) + -- Clean: generate a function + "v" >|< @ident >#< (@loc.addbang $ pp_parens (@loc.nameTIn_visit >#< @loc.inhpats)) >#< "=" + >#< ( if dummyTokenVisit @lhs.options + then pp $ dummyPat @lhs.options True -- extra (but unused) argument + else empty + ) + -- >#< "->" + -- >#< "(" + >-< indent 10 (@loc.stepsInitial + >-< indent 4 @steps.sem_steps) >-< indent 10 @loc.stepsClosing + -- >#< ")" + ) + loc.stepsInitial = case @kind of + VisitPure False -> text "let" + VisitPure True -> empty + VisitMonadic -> text "do" + loc.stepsClosing = let decls = @loc.nextStBuild + >-< @loc.addbang (pp resultValName) >#< "=" >#< @loc.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 + loc.vname = "v" >|< @ident + loc.inhpats = ppSpaced $ map (\arg -> pp $ attrname @lhs.options True _LHS arg) $ Set.toList @inh + loc.inhargs = \chn -> ppSpaced $ map (attrname @lhs.options False chn) $ Set.toList @inh + loc.synargs = ppSpaced $ map (\arg -> attrname @lhs.options False _LHS arg) $ Set.toList @syn + loc.nextargsMp = maybe Map.empty id $ Map.lookup @to @lhs.allintramap + loc.nextargs = ppSpaced $ Map.keys $ @loc.nextargsMp + loc.nextst = "st" >|< @to >#< @loc.nextargs >#< dummyArg @lhs.options (Map.null @loc.nextargsMp) + loc.resultval = @loc.nameTOut_visit >#< @loc.synargs >#< @loc.nextStRef + (loc.nextStBuild, loc.nextStRef) + = case @loc.nextVisitInfo of + NoneVis -> (empty, empty) + _ -> (@loc.addbang (pp nextStName) >#< "=" >#< @loc.nextst, pp nextStName) + +{ +resultValName :: String +resultValName = "ag__result_" + +nextStName :: String +nextStName = "ag__st_" +} + +-- Propagate the visit kind to the steps +ATTR VisitStep VisitSteps [ kind : VisitKind | | ] +SEM Visit | Visit steps.kind = @kind + +-- the steps in this group should be executed in a pure fashion +SEM VisitStep | PureGroup + steps.kind = VisitPure @ordered + +ATTR Visits Visit VisitStep VisitSteps [ mrules : {Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)} | | ] +ATTR VisitStep VisitSteps [ | | sem_steps USE {>-<} {empty} : {PP_Doc} ] +SEM VisitStep + | Sem loc.ruleItf = Map.findWithDefault (error $ "Rule " ++ show @name ++ " not found") @name @lhs.mrules + (lhs.errors, loc.sem_steps) = case @loc.ruleItf @lhs.kind @lhs.fmtMode of + Left e -> (Seq.singleton e, empty) + Right stmt -> (Seq.empty, stmt) + | ChildIntro loc.attachItf = Map.findWithDefault (error $ "Child " ++ show @child ++ " not found") @child @lhs.childintros + (lhs.errors,lhs.sem_steps,lhs.defs,lhs.uses) + = case @loc.attachItf @lhs.kind @lhs.fmtMode of + Left e -> (Seq.singleton e, empty, Set.empty, Map.empty) + Right (code, defs, uses) -> (Seq.empty, code, defs, uses) + | ChildVisit loc.visitItf = Map.findWithDefault (error $ "Visit " ++ show @visit ++ " not found") @visit @lhs.allchildvisit + (lhs.errors, loc.patPP, loc.exprPP) = case @loc.visitItf @child @lhs.kind of + Left e -> (Seq.singleton e, empty, empty) + Right (pat,expr) -> (Seq.empty, pat, expr) + + lhs.sem_steps = let decl = case @lhs.kind of + VisitPure _ -> @loc.patPP >#< "=" >#< @loc.exprPP + VisitMonadic -> @loc.exprPP >#< ">>= \\" >#< @loc.patPP >#< "->" + in fmtDecl False @lhs.fmtMode decl + loc.convToMonad = case @loc.callKind of + VisitPure _ -> text "lift" + VisitMonadic -> empty + loc.callKind = Map.findWithDefault (error "visit kind should be in the map") @visit @lhs.allVisitKinds + | Sim lhs.sem_steps = @steps.sem_steps + | PureGroup lhs.sem_steps = case @lhs.fmtMode of + FormatDo -> "let" >#< @steps.sem_steps -- formatted as a let-block (not a line-let) + _ -> @steps.sem_steps + +-- The fmtMode indicates in what kind of expression (do/let/line-lets) we are printing +-- declarations, because that determines how we need to wrap declarations +-- Invariant: @lhs.kind == VisitMonadic ---> @lhs.fmtMode == FormatDo +ATTR VisitSteps VisitStep [ fmtMode : FormatMode | | ] +SEM Visit | Visit + steps.fmtMode = case @kind of + VisitPure False -> FormatLetDecl + VisitPure True -> FormatLetLine + VisitMonadic -> FormatDo + +SEM VisitStep | PureGroup + steps.fmtMode = case @lhs.fmtMode of + FormatDo -> FormatLetDecl + mode -> mode + +{ +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 +} + +-- +-- Some properties of VisitStep(s) +-- + +-- Used arguments +ATTR VisitSteps VisitStep Visit Visits EChild EChildren ERule ERules [ | | usedArgs USE {`Set.union`} {Set.empty} : {Set String} ] +SEM ERule + | ERule +usedArgs = Set.union $ Map.keysSet $ Map.mapKeys (\a -> "arg_" ++ a) $ Map.filter isNothing @rhs.attrs + +SEM EChild + | EChild +usedArgs = \s -> case @kind of + ChildSyntax -> Set.insert ("arg_" ++ show @name ++ "_") s + _ -> s + + +-- Number of steps in a 'Sim' block +ATTR VisitSteps [ | | size : Int ] +SEM VisitSteps + | Nil lhs.size = 0 + | Cons lhs.size = 1 + @tl.size + +-- Number the steps in a 'Sim' block +ATTR VisitSteps VisitStep [ | index : Int | ] +SEM VisitSteps | Cons + hd.index = @lhs.index -- copy rule + tl.index = 1 + @lhs.index + lhs.index = @tl.index -- copy rule +SEM Visit | Visit steps.index = 0 +SEM VisitStep | Sim steps.index = 0 + lhs.index = @lhs.index -- needed for if we ever allow nested Sims + +-- Is this the last step? +ATTR VisitSteps VisitStep [ | | isLast : Bool ] +ATTR VisitStep [ isLast : Bool | | ] +SEM VisitSteps + | Nil lhs.isLast = True + | Cons lhs.isLast = False + hd.isLast = @tl.isLast + +SEM VisitStep | Sim + loc.isMonadic = case @lhs.kind of + VisitMonadic -> True + _ -> False + + +-- Child introduction +ATTR EChild EChildren [ | | childintros USE {`Map.union`} {Map.empty} : {Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))} ] + +ATTR Visits Visit + VisitSteps VisitStep [ childintros : {Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))} | | ] + +SEM EProduction + | EProduction visits.childintros = @children.childintros + +SEM EChild + | ETerm lhs.childintros = Map.singleton @name (\_ _ -> Right (empty, Set.empty, Map.empty)) + | EChild lhs.childintros = Map.singleton @name @loc.introcode + loc.isDefor = case @tp of + NT _ _ defor -> defor + _ -> False + loc.valcode = case @kind of + ChildSyntax -> "arg_" >|< @name >|< "_" + ChildAttr -> -- decide if we need to invoke the sem-function under the hood + let prefix | not @loc.isDefor = if lateHigherOrderBinding @lhs.options -- && sepsemmods @lhs.options -- when sepsemmods is not enabled, the indirection can be optimized away + then lateSemNtLabel @loc.nt >#< lhsname @lhs.options True idLateBindingAttr + else "sem_" >|< @loc.nt + | otherwise = empty -- no need to intro a terminal + in pp_parens (prefix >#< instname @name) + ChildReplace _ -> -- the higher-order attribute is actually a function that transforms + -- the semantics of the child (always deforested) + pp_parens (instname @name >#< @name >|< "_") + loc.aroundcode = if @hasAround + then locname @lhs.options @name >|< "_around" + else empty + loc.introcode = \kind fmtMode -> + let pat = text $ stname @name @loc.initSt + patStrict = @loc.addbang pat + attach = "attach_T_" >|< @loc.nt >#< pp_parens (@loc.aroundcode >#< @loc.valcode) + runAttach = unMon @lhs.options >#< pp_parens attach + decl = case kind of + VisitPure False -> pat >#< "=" >#< runAttach + VisitPure True -> patStrict >#< "=" >#< runAttach + VisitMonadic -> attach >#< ">>= \\" >#< patStrict >#< "->" + in if compatibleAttach kind @loc.nt @lhs.options + then Right ( fmtDecl False fmtMode decl + , Set.singleton (stname @name @loc.initSt) -- variables defined by the child intro + , case @kind of -- variables used by the child introduction + ChildAttr -> Map.insert (instname @name) Nothing $ -- the sem attr + ( if @loc.isDefor || not (lateHigherOrderBinding @lhs.options) + then id -- the sem dictionary attr is not used + else Map.insert (lhsname @lhs.options True idLateBindingAttr) (Just $ AttrInh _LHS idLateBindingAttr) + ) $ + ( if @hasAround + then Map.insert (locname @lhs.options (@name) ++ "_around") Nothing + else id + ) $ Map.empty + ChildReplace _ -> Map.singleton (instname @name) Nothing -- uses the transformation function + ChildSyntax -> Map.empty + ) + else Left $ IncompatibleAttachKind @name kind + loc.nt = extractNonterminal @tp + +{ +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 +} + +-- rules +ATTR ERules ERule [ | | sem_rules USE {>-<} {empty} : {PP_Doc} + mrules USE {`Map.union`} {Map.empty} : {Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)} ] + +SEM ERule | ERule + lhs.sem_rules = if @loc.used == 0 + then empty + else @loc.rulecode + loc.rulecode = ( if @loc.genpragma + then @loc.pragma -- this additional pragma *may* help to give some AG source location in the presence of + -- type errors in the rule. It will definitely not be precise, and may take some additional + -- source space, but let's see if it's worth it in practice. + else empty + ) + >-< @loc.lambda + >-< indent ((column @rhs.pos - 2) `max` 2) + ( if @loc.genpragma + then @loc.pragma >-< @rhs.semfunc >-< @loc.endpragma + else @rhs.semfunc + ) + loc.pragma = "/*# LINE" >#< show (line @rhs.pos) >#< show (file @rhs.pos) >#< "#*/" + loc.endpragma = ppWithLineNr (\ln -> "/*# LINE " ++ show (ln+1) ++ " " ++ show @lhs.mainFile ++ "#*/") + loc.genpragma = genLinePragmas @lhs.options && @explicit && @loc.haspos + loc.haspos = line @rhs.pos > 0 && column @rhs.pos >= 0 && not (null (file @rhs.pos)) + + -- This comment describes the Haskell rationale for lambdas + -- we generate a simple pattern binding because of overloading-resolving during the type inference process. + -- The types of the rules are not generalized (nor do we want that - rules are used in a single typing-context). + -- If overloading is resolved separately, it may not be clear which dictionaries to use. For that all rules have + -- to be considered together, which is done when we use simple pattern bindings with a lambda expression instead + -- of a function definition. + -- Note: we also ensure that all rules are lambda expressions, so that they are not made part of any closures + -- but are lambda-lifted instead. + -- loc.lambda = @name >#< "=" >#< "\\" >#< @loc.argPats >#< dummyPat @lhs.options (Map.null @rhs.attrs) >#< "->" + + -- For Clean, we do not want to generate lambdas, but functions instead + loc.lambda = @name >#< @loc.argPats >#< dummyPat @lhs.options (Map.null @rhs.attrs) >#< "=" + + loc.argPats = ppSpaced [ let match | str `Set.member` @lhs.lazyIntras = pp str + | otherwise = @loc.addbang1 (pp str) + in case mbAttr of + Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs @lhs.options) -> + case Map.lookup nm @lhs.localAttrTypes of + Just tp -> pp_parens (pp_parens match) -- TODO Remove? >#< "::" >#< ppTp tp) + Nothing -> match + Just attr | not (noPerRuleTypeSigs @lhs.options) -> + case lookupAttrType attr @lhs.allInhmap @lhs.allSynmap @lhs.childTypes of + Just tpDoc -> pp_parens (pp_parens match) -- TODO Remove? >#< "::" >#< tpDoc) + Nothing -> match + _ -> match + | (str,mbAttr) <- Map.assocs @rhs.attrs + ] + loc.argExprs = ppSpaced [ case mbAttr of + Nothing -> "arg_" >|< str + _ -> text str + | (str,mbAttr) <- Map.assocs @rhs.attrs + ] + loc.stepcode = \kind fmtMode -> if kind `compatibleRule` @pure + then Right $ let oper | @pure = "=" + | otherwise = "<-" -- TODO Desugar + decl = @pattern.sem_lhs >#< oper >#< @name >#< @loc.argExprs >#< dummyArg @lhs.options (Map.null @rhs.attrs) + tp = if @pure && not (noPerRuleTypeSigs @lhs.options) + then @pattern.attrTypes + else empty + in fmtDecl @pure fmtMode (tp >-< decl) + else Left $ IncompatibleRuleKind @name kind + + lhs.mrules = Map.singleton @name @loc.stepcode + +ATTR Expression [ | | tks : {[HsToken]} ] +SEM Expression + | Expression lhs.tks = @tks + +{ +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)" +} + +{ +-- 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 +} + +ATTR Expression [ | | pos : {Pos} ] +SEM Expression | Expression lhs.pos = @pos + +-- pattern and expression semantics +ATTR Pattern [ | | sem_lhs : { PP_Doc } ] +ATTR Patterns [ | | sem_lhs USE {:} {[]} : {[PP_Doc]} ] +ATTR Pattern Patterns [ | | ] + +SEM Pattern + | Alias loc.varPat = text $ attrname @lhs.options False @field @attr + loc.patExpr = if @pat.isUnderscore + then @loc.varPat + else @loc.varPat >|< "@" >|< @pat.sem_lhs + lhs.sem_lhs = @loc.addbang1 @loc.patExpr + | Product lhs.sem_lhs = @loc.addbang1 $ pp_block "(" ")" "," @pats.sem_lhs + | Constr lhs.sem_lhs = @loc.addbang1 $ pp_parens $ @name >#< hv_sp @pats.sem_lhs + | Underscore lhs.sem_lhs = text "_" + | Irrefutable lhs.sem_lhs = text "~" >|< pp_parens @pat.sem_lhs + +-- Check if a pattern is just an underscore +ATTR Pattern [ | | isUnderscore:{Bool}] +SEM Pattern + | Constr lhs.isUnderscore = False + | Product lhs.isUnderscore = False + | Alias lhs.isUnderscore = False + | Underscore lhs.isUnderscore = True + +-- Collect the attributes defined by a pattern +ATTR Pattern Patterns [ | | attrs USE {`Set.union`} {Set.empty} : {Set String} ] +SEM Pattern | Alias + lhs.attrs = Set.insert (attrname @lhs.options False @field @attr) @pat.attrs + +-- All attribute types of this pattern +ATTR Pattern Patterns [ | | attrTypes USE {>-<} {empty} : {PP_Doc} ] +SEM Pattern | Alias + loc.mbTp = if @field == _LHS + then Map.lookup @attr @lhs.synmap + else if @field == _LOC + then Map.lookup @attr @lhs.localAttrTypes + else Nothing + lhs.attrTypes = empty -- Don't generate these type signatures; increases performance in Clean + -- maybe empty (\tp -> (attrname @lhs.options False @field @attr) >#< "::" >#< ppTp tp) @loc.mbTp + -- >-< @pat.attrTypes + +-- Collect the attributes used by the right-hand side +ATTR HsToken Expression [ | | attrs USE {`Map.union`} {Map.empty} : {Map String (Maybe NonLocalAttr)} ] +SEM HsToken + | AGLocal lhs.attrs = Map.singleton (fieldname @var) Nothing + | AGField loc.mbAttr = if @field == _INST || @field == _FIELD || @field == _INST' + then Nothing -- should not be used in the first place + else Just $ mkNonLocalAttr (@field == _LHS) @field @attr + lhs.attrs = Map.singleton (attrname @lhs.options True @field @attr) @loc.mbAttr + +{ +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 +} + +ATTR Expression [ | | semfunc : {PP_Doc} ] + +SEM Expression + | Expression lhs.attrs = Map.unions $ map (\tok -> attrs_Syn_HsToken (wrap_HsToken (sem_HsToken tok) @loc.inhhstoken)) @tks + lhs.semfunc = vlist $ showTokens $ map (\tok -> tok_Syn_HsToken (wrap_HsToken (sem_HsToken tok) @loc.inhhstoken)) @tks + loc.inhhstoken = Inh_HsToken @lhs.options + +-- child visit map +ATTR Visit + Visits + EProduction + EProductions + ENonterminal + ENonterminals [ allchildvisit : {Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))} + | | childvisit USE {`Map.union`} {Map.empty} : {Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))} ] + +ATTR VisitSteps VisitStep [ allchildvisit : {Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))} | | ] + +SEM ExecutionPlan + | ExecutionPlan nonts.allchildvisit = @nonts.childvisit + +SEM Visit + | Visit + loc.prevVisitInfo = Map.findWithDefault ManyVis @from @lhs.nextVisits + lhs.childvisit = Map.singleton @ident @loc.invokecode + loc.invokecode = \chn kind -> -- "chn" is the name of the child at the place of invocation, and "kind" the kind of the calling visit + if kind `compatibleKind` @kind + then Right $ + let pat | isLazyKind @kind = pat0 + | otherwise = @loc.addbang pat0 + pat0 = pp_parens pat1 + pat1 = @loc.nameTOut_visit >#< (ppSpaced $ map (attrname @lhs.options True chn) $ Set.toList @syn) + >#< cont + cont = case @loc.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 @lhs.options >#< expr0 + (VisitMonadic, VisitPure _) -> "lift" >#< expr0 + (VisitMonadic, VisitMonadic) -> expr0 + expr0 = case @loc.prevVisitInfo of + NoneVis -> error "error: invocation of a visit from a state that has no next visits" + OneVis _ -> "inv_" >|< @lhs.nt >|< "_s" >|< @from >#< ch0 >#< args + ManyVis -> "inv_" >|< @lhs.nt >|< "_s" >|< @from >#< ch0 + >#< "K_" >|< @lhs.nt >|< "_v" >|< @ident >#< args + args = pp_parens args0 >#< args1 + args0 = @loc.nameTIn_visit >#< @loc.inhargs chn + args1 | dummyTokenVisit @lhs.options = pp $ dummyArg @lhs.options True + | otherwise = empty + in (pat, expr) -- pretty print of the pattern and the expression part + else Left $ IncompatibleVisitKind chn @ident kind @kind + +{ +-- 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 +} + +------------------------------------------------------------------------------- +-- Properties of rules +------------------------------------------------------------------------------- + +-- Construct an environment that counts how often certain rules are used +ATTR Visits Visit VisitSteps VisitStep [ | | ruleUsage USE {`unionWithSum`} {Map.empty} : {Map Identifier Int} ] +ATTR ERules ERule [ usageInfo : {Map Identifier Int} | | ] + +SEM EProduction | EProduction rules.usageInfo = @visits.ruleUsage +SEM VisitStep | Sem lhs.ruleUsage = Map.singleton @name 1 +SEM ERule | ERule loc.used = Map.findWithDefault 0 @name @lhs.usageInfo + +{ +unionWithSum = Map.unionWith (+) +} + +-- Collect in what visit-kinds a rule is used +ATTR Visits Visit VisitSteps VisitStep [ | | ruleKinds USE {`unionWithMappend`} {Map.empty} : {Map Identifier (Set VisitKind)} ] +SEM VisitStep | Sem + lhs.ruleKinds = Map.singleton @name (Set.singleton @lhs.kind) + +ATTR ERules ERule [ ruleKinds : {Map Identifier (Set VisitKind)} | | ] +SEM EProduction | EProduction + rules.ruleKinds = @visits.ruleKinds + +SEM ERule | ERule + loc.kinds = Map.findWithDefault Set.empty @name @lhs.ruleKinds + loc.anyLazyKind = Set.fold (\k r -> isLazyKind k || r) False @loc.kinds + +ATTR Pattern Patterns [ anyLazyKind : Bool | | ] + + +------------------------------------------------------------------------------- +-- Intra attributes +------------------------------------------------------------------------------- +{ +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 +} +ATTR Visit Visits [ allintramap : {Map StateIdentifier (Map String (Maybe NonLocalAttr))} + | | intramap USE {`uwMapUnion`} {Map.empty} : {Map StateIdentifier (Map String (Maybe NonLocalAttr))} ] + +ATTR Visit Visits [ terminaldefs : {Set String} | | ] +ATTR EChild EChildren [ | | terminaldefs USE {`Set.union`} {Set.empty} : {Set String} ] + +SEM EChild | ETerm + lhs.terminaldefs = Set.singleton $ fieldname @name + +SEM EProduction | EProduction + visits.allintramap = @visits.intramap + visits.terminaldefs = @children.terminaldefs + +SEM Visit + | Visit loc.thisintra = (@loc.uses `Map.union` @loc.nextintra) `Map.difference` @loc.defsAsMap + lhs.intramap = Map.singleton @from @loc.thisintra + loc.nextintra = maybe Map.empty id $ Map.lookup @to @lhs.allintramap + loc.uses = let mp1 = @steps.uses + mp2 = Map.fromList [ (lhsname @lhs.options False i, Just (AttrSyn _LHS i)) | i <- Set.elems @syn ] + in mp1 `Map.union` mp2 + loc.inhVarNms = Set.map (lhsname @lhs.options True) @inh + loc.defs = @steps.defs `Set.union` @loc.inhVarNms `Set.union` @lhs.terminaldefs + loc.defsAsMap = Map.fromList [ (a, Nothing) | a <- Set.elems @loc.defs ] + +ATTR ERule ERules [ | | ruledefs USE {`uwSetUnion`} {Map.empty} : {Map Identifier (Set String)} + ruleuses USE {`uwMapUnion`} {Map.empty} : {Map Identifier (Map String (Maybe NonLocalAttr))} ] +ATTR Visit Visits + VisitSteps VisitStep [ ruledefs : {Map Identifier (Set String)} + ruleuses : {Map Identifier (Map String (Maybe NonLocalAttr))} | | ] + +SEM ERule + | ERule lhs.ruledefs = Map.singleton @name @pattern.attrs + lhs.ruleuses = Map.singleton @name @rhs.attrs + +SEM EProduction + | EProduction visits.ruledefs = @rules.ruledefs + visits.ruleuses = @rules.ruleuses + +ATTR Visit Visits + EProduction + EProductions + ENonterminal + ENonterminals [ | | visitdefs USE {`uwSetUnion`} {Map.empty} : {Map VisitIdentifier (Set Identifier)} + visituses USE {`uwSetUnion`} {Map.empty} : {Map VisitIdentifier (Set Identifier)} ] + +SEM Visit + | Visit lhs.visitdefs = Map.singleton @ident @syn + lhs.visituses = Map.singleton @ident @inh + +ATTR Visit Visits + VisitSteps VisitStep + EProduction EProductions + ENonterminal ENonterminals [ avisitdefs : {Map VisitIdentifier (Set Identifier)} + avisituses : {Map VisitIdentifier (Set Identifier)} | | ] + +SEM ExecutionPlan + | ExecutionPlan nonts.avisitdefs = @nonts.visitdefs + nonts.avisituses = @nonts.visituses + +ATTR VisitSteps VisitStep [ | | defs USE {`Set.union`} {Set.empty} : {Set String} + uses USE {`Map.union`} {Map.empty} : {Map String (Maybe NonLocalAttr)} ] +SEM VisitStep + | Sem lhs.defs = maybe (error "Rule not found") id $ Map.lookup @name @lhs.ruledefs + lhs.uses = maybe (error "Rule not found") id $ Map.lookup @name @lhs.ruleuses + | ChildVisit lhs.defs = Set.insert (stname @child @to) $ maybe (error "Visit not found") (Set.map $ attrname @lhs.options True @child) $ Map.lookup @visit @lhs.avisitdefs + lhs.uses = let convert attrs = Map.fromList [ (attrname @lhs.options 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 @lhs.avisituses + +------------------------------------------------------------------------------- +-- Identification of lazy intra defs within a production +-- +-- These identifiers will not be marked as strict in rules and state closures +------------------------------------------------------------------------------- + +ATTR Visits Visit VisitSteps VisitStep [ | | lazyIntras USE {`Set.union`} {Set.empty} : {Set String} ] +ATTR ERules ERule [ lazyIntras : {Set String} | | ] + +SEM Visit | Visit + loc.lazyIntrasInh = case @kind of + VisitPure False -> @loc.inhVarNms `Set.union` @steps.defs + _ -> Set.empty + lhs.lazyIntras = @loc.lazyIntrasInh `Set.union` @steps.lazyIntras + +SEM VisitStep | PureGroup + lhs.lazyIntras = if @ordered + then @steps.lazyIntras + else @steps.defs + +SEM EProduction | EProduction + loc.lazyIntras = @visits.lazyIntras + +------------------------------------------------------------------------------- +-- Pretty printing of haskell code +------------------------------------------------------------------------------- + +SEM HsTokens [ || tks : {[(Pos,String)]} ] + | Cons lhs.tks = @hd.tok : @tl.tks + | Nil lhs.tks = [] + +SEM HsToken + | AGLocal loc.tok = (@pos,fieldname @var) + +SEM HsToken [ || tok:{(Pos,String)}] + | AGField + loc.addTrace = case @rdesc of + Just d -> \x -> "(trace_n " ++ show (d ++ " -> " ++ show @field ++ "." ++ show @attr) ++ " (" ++ x ++ "))" + Nothing -> id + lhs.tok = (@pos, @loc.addTrace $ attrname @lhs.options True @field @attr) + + | HsToken lhs.tok = (@pos, @value) + + | CharToken lhs.tok = (@pos, if null @value + then "" + else showCharShort (head @value) + ) + + | StrToken lhs.tok = (@pos, showStrShort @value) + | Err lhs.tok = (@pos, "") + +------------------------------------------------------------------------------- +-- Alternative code generation (sepsemmods) +------------------------------------------------------------------------------- + +ATTR ExecutionPlan [ mainBlocksDoc : PP_Doc textBlockMap : {Map BlockInfo PP_Doc} + | | genIO : {IO ()} ] + +SEM ExecutionPlan + | ExecutionPlan lhs.genIO = do @loc.genMainModule + @loc.genCommonModule + @nonts.genProdIO + loc.mainModuleFile = @lhs.mainFile + loc.ppMonadImports = pp "import qualified Control.Monad.Identity" + loc.genMainModule = writeModule @loc.mainModuleFile + ( [ pp $ @lhs.iclModuleHeader @lhs.mainName "" "" False + , @loc.ppMonadImports + , pp $ "import " ++ @lhs.mainName ++ "_common" + ] + ++ @nonts.imports + ++ [@lhs.mainBlocksDoc] + ++ [@loc.wrappersExtra] + ++ @nonts.appendMain + ) + loc.commonFile = replaceBaseName @lhs.mainFile (takeBaseName @lhs.mainFile ++ "_common") + loc.genCommonModule = writeModule @loc.commonFile + ( [ pp $ @lhs.iclModuleHeader @lhs.mainName "_common" "" True + , @loc.ppMonadImports + , @lhs.importBlocks + , @lhs.textBlocks + , @loc.commonExtra + ] + ++ @nonts.appendCommon + ) + +ATTR ENonterminal [ | | appendCommon, appendMain : { PP_Doc } ] +ATTR ENonterminals [ | | appendCommon, appendMain USE {:} {[]} : {[PP_Doc]} ] + +SEM ENonterminal + | ENonterminal lhs.appendMain = (if @nt `Set.member` @lhs.wrappers + then @loc.wr_inh_icl + >-< @loc.wr_syn_icl + >-< @loc.wrapper_icl + else empty) + >-< @loc.sem_nt + lhs.appendCommon = (if dataTypes @lhs.options then @loc.datatype else empty) + >-< @loc.t_init_icl + >-< @loc.t_states_icl + >-< @loc.k_states + >-< @prods.t_visits + +ATTR EProduction EProductions + ENonterminal ENonterminals [ | | imports USE {++} {[]} : {[PP_Doc]} + genProdIO USE {>>} {return ()} : {IO ()} ] + +SEM EProduction + | EProduction lhs.imports = [pp $ "import " ++ @loc.moduleName] + loc.moduleName = @lhs.mainName ++ @loc.suffix + loc.suffix = '_' : show @lhs.nt ++ ('_' : show @con) + loc.outputfile = replaceBaseName @lhs.mainFile (takeBaseName @lhs.mainFile ++ @loc.suffix) + loc.ppMonadImports = pp "import qualified Control.Monad.Identity" + lhs.genProdIO = writeModule @loc.outputfile + [ pp $ @lhs.iclModuleHeader @lhs.mainName @loc.suffix @loc.semname True + , @lhs.importBlocks + , @loc.ppMonadImports + , pp $ "import " ++ @lhs.mainName ++ "_common" + , @loc.sem_prod + ] + +{ +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 +} + + +-- +-- Bang pattern usage +-- + +SEM ERule | ERule loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x +SEM Visit | Visit loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x +SEM ENonterminal | ENonterminal loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x +SEM EProduction | EProduction loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x +SEM EChild | EChild loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x +SEM EChild | ETerm loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x +SEM VisitStep | ChildVisit loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x +SEM Pattern | Alias Constr Product loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x + +SEM Visit | Visit loc.addbang1 = if isLazyKind @kind then id else @loc.addbang +SEM ENonterminal | ENonterminal loc.addbangWrap = id --if strictWrap @lhs.options then @loc.addbang else id +SEM ERule | ERule loc.addbang1 = if @loc.anyLazyKind then id else @loc.addbang +SEM Pattern | Alias Constr Product loc.addbang1 = if @lhs.anyLazyKind then id else @loc.addbang + +-- +-- Distribute single-visit-next map downward +-- + +ATTR EProductions EProduction Visits Visit + [ prevVisits, nextVisits : {Map StateIdentifier StateCtx} | | ] + +SEM ENonterminal | ENonterminal + prods.nextVisits = @nextVisits + prods.prevVisits = @prevVisits + +-- +-- Collect and distribute the from/to states of a visit +-- + +ATTR ENonterminals ENonterminal EProductions EProduction Visits Visit + [ | | fromToStates USE {`mappend`} {mempty} : {Map VisitIdentifier (Int,Int)} ] + +ATTR ENonterminals ENonterminal EProductions EProduction Visits Visit VisitSteps VisitStep + [ allFromToStates : {Map VisitIdentifier (Int,Int)} | | ] + +SEM Visit | Visit + lhs.fromToStates = Map.singleton @ident (@from, @to) + +SEM ExecutionPlan | ExecutionPlan + nonts.allFromToStates = @nonts.fromToStates + +SEM VisitStep | ChildVisit + (loc.from, loc.to) = Map.findWithDefault (error "visit not in allFromToStates") @visit @lhs.allFromToStates + + +-- +-- Collect and distribute the actual types of children of productions +-- + +ATTR EChildren EChild [ | | childTypes USE {`mappend`} {mempty} : {Map Identifier Type} ] +ATTR ERules ERule Visits Visit VisitSteps VisitStep [ childTypes : {Map Identifier Type} | | ] + +SEM EProduction | EProduction + loc.childTypes = Map.singleton _LHS @lhs.ntType `Map.union` @children.childTypes + +SEM EChild | EChild ETerm + lhs.childTypes = Map.singleton @name @tp + +-- +-- Distribute types of local attributes +-- + +ATTR ExecutionPlan ENonterminals ENonterminal [ localAttrTypes : {Map NontermIdent (Map ConstructorIdent (Map Identifier Type))} | | ] +ATTR EProductions EProduction [ localAttrTypes : {Map ConstructorIdent (Map Identifier Type)} | | ] +ATTR ERules ERule Pattern Patterns [ localAttrTypes : {Map Identifier Type} | | ] + +SEM ENonterminal | ENonterminal + prods.localAttrTypes = Map.findWithDefault Map.empty @nt @lhs.localAttrTypes + +SEM EProduction | EProduction + loc.localAttrTypes = Map.findWithDefault Map.empty @con @lhs.localAttrTypes + +-- +-- Collect and distribute visit kinds +-- + +ATTR ENonterminals ENonterminal EProductions EProduction Visits Visit VisitSteps VisitStep + [ allVisitKinds : {Map VisitIdentifier VisitKind} | | visitKinds USE {`mappend`} {mempty} : {Map VisitIdentifier VisitKind} ] + +SEM Visit | Visit + lhs.visitKinds = Map.singleton @ident @kind + +SEM ExecutionPlan | ExecutionPlan + nonts.allVisitKinds = @nonts.visitKinds + +-- +-- Collect and distribute the initial state of nonterminals +-- + +ATTR ENonterminals ENonterminal [ | | initStates USE {`mappend`} {mempty} : {Map NontermIdent Int} ] +ATTR ENonterminals ENonterminal EProductions EProduction EChildren EChild Visits Visit VisitSteps VisitStep + [ allInitStates : {Map NontermIdent Int} | | ] + +SEM ENonterminal | ENonterminal + lhs.initStates = Map.singleton @nt @initial + +SEM ExecutionPlan | ExecutionPlan + nonts.allInitStates = @nonts.initStates + +SEM EChild | EChild + loc.initSt = Map.findWithDefault (error "nonterminal not in allInitStates map") @loc.nt @lhs.allInitStates + +-- +-- Push the nonterminal type downward +-- + +ATTR EProductions EProduction [ ntType : Type | | ] +SEM ENonterminal | ENonterminal + loc.ntType = NT @nt (map show @params) False + +-- +-- Collect errors contained in rules that should be yielded when the +-- rules are scheduled. +-- + +ATTR ExecutionPlan ENonterminals ENonterminal EProductions EProduction ERules ERule Visits Visit VisitSteps VisitStep [ | | errors USE {Seq.><} {Seq.empty} : {Seq Error} ] +SEM ERule | ERule + lhs.errors = case @mbError of + Just e | @loc.used > 0 -> Seq.singleton e + _ -> Seq.empty +
+ src-ag/ExecutionPlan2Hs.ag view
@@ -0,0 +1,1711 @@+INCLUDE "ExecutionPlan.ag" +INCLUDE "Patterns.ag" +INCLUDE "Expression.ag" +INCLUDE "HsToken.ag" + +imports +{ +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) +} + +ATTR ExecutionPlan ENonterminals ENonterminal EProductions EProduction ERules ERule EChildren EChild + [ importBlocks : PP_Doc + pragmaBlocks : String + textBlocks : PP_Doc + moduleHeader : {String -> String -> String -> Bool -> String} + mainFile : String + mainName : String | | ] + +------------------------------------------------------------------------------- +-- Options +------------------------------------------------------------------------------- +ATTR ExecutionPlan + ENonterminals ENonterminal + EProductions EProduction + ERules ERule + EChildren EChild + Expression + HsToken HsTokens HsTokensRoot + Pattern Patterns + Visits Visit + VisitSteps VisitStep [ options : {Options} | | ] +ATTR EProductions EProduction [ rename : {Bool} | | ] + +SEM ENonterminal + | ENonterminal prods.rename = rename @lhs.options + +------------------------------------------------------------------------------- +-- Context info (nonterminal ident, constructor ident, nonterm params, etc.) +------------------------------------------------------------------------------- + +ATTR Visit Visits EProduction EProductions EChildren EChild ERules ERule [ nt : NontermIdent | | ] +SEM ENonterminal + | ENonterminal prods.nt = @nt + +ATTR EChildren EChild ERules ERule Visits Visit + [ con : ConstructorIdent | | ] + +SEM EProduction + | EProduction children.con = @con + rules.con = @con + visits.con = @con + +ATTR EProductions EProduction Visits Visit [ params : {[Identifier]} | | ] +SEM ENonterminal | ENonterminal + prods.params = @params + +ATTR EProductions EProduction [ classCtxs : ClassContext | | ] +SEM ENonterminal | ENonterminal + prods.classCtxs = @classCtxs + +------------------------------------------------------------------------------- +-- Default output +------------------------------------------------------------------------------- +ATTR ExecutionPlan [ | | output : {PP_Doc} ] + +SEM ExecutionPlan + | ExecutionPlan lhs.output = @nonts.output >-< @loc.commonExtra >-< @loc.wrappersExtra + +ATTR ENonterminal ENonterminals [ wrappers : {Set NontermIdent} + | | output USE {>-<} {empty} : {PP_Doc} ] + +SEM ExecutionPlan + | ExecutionPlan nonts.wrappers = @wrappers + +SEM ENonterminal + | ENonterminal lhs.output = ("-- " ++ getName @nt ++ " " ++ replicate (60 - length (getName @nt)) '-') + >-< (if dataTypes @lhs.options + then "-- data" + >-< @loc.datatype + >-< "" + else empty) + >-< (if @loc.hasWrapper + then "-- wrapper" + >-< @loc.wr_inh + >-< @loc.wr_syn + >-< @loc.wrapper + >-< "" + else empty) + >-< (if folds @lhs.options + then "-- cata" + >-< @loc.sem_nt + >-< "" + else empty) + >-< (if semfuns @lhs.options + then "-- semantic domain" + >-< @loc.t_init + >-< @loc.t_states + >-< @loc.k_states + >-< @prods.t_visits + >-< @prods.sem_prod + >-< "" + else empty) + loc.hasWrapper = @nt `Set.member` @lhs.wrappers + +------------------------------------------------------------------------------- +-- Nonterminal datatype +------------------------------------------------------------------------------- +ATTR ENonterminal ENonterminals [ typeSyns : {TypeSyns} + derivings : {Derivings} | | ] + +SEM ExecutionPlan + | ExecutionPlan nonts.typeSyns = @typeSyns + nonts.derivings = @derivings + +SEM ENonterminal + | ENonterminal loc.classPP = ppClasses $ classCtxsToDocs @classCtxs + loc.aliasPre = "type" >#< @loc.classPP >#< @nt >#< @loc.t_params >#< "=" + loc.datatype = case lookup @nt @lhs.typeSyns of + Nothing -> "data" >#< @loc.classPP >#< @nt >#< @loc.t_params + >-< ( if null @prods.datatype + then empty + else indent 2 $ vlist $ ( ("=" >#< head @prods.datatype) + : (map ("|" >#<) $ tail @prods.datatype)) + ) + >-< indent 2 @loc.derivings + Just (List t) -> @loc.aliasPre >#< "[" >#< show t >#< "]" + Just (Maybe t) -> @loc.aliasPre >#< "Maybe" >#< pp_parens (show t) + Just (Tuple ts) -> @loc.aliasPre >#< pp_parens (ppCommas $ map (show . snd) ts) + Just (Either l r) -> @loc.aliasPre >#< "Either" >#< pp_parens (show l) >#< pp_parens (show r) + Just (Map k v) -> @loc.aliasPre >#< "Data.Map" >#< pp_parens (show k) >#< pp_parens (show v) + Just (IntMap t) -> @loc.aliasPre >#< "Data.IntMap.IntMap" >#< pp_parens (show t) + Just (OrdSet t) -> @loc.aliasPre >#< "Data.Set.Set" >#< pp_parens (show t) + Just IntSet -> @loc.aliasPre >#< "Data.IntSet.IntSet" +-- Just x -> error $ "Type " ++ show x ++ " is not supported" + loc.derivings = case Map.lookup @nt @lhs.derivings of + Nothing -> empty + Just s -> if Set.null s + then empty + else "deriving" >#< (pp_parens $ ppCommas $ map pp $ Set.toList s) + +{ +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 >#< "." +} + +ATTR EProduction [ | | datatype : {PP_Doc} ] +ATTR EProductions [ | | datatype USE {:} {[]} : {[PP_Doc]} ] + +-- we generate the data type in the type-class style instead of the GADT style +-- the GADT extension may be required if equality constraints are used +SEM EProduction + | EProduction lhs.datatype = @loc.quantPP1 >#< @loc.classPP1 + >#< conname @lhs.rename @lhs.nt @con + >#< ppConFields (dataRecords @lhs.options) @children.datatype + loc.classPP1 = ppClasses (classConstrsToDocs @constraints) + loc.quantPP1 = ppQuants @params + +{ +-- 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 +} + + +ATTR EChild [ | | datatype : {PP_Doc} ] +ATTR EChildren [ | | datatype USE {:} {[]} : {[PP_Doc]} ] + +-- Note: the child may be a higher-order attribute, and its semantics may be deforested +SEM EChild + | EChild ETerm + loc.tpDoc = @loc.addStrict $ pp_parens $ ppTp $ removeDeforested @tp + loc.strNm = recordFieldname @lhs.nt @lhs.con @name + loc.field = if dataRecords @lhs.options + then @loc.strNm >#< "::" >#< @loc.tpDoc + else @loc.tpDoc + loc.addStrict = \x -> if strictData @lhs.options then "!" >|< x else x + | EChild lhs.datatype = case @kind of + ChildAttr -> empty -- higher order attributes are not part of the data type + _ -> @loc.field + + | ETerm lhs.datatype = @loc.field + +{ +ppTp :: Type -> PP_Doc +ppTp = text . typeToHaskellString Nothing [] +} + +------------------------------------------------------------------------------- +-- Nonterminal semantic function +------------------------------------------------------------------------------- +SEM ENonterminal + | ENonterminal loc.fsemname = \x -> "sem_" ++ show x + loc.semname = @loc.fsemname @nt + loc.frecarg = \t x -> case t of + NT nt _ _ -> pp_parens (@fsemname nt >#< x) + _ -> pp x + + -- The sem_NT function is lazy in the AST: it depends on the application of "child" + -- rules to which extend the AST needs to be constructed. + loc.sem_tp = @loc.quantPP >#< @loc.classPP >#< @nt >#< @loc.t_params >#< "->" >#< @loc.t_type >#< @loc.t_params + loc.quantPP = ppQuants @params + loc.sem_nt = @loc.semPragma + >-< @loc.semname >#< "::" >#< @loc.sem_tp + >-< case lookup @nt @lhs.typeSyns of + Nothing -> @prods.sem_nt + Just (List t) -> @loc.semname >#< "list" >#< "=" >#< "Prelude.foldr" >#< @loc.semname >|< "_Cons" + >#< @loc.semname >|< "_Nil" + >#< case t of + NT nt _ _ -> pp_parens ("Prelude.map" >#< @fsemname nt >#< "list") + _ -> pp "list" + Just (Maybe t) -> @loc.semname >#< "Prelude.Nothing" >#< "=" >#< @loc.semname >|< "_Nothing" + >-< @loc.semname >#< pp_parens ("Prelude.Just just") >#< "=" + >#< @loc.semname >|< "_Just" >#< @frecarg t "just" + Just (Tuple ts) -> @loc.semname >#< pp_parens (ppCommas $ map fst ts) >#< "=" + >#< @loc.semname >|< "_Tuple" >#< ppSpaced (map (\t -> @frecarg (snd t) (show $ fst t)) ts) + Just (Either l r) -> @loc.semname >#< "(Prelude.Left left)" >#< "=" >#< @loc.semname >|< "_Left" >#< @frecarg l "left" + >-< @loc.semname >#< "(Prelude.Right right)" >#< "=" >#< @loc.semname >|< "_Right" >#< @frecarg r "right" + Just (Map k v) -> @loc.semname >#< "m" >#< "=" >#< "Data.Map.foldrWithKey" + >#< @loc.semname >|< "_Entry" >#< @loc.semname >|< "_Nil" + >#< case v of + NT nt _ _ -> pp_parens ("Data.Map.map" >#< @fsemname nt >#< "m") + _ -> pp "m" + Just (IntMap v) -> @loc.semname >#< "m" >#< "=" >#< "Data.IntMap.foldWithKey" + >#< @loc.semname >|< "_Entry" >#< @loc.semname >|< "_Nil" + >#< case v of + NT nt _ _ -> pp_parens ("Data.IntMap.map" >#< @fsemname nt >#< "m") + _ -> pp "m" + Just (OrdSet t) -> @loc.semname >#< "s" >#< "=" >#< "Prelude.foldr" >#< @loc.semname >|< "_Entry" + >#< @loc.semname >|< "_Nil" + >#< pp_parens ( + ( case t of + NT nt _ _ -> pp_parens ("Prelude.map" >#< @fsemname nt) + _ -> empty + ) >#< pp_parens ("Data.IntSet.elems" >#< "s") + ) + Just IntSet -> @loc.semname >#< "s" >#< "=" >#< "Prelude.foldr" >#< @loc.semname >|< "_Entry" + >#< @loc.semname >|< "_Nil" + >#< pp_parens ("Data.IntSet.elems" >#< "s") +-- Just x -> error $ "Type " ++ show x ++ " is not supported yet" -- TODO: other typeSyns + + -- precise inlining strategies for inlining + loc.inlineNt = not (lateHigherOrderBinding @lhs.options) && not @recursive && (@prods.count == 1 || (aggressiveInlinePragmas @lhs.options && not @loc.hasWrapper)) -- lucrative for inlining + loc.semPragma = if noInlinePragmas @lhs.options + then empty + else if @loc.inlineNt + then ppInline @loc.semname + else if helpInlining @lhs.options && not (lateHigherOrderBinding @lhs.options) + then ppInlinable @loc.semname + else ppNoInline @loc.semname + +-- The number of productions +ATTR EProductions EProduction [ | | count USE {+} {0} : {Int} ] +SEM EProduction | EProduction lhs.count = {1} + +-- The per-production cases for the sem_NT function +ATTR EProduction EProductions [ | | sem_nt USE {>-<} {empty} : {PP_Doc} ] +SEM EProduction + | EProduction lhs.sem_nt = "sem_" >|< @lhs.nt >#< "(" >#< conname @lhs.rename @lhs.nt @con >#< ppSpaced @children.argpats >#< ")" + >#< "=" >#< "sem_" >|< @lhs.nt >|< "_" >|< @con >#< ppSpaced @children.argnamesw + +ATTR EChild [ | | argnamesw : { PP_Doc } ] +ATTR EChildren [ | | argnamesw USE {:} {[]} : {[PP_Doc]} ] + +SEM EChild + | EChild lhs.argnamesw = case @kind of + ChildSyntax -> "(" >#< "sem_" >|< @loc.nt >#< @name >|< "_" >#< ")" + ChildAttr -> empty -- no sem-case for a higher-order child + ChildReplace tp -> "(" >#< "sem_" >|< extractNonterminal tp >#< @name >|< "_" >#< ")" + | ETerm lhs.argnamesw = text $ fieldname @name + +------------------------------------------------------------------------------- +-- Types of attributes +------------------------------------------------------------------------------- +ATTR ExecutionPlan + ENonterminals + ENonterminal [ inhmap : {Map NontermIdent Attributes} + synmap : {Map NontermIdent Attributes} | | ] + +ATTR EProductions EProduction + ERules ERule + Patterns Pattern + Visits + Visit [ inhmap : {Attributes} + synmap : {Attributes} + allInhmap : {Map NontermIdent Attributes} + allSynmap : {Map NontermIdent Attributes} | | ] + +SEM ENonterminal + | ENonterminal (Just prods.inhmap) = Map.lookup @nt @lhs.inhmap + (Just prods.synmap) = Map.lookup @nt @lhs.synmap + prods.allInhmap = @lhs.inhmap + prods.allSynmap = @lhs.synmap + +------------------------------------------------------------------------------- +-- State datatypes +------------------------------------------------------------------------------- +{type VisitStateState = (VisitIdentifier,StateIdentifier, StateIdentifier)} + +ATTR Visit [ | | allvisits : { VisitStateState }] +ATTR Visits [ | | allvisits USE {:} {[]} : {[VisitStateState]}] +ATTR EProduction + EProductions [ | | allvisits: {[VisitStateState]}] + +SEM Visit + | Visit lhs.allvisits = (@ident, @from, @to) + +SEM EProductions + | Cons lhs.allvisits = @hd.allvisits -- just pick the first production + | Nil lhs.allvisits = error "Every nonterminal should have at least 1 production" + +-- type of tree in a given state s +SEM ENonterminal + | ENonterminal loc.outedges = Set.fromList $ map (\(_,f,_) -> f) @prods.allvisits + loc.inedges = Set.fromList $ map (\(_,_,t) -> t) @prods.allvisits + loc.allstates = Set.insert @initial $ @loc.inedges `Set.union` @loc.outedges + loc.stvisits = \st -> filter (\(v,f,t) -> f == st) @prods.allvisits + loc.t_type = "T_" >|< @nt + loc.t_params = ppSpaced @params + loc.t_init = "newtype" >#< @loc.t_type >#< @loc.t_params >#< "=" >#< @loc.t_type >#< + pp_braces ( + "attach_">|< @loc.t_type >#< "::" + >#< ppMonadType @lhs.options >#< pp_parens (@loc.t_type >|< "_s" >|< @initial >#< @loc.t_params)) + loc.t_states = 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 >#< @loc.t_params >#< "=" >#< c_st -- empty semantics + OneVis vId -> "newtype" >#< t_st >#< @loc.t_params >#< "=" >#< c_st + >#< (pp_braces $ inv_st >#< "::" >#< pp_parens (conNmTVisit @nt vId >#< @loc.t_params)) + ManyVis -> "data" >#< t_st >#< @loc.t_params >#< "where" >#< c_st >#< "::" + >#< (pp_braces $ inv_st >#< "::" >#< "!" >|< pp_parens ("forall t." >#< k_st >#< @loc.t_params >#< "t" >#< "->" >#< "t")) + >#< "->" >#< t_st >#< @loc.t_params -- this is a conventional data type, but declared with GADT syntax + ) $ Set.toList @loc.allstates + +-- type of a key which identifies a visit v from state s +SEM ENonterminal + | ENonterminal loc.k_type = "K_" ++ show @nt + loc.k_states = vlist $ map (\st -> + let nt_st = @nt >|< "_s" >|< st + k_st = "K_" >|< nt_st + outg = filter (\(v,f,t) -> f == st) @prods.allvisits + visitlist = vlist $ map (\(v,f,t) -> + @loc.k_type >|< "_v" >|< v >#< "::" >#< k_st >#< @loc.t_params >#< pp_parens (@loc.t_type >|< "_v" >|< v >#< @loc.t_params) + ) outg + nextVisit = Map.findWithDefault ManyVis st @nextVisits + decl = "data" >#< k_st >#< "k" >#< @loc.t_params >#< "where" >-< indent 3 visitlist + in case nextVisit of + NoneVis -> empty + OneVis _ -> empty + ManyVis -> decl + ) $ Set.toList @loc.allstates + +-- type of a visit v, with continuation as new state s +ATTR Visit Visits EProduction EProductions [ | | t_visits USE {>-<} {empty} : {PP_Doc} ] + +SEM EProductions + | Cons lhs.t_visits = @hd.t_visits -- just pick the first production + +SEM Visit + | Visit loc.nameT_visit = conNmTVisit @lhs.nt @ident + loc.nameTIn_visit = conNmTVisitIn @lhs.nt @ident + loc.nameTOut_visit = conNmTVisitOut @lhs.nt @ident + loc.nameTNext_visit = conNmTNextVisit @lhs.nt @to + + loc.nextVisitInfo = Map.findWithDefault ManyVis @to @lhs.nextVisits -- which visits can we do after we reach the @to state? + loc.typecon = case @kind of + VisitPure _ -> empty + VisitMonadic -> ppMonadType @lhs.options + + loc.t_params = ppSpaced @lhs.params + lhs.t_visits = "type" >#< @loc.nameT_visit >#< @loc.t_params >#< "=" >#< + pp_parens (@loc.nameTIn_visit >#< @loc.t_params) + >#< ( if dummyTokenVisit @lhs.options + then "->" >#< dummyType @lhs.options True -- Additional (unused though) argument + else empty + ) + >#< "->" >#< @loc.typecon >#< pp_parens (@loc.nameTOut_visit >#< @loc.t_params) + >-< "data" >#< @loc.nameTIn_visit >#< @loc.t_params >#< "=" >#< @loc.nameTIn_visit >#< + @loc.inhpart + >-< "data" >#< @loc.nameTOut_visit >#< @loc.t_params >#< "=" >#< @loc.nameTOut_visit >#< + @loc.synpart >#< case @loc.nextVisitInfo of + NoneVis -> empty -- don't return a continuation at all + _ -> @loc.addbang1 $ pp_parens (@loc.nameTNext_visit >#< @loc.t_params) -- normal route: select the next semantics + loc.inhpart = @loc.ppTypeList @inh @lhs.inhmap + loc.synpart = @loc.ppTypeList @syn @lhs.synmap + loc.ppTypeList = \s m -> ppSpaced $ map (\i -> @loc.addbang1 $ pp_parens $ case Map.lookup i m of + Just tp -> ppTp tp ) $ Set.toList s + +{ +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" +} + +------------------------------------------------------------------------------- +-- Inh and Syn wrappers +------------------------------------------------------------------------------- +SEM ENonterminal + | ENonterminal loc.wr_inh = @loc.genwrap "Inh" @loc.wr_inhs + loc.wr_syn = @loc.genwrap "Syn" @loc.wr_syns + loc.genwrap = \nm attr -> "data" >#< nm >|< "_" >|< @nt >#< @loc.t_params >#< "=" >#< nm >|< "_" >|< @nt >#< "{" + >#< (ppCommas $ map (\(i,t) -> i >|< "_" >|< nm >|< "_" >|< @nt >#< "::" + >#< (@loc.addbang $ pp_parens $ typeToHaskellString (Just @nt) [] t)) attr) >#< "}" + loc.synAttrs = fromJust $ Map.lookup @nt @lhs.inhmap + loc.wr_inhs = Map.toList $ @loc.wr_filter $ @loc.synAttrs + loc.wr_inhs1 = Map.toList @loc.synAttrs + loc.wr_filter = if lateHigherOrderBinding @lhs.options + then Map.delete idLateBindingAttr + else id + loc.wr_syns = Map.toList $ fromJust $ Map.lookup @nt @lhs.synmap + loc.inhlist = map (lhsname @lhs.options True . fst) @loc.wr_inhs + loc.inhlist1 = map (lhsname @lhs.options True . fst) @loc.wr_inhs1 + loc.synlist = map (lhsname @lhs.options False . fst) @loc.wr_syns + loc.wrapname = "wrap_" ++ show @nt + loc.inhname = "Inh_" ++ show @nt + loc.synname = "Syn_" ++ show @nt + loc.firstVisitInfo = Map.findWithDefault ManyVis @initial @nextVisits + loc.wrapper = @loc.wrapPragma + >-< (@loc.wrapname >#< "::" >#< @loc.quantPP >#< @loc.classPP >#< @loc.t_type >#< @loc.t_params >#< "->" + >#< @loc.inhname >#< @loc.t_params >#< "->" >#< ( if monadicWrappers @lhs.options then ppMonadType @lhs.options else empty) >#< pp_parens (@loc.synname >#< @loc.t_params)) + >-< (@loc.wrapname >#< (@loc.addbang $ pp_parens (@loc.t_type >#< pp "act")) + >#< (@loc.addbang $ pp_parens (@loc.inhname + >#< (ppSpaced $ map (@loc.addbangWrap . pp) @loc.inhlist)) >#< "=")) + >-< + indent 3 (case @initialv of + -- case where there are no inherited or synthesized attributes + [] -> @loc.synname >#< " { }" + initvs@(initv:_) -> + let extra = if dummyTokenVisit @lhs.options + then pp $ dummyArg @lhs.options True + else empty + unMonad | monadicWrappers @lhs.options = empty + | otherwise = unMon @lhs.options + genSteps _ [] = [] + genSteps curst (curv:nextvs) = setarg : dovis : genSteps nextst nextvs where + inCon = conNmTVisitIn @nt curv + outCon = conNmTVisitOut @nt curv + pat = @loc.addbang $ pp_parens $ pat0 + pat0 = outCon >#< ppSpaced (map (lhsname @lhs.options False) syns) >#< cont + cont | null nextvs = empty + | otherwise = pp "sem" + inhs = Set.toList $ Map.findWithDefault Set.empty curv @prods.visituses + syns = Set.toList $ Map.findWithDefault Set.empty curv @prods.visitdefs + arg = inCon >#< ppSpaced (map (lhsname @lhs.options True) inhs) + setarg = "let" >#< @loc.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 -> @loc.k_type >|< "_v" >|< initv + nextst = curst + 1 -- This is not correct, but works both for KW and AOAG + -- Should be lookup up based on visit + convert = case Map.lookup curv @lhs.allVisitKinds 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" >#< ( @loc.addbang (pp "sem") >#< "<-" >#< "act" -- run the per-node monadic code to get the initial state (of the root) + >-< vlist (genSteps @initial initvs) + >-< "return" >#< pp_parens (@loc.synname >#< ppSpaced @loc.synlist) + ) + ) + >-< ")" ) + >-< if lateHigherOrderBinding @lhs.options + then indent 2 ("where" >#< lhsname @lhs.options True idLateBindingAttr >#< "=" >#< lateBindingFieldNm @lhs.mainName) + else empty + loc.wrapPragma = if parallelInvoke @lhs.options && not (monadicWrappers @lhs.options) + then ppNoInline @loc.wrapname -- required for the use of unsafePerformIO in case of the IO monad + else if noInlinePragmas @lhs.options + then empty + else ppInlinable @loc.wrapname -- ensure that the wrapper is exposed as inlinable + +------------------------------------------------------------------------------- +-- Collection of NT / Production sem funs references +------------------------------------------------------------------------------- + +ATTR ENonterminals ENonterminal EProductions EProduction [ | | semFunBndDefs, semFunBndTps USE {Seq.><} {Seq.empty} : {Seq PP_Doc} ] +SEM ENonterminal | ENonterminal + lhs.semFunBndDefs = @loc.semFunBndDef Seq.<| @prods.semFunBndDefs + lhs.semFunBndTps = @loc.semFunBndTp Seq.<| @prods.semFunBndTps + loc.semFunBndDef = @loc.semFunBndNm >#< "=" >#< @loc.semname + loc.semFunBndTp = @loc.semFunBndNm >#< "::" >#< @loc.sem_tp + loc.semFunBndNm = lateSemNtLabel @nt + +SEM EProduction | EProduction + lhs.semFunBndDefs = Seq.singleton @loc.semFunBndDef + lhs.semFunBndTps = Seq.singleton @loc.semFunBndTp + loc.semFunBndDef = @loc.semFunBndNm >#< "=" >#< @loc.semname + loc.semFunBndTp = @loc.semFunBndNm >#< "::" >#< @loc.sem_tp + loc.semFunBndNm = lateSemConLabel @lhs.nt @con + +-- Generate a dictionary that contains the semantics of all semantic functions +SEM ExecutionPlan | ExecutionPlan + loc.wrappersExtra = if lateHigherOrderBinding @lhs.options + then @loc.lateSemBndDef + else empty + loc.commonExtra = if lateHigherOrderBinding @lhs.options + then @loc.lateSemBndTp + else empty + loc.lateSemBndTp = "data" >#< lateBindingTypeNm @lhs.mainName >#< "=" >#< lateBindingTypeNm @lhs.mainName + >-< (indent 2 $ pp_block "{" "}" "," $ toList @nonts.semFunBndTps) + loc.lateSemBndDef = ( if noInlinePragmas @lhs.options + then empty + else if helpInlining @lhs.options && Set.size @wrappers == 1 + then ppInline $ lateBindingFieldNm @lhs.mainName -- inline in the single wrapper + else ppNoInline $ lateBindingFieldNm @lhs.mainName + ) + >-< lateBindingFieldNm @lhs.mainName >#< "::" >#< lateBindingTypeNm @lhs.mainName + >-< lateBindingFieldNm @lhs.mainName >#< "=" >#< lateBindingTypeNm @lhs.mainName + >-< (indent 2 $ pp_block "{" "}" "," $ toList @nonts.semFunBndDefs ) + +------------------------------------------------------------------------------- +-- Production semantic functions +------------------------------------------------------------------------------- +ATTR EProduction [ | | sem_prod : {PP_Doc} ] +ATTR EProductions [ | | sem_prod USE {>-<} {empty} : {PP_Doc} ] + +ATTR EProduction EProductions [ initial : {StateIdentifier} + allstates : {Set StateIdentifier} | | ] +SEM ENonterminal + | ENonterminal prods.initial = @initial + prods.allstates = @loc.allstates + +ATTR EChild [ | | argtps : { PP_Doc } + argpats : { PP_Doc } ] +ATTR EChildren [ | | argtps USE {:} {[]} : { [PP_Doc] } + argpats USE {:} {[]} : { [PP_Doc] } ] + +SEM EChild + | EChild lhs.argtps = case @kind of + ChildSyntax -> ppDefor @tp >#< "->" + ChildReplace tp -> ppDefor tp >#< "->" + _ -> empty -- higher order attribute + loc.argpats = case @kind of + ChildSyntax -> @name >|< "_" -- no strictification of children semantics to allow infinite trees + ChildReplace _ -> @name >|< "_" + _ -> empty + | ETerm lhs.argtps = (pp_parens $ show @tp) >#< "->" + loc.argpats = @loc.addbang $ text $ fieldname @name -- terminals may be strict (perhaps this should become an option) + +{ +ppDefor :: Type -> PP_Doc +ppDefor (NT nt args _) = "T_" >|< nt >#< ppSpaced (map pp_parens args) +ppDefor (Haskell s) = text s +} + +SEM EProduction + | EProduction loc.t_type = "T_" >|< @lhs.nt + loc.t_params = ppSpaced @lhs.params + loc.usedArgs = @children.usedArgs `Set.union` @visits.usedArgs `Set.union` @rules.usedArgs + -- A bit ugly, but this code renames arguments and puts an underscore when the argument + -- is never used. This avoids compiler warnings of unused variables. + loc.args = 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` @loc.usedArgs + then arg + else text "_") @children.argpats + loc.semname = "sem_" ++ show @lhs.nt ++ "_" ++ show @con + loc.sem_tp = @loc.quantPP2 >#< @loc.classPP2 >#< ppSpaced @children.argtps >#< @loc.t_type >#< @loc.t_params + loc.classPP2 = ppClasses (classCtxsToDocs @lhs.classCtxs ++ classConstrsToDocs @constraints) + loc.quantPP2 = ppQuants (@lhs.params ++ @params) + loc.sem_prod = @loc.semInlinePragma + >-< @loc.semname >#< "::" >#< @loc.sem_tp + >-< @loc.mkSemBody (@loc.semname >#< ppSpaced @loc.args >#< "=" >#< @loc.scc >#< @loc.t_type) + @loc.mbInitializer @loc.outerlet ("return" >#< "st" >|< @lhs.initial) + loc.mkSemBody = \prefix mbInit outerlet ret -> + case mbInit of + Nothing -> prefix >#< pp_parens ret >#< "where" + >-< indent 3 outerlet -- code for states and visits + Just m -> prefix >#< "(" >#< "do" + >-< indent 1 ( + m + >-< "let" + >-< indent 2 outerlet -- code for the states and visits + >-< ret ) + >-< indent 1 ")" + + loc.mbInitializer = --some monadic actions, performed upon attaching a child, can + -- be specified here. The resulting bindings of these actions are + -- in scope of the rules of the production + if parallelInvoke @lhs.options + then (Nothing :: Maybe PP_Doc) -- perhaps do some per-node registation, etc. For now: nothing + else Nothing -- nothing special here + loc.scc = if genCostCentres @lhs.options + then ppCostCentre @loc.semname + else empty + loc.semInlinePragma = if noInlinePragmas @lhs.options + then empty + else ppNoInline @loc.semname -- prevent the semantic functions of constructors to be inlined (e.g. in the nt sem-funs) + loc.outerlet = vlist @loc.statefns >-< @rules.sem_rules + loc.statefns = map @loc.genstfn $ Set.toList @lhs.allstates + loc.genstfn = \st -> let nextVisitInfo = Map.findWithDefault ManyVis st @lhs.nextVisits + prevVisitInfo = Map.findWithDefault ManyVis st @lhs.prevVisits + stNm = "st" >|< st + lhs = pragma >-< bang stNm >#< "=" >#< + ( -- generating a lambda for the same reasons as generating + -- a lambda for rules: to ensure that overloading is + -- resolved for all visit functions and rules together. + if st == @lhs.initial + then empty + else "\\" >#< @loc.stargs st >#< "->" + ) + + pragma = if noInlinePragmas @lhs.options + then empty + else if helpInlining @lhs.options + then case prevVisitInfo of + ManyVis -> ppNoInline stNm + OneVis _ -> if aggressiveInlinePragmas @lhs.options + then ppInline stNm + else ppInlinable stNm + NoneVis -> if st /= @lhs.initial + then error ("State " ++ show st ++ " is not reachable from the initial state.") + else if aggressiveInlinePragmas @lhs.options + then ppInline stNm -- first state can be inlined + else ppInlinable stNm + else ppNoInline stNm + cCon = "C_" >|< @lhs.nt >|< "_s" >|< st + bang | st == @lhs.initial = @loc.addbang -- initial state is not parameterized + | otherwise = id + + -- note about the initial state: the initial state should be the only + -- state-binding that is not a function. It is non-recursive and not needed + -- anywhere except delivered as initial result. This binding therefore does + -- not end up needlessly in any closure. + in case nextVisitInfo of + NoneVis -> -- the (empty) closure of a (non-initial) end state is not referenced + -- thus generating it is not needed (and omitting it may catch some small mistakes). + if st == @lhs.initial + then lhs >#< cCon -- empty state + else empty -- no state generated + OneVis vId -> mklet lhs (@loc.stvs st False) (cCon >#< "v" >|< vId) + ManyVis -> mklet lhs (@loc.stks st >-< @loc.stvs st True) (cCon >#< "k" >|< st) + loc.stargs = \st -> let attrs = maybe Map.empty id $ Map.lookup st @visits.intramap + in ppSpaced [ let match | str `Set.member` @loc.lazyIntras = pp str + | otherwise = @loc.addbang (pp str) + in case mbAttr of + Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs @lhs.options) -> + case Map.lookup nm @loc.localAttrTypes of + Just tp -> pp_parens (pp_parens match >#< "::" >#< ppTp tp) + Nothing -> match + Just attr | not (noPerStateTypeSigs @lhs.options) -> + case lookupAttrType attr @lhs.allInhmap @lhs.allSynmap @loc.childTypes of + Just tpDoc -> pp_parens (pp_parens match >#< "::" >#< tpDoc) + Nothing -> match + _ -> match + | (str,mbAttr) <- Map.assocs attrs + ] >#< dummyPat @lhs.options (Map.null attrs) + + loc.stks = \st -> if null (@loc.stvisits st) + then empty + else ( if not (noInlinePragmas @lhs.options) && helpInlining @lhs.options + then ppNoInline ("k" >|< st) + else empty + ) + >-< "k" >|< st >#< "::" >#< "K_" >|< @lhs.nt >|< "_s" >|< st >#< @loc.t_params >#< "t" >#< "->" >#< "t" + >-< vlist (map (\(v,f,t) -> "k" >|< st >#< "K_" >|< @lhs.nt >|< "_v" >|< v >#< "=" + >#< "v" >|< v) $ @loc.stvisits st) + loc.stvisits = \st -> filter (\(v,f,t) -> f == st) @visits.allvisits + loc.stvs = \st inlinePragma -> vlist [ppf inlinePragma | (f,ppf) <- @visits.sem_visit, f == st] + visits.mrules = @rules.mrules + +{ +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 +} + +------------------------------------------------------------------------------- +-- Visit semantic functions +------------------------------------------------------------------------------- +ATTR Visit [ | | sem_visit : { (StateIdentifier,Bool -> PP_Doc) } ] +ATTR Visits [ | | sem_visit USE {:} {[]} : { [(StateIdentifier,Bool -> PP_Doc)] } ] + +SEM Visit + | Visit lhs.sem_visit = ( @from + , \addInlinePragma -> + ( if noInlinePragmas @lhs.options + then empty + else if addInlinePragma && aggressiveInlinePragmas @lhs.options + then ppInline @loc.vname + else if helpInlining @lhs.options + then ppNoInline @loc.vname + else empty + ) + >-< "v" >|< @ident >#< "::" >#< @loc.nameT_visit >#< @loc.t_params + + -- generate a lambda here as well instead of a function definition + >-< "v" >|< @ident >#< "=" >#< "\\" >#< (@loc.addbang $ pp_parens (@loc.nameTIn_visit >#< @loc.inhpats)) + >#< ( if dummyTokenVisit @lhs.options + then pp $ dummyPat @lhs.options True -- extra (but unused) argument + else empty + ) + >#< "->" + >#< ( if genCostCentres @lhs.options + then ppCostCentre (@loc.vname >|< "_" >|< @lhs.nt >|< "_" >|< @lhs.con) + else empty + ) >#< "(" >#< @loc.stepsInitial + >-< indent 3 (@steps.sem_steps >-< @loc.stepsClosing >#< ")") + ) + loc.stepsInitial = case @kind of + VisitPure False -> text "let" + VisitPure True -> empty + VisitMonadic -> text "do" + loc.stepsClosing = let decls = @loc.nextStBuild + >-< @loc.addbang (pp resultValName) >#< "=" >#< @loc.resultval + in case @kind of + VisitPure False -> decls + >-< "in" >#< resultValName + VisitPure True -> "let" >#< decls + >-< indent 1 ("in" >#< resultValName) + VisitMonadic -> "let" >#< decls + >-< "return" >#< resultValName + loc.vname = "v" >|< @ident + loc.inhpats = ppSpaced $ map (\arg -> {-@loc.addbang $-} pp $ attrname @lhs.options True _LHS arg) $ Set.toList @inh + loc.inhargs = \chn -> ppSpaced $ map (attrname @lhs.options False chn) $ Set.toList @inh + loc.synargs = ppSpaced $ map (\arg -> attrname @lhs.options False _LHS arg) $ Set.toList @syn + loc.nextargsMp = maybe Map.empty id $ Map.lookup @to @lhs.allintramap + loc.nextargs = ppSpaced $ Map.keys $ @loc.nextargsMp + loc.nextst = "st" >|< @to >#< @loc.nextargs >#< dummyArg @lhs.options (Map.null @loc.nextargsMp) + loc.resultval = @loc.nameTOut_visit >#< @loc.synargs >#< @loc.nextStRef + (loc.nextStBuild, loc.nextStRef) + = case @loc.nextVisitInfo of + NoneVis -> (empty, empty) + _ -> (@loc.addbang (pp nextStName) >#< "=" >#< @loc.nextst, pp nextStName) + +{ +resultValName :: String +resultValName = "__result_" + +nextStName :: String +nextStName = "__st_" +} + +-- Propagate the visit kind to the steps +ATTR VisitStep VisitSteps [ kind : VisitKind | | ] +SEM Visit | Visit steps.kind = @kind + +-- the steps in this group should be executed in a pure fashion +SEM VisitStep | PureGroup + steps.kind = VisitPure @ordered + +ATTR Visits Visit VisitStep VisitSteps [ mrules : {Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)} | | ] +ATTR VisitStep VisitSteps [ | | sem_steps USE {>-<} {empty} : {PP_Doc} ] +SEM VisitStep + | Sem loc.ruleItf = Map.findWithDefault (error $ "Rule " ++ show @name ++ " not found") @name @lhs.mrules + (lhs.errors, loc.sem_steps) = case @loc.ruleItf @lhs.kind @lhs.fmtMode of + Left e -> (Seq.singleton e, empty) + Right stmt -> (Seq.empty, stmt) + | ChildIntro loc.attachItf = Map.findWithDefault (error $ "Child " ++ show @child ++ " not found") @child @lhs.childintros + (lhs.errors,lhs.sem_steps,lhs.defs,lhs.uses) + = case @loc.attachItf @lhs.kind @lhs.fmtMode of + Left e -> (Seq.singleton e, empty, Set.empty, Map.empty) + Right (code, defs, uses) -> (Seq.empty, code, defs, uses) + | ChildVisit loc.visitItf = Map.findWithDefault (error $ "Visit " ++ show @visit ++ " not found") @visit @lhs.allchildvisit + (lhs.errors, loc.patPP, loc.exprPP) = case @loc.visitItf @child @lhs.kind of + Left e -> (Seq.singleton e, empty, empty) + Right (pat,expr) -> (Seq.empty, pat, expr) + + loc.useParallel = @lhs.useParallel && not @lhs.isLast + lhs.sem_steps = if @loc.useParallel -- assumes to be in a monadic do-expression + then @loc.addbang ("sync_" >|< @lhs.index) >#< "<- newEmptyMVar" + >-< "forkIO" >#< pp_parens (@loc.convToMonad >#< pp_parens @loc.exprPP >#< ">>= \\" >#< @loc.addbang (pp parResultName) >#< " -> putMVar sync_" >|< @lhs.index >#< parResultName) -- parResultName is guaranteed to be evaluated + else let decl = case @lhs.kind of + VisitPure _ -> @loc.patPP >#< "=" >#< @loc.exprPP + VisitMonadic -> @loc.patPP >#< "<-" >#< @loc.exprPP + in fmtDecl False @lhs.fmtMode decl + loc.convToMonad = case @loc.callKind of + VisitPure _ -> text "return" + VisitMonadic -> empty + loc.callKind = Map.findWithDefault (error "visit kind should be in the map") @visit @lhs.allVisitKinds + | Sim lhs.sem_steps = @steps.sem_steps >-< @steps.sync_steps + | PureGroup lhs.sem_steps = case @lhs.fmtMode of + FormatDo -> "let" >#< @steps.sem_steps -- formatted as a let-block (not a line-let) + _ -> @steps.sem_steps + +ATTR VisitSteps VisitStep [ | | sync_steps USE {>-<} {empty} : {PP_Doc} ] +SEM VisitStep | ChildVisit + lhs.sync_steps = if @loc.useParallel + then @loc.patPP >#< "<-" >#< "takeMVar sync_" >|< @lhs.index + else empty + +-- The fmtMode indicates in what kind of expression (do/let/line-lets) we are printing +-- declarations, because that determines how we need to wrap declarations +-- Invariant: @lhs.kind == VisitMonadic ---> @lhs.fmtMode == FormatDo +ATTR VisitSteps VisitStep [ fmtMode : FormatMode | | ] +SEM Visit | Visit + steps.fmtMode = case @kind of + VisitPure False -> FormatLetDecl + VisitPure True -> FormatLetLine + VisitMonadic -> FormatDo + +SEM VisitStep | PureGroup + steps.fmtMode = case @lhs.fmtMode of + FormatDo -> FormatLetDecl + mode -> mode + +{ +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 +} + +-- +-- Some properties of VisitStep(s) +-- + +-- Used arguments +ATTR VisitSteps VisitStep Visit Visits EChild EChildren ERule ERules [ | | usedArgs USE {`Set.union`} {Set.empty} : {Set String} ] +SEM ERule + | ERule +usedArgs = Set.union $ Map.keysSet $ Map.mapKeys (\a -> "arg_" ++ a) $ Map.filter isNothing @rhs.attrs + +SEM EChild + | EChild +usedArgs = \s -> case @kind of + ChildSyntax -> Set.insert ("arg_" ++ show @name ++ "_") s + _ -> s + + +-- Number of steps in a 'Sim' block +ATTR VisitSteps [ | | size : Int ] +SEM VisitSteps + | Nil lhs.size = 0 + | Cons lhs.size = 1 + @tl.size + +-- Number the steps in a 'Sim' block +ATTR VisitSteps VisitStep [ | index : Int | ] +SEM VisitSteps | Cons + hd.index = @lhs.index -- copy rule + tl.index = 1 + @lhs.index + lhs.index = @tl.index -- copy rule +SEM Visit | Visit steps.index = 0 +SEM VisitStep | Sim steps.index = 0 + lhs.index = @lhs.index -- needed for if we ever allow nested Sims + +-- Biggest number of steps in previous blocks that used parallel invocation +-- This number - 1 (minimum 0) is the number of references for parallel invocation created +ATTR VisitSteps VisitStep [ | prevMaxSimRefs : Int | ] +SEM Visit | Visit steps.prevMaxSimRefs = 0 +SEM VisitStep | Sim + lhs.prevMaxSimRefs = if @loc.useParallel + then @lhs.prevMaxSimRefs `max` (@steps.index - 1) -- possibly new references made + else @lhs.prevMaxSimRefs -- no references created + +-- Is this the last step? +ATTR VisitSteps VisitStep [ | | isLast : Bool ] +ATTR VisitStep [ isLast : Bool | | ] +SEM VisitSteps + | Nil lhs.isLast = True + | Cons lhs.isLast = False + hd.isLast = @tl.isLast + +-- Use parallel invocation: only when option enabled and there is more than one visit to a child +SEM VisitSteps VisitStep [ useParallel : Bool | | ] +SEM Visit | Visit steps.useParallel = False +SEM VisitStep | Sim loc.useParallel = parallelInvoke @lhs.options && @steps.size > 1 && @loc.isMonadic + loc.isMonadic = case @lhs.kind of + VisitMonadic -> True + _ -> False + + +-- Child introduction +ATTR EChild EChildren [ | | childintros USE {`Map.union`} {Map.empty} : {Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))} ] + +ATTR Visits Visit + VisitSteps VisitStep [ childintros : {Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))} | | ] + +SEM EProduction + | EProduction visits.childintros = @children.childintros + +SEM EChild + | ETerm lhs.childintros = Map.singleton @name (\_ _ -> Right (empty, Set.empty, Map.empty)) + | EChild lhs.childintros = Map.singleton @name @loc.introcode + loc.isDefor = case @tp of + NT _ _ defor -> defor + _ -> False + loc.valcode = case @kind of + ChildSyntax -> "arg_" >|< @name >|< "_" + ChildAttr -> -- decide if we need to invoke the sem-function under the hood + let prefix | not @loc.isDefor = if lateHigherOrderBinding @lhs.options -- && sepsemmods @lhs.options -- when sepsemmods is not enabled, the indirection can be optimized away + then lateSemNtLabel @loc.nt >#< lhsname @lhs.options True idLateBindingAttr + else "sem_" >|< @loc.nt + | otherwise = empty -- no need to intro a terminal + in pp_parens (prefix >#< instname @name) + ChildReplace _ -> -- the higher-order attribute is actually a function that transforms + -- the semantics of the child (always deforested) + pp_parens (instname @name >#< @name >|< "_") + loc.aroundcode = if @hasAround + then locname @lhs.options @name >|< "_around" + else empty + loc.introcode = \kind fmtMode -> + let pat = text $ stname @name @loc.initSt + patStrict = @loc.addbang pat + attach = "attach_T_" >|< @loc.nt >#< pp_parens (@loc.aroundcode >#< @loc.valcode) + runAttach = unMon @lhs.options >#< pp_parens attach + decl = case kind of + VisitPure False -> pat >#< "=" >#< runAttach + VisitPure True -> patStrict >#< "=" >#< runAttach + VisitMonadic -> patStrict >#< "<-" >#< attach + in if compatibleAttach kind @loc.nt @lhs.options + then Right ( fmtDecl False fmtMode decl + , Set.singleton (stname @name @loc.initSt) -- variables defined by the child intro + , case @kind of -- variables used by the child introduction + ChildAttr -> Map.insert (instname @name) Nothing $ -- the sem attr + ( if @loc.isDefor || not (lateHigherOrderBinding @lhs.options) + then id -- the sem dictionary attr is not used + else Map.insert (lhsname @lhs.options True idLateBindingAttr) (Just $ AttrInh _LHS idLateBindingAttr) + ) $ + ( if @hasAround + then Map.insert (locname @lhs.options (@name) ++ "_around") Nothing + else id + ) $ Map.empty + ChildReplace _ -> Map.singleton (instname @name) Nothing -- uses the transformation function + ChildSyntax -> Map.empty + ) + else Left $ IncompatibleAttachKind @name kind + loc.nt = extractNonterminal @tp + +{ +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 +} + +-- rules +ATTR ERules ERule [ | | sem_rules USE {>-<} {empty} : {PP_Doc} + mrules USE {`Map.union`} {Map.empty} : {Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)} ] + +SEM ERule | ERule + lhs.sem_rules = if @loc.used == 0 + then empty + else @loc.rulePragma >-< @loc.rulecode + loc.rulecode = ( if @loc.genpragma + then @loc.pragma -- this additional pragma *may* help to give some AG source location in the presence of + -- type errors in the rule. It will definitely not be precise, and may take some additional + -- source space, but let's see if it's worth it in practice. + else empty + ) + >-< @loc.lambda >#< @loc.scc + >-< indent ((column @rhs.pos - 2) `max` 2) + ( if @loc.genpragma + then @loc.pragma >-< @rhs.semfunc >-< @loc.endpragma + else @rhs.semfunc + ) + loc.rulePragma = ( let reallyInlineStr = "INLINE" + reallyNoInlineStr = "NOINLINE" + in if noInlinePragmas @lhs.options + then empty + else if @loc.used == 1 + then ppPragmaBinding reallyInlineStr @name -- always inline if used exactly once + else if helpInlining @lhs.options + then if not @explicit && @loc.used <= reallyOftenUsedThreshold + then ppPragmaBinding "INLINE[1]" @name -- inline if copy rule + else if @loc.used > ruleInlineThresholdSoft && @explicit -- noinline if it passes the threshold and is not a copy rule + then if @loc.used > ruleInlineThresholdHard + then ppPragmaBinding reallyNoInlineStr @name -- used too often: force ghc not to inline it + else if aggressiveInlinePragmas @lhs.options + then ppPragmaBinding "NOINLINE[2]" @name -- allow inlining but only late in the process + else ppNoInline @name + else if aggressiveInlinePragmas @lhs.options + then ppPragmaBinding "NOINLINE[1]" @name -- otherwise, let GHC decide (but do other inlining first) + else ppNoInline @name + else if not @explicit || @loc.used <= ruleInlineThresholdSoft + then ppPragmaBinding "NOINLINE[1]" @name -- otherwise, let GHC decide (but do other inlining first) + else ppNoInline @name + ) + loc.scc = if genCostCentres @lhs.options && @explicit && @pure && not (noPerRuleCostCentres @lhs.options) + then ppCostCentre (@name >|< "_" >|< line @rhs.pos >|< "_" >|< @lhs.nt >|< "_" >|< @lhs.con) + else empty + loc.pragma = "{-# LINE" >#< show (line @rhs.pos) >#< show (file @rhs.pos) >#< "#-}" + loc.endpragma = ppWithLineNr (\ln -> "{-# LINE " ++ show (ln+1) ++ " " ++ show @lhs.mainFile ++ "#-}") + loc.genpragma = genLinePragmas @lhs.options && @explicit && @loc.haspos + loc.haspos = line @rhs.pos > 0 && column @rhs.pos >= 0 && not (null (file @rhs.pos)) + + -- we generate a simple pattern binding because of overloading-resolving during the type inference process. + -- The types of the rules are not generalized (nor do we want that - rules are used in a single typing-context). + -- If overloading is resolved separately, it may not be clear which dictionaries to use. For that all rules have + -- to be considered together, which is done when we use simple pattern bindings with a lambda expression instead + -- of a function definition. + -- Note: we also ensure that all rules are lambda expressions, so that they are not made part of any closures + -- but are lambda-lifted instead. + loc.lambda = @name >#< "=" >#< "\\" >#< @loc.argPats >#< dummyPat @lhs.options (Map.null @rhs.attrs) >#< "->" + + loc.argPats = ppSpaced [ let match | str `Set.member` @lhs.lazyIntras = pp str + | otherwise = @loc.addbang1 (pp str) + in case mbAttr of + Just (AttrSyn child nm) | child == _LOC && not (noPerStateTypeSigs @lhs.options) -> + case Map.lookup nm @lhs.localAttrTypes of + Just tp -> pp_parens (pp_parens match >#< "::" >#< ppTp tp) + Nothing -> match + Just attr | not (noPerRuleTypeSigs @lhs.options) -> + case lookupAttrType attr @lhs.allInhmap @lhs.allSynmap @lhs.childTypes of + Just tpDoc -> pp_parens (pp_parens match >#< "::" >#< tpDoc) + Nothing -> match + _ -> match + | (str,mbAttr) <- Map.assocs @rhs.attrs + ] + loc.argExprs = ppSpaced [ case mbAttr of + Nothing -> "arg_" >|< str + _ -> text str + | (str,mbAttr) <- Map.assocs @rhs.attrs + ] + loc.stepcode = \kind fmtMode -> if kind `compatibleRule` @pure + then Right $ let oper | @pure = "=" + | otherwise = "<-" + decl = @pattern.sem_lhs >#< oper >#< @name >#< @loc.argExprs >#< dummyArg @lhs.options (Map.null @rhs.attrs) + tp = if @pure && not (noPerRuleTypeSigs @lhs.options) + then @pattern.attrTypes + else empty + in fmtDecl @pure fmtMode (tp >-< decl) + else Left $ IncompatibleRuleKind @name kind + + lhs.mrules = Map.singleton @name @loc.stepcode + +ATTR Expression [ | | tks : {[HsToken]} ] +SEM Expression + | Expression lhs.tks = @tks + +{ +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)" +} + +{ +-- 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 +} + +ATTR Expression [ | | pos : {Pos} ] +SEM Expression | Expression lhs.pos = @pos + +-- pattern and expression semantics +ATTR Pattern [ | | sem_lhs : { PP_Doc } ] +ATTR Patterns [ | | sem_lhs USE {:} {[]} : {[PP_Doc]} ] +ATTR Pattern Patterns [ | | ] + +SEM Pattern + | Alias loc.varPat = text $ attrname @lhs.options False @field @attr + loc.patExpr = if @pat.isUnderscore + then @loc.varPat + else @loc.varPat >|< "@" >|< @pat.sem_lhs + lhs.sem_lhs = @loc.addbang1 @loc.patExpr + | Product lhs.sem_lhs = @loc.addbang1 $ pp_block "(" ")" "," @pats.sem_lhs + | Constr lhs.sem_lhs = @loc.addbang1 $ pp_parens $ @name >#< hv_sp @pats.sem_lhs + | Underscore lhs.sem_lhs = text "_" + | Irrefutable lhs.sem_lhs = text "~" >|< pp_parens @pat.sem_lhs + +-- Check if a pattern is just an underscore +ATTR Pattern [ | | isUnderscore:{Bool}] +SEM Pattern + | Constr lhs.isUnderscore = False + | Product lhs.isUnderscore = False + | Alias lhs.isUnderscore = False + | Underscore lhs.isUnderscore = True + +-- Collect the attributes defined by a pattern +ATTR Pattern Patterns [ | | attrs USE {`Set.union`} {Set.empty} : {Set String} ] +SEM Pattern | Alias + lhs.attrs = Set.insert (attrname @lhs.options False @field @attr) @pat.attrs + +-- All attribute types of this pattern +ATTR Pattern Patterns [ | | attrTypes USE {>-<} {empty} : {PP_Doc} ] +SEM Pattern | Alias + loc.mbTp = if @field == _LHS + then Map.lookup @attr @lhs.synmap + else if @field == _LOC + then Map.lookup @attr @lhs.localAttrTypes + else Nothing + lhs.attrTypes = maybe empty (\tp -> (attrname @lhs.options False @field @attr) >#< "::" >#< ppTp tp) @loc.mbTp + >-< @pat.attrTypes + +-- Collect the attributes used by the right-hand side +ATTR HsToken Expression [ | | attrs USE {`Map.union`} {Map.empty} : {Map String (Maybe NonLocalAttr)} ] +SEM HsToken + | AGLocal lhs.attrs = Map.singleton (fieldname @var) Nothing + | AGField loc.mbAttr = if @field == _INST || @field == _FIELD || @field == _INST' + then Nothing -- should not be used in the first place + else Just $ mkNonLocalAttr (@field == _LHS) @field @attr + lhs.attrs = Map.singleton (attrname @lhs.options True @field @attr) @loc.mbAttr + +{ +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 +} + +ATTR Expression [ | | semfunc : {PP_Doc} ] + +SEM Expression + | Expression lhs.attrs = Map.unions $ map (\tok -> attrs_Syn_HsToken (wrap_HsToken (sem_HsToken tok) @loc.inhhstoken)) @tks + lhs.semfunc = vlist $ showTokens $ map (\tok -> tok_Syn_HsToken (wrap_HsToken (sem_HsToken tok) @loc.inhhstoken)) @tks + loc.inhhstoken = Inh_HsToken @lhs.options + +-- child visit map +ATTR Visit + Visits + EProduction + EProductions + ENonterminal + ENonterminals [ allchildvisit : {Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))} + | | childvisit USE {`Map.union`} {Map.empty} : {Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))} ] + +ATTR VisitSteps VisitStep [ allchildvisit : {Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))} | | ] + +SEM ExecutionPlan + | ExecutionPlan nonts.allchildvisit = @nonts.childvisit + +SEM Visit + | Visit + loc.prevVisitInfo = Map.findWithDefault ManyVis @from @lhs.nextVisits + lhs.childvisit = Map.singleton @ident @loc.invokecode + loc.invokecode = \chn kind -> -- "chn" is the name of the child at the place of invocation, and "kind" the kind of the calling visit + if kind `compatibleKind` @kind + then Right $ + let pat | isLazyKind @kind = pat0 + | otherwise = @loc.addbang pat0 + pat0 = pp_parens pat1 + pat1 = @loc.nameTOut_visit >#< (ppSpaced $ map (attrname @lhs.options True chn) $ Set.toList @syn) + >#< cont + cont = case @loc.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 @lhs.options >#< expr0 + (VisitMonadic, VisitPure _) -> "return" >#< expr0 + (VisitMonadic, VisitMonadic) -> expr0 + expr0 = case @loc.prevVisitInfo of + NoneVis -> error "error: invocation of a visit from a state that has no next visits" + OneVis _ -> "inv_" >|< @lhs.nt >|< "_s" >|< @from >#< ch0 >#< args + ManyVis -> "inv_" >|< @lhs.nt >|< "_s" >|< @from >#< ch0 + >#< "K_" >|< @lhs.nt >|< "_v" >|< @ident >#< args + args = pp_parens args0 >#< args1 + args0 = @loc.nameTIn_visit >#< @loc.inhargs chn + args1 | dummyTokenVisit @lhs.options = pp $ dummyArg @lhs.options True + | otherwise = empty + in (pat, expr) -- pretty print of the pattern and the expression part + else Left $ IncompatibleVisitKind chn @ident kind @kind + +{ +-- 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 +} + +------------------------------------------------------------------------------- +-- Properties of rules +------------------------------------------------------------------------------- + +-- Construct an environment that counts how often certain rules are used +ATTR Visits Visit VisitSteps VisitStep [ | | ruleUsage USE {`unionWithSum`} {Map.empty} : {Map Identifier Int} ] +ATTR ERules ERule [ usageInfo : {Map Identifier Int} | | ] + +SEM EProduction | EProduction rules.usageInfo = @visits.ruleUsage +SEM VisitStep | Sem lhs.ruleUsage = Map.singleton @name 1 +SEM ERule | ERule loc.used = Map.findWithDefault 0 @name @lhs.usageInfo + +{ +unionWithSum = Map.unionWith (+) +} + +-- Collect in what visit-kinds a rule is used +ATTR Visits Visit VisitSteps VisitStep [ | | ruleKinds USE {`unionWithMappend`} {Map.empty} : {Map Identifier (Set VisitKind)} ] +SEM VisitStep | Sem + lhs.ruleKinds = Map.singleton @name (Set.singleton @lhs.kind) + +ATTR ERules ERule [ ruleKinds : {Map Identifier (Set VisitKind)} | | ] +SEM EProduction | EProduction + rules.ruleKinds = @visits.ruleKinds + +SEM ERule | ERule + loc.kinds = Map.findWithDefault Set.empty @name @lhs.ruleKinds + loc.anyLazyKind = Set.fold (\k r -> isLazyKind k || r) False @loc.kinds + +ATTR Pattern Patterns [ anyLazyKind : Bool | | ] + + +------------------------------------------------------------------------------- +-- Intra attributes +------------------------------------------------------------------------------- +{ +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 +} +ATTR Visit Visits [ allintramap : {Map StateIdentifier (Map String (Maybe NonLocalAttr))} + | | intramap USE {`uwMapUnion`} {Map.empty} : {Map StateIdentifier (Map String (Maybe NonLocalAttr))} ] + +ATTR Visit Visits [ terminaldefs : {Set String} | | ] +ATTR EChild EChildren [ | | terminaldefs USE {`Set.union`} {Set.empty} : {Set String} ] + +SEM EChild | ETerm + lhs.terminaldefs = Set.singleton $ fieldname @name + +SEM EProduction | EProduction + visits.allintramap = @visits.intramap + visits.terminaldefs = @children.terminaldefs + +SEM Visit + | Visit loc.thisintra = (@loc.uses `Map.union` @loc.nextintra) `Map.difference` @loc.defsAsMap + lhs.intramap = Map.singleton @from @loc.thisintra + loc.nextintra = maybe Map.empty id $ Map.lookup @to @lhs.allintramap + loc.uses = let mp1 = @steps.uses + mp2 = Map.fromList [ (lhsname @lhs.options False i, Just (AttrSyn _LHS i)) | i <- Set.elems @syn ] + in mp1 `Map.union` mp2 + loc.inhVarNms = Set.map (lhsname @lhs.options True) @inh + loc.defs = @steps.defs `Set.union` @loc.inhVarNms `Set.union` @lhs.terminaldefs + loc.defsAsMap = Map.fromList [ (a, Nothing) | a <- Set.elems @loc.defs ] + +ATTR ERule ERules [ | | ruledefs USE {`uwSetUnion`} {Map.empty} : {Map Identifier (Set String)} + ruleuses USE {`uwMapUnion`} {Map.empty} : {Map Identifier (Map String (Maybe NonLocalAttr))} ] +ATTR Visit Visits + VisitSteps VisitStep [ ruledefs : {Map Identifier (Set String)} + ruleuses : {Map Identifier (Map String (Maybe NonLocalAttr))} | | ] + +SEM ERule + | ERule lhs.ruledefs = Map.singleton @name @pattern.attrs + lhs.ruleuses = Map.singleton @name @rhs.attrs + +SEM EProduction + | EProduction visits.ruledefs = @rules.ruledefs + visits.ruleuses = @rules.ruleuses + +ATTR Visit Visits + EProduction + EProductions + ENonterminal + ENonterminals [ | | visitdefs USE {`uwSetUnion`} {Map.empty} : {Map VisitIdentifier (Set Identifier)} + visituses USE {`uwSetUnion`} {Map.empty} : {Map VisitIdentifier (Set Identifier)} ] + +SEM Visit + | Visit lhs.visitdefs = Map.singleton @ident @syn + lhs.visituses = Map.singleton @ident @inh + +ATTR Visit Visits + VisitSteps VisitStep + EProduction EProductions + ENonterminal ENonterminals [ avisitdefs : {Map VisitIdentifier (Set Identifier)} + avisituses : {Map VisitIdentifier (Set Identifier)} | | ] + +SEM ExecutionPlan + | ExecutionPlan nonts.avisitdefs = @nonts.visitdefs + nonts.avisituses = @nonts.visituses + +ATTR VisitSteps VisitStep [ | | defs USE {`Set.union`} {Set.empty} : {Set String} + uses USE {`Map.union`} {Map.empty} : {Map String (Maybe NonLocalAttr)} ] +SEM VisitStep + | Sem lhs.defs = maybe (error "Rule not found") id $ Map.lookup @name @lhs.ruledefs + lhs.uses = maybe (error "Rule not found") id $ Map.lookup @name @lhs.ruleuses + | ChildVisit lhs.defs = Set.insert (stname @child @to) $ maybe (error "Visit not found") (Set.map $ attrname @lhs.options True @child) $ Map.lookup @visit @lhs.avisitdefs + lhs.uses = let convert attrs = Map.fromList [ (attrname @lhs.options 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 @lhs.avisituses + +------------------------------------------------------------------------------- +-- Identification of lazy intra defs within a production +-- +-- These identifiers will not be marked as strict in rules and state closures +------------------------------------------------------------------------------- + +ATTR Visits Visit VisitSteps VisitStep [ | | lazyIntras USE {`Set.union`} {Set.empty} : {Set String} ] +ATTR ERules ERule [ lazyIntras : {Set String} | | ] + +SEM Visit | Visit + loc.lazyIntrasInh = case @kind of + VisitPure False -> @loc.inhVarNms `Set.union` @steps.defs + _ -> Set.empty + lhs.lazyIntras = @loc.lazyIntrasInh `Set.union` @steps.lazyIntras + +SEM VisitStep | PureGroup + lhs.lazyIntras = if @ordered + then @steps.lazyIntras + else @steps.defs + +SEM EProduction | EProduction + loc.lazyIntras = @visits.lazyIntras + +------------------------------------------------------------------------------- +-- Pretty printing of haskell code +------------------------------------------------------------------------------- + +SEM HsTokens [ || tks : {[(Pos,String)]} ] + | Cons lhs.tks = @hd.tok : @tl.tks + | Nil lhs.tks = [] + +SEM HsToken + | AGLocal loc.tok = (@pos,fieldname @var) + +SEM HsToken [ || tok:{(Pos,String)}] + | AGField + loc.addTrace = case @rdesc of + Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show @field ++ "." ++ show @attr) ++ " (" ++ x ++ "))" + Nothing -> id + lhs.tok = (@pos, @loc.addTrace $ attrname @lhs.options True @field @attr) + + | HsToken lhs.tok = (@pos, @value) + + | CharToken lhs.tok = (@pos, if null @value + then "" + else showCharShort (head @value) + ) + + | StrToken lhs.tok = (@pos, showStrShort @value) + | Err lhs.tok = (@pos, "") + +------------------------------------------------------------------------------- +-- Alternative code generation (sepsemmods) +------------------------------------------------------------------------------- + +ATTR ExecutionPlan [ mainBlocksDoc : PP_Doc textBlockMap : {Map BlockInfo PP_Doc} + | | genIO : {IO ()} ] + +SEM ExecutionPlan + | ExecutionPlan lhs.genIO = do @loc.genMainModule + @loc.genCommonModule + @nonts.genProdIO + loc.mainModuleFile = @lhs.mainFile + loc.ppMonadImports = ( if tupleAsDummyToken @lhs.options + then empty + else pp "import GHC.Prim" + ) + >-< if parallelInvoke @lhs.options + 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" + loc.genMainModule = writeModule @loc.mainModuleFile + ( [ warrenFlagsPP @lhs.options + , pp $ @lhs.pragmaBlocks + , pp $ @lhs.moduleHeader @lhs.mainName "" "" False + , @loc.ppMonadImports + , pp $ "import " ++ @lhs.mainName ++ "_common" + ] + ++ @nonts.imports + ++ [@lhs.mainBlocksDoc] + ++ [@loc.wrappersExtra] + ++ @nonts.appendMain + ) + loc.commonFile = replaceBaseName @lhs.mainFile (takeBaseName @lhs.mainFile ++ "_common") + loc.genCommonModule = writeModule @loc.commonFile + ( [ pp $ "{-# LANGUAGE Rank2Types, GADTs #-}" -- the common module only needs GADTs and Rank2Types + , pp $ @lhs.pragmaBlocks + , pp $ @lhs.moduleHeader @lhs.mainName "_common" "" True + , @loc.ppMonadImports + , @lhs.importBlocks + , @lhs.textBlocks + , @loc.commonExtra + ] + ++ @nonts.appendCommon + ) + +ATTR ENonterminal [ | | appendCommon, appendMain : { PP_Doc } ] +ATTR ENonterminals [ | | appendCommon, appendMain USE {:} {[]} : {[PP_Doc]} ] + +SEM ENonterminal + | ENonterminal lhs.appendMain = (if @nt `Set.member` @lhs.wrappers + then @loc.wr_inh + >-< @loc.wr_syn + >-< @loc.wrapper + else empty) + >-< @loc.sem_nt + lhs.appendCommon = (if dataTypes @lhs.options then @loc.datatype else empty) + >-< @loc.t_init + >-< @loc.t_states + >-< @loc.k_states + >-< @prods.t_visits + +ATTR EProduction EProductions + ENonterminal ENonterminals [ | | imports USE {++} {[]} : {[PP_Doc]} + genProdIO USE {>>} {return ()} : {IO ()} ] + +SEM EProduction + | EProduction lhs.imports = [pp $ "import " ++ @loc.moduleName] + loc.moduleName = @lhs.mainName ++ @loc.suffix + loc.suffix = "_" ++ show @lhs.nt ++ "_" ++ show @con + loc.outputfile = replaceBaseName @lhs.mainFile (takeBaseName @lhs.mainFile ++ @loc.suffix) + loc.ppMonadImports = if parallelInvoke @lhs.options + 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" + lhs.genProdIO = writeModule @loc.outputfile + [ warrenFlagsPP @lhs.options + , pp $ @lhs.pragmaBlocks + , pp $ @lhs.moduleHeader @lhs.mainName @loc.suffix @loc.semname True + , @lhs.importBlocks + , @loc.ppMonadImports + , ( if tupleAsDummyToken @lhs.options + then empty + else pp "import GHC.Prim" -- need it to pass State# + ) + , pp $ "import " ++ @lhs.mainName ++ "_common" + , @loc.sem_prod + ] + +{ +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 +} + + +-- +-- Bang pattern usage +-- + +SEM ERule | ERule loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x +SEM Visit | Visit loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x +SEM ENonterminal | ENonterminal loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x +SEM EProduction | EProduction loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x +SEM EChild | EChild loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x +SEM EChild | ETerm loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x +SEM VisitStep | ChildVisit loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x +SEM Pattern | Alias Constr Product loc.addbang = \x -> if bangpats @lhs.options then "!" >|< x else x + +SEM Visit | Visit loc.addbang1 = if isLazyKind @kind then id else @loc.addbang +SEM ENonterminal | ENonterminal loc.addbangWrap = id --if strictWrap @lhs.options then @loc.addbang else id +SEM ERule | ERule loc.addbang1 = if @loc.anyLazyKind then id else @loc.addbang +SEM Pattern | Alias Constr Product loc.addbang1 = if @lhs.anyLazyKind then id else @loc.addbang + +-- +-- Distribute single-visit-next map downward +-- + +ATTR EProductions EProduction Visits Visit + [ prevVisits, nextVisits : {Map StateIdentifier StateCtx} | | ] + +SEM ENonterminal | ENonterminal + prods.nextVisits = @nextVisits + prods.prevVisits = @prevVisits + +-- +-- Collect and distribute the from/to states of a visit +-- + +ATTR ENonterminals ENonterminal EProductions EProduction Visits Visit + [ | | fromToStates USE {`mappend`} {mempty} : {Map VisitIdentifier (Int,Int)} ] + +ATTR ENonterminals ENonterminal EProductions EProduction Visits Visit VisitSteps VisitStep + [ allFromToStates : {Map VisitIdentifier (Int,Int)} | | ] + +SEM Visit | Visit + lhs.fromToStates = Map.singleton @ident (@from, @to) + +SEM ExecutionPlan | ExecutionPlan + nonts.allFromToStates = @nonts.fromToStates + +SEM VisitStep | ChildVisit + (loc.from, loc.to) = Map.findWithDefault (error "visit not in allFromToStates") @visit @lhs.allFromToStates + + +-- +-- Collect and distribute the actual types of children of productions +-- + +ATTR EChildren EChild [ | | childTypes USE {`mappend`} {mempty} : {Map Identifier Type} ] +ATTR ERules ERule Visits Visit VisitSteps VisitStep [ childTypes : {Map Identifier Type} | | ] + +SEM EProduction | EProduction + loc.childTypes = Map.singleton _LHS @lhs.ntType `Map.union` @children.childTypes + +SEM EChild | EChild ETerm + lhs.childTypes = Map.singleton @name @tp + +-- +-- Distribute types of local attributes +-- + +ATTR ExecutionPlan ENonterminals ENonterminal [ localAttrTypes : {Map NontermIdent (Map ConstructorIdent (Map Identifier Type))} | | ] +ATTR EProductions EProduction [ localAttrTypes : {Map ConstructorIdent (Map Identifier Type)} | | ] +ATTR ERules ERule Pattern Patterns [ localAttrTypes : {Map Identifier Type} | | ] + +SEM ENonterminal | ENonterminal + prods.localAttrTypes = Map.findWithDefault Map.empty @nt @lhs.localAttrTypes + +SEM EProduction | EProduction + loc.localAttrTypes = Map.findWithDefault Map.empty @con @lhs.localAttrTypes + +-- +-- Collect and distribute visit kinds +-- + +ATTR ENonterminals ENonterminal EProductions EProduction Visits Visit VisitSteps VisitStep + [ allVisitKinds : {Map VisitIdentifier VisitKind} | | visitKinds USE {`mappend`} {mempty} : {Map VisitIdentifier VisitKind} ] + +SEM Visit | Visit + lhs.visitKinds = Map.singleton @ident @kind + +SEM ExecutionPlan | ExecutionPlan + nonts.allVisitKinds = @nonts.visitKinds + +-- +-- Collect and distribute the initial state of nonterminals +-- + +ATTR ENonterminals ENonterminal [ | | initStates USE {`mappend`} {mempty} : {Map NontermIdent Int} ] +ATTR ENonterminals ENonterminal EProductions EProduction EChildren EChild Visits Visit VisitSteps VisitStep + [ allInitStates : {Map NontermIdent Int} | | ] + +SEM ENonterminal | ENonterminal + lhs.initStates = Map.singleton @nt @initial + +SEM ExecutionPlan | ExecutionPlan + nonts.allInitStates = @nonts.initStates + +SEM EChild | EChild + loc.initSt = Map.findWithDefault (error "nonterminal not in allInitStates map") @loc.nt @lhs.allInitStates + +-- +-- Push the nonterminal type downward +-- + +ATTR EProductions EProduction [ ntType : Type | | ] +SEM ENonterminal | ENonterminal + loc.ntType = NT @nt (map show @params) False + +-- +-- Collect errors contained in rules that should be yielded when the +-- rules are scheduled. +-- + +ATTR ExecutionPlan ENonterminals ENonterminal EProductions EProduction ERules ERule Visits Visit VisitSteps VisitStep [ | | errors USE {Seq.><} {Seq.empty} : {Seq Error} ] +SEM ERule | ERule + lhs.errors = case @mbError of + Just e | @loc.used > 0 -> Seq.singleton e + _ -> Seq.empty + + +-- Some pretty printing utility functions +{ +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 + ] +}
src-ag/ExecutionPlanCommon.ag view
@@ -141,13 +141,13 @@ ------------------------------------------------------------------------------- ATTR Grammar Nonterminals [ | | inhmap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent Attributes} - synmap 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} ] + synmap : {Map.Map NontermIdent Attributes} ] SEM Nonterminal | Nonterminal lhs.inhmap = Map.singleton @nt @inh - lhs.synmap = Map.singleton @nt @syn + lhs.synmap = Map.singleton @nt @syn ------------------------------------------------------------------------------- -- Output nonterminal type mappings
src-ag/ExecutionPlanPre.ag view
@@ -10,6 +10,6 @@ SEM Rule | Rule lhs.rulenumber = @lhs.rulenumber + 1 - loc.rulename = maybe (identifier $ "rule" ++ show @lhs.rulenumber) id @mbName + loc.rulename = maybe (identifier $ "rule" ++ show @lhs.rulenumber) id @mbName
+ src-ag/Expression.ag view
@@ -0,0 +1,12 @@+imports +{ +import UU.Scanner.Position(Pos) +import HsToken +} + +DATA Expression + | Expression pos:{Pos} + tks:{[HsToken]} + +SET AllExpression + = Expression
+ src-ag/GenerateCode.ag view
@@ -0,0 +1,1191 @@+PRAGMA strictwrap +PRAGMA strictdata + +INCLUDE "CodeSyntax.ag" +INCLUDE "Patterns.ag" +INCLUDE "DeclBlocks.ag" + +imports +{ +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) + +} + + +------------------------------------------------------------------------------- +-- Options +------------------------------------------------------------------------------- + +ATTR CNonterminals CNonterminal + CProductions CProduction + CVisits CVisit + Sequence CRule + CInterface CSegments CSegment + [ o_unbox,o_sig,o_sem,o_newtypes,o_case,o_pretty,o_rename,o_cata,o_strictwrap,o_splitsems,o_traces,o_costcentre,o_linePragmas,o_monadic,o_clean : Bool + o_data : {Maybe Bool} + prefix : String + options : Options + | | ] +SEM CGrammar [ options : Options | | ] + | CGrammar nonts.o_sig = typeSigs @lhs.options + .o_cata = folds @lhs.options + .o_sem = semfuns @lhs.options + .o_newtypes = newtypes @lhs.options + .o_unbox = unbox @lhs.options + .o_case = cases @lhs.options + .o_pretty = attrInfo @lhs.options + .o_rename = rename @lhs.options + .o_strictwrap = strictWrap @lhs.options + .o_splitsems = splitSems @lhs.options + .o_data = if dataTypes @lhs.options then Just (strictData @lhs.options) else Nothing + .prefix = prefix @lhs.options + .o_traces = genTraces @lhs.options + .o_costcentre = genCostCentres @lhs.options + .o_linePragmas = genLinePragmas @lhs.options + .o_monadic = monadic @lhs.options + .o_clean = clean @lhs.options + +SEM CGrammar | CGrammar + loc.options = @lhs.options { breadthFirst = breadthFirst @lhs.options && visit @lhs.options && cases @lhs.options && @multivisit } + +ATTR CNonterminals CNonterminal CProductions CProduction CVisits CVisit [ allPragmas : PragmaMap | | ] + +SEM CGrammar + | CGrammar nonts.allPragmas = @pragmas + +------------------------------------------------------------------------------- +-- Passing information about nonterminal and constructor down +------------------------------------------------------------------------------- + +ATTR CProductions CProduction CVisits + CVisit Sequence CRule CInterface + CSegments CSegment [ nt:NontermIdent inh,syn:Attributes | | ] +SEM CNonterminal + | CNonterminal inter.(inh,syn,nt) = (@inh,@syn,@nt) + prods.(inh,syn,nt) = (@inh,@syn,@nt) + +ATTR CVisits CVisit Sequence CRule [ con:ConstructorIdent + terminals : {[Identifier]} | | ] +SEM CProduction + | CProduction visits.con = @con + visits.terminals = @terminals + +ATTR CNonterminals CNonterminal CSegments CSegment CInterface CProductions CProduction CVisits CVisit Sequence CRule [ paramMap : ParamMap | | ] + +SEM CGrammar + | CGrammar nonts.paramMap = @paramMap + + +ATTR CVisits CVisit Sequence CRule [ paramInstMap : {Map Identifier (NontermIdent, [String])} | | ] + +SEM CProduction + | CProduction + loc.paramInstMap = Map.fromList [(nm, (extractNonterminal tp, tps)) | (nm,tp,_) <- @children, let tps = map (cleanupArg @lhs.options) $ nontermArgs tp, not (null tps) ] + +{ +-- 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" +} + +ATTR CNonterminals CNonterminal CProductions CProduction CVisits CVisit [ contextMap : {ContextMap} quantMap : QuantMap | | ] + +SEM CGrammar + | CGrammar + nonts.contextMap = @contextMap + nonts.quantMap = @quantMap + +{ +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 +} + +ATTR CNonterminals CNonterminal CProductions CProduction CVisits CVisit Sequence CRule [ allNts : {Set NontermIdent} | | ] + +SEM CGrammar + | CGrammar + nonts.allNts = @nonts.gathNts + +ATTR CNonterminals CNonterminal [ | | gathNts USE {`Set.union`} {Set.empty} : {Set NontermIdent} ] + +SEM CNonterminal + | CNonterminal + lhs.gathNts = Set.singleton @nt + +-- keep track of which children have had their first visit +ATTR CVisits CVisit Sequence CRule [ | visitedSet : {Set Identifier} | ] +SEM CProduction | CProduction visits.visitedSet = Set.empty +SEM CRule | CChildVisit loc.visitedSet = Set.insert @name @lhs.visitedSet + +------------------------------------------------------------------------------- +-- Generating declarations from the sequence. We generate the origin +-- comment if pretty printing is requested. A childvisit takes inherited +-- attributes and returns synthesized attributes and the next visit. +------------------------------------------------------------------------------- + +ATTR Sequence CRule [ | | decls USE {++} {[]} : {Decls} ] +SEM CRule + | CRule loc.instTypes = [ (n, (t, mb, for)) | (n, NT t _ for, mb) <- @lhs.children ] + loc.originComment = if @lhs.o_pretty + then (Comment @origin:) + else id + loc.instDecls = [ mkDecl @lhs.o_monadic (Pattern3 (Alias _INST' inst (Underscore (getPos inst)))) + ( let (nm,mb,defor) = fromJust $ inst `lookup` @loc.instTypes + in unwrapSem @lhs.o_newtypes nm + $ case mb of + ChildReplace _ -> App instLocFieldName [SimpleExpr $ fieldname inst] + _ -> + if defor + then SimpleExpr instLocFieldName + else App (cataname @lhs.prefix nm) + [SimpleExpr instLocFieldName] + ) + (Set.singleton instSemFieldName) + (Set.singleton instLocFieldName) + | inst <- @loc.definedInsts + , let instLocFieldName = attrname @lhs.options True _INST inst + instSemFieldName = attrname @lhs.options False _INST' inst + ] + loc.patDescr = if @isIn + then "_" + else concat $ intersperse "," (map (\(f,a) -> show f ++ "." ++ show a) @pattern.patternAttributes) + loc.traceDescr = (maybe "" (\nm -> show nm ++ ":") @mbNamed) ++ show @nt ++ " :: " ++ show @con ++ " :: " ++ @loc.patDescr + + loc.addTrace = \v -> if @lhs.o_traces + then Trace @loc.traceDescr v + else v + loc.costCentreDescr = show @nt ++ ":" ++ show @con ++ ":" ++ @loc.patDescr + loc.addCostCentre = \v -> if @lhs.o_costcentre + then PragmaExpr True False ("SCC \"" ++ @loc.costCentreDescr ++ "\"") v + else v + loc.addLinePragma = \v -> let p = getPos @name + hasPos = line p > 0 && column p >= 0 && not (null (file p)) + in if @lhs.o_linePragmas && hasPos + then PragmaExpr True True ("LINE " ++ show (line p) ++ " " ++ show (file p)) + $ LineExpr + $ v + else v + loc.decls = if @hasCode + then @originComment ( mkDecl (@lhs.o_monadic && @explicit) (Pattern3 @pattern.copy) (@loc.addTrace $ @loc.addCostCentre $ @loc.addLinePragma $ (TextExpr @rhs)) + (Set.fromList [attrname @lhs.options False fld nm | (fld,nm,_) <- Map.elems @defines]) + (Set.fromList [attrname @lhs.options True fld nm | (fld,nm) <- Set.toList @uses]) + : @loc.instDecls) + else @loc.instDecls + | CChildVisit loc.costCentreDescr = show @lhs.nt ++ ":" ++ show @lhs.con ++ ":" ++ show @name ++ ":" ++ show @nt ++ ":" ++ show @nr + loc.addCostCentre = \v -> if @lhs.o_costcentre + then PragmaExpr True False ("SCC \"" ++ @loc.costCentreDescr ++ "\"") v + else v + loc.decls = let lhsVars = map (attrname @lhs.options True @name) (Map.keys @syn) + ++ if @isLast then [] else [unwrap ++ funname @name (@nr+1)] + rhsVars = map (attrname @lhs.options False @name) (Map.keys @inh) + unwrap = if @lhs.o_newtypes then typeName @nt (@nr + 1) ++ " " else "" + tuple | isMerging = TupleLhs [locname @lhs.options @name ++ "_comp"] + | otherwise = mkTupleLhs @lhs.o_unbox (null $ Map.keys @inh) lhsVars + rhs = @loc.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 + ChildReplace _ -> True + _ -> False + | otherwise = isVirtual nm r + isMerged = @name `Map.member` @lhs.mergeMap + isMerging = @name `elem` concatMap (\(_,cs) -> cs) (Map.elems @lhs.mergeMap) + merges = [ (c,cs) | (c,(_,cs)) <- Map.assocs @lhs.mergeMap, all (`Set.member` @loc.visitedSet) cs, @name `elem` (c:cs) ] + + baseNm = if @nr == 0 && isVirtual @name @lhs.children + then Ident (getName @name ++ "_inst") (getPos @name) + else @name + fun | @nr == 0 && Set.member @name @lhs.aroundMap + = locname @lhs.options @name ++ "_around " ++ funname baseNm 0 + | otherwise = funname baseNm @nr + outDecls | isMerged = [] -- merged variant is only produced after the last visit of the merged children + | otherwise = -- [mkDecl @lhs.o_monadic tuple rhs (Set.fromList lhsVars) (Set.fromList (funname baseNm @nr : rhsVars))] + if isMerging + then [mkDecl @lhs.o_monadic tuple rhs Set.empty Set.empty] + else [Resume @lhs.o_monadic (typeName @nt @nr) tuple rhs] + outMerged | null merges || @nr /= 0 = [] -- no merged child to produce + | otherwise = let (c,cs) = head merges + tuple' = mkTupleLhs @lhs.o_unbox (null $ Map.keys @inh) lhsVars' + lhsVars' = map (attrname @lhs.options True c) (Map.keys @syn) + ++ if @isLast then [] else [unwrap ++ funname c (@nr+1)] + rhsVars' = [ locname @lhs.options c' ++ "_comp" | c' <- cs ] + fun' = locname @lhs.options c ++ "_merge" + rhs' = App fun' (map SimpleExpr rhsVars') + in [Resume @lhs.o_monadic (typeName @nt @nr) tuple' rhs'] + in -- trace (show @name ++ " # " ++ show @loc.visitedSet ++ " # " ++ show (Map.assocs @lhs.mergeMap) ++ " # " ++ show merges ++ " # " ++ show @nr ++ " # " ++ show (length outMerged)) $ + (outDecls ++ outMerged) + +{ +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" +} + +ATTR Sequence CRule [ children : {[(Identifier,Type,ChildKind)]} ||] + +ATTR Sequence CRule Pattern Patterns [|| definedInsts USE {++} {[]} : {[Identifier]} ] +SEM Pattern + | Alias lhs.definedInsts = (if @field == _INST then [@attr] else []) ++ @pat.definedInsts + +SEM CRule + | CRule loc.definedInsts = if @isIn then [] else @pattern.definedInsts + +ATTR Pattern Patterns [ | | patternAttributes USE {++} {[]} : {[(Identifier, Identifier)]} ] +SEM Pattern + | Alias + lhs.patternAttributes = (@field,@attr) : @pat.patternAttributes + +------------------------------------------------------------------------------- +-- Numbering the visits +------------------------------------------------------------------------------- + +ATTR CVisits CVisit Sequence CRule + CSegments CSegment [ nr : Int | | ] +SEM CProduction + | CProduction visits.nr = 0 +SEM CVisits + | Cons tl.nr = @lhs.nr + 1 +SEM CInterface + | CInterface seg.nr = 0 +SEM CSegments + | Cons tl.nr = @lhs.nr + 1 + +------------------------------------------------------------------------------- +-- Checking last visit +------------------------------------------------------------------------------- + +ATTR CVisit CSegment [ isLast : Bool | | ] +ATTR CVisits CSegments [ | | isNil : Bool ] +SEM CVisits + | Cons lhs.isNil = False + hd.isLast = @tl.isNil + | Nil lhs.isNil = True +SEM CSegments + | Cons lhs.isNil = False + hd.isLast = @tl.isNil + | Nil lhs.isNil = True + +------------------------------------------------------------------------------- +-- Getting the next intra-visit dependencies +------------------------------------------------------------------------------- + +ATTR CVisit [ nextIntra : {Exprs} nextIntraVars : {Set String} | | ] +ATTR CVisits CVisit [ | | intra : {Exprs} intraVars : {Set String} ] +SEM CVisit + | CVisit lhs.intra = @intra.exprs + lhs.intraVars = @intra.usedVars +SEM CVisits + | Cons hd.nextIntra = @tl.intra + hd.nextIntraVars = @tl.intraVars + lhs.intra = @hd.intra + lhs.intraVars = @hd.intraVars + | Nil lhs.intra = [] + lhs.intraVars = Set.empty + +------------------------------------------------------------------------------- +-- Superfluous intra-visit dependencies due to higher-order children +-- (higher-order children can only be passed from their moment of creation) +------------------------------------------------------------------------------- + +SEM CRule + | CChildVisit + loc.isSuperfluousHigherOrderIntra + = @lhs.nr <= Map.findWithDefault (-1) @name @lhs.instVisitNrs + +------------------------------------------------------------------------------- +-- Intra-visit dependencies are expressions that need to be passed +------------------------------------------------------------------------------- + +ATTR Sequence CRule [ | | exprs USE {++} {[]} : {Exprs} ] +SEM CRule + | CRule loc.rulename = if @field == _LOC && @name `elem` @lhs.terminals + then funname @name 0 + else attrname @lhs.options @isIn @field @name + lhs.exprs = [SimpleExpr @loc.rulename] + | CChildVisit + loc.names = -- do not pass inst-childs as parameter if they are not defined yet + if @loc.isSuperfluousHigherOrderIntra + then [] + else [funname @name (@nr+1)] + lhs.exprs = let wrap = if @lhs.o_newtypes then \x -> App (typeName @nt (@nr + 1)) [x] else id + + addType expr | null @loc.instParams = expr + | otherwise = TypedExpr expr (@lhs.unfoldSemDom @nt (@nr+1) @loc.instParams) + + in map (wrap . addType . SimpleExpr) @loc.names + +ATTR Sequence CRule [ | | usedVars USE {`Set.union`} {Set.empty} : {Set String} ] +SEM CRule + | CRule + lhs.usedVars = Set.singleton @loc.rulename + | CChildVisit + lhs.usedVars = Set.fromList @loc.names + +------------------------------------------------------------------------------- +-- Type signatures are added to the declarations. +------------------------------------------------------------------------------- + +ATTR Sequence CRule [ | | tSigs USE {++} {[]} : {[Decl]} ] +SEM CRule + | CRule loc.mkTp = typeToCodeType (Just @lhs.nt) @loc.orgParams + lhs.tSigs = [ TSig (attrname @lhs.options False field attr) tp' + | (field,attr,tp) <- Map.elems @defines, isJust tp + , let tp1 = @loc.evalTp field $ @mkTp (fromJust tp) + tp' = case findOrigType attr @lhs.children of + Just tp' -> let tp'' = case tp' of + NT n params b -> NT (Ident ("T_" ++ show n) (getPos n)) params b + _ -> tp' + tp2 = @loc.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 + ] + + loc.orgParams = map getName $ Map.findWithDefault [] @lhs.nt @lhs.paramMap + loc.evalTp = + \field tp -> let orgFldParams = map getName $ Map.findWithDefault [] childNt @lhs.paramMap + (childNt,instParams) = Map.findWithDefault (@lhs.nt,[]) field @lhs.paramInstMap + 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 @lhs.options tp + else evalType @lhs.options replace tp + + | CChildVisit loc.mkTp = @loc.evalTp . typeToCodeType (Just @nt) @loc.orgParams + loc.definedTps = [ TSig (attrname @lhs.options True @name a) (@mkTp tp) | (a,tp) <- Map.toList @syn ] + loc.nextTp = typeName @nt (@nr+1) + lhs.tSigs = (if @isLast then id else (TSig (funname @name (@nr+1)) (TypeApp (SimpleType @nextTp) (map SimpleType @loc.instParams)) :)) @definedTps + + loc.orgParams = map getName $ Map.findWithDefault [] @nt @lhs.paramMap + loc.instParams = snd $ Map.findWithDefault (@nt,[]) @name @lhs.paramInstMap + loc.replParamMap = Map.fromList (zip @loc.orgParams @loc.instParams) + loc.replace = \k -> Map.findWithDefault k k @loc.replParamMap + loc.evalTp = if null @loc.orgParams then id else evalType @lhs.options @loc.replace + + +------------------------------------------------------------------------------- +-- Types of intra-visit dependencies are needed in the type of the +-- semantic function. +------------------------------------------------------------------------------- + +ATTR CVisits CVisit [ children : {[(Identifier,Type, ChildKind)]} | | ] +SEM CProduction + | CProduction visits.children = @children + + +ATTR Sequence CRule [ | | tps USE {++} {[]} : {[Type]} + allTpsFound USE {&&} {True} : Bool ] +SEM CRule + | CRule lhs.(tps,allTpsFound) = maybe ([],False) (\tp -> ([tp],True)) @tp + | CChildVisit lhs.tps = if @loc.isSuperfluousHigherOrderIntra + then [] + else [NT (ntOfVisit @nt (@nr+1)) @loc.instParams False] + +------------------------------------------------------------------------------- +-- Each visit has its semantic function +------------------------------------------------------------------------------- + +ATTR CVisits [ | | decls : {Decls} ] +ATTR CVisit [ | decls : {Decls} | ] +SEM CVisits + | Nil lhs.decls = [] + | Cons lhs.decls = @hd.decls + hd.decls = @tl.decls + +-- Note: lhs.decls are the decls related to the next visit function. We pass it +-- chained from right to left in order to build the next visit function inside +-- the previous one. +-- Note: intra decls are ignored. The intra-visit variables are not passed on +-- explicitly, but handled automatically due to nesting level. + +SEM CVisit + | CVisit (loc.higherOrderChildren,loc.firstOrderChildren) = partition (\(_,_,virt) -> isHigherOrder virt) @lhs.children + loc.firstOrderOrig = map pickOrigType @loc.firstOrderChildren + loc.funcname = seqSemname @lhs.prefix @lhs.nt @lhs.con @lhs.nr + loc.nextVisitName = if @lhs.isLast then [] else [visitname @lhs.prefix @lhs.nt (@lhs.nr+1)] + loc.nextVisitDecl = let lhs = TupleLhs @nextVisitName + -- rhs = App fun @lhs.nextIntra + rhs = Let @lhs.decls (SimpleExpr fun) + fun = seqSemname @lhs.prefix @lhs.nt @lhs.con (@lhs.nr+1) + in if @lhs.isLast + then [] + else [Decl lhs rhs (Set.fromList @nextVisitName) @lhs.nextIntraVars] + loc.isOneVisit = @lhs.isLast && @lhs.nr == 0 + loc.hasWrappers = @lhs.nt `Set.member` @lhs.wrappers + loc.refDecls = if @loc.isOneVisit && @loc.hasWrappers && reference @lhs.options + then let synAttrs = Map.toList @syn + synNT = "Syn" ++ "_" ++ getName @lhs.nt + synVars = [ SimpleExpr (attrname @lhs.options False _LHS a) | (a,_) <- synAttrs ] + rhs = App synNT synVars + lhs = Fun "___node" [] + in [Decl lhs rhs Set.empty Set.empty] + else [] + loc.decls = if @lhs.o_clean + then @vss.decls ++ @nextVisitDecl ++ @loc.refDecls -- Don't generate type signatures for Clean, they will cause the compiler to generate functions, even for constants + else @typeSigs ++ @vss.decls ++ @nextVisitDecl ++ @loc.refDecls + vss.lastExpr = mkTupleExpr @lhs.o_unbox (null $ Map.keys @inh) $ map (SimpleExpr . lhsname @lhs.options False) (Map.keys @syn) ++ map SimpleExpr @nextVisitName + intra.lastExpr = error "lastExpr: not used here" + loc.lastExprVars = map (lhsname @lhs.options False) (Map.keys @syn) ++ @loc.nextVisitName + (loc.blockFunDecls, loc.blockFirstFunCall) = mkPartitionedFunction @loc.funcname @loc.o_case @loc.nextVisitDecl @loc.lastExprVars @vss.blockDecls + + loc.costCentreDescr = "b" ++ ":" ++ show @lhs.nt ++ ":" ++ show @lhs.con ++ ":" ++ show @lhs.nr + loc.addCostCentre = \v -> if @lhs.o_costcentre + then PragmaExpr True False ("SCC \"" ++ @loc.costCentreDescr ++ "\"") v + else v + + loc.params = map getName $ Map.findWithDefault [] @lhs.nt @lhs.paramMap + loc.semFun = let lhs = Fun @funcname lhs_args + lhs_args = if @lhs.nr == 0 then map field @loc.firstOrderOrig else [] -- @intra.exprs + + field (name,NT tp tps _,_) = let unwrap | @lhs.o_newtypes = \x -> App (sdtype tp) [x] + | otherwise = id + + addType expr | null tps = expr + | otherwise = TypedExpr expr (@lhs.unfoldSemDom tp 0 tps) + + in unwrap $ addType $ SimpleExpr $ funname name 0 + field (name,tp,_) = let expr = SimpleExpr (funname name 0) + in if null @loc.params + then expr + else TypedExpr expr (idEvalType @lhs.options $ typeToCodeType (Just @lhs.nt) @loc.params $ removeDeforested tp) + + mbEvalTp | null @loc.params = const Nothing + | otherwise = Just . (idEvalType @lhs.options) + + rhs = wrap + . mkSemFun @lhs.nt @lhs.nr [mkLambdaArg (lhsname @lhs.options True nm) (mbEvalTp $ typeToCodeType (Just @lhs.nt) @loc.params $ removeDeforested tp) | (nm,tp) <- Map.assocs @inh] + $ @loc.addCostCentre + $ if @ordered && @loc.o_splitsems + then @loc.blockFirstFunCall + else mkDecls @loc.declsType @decls + . ResultExpr (typeName @lhs.nt @lhs.nr) + . mkTupleExpr @lhs.o_unbox (null $ Map.keys @inh) + $ map (SimpleExpr . lhsname @lhs.options False) (Map.keys @syn) ++ map SimpleExpr @nextVisitName + wrap = if @lhs.o_newtypes + then \x -> App (typeName @lhs.nt @lhs.nr) [x] + else id + in Decl lhs rhs Set.empty Set.empty + loc.tsig = TSig @funcname @semType + loc.semType = 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 @loc.params = id + | otherwise = idEvalType @lhs.options + + in appQuant @lhs.quantMap @lhs.nt $ appContext @lhs.contextMap @lhs.nt $ evalTp $ + if @lhs.nr == 0 + then foldr argType (typeAppStrs (sdtype @lhs.nt ) @loc.params) (map (\(_,t,_) -> t) @loc.firstOrderOrig) + else foldr argType (typeAppStrs (typeName @lhs.nt @lhs.nr) @loc.params) [] -- @intra.tps + lhs.decls = ( if @lhs.with_sig + then [@tsig, @semFun] + else [@semFun] + ) ++ + ( if @ordered && @loc.o_splitsems + then @loc.blockFunDecls + else [] + ) + loc.typeSigs = if @lhs.o_sig && not @o_case + then @vss.tSigs + else [] + loc.o_do = @ordered && @lhs.o_monadic + loc.o_case = not @loc.o_do && @lhs.o_case && @ordered && not (hasPragma @lhs.allPragmas @lhs.nt @lhs.con _NOCASE) + loc.declsType = if @loc.o_do + then DeclsDo + else if @loc.o_case + then DeclsCase + else DeclsLet + loc.o_splitsems = @ordered && @lhs.o_splitsems + +{ +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 +} + +ATTR CVisits CVisit Sequence CRule [ instVisitNrs : {Map Identifier Int} || ] +ATTR CVisits CVisit [|| gatherInstVisitNrs USE {`Map.union`} {Map.empty} : {Map Identifier Int} ] +SEM CProduction + | CProduction + visits.instVisitNrs = @visits.gatherInstVisitNrs + +SEM CVisit + | CVisit + lhs.gatherInstVisitNrs = Map.fromList [(i,@lhs.nr) | i <- @vss.definedInsts] + +------------------------------------------------------------------------------- +-- Push aroundsMap downward +------------------------------------------------------------------------------- + +ATTR CNonterminals CNonterminal + [ aroundMap : {Map NontermIdent (Map ConstructorIdent (Set Identifier))} || ] + +ATTR CProductions CProduction + [ aroundMap : {Map ConstructorIdent (Set Identifier)} || ] + +ATTR CVisits CVisit Sequence CRule [ aroundMap : {Set Identifier} | | ] + +SEM CGrammar | CGrammar loc.aroundMap = @aroundsMap +SEM CNonterminal | CNonterminal loc.aroundMap = Map.findWithDefault Map.empty @nt @lhs.aroundMap +SEM CProduction | CProduction loc.aroundMap = Map.findWithDefault Set.empty @con @lhs.aroundMap + +------------------------------------------------------------------------------- +-- Push mergeMap downward +------------------------------------------------------------------------------- + +ATTR CNonterminals CNonterminal + [ mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))} || ] + +ATTR CProductions CProduction + [ mergeMap : {Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))} || ] + +ATTR CVisits CVisit Sequence CRule [ mergeMap : {Map Identifier (Identifier, [Identifier])} | | ] + +SEM CGrammar | CGrammar loc.mergeMap = @mergeMap +SEM CNonterminal | CNonterminal loc.mergeMap = Map.findWithDefault Map.empty @nt @lhs.mergeMap +SEM CProduction | CProduction loc.mergeMap = Map.findWithDefault Map.empty @con @lhs.mergeMap + +------------------------------------------------------------------------------- +-- Generate a partitioned version of the sequence of rules +------------------------------------------------------------------------------- + +ATTR Sequence [ lastExpr : Expr | | blockDecls : DeclBlocks ] + +ATTR Sequence CRule [ | declsAbove : {[Decl]} | ] +SEM CVisit + | CVisit + vss.declsAbove = [] + intra.declsAbove = error "declsAbove: not used here" + +SEM CRule + | CRule + lhs.declsAbove = @lhs.declsAbove ++ @loc.decls + | CChildVisit + lhs.declsAbove = [] + +SEM Sequence + | Cons + lhs.blockDecls = @hd.bldBlocksFun @tl.blockDecls + | Nil + lhs.blockDecls = DeclTerminator @lhs.declsAbove @lhs.lastExpr + +ATTR CRule [ | | bldBlocksFun : {DeclBlocks -> DeclBlocks} ] +SEM CRule + | CRule + lhs.bldBlocksFun = id + | CChildVisit + lhs.bldBlocksFun = DeclBlock @lhs.declsAbove (head @loc.decls) + +{ +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) +} + +WRAPPER DeclBlocksRoot + +ATTR DeclBlocksRoot DeclBlocks [ prefix : String optCase : Bool nextVisitDecls : {[Decl]} lastExprVars : {[String]} | | ] +ATTR DeclBlocksRoot [ | | lambdas : {[Decl]} firstCall : Expr ] + +SEM DeclBlocksRoot + | DeclBlocksRoot + lhs.lambdas = @blocks.decls + lhs.firstCall = @blocks.callExpr + +ATTR DeclBlocks [ blockNr : Int | | ] +SEM DeclBlocksRoot + | DeclBlocksRoot + blocks.blockNr = 1 +SEM DeclBlocks + | DeclBlock + next.blockNr = @lhs.blockNr + 1 + +ATTR DeclBlocks [ | | callExpr : Expr freeVars : {[String]} ] +SEM DeclBlocks + | DeclBlock DeclTerminator + loc.lambdaName = @lhs.prefix ++ "_block" ++ show @lhs.blockNr + loc.pragmaDecl = PragmaDecl ("NOINLINE " ++ @loc.lambdaName) + lhs.callExpr = App @loc.lambdaName (map SimpleExpr @loc.freeVars) + | DeclTerminator + loc.freeVars = freevars @lhs.lastExprVars (@defs ++ @lhs.nextVisitDecls) + | DeclBlock + loc.freeVars = freevars @next.freeVars (@visit : @defs) + +ATTR DeclBlocks [ | | decls : {[Decl]} ] +SEM DeclBlocks + | DeclTerminator + lhs.decls = [ mkBlockLambda @lhs.optCase @loc.lambdaName @loc.freeVars (@defs ++ @lhs.nextVisitDecls) @result ] + | DeclBlock + loc.decl = mkBlockLambda @lhs.optCase @loc.lambdaName @loc.freeVars (@defs ++ [@visit]) @next.callExpr + lhs.decls = (if @lhs.blockNr > 1 then [@loc.pragmaDecl] else []) ++ [@loc.decl] ++ @next.decls + +{ +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 +} + + +------------------------------------------------------------------------------- +-- The semantic domain is generated from the interface. +------------------------------------------------------------------------------- + +ATTR CInterface CSegments CSegment [ | | semDom USE {++} {[]} : {[Decl]} ] +SEM CInterface + | CInterface lhs.semDom = Comment "semantic domain" : @seg.semDom + +SEM CSegment + | CSegment loc.altSemForm = breadthFirst @lhs.options + loc.tp = if @loc.altSemForm + then TypeApp (SimpleType "Child") [SimpleType "EvalInfo", @loc.indexExpr ] + else foldr Arr @loc.synTps @loc.inhTps + loc.inhTps = [typeToCodeType (Just @lhs.nt) @loc.params tp | tp <- Map.elems @inh] + loc.inhTup = mkTupleType @lhs.o_unbox (null @loc.inhTps) @loc.inhTps + loc.synTps = mkTupleType @lhs.o_unbox (null @loc.inhTps) ([typeToCodeType (Just @lhs.nt) @loc.params tp | tp <- Map.elems @syn] ++ @loc.continuation) + loc.curTypeName = typeName @lhs.nt @lhs.nr + loc.nextTypeName = typeName @lhs.nt (@lhs.nr + 1) + loc.indexName = "I_" ++ @loc.curTypeName + loc.dataIndex = Code.Data @loc.indexName @loc.params [DataAlt @loc.indexName []] False [] + loc.indexExpr = TypeApp (SimpleType @loc.indexName) (map (SimpleType . ('@':)) @loc.params) + loc.indexStr = "(" ++ @loc.indexName ++ concatMap (\p -> " " ++ p) @loc.params ++ ")" + loc.inhInstance = Code.Data "instance Inh" [@loc.indexStr] [DataAlt (typeName @lhs.nt @lhs.nr ++ "_Inh") [@loc.inhTup] ] False [] + loc.synInstance = Code.Data "instance Syn" [@loc.indexStr] [DataAlt (typeName @lhs.nt @lhs.nr ++ "_Syn") [@loc.synTps] ] False [] + loc.continuation = if @lhs.isLast + then [] + else [TypeApp (SimpleType @loc.nextTypeName) (map (SimpleType . ('@':)) @loc.params)] + loc.params = map getName $ Map.findWithDefault [] @lhs.nt @lhs.paramMap + lhs.semDom = let name = typeName @lhs.nt @lhs.nr + evalTp | null @loc.params = id + | otherwise = idEvalType @lhs.options + in ( if @lhs.o_newtypes + then [ Code.NewType name @loc.params name (evalTp @loc.tp) ] + else [ Code.Type name @loc.params (evalTp @loc.tp) ] ) + ++ ( if @loc.altSemForm + then [@loc.dataIndex, @loc.inhInstance, @loc.synInstance] + else [] ) + +ATTR CNonterminals CNonterminal CInterface CSegments CSegment [ | | semDomUnfoldGath USE {`Map.union`} {Map.empty} : {Map (NontermIdent, Int) ([String], Code.Type)} ] + +SEM CSegment + | CSegment + lhs.semDomUnfoldGath = Map.singleton (@lhs.nt, @lhs.nr) (@loc.params, @loc.tp) + +ATTR CNonterminals CNonterminal CProductions CProduction CVisits CVisit Sequence CRule [ unfoldSemDom : {NontermIdent -> Int -> [String] -> Code.Type} | | ] + +SEM CGrammar + | CGrammar + loc.unfoldSemDom = + \nt nr repl -> + let (params, tp) = Map.findWithDefault (error ("No such semantic domain: " ++ show nt)) (nt, nr) @nonts.semDomUnfoldGath + replMap = Map.fromList (zip params repl) + replace k = Map.findWithDefault ('@':k) k replMap + in evalType @lhs.options replace tp + +{ +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 +} + +------------------------------------------------------------------------------- +-- Wrapper functions +------------------------------------------------------------------------------- + +SEM CNonterminal + | CNonterminal loc.semWrapper = let params' = map getName @params + inhAttrs = Map.toList @inh + synAttrs = Map.toList @syn + inhVars = [ SimpleExpr (attrname @lhs.options True _LHS a) | (a,_) <- inhAttrs ] + synVars = [ SimpleExpr (attrname @lhs.options False _LHS a) | (a,_) <- synAttrs ] + var = "sem" + wrapNT = "wrap" ++ "_" ++ getName @nt + inhNT = "Inh" ++ "_" ++ getName @nt + synNT = "Syn" ++ "_" ++ getName @nt + varPat = if @lhs.o_newtypes + then App (sdtype @nt) [SimpleExpr var] + else SimpleExpr var + + evalTp | null params' = id + | otherwise = idEvalType @lhs.options + appParams nm = TypeApp (SimpleType nm) (map SimpleType params') + typeSig = TSig wrapNT (evalTp $ appParams (sdtype @nt) `Arr` (appParams inhNT `Arr` appParams synNT)) + mkstrict = Named @lhs.o_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 @inter.wrapDecls (App synNT synVars)) + Set.empty Set.empty + ] + +ATTR CInterface CSegments CSegment [ | | wrapDecls USE {++} {[]}: {Decls} ] +SEM CSegment + | CSegment lhs.wrapDecls = let lhsVars = map (lhsname @lhs.options False) (Map.keys @syn) + ++ if @lhs.isLast then [] else [unwrap ++ sem (@lhs.nr+1)] + rhsVars = map (lhsname @lhs.options True) (Map.keys @inh) + rhs = map SimpleExpr rhsVars + unwrap = if @lhs.o_newtypes then typeName @lhs.nt (@lhs.nr + 1) ++ " " else "" + var = "sem" + sem 0 = var + sem n = var ++ "_" ++ show n + ntt = typeName @lhs.nt @lhs.nr + in [ EvalDecl ntt (mkTupleLhs @lhs.o_unbox (null $ Map.keys @inh) lhsVars) (InvokeExpr ntt (SimpleExpr $ sem @lhs.nr) rhs) ] + -- [ Decl (mkTupleLhs @lhs.o_unbox (null $ Map.keys @inh) lhsVars) (App (sem @lhs.nr) rhs) (Set.fromList lhsVars) (Set.fromList rhsVars) ] + +------------------------------------------------------------------------------- +-- Errors for missing type signatures. It's an error when one of the +-- attributes in the intra-visit dependencies does not have a type. +-- UPDATE: it is not an error anymore... +------------------------------------------------------------------------------- + +ATTR CNonterminals CNonterminal + CProductions CProduction + CVisits CVisit [ with_sig : Bool | | ] + +SEM CGrammar + | CGrammar nonts.with_sig = typeSigs @lhs.options + +SEM CGrammar [ | | errors : {Seq Error} ] + | CGrammar lhs.errors = Seq.empty + +------------------------------------------------------------------------------- +-- Provide a description of the interfaces as comments +------------------------------------------------------------------------------- + +SEM CNonterminal + | CNonterminal loc.comment = Comment . unlines . map ind $ ( @inter.comments ++ ("alternatives:" : map ind @prods.comments) ) + +ATTR CInterface CSegments CSegment + CProductions CProduction + CVisits CVisit Sequence CRule [ | | comments USE {++} {[]}: {[String]} ] + +ATTR Sequence CRule [ what:String | | ] + +SEM CSegment + | CSegment lhs.comments = let body = map ind (showsSegment (CSegment @inh @syn)) + in if null body + then [] + else ("visit " ++ show @lhs.nr ++ ":") : body + +SEM CProduction + | CProduction loc.firstOrderChildren = [ (nm,fromJust mb,virt) | (nm,tp,virt) <- @children, let mb = isFirstOrder virt tp, isJust mb ] + lhs.comments = ("alternative " ++ getName @con ++ ":") + : map ind ( map (\(x,y,_) -> makeLocalComment 14 "child" x (Just y)) @loc.firstOrderChildren + ++ @visits.comments + ) + +{ +-- 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 +} + +SEM CVisit + | CVisit lhs.comments = let body = map ind (@vss.comments ++ @intra.comments) + in if null body + then [] + else ("visit " ++ show @lhs.nr ++ ":") : body + vss.what = "local" + intra.what = "intra" + + +SEM CRule + | CRule lhs.comments = [ makeLocalComment 11 @lhs.what name tp | (field,name,tp) <- Map.elems @defines, field == _LOC ] + ++ [ makeLocalComment 11 "inst " name tp | (field,name,tp) <- Map.elems @defines, field == _INST ] + +{ +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 ) + +} + +------------------------------------------------------------------------------- +-- And tie it all together +------------------------------------------------------------------------------- + +ATTR CNonterminals CNonterminal [ | | chunks USE {++} {[]} : {Chunks} ] +ATTR CProductions CProduction [ | | decls USE {++} {[]} : {Decls} ] +ATTR CGrammar [ | | output : Program ] + +SEM CGrammar + | CGrammar lhs.output = Program @nonts.chunks @multivisit + +SEM CNonterminal + | CNonterminal lhs.chunks = [ Chunk (getName @nt) + (Comment (getName @nt ++ " " ++ replicate (60 - length (getName @nt)) '-')) + (if @lhs.o_pretty then [@loc.comment] else []) + (if isJust @lhs.o_data then [@loc.dataDef] else []) + (if @lhs.o_cata && @loc.genCata then @loc.cataFun else []) + (if @lhs.o_sig then @inter.semDom else []) + (if @nt `Set.member` @lhs.wrappers then @loc.semWrapper else []) + (if @lhs.o_sem then @prods.decls else []) + (if @lhs.o_sem then @prods.semNames else []) + ] + +{ +-- 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 +} + +------------------------------------------------------------------------------- +-- Datatypes were already present +------------------------------------------------------------------------------- + +ATTR CNonterminals CNonterminal [ derivings: {Derivings} typeSyns : {TypeSyns} | | ] +ATTR CNonterminals CNonterminal CProductions CProduction CVisits CVisit [ wrappers:{Set NontermIdent} | | ] + +SEM CGrammar + | CGrammar nonts . typeSyns = @typeSyns + . derivings = @derivings + . wrappers = @wrappers + +SEM CNonterminal + | CNonterminal loc.dataDef = 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 @lhs.options theType) + derivings = maybe [] (map getName . Set.toList) (Map.lookup @nt @lhs.derivings) + dataDef = Data (getName @nt) (map getName @params) @prods.dataAlts (maybe False id @lhs.o_data) derivings + in maybe dataDef typeSyn $ lookup @nt @lhs.typeSyns + +ATTR CProductions [ | | dataAlts : {DataAlts} ] +ATTR CProduction [ | | dataAlt : {DataAlt} ] + +SEM CProductions + | Cons lhs.dataAlts = @hd.dataAlt : @tl.dataAlts + | Nil lhs.dataAlts = [] + +SEM CProduction + | CProduction loc.params = map getName $ Map.findWithDefault [] @lhs.nt @lhs.paramMap + lhs.dataAlt = let conNm = conname @lhs.o_rename @lhs.nt @con + mkFields :: (NontermIdent -> ConstructorIdent -> Identifier -> Code.Type -> a) -> [a] + mkFields f = map (\(nm,t,_) -> f @lhs.nt @con nm (typeToCodeType (Just @lhs.nt) @loc.params $ removeDeforested t)) @loc.firstOrderChildren + in if dataRecords @lhs.options + then Record conNm $ mkFields $ toNamedType (strictData @lhs.options) + else DataAlt conNm $ mkFields $ \_ _ _ t -> t + +{ +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 +} + +------------------------------------------------------------------------------- +-- Catamorphism were already present +------------------------------------------------------------------------------- + +SEM CNonterminal + | CNonterminal loc.genCata = not (@nt `Set.member` nocatas @lhs.options) + loc.cataFun = let appParams nm = TypeApp (SimpleType nm) (map SimpleType (map getName @params)) + evalTp | null @params = id + | otherwise = idEvalType @lhs.options + tSig = TSig (cataname @lhs.prefix @nt) + (appQuant @lhs.quantMap @nt $ appContext @lhs.contextMap @nt $ evalTp $ appParams (getName @nt) `Arr` appParams (sdtype @nt)) + special typ = case typ of + CommonTypes.List tp -> + let cons = SimpleExpr (semname @lhs.prefix @nt (identifier "Cons")) + nil = SimpleExpr (semname @lhs.prefix @nt (identifier "Nil" )) + arg = SimpleExpr "list" + rarg = case tp of + NT t _ _ -> let t' = maybe t id (deforestedNt t) + in SimpleExpr ("(Prelude.map " ++ (cataname @lhs.prefix t') ++ " list)") + _ -> arg + lhs = Fun (cataname @lhs.prefix @nt) [arg] + rhs = (App "Prelude.foldr" [cons,nil,rarg]) + in [Decl lhs rhs Set.empty Set.empty] + CommonTypes.Maybe tp -> + let just = semname @lhs.prefix @nt (identifier "Just") + nothing = semname @lhs.prefix @nt (identifier "Nothing" ) + arg = SimpleExpr "x" + rarg = case tp of + NT t _ _ -> let t' = maybe t id (deforestedNt t) + in App (cataname @lhs.prefix t') [arg] + _ -> arg + lhs a = Fun (cataname @lhs.prefix @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 @lhs.prefix @nt (identifier "Left") + right = semname @lhs.prefix @nt (identifier "Right" ) + arg = SimpleExpr "x" + rarg0 = case tp1 of + NT t _ _ -> let t' = maybe t id (deforestedNt t) + in App (cataname @lhs.prefix t') [arg] + _ -> arg + rarg1 = case tp2 of + NT t _ _ -> let t' = maybe t id (deforestedNt t) + in App (cataname @lhs.prefix t') [arg] + _ -> arg + lhs a = Fun (cataname @lhs.prefix @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 @lhs.prefix @nt (identifier "Entry")) + nil = SimpleExpr (semname @lhs.prefix @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 @lhs.prefix t', arg] + _ -> arg + lhs = Fun (cataname @lhs.prefix @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 @lhs.prefix @nt (identifier "Entry")) + nil = SimpleExpr (semname @lhs.prefix @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 @lhs.prefix t', arg] + _ -> arg + lhs = Fun (cataname @lhs.prefix @nt) [arg] + rhs = App "Data.IntMap.foldWithKey" [entry,nil,rarg] + in [Decl lhs rhs Set.empty Set.empty] + CommonTypes.Tuple tps -> + let con = semname @lhs.prefix @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 @lhs.prefix t') [n] + _ -> n + + lhs = Fun (cataname @lhs.prefix @nt) [TupleExpr (map fst tps')] + rhs = App con rargs + in [Decl lhs rhs Set.empty Set.empty] + CommonTypes.OrdSet tp -> + let entry = SimpleExpr (semname @lhs.prefix @nt (identifier "Entry")) + nil = SimpleExpr (semname @lhs.prefix @nt (identifier "Nil" )) + arg = SimpleExpr "set" + rentry = case tp of + NT t _ _ -> let t' = maybe t id (deforestedNt t) + in App "(.)" [entry, SimpleExpr $ cataname @lhs.prefix t'] + _ -> entry + lhs = Fun (cataname @lhs.prefix @nt) [arg] + rhs = (App "Data.Set.foldr" [rentry,nil,arg]) + in [Decl lhs rhs Set.empty Set.empty] + CommonTypes.IntSet -> + let entry = SimpleExpr (semname @lhs.prefix @nt (identifier "Entry")) + nil = SimpleExpr (semname @lhs.prefix @nt (identifier "Nil" )) + arg = SimpleExpr "set" + lhs = Fun (cataname @lhs.prefix @nt) [arg] + rhs = (App "Data.IntSet.foldr" [entry,nil,arg]) + in [Decl lhs rhs Set.empty Set.empty] + in Comment "cata" : + (if @lhs.o_sig then [tSig] else []) ++ + maybe @prods.cataAlts special (lookup @nt @lhs.typeSyns) + +ATTR CProductions [ | | cataAlts : {Decls} ] +ATTR CProduction [ | | cataAlt : {Decl} ] + + +SEM CProductions + | Cons lhs.cataAlts = @hd.cataAlt : @tl.cataAlts + | Nil lhs.cataAlts = [] + +SEM CProduction + | CProduction lhs.cataAlt = let lhs = Fun (cataname @lhs.prefix @lhs.nt) [lhs_pat] + lhs_pat = App (conname @lhs.o_rename @lhs.nt @con) + (map (\(n,_,_) -> SimpleExpr $ locname @lhs.options $ n) @loc.firstOrderChildren) + rhs = App (semname @lhs.prefix @lhs.nt @con) + (map argument @loc.firstOrderChildren) + argument (nm,NT tp _ _,_) = App (cataname @lhs.prefix tp) + [SimpleExpr (locname @lhs.options nm)] + argument (nm, _,_) = SimpleExpr (locname @lhs.options nm) + in Decl lhs rhs Set.empty Set.empty + + +------------------------------------------------------------------------------- +-- Collect names of generated stuff +------------------------------------------------------------------------------- + +ATTR CProductions CProduction CVisits CVisit [ | | semNames USE {++} {[]} : {[String]} ] + +{- +SEM CProduction + | CProduction + lhs.semNames = [cataname @lhs.prefix @lhs.nt] ++ @visits.semNames +-} + +SEM CVisit + | CVisit + lhs.semNames = [@loc.funcname] +
+ src-ag/HsToken.ag view
@@ -0,0 +1,33 @@+imports +{ +import CommonTypes +import UU.Scanner.Position(Pos) +} + +DATA HsTokensRoot + | HsTokensRoot tokens : HsTokens + +TYPE HsTokens = [HsToken] + +DATA HsToken + | AGLocal var : {Identifier} -- either a local or a terminal + pos : {Pos} + rdesc : {Maybe String} -- description of the rule the local reference appears in + + | AGField field : {Identifier} -- Misnomer: this is actually a reference to an attribute, not a terminal! + attr : {Identifier} + pos : {Pos} + rdesc : {Maybe String} -- description of the rule the attribute reference appears in + + | HsToken value : {String} + pos : {Pos} + | CharToken value : {String} + pos : {Pos} + | StrToken value : {String} + pos : {Pos} + | Err mesg : {String} + pos : {Pos} + + + +DERIVING HsToken : Show
+ src-ag/Interfaces.ag view
@@ -0,0 +1,16 @@+imports +{ +import CommonTypes +import SequentialTypes +} + +DATA IRoot | IRoot inters:Interfaces +TYPE Interfaces = [Interface] +DATA Interface | Interface nt:NontermIdent + cons:{[ConstructorIdent]} + seg:Segments +TYPE Segments = [Segment] +DATA Segment | Segment inh:{[Vertex]} + syn:{[Vertex]} + +
+ src-ag/KWOrder.ag view
@@ -0,0 +1,217 @@+INCLUDE "AbstractSyntax.ag" +INCLUDE "HsToken.ag" +INCLUDE "Expression.ag" +INCLUDE "Patterns.ag" +INCLUDE "DistChildAttr.ag" +INCLUDE "ExecutionPlanPre.ag" +INCLUDE "ExecutionPlanCommon.ag" + +imports +{ +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) +} + +------------------------------------------------------------------------------- +-- Dependency graph per production +------------------------------------------------------------------------------- +-- Gather vertices +ATTR HsToken Expression + Rule Rules + Pattern Patterns + Child Children [ | | vertices USE {`Set.union`} {Set.empty} : {Set.Set Vertex} ] + +-- All vertices from the righthandside of a rule +SEM HsToken + | AGLocal lhs.vertices = Set.singleton $ VChild @var + | AGField lhs.vertices = Set.singleton $ VAttr (if @field == _LHS then Inh + else if @field == _LOC then Loc + else Syn) @field @attr + +-- Gather vertices for an expression (make a higher order child) +SEM Expression + | Expression lhs.vertices = Set.unions $ map (\tok -> vertices_Syn_HsToken + (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) @tks + +-- Gather vertices at patterns +SEM Pattern + | Alias loc.vertex = if @field == _INST then VChild @attr + else VAttr (if @field == _LHS then Syn + else if @field == _LOC then Loc + else Inh) @field @attr + lhs.vertices = Set.insert @loc.vertex @pat.vertices + +-- Gather vertices for children +-- +-- The behavior for merged children is a bit more complicated (and ignored for now) +SEM Child + | Child loc.vertex = VChild @name + loc.synvertices = map (VAttr Syn @name) . Map.keys $ @loc.syn + loc.inhvertices = map (VAttr Inh @name) . Map.keys $ @loc.inh + lhs.vertices = case @tp of -- only Nonterminal children need to be in dependency graph + NT _ _ _ -> Set.insert @loc.vertex $ Set.fromList (@loc.synvertices ++ @loc.inhvertices) + _ -> Set.empty + +-- Add extra vertex for a rule +SEM Rule + | Rule loc.vertex = VRule @loc.rulename + lhs.vertices = Set.insert @loc.vertex $ @pattern.vertices `Set.union` @rhs.vertices + +-- Combine all vertices for a production +SEM Production + | Production loc.vertices = @rules.vertices `Set.union` @children.vertices + +-- Gather edges +ATTR Rule Rules + Child Children [ | | edges USE {`Set.union`} {Set.empty} : {Set.Set Edge} ] + +-- Gather edges for a rule +SEM Rule + | Rule loc.edgesout = map ((,) @loc.vertex) (Set.toList @rhs.vertices) + loc.edgesin = map (flip (,) @loc.vertex) (Set.toList @pattern.vertices) + lhs.edges = Set.fromList $ @loc.edgesout ++ @loc.edgesin + +-- When a child is defined by a higher order attribute and the late binding option +-- is enabled, we refer to the additional inherited attribute under the hood, hence +-- we need to tell the dependency analysis about this in order to actually have the +-- attribute available when we attach the child. +-- Note that the dependencies on the rule that creates the semantics of the child +-- is handled elsewhere by mapping an "inst"-attribute to the right child vertex. +SEM Child | Child + loc.childIsDeforested = case @tp of + NT _ _ defor -> defor + _ -> False + loc.higherOrderEdges = case @kind of + ChildAttr | lateHigherOrderBinding @lhs.options && not @loc.childIsDeforested + -> [(@loc.vertex, VAttr Inh _LHS idLateBindingAttr)] + _ -> [] -- attribute is not referenced implicitly + loc.aroundEdges = if @loc.hasArounds + then [(@loc.vertex, VAttr Syn _LOC (Ident (getName @name ++ "_around") (getPos @name)))] + else [] + +-- Gather edges for a child +SEM Child + | Child loc.edgesout = @loc.higherOrderEdges + loc.edgesin = map (flip (,) @loc.vertex) @loc.synvertices + lhs.edges = Set.fromList (@loc.edgesout ++ @loc.edgesin) + +-- Add manual attribute dependencies +ATTR Nonterminals Nonterminal [ manualDeps : AttrOrderMap | | ] +ATTR Productions Production [ manualDeps : {Map ConstructorIdent (Set Dependency)} | | ] + +SEM Grammar | Grammar nonts.manualDeps = @manualAttrOrderMap +SEM Nonterminal | Nonterminal prods.manualDeps = Map.findWithDefault Map.empty @nt @lhs.manualDeps +SEM Production | Production + loc.manualDeps = Map.findWithDefault Set.empty @con @lhs.manualDeps + loc.manualEdges = Set.map depToEdge @loc.manualDeps + +{ +-- 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 +} + +-- Combine all edges for a production +SEM Production + | Production loc.edges = @rules.edges `Set.union` @children.edges + +-- Find all child nonterminal names for a production +ATTR Child Children [ | | nontnames USE {++} {[]} : {[(Identifier, Identifier)]}] + +SEM Child + | Child lhs.nontnames = case @tp of + NT nont _ _ -> [(@name, nont)] + _ -> [] + +-- Return a dependency graph for each production +ATTR Production [ | | depgraph : {ProdDependencyGraph} ] +ATTR Productions [ | | depgraph USE {:} {[]} : {[ProdDependencyGraph]} ] + +SEM Production + | Production lhs.depgraph = ProdDependencyGraph { pdgVertices = Set.toList @loc.vertices + , pdgEdges = Set.toList @loc.edges + , pdgRules = @rules.erules + , pdgChilds = @children.echilds + , pdgProduction = @con + , pdgChildMap = @children.nontnames + , pdgConstraints = @constraints + , pdgParams = @params } + +------------------------------------------------------------------------------- +-- Dependency graph per nonterminal +------------------------------------------------------------------------------- + +-- Vertices are just all inherited and syntesized attributes +SEM Nonterminal + | Nonterminal loc.synvertices = map (VAttr Syn @nt) . Map.keys $ @syn + loc.inhvertices = map (VAttr Inh @nt) . Map.keys $ @inh + loc.vertices = @loc.synvertices ++ @loc.inhvertices + +-- Construct nonterminal dependency graph for production +SEM Nonterminal + | Nonterminal loc.nontgraph = NontDependencyGraph { ndgVertices = @loc.vertices + , ndgEdges = [] } + +-- Create dependency information for nonterminal and pass it upwards +ATTR Nonterminal [ | | depinfo : {NontDependencyInformation} ] +ATTR Nonterminals [ | | depinfo USE {:} {[]} : {[NontDependencyInformation]} ] + +SEM Nonterminal + | Nonterminal lhs.depinfo = NontDependencyInformation { ndiNonterminal = @nt + , ndiParams = @params + , ndiInh = Map.keys @inh + , ndiSyn = Map.keys @syn + , ndiDepGraph = @loc.nontgraph + , ndiProds = @prods.depgraph + , ndiRecursive = @loc.recursive + , ndiHoInfo = @loc.hoInfo + , ndiClassCtxs = @loc.classContexts + } + +------------------------------------------------------------------------------- +-- Call the kennedy-warren algorithm +------------------------------------------------------------------------------- +ATTR Grammar [ | | output : {ExecutionPlan} + depgraphs : {PP_Doc} + visitgraph : {PP_Doc} + errors : {Seq Error} ] + +SEM Grammar + | Grammar (lhs.output, lhs.depgraphs, lhs.visitgraph, lhs.errors) + = let lazyPlan = kennedyWarrenLazy @lhs.options @wrappers @nonts.depinfo @typeSyns @derivings + in if visit @lhs.options && withCycle @lhs.options + then case kennedyWarrenOrder @lhs.options @wrappers @nonts.depinfo @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) + +
+ src-ag/LOAG/Order.ag view
@@ -0,0 +1,435 @@+INCLUDE "AbstractSyntax" +INCLUDE "Patterns" +INCLUDE "CodeSyntax" +INCLUDE "Expression" +INCLUDE "HsToken" +INCLUDE "LOAG/Rep" +INCLUDE "LOAG/Prepare" +INCLUDE "ExecutionPlanCommon" + +MODULE {LOAG.Order} +{} +{} +imports{ +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 +} + +{ +fst' (a,_,_) = a +snd' (_,b,_) = b +trd' (_,_,c) = c +} + +ATTR Grammar [ | | + output : ExecutionPlan + ads : {Maybe PP_Doc} + errors : {Seq.Seq Error}] + +SEM Grammar | Grammar + lhs.errors = either Seq.singleton (const Seq.empty) @loc.schedRes + lhs.ads = case either (const []) trd' @loc.schedRes of + [] -> Nothing + ads -> Just $ ppAds @lhs.options @nonts.pmp ads + lhs.output = ExecutionPlan @nonts.enonts @typeSyns @wrappers @derivings + + nonts.sched = either (const Map.empty) snd' @loc.schedRes + nonts.tdp = either (error "no tdp") (fromJust.fst') @loc.schedRes + + loc.schedRes = if CT.loag @lhs.options + then if CT.aoag @lhs.options + then AOAG.schedule @smf.self @self @loc.ag @nonts.ads + else @loc.loagRes + else Right (Nothing,Map.empty,[]) + loc.loagRes = let putStrLn s = when (verbose @lhs.options) (IO.putStrLn s) + in Right $ unsafePerformIO $ scheduleLOAG @loc.ag putStrLn @lhs.options + loc.ag = repToAg @smf.self @self + + nonts.res_ads = either (const []) trd' @loc.schedRes + +-- Gather the fake dependencies from the ads result of AOAG + +ATTR Nonterminals Nonterminal Productions Production + [ res_ads : {[Edge]} || ] +ATTR Nonterminals Nonterminal + [ || fdps USE {Map.union} {Map.empty} : AttrOrderMap ] + +SEM Nonterminal | Nonterminal + lhs.fdps = Map.singleton @nt @prods.fdps + +ATTR Productions Production [ || + fdps USE {Map.union} {Map.empty} : {Map.Map ConstructorIdent (Set Dependency)} ] + +SEM Production | Production + lhs.fdps = + let op d@(f,t) ds + | fst (argsOf $ findWithErr @lhs.pmpf "fdps" f) == (@lhs.dty,getName @con) + = Set.insert (edgeToDep @lhs.pmpf d) ds + | otherwise + = ds + in Map.singleton @con $ foldr op Set.empty @lhs.res_ads +{ +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 + +} + +-- Construct Execution Plan + +ATTR Nonterminals Nonterminal [ + visMapf : {IMap.IntMap Int} + tdp : TDPRes || + enonts USE {(++)} {[]} : ENonterminals + visMap USE {IMap.union} {IMap.empty} : {IMap.IntMap Int}] + +SEM Grammar + | Grammar nonts.visMapf = @nonts.visMap + nonts.visitnum = 0 + +SEM Nonterminal + | Nonterminal + loc.initial = @lhs.visitnum + loc.vnums = zipWith const [@loc.initial..] @segments + loc.initialVisit = @vnums + loc.nextVis = Map.fromList $ (@loc.initial + length @vnums, NoneVis) + : [(v, OneVis v) | v <- @vnums ] + loc.prevVis = Map.fromList $ (@loc.initial, NoneVis) + : [(v+1, OneVis v) | v <- @vnums ] + loc.visMap = let op vnr (MySegment visnr ins syns _ _) = + IMap.fromList $ zip syns (repeat vnr) + in IMap.unions $ zipWith op [@loc.initial..] @mysegments + lhs.enonts = [ENonterminal + @nt + @params + @loc.classContexts + @loc.initial + @loc.initialVisit + @loc.nextVis + @loc.prevVis + @prods.eprods + @loc.recursive + @loc.hoInfo ] + +ATTR Productions Production [ + visMapf : {IMap.IntMap Int} + tdp : TDPRes || + eprods USE {(++)} {[]} : EProductions ] + +SEM Production + | Production + segs.ruleMap = @rules.ruleMap + segs.done = (Set.empty, Set.empty, Set.empty, Set.empty) + loc.intros = let intro (Child nm _ kind) + | kind == ChildAttr = Nothing + | otherwise = Just $ ChildIntro nm + in catMaybes $ map intro @children.self + lhs.eprods = + let ((Visit ident from to inh syn steps kind):vss) = @segs.evisits + steps' = @loc.intros ++ steps + visits | null @segs.evisits = [] + | otherwise = + ((Visit ident from to inh syn steps' kind):vss) + in [EProduction + @con + @params + @constraints + @rules.erules + @children.echilds + visits ] + +ATTR Nonterminals Nonterminal Productions Production MySegments MySegment + [ | visitnum : Int | ] + +-- Visit nums should be the same for each production, but different globally +SEM Productions + | Cons tl.visitnum = @lhs.visitnum + lhs.visitnum = @hd.visitnum + +SEM MySegment | MySegment +visitnum = (+1) +ATTR MySegments MySegment [ + -- maps which attribute occurrence is calculated in which visit + visMapf : {IMap.IntMap Int} | | ] + +ATTR MySegments MySegment [ + ps : PLabel + ruleMap : {Map.Map MyOccurrence Identifier} + nmprf : NMP_R + options : {Options} + tdp : TDPRes + done : { (Set.Set MyOccurrence, Set.Set FLabel + , Set.Set Identifier, Set.Set (FLabel,Int))} + ||] + +ATTR MySegments [|| evisits USE {:} {[]} : {Visits}] +ATTR MySegment [|| + evisits : {Visit} + -- synthesized attribute occurrences of this segment + synsO : {[Int]} + visnr : Int + done : { (Set.Set MyOccurrence, Set.Set FLabel + ,Set.Set Identifier, Set.Set (FLabel,Int))}] + +SEM MySegments + | Cons hd.done = @lhs.done + tl.done = @hd.done + +SEM MySegment + | MySegment + loc.inhs = Map.keysSet$ Map.unions $ map (vertexToAttr @lhs.nmp) @inhAttr + loc.syns = Map.keysSet$ Map.unions $ map (vertexToAttr @lhs.nmp) @synAttr + loc.inhsO= maybe (error "segment not instantiated") id @inhOccs + loc.synsO= maybe (error "segment not instantiated") id @synOccs + lhs.visnr= @visnr + loc.kind = if monadic @lhs.options then VisitMonadic else VisitPure True + lhs.evisits = Visit @lhs.visitnum @lhs.visitnum (@lhs.visitnum+1) + @loc.inhs @loc.syns @loc.steps @loc.kind + loc.steps = if monadic @lhs.options + then [Sim @loc.vss] else [PureGroup @loc.vss True] + (loc.vss,lhs.done) = (runST $ getVss @lhs.done @lhs.ps @lhs.tdp @synsO + @lhs.lfpf @lhs.nmprf @lhs.pmpf @lhs.pmprf @lhs.fty + @lhs.visMapf @lhs.ruleMap @lhs.hoMapf) + +{ +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 $ + lfp Map.! occ + rep :: MyOccurrence -> Set.Set MyOccurrence + rep occ | isLoc occ = Set.insert occ $ + setConcatMap rep $ lfp Map.! 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-> visMap IMap.! x) (nmpr Map.! (nt <.> attr o)) + nt = fty Map.! (ps,child) +} + +ATTR Nonterminals Nonterminal [ + sched : {InterfaceRes} ||] +SEM Nonterminal + | Nonterminal + loc.assigned = findWithErr @lhs.sched "could not const. interfaces" + (getName @nt) + loc.mx = if Map.null @lhs.sched + then 0 + else let mx = fst $ IMap.findMax @loc.assigned in + if even mx then mx else mx + 1 + loc.mysegments = + map (\i -> MySegment ((@loc.mx - i) `div` 2) + (maybe [] id $ IMap.lookup i @loc.assigned) + (maybe [] id $ IMap.lookup (i-1) @loc.assigned) + Nothing Nothing) + [@loc.mx,@loc.mx-2 .. 2] + loc.segments = + map (\(MySegment visnr is ss _ _) -> + CSegment (Map.unions $ map (vertexToAttr @lhs.nmp) is) + (Map.unions $ map (vertexToAttr @lhs.nmp) ss)) + @loc.mysegments + +ATTR Productions Production [ mysegments : MySegments || ] +SEM Production + | Production + inst.segs : MySegments + --translate from attribute to occurrences + inst.segs = + map (\(MySegment visnr inhs syns _ _) -> + MySegment visnr inhs syns + (Just $ map (@lhs.pmprf Map.!) $ + handAllOut (@loc.ps,"lhs") $ + map (@lhs.nmp Map.!) inhs) + (Just $ map (@lhs.pmprf Map.!) $ + handAllOut (@loc.ps,"lhs") $ + map (@lhs.nmp Map.!) syns) + ) @lhs.mysegments + +{ +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 + + +}
+ src-ag/LOAG/Rep.ag view
@@ -0,0 +1,49 @@+MODULE {LOAG.Rep} +{}{ +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 +} +imports{ +import Data.List (intercalate, foldl', nub) +import Data.Tuple (swap) +import Control.Arrow +} + +DATA LOAGRep | LOAGRep + ps : {[PLabel]} + ap : A_P + an : A_N + ain : AI_N + asn : AS_N + sfp : SF_P + pmp : PMP + pmpr : PMP_R + nmp : NMP + nmpr : NMP_R + gen : {A.Array Int Int} + inss : {A.Array Int [Int]} + ofld : {A.Array Int Int} + fty : FTY + fieldMap : FMap + fsInP: {Map.Map PLabel [(PLabel,FLabel)]} + +TYPE FieldAtts = [FieldAtt] +-- t is the type of the attribute this occurrence belongs to +DATA FieldAtt | FieldAtt t : {MyType} p : {PLabel} + f : {FLabel} a : {ALabel} + +TYPE MySegments = [MySegment] +DATA MySegment | MySegment + visnr : Int + inhAttr : {[Int]} + synAttr : {[Int]} + inhOccs : {Maybe [Int]} + synOccs : {Maybe [Int]} + +DERIVING MySegments MySegment : Show + +
+ src-ag/Macro.ag view
@@ -0,0 +1,24 @@+--marcos: macros extension + +imports +{ +import CommonTypes +} + +TYPE MaybeMacro = MAYBE Macro + +DATA Macro | Macro con : {ConstructorIdent} + children : MacroChildren + | None + +TYPE MacroChildren = [MacroChild] + +DATA MacroChild | RuleChild name : {Identifier} + macro : Macro + | ChildChild name : {Identifier} + child : {Identifier} + + | ValueChild name : {Identifier} + value : {String} + +DERIVING MaybeMacro Macro MacroChildren MacroChild : Show
+ src-ag/Order.ag view
@@ -0,0 +1,809 @@+PRAGMA strictdata +PRAGMA strictwrap + +INCLUDE "Patterns.ag" +INCLUDE "Expression.ag" +INCLUDE "AbstractSyntax.ag" +INCLUDE "DistChildAttr.ag" + +imports +{ +-- 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 +} + +{ +-- 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 +} + +-- +-- Some statistics, count number of attributes +-- + +ATTR Grammar Nonterminals Nonterminal Productions Production Rules Rule [ | | nAutoRules,nExplicitRules USE {+} {0} : {Int} ] + +SEM Rule + | Rule lhs.nExplicitRules = if @explicit + then 1 + else 0 + lhs.nAutoRules = if startsWith "use rule" @origin || startsWith "copy rule" @origin + then 1 + else 0 + +{ +startsWith :: String -> String -> Bool +startsWith k h = k == take (length k) h +} + + +------------------------------------------------------------------------------- +-- Errors +------------------------------------------------------------------------------- +-- Everyone that wants to report an error can do this by adding an error message to the +-- stream of errors + +ATTR Nonterminals Nonterminal Productions Production + Child Children Rule Rules Pattern Patterns Grammar [ | | errors USE {Seq.><} {Seq.empty}:{Seq Error} ] + +------------------------------------------------------------------------------- +-- Distributing name of nonterminal and names of attributes +------------------------------------------------------------------------------- +ATTR Productions Production Child Children Rules Rule Patterns Pattern [ nt : {Identifier} inh,syn : {Attributes} | | ] +ATTR Child Children Rules Rule Patterns Pattern [ con : {Identifier} | | ] + +SEM Production + | Production children . con = @con +SEM Production + | Production rules . con = @con +SEM Nonterminal + | Nonterminal prods . nt = @nt + +SEM Nonterminal + | Nonterminal prods.inh = @inh + prods.syn = @syn + + +------------------------------------------------------------------------------- +-- Distributing options +------------------------------------------------------------------------------- + +ATTR Grammar [ options:{Options} | | ] +ATTR Nonterminals Nonterminal Productions Production Rules Rule + [ o_newtypes + , o_cata + , o_sig + , o_sem + , o_rename + , o_wantvisit -- True if the option for visit functions has been specified + , o_dovisit -- True if o_wantvisit and it is possible to generate visit functions (no cycles) + , o_case:{Bool} + prefix : {String} | | ] +ATTR Nonterminals Nonterminal Productions Production Children Child [ o_unbox:{Bool} | | ] +ATTR Nonterminals Nonterminal [ o_data:{Bool} | | ] + +SEM Grammar + | Grammar loc.o_dovisit = visit @lhs.options && null @cyclesErrors + nonts.o_cata = folds @lhs.options + .o_data = dataTypes @lhs.options + .o_sig = typeSigs @lhs.options + .o_sem = semfuns @lhs.options + .o_rename = rename @lhs.options + .o_newtypes= newtypes @lhs.options + .o_wantvisit = visit @lhs.options + .o_unbox = unbox @lhs.options + .o_case = cases @lhs.options + .prefix = prefix @lhs.options + +------------------------------------------------------------------ +-- Building a mapping from Vertices to Ints +------------------------------------------------------------------ +{ +getNtName :: Type -> NontermIdent +getNtName (NT nt _ _) = nt +getNtName _ = nullIdent +} + +------------------------------------------------------------------ +-- Collect attribute occurrences +-- +-- All attribute occurences in an alternative are gathered. +-- This is done by joining various sublists: +-- 1. inherited attributes for _LHS +-- 2a. synthesized attributes for children +-- 2b. children that are a trivial field +-- 3a. inherited attributes for children +-- 3b. synthesized attributes for _LHS +-- 3c. local attributes +-- +-- Sublist 3 is exactly the targets for ATTR definitions, and +-- thus can be obtained by traversing all rules. +-- +-- The (field,attr) combination is not enough to uniquely identify +-- an attribute occurence, because threaded attributes occur twice. +-- Therefore, in the AltAttr structures, a boolean is added, +-- that is False in sublists 3a and 3b, i.e. the non-local output fields. +-- +-- Each AltAttr, that is eacht attribute occurence, is mapped to a number +-- in the altAttrs Map, starting at vcount +{ +data AltAttr = AltAttr Identifier Identifier Bool + deriving (Eq, Ord, Show) +} +ATTR Rules Rule Production Productions Nonterminal Nonterminals + [ options : {Options} | | ] + +ATTR Children Child Rules Rule Patterns Pattern [ | | gathAltAttrs USE {++} {[]} : {[AltAttr]} ] +SEM Production + | Production loc.gathAltAttrs = [ AltAttr _LHS inh True | inh <- Map.keys @lhs.inh ] -- sublist 1 + ++ @children.gathAltAttrs -- sublist 2 + ++ @rules.gathAltAttrs -- sublist 3 + +SEM Child + | Child loc.maptolocal = case @tp of + NT nt _ _ -> Map.null @syn + _ -> True + lhs.gathAltAttrs = if @maptolocal + then [ AltAttr _LOC @name True ] -- sublist 2b + else [ AltAttr @name syn True | syn <- Map.keys @loc.syn ] -- sublist 2a +SEM Pattern + | Alias lhs.gathAltAttrs = [AltAttr @field @attr (@field == _LOC || @field == _INST)] -- sublist 3 + +ATTR Rules Rule Patterns Pattern [ altAttrs : {Map AltAttr Vertex} | | ] +SEM Production + | Production loc.altAttrs = Map.fromList (zip @gathAltAttrs [@lhs.vcount..]) + +-- Information passed to Pattern +ATTR Children Child + [ | | nts USE {Seq.><} {Seq.empty} : {Seq (Identifier,NontermIdent)} + inhs USE {Seq.><} {Seq.empty} : {Seq (Identifier,Attributes)} ] +SEM Child + | Child lhs.nts = Seq.singleton (@name,getNtName @tp) + lhs.inhs = Seq.singleton (@name,@loc.inh) +ATTR Rules Rule + [ childNts : {Map Identifier NontermIdent} + childInhs : {Map Identifier Attributes} | | ] +SEM Production + | Production rules.childNts = Map.fromList (toList @children.nts) + rules.childInhs = Map.fromList (toList @children.inhs) + +-- Collect CRules +ATTR Children Child Rules Rule + [ | | gathRules USE {Seq.><} {Seq.empty} : {Seq CRule} ] +SEM Production + | Production loc.inhRules = [ cRuleLhsInh inh @lhs.nt @con tp | (inh,tp) <- Map.assocs @lhs.inh ] + loc.gathRules = @inhRules ++ toList (@children.gathRules Seq.>< @rules.gathRules) + +SEM Child + | Child loc.gathRules = if @maptolocal + then Seq.singleton (cRuleTerminal @name @lhs.nt @lhs.con @tp) + else Seq.fromList [ cRuleRhsSyn syn @lhs.nt @lhs.con tp @name (getNtName @tp) | (syn,tp) <- Map.assocs @loc.syn] + +SEM Rule + | Rule loc.defines = let tp field attr | field == _LOC || field == _INST + = Map.lookup attr @lhs.allTypeSigs + | field == _LHS = Map.lookup attr @lhs.syn + | otherwise = Map.lookup attr (findWithErr1 "Rule.defines.tp" field @lhs.childInhs) + typ :: Pattern -> Maybe Type + typ (Alias field attr _) = tp field attr + typ (Underscore _) = Nothing + -- typ (Product _ pats) = tp _LOC undefined pats + typ _ = Nothing + + in Map.fromList [ (findWithErr1 "Rule.defines" aa @lhs.altAttrs, (field,attr,(tp field attr))) + | (field,attr,isLocalOrInst) <- @pattern.patternAttrs + , let aa = AltAttr field attr isLocalOrInst + ] + loc.gathRules = let childnt field = Map.lookup field @lhs.childNts + in Seq.fromList [ CRule attr False True @lhs.nt @lhs.con field (childnt field) tp @pattern.copy @rhs.textLines @defines @owrt @origin @rhs.allRhsVars @explicit @mbName + | (field,attr,tp) <- Map.elems @defines + ] + +{ +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))) ++ ")" )) +} + + +ATTR Patterns Pattern [ | | patternAttrs USE {++} {[]} : {[(Identifier,Identifier,Bool)]} ] + +SEM Pattern + | Alias lhs.patternAttrs = [(@field,@attr,(@field == _LOC || @field == _INST))] + + + +-- Giving them a number +ATTR Nonterminals Nonterminal Productions Production + [ | vcount : Int + | rules USE {Seq.><} {Seq.empty} : {Seq (Vertex,CRule)}] +SEM Grammar + | Grammar nonts.vcount = 0 +SEM Production + | Production lhs.rules = Seq.fromList (zip [@lhs.vcount..] @gathRules) + lhs.vcount = @lhs.vcount + length @gathRules + +-- Direct dependencies +ATTR Nonterminals Nonterminal + Productions Production + Rules Rule [ | | directDep USE {Seq.><} {Seq.empty} : {Seq Edge} ] +SEM Rule + | Rule lhs.directDep + = let defined = Map.keys @defines + used = [ Map.lookup (AltAttr field attr True) @lhs.altAttrs | (field,attr) <- @rhs.usedAttrs] + ++ [ Map.lookup (AltAttr _LOC attr True) @lhs.altAttrs | attr <- @rhs.usedLocals ++ @rhs.usedFields ] + in Seq.fromList [ (x,y) | Just x <- used, y <- defined ] + +-- Manual depdendencies (provided by the programmer) +-- +-- a dependency f1.a1 < f2.a2 is translated to +-- the edge (vertex(f1.a1), vertex(f2.a2)) +ATTR Nonterminals Nonterminal + Productions Production + [ manualAttrDepMap : {AttrOrderMap} | | additionalDep USE {Seq.><} {Seq.empty} : {Seq Edge} ] + +SEM Grammar + | Grammar + nonts.manualAttrDepMap = @manualAttrOrderMap + +SEM Production + | Production + loc.manualDeps + = Set.toList $ Map.findWithDefault Set.empty @con $ Map.findWithDefault Map.empty @lhs.nt @lhs.manualAttrDepMap + + lhs.additionalDep + = Seq.fromList [ (vertex True occA, vertex False occB) + | Dependency occA occB <- @loc.manualDeps + , let vertex inout (OccAttr child nm) + | child == _LOC = findWithErr2 (AltAttr _LOC nm True) @loc.altAttrs + | otherwise = findWithErr2 (AltAttr child nm inout) @loc.altAttrs + vertex _ (OccRule nm) + = findWithErr2 (AltAttr _LOC (Ident ("_rule_" ++ show nm) (getPos nm)) True) @loc.altAttrs + ] + +-- Inst dependencies +-- +-- For each inst attribute x of nt N, add the dependency +-- (inst.x,x.y) for each synthesized attribute of N +-- + +ATTR Nonterminals Nonterminal + Productions Production + Rules Rule [ | | instDep USE {Seq.><} {Seq.empty} : {Seq Edge} ] +SEM Rule + | Rule + loc.instDep1 + = Seq.fromList $ + [ (instVert, synVert) + | (field,instNm,_) <- Map.elems @defines + , field == _INST + , synNm <- Map.keys (findWithErr2 instNm @lhs.synsOfChildren) + , let instAttr = AltAttr _INST instNm True + synAttr = AltAttr instNm synNm True + instVert = findWithErr2 instAttr @lhs.altAttrs + synVert = findWithErr2 synAttr @lhs.altAttrs + ] + loc.instDep2 + = Seq.fromList $ + [ (instVert, inhVert) + | (field,instNm,_) <- Map.elems @defines + , field == _INST + , inhNm <- Map.keys (findWithErr2 instNm @lhs.inhsOfChildren) + , let instAttr = AltAttr _INST instNm True + inhAttr = AltAttr instNm inhNm False + instVert = findWithErr2 instAttr @lhs.altAttrs + inhVert = findWithErr2 inhAttr @lhs.altAttrs + ] + lhs.instDep = @loc.instDep1 Seq.>< @loc.instDep2 + +ATTR Rules Rule [ synsOfChildren, inhsOfChildren : {Map Identifier Attributes} | | ] +SEM Production + | Production rules.synsOfChildren = @children.collectChildrenSyns + rules.inhsOfChildren = @children.collectChildrenInhs + +ATTR Children Child [ | | collectChildrenSyns, collectChildrenInhs USE {`Map.union`} {Map.empty} : {Map Identifier Attributes } ] +SEM Child + | Child lhs.collectChildrenSyns = Map.singleton @name @loc.syn + lhs.collectChildrenInhs = Map.singleton @name @loc.inh + +-- +-- Merge stuff +-- + +ATTR Nonterminals Nonterminal + [ mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))} | | ] + +ATTR Productions Production + [ mergeMap : {Map ConstructorIdent (Map Identifier (Identifier,[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 + +ATTR Rules Rule Children Child Expression [ mergeMap : {Map Identifier (Identifier,[Identifier])} | | ] + +-- for a child c : N, with merged children cs, add dependencies between synthesized attrs of +-- c to synthesized attrs of cs, and to the merge-attribute +ATTR Nonterminals Nonterminal Productions Production + [ | | mergeDep USE {Seq.><} {Seq.empty} : {Seq Edge} ] + +SEM Production + | Production + lhs.mergeDep = @loc.mergeDep1 Seq.>< @loc.mergeDep2 + loc.mergeDep1 + = Seq.fromList $ + [ (childVert, synVert) + | childNm <- Map.keys @loc.mergeMap + , synNm <- Map.keys (findWithErr2 childNm @children.collectChildrenSyns) + , let childNm' = Ident (show childNm ++ "_merge") (getPos childNm) + childAttr = AltAttr _LOC childNm' True + synAttr = AltAttr childNm synNm True + childVert = findWithErr2 childAttr @loc.altAttrs + synVert = findWithErr2 synAttr @loc.altAttrs + ] + loc.mergeDep2 + = Seq.fromList $ + [ (mergedVert, sourceVert) + | (childNm, (_,cs)) <- Map.assocs @loc.mergeMap + , c <- cs + , synNm <- Map.keys (findWithErr2 childNm @children.collectChildrenSyns) + , let sourceAttr = AltAttr childNm synNm True + mergedAttr = AltAttr c synNm True + sourceVert = findWithErr2 sourceAttr @loc.altAttrs + mergedVert = findWithErr2 mergedAttr @loc.altAttrs + ] + + +-- Around dependencies +-- +-- For each around x_around on x of nt N, add the dependency +-- (x_around, x.y) for each synthesized attribute y of N +-- + +ATTR Nonterminals Nonterminal + Productions Production + [ | | aroundDep USE {Seq.><} {Seq.empty} : {Seq Edge} ] + +ATTR Nonterminals Nonterminal + [ aroundMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} || ] + +ATTR Productions Production + [ aroundMap : {Map ConstructorIdent (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 Production + | Production + loc.aroundDep1 + = Seq.fromList $ + [ (childVert, synVert) + | childNm <- Map.keys @loc.aroundMap + , synNm <- Map.keys (findWithErr2 childNm @children.collectChildrenSyns) + , let childNm' = Ident (show childNm ++ "_around") (getPos childNm) + childAttr = AltAttr _LOC childNm' True + synAttr = AltAttr childNm synNm True + childVert = findWithErr2 childAttr @loc.altAttrs + synVert = findWithErr2 synAttr @loc.altAttrs + ] + loc.aroundDep2 + = Seq.fromList $ + [ (childVert, inhVert) + | childNm <- Map.keys @loc.aroundMap + , inhNm <- Map.keys (findWithErr2 childNm @children.collectChildrenInhs) + , let childNm' = Ident (show childNm ++ "_around") (getPos childNm) + childAttr = AltAttr _LOC childNm' True + inhAttr = AltAttr childNm inhNm False + childVert = findWithErr2 childAttr @loc.altAttrs + inhVert = findWithErr2 inhAttr @loc.altAttrs + ] + lhs.aroundDep = @loc.aroundDep1 Seq.>< @loc.aroundDep2 + + +-- Wrapping an Expression + +ATTR Expression [ nt,con :{Identifier} + allfields:{[(Identifier,Type,ChildKind)]} + allnts :{[Identifier]} + attrs :{[(Identifier,Identifier)]} + options :{Options} + || + errors :{Seq Error} + usedLocals:{[Identifier]} + usedAttrs :{[(Identifier,Identifier)]} + usedFields:{[Identifier]} + textLines :{[String]} + copy : SELF + allRhsVars : {Set (Identifier,Identifier)} + ] + +-- appendum: filter out the syn attrs of merged children in the input attr list. +-- add the merged children to the used attr list +-- appendum: ignored the error reporting on expressions. These are already +-- reported by the separate 'ResolveLocals' pass. +SEM Expression + | Expression loc.(textLines,usedAttrs,usedLocals,usedFields) + = let mergedChildren = [ x | (_,xs) <- Map.elems @lhs.mergeMap, x <- xs ] + attrsIn = filter (\(fld,_) -> not (fld `elem` mergedChildren)) @lhs.attrs + inherited = Inh_HsTokensRoot + { attrs_Inh_HsTokensRoot = attrsIn + , con_Inh_HsTokensRoot = @lhs.con + , allfields_Inh_HsTokensRoot = @lhs.allfields + , allnts_Inh_HsTokensRoot = @lhs.allnts + , nt_Inh_HsTokensRoot = @lhs.nt + , options_Inh_HsTokensRoot = @lhs.options + } + 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 @lhs.mergeMap, isJust mbMerged + , let (Just (_, srcs)) = mbMerged, src <- srcs ] + usedAttrs' = usedAttrs ++ extraAttrs + in (textLines,usedAttrs',usedLocals,usedFields) + + lhs.errors = Seq.empty + lhs.allRhsVars = Set.fromList @loc.usedAttrs + `Set.union` + Set.fromList [ (_LOC, l) | l <- @loc.usedLocals] + `Set.union` + Set.fromList [ (_FIELD, fld) | fld <- @loc.usedFields] + + +------------------------------------- +-- NT-Attributes +------------------------------------- +ATTR Nonterminals Nonterminal + [ | acount : Int | ntattrs USE {Seq.><} {Seq.empty} : {Seq (Vertex,NTAttr)} + aranges USE {Seq.><} {Seq.empty} : {Seq (Int,Int,Int)}] + +SEM Grammar + | Grammar nonts.acount = 0 + +SEM Nonterminal + | Nonterminal loc.ntattrs = [ NTAInh @nt inh tp | (inh,tp) <- Map.assocs @inh ] + ++ [NTASyn @nt syn tp | (syn,tp) <- Map.assocs @syn ] + lhs.ntattrs = Seq.fromList (zip [@lhs.acount ..] @ntattrs) + lhs.acount = @lhs.acount + Map.size @inh + Map.size @syn + lhs.aranges = Seq.singleton + (@lhs.acount + ,@lhs.acount + Map.size @inh + ,@lhs.acount + Map.size @syn + Map.size @inh - 1) +------------------------------------------------------------------ +-- Pass structure up +------------------------------------------------------------------ +ATTR Nonterminals Nonterminal [ | | nonts USE {++} {[]} : {[(NontermIdent,[ConstructorIdent])]} ] +SEM Nonterminal + | Nonterminal lhs.nonts = [(@nt,@prods.cons)] +ATTR Productions Production [ | | cons USE {++} {[]} : {[ConstructorIdent]} ] +SEM Production + | Production lhs.cons = [@con] + +------------------------------------------------------------------ +-- Collect type signatures +------------------------------------------------------------------ +ATTR TypeSigs TypeSig [ | typeSigs : {Map Identifier Type} | ] +SEM Production + | Production typeSigs.typeSigs = Map.empty +SEM TypeSig + | TypeSig lhs.typeSigs = Map.insert @name @tp @lhs.typeSigs + +ATTR Rules Rule Patterns Pattern [ allTypeSigs : {Map Identifier Type} | | ] +SEM Production + | Production rules.allTypeSigs = @typeSigs.typeSigs + +------------------------------------------------------------------ +-- Invoking sequential computation +------------------------------------------------------------------ +SEM Grammar + | Grammar loc.ruleTable = Array.array (0,@nonts.vcount-1) (toList @nonts.rules) + loc.attrTable = Array.array (0,@nonts.acount-1) (toList @nonts.ntattrs) + loc.attrVertex = Map.fromList (map swap (toList @nonts.ntattrs)) + loc.tdpToTds = [ (s, maybe (-1) (\v -> findWithErr1 "Grammar.tdpToTds" v @attrVertex) (ntattr cr)) + | (s,cr) <- toList @nonts.rules] + loc.tdsToTdp = 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) + loc.directDep = toList (@nonts.directDep Seq.>< @nonts.additionalDep) + loc.instDep = toList @nonts.instDep + loc.aroundDep = toList @nonts.aroundDep + loc.mergeDep = toList @nonts.mergeDep + loc.info = let def [] = -1 + def (v:vs) = v + in Info { tdsToTdp = Array.array (0,@nonts.acount-1) @tdsToTdp + , tdpToTds = Array.array (0,@nonts.vcount-1) @tdpToTds + , attrTable = @attrTable + , ruleTable = @ruleTable + , lmh = toList @nonts.aranges + , nonts = @nonts.nonts + , wraps = @wrappers + } + + loc.(cInterfaceMap,cVisitsMap,cyclesErrors) = + case computeSequential @info @directDep (@instDep ++ @aroundDep ++ @loc.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 @lhs.options)) 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 @lhs.options)) 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 @lhs.options) errs + ) + InducedCycle cim errs -> ( cim + , error "No visit sub-sequences for AG with induced cycles" + , inducedCycleErrs @attrTable @ruleTable cim errs + ) + lhs.errors = (if withCycle @lhs.options then Seq.fromList @cyclesErrors else Seq.empty) + Seq.>< @nonts.errors + +------------------------------------------------------------------ +-- Generate CGrammar +------------------------------------------------------------------ +-- Pass InterfaceMap down and select the Interface in the Nonterminal +ATTR Nonterminals Nonterminal [ cInterfaceMap : CInterfaceMap | | ] +SEM Nonterminal + | Nonterminal loc.cInter = if @lhs.o_dovisit + then findWithErr1 "Nonterminal.cInter" @nt @lhs.cInterfaceMap + else CInterface [CSegment @inh @syn] + +-- Pass VisitMap down and select the CVisits in the Production +ATTR Nonterminals Nonterminal Productions Production [ cVisitsMap : CVisitsMap | | ] +SEM Production + | Production loc.cVisits = if @lhs.o_dovisit + then let prodsVisitsMap = findWithErr1 "Production.cVisits.nt" @lhs.nt @lhs.cVisitsMap + visits = findWithErr1 "Production.cVisits.con" @con prodsVisitsMap + in visits + else let vss = nubBy eqCRuleDefines @gathRules ++ @children.singlevisits + in [CVisit @lhs.inh @lhs.syn vss [] False] + +-- Declarations for single visits +ATTR Child Children [ | | singlevisits USE {++} {[]}: {[CRule]}] +SEM Child + | Child lhs.singlevisits = if @maptolocal + then [] + else [CChildVisit @name (getNtName @tp) 0 @loc.inh @loc.syn True] + +-- Now just build the CGrammar +SEM Grammar [ | | output : CGrammar ] + | Grammar lhs.output = CGrammar @typeSyns @derivings @wrappers @nonts.cNonterminals @pragmas @paramMap @contextMap @quantMap @loc.aroundMap @loc.mergeMap @loc.o_dovisit +SEM Nonterminals [ | | cNonterminals : CNonterminals ] + | Cons lhs.cNonterminals = @hd.cNonterminal : @tl.cNonterminals + | Nil lhs.cNonterminals = [] +SEM Nonterminal [ | | cNonterminal : CNonterminal ] + | Nonterminal lhs.cNonterminal = CNonterminal @nt @params @inh @syn @prods.cProductions @cInter +SEM Productions [ | | cProductions : CProductions ] + | Cons lhs.cProductions = @hd.cProduction : @tl.cProductions + | Nil lhs.cProductions = [] +SEM Production [ | | cProduction : CProduction ] + | Production lhs.cProduction = CProduction @con @cVisits @children.fields @children.terminals + +SEM Grammar + | Grammar loc.aroundMap = Map.map (Map.map Map.keysSet) @aroundsMap + loc.mergeMap = Map.map (Map.map (Map.map (\(nt,srcs,_) -> (nt,srcs)))) @mergeMap + +-- Collect terminals +ATTR Children Child [ | | terminals USE {++} {[]} : {[Identifier]} ] +SEM Child + | Child lhs.terminals = if @maptolocal + then [@name] + else [] + + +-- Collecting nts +ATTR Nonterminal Nonterminals + Production Productions + Rule Rules + Child Children [allnts:{[Identifier]} | | ] + +SEM Grammar + | Grammar nonts.allnts = map fst (@nonts.nonts) + +-- Collecting fields +ATTR Rule Rules + Child Children [allfields:{[(Identifier,Type,ChildKind)]} attrs:{[(Identifier,Identifier)]} | | ] + +SEM Production + | Production loc.allfields = @children.fields + .attrs = map ((,) _LOC) @rules.locVars ++ + map ((,) _INST) @rules.instVars ++ + map ((,) _LHS) @inhnames ++ + concat [map ((,) nm) (Map.keys as) | (nm,_,as) <- @children.attributes] + .inhnames = Map.keys @lhs.inh + .synnames = Map.keys @lhs.syn + +ATTR Children [ | | attributes USE {++} {[]} : {[(Identifier,Attributes,Attributes)]} ] +SEM Child [ | | attributes:{[(Identifier,Attributes,Attributes)]} ] + | Child lhs.attributes = [(@name, @loc.inh, @loc.syn)] + + +SEM Child [ | | field : {(Identifier,Type,ChildKind)} ] + | Child lhs.field = (@name, @tp, @kind) + +SEM Children [ | | fields : {[(Identifier,Type,ChildKind)]} ] + | Cons lhs.fields = @hd.field : @tl.fields + | Nil lhs.fields = [] + +ATTR Rules Rule Patterns Pattern [ | | locVars USE {++} {[]}:{[Identifier]} instVars USE {++} {[]} : {[Identifier]} ] + +SEM Pattern + | Alias lhs.locVars = if @field == _LOC + then [@attr] + else [] + lhs.instVars = if @field == _INST + then [@attr] + else [] + +{ +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<n = xs ++ replicate (n-k) ' ' + | otherwise = xs + where k = length xs + +alignR n xs | k<n = replicate (n-k) ' ' ++ xs + | otherwise = xs + where k = length xs + +localCycleErr :: Table CRule -> 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) +}
+ src-ag/Patterns.ag view
@@ -0,0 +1,25 @@+imports +{ +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +} + +TYPE Patterns = [Pattern] + +DATA Pattern | Constr name : {ConstructorIdent} + pats : Patterns + | Product pos : {Pos} + pats : Patterns + | Alias field : {Identifier} + attr : {Identifier} + pat : Pattern + | Irrefutable pat : Pattern + | Underscore pos : {Pos} + +DERIVING Pattern:Show + +ATTR AllPattern [ | | copy : SELF ] + +SET AllPattern + = Pattern Patterns
+ src-ag/PrintCleanCode.ag view
@@ -0,0 +1,563 @@+PRAGMA strictdata +PRAGMA optimize +PRAGMA bangpats +PRAGMA strictwrap + +INCLUDE "Code.ag" +INCLUDE "Patterns.ag" + +imports +{ +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(..)) +} + +{ +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 +} + +ATTR Expr Exprs Decl Decls CaseAlt CaseAlts Lhs [ outputfile : {String} | | ] + +SEM Chunk + | Chunk + loc.outputfile = if sepSemMods @lhs.options + then replaceBaseName @lhs.mainFile (takeBaseName @lhs.mainFile ++ "_" ++ @name) + else @lhs.mainFile + +ATTR Program [ options:{Options} | | output:{PP_Docs} ] + +ATTR Expr Exprs Decl Decls Chunk Chunks CaseAlts CaseAlt Lhs Pattern Patterns [ options:{Options} | | ] + +ATTR Expr Decl DataAlt Type NamedType Lhs [ nested:{Bool} | | pp:{PP_Doc} ] +ATTR Decl DataAlt NamedType [ | | ppa USE {>-<} {empty} : {PP_Doc}] + +ATTR Exprs DataAlts Types NamedTypes Decls Chunk Chunks [ nested:{Bool} | | pps : {PP_Docs} ] +ATTR DataAlts NamedTypes [ | | ppas : {PP_Docs} ] + +ATTR CaseAlt CaseAlts [ nested:{Bool} | | pps: {PP_Docs} ] + +ATTR Type Types [ | | copy : SELF] + +SEM Program | Program + loc.options = @lhs.options { breadthFirst = breadthFirst @lhs.options && visit @lhs.options && cases @lhs.options && @ordered } + +SEM Program + | Program chunks.nested = nest @lhs.options + +SEM Exprs + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM CaseAlts + | Cons lhs.pps = @hd.pps ++ @tl.pps + | Nil lhs.pps = [] + +SEM DataAlts + | Cons lhs.pps = @hd.pp : @tl.pps + lhs.ppas = @hd.ppa : @tl.ppas + | Nil lhs.pps = [] + lhs.ppas = [] + +SEM Types + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM NamedTypes + | Cons lhs.pps = @hd.pp : @tl.pps + lhs.ppas = @hd.ppa : @tl.ppas + | Nil lhs.pps = [] + lhs.ppas = [] + +SEM Decls + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM Chunks + | Cons lhs.pps = @hd.pps ++ @tl.pps + | Nil lhs.pps = [] + + +SEM Program + | Program lhs.output = @chunks.pps + +SEM Chunk + | Chunk lhs.pps = @comment.pp + : @info.pps + ++ @dataDef.pps + ++ @cataFun.pps + ++ @semDom.pps + ++ @semWrapper.pps + ++ @semFunctions.pps + ++ [Map.findWithDefault empty (BlockOther, Just $ identifier @name) @lhs.textBlockMap] + +SEM Decl + | Decl lhs.pp = @left.pp >#< "=" + >-< indent 4 @rhs.pp + | Bind lhs.pp = @left.pp >#< "<-" >#< @rhs.pp + | BindLet lhs.pp = "let" >#< @left.pp >#< "=" >#< @rhs.pp + | Data lhs.pp = "::" >#< hv_sp (@name : @params) + >#< ( case @alts.pps of + [] -> empty + (x:xs) -> "=" >#< x + >-< vlist (map ("|" >#<) xs) + >-< if null @derivings + then empty + else "deriving" >#< ppTuple False (map text @derivings) + ) + >-< foldr (>-<) empty @alts.ppas + + | NewType lhs.pp = "::" >#< hv_sp (@name : @params) >#< "=" >#< @con >#< pp_parens @tp.pp + | Type lhs.pp = "::" >#< hv_sp (@name : @params) >#< ":==" >#< @tp.pp + | TSig lhs.pp = @name >#< "::" >#< @tp.pp + | Comment lhs.pp = if '\n' `elem` @txt + then "/*" >-< vlist (lines @txt) >-< "*/" + else "//" >#< @txt + | PragmaDecl lhs.pp = "/*#" >#< text @txt >#< "#*/" -- Not used in Clean + | Resume lhs.pp = if @monadic + then @left.pp >#< "<-" >#< @rhs.pp + else @left.pp >#< "=" >-< indent 4 @rhs.pp + | EvalDecl loc.strat = if breadthFirstStrict @lhs.options + then "stepwiseEval" + else "lazyEval" + lhs.pp = if breadthFirst @lhs.options + then @left.pp >#< "=" >#< "case" >#< @loc.strat >#< pp_parens @rhs.pp >#< "of" + >-< indent 4 ( + pp_parens (@nt >|< "_Syn" >#< "_val") >#< "-> _val" + ) + else @left.pp >#< "=" >#< @rhs.pp + +SEM Expr + | Let lhs.pp = pp_parens ( "let" >#< (vlist @decls.pps) + >-< "in " >#< @body.pp + ) + | Case lhs.pp = pp_parens ( "case" >#< pp_parens @expr.pp >#< "of" + >-< (vlist @alts.pps) + ) + | Do lhs.pp = pp_parens ( "do" >#< ( vlist @stmts.pps + >-< ("return" >#< @body.pp)) + ) + | Lambda loc.strictParams = if strictSems @lhs.options + then @args.pps + else [] + loc.addBang = if bangpats @lhs.options + then \p -> pp_parens ("!" >|< p) + else id + lhs.pp = pp_parens ( "\\" >#< (vlist (map @loc.addBang @args.pps)) >#< "->" + >-< indent 4 (@loc.strictParams `ppMultiSeqV` @body.pp) + ) + | TupleExpr lhs.pp = ppTuple @lhs.nested @exprs.pps + | UnboxedTupleExpr lhs.pp = ppUnboxedTuple @lhs.nested @exprs.pps + | App lhs.pp = pp_parens $ @name >#< hv_sp @args.pps + | SimpleExpr lhs.pp = text @txt + | TextExpr lhs.pp = vlist (map text @lns) + | Trace lhs.pp = "trace" >#< ( pp_parens ("\"" >|< text @txt >|< "\"") + >-< pp_parens @expr.pp + ) + | PragmaExpr lhs.pp = let pragmaDoc = "/*#" >#< @txt >#< "#*/" -- Not used in Clean + 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` @expr.pp `rightOp` pragmaDoc) + | LineExpr lhs.pp = @expr.pp >-< "/*# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show @lhs.outputfile >#< "#*/" + >-< "" + | TypedExpr lhs.pp = pp_parens (@expr.pp >#< "::" >#< @tp.pp) + | ResultExpr lhs.pp = if breadthFirst @lhs.options + then "final" >#< + pp_parens (@nt >|< "_Syn" >#< pp_parens @expr.pp) + else @expr.pp + | InvokeExpr lhs.pp = if breadthFirst @lhs.options + then "invoke" >#< pp_parens @expr.pp >#< pp_parens ( + @nt >|< "_Inh" >#< pp_parens (ppTuple False @args.pps)) + else @expr.pp >#< hv_sp @args.pps + | ResumeExpr lhs.pp = if breadthFirst @lhs.options + then pp_parens ("resume" >#< pp_parens @expr.pp + >-< indent 2 (pp_parens ( "\\" >|< + pp_parens ("~" >|< pp_parens (@nt >|< "_Syn" >#< "_inh_arg")) + >#< "->" + >-< indent 2 ( "let" >#< @left.pp >#< "= _inh_arg" + >-< indent 2 ("in" >#< @rhs.pp) + )))) + else pp_parens ( "case" >#< pp_parens @expr.pp >#< "of" + >-< ("{" >#< @left.pp >#< "->") + >-< indent 4 (@rhs.pp >#< "}") + ) + | SemFun loc.strictParams = if strictSems @lhs.options + then @args.pps + else [] + loc.addBang = if bangpats @lhs.options + then \p -> pp_parens ("!" >|< p) + else id + lhs.pp = if breadthFirst @lhs.options + then "Child" >#< pp_parens ( "\\" >|< + pp_parens (@nt >|< "_Inh" >#< + ppTuple False (map @loc.addBang @args.pps)) >#< "->" + >-< indent 2 (@loc.strictParams `ppMultiSeqV` @body.pp)) + else if null @args.pps + then @body.pp + else pp_parens ( "\\" >#< (vlist (map @loc.addBang @args.pps)) >#< "->" + >-< indent 4 (@loc.strictParams `ppMultiSeqV` @body.pp) + ) + +SEM CaseAlt + | CaseAlt lhs.pps = ["{" >#< @left.pp >#< "->", @expr.pp >#< "}"] + +SEM DataAlt + | DataAlt lhs.pp = @name >#< hv_sp (map ((@lhs.strictPre >|<) . pp_parens) @args.pps) + lhs.ppa = empty + | Record lhs.pp = @name >#< hv_sp (map ((@lhs.strictPre >|<) . pp_parens) @args.pps) -- @name >#< pp_block "{" "}" "," @args.pps + lhs.ppa = let f n d = d >#< (pp_block ("(" ++ @name) ")" "" $ map pp (ppat n)) + >#< pp "=" >#< pp "x" + ppat n = replicate (length @args.ppas - n - 1) (pp " _") ++ [pp " x"] ++ replicate n (pp " _") + in snd $ foldr (\x (n, xs) -> (n + 1, f n x >-< xs)) (0, empty) @args.ppas + +SEM NamedType + | Named lhs.pp = -- @name >#< "::" >#< + if @strict + then "!" >|< pp_parens @tp.pp + else @tp.pp + lhs.ppa = pp @name + +SEM Lhs + | Pattern3 TupleLhs UnboxedTupleLhs + loc.addStrictGuard = if strictCases @lhs.options && @loc.hasStrictVars then \v -> v >#< "|" >#< @loc.strictGuard else id + | Pattern3 + loc.strictGuard = @pat3.strictVars `ppMultiSeqH` (pp "True") + loc.hasStrictVars = not (null @pat3.strictVars) + | TupleLhs UnboxedTupleLhs + loc.strictGuard = if stricterCases @lhs.options && not @lhs.isDeclOfLet + then map text @comps `ppMultiSeqH` (pp "True") + else pp "True" + loc.hasStrictVars = not (null @comps) + + | Fun + loc.addStrictGuard = if strictSems @lhs.options && @loc.hasStrictVars then \v -> v >#< "|" >#< @loc.strictGuard else id + loc.hasStrictVars = not (null @args.pps) + loc.strictGuard = @args.pps `ppMultiSeqH` (pp "True") + + | TupleLhs UnboxedTupleLhs Fun + loc.addBang = if bangpats @lhs.options + then \p -> "!" >|< p + else id + + | Pattern3 lhs.pp = @loc.addStrictGuard @pat3.pp + | Pattern3SM lhs.pp = @pat3.pp' + | TupleLhs lhs.pp = @loc.addStrictGuard $ ppTuple @lhs.nested (map (@loc.addBang . text) @comps) + | UnboxedTupleLhs lhs.pp = @loc.addStrictGuard $ ppUnboxedTuple @lhs.nested (map (@loc.addBang . text) @comps) + | Fun lhs.pp = @loc.addStrictGuard (@name >#< hv_sp (map @loc.addBang @args.pps)) + | Unwrap lhs.pp = pp_parens (@name >#< @sub.pp) + +SEM Type [ | | prec:Int ] + | Arr lhs.prec = 2 + .pp = case @right.copy of + Arr{} -> @loc.l >-< @loc.r + _ -> @loc.l >#< "->" >-< @loc.r + loc.l = if @left.prec <= 2 then pp_parens @left.pp else @left.pp + .r = if @right.prec < 2 then pp_parens @right.pp else @right.pp + + | TypeApp + lhs.pp = pp "(" >#< hv_sp (@func.pp : @args.pps) >#< pp ")"-- TODO: Check + + | CtxApp + lhs.pp = @right.pp >#< " | " >#< (pp_block "" "" "&" $ map (\(n,ns) -> hv_sp $ map pp (n:ns)) @left) + | QuantApp + lhs.pp = @left >#< @right.pp + + | TupleType lhs.prec = 5 + .pp = ppTuple @lhs.nested @tps.pps + + | UnboxedTupleType lhs.prec = 5 + .pp = ppUnboxedTuple @lhs.nested @tps.pps + + | List lhs.prec = 5 + .pp = "[" >|< @tp.pp >|< "]" + + | SimpleType lhs.prec = 5 + .pp = if reallySimple @txt then text @txt else pp_parens (text @txt) + + | NontermType lhs.prec = 5 + lhs.pp = @loc.prefix >|< text @name >#< hv_sp @params + loc.prefix = if @deforested + then text "T_" + else empty + | TMaybe lhs.prec = 5 + lhs.pp = text "Maybe" >#< pp_parens @tp.pp + | TEither lhs.prec = 5 + lhs.pp = text "Either" >#< pp_parens @left.pp >#< pp_parens @right.pp + | TMap lhs.prec = 5 + lhs.pp = text "'Data.Map'.Map" >#< pp_parens @key.pp >#< pp_parens @value.pp + | TIntMap lhs.prec = 5 + lhs.pp = text "'Data.IntMap'.IntMap" >#< pp_parens @value.pp + | TSet lhs.prec = 5 + lhs.pp = text "'Data.Set'.Set" >#< pp_parens @tp.pp + | TIntSet lhs.prec = 5 + lhs.pp = text "'Data.IntSet'.IntSet" + + +{ + +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 + +} + + +------------------------------------------------------------------------------- +-- Strict data fields +------------------------------------------------------------------------------- + +ATTR DataAlt DataAlts [ strictPre: PP_Doc | | ] + +SEM Decl + | Data alts.strictPre = if @strict then pp "!" else empty + +------------------------------------------------------------------------------- +-- Strict variables +------------------------------------------------------------------------------- + +ATTR Pattern Patterns [ | | strictVars USE {++} {[]} : {[PP_Doc]} ] +SEM Pattern + | Alias + loc.strictVar + = if strictCases @lhs.options && not @lhs.isDeclOfLet + then [@loc.ppVar] + else [] + loc.strictPatVars + = if stricterCases @lhs.options && not @lhs.isDeclOfLet + then @pat.strictVars + else [] + lhs.strictVars + = @loc.strictVar ++ @loc.strictPatVars + | Irrefutable + lhs.strictVars = [] + +------------------------------------------------------------------------------- +-- Pretty printing patterns +------------------------------------------------------------------------------- + +SEM Patterns [ | | pps : {[PP_Doc]} ] + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM Pattern + | Constr Product Alias + loc.addBang = if bangpats @lhs.options && not @lhs.isDeclOfLet && not @lhs.belowIrrefutable + then \p -> "!" >|< p + else id + +SEM Pattern [ | | pp:PP_Doc ] + | Constr lhs.pp = @loc.addBang $ pp_parens $ @name >#< hv_sp @pats.pps + | Product lhs.pp = @loc.addBang $ pp_block "(" ")" "," @pats.pps + | Alias loc.ppVar = pp (attrname @lhs.options False @field @attr) + loc.ppVarBang = @loc.addBang $ @loc.ppVar + lhs.pp = if @pat.isUnderscore + then @loc.ppVarBang + else @loc.ppVarBang >|< "@" >|< @pat.pp + | Irrefutable lhs.pp = text "~" >|< pp_parens @pat.pp + | Underscore lhs.pp = text "_" + +SEM Pattern [ | | isUnderscore:{Bool}] + | Constr lhs.isUnderscore = False + | Product lhs.isUnderscore = False + | Alias lhs.isUnderscore = False + | Underscore lhs.isUnderscore = True + +ATTR Pattern Patterns [ belowIrrefutable : Bool | | ] +SEM Pattern + | Irrefutable + pat.belowIrrefutable = True + +SEM Lhs + | Pattern3 Pattern3SM + pat3.belowIrrefutable = False + +------------------------------------------------------------------------------- +-- Pretty printing patterns for SM +------------------------------------------------------------------------------- + +SEM Patterns [ | | pps' : {[PP_Doc]} ] + | Cons lhs.pps' = @hd.pp' : @tl.pps' + | Nil lhs.pps' = [] + +SEM Pattern [ | | pp':PP_Doc ] + | Constr lhs.pp' = pp_parens $ @name >#< hv_sp (map pp_parens @pats.pps') + | Product lhs.pp' = pp_block "(" ")" "," @pats.pps' + | Alias lhs.pp' = let attribute | @field == _LOC || @field == nullIdent = locname' @attr + | otherwise = attrname @lhs.options False @field @attr + in attribute >|< "@" >|< @pat.pp' + | Irrefutable lhs.pp' = text "~" >|< pp_parens @pat.pp + | Underscore lhs.pp' = text "_" + +{ +locname' :: Identifier -> [Char] +locname' n = "_loc_" ++ getName n +} + +------------------------------------------------------------------------------- +-- Determine if inside a Let +------------------------------------------------------------------------------- + +ATTR Chunks Chunk Decls Decl Lhs Pattern Patterns [ isDeclOfLet : Bool | | ] +SEM Program + | Program + chunks.isDeclOfLet = False + +SEM Expr + | Let + decls.isDeclOfLet = True + | Do + stmts.isDeclOfLet = False + | ResumeExpr + left.isDeclOfLet = False + +SEM CaseAlt + | CaseAlt + left.isDeclOfLet = False + + + +------------------------------------------------------------------------------- +-- Alternative code printing to separate modules +------------------------------------------------------------------------------- + +ATTR Program [ mainBlocksDoc : PP_Doc | | genIO : {IO ()} ] +ATTR Program Chunks Chunk + [ importBlocks : PP_Doc + pragmaBlocks : String + textBlocks : PP_Doc + textBlockMap : {Map BlockInfo PP_Doc} + optionsLine : String + mainFile : String + mainName : String + moduleHeader : {String -> String -> String -> Bool -> String} + | | ] + +SEM Program + | Program + loc.mainModuleFile = @lhs.mainFile + loc.genMainModule + = writeModule @loc.mainModuleFile + ( [ pp $ @lhs.pragmaBlocks + , pp $ @lhs.optionsLine + , pp $ @lhs.moduleHeader @lhs.mainName "" "" False + , pp $ ("import " ++ @lhs.mainName ++ "_common\n") + ] + ++ map pp @chunks.imports + ++ map vlist @chunks.appendMain + ++ [@lhs.mainBlocksDoc] + ) + + loc.commonFile = replaceBaseName @lhs.mainFile (takeBaseName @lhs.mainFile ++ "_common") + loc.genCommonModule + = writeModule @loc.commonFile + ( [ pp $ @lhs.pragmaBlocks + , pp $ @lhs.optionsLine + , pp $ @lhs.moduleHeader @lhs.mainName "_common" "" True + , @lhs.importBlocks + , @lhs.textBlocks + ] + ++ map vlist @chunks.appendCommon + ) + + lhs.genIO = do @loc.genMainModule + @loc.genCommonModule + @chunks.genSems + +{ +renderDocs :: [PP_Doc] -> String +renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) "" +} + +ATTR Chunk Chunks [ | | imports USE {++} {[]} : {[String]} ] +SEM Chunk + | Chunk + lhs.imports = ["import " ++ @lhs.mainName ++ "_" ++ @name ++ "\n"] + +ATTR Chunk Chunks [ | | appendCommon, appendMain USE {++} {[]} : {[[PP_Doc]]} ] + +SEM Chunk + | Chunk + lhs.appendCommon + = [ [@comment.pp] + , @dataDef.pps + , @semDom.pps + , if reference @lhs.options then @semWrapper.pps else [] + ] + lhs.appendMain + = [ [@comment.pp] + , @cataFun.pps + , if reference @lhs.options then [] else @semWrapper.pps + ] + +ATTR Chunk Chunks [ | | genSems USE {>>} {return ()} : {IO ()} ] + +SEM Chunk + | Chunk + lhs.genSems + = writeModule @loc.outputfile + [ pp $ @lhs.pragmaBlocks + , pp $ Map.findWithDefault empty (BlockPragma, Just $ identifier @name) @lhs.textBlockMap + , pp $ @lhs.optionsLine + , pp $ @lhs.moduleHeader @lhs.mainName ("_" ++ @name) @loc.exports True + , pp $ ("import " ++ @lhs.mainName ++ "_common\n") + , pp $ Map.findWithDefault empty (BlockImport, Just $ identifier @name) @lhs.textBlockMap + , @comment.pp + , vlist_sep "" @info.pps + , vlist_sep "" @semFunctions.pps + , Map.findWithDefault empty (BlockOther, Just $ identifier @name) @lhs.textBlockMap + ] + +SEM Chunk + | Chunk + loc.exports = concat $ intersperse "," @semNames + +{ +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 +} +
+ src-ag/PrintCode.ag view
@@ -0,0 +1,542 @@+PRAGMA strictdata +PRAGMA optimize +PRAGMA bangpats +PRAGMA strictwrap + +INCLUDE "Code.ag" +INCLUDE "Patterns.ag" + +imports +{ +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(..)) +} + +{ +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 +} + +ATTR Expr Exprs Decl Decls CaseAlt CaseAlts Lhs [ outputfile : {String} | | ] + +SEM Chunk + | Chunk + loc.outputfile = if sepSemMods @lhs.options + then replaceBaseName @lhs.mainFile (takeBaseName @lhs.mainFile ++ "_" ++ @name) + else @lhs.mainFile + +ATTR Program [ options:{Options} | | output:{PP_Docs} ] + +ATTR Expr Exprs Decl Decls Chunk Chunks CaseAlts CaseAlt Lhs Pattern Patterns [ options:{Options} | | ] + +ATTR Expr Decl DataAlt Type NamedType Lhs [ nested:{Bool} | | pp:{PP_Doc} ] + +ATTR Exprs DataAlts Types NamedTypes Decls Chunk Chunks [ nested:{Bool} | | pps : {PP_Docs} ] + +ATTR CaseAlt CaseAlts [ nested:{Bool} | | pps: {PP_Docs} ] + +SEM Program | Program + loc.options = @lhs.options { breadthFirst = breadthFirst @lhs.options && visit @lhs.options && cases @lhs.options && @ordered } + +SEM Program + | Program chunks.nested = nest @lhs.options + +SEM Exprs + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM CaseAlts + | Cons lhs.pps = @hd.pps ++ @tl.pps + | Nil lhs.pps = [] + +SEM DataAlts + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM Types + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM NamedTypes + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM Decls + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM Chunks + | Cons lhs.pps = @hd.pps ++ @tl.pps + | Nil lhs.pps = [] + + +SEM Program + | Program lhs.output = @chunks.pps + +SEM Chunk + | Chunk lhs.pps = @comment.pp + : @info.pps + ++ @dataDef.pps + ++ @cataFun.pps + ++ @semDom.pps + ++ @semWrapper.pps + ++ @semFunctions.pps + ++ [Map.findWithDefault empty (BlockOther, Just $ identifier @name) @lhs.textBlockMap] + +SEM Decl + | Decl lhs.pp = @left.pp >#< "=" + >-< indent 4 @rhs.pp + | Bind lhs.pp = @left.pp >#< "<-" >#< @rhs.pp + | BindLet lhs.pp = "let" >#< @left.pp >#< "=" >#< @rhs.pp + | Data lhs.pp = "data" >#< hv_sp (@name : @params) + >#< ( case @alts.pps of + [] -> empty + (x:xs) -> "=" >#< x + >-< vlist (map ("|" >#<) xs) + >-< if null @derivings + then empty + else "deriving" >#< ppTuple False (map text @derivings) + ) + | NewType lhs.pp = "newtype" >#< hv_sp (@name : @params) >#< "=" >#< @con >#< pp_parens @tp.pp + | Type lhs.pp = "type" >#< hv_sp (@name : @params) >#< "=" >#< @tp.pp + | TSig lhs.pp = @name >#< "::" >#< @tp.pp + | Comment lhs.pp = if '\n' `elem` @txt + then "{-" >-< vlist (lines @txt) >-< "-}" + else "--" >#< @txt + | PragmaDecl lhs.pp = "{-#" >#< text @txt >#< "#-}" + | Resume lhs.pp = if @monadic + then @left.pp >#< "<-" >#< @rhs.pp + else @left.pp >#< "=" >-< indent 4 @rhs.pp + | EvalDecl loc.strat = if breadthFirstStrict @lhs.options + then "stepwiseEval" + else "lazyEval" + lhs.pp = if breadthFirst @lhs.options + then @left.pp >#< "=" >#< "case" >#< @loc.strat >#< pp_parens @rhs.pp >#< "of" + >-< indent 4 ( + pp_parens (@nt >|< "_Syn" >#< "_val") >#< "-> _val" + ) + else @left.pp >#< "=" >#< @rhs.pp + +SEM Expr + | Let lhs.pp = pp_parens ( "let" >#< (vlist @decls.pps) + >-< "in " >#< @body.pp + ) + | Case lhs.pp = pp_parens ( "case" >#< pp_parens @expr.pp >#< "of" + >-< (vlist @alts.pps) + ) + | Do lhs.pp = pp_parens ( "do" >#< ( vlist @stmts.pps + >-< ("return" >#< @body.pp)) + ) + | Lambda loc.strictParams = if strictSems @lhs.options + then @args.pps + else [] + loc.addBang = if bangpats @lhs.options + then \p -> pp_parens ("!" >|< p) + else id + lhs.pp = pp_parens ( "\\" >#< (vlist (map @loc.addBang @args.pps)) >#< "->" + >-< indent 4 (@loc.strictParams `ppMultiSeqV` @body.pp) + ) + | TupleExpr lhs.pp = ppTuple @lhs.nested @exprs.pps + | UnboxedTupleExpr lhs.pp = ppUnboxedTuple @lhs.nested @exprs.pps + | App lhs.pp = pp_parens $ @name >#< hv_sp @args.pps + | SimpleExpr lhs.pp = text @txt + | TextExpr lhs.pp = vlist (map text @lns) + | Trace lhs.pp = "trace" >#< ( pp_parens ("\"" >|< text @txt >|< "\"") + >-< pp_parens @expr.pp + ) + | PragmaExpr lhs.pp = 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` @expr.pp `rightOp` pragmaDoc) + | LineExpr lhs.pp = @expr.pp >-< "{-# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show @lhs.outputfile >#< "#-}" + >-< "" + | TypedExpr lhs.pp = pp_parens (@expr.pp >#< "::" >#< @tp.pp) + | ResultExpr lhs.pp = if breadthFirst @lhs.options + then "final" >#< + pp_parens (@nt >|< "_Syn" >#< pp_parens @expr.pp) + else @expr.pp + | InvokeExpr lhs.pp = if breadthFirst @lhs.options + then "invoke" >#< pp_parens @expr.pp >#< pp_parens ( + @nt >|< "_Inh" >#< pp_parens (ppTuple False @args.pps)) + else @expr.pp >#< hv_sp @args.pps + | ResumeExpr lhs.pp = if breadthFirst @lhs.options + then pp_parens ("resume" >#< pp_parens @expr.pp + >-< indent 2 (pp_parens ( "\\" >|< + pp_parens ("~" >|< pp_parens (@nt >|< "_Syn" >#< "_inh_arg")) + >#< "->" + >-< indent 2 ( "let" >#< @left.pp >#< "= _inh_arg" + >-< indent 2 ("in" >#< @rhs.pp) + )))) + else pp_parens ( "case" >#< pp_parens @expr.pp >#< "of" + >-< ("{" >#< @left.pp >#< "->") + >-< indent 4 (@rhs.pp >#< "}") + ) + | SemFun loc.strictParams = if strictSems @lhs.options + then @args.pps + else [] + loc.addBang = if bangpats @lhs.options + then \p -> pp_parens ("!" >|< p) + else id + lhs.pp = if breadthFirst @lhs.options + then "Child" >#< pp_parens ( "\\" >|< + pp_parens (@nt >|< "_Inh" >#< + ppTuple False (map @loc.addBang @args.pps)) >#< "->" + >-< indent 2 (@loc.strictParams `ppMultiSeqV` @body.pp)) + else if null @args.pps + then @body.pp + else pp_parens ( "\\" >#< (vlist (map @loc.addBang @args.pps)) >#< "->" + >-< indent 4 (@loc.strictParams `ppMultiSeqV` @body.pp) + ) + +SEM CaseAlt + | CaseAlt lhs.pps = ["{" >#< @left.pp >#< "->", @expr.pp >#< "}"] + +SEM DataAlt + | DataAlt lhs.pp = @name >#< hv_sp (map ((@lhs.strictPre >|<) . pp_parens) @args.pps) + | Record lhs.pp = @name >#< pp_block "{" "}" "," @args.pps + +SEM NamedType + | Named lhs.pp = if @strict + then @name >#< "::" >#< "!" >|< pp_parens @tp.pp + else @name >#< "::" >#< @tp.pp + +SEM Lhs + | Pattern3 TupleLhs UnboxedTupleLhs + loc.addStrictGuard = if strictCases @lhs.options && @loc.hasStrictVars then \v -> v >#< "|" >#< @loc.strictGuard else id + | Pattern3 + loc.strictGuard = @pat3.strictVars `ppMultiSeqH` (pp "True") + loc.hasStrictVars = not (null @pat3.strictVars) + | TupleLhs UnboxedTupleLhs + loc.strictGuard = if stricterCases @lhs.options && not @lhs.isDeclOfLet + then map text @comps `ppMultiSeqH` (pp "True") + else pp "True" + loc.hasStrictVars = not (null @comps) + + | Fun + loc.addStrictGuard = if strictSems @lhs.options && @loc.hasStrictVars then \v -> v >#< "|" >#< @loc.strictGuard else id + loc.hasStrictVars = not (null @args.pps) + loc.strictGuard = @args.pps `ppMultiSeqH` (pp "True") + + | TupleLhs UnboxedTupleLhs Fun + loc.addBang = if bangpats @lhs.options + then \p -> "!" >|< p + else id + + | Pattern3 lhs.pp = @loc.addStrictGuard @pat3.pp + | Pattern3SM lhs.pp = @pat3.pp' + | TupleLhs lhs.pp = @loc.addStrictGuard $ ppTuple @lhs.nested (map (@loc.addBang . text) @comps) + | UnboxedTupleLhs lhs.pp = @loc.addStrictGuard $ ppUnboxedTuple @lhs.nested (map (@loc.addBang . text) @comps) + | Fun lhs.pp = @loc.addStrictGuard (@name >#< hv_sp (map @loc.addBang @args.pps)) + | Unwrap lhs.pp = pp_parens (@name >#< @sub.pp) + +SEM Type [ | | prec:Int ] + | Arr lhs.prec = 2 + .pp = @loc.l >#< "->" >-< @loc.r + loc.l = if @left.prec <= 2 then pp_parens @left.pp else @left.pp + .r = if @right.prec < 2 then pp_parens @right.pp else @right.pp + + | TypeApp + lhs.pp = hv_sp (@func.pp : @args.pps) + + | CtxApp + lhs.pp = (pp_block "(" ")" "," $ map (\(n,ns) -> hv_sp $ map pp (n:ns)) @left) >#< "=>" >#< @right.pp + | QuantApp + lhs.pp = @left >#< @right.pp + + | TupleType lhs.prec = 5 + .pp = ppTuple @lhs.nested @tps.pps + + | UnboxedTupleType lhs.prec = 5 + .pp = ppUnboxedTuple @lhs.nested @tps.pps + + | List lhs.prec = 5 + .pp = "[" >|< @tp.pp >|< "]" + + | SimpleType lhs.prec = 5 + .pp = if reallySimple @txt then text @txt else pp_parens (text @txt) + + | NontermType lhs.prec = 5 + lhs.pp = @loc.prefix >|< text @name >#< hv_sp @params + loc.prefix = if @deforested + then text "T_" + else empty + | TMaybe lhs.prec = 5 + lhs.pp = text "Maybe" >#< pp_parens @tp.pp + | TEither lhs.prec = 5 + lhs.pp = text "Either" >#< pp_parens @left.pp >#< pp_parens @right.pp + | TMap lhs.prec = 5 + lhs.pp = text "Data.Map.Map" >#< pp_parens @key.pp >#< pp_parens @value.pp + | TIntMap lhs.prec = 5 + lhs.pp = text "Data.IntMap.IntMap" >#< pp_parens @value.pp + | TSet lhs.prec = 5 + lhs.pp = text "Data.Set.Set" >#< pp_parens @tp.pp + | TIntSet lhs.prec = 5 + lhs.pp = text "Data.IntSet.IntSet" + + +{ + +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 + +} + + +------------------------------------------------------------------------------- +-- Strict data fields +------------------------------------------------------------------------------- + +ATTR DataAlt DataAlts [ strictPre: PP_Doc | | ] + +SEM Decl + | Data alts.strictPre = if @strict then pp "!" else empty + +------------------------------------------------------------------------------- +-- Strict variables +------------------------------------------------------------------------------- + +ATTR Pattern Patterns [ | | strictVars USE {++} {[]} : {[PP_Doc]} ] +SEM Pattern + | Alias + loc.strictVar + = if strictCases @lhs.options && not @lhs.isDeclOfLet + then [@loc.ppVar] + else [] + loc.strictPatVars + = if stricterCases @lhs.options && not @lhs.isDeclOfLet + then @pat.strictVars + else [] + lhs.strictVars + = @loc.strictVar ++ @loc.strictPatVars + | Irrefutable + lhs.strictVars = [] + +------------------------------------------------------------------------------- +-- Pretty printing patterns +------------------------------------------------------------------------------- + +SEM Patterns [ | | pps : {[PP_Doc]} ] + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM Pattern + | Constr Product Alias + loc.addBang = if bangpats @lhs.options && not @lhs.isDeclOfLet && not @lhs.belowIrrefutable + then \p -> "!" >|< p + else id + +SEM Pattern [ | | pp:PP_Doc ] + | Constr lhs.pp = @loc.addBang $ pp_parens $ @name >#< hv_sp @pats.pps + | Product lhs.pp = @loc.addBang $ pp_block "(" ")" "," @pats.pps + | Alias loc.ppVar = pp (attrname @lhs.options False @field @attr) + loc.ppVarBang = @loc.addBang $ @loc.ppVar + lhs.pp = if @pat.isUnderscore + then @loc.ppVarBang + else @loc.ppVarBang >|< "@" >|< @pat.pp + | Irrefutable lhs.pp = text "~" >|< pp_parens @pat.pp + | Underscore lhs.pp = text "_" + +SEM Pattern [ | | isUnderscore:{Bool}] + | Constr lhs.isUnderscore = False + | Product lhs.isUnderscore = False + | Alias lhs.isUnderscore = False + | Underscore lhs.isUnderscore = True + +ATTR Pattern Patterns [ belowIrrefutable : Bool | | ] +SEM Pattern + | Irrefutable + pat.belowIrrefutable = True + +SEM Lhs + | Pattern3 Pattern3SM + pat3.belowIrrefutable = False + +------------------------------------------------------------------------------- +-- Pretty printing patterns for SM +------------------------------------------------------------------------------- + +SEM Patterns [ | | pps' : {[PP_Doc]} ] + | Cons lhs.pps' = @hd.pp' : @tl.pps' + | Nil lhs.pps' = [] + +SEM Pattern [ | | pp':PP_Doc ] + | Constr lhs.pp' = pp_parens $ @name >#< hv_sp (map pp_parens @pats.pps') + | Product lhs.pp' = pp_block "(" ")" "," @pats.pps' + | Alias lhs.pp' = let attribute | @field == _LOC || @field == nullIdent = locname' @attr + | otherwise = attrname @lhs.options False @field @attr + in attribute >|< "@" >|< @pat.pp' + | Irrefutable lhs.pp' = text "~" >|< pp_parens @pat.pp + | Underscore lhs.pp' = text "_" + +{ +locname' :: Identifier -> [Char] +locname' n = "_loc_" ++ getName n +} + +------------------------------------------------------------------------------- +-- Determine if inside a Let +------------------------------------------------------------------------------- + +ATTR Chunks Chunk Decls Decl Lhs Pattern Patterns [ isDeclOfLet : Bool | | ] +SEM Program + | Program + chunks.isDeclOfLet = False + +SEM Expr + | Let + decls.isDeclOfLet = True + | Do + stmts.isDeclOfLet = False + | ResumeExpr + left.isDeclOfLet = False + +SEM CaseAlt + | CaseAlt + left.isDeclOfLet = False + + + +------------------------------------------------------------------------------- +-- Alternative code printing to separate modules +------------------------------------------------------------------------------- + +ATTR Program [ mainBlocksDoc : PP_Doc | | genIO : {IO ()} ] +ATTR Program Chunks Chunk + [ importBlocks : PP_Doc + pragmaBlocks : String + textBlocks : PP_Doc + textBlockMap : {Map BlockInfo PP_Doc} + optionsLine : String + mainFile : String + mainName : String + moduleHeader : {String -> String -> String -> Bool -> String} + | | ] + +SEM Program + | Program + loc.mainModuleFile = @lhs.mainFile + loc.genMainModule + = writeModule @loc.mainModuleFile + ( [ pp $ @lhs.pragmaBlocks + , pp $ @lhs.optionsLine + , pp $ @lhs.moduleHeader @lhs.mainName "" "" False + , pp $ ("import " ++ @lhs.mainName ++ "_common\n") + ] + ++ map pp @chunks.imports + ++ map vlist @chunks.appendMain + ++ [@lhs.mainBlocksDoc] + ) + + loc.commonFile = replaceBaseName @lhs.mainFile (takeBaseName @lhs.mainFile ++ "_common") + loc.genCommonModule + = writeModule @loc.commonFile + ( [ pp $ @lhs.pragmaBlocks + , pp $ @lhs.optionsLine + , pp $ @lhs.moduleHeader @lhs.mainName "_common" "" True + , @lhs.importBlocks + , @lhs.textBlocks + ] + ++ map vlist @chunks.appendCommon + ) + + lhs.genIO = do @loc.genMainModule + @loc.genCommonModule + @chunks.genSems + +{ +renderDocs :: [PP_Doc] -> String +renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) "" +} + +ATTR Chunk Chunks [ | | imports USE {++} {[]} : {[String]} ] +SEM Chunk + | Chunk + lhs.imports = ["import " ++ @lhs.mainName ++ "_" ++ @name ++ "\n"] + +ATTR Chunk Chunks [ | | appendCommon, appendMain USE {++} {[]} : {[[PP_Doc]]} ] + +SEM Chunk + | Chunk + lhs.appendCommon + = [ [@comment.pp] + , @dataDef.pps + , @semDom.pps + , if reference @lhs.options then @semWrapper.pps else [] + ] + lhs.appendMain + = [ [@comment.pp] + , @cataFun.pps + , if reference @lhs.options then [] else @semWrapper.pps + ] + +ATTR Chunk Chunks [ | | genSems USE {>>} {return ()} : {IO ()} ] + +SEM Chunk + | Chunk + lhs.genSems + = writeModule @loc.outputfile + [ pp $ @lhs.pragmaBlocks + , pp $ Map.findWithDefault empty (BlockPragma, Just $ identifier @name) @lhs.textBlockMap + , pp $ @lhs.optionsLine + , pp $ @lhs.moduleHeader @lhs.mainName ("_" ++ @name) @loc.exports True + , pp $ ("import " ++ @lhs.mainName ++ "_common\n") + , pp $ Map.findWithDefault empty (BlockImport, Just $ identifier @name) @lhs.textBlockMap + , @comment.pp + , vlist_sep "" @info.pps + , vlist_sep "" @semFunctions.pps + , Map.findWithDefault empty (BlockOther, Just $ identifier @name) @lhs.textBlockMap + ] + +SEM Chunk + | Chunk + loc.exports = concat $ intersperse "," @semNames + +{ +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 +} +
+ src-ag/PrintErrorMessages.ag view
@@ -0,0 +1,656 @@+INCLUDE "ErrorMessages.ag" + +imports +{ +import UU.Scanner.Position(Pos(..), noPos) +import ErrorMessages +import Data.List(mapAccumL) +import GrammarInfo +import qualified Control.Monad.Error.Class as Err +} + + +{ +instance Err.Error Error where + noMsg = Err.strMsg "error" + strMsg = CustomError False noPos . pp +} + + +{ +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 ] +} + + + + + + +ATTR Error [ options:{Options} verbose:{Bool} | | pp :{PP_Doc} + me :SELF + ] + +ATTR Errors [ options:{Options} dups : {[String]} | | pp USE {>-<} {text ""} : {PP_Doc} + ] + +SEM Errors + | * loc.verbose = verbose @lhs.options + | Cons loc.str = disp @hd.pp 5000 "" + + lhs.pp = if @loc.str `elem` @lhs.dups + then @tl.pp + else @hd.pp >-< @tl.pp + tl.dups = @loc.str : @lhs.dups + | Nil lhs.pp = text "" + + +SEM Error + | ParserError lhs.pp = let mesg = text ("parser expecting " ++ @problem) + pat = text "" + help = text "" + act = text @action + in ppError (isError @lhs.options @me) @pos mesg pat help act @lhs.verbose + + | HsParseError lhs.pp = ppError True @pos (text @msg) (text "") (text "") (text "Correct the syntax of the Haskell code.") @lhs.verbose + + | DupAlt lhs.pp = 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 @lhs.options @me) (getPos @con) mesg pat help act @lhs.verbose + + | DupSynonym lhs.pp = 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 @lhs.options @me) (getPos @nt) mesg pat help act @lhs.verbose + + | DupSet lhs.pp = 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 @lhs.options @me) (getPos @name) mesg pat help act @lhs.verbose + + | DupInhAttr lhs.pp = 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 @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose + + | DupSynAttr lhs.pp = 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 @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose + + | DupChild lhs.pp = 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 @lhs.options @me) (getPos @name) mesg pat help act @lhs.verbose + + | DupRule lhs.pp = 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 @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose + + | DupRuleName lhs.pp = 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 @lhs.options @me) (getPos @nm) mesg pat help act @lhs.verbose + + | DupSig lhs.pp = 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 @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose + + | UndefNont lhs.pp = 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 @lhs.options @me) (getPos @nt) mesg pat help act @lhs.verbose + + | UndefAlt lhs.pp = 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 @lhs.options @me) (getPos @con) mesg pat help act @lhs.verbose + + | UndefChild lhs.pp = 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 "<attr>") >#< "= ...") + + 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 @lhs.options @me) (getPos @name) mesg pat help act @lhs.verbose + + | MissingRule lhs.pp = 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 @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose + + | MissingNamedRule lhs.pp = 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 @lhs.options @me) (getPos @name) mesg pat help act @lhs.verbose + + | SuperfluousRule lhs.pp = 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 @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose + + | UndefLocal lhs.pp = 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 >#< "<field>.<attr> = " + >#< "..." >#< "@" >|< 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 @lhs.options @me) (getPos @var) mesg pat help act @lhs.verbose + + | ChildAsLocal lhs.pp = 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 @lhs.options @me) (getPos @var) mesg pat help act @lhs.verbose + + | UndefAttr lhs.pp = 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 >#< "<field>.<attr> = " + >#< "..." >#< 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 @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose + + | CyclicSet lhs.pp = 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 @lhs.options @me) (getPos @name) mesg pat help act @lhs.verbose + + | Cyclic lhs.pp = 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 @lhs.options @me) pos mesg pat help act False + + | CustomError lhs.pp = let pat = text "unknown" + help = wfill ["not available."] + act = wfill ["unknown"] + in ppError (isError @lhs.options @me) @pos @mesg pat help act False + + | LocalCirc lhs.pp = 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 @lhs.options @me) (getPos (@attr)) mesg pat help act @lhs.verbose + + | InstCirc lhs.pp = 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.<some attribte>" >#< "...") + 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 @lhs.options @me) (getPos (@attr)) mesg pat help act @lhs.verbose + + | DirectCirc lhs.pp = 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 @lhs.options @me) noPos mesg pat help act @lhs.verbose + + | InducedCirc lhs.pp = 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 @lhs.options @me) noPos mesg pat help act @lhs.verbose + + | MissingTypeSig lhs.pp = 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 @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose + + | MissingInstSig lhs.pp = 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 @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose + + | MissingUnique lhs.pp = 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 @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose + + | DupUnique lhs.pp = 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 @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose + + | MissingSyn lhs.pp = 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 @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose + | IncompatibleVisitKind + lhs.pp = 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 @lhs.options @me) (getPos @child) mesg pat help act @lhs.verbose + | IncompatibleRuleKind + lhs.pp = 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 @lhs.options @me) (getPos @rule) mesg pat help act @lhs.verbose + + | IncompatibleAttachKind + lhs.pp = 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 @lhs.options @me) (getPos @child) mesg pat help act @lhs.verbose + +{ +toWidth :: Int -> String -> String +toWidth n xs | k<n = xs ++ replicate (n-k) ' ' + | otherwise = xs + where k = length xs + +showEdge :: ((Identifier,Identifier),[String],[String]) -> 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 +} +-- Printing of error messages + +{ +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] + +} +
+ src-ag/PrintOcamlCode.ag view
@@ -0,0 +1,222 @@+PRAGMA strictdata +PRAGMA optimize +PRAGMA bangpats +PRAGMA strictwrap + +INCLUDE "Code.ag" +INCLUDE "Patterns.ag" + +imports +{ +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) +} + + +{ +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 +} + + +-- +-- Pass options down +-- + +ATTR Program Expr Exprs Decl Decls Chunk Chunks CaseAlts CaseAlt Lhs Pattern Patterns [ options:{Options} | | ] + +ATTR Program Chunks Chunk [ textBlockMap : {Map BlockInfo PP_Doc} | | ] + + +-- +-- Collect outputs +-- + +ATTR Program [ | | output:{PP_Docs} ] +ATTR Expr Decl DataAlt CaseAlt Type NamedType Lhs Pattern [ | | pp:{PP_Doc} ] +ATTR Exprs DataAlts CaseAlts Types NamedTypes Decls Chunk Chunks Patterns [ | | pps : {PP_Docs} ] + +SEM Program + | Program lhs.output = @chunks.pps + +SEM Exprs + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM CaseAlts + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM DataAlts + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM Types + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM NamedTypes + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM Decls + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +SEM Chunks + | Cons lhs.pps = @hd.pps ++ @tl.pps + | Nil lhs.pps = [] + +SEM Patterns + | Cons lhs.pps = @hd.pp : @tl.pps + | Nil lhs.pps = [] + +-- +-- Individual cases +-- + +SEM Chunk + | Chunk lhs.pps = @comment.pp + : @info.pps + ++ @dataDef.pps + ++ @semDom.pps + ++ @semFunctions.pps + ++ @semWrapper.pps + ++ @cataFun.pps + ++ [Map.findWithDefault empty (BlockOther, Just $ identifier @name) @lhs.textBlockMap] + +SEM Decl + | Decl lhs.pp = if @lhs.isToplevel + then "let" >#< @left.pp >#< "=" + >-< indent 4 @rhs.pp >#< ";;" + else "let" >#< @left.pp >#< "=" + >-< indent 4 @rhs.pp >#< "in" + | Bind lhs.pp = error "pp of Decl.Bind not supported" + | BindLet lhs.pp = error "pp of Decl.BindLet not supported" + | Data lhs.pp = "type" >#< hv_sp (map (\p -> "'" >|< p) @params ++ [text $ toOcamlTC @name]) + >#< ( case @alts.pps of + [] -> empty + (x:xs) -> "=" >#< x + >-< vlist (map ("|" >#<) xs) + ) + >#< ";;" + | NewType lhs.pp = error "pp of Decl.NewType not supported" + | Type lhs.pp = "type" >#< hv_sp (map (\p -> "'" >|< p) @params ++ [text $ toOcamlTC @name]) >#< "=" >#< @tp.pp >#< ";;" + | TSig lhs.pp = "(*" >#< @name >#< ":" >#< @tp.pp >#< "*)" + | Comment lhs.pp = if '\n' `elem` @txt + then "(* " >-< vlist (lines @txt) >-< "*)" + else "(*" >#< @txt >#< "*)" + | PragmaDecl lhs.pp = error "pp of Decl.PragmaDecl not supported" + + + SEM Expr + | Let lhs.pp = pp_parens $ vlist (@decls.pps ++ [@body.pp]) + | Case lhs.pp = pp_parens ( "match" >#< @expr.pp >#< "with" + >-< indent 2 ( case @alts.pps of + [] -> empty + (x:xs) -> " " >#< x + >-< vlist (map ("|" >#<) xs) + ) + ) + | Do lhs.pp = error "pp of Expr.Do not supported" + | Lambda lhs.pp = pp_parens ( pp "fun" >#< hv_sp @args.pps >#< "->" + >-< indent 2 @body.pp ) + | TupleExpr lhs.pp = ppTuple False @exprs.pps + | UnboxedTupleExpr lhs.pp = error "pp of Expr.UnboxedTupleExpr not supported" + | App lhs.pp = pp_parens $ @name >#< hv_sp @args.pps + | SimpleExpr lhs.pp = text @txt + | TextExpr lhs.pp = vlist (map text @lns) + | Trace lhs.pp = @expr.pp + | PragmaExpr lhs.pp = @expr.pp + | LineExpr lhs.pp = @expr.pp + | TypedExpr lhs.pp = @expr.pp + +SEM Lhs + | Pattern3 lhs.pp = @pat3.pp + | Pattern3SM lhs.pp = error "pp of Lhs.Pattern3SM not supported" + | TupleLhs lhs.pp = ppTuple False (map text @comps) + | UnboxedTupleLhs lhs.pp = error "pp of Lhs.UnboxedTupleLhs not supported" + | Fun lhs.pp = @name >#< hv_sp @args.pps + | Unwrap lhs.pp = pp_parens (@name >#< @sub.pp) + +SEM Type + | Arr lhs.pp = pp_parens (@left.pp >#< "->" >#< @right.pp) + | CtxApp lhs.pp = error "pp of Type.CtxApp not supported" + | TypeApp lhs.pp = pp_parens (hv_sp (@args.pps ++ [@func.pp])) + | TupleType lhs.pp = pp_block "(" ")" "," @tps.pps + | UnboxedTupleType + lhs.pp = error "pp of Type.UnboxedTupleType is not supported" + | List lhs.pp = @tp.pp >#< "list" + | SimpleType lhs.pp = text @txt + | NontermType lhs.pp = pp_block "(" ")" " " (map text @params ++ [text $ toOcamlTC @name]) + | TMaybe lhs.pp = @tp.pp >#< "opt" + | TEither lhs.pp = error "pp of Type.TEither is not supported" + | TMap lhs.pp = error "pp of Type.TMap is not supported" + | TIntMap lhs.pp = error "pp of Type.TIntMap is not supported" + | TSet lhs.pp = error "pp of Type.TSet is not supported" + | TIntSet lhs.pp = error "pp of Type.TIntSet is not supported" + +{ +toOcamlTC :: String -> String +toOcamlTC (c:cs) = toLower c : cs +toOcamlTC xs = xs +} + +SEM CaseAlt + | CaseAlt lhs.pp = @left.pp >#< "->" >#< @expr.pp + +SEM DataAlt + | DataAlt lhs.pp = @name >#< "of" >#< pp_block "" "" " * " (map pp_parens @args.pps) + | Record lhs.pp = pp_block "{" "}" ";" @args.pps + +SEM NamedType + | Named lhs.pp = @name >#< ":" >#< @tp.pp + +SEM Pattern + | Constr lhs.pp = pp_parens $ @name >#< hv_sp @pats.pps + | Product lhs.pp = pp_block "(" ")" "," @pats.pps + | Alias -- assuming here that there is only an underscore under an alias + lhs.pp = if @pat.isUnderscore + then pp (attrname @lhs.options False @field @attr) + else error "pp of Pattern.Alias is only supported in the form (x@_)" + | Irrefutable lhs.pp = error "pp of Pattern.Irrefutable not supported" + | Underscore lhs.pp = text "_" + +SEM Pattern [ | | isUnderscore:{Bool}] + | Constr lhs.isUnderscore = False + | Product lhs.isUnderscore = False + | Alias lhs.isUnderscore = False + | Underscore lhs.isUnderscore = True + +-- +-- Determine if a declaration is toplevel +-- + +ATTR Chunks Chunk Decls Decl [ isToplevel : Bool | | ] +SEM Program + | Program + chunks.isToplevel = True + +SEM Expr + | Let + decls.isToplevel = False + | Do + stmts.isToplevel = False
+ src-ag/PrintVisitCode.ag view
@@ -0,0 +1,53 @@+PRAGMA strictwrap +PRAGMA strictdata +PRAGMA optimize + +INCLUDE "CodeSyntax.ag" +INCLUDE "Patterns.ag" +INCLUDE "DeclBlocks.ag" + +imports +{ +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) +} + +{ +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 +} + + +WRAPPER CGrammar + +ATTR CGrammar [ options:{Options} | | output:{PP_Docs} ] + +SEM CGrammar + | CGrammar + lhs.output = []
+ src-ag/ResolveLocals.ag view
@@ -0,0 +1,157 @@+INCLUDE "AbstractSyntax.ag" +INCLUDE "Patterns.ag" +INCLUDE "Expression.ag" +INCLUDE "DistChildAttr.ag" + + +-- +-- Checks right-hand sides for missing attributes. +-- Attribute references @xxx are now explicitly mapped to @loc.xxx if there is such +-- an attribute in scope and there is no terminal @xxx. +-- + + +imports +{ +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 +} + +WRAPPER Grammar + + +-- +-- Main attributes +-- + +ATTR Grammar Nonterminals Nonterminal Productions Production Rule Rules Expression + [ options:{Options} | | ] + +ATTR Grammar Nonterminals Nonterminal Productions Production Rule Rules Pattern Patterns Expression + [ | | errors USE {Seq.><} {Seq.empty} : {Seq Error} ] + +ATTR Grammar Nonterminals Nonterminal Productions Production Child Children Rule Rules Pattern Patterns TypeSig TypeSigs Expression + [ | | output : SELF ] + +-- +-- Collect inputs to expressions +-- + +-- Collecting nts +ATTR Nonterminal Nonterminals + Production Productions + Rule Rules + Child Children [allnts:{[Identifier]} | | ] + +SEM Grammar + | Grammar nonts.allnts = map fst (@nonts.nonts) + +ATTR Nonterminals Nonterminal [ | | nonts USE {++} {[]} : {[(NontermIdent,[ConstructorIdent])]} ] +SEM Nonterminal + | Nonterminal lhs.nonts = [(@nt,@prods.cons)] +ATTR Productions Production [ | | cons USE {++} {[]} : {[ConstructorIdent]} ] +SEM Production + | Production lhs.cons = [@con] + +-- Collecting fields +ATTR Rule Rules + Child Children [allfields:{[(Identifier,Type,ChildKind)]} attrs:{[(Identifier,Identifier)]} | | ] + +SEM Production + | Production loc.allfields = @children.fields + .attrs = map ((,) _LOC) @rules.locVars ++ + map ((,) _INST) @rules.instVars ++ + map ((,) _LHS) @inhnames ++ + concat [map ((,) nm) (Map.keys as) | (nm,_,as) <- @children.attributes] + .inhnames = Map.keys @lhs.inh + .synnames = Map.keys @lhs.syn + +ATTR Children [ | | attributes USE {++} {[]} : {[(Identifier,Attributes,Attributes)]} ] +SEM Child [ | | attributes:{[(Identifier,Attributes,Attributes)]} ] + | Child lhs.attributes = [(@name, @loc.inh, @loc.syn)] + +SEM Child [ | | field : {(Identifier,Type,ChildKind)} ] + | Child lhs.field = (@name, @tp, @kind) + +SEM Children [ | | fields : {[(Identifier,Type,ChildKind)]} ] + | Cons lhs.fields = @hd.field : @tl.fields + | Nil lhs.fields = [] + +ATTR Rules Rule Patterns Pattern [ | | locVars USE {++} {[]}:{[Identifier]} instVars USE {++} {[]} : {[Identifier]} ] + +SEM Pattern + | Alias lhs.locVars = if @field == _LOC + then [@attr] + else [] + lhs.instVars = if @field == _INST + then [@attr] + else [] + +-- Distributing name of nonterminal and names of attributes +ATTR Productions Production Child Children Rules Rule Patterns Pattern [ nt : {Identifier} inh,syn : {Attributes} | | ] +ATTR Child Children Rules Rule Patterns Pattern [ con : {Identifier} | | ] + +SEM Production + | Production children . con = @con +SEM Production + | Production rules . con = @con +SEM Nonterminal + | Nonterminal prods . nt = @nt + +SEM Nonterminal + | Nonterminal prods.inh = @inh + prods.syn = @syn + +-- merge map +SEM Grammar + | Grammar nonts.mergeMap = Map.map (Map.map (Map.map (\(nt,srcs,_) -> (nt,srcs)))) @mergeMap + +ATTR Nonterminals Nonterminal + [ mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))} | | ] + +ATTR Productions Production + [ mergeMap : {Map ConstructorIdent (Map Identifier (Identifier,[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 + +ATTR Rules Rule Children Child Expression [ mergeMap : {Map Identifier (Identifier,[Identifier])} | | ] + + +-- +-- Handling Expressions +-- + +ATTR Expression [ nt,con :{Identifier} + allfields:{[(Identifier,Type,ChildKind)]} + allnts :{[Identifier]} + attrs :{[(Identifier,Identifier)]} + || ] + +SEM Expression + | Expression loc.(errors,newTks) + = let mergedChildren = [ x | (_,xs) <- Map.elems @lhs.mergeMap, x <- xs ] + attrsIn = filter (\(fld,_) -> not (fld `elem` mergedChildren)) @lhs.attrs + inherited = Inh_HsTokensRoot + { attrs_Inh_HsTokensRoot = attrsIn + , con_Inh_HsTokensRoot = @lhs.con + , allfields_Inh_HsTokensRoot = @lhs.allfields + , allnts_Inh_HsTokensRoot = @lhs.allnts + , nt_Inh_HsTokensRoot = @lhs.nt + , options_Inh_HsTokensRoot = @lhs.options + } + synthesized = wrap_HsTokensRoot (sem_HsTokensRoot (HsTokensRoot @tks)) inherited + in (errors_Syn_HsTokensRoot synthesized, output_Syn_HsTokensRoot synthesized) + lhs.output = Expression @pos @loc.newTks
+ src-ag/SemHsTokens.ag view
@@ -0,0 +1,144 @@+INCLUDE "HsToken.ag" + +imports +{ +import qualified Data.Sequence as Seq +import Data.Sequence(Seq,empty,singleton,(><)) +import Data.Foldable(toList) +import Pretty + +import TokenDef +import HsToken +import ErrorMessages +} + +ATTR HsTokensRoot + [ + | | + errors USE {Seq.><} {Seq.empty}:{Seq Error} + usedLocals:{[Identifier]} + usedAttrs :{[(Identifier,Identifier)]} + textLines :{[String]} + usedFields:{[Identifier]} + ] + +------------------------------------------------------------------------------- +-- Context information +------------------------------------------------------------------------------- +ATTR HsTokensRoot + HsTokens HsToken [ nt,con : {Identifier} + allfields : {[(Identifier,Type,ChildKind)]} + allnts : {[Identifier]} + attrs : {[(Identifier,Identifier)]} + options : {Options} + || + ] + +ATTR HsTokens HsToken [ fieldnames : {[Identifier]} | | ] +SEM HsTokensRoot + | HsTokensRoot tokens.fieldnames = map (\(n,_,_) -> n) @lhs.allfields + +------------------------------------------------------------------------------- +-- Errors +------------------------------------------------------------------------------- +ATTR HsTokens HsToken [ | | errors USE {Seq.><} {Seq.empty}:{Seq Error} ] + +------------------------------------------------------------------------------- +-- Syntax errors +------------------------------------------------------------------------------- + +SEM HsToken + | Err lhs.errors = let m = text @mesg + in Seq.singleton (CustomError False @pos m) + +------------------------------------------------------------------------------- +-- Undefined variables +------------------------------------------------------------------------------- + +{ +isNTname allnts (Just (NT nt _ _)) = nt `elem` allnts +isNTname allnts _ = False +} + + +-- An AGLocal is either a local variable or a terminal +SEM HsToken + | AGLocal loc.tkAsLocal = AGLocal @var @pos @rdesc -- refers to the terminal + loc.tkAsField = AGField _LOC @var @pos @rdesc -- refers to the (local) attribute + loc.(errors,output,tok,usedLocals) = + if @var `elem` @lhs.fieldnames -- check if @var occurs as a terminal + then if isNTname @lhs.allnts (lookup @var (map (\(n,t,_) -> (n,t)) @lhs.allfields)) + then (Seq.singleton(ChildAsLocal @lhs.nt @lhs.con @var), @loc.tkAsLocal,(@pos,fieldname @var), [] ) + else (Seq.empty, @loc.tkAsLocal, (@pos,fieldname @var), [] ) + else if (_LOC,@var) `elem` @lhs.attrs + then (Seq.empty , @loc.tkAsField, (@pos,locname @lhs.options @var), [@var]) + else (Seq.singleton(UndefLocal @lhs.nt @lhs.con @var), @loc.tkAsField, (@pos,locname @lhs.options @var), [] ) + +SEM HsToken + | AGField lhs.errors = if (@field,@attr) `elem` @lhs.attrs + then Seq.empty + else if not(@field `elem` (_LHS : _LOC: @lhs.fieldnames)) + then Seq.singleton (UndefChild @lhs.nt @lhs.con @field) + else Seq.singleton (UndefAttr @lhs.nt @lhs.con @field @attr False) + +------------------------------------------------------------------------------- +-- Used variables +------------------------------------------------------------------------------- + +ATTR HsTokens HsToken [ | | usedLocals USE {++} {[]} : {[Identifier]} + usedAttrs USE {++} {[]} : {[(Identifier,Identifier)]} ] + +SEM HsToken + | AGField (lhs.usedAttrs,lhs.usedLocals) + = if @field == _LOC + then ([], [@attr]) + else ([(@field,@attr)], []) + + +------------------------------------------------------------------------------- +-- Used fields +------------------------------------------------------------------------------- +ATTR HsTokens HsToken [ | | usedFields USE {Seq.><} {Seq.empty} : {Seq Identifier} ] + +SEM HsToken + | AGLocal lhs.usedFields = if @var `elem` @lhs.fieldnames + then Seq.singleton @var + else Seq.empty +SEM HsTokensRoot + | HsTokensRoot lhs.usedFields = toList @tokens.usedFields + +------------------------------------------------------------------------------- +-- Pretty printing +------------------------------------------------------------------------------- + +SEM HsTokensRoot + | HsTokensRoot lhs.textLines = showTokens @tokens.tks + +SEM HsTokens [ || tks : {[(Pos,String)]} ] + | Cons lhs.tks = @hd.tok : @tl.tks + | Nil lhs.tks = [] + +SEM HsToken [ || tok:{(Pos,String)}] + | AGField + loc.addTrace = case @rdesc of + Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show @field ++ "." ++ show @attr) ++ " (" ++ x ++ "))" + Nothing -> id + lhs.tok = (@pos, @loc.addTrace $ attrname @lhs.options True @field @attr) + + | HsToken lhs.tok = (@pos, @value) + + | CharToken lhs.tok = (@pos, if null @value + then "" + else showCharShort (head @value) + ) + + | StrToken lhs.tok = (@pos, showStrShort @value) + | Err lhs.tok = (@pos, "") + +------------------------------------------------------------------------------- +-- Desugar (resolve AGLocals to explicit AGFields) +------------------------------------------------------------------------------- + +ATTR HsTokensRoot [ | | output : {[HsToken]} ] +ATTR HsTokens HsToken [ | | output : SELF ] +
+ src-ag/TfmToVisage.ag view
@@ -0,0 +1,147 @@+-- !!!! The Visage AST does not support nonterminals with type variables! +-- !!!! Type variables in data type declarations are ignored. + +INCLUDE "AbstractSyntax.ag" +INCLUDE "Patterns.ag" +INCLUDE "Expression.ag" +INCLUDE "DistChildAttr.ag" + +imports { +import AbstractSyntax +import VisagePatterns +import VisageSyntax +import qualified Data.Map as Map +import Data.Map (Map) +} + +{ +-- 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 + +-} +} + + +ATTR Expression Pattern Patterns [ | | self : SELF ] + +ATTR Grammar [ || visage:{VisageGrammar} ] +ATTR Nonterminal [ || vnont:{VisageNonterminal} ] +ATTR Nonterminals [ || vnonts:{[VisageNonterminal]} ] +ATTR Production [ || vprod:{VisageProduction} ] +ATTR Productions [ || vprods:{[VisageProduction]} ] +ATTR Rule [ || vrule : {VisageRule} ] +ATTR Rules [ || vrules : {[VisageRule]} ] +ATTR Child [ rulemap : {VisageRuleMap} || vchild:{VisageChild} ] +ATTR Children [ rulemap : {VisageRuleMap} || vchildren:{[VisageChild]} ] +ATTR Pattern [ || vpat:{VisagePattern} ] +ATTR Patterns [ || vpats: {[VisagePattern]} ] + +SEM Grammar + | Grammar + lhs.visage = VGrammar @nonts.vnonts + +SEM Nonterminals + | Cons + lhs.vnonts = @hd.vnont : @tl.vnonts + | Nil + lhs.vnonts = [] + +SEM Nonterminal + | Nonterminal + lhs.vnont = VNonterminal @nt @inh @syn @prods.vprods + +SEM Productions + | Cons + lhs.vprods = @hd.vprod : @tl.vprods + | Nil + lhs.vprods = [] + +SEM Production + | Production + lhs.vprod = VProduction @con @children.vchildren @lhsrules @locrules + loc.splitVRules = splitVRules @rules.vrules + loc.locrules = getForField "loc" @splitVRules + loc.lhsrules = getForField "lhs" @splitVRules + children.rulemap = @splitVRules + +SEM Children + | Cons lhs.vchildren = @hd.vchild : @tl.vchildren + | Nil lhs.vchildren = [] + +SEM Child + | Child lhs.vchild = VChild @name @tp @loc.inh @loc.syn (getForField (getName @name) @lhs.rulemap) + +SEM Rules + | Cons lhs.vrules = @hd.vrule : @tl.vrules + | Nil lhs.vrules = [] + +-- The undefined may seem strange, but it really belongs there. +SEM Rule + | Rule lhs.vrule = VRule @pattern.fieldattrs undefined @pattern.vpat @rhs.self @owrt + +SEM Patterns + | Cons lhs.vpats = @hd.vpat : @tl.vpats + | Nil lhs.vpats = [] + +SEM Pattern + | Constr lhs.vpat = VConstr @name @pats.vpats + | Product lhs.vpat = VProduct @pos @pats.vpats + | Alias lhs.vpat = if (isVar @self) + then VVar @field @attr + else VAlias @field @attr @pat.vpat + | Underscore lhs.vpat = VUnderscore @pos + +-- All (field,attrs) in a pattern +ATTR Patterns -> Pattern [ | | fieldattrs USE { ++ } { [] } : { [(Identifier,Identifier)] } ] + +SEM Pattern + | Alias lhs.fieldattrs = [(@field, @attr)]
+ src-ag/Transform.ag view
@@ -0,0 +1,1371 @@+PRAGMA strictdata +PRAGMA strictwrap + +INCLUDE "ConcreteSyntax.ag" +INCLUDE "Patterns.ag" + +imports +{ +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 +} + + +------------------------------------------------------------------------------- +-- Main goal +------------------------------------------------------------------------------- + +-- Given some options, we want to construct a Grammar, that is, a structure that conforms to AbstractSyntax +ATTR AG [ | | output : Grammar ] +ATTR AG Elems Elem SemAlts SemAlt SemDefs SemDef Attrs [ options : Options | | ] + +-- as a side effect, we generate error messages and Haskell code blocks that need to be embedded in the final code +ATTR AG Elems Elem SemAlts SemAlt Attrs NontSet ConstructorSet SemDefs SemDef + [ | | errors USE {Seq.><}{Seq.empty}:{Seq Error} ] +ATTR AG Elems Elem + [ | | blocks USE {`mapUnionWithPlusPlus`} {Map.empty}: {Blocks} ] + + +-- The output is produced by calling a function that constructs the Grammar, +-- given various datastructures that are collected from the concrete AG. + +SEM AG + | AG lhs.output = constructGrammar @loc.allNonterminals + @elems.paramsCollect + @loc.allConParams + @loc.allFields + @loc.prodOrder + @loc.allConstraints + @loc.allAttrDecls + @elems.useMap + @elems.derivings + (if wrappers @lhs.options then @loc.allNonterminals else @elems.wrappers) + @loc.checkedRules + @loc.checkedSigs + @loc.checkedInsts + @elems.typeSyns + @elems.semPragmasCollect + @elems.attrOrderCollect + @elems.ctxCollect + @elems.quantCollect + @loc.checkedUniques + @loc.checkedAugments + @loc.checkedArounds + @loc.checkedMerges + @loc.allMacros + + +------------------------------------------------------------------------------- +-- Main data flow +------------------------------------------------------------------------------- + +{- Information is collected bottom-up (in multiple phases) + After checking for consistency, datastructures are createad from it, + which are passed down for the other phases. +-} + + +-- Names that are in use + + -- bottom-up collection +ATTR Elem Elems [ | | collectedSetNames USE {`Set.union`} {Set.empty} : {Set Identifier} ] +ATTR Elem Elems NontSet [ | | collectedNames USE {`Set.union`} {Set.empty} : {Set Identifier} ] + -- top-down distribution +ATTR Elem Elems Attrs Alts Alt Fields Field NontSet [ allNonterminals : {Set NontermIdent} | | ] + + +-- Constructors that are in use + -- bottom-up collection +ATTR Alt Alts ConstructorSet [ | | collectedConstructorNames USE {`Set.union`} {Set.empty} : {Set ConstructorIdent} ] +ATTR Elem Elems [ | | collectedConstructorsMap USE {`mapUnionWithSetUnion`} {Map.empty} : {Map NontermIdent (Set ConstructorIdent)} ] + -- top-down distribution +ATTR Elem Elems Alts Alt [ allConstructors : {Map NontermIdent (Set ConstructorIdent)} | | ] + + + +-- Nonterminal sets that are defined +{type DefinedSets = Map Identifier (Set NontermIdent) } + -- bottom-up collection +ATTR Elem Elems + [ | defSets:{Map Identifier (Set NontermIdent,Set Identifier)} | ] + -- top-down distribution +ATTR Elem Elems NontSet + [ definedSets:{DefinedSets} | | ] + + + +-- Interpreting nonterminal sets +ATTR NontSet [ | | nontSet : {Set NontermIdent} ] + + +-- Interpreting constructor sets +ATTR ConstructorSet [ | | constructors : {(Set ConstructorIdent->Set ConstructorIdent)} ] + + + +-- Contextfree structure +{type FieldMap = [(Identifier, Type)] } +{type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap) } + -- bottom-up collection +ATTR Alt Alts Elem Elems + [ | | collectedFields USE {++} {[]} : {[(NontermIdent, ConstructorIdent, FieldMap)]} + collectedConstraints USE {++} {[]} : {[(NontermIdent, ConstructorIdent, [Type])]} + collectedConParams USE {++} {[]} : {[(NontermIdent, ConstructorIdent, Set Identifier)]} + ] + -- top-down distribution +ATTR Elem Elems Attrs SemAlt SemAlts NontSet + [ allFields : {DataTypes} | | ] + + + +-- Attribute declarations + -- bottom-up collection +ATTR Elems Elem Attrs + [ + | attrDecls:{Map NontermIdent (Attributes, Attributes)} + | useMap USE {`merge`} {Map.empty}:{Map NontermIdent (Map Identifier (String,String,String))} + ] + + +-- Attribute definitions +{type AttrName = (Identifier,Identifier) } +{type RuleInfo = (Maybe Identifier, [AttrName]->Pattern, Expression, [AttrName], Bool, String, Bool, Bool) } +{type SigInfo = (Identifier,Type) } +{type UniqueInfo = (Identifier,Identifier) } +{type AugmentInfo = (Identifier,Expression)} +{type AroundInfo = (Identifier,Expression)} +{type MergeInfo = (Identifier, Identifier, [Identifier], Expression)} + -- bottom-up collection +ATTR Elem Elems SemAlt SemAlts + [ | | collectedRules USE {++} {[]} : {[ (NontermIdent, ConstructorIdent, RuleInfo)]} + collectedSigs USE {++} {[]} : {[ (NontermIdent, ConstructorIdent, SigInfo) ]} + collectedInsts USE {++} {[]} : {[ (NontermIdent, ConstructorIdent, [Identifier]) ]} + collectedUniques USE {++} {[]} : {[ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]} + collectedAugments USE {++} {[]} : {[ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]} + collectedArounds USE {++} {[]} : {[ (NontermIdent, ConstructorIdent, [AroundInfo]) ]} + collectedMerges USE {++} {[]} : {[ (NontermIdent, ConstructorIdent, [MergeInfo]) ]} + ] + + + +------------------------------------------------------------------------------- +-- Passing nonterminals +------------------------------------------------------------------------------- + +-- Pass the name of the associated nonterminal to everyone +ATTR Alt Alts SemAlt SemAlts [ nts:{Set NontermIdent} | | ] + +SEM Elem + | Data alts.nts = @names.nontSet + | Sem alts.nts = @names.nontSet + + + +------------------------------------------------------------------------------- +-- Calculation of code blocks -- +------------------------------------------------------------------------------- + +SEM Elem + | Txt loc.blockInfo = ( @kind + , @mbNt + ) + loc.blockValue = [(@lines, @pos)] + lhs.blocks = Map.singleton @loc.blockInfo @loc.blockValue + lhs.errors = if checkParseBlock @lhs.options + then let ex = Expression @pos tks + tks = [tk] + tk = HsToken (unlines @lines) @pos + in Seq.fromList $ checkBlock $ ex + else Seq.empty + + +------------------------------------------------------------------------------- +-- Check for duplicates and report error +------------------------------------------------------------------------------- + +{ + +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 + +} + +------------------------------------------------------------------------------- +-- Collecting DATA's and type synonyms +------------------------------------------------------------------------------- + + +SEM Alt + | Alt lhs.collectedFields = [ (nt, con, @fields.collectedFields) + | nt <- Set.toList @lhs.nts + , con <- Set.toList (@names.constructors (Map.findWithDefault Set.empty nt @lhs.allConstructors)) + ] + lhs.collectedConstraints = [ (nt, con, @fields.collectedConstraints) + | nt <- Set.toList @lhs.nts + , con <- Set.toList (@names.constructors (Map.findWithDefault Set.empty nt @lhs.allConstructors)) + ] + lhs.collectedConParams = [ (nt, con, Set.fromList @tyvars) + | nt <- Set.toList @lhs.nts + , con <- Set.toList (@names.constructors (Map.findWithDefault Set.empty nt @lhs.allConstructors)) + ] + +SEM Elem + | Type lhs.collectedFields = map (\(x,y)->(@name, x, y)) @loc.expanded + +SEM AG + | AG + loc.prodOrder = 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 @elems.collectedFields + loc.allFields = let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm) + in foldr f (Map.empty) @elems.collectedFields + + loc.allConstraints = let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm) + in foldr f (Map.empty) @elems.collectedConstraints + + loc.allConParams = let f (nt,con,fm) = Map.insertWith (Map.unionWith Set.union) nt (Map.singleton con fm) + in foldr f (Map.empty) @elems.collectedConParams + + loc.allConstrs = let f (nt,con,_) = Map.insertWith (++) nt [con] + in foldr f (Map.empty) @elems.collectedFields + + loc.allRules = let f (nt,con,r) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [r]) + in foldr f (Map.empty) @elems.collectedRules + + loc.allSigs = let f (nt,con,t) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [t]) + typeof nt r = Map.findWithDefault (Haskell "<unknown>") r $ fst $ Map.findWithDefault (Map.empty,Map.empty) nt @loc.allAttrDecls + in foldr f (Map.empty) ( @elems.collectedSigs + ++ [ (nt, con, (ident,typeof nt ref)) | (nt, con, us) <- @elems.collectedUniques, (ident,ref) <- us ] + ) + + loc.allInsts = let f (nt,con,is) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con is) + in foldr f (Map.empty) @elems.collectedInsts + + loc.allUniques = let f (nt,con,us) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con us) + in foldr f (Map.empty) @elems.collectedUniques + loc.allAugments = let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as) + in foldr f Map.empty @elems.collectedAugments + loc.allArounds = let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as) + in foldr f Map.empty @elems.collectedArounds + loc.allMerges = let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as) + in foldr f Map.empty @elems.collectedMerges + + loc.augmentSigs = let gen _ = [] -- TODO: generate type signatures here for the augments + in Map.map (Map.map gen) @loc.allAugments + + loc.allRulesErrs = Map.mapWithKey (Map.mapWithKey . (checkRules @allAttrDecls @allFields @allInsts @loc.allSigs @loc.allMerges)) @loc.allRules + loc.allNamesErrs = Map.mapWithKey (Map.mapWithKey . checkRuleNames) @loc.allRules + loc.allSigsErrs = Map.mapWithKey (Map.mapWithKey . (checkSigs )) @loc.allSigs + loc.allInstsErrs = Map.mapWithKey (Map.mapWithKey . (checkInsts @loc.allNonterminals @loc.allSigs @allFields )) @loc.allInsts + loc.allUniquesErrs = Map.mapWithKey (Map.mapWithKey . (checkUniques @allAttrDecls )) @loc.allUniques + loc.allAugmentErrs = Map.mapWithKey (Map.mapWithKey . (checkAugments @allAttrDecls )) @loc.allAugments + loc.allAroundsErrs = Map.mapWithKey (Map.mapWithKey . (checkArounds @loc.allFields)) @loc.allArounds + loc.allMergesErrs = Map.mapWithKey (Map.mapWithKey . (checkMerges @loc.allNonterminals @loc.allInsts @loc.allFields)) @loc.allMerges + + loc.checkedRulesPre = Map.map (Map.map fst) @loc.allRulesErrs + loc.checkedSigs = Map.map (Map.map fst) @loc.allSigsErrs `unionunionplusplus` @loc.augmentSigs + loc.checkedInsts = Map.map (Map.map fst) @loc.allInstsErrs + loc.checkedUniques = Map.map (Map.map fst) @loc.allUniquesErrs + loc.checkedAugments = Map.map (Map.map fst) @loc.allAugmentErrs + loc.checkedArounds = Map.map (Map.map fst) @loc.allAroundsErrs + loc.checkedRules = Map.unionWith (Map.unionWith (++)) @loc.checkedRulesPre (Map.mapWithKey (Map.mapWithKey . (mkUniqueRules @lhs.options @loc.allRules @loc.allFields @loc.checkedInsts @loc.allAttrDecls)) @loc.checkedUniques) + loc.checkedMerges = Map.map (Map.map fst) @loc.allMergesErrs + + loc.errs1 = let f = checkForDuplicates (DupSynonym) + in Seq.fromList . f . map fst $ @elems.typeSyns -- forbid duplicate type synonyms + + loc.errs2 = 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 -- forbid duplicate fields + + loc.errs3 = let -- f (nt,cons) = checkForDuplicates (DupAlt nt) cons + in Seq.empty -- allow duplicate constructors, merging their fields + -- Seq.fromList . concat . map f . Map.toList $ @allConstrs -- forbid duplicate constructors + + loc.errs4 = let f m s = Map.foldr ((><) . snd) s m + in Map.foldr f Seq.empty @loc.allRulesErrs + + loc.errs5 = let f m s = Map.foldr ((><) . snd) s m + in Map.foldr f Seq.empty @loc.allSigsErrs + + loc.errs6 = let f m s = Map.foldr ((><) . snd) s m + in Map.foldr f Seq.empty @loc.allInstsErrs + + loc.errs7 = let f m s = Map.foldr ((><) . snd) s m + in Map.foldr f Seq.empty @loc.allUniquesErrs + + loc.errs8 = let f m s = Map.foldr ((><) . snd) s m + in Map.foldr f Seq.empty @loc.allAugmentErrs + + loc.errs9 = let f m s = Map.foldr ((><) . snd) s m + in Map.foldr f Seq.empty @loc.allAroundsErrs + + loc.errs10 = let f m s = Map.foldr ((><)) s m + in Map.foldr f Seq.empty @loc.allNamesErrs + + loc.errs11 = let f m s = Map.foldr ((><) . snd) s m + in Map.foldr f Seq.empty @loc.allMergesErrs + + lhs.errors = @elems.errors >< @errs1 >< @errs2 >< @errs3 >< @errs4 >< @errs5 >< @errs6 >< @errs7 >< @errs8 >< @errs9 >< @errs10 >< @errs11 + +{ +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 (++)) +} + + +{ +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 " )" +} + + +------------------------------------------------------------------------------- +-- Checking RHSs of rules (optional) +------------------------------------------------------------------------------- + +SEM SemDef | Def MergeDef + lhs.errors = if checkParseRhs @lhs.options + then Seq.fromList $ checkRhs @rhs + else Seq.empty + +-- type of a type signature + +SEM SemDef | TypeDef + lhs.errors = if checkParseTy @lhs.options + 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 + +------------------------------------------------------------------------------- +-- Collecting fields +------------------------------------------------------------------------------- + +ATTR Fields Field [ | | collectedFields USE {++} {[]} : {[(Identifier, Type)]} ] + +SEM Field | FChild + lhs.collectedFields = [(@name, makeType @lhs.allNonterminals @tp)] + +------------------------------------------------------------------------------- +-- Collecting constraints +------------------------------------------------------------------------------- + +ATTR Fields Field [ | | collectedConstraints USE {++} {[]} : {[Type]} ] + +SEM Field | FCtx + lhs.collectedConstraints = @tps + +------------------------------------------------------------------------------- +-- Collecting Set names and Nonterminal names +------------------------------------------------------------------------------- + + + +SEM Elem + | Set lhs.collectedSetNames = Set.singleton @name + +SEM Elem + | Type lhs.collectedNames = Set.singleton @name + +SEM NontSet + | NamedSet lhs.collectedNames = Set.singleton @name + +SEM AG + | AG loc.allNonterminals = @elems.collectedNames `Set.difference` @elems.collectedSetNames + + + + + + +SEM ConstructorSet + | CName lhs.collectedConstructorNames = Set.singleton @name + +--SEM Alt +-- | Alt lhs.collectedConstructorNames = Set.singleton @name + +SEM Elem + | Data lhs.collectedConstructorsMap = Map.fromList + [ (n, @alts.collectedConstructorNames) + | n <- Set.toList @names.nontSet + ] + +SEM AG + | AG elems.allConstructors = @elems.collectedConstructorsMap + + + +------------------------------------------------------------------------------- +-- Type synonyms +------------------------------------------------------------------------------- + +{- At the moment type synonyms are only supported for list types + This means that only synonyms of the form: + TYPE <NT> = [ <TP> ] + are allowed +-} + + +ATTR Elem Elems [ | | typeSyns USE {++} {[]} : {TypeSyns} ] + +{- Put this synonym in the typeSyns list and + add the implicit Cons and Nil productions for the type synonym + + A synonym of the form: + TYPE <NT> = [ <TP> ] + is translated into: + DATA <NT> | Cons hd:<TP> tl:<NT> + | Nil +-} + +SEM Elem + | Type loc.expanded = 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)] + loc.argType = case @type of + Maybe tp -> Maybe ( makeType @lhs.allNonterminals tp) + Either tp1 tp2 -> Either ( makeType @lhs.allNonterminals tp1) (makeType @lhs.allNonterminals tp2) + List tp -> List ( makeType @lhs.allNonterminals tp) + Tuple xs -> Tuple [(f,makeType @lhs.allNonterminals tp) | (f,tp) <- xs] + Map tp1 tp2 -> Map ( makeType @lhs.allNonterminals tp1) (makeType @lhs.allNonterminals tp2) + IntMap tp -> IntMap ( makeType @lhs.allNonterminals tp) + OrdSet tp -> OrdSet ( makeType @lhs.allNonterminals tp) + IntSet -> IntSet + lhs.typeSyns = [(@name,@argType)] + +------------------------------------------------------------------------------- +-- Interpreting Nonterminal sets +------------------------------------------------------------------------------- + + +SEM AG + | AG + elems.defSets = Map.fromList (map (\x->(x,(Set.singleton x, Set.empty))) (Set.toList @loc.allNonterminals)) + elems.definedSets = Map.map fst @elems.defSets + + +SEM Elem + | Set loc.(defSets2,errs) = let allUsedNames = Set.unions [ maybe (Set.singleton n) + snd + (Map.lookup n @lhs.defSets) + | n <- Set.toList @set.collectedNames + ] + (nontSet,e1) | Set.member @name allUsedNames + = (Set.empty, Seq.singleton(CyclicSet @name)) + | otherwise = (@set.nontSet, 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 @lhs.allNonterminals || not @merge + then checkDuplicate DupSet @name toAdd @lhs.defSets + else (Map.insertWith un @name toAdd @lhs.defSets, Seq.empty) + in (res, e1 Seq.>< e2) + lhs.defSets = @defSets2 + .errors = @errs >< @set.errors + +SEM NontSet + | All lhs.nontSet = @lhs.allNonterminals + | NamedSet loc.(nontSet,errors) = case Map.lookup @name @lhs.definedSets of + Nothing -> (Set.empty, Seq.singleton (UndefNont @name)) + Just set -> (set, Seq.empty) + | Union lhs.nontSet = Set.union @set1.nontSet @set2.nontSet + | Intersect lhs.nontSet = Set.intersection @set1.nontSet @set2.nontSet + | Difference lhs.nontSet = Set.difference @set1.nontSet @set2.nontSet + | Path lhs.nontSet = let table = flattenDatas @lhs.allFields + in path table @from @to + lhs.errors = let check name | Set.member name @lhs.allNonterminals + = Seq.empty + | otherwise = Seq.singleton (UndefNont name) + in check @from >< check @to + + +{ +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 +} + +------------------------------------------------------------------------------- +-- Interpreting Constructor Sets +------------------------------------------------------------------------------- + + +SEM ConstructorSet + | CName lhs.constructors = \_ -> Set.singleton @name + | CUnion lhs.constructors = \ds -> @set1.constructors ds `Set.union` @set2.constructors ds + | CDifference lhs.constructors = \ds -> @set1.constructors ds `Set.difference` @set2.constructors ds + | CAll lhs.constructors = \ds -> ds + +------------------------------------------------------------------------------- +-- Collecting wrappers +------------------------------------------------------------------------------- + +ATTR Elem Elems [ | | wrappers USE {`Set.union`} {Set.empty} :{Set NontermIdent}] + +SEM Elem + | Wrapper lhs.wrappers = @set.nontSet + +------------------------------------------------------------------------------- +-- Collecting nocatas +------------------------------------------------------------------------------- + +SEM Elem + | Nocatas lhs.pragmas = \o -> o { nocatas = @set.nontSet `Set.union` nocatas o } + +------------------------------------------------------------------------------- +-- Collecting pragmas +------------------------------------------------------------------------------- + +ATTR AG Elem Elems [ | | pragmas USE {.} {id} :{Options -> Options}] + +SEM Elem + | Pragma lhs.pragmas = 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 + +{ +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 == '_' +} + +ATTR Elem Elems SemAlts SemAlt [ | | semPragmasCollect USE {`pragmaMapUnion`} {Map.empty} : {PragmaMap} ] + +SEM SemAlt + | SemAlt + loc.pragmaNames = Set.fromList @rules.pragmaNamesCollect + lhs.semPragmasCollect = foldr pragmaMapUnion Map.empty [ pragmaMapSingle nt con @loc.pragmaNames + | (nt, conset, _) <- @loc.coninfo + , con <- Set.toList conset + ] + +ATTR SemDefs SemDef [ | | pragmaNamesCollect USE {++} {[]} : {[Identifier]} ] + +SEM SemDef + | SemPragma + lhs.pragmaNamesCollect = @names + +{ +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) +} + +------------------------------------------------------------------------------- +-- Collecting attribute orders +------------------------------------------------------------------------------- + +ATTR Elem Elems SemAlts SemAlt [ | | attrOrderCollect USE {`orderMapUnion`} {Map.empty} : {AttrOrderMap} ] +ATTR Elem Elems SemAlts SemAlt [ allAttrDecls : {Map NontermIdent (Attributes, Attributes)} | | ] + +SEM SemAlt + | SemAlt + loc.attrOrders + = [ orderMapSingle nt con @rules.orderDepsCollect + | (nt, conset, _) <- @loc.coninfo + , con <- Set.toList conset + ] + + lhs.attrOrderCollect = foldr orderMapUnion Map.empty @loc.attrOrders + +ATTR SemDefs SemDef [ | | orderDepsCollect USE {`Set.union`} {Set.empty} : {Set Dependency} ] + +SEM SemDef + | AttrOrderBefore + loc.dependency = [ Dependency b a | b <- @before, a <- @after ] + lhs.orderDepsCollect = Set.fromList @loc.dependency + +{ +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) +} + +------------------------------------------------------------------------------- +-- Collecting nonterminal type parameters +------------------------------------------------------------------------------- + +ATTR Elem Elems [ | | paramsCollect USE {`mergeParams`} {Map.empty} : {ParamMap}] + +SEM Elem + | Data + lhs.paramsCollect = if null @params + then Map.empty + else Map.fromList [(nt, @params) | nt <- Set.toList @names.nontSet] + +SEM Elem + | Type + lhs.paramsCollect = if null @params + then Map.empty + else Map.singleton @name @params + +{ +mergeParams :: ParamMap -> ParamMap -> ParamMap +mergeParams = Map.unionWith (++) +} + +------------------------------------------------------------------------------- +-- Collecting class contexts of semantic functions +------------------------------------------------------------------------------- + +ATTR Elem Elems [ | | ctxCollect USE {`mergeCtx`} {Map.empty} : {ContextMap}] + +SEM Elem + | Sem Data Attr + lhs.ctxCollect = if null @ctx + then Map.empty + else Map.fromList [(nt, @ctx) | nt <- Set.toList @names.nontSet] + +SEM Elem + | Type + lhs.ctxCollect = if null @ctx + then Map.empty + else Map.singleton @name @ctx + +{ +mergeCtx :: ContextMap -> ContextMap -> ContextMap +mergeCtx + = Map.unionWith nubconcat + where nubconcat a b = nub (a ++ b) +} + +------------------------------------------------------------------------------- +-- Collecting quantifiers of semantic functions +------------------------------------------------------------------------------- + +ATTR Elem Elems [ | | quantCollect USE {`mergeQuant`} {Map.empty} : {QuantMap}] + +SEM Elem + | Sem Attr + lhs.quantCollect = if null @quants + then Map.empty + else Map.fromList [(nt, @quants) | nt <- Set.toList @names.nontSet] + +{ +mergeQuant :: QuantMap -> QuantMap -> QuantMap +mergeQuant = Map.unionWith (++) +} + +------------------------------------------------------------------------------- +-- Collecting derivings +------------------------------------------------------------------------------- + +ATTR Elem Elems [ | | derivings USE {`mergeDerivings`} {Map.empty} :{Derivings}] + +{ +mergeDerivings :: Derivings -> Derivings -> Derivings +mergeDerivings m1 m2 = foldr (\(n,cs) m -> Map.insertWith Set.union n cs m) m2 (Map.toList m1) +} + +SEM Elem + | Deriving lhs.derivings = Map.fromList [(nt,Set.fromList @classes) | nt <- Set.toList @set.nontSet] + +------------------------------------------------------------------------------- +-- Collecting ATTR declarations +------------------------------------------------------------------------------- + +{ +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 +} + +SEM AG + | AG elems.attrDecls = Map.empty + +SEM Elem + | Data attrs.nts = @names.nontSet + | Attr attrs.nts = @names.nontSet + | Sem attrs.nts = @names.nontSet + + +SEM Attrs [ nts:{Set NontermIdent} | | ] + | Attrs loc.(attrDecls,errors) = checkAttrs @lhs.allFields (Set.toList @lhs.nts) @inherited @synthesized @lhs.attrDecls + + .(inherited,synthesized,useMap) = let splitAttrs xs = unzip [ ((n,makeType @lhs.allNonterminals 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))) + lhs.useMap = Map.fromList (zip (Set.toList @lhs.nts) (repeat @useMap)) + + loc.errors1 = if checkParseTy @lhs.options + 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 + lhs.errors = @loc.errors Seq.>< @loc.errors1 + + +{ +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) +} + + +-- Add declaration of self-attribute for each nonterminal: ATTR <nt> [ | | self:SELF] +{ +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 +} + + +SEM AG + | AG loc.allAttrDecls = if withSelf @lhs.options + then foldr addSelf @elems.attrDecls (Set.toList @loc.allNonterminals) + else @elems.attrDecls + +------------------------------------------------------------------------------- +-- Collecting rules +------------------------------------------------------------------------------- + + +ATTR SemDef SemDefs [ | | ruleInfos USE {++} {[]} : {[RuleInfo]} + sigInfos USE {++} {[]} : {[SigInfo]} + uniqueInfos USE {++} {[]} : {[UniqueInfo]} + augmentInfos USE {++} {[]} : {[AugmentInfo]} + aroundInfos USE {++} {[]} : {[AroundInfo]} + mergeInfos USE {++} {[]} : {[MergeInfo]} + ] + + +SEM SemAlt + | SemAlt loc.coninfo = [ (nt, conset, conkeys) + | nt <- Set.toList @lhs.nts + , let conmap = Map.findWithDefault Map.empty nt @lhs.allFields + , let conkeys = Set.fromList (Map.keys conmap) + , let conset = @constructorSet.constructors conkeys + ] + + lhs.errors = Seq.fromList + [ UndefAlt nt con + | (nt, conset, conkeys) <- @loc.coninfo + , con <- Set.toList (Set.difference conset conkeys) + ] + Seq.>< @rules.errors + lhs.collectedRules + = [ (nt,con,r) + | (nt, conset, _) <- @loc.coninfo + , con <- Set.toList conset + , r <- @rules.ruleInfos + ] + lhs.collectedSigs + = [ (nt,con,ts) + | (nt, conset, _) <- @loc.coninfo + , con <- Set.toList conset + , ts <- @rules.sigInfos + ] + + lhs.collectedInsts + = [ (nt,con,@rules.definedInsts) + | (nt, conset, _) <- @loc.coninfo + , con <- Set.toList conset + ] + + lhs.collectedUniques + = [ (nt,con,@rules.uniqueInfos) + | (nt, conset, _) <- @loc.coninfo + , con <- Set.toList conset + ] + + lhs.collectedAugments + = [ (nt, con, @rules.augmentInfos) + | (nt, conset, _) <- @loc.coninfo + , con <- Set.toList conset + ] + + lhs.collectedArounds + = [ (nt, con, @rules.aroundInfos) + | (nt, conset, _) <- @loc.coninfo + , con <- Set.toList conset + ] + + lhs.collectedMerges + = [ (nt, con, @rules.mergeInfos) + | (nt, conset, _) <- @loc.coninfo + , con <- Set.toList conset + ] + +SEM SemDef + | Def lhs.ruleInfos = [ (@mbName, @pattern.patunder, @rhs, @pattern.definedAttrs, @owrt, show @pattern.stpos, @pure, @eager) ] + +SEM SemDef + | TypeDef lhs.sigInfos = [ (@ident, @tp) ] + +SEM SemDef + | UniqueDef lhs.uniqueInfos = [ (@ident, @ref) ] + +SEM SemDef + | AugmentDef lhs.augmentInfos = [ (@ident, @rhs) ] + +SEM SemDef + | AroundDef lhs.aroundInfos = [ (@ident, @rhs) ] + +SEM SemDef + | MergeDef lhs.mergeInfos = [ (@target, @nt, @sources, @rhs) ] + + +ATTR SemDef SemDefs Pattern Patterns [|| definedInsts USE {++} {[]} : {[Identifier]} ] +ATTR Pattern Patterns [ | | definedAttrs USE {++} {[]} : {[AttrName]} ] +ATTR Pattern [ | | patunder : {[AttrName]->Pattern} ] +ATTR Patterns [ | | patunder : {[AttrName]->Patterns} ] + +SEM Pattern + | Alias lhs.definedAttrs = (@field, @attr) : @pat.definedAttrs + lhs.patunder = \us -> if ((@field,@attr) `elem` us) then Underscore noPos else @copy + lhs.definedInsts = (if @field == _INST then [@attr] else []) ++ @pat.definedInsts + | Underscore lhs.patunder = \_ -> @copy + | Constr lhs.patunder = \us -> Constr @name (@pats.patunder us) + | Product lhs.patunder = \us -> Product @pos (@pats.patunder us) + | Irrefutable lhs.patunder = \us -> Irrefutable (@pat.patunder us) + +SEM Patterns + | Nil lhs.patunder = \_ -> [] + | Cons lhs.patunder = \us -> (@hd.patunder us) : (@tl.patunder us) + +ATTR Pattern [ | | stpos : Pos ] + +SEM Pattern + | Constr lhs.stpos = getPos @name + | Product lhs.stpos = @pos + | Alias lhs.stpos = getPos @field + | Underscore lhs.stpos = @pos + +------------------------------------------------------------------------------- +-- Collect module declaration +------------------------------------------------------------------------------- + +ATTR AG Elems Elem [ | | moduleDecl USE {`flipmplus`} {mzero} : {Maybe (String,String,String)} ] + +SEM Elem + | Module + lhs.moduleDecl = Just (@name, @exports, @imports) + +{ +-- We want the last Just in the list +flipmplus = flip mplus +} + +------------------------------------------------------------------------------- +-- Constructing transformed syntax tree +------------------------------------------------------------------------------- +{ +makeType :: Set NontermIdent -> Type -> Type +makeType nts tp@(NT x _ _) | Set.member x nts = tp + | otherwise = Haskell (typeToHaskellString Nothing [] tp) +makeType _ tp = tp +} +{ +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 +} + +{ +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 (++) +} + + +--marcos +------------------------------------------------------------------------------- +-- Collecting Macro information +------------------------------------------------------------------------------- + +ATTR Alt Alts Elem Elems + [ | | collectedMacros USE {++} {[]} : {[(NontermIdent, ConstructorIdent, MaybeMacro)]}] + + +SEM Alt + | Alt lhs.collectedMacros = [ (nt, con, @macro) + | nt <- Set.toList @lhs.nts + , con <- Set.toList (@names.constructors (Map.findWithDefault Set.empty nt @lhs.allConstructors)) + ] + + +SEM AG + | AG + + loc.allMacros = let f (nt,con,m) = Map.insertWith (Map.union) nt (Map.singleton con m) + in foldr f (Map.empty) @elems.collectedMacros + + +------------------------------------------------------------------------------- +-- Collecting the AGI information +------------------------------------------------------------------------------- + +ATTR AG [ | | agi : {(Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))} ] + +ATTR Elem Elems SemAlts SemAlt [ allAttrs : {Map NontermIdent (Attributes, Attributes)} | | ] + +SEM AG + | AG lhs.agi = (@loc.allNonterminals,@loc.allFields,@loc.allAttrs) + + loc.allAttrs = if withSelf @lhs.options + then foldr addSelf @elems.attrs (Set.toList @loc.allNonterminals) + else @elems.attrs + +ATTR Elems Elem Attrs + [ | attrs : {Map NontermIdent (Attributes, Attributes)} | ] + +SEM AG + | AG elems.attrs = Map.empty + + +SEM Attrs + | Attrs lhs.attrs = 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 @lhs.attrs (Set.toList @lhs.nts) + + +------------------------------------------------------------------------------- +-- Collecting the data type information +------------------------------------------------------------------------------- + +ATTR AG Elems Elem + [ | | constructorTypeMap USE {`Map.union`} {Map.empty} : {Map NontermIdent ConstructorType} ] + +SEM Elem + | Data lhs.constructorTypeMap = Set.fold (\nm mp -> Map.insert nm @contype mp) Map.empty @names.collectedNames
+ src-ag/Visage.ag view
@@ -0,0 +1,122 @@+INCLUDE "VisageSyntax.ag" +INCLUDE "VisagePatterns.ag" +INCLUDE "Expression.ag" + + +imports { +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 +} + +{ +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 +} + +WRAPPER VisageGrammar + +ATTR VisageGrammar VisageNonterminal VisageProduction + VisageChild VisageRule Expression VisagePattern [ || aterm:{ATerm} ] +ATTR VisageNonterminals VisageProductions VisageChildren + VisageRules VisagePatterns [ || aterms:{[ATerm]} ] +ATTR VisageRules -> VisageRule [ isLoc : Bool | | ] + +SEM VisageGrammar + | VGrammar lhs.aterm = AAppl "Productions" @nonts.aterms + + +SEM VisageNonterminals + | Cons lhs.aterms = @hd.aterm : @tl.aterms + | Nil lhs.aterms = [] + + +SEM VisageNonterminal + | VNonterminal lhs.aterm = AAppl "Production" [AString (sQ (getName @nt)), AString (sQ(showMap @inh)), + AString (sQ(showMap @syn)), AAppl "Alternatives" @alts.aterms] + + +SEM VisageProductions + | Cons lhs.aterms = @hd.aterm : @tl.aterms + | Nil lhs.aterms = [] + + +SEM VisageProduction + | VProduction lhs.aterm = AAppl "Alternative" [AString (sQ (getName @con)), AAppl "Children" @children.aterms, + AAppl "Rules" @rules.aterms, + AAppl "LocRules" @locrules.aterms] + locrules.isLoc = True + rules.isLoc = False + +SEM VisageChildren + | Cons lhs.aterms = @hd.aterm : @tl.aterms + | Nil lhs.aterms = [] + + +SEM VisageChild + | VChild lhs.aterm = AAppl "Child" [AString (sQ (getName @name)), AString (sQ (show @tp)), + AString (sQ (showMap @inh)), + AString (sQ (showMap @syn)), + AAppl "Rules" @rules.aterms] + rules.isLoc = False + +SEM VisageRules + | Cons lhs.aterms = @hd.aterm : @tl.aterms + | Nil lhs.aterms = [] + + +SEM VisageRule + | VRule lhs.aterm = AAppl (if @lhs.isLoc then "LocRule" else "Rule") + ([AString (sQ (getName @attr)), @pat.aterm, @rhs.aterm] ++ if @lhs.isLoc then [AString (sQ (show @owrt))] else []) + + + +SEM Expression + | Expression lhs.aterm = AAppl "Expression" [AString (sQ (showAGPos @pos)), AString (sQ (unlines . showTokens . tokensToStrings $ @tks))] + + +SEM VisagePatterns + | Cons lhs.aterms = @hd.aterm : @tl.aterms + | Nil lhs.aterms = [] + + +SEM VisagePattern + | VConstr lhs.aterm = AAppl "Pattern" [AAppl "Constr" [AString (sQ (showAGPos (getPos @name))), + AString (sQ (getName @name)), + AAppl "Patterns" @pats.aterms]] + | VProduct lhs.aterm = AAppl "Pattern" [AAppl "Product" [AString (sQ (showAGPos @pos)), + AAppl "Patterns" @pats.aterms]] + | VVar lhs.aterm = AAppl "Pattern" [AAppl "Var" [AString (sQ (showAGPos (getPos @field))), + AString (sQ (getName @field ++ "." ++ getName @attr))]] + | VAlias lhs.aterm = AAppl "Pattern" [AAppl "Alias" [AString (sQ (showAGPos (getPos @field))), + AString (sQ (getName @field ++ "." ++ getName @attr)), @pat.aterm]] + | VUnderscore lhs.aterm = AAppl "Pattern" [AAppl "Underscore" [AString (sQ (showAGPos @pos))]] +
+ src-ag/VisagePatterns.ag view
@@ -0,0 +1,19 @@+imports +{ +import UU.Scanner.Position(Pos) +import CommonTypes +} + +TYPE VisagePatterns = [VisagePattern] + +DATA VisagePattern | VConstr name : {ConstructorIdent} + pats : VisagePatterns + | VProduct pos : {Pos} + pats : VisagePatterns + | VVar field : {Identifier} + attr : {Identifier} + | VAlias field : {Identifier} + attr : {Identifier} + pat : VisagePattern + | VUnderscore pos : {Pos} +
+ src-ag/VisageSyntax.ag view
@@ -0,0 +1,42 @@+imports +{ +import CommonTypes +import UU.Pretty +import AbstractSyntax +import VisagePatterns +import Expression +} + +DATA VisageGrammar | VGrammar nonts : VisageNonterminals + +TYPE VisageNonterminals = [VisageNonterminal] + +TYPE VisageProductions = [VisageProduction] + +TYPE VisageChildren = [VisageChild] + +TYPE VisageRules = [VisageRule] + +DATA VisageNonterminal | VNonterminal nt : {NontermIdent} + inh : {Attributes} + syn : {Attributes} + alts : VisageProductions + +DATA VisageProduction | VProduction con : {ConstructorIdent} + children : VisageChildren + rules : VisageRules + locrules : VisageRules + + +DATA VisageChild | VChild name : {Identifier} + tp : {Type} + inh : {Attributes} + syn : {Attributes} + rules : VisageRules + +DATA VisageRule | VRule fieldattrs : {[(Identifier,Identifier)]} + attr : {Identifier} + pat : VisagePattern + rhs : Expression + owrt : {Bool} +
src-generated/AG2AspectAG.hs view
@@ -1,2928 +1,2928 @@-{-# 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 +{-# LANGUAGE Rank2Types, GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module AG2AspectAG where+{-# LINE 2 "src-ag/HsToken.ag" #-}+ +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 10 "src-generated/AG2AspectAG.hs" #-}++{-# LINE 2 "src-ag/Expression.ag" #-}+ +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 16 "src-generated/AG2AspectAG.hs" #-}++{-# LINE 2 "src-ag/Patterns.ag" #-}+ +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 23 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/AG2AspectAG.hs" #-}++{-# LINE 33 "src-ag/AG2AspectAG.ag" #-}+ +ppName l = ppListSep "" "" "_" l +{-# LINE 68 "src-generated/AG2AspectAG.hs" #-}++{-# LINE 70 "src-ag/AG2AspectAG.ag" #-}+ +type FieldMap = [(Identifier, Type)] +type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap) +{-# LINE 74 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule3 #-}+ {-# LINE 67 "src-ag/AG2AspectAG.ag" #-}+ rule3 = \ _inh ->+ {-# LINE 67 "src-ag/AG2AspectAG.ag" #-}+ _inh+ {-# LINE 470 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule4 #-}+ {-# LINE 182 "src-ag/AG2AspectAG.ag" #-}+ rule4 = \ name_ ->+ {-# LINE 182 "src-ag/AG2AspectAG.ag" #-}+ pp name_+ {-# LINE 476 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule5 #-}+ {-# LINE 183 "src-ag/AG2AspectAG.ag" #-}+ rule5 = \ tp_ ->+ {-# LINE 183 "src-ag/AG2AspectAG.ag" #-}+ ppShow tp_+ {-# LINE 482 "src-generated/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 "src-generated/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 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule8 #-}+ {-# LINE 285 "src-ag/AG2AspectAG.ag" #-}+ rule8 = \ _chName ->+ {-# LINE 285 "src-ag/AG2AspectAG.ag" #-}+ "ch_" >|< _chName+ {-# LINE 502 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule9 #-}+ {-# LINE 286 "src-ag/AG2AspectAG.ag" #-}+ rule9 = \ _chName ->+ {-# LINE 286 "src-ag/AG2AspectAG.ag" #-}+ "Ch_" >|< _chName+ {-# LINE 508 "src-generated/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 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule11 #-}+ {-# LINE 293 "src-ag/AG2AspectAG.ag" #-}+ rule11 = \ _chLabel _chTLabel ->+ {-# LINE 293 "src-ag/AG2AspectAG.ag" #-}+ [ _chLabel , _chTLabel ]+ {-# LINE 524 "src-generated/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 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule13 #-}+ {-# LINE 489 "src-ag/AG2AspectAG.ag" #-}+ rule13 = \ name_ tp_ ->+ {-# LINE 489 "src-ag/AG2AspectAG.ag" #-}+ [ (name_, removeDeforested tp_ ) ]+ {-# LINE 537 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule51 #-}+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}+ rule51 = \ ((_nontsIsynMap') :: Map Identifier Attributes) ->+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}+ _nontsIsynMap'+ {-# LINE 887 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule52 #-}+ {-# LINE 43 "src-ag/AG2AspectAG.ag" #-}+ rule52 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 43 "src-ag/AG2AspectAG.ag" #-}+ rename _lhsIoptions+ {-# LINE 893 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule53 #-}+ {-# LINE 47 "src-ag/AG2AspectAG.ag" #-}+ rule53 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 47 "src-ag/AG2AspectAG.ag" #-}+ sort $ noGroup _lhsIoptions+ {-# LINE 899 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule54 #-}+ {-# LINE 48 "src-ag/AG2AspectAG.ag" #-}+ rule54 = \ _o_noGroup ->+ {-# LINE 48 "src-ag/AG2AspectAG.ag" #-}+ _o_noGroup+ {-# LINE 905 "src-generated/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 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule56 #-}+ {-# LINE 82 "src-ag/AG2AspectAG.ag" #-}+ rule56 = \ _newAtts ->+ {-# LINE 82 "src-ag/AG2AspectAG.ag" #-}+ _newAtts+ {-# LINE 918 "src-generated/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 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule58 #-}+ {-# LINE 90 "src-ag/AG2AspectAG.ag" #-}+ rule58 = \ _newProds ->+ {-# LINE 90 "src-ag/AG2AspectAG.ag" #-}+ _newProds+ {-# LINE 931 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule62 #-}+ {-# LINE 202 "src-ag/AG2AspectAG.ag" #-}+ rule62 = \ derivings_ ->+ {-# LINE 202 "src-ag/AG2AspectAG.ag" #-}+ derivings_+ {-# LINE 979 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule63 #-}+ {-# LINE 251 "src-ag/AG2AspectAG.ag" #-}+ rule63 = \ typeSyns_ ->+ {-# LINE 251 "src-ag/AG2AspectAG.ag" #-}+ typeSyns_+ {-# LINE 985 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule67 #-}+ {-# LINE 392 "src-ag/AG2AspectAG.ag" #-}+ rule67 = \ ((_nontsIppNtL) :: [(PP_Doc, Attributes)]) ->+ {-# LINE 392 "src-ag/AG2AspectAG.ag" #-}+ _nontsIppNtL+ {-# LINE 1021 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule78 #-}+ {-# LINE 173 "src-ag/AG2AspectAG.ag" #-}+ rule78 = \ nt_ ->+ {-# LINE 173 "src-ag/AG2AspectAG.ag" #-}+ pp nt_+ {-# LINE 1372 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule79 #-}+ {-# LINE 190 "src-ag/AG2AspectAG.ag" #-}+ rule79 = \ _ppNt ->+ {-# LINE 190 "src-ag/AG2AspectAG.ag" #-}+ _ppNt+ {-# LINE 1378 "src-generated/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 "src-generated/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 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule82 #-}+ {-# LINE 262 "src-ag/AG2AspectAG.ag" #-}+ rule82 = \ _ppNt ->+ {-# LINE 262 "src-ag/AG2AspectAG.ag" #-}+ "nt_" >|< _ppNt+ {-# LINE 1406 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule91 #-}+ {-# LINE 766 "src-ag/AG2AspectAG.ag" #-}+ rule91 = \ syn_ ->+ {-# LINE 766 "src-ag/AG2AspectAG.ag" #-}+ syn_+ {-# LINE 1473 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule92 #-}+ {-# LINE 767 "src-ag/AG2AspectAG.ag" #-}+ rule92 = \ inh_ ->+ {-# LINE 767 "src-ag/AG2AspectAG.ag" #-}+ inh_+ {-# LINE 1479 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule169 #-}+ {-# LINE 176 "src-ag/AG2AspectAG.ag" #-}+ rule169 = \ con_ ->+ {-# LINE 176 "src-ag/AG2AspectAG.ag" #-}+ pp con_+ {-# LINE 2154 "src-generated/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 "src-generated/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 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule172 #-}+ {-# LINE 195 "src-ag/AG2AspectAG.ag" #-}+ rule172 = \ _ppProd ->+ {-# LINE 195 "src-ag/AG2AspectAG.ag" #-}+ _ppProd+ {-# LINE 2174 "src-generated/AG2AspectAG.hs" #-}+ {-# INLINE rule173 #-}+ {-# LINE 196 "src-ag/AG2AspectAG.ag" #-}+ rule173 = \ _ppProd ->+ {-# LINE 196 "src-ag/AG2AspectAG.ag" #-}+ _ppProd+ {-# LINE 2180 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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
src-generated/AbstractSyntax.hs view
@@ -1,8 +1,8 @@- - --- UUAGC 0.9.51 (src-ag/AbstractSyntax.ag) -module AbstractSyntax where -{-# LINE 2 "src-ag/AbstractSyntax.ag" #-} +++-- UUAGC 0.9.53 (src-ag/AbstractSyntax.ag)+module AbstractSyntax where+{-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) @@ -12,126 +12,126 @@ 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: --} +{-# LINE 16 "src-generated/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]
src-generated/AbstractSyntaxDump.hs view
@@ -1,1083 +1,1083 @@-{-# 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 +{-# LANGUAGE Rank2Types, GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module AbstractSyntaxDump where+{-# LINE 2 "src-ag/Expression.ag" #-}+ +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 10 "src-generated/AbstractSyntaxDump.hs" #-}++{-# LINE 2 "src-ag/Patterns.ag" #-}+ +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 17 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/AbstractSyntaxDump.hs" #-}+ {-# INLINE rule49 #-}+ rule49 = \ (_ :: ()) ->+ empty
src-generated/Code.hs view
@@ -1,16 +1,16 @@- - --- UUAGC 0.9.51 (src-ag/Code.ag) -module Code where -{-# LINE 2 "src-ag/Code.ag" #-} +++-- UUAGC 0.9.53 (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" #-} +{-# LINE 13 "src-generated/Code.hs" #-}+{-# LINE 146 "src-ag/Code.ag" #-} -- Unboxed tuples -- unbox Whether unboxed tuples are wanted or not @@ -27,330 +27,330 @@ 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: --} +{-# LINE 31 "src-generated/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]
src-generated/CodeSyntax.hs view
@@ -1,151 +1,151 @@- - --- UUAGC 0.9.51 (src-ag/CodeSyntax.ag) -module CodeSyntax where -{-# LINE 2 "src-ag/CodeSyntax.ag" #-} +++-- UUAGC 0.9.53 (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: --} +{-# LINE 12 "src-generated/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]
src-generated/CodeSyntaxDump.hs view
@@ -1,1109 +1,1109 @@-{-# 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 "<no pat because In>" 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"#-} +{-# 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 "src-generated/CodeSyntaxDump.hs" #-}++{-# LINE 2 "src-ag/CodeSyntax.ag" #-}+ +import Patterns +import CommonTypes +import Data.Map(Map) +import Data.Set(Set) +{-# LINE 19 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "<no pat because In>" else _patternIpp, ppF "rhs" $ ppStrings rhs_, ppF "defines" $ ppVertexMap defines_, ppF "owrt" $ ppBool owrt_, ppF "origin" $ pp origin_] []+ {-# LINE 483 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/CodeSyntaxDump.hs" #-}
src-generated/ConcreteSyntax.hs view
@@ -1,261 +1,261 @@- - --- UUAGC 0.9.51 (src-ag/ConcreteSyntax.ag) -module ConcreteSyntax where -{-# LINE 2 "src-ag/ConcreteSyntax.ag" #-} +++-- UUAGC 0.9.53 (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: --} +{-# LINE 13 "src-generated/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]
src-generated/DeclBlocks.hs view
@@ -1,28 +1,28 @@- - --- UUAGC 0.9.51 (src-ag/DeclBlocks.ag) -module DeclBlocks where -{-# LINE 2 "src-ag/DeclBlocks.ag" #-} +++-- UUAGC 0.9.53 (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 --} +{-# LINE 9 "src-generated/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)
src-generated/DefaultRules.hs view
@@ -1,4726 +1,4726 @@-{-# 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 "<child>_around" and <child> 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: "<child>_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><errs5) - {-# LINE 3588 "dist/build/DefaultRules.hs"#-} - {-# NOINLINE[1] rule206 #-} - {-# LINE 636 "src-ag/DefaultRules.ag" #-} - rule206 = \ !_augmentsIn !_newRls ((!_rulesIoutput) :: Rules) -> - {-# 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 +{-# 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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "<child>_around" and <child> 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: "<child>_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 "src-generated/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 "src-generated/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 "src-generated/DefaultRules.hs" #-}++{-# LINE 675 "src-ag/DefaultRules.ag" #-}+ +needsMultiRules :: Options -> Bool +needsMultiRules opts = (visit opts || withCycle opts) && not (kennedyWarren opts) +{-# LINE 412 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/DefaultRules.hs" #-}+ {-# NOINLINE[1] rule3 #-}+ {-# LINE 229 "src-ag/DefaultRules.ag" #-}+ rule3 = \ !name_ ->+ {-# LINE 229 "src-ag/DefaultRules.ag" #-}+ name_+ {-# LINE 620 "src-generated/DefaultRules.hs" #-}+ {-# NOINLINE[1] rule4 #-}+ {-# LINE 238 "src-ag/DefaultRules.ag" #-}+ rule4 = \ !_inh1 ->+ {-# LINE 238 "src-ag/DefaultRules.ag" #-}+ _inh1+ {-# LINE 626 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/DefaultRules.hs" #-}+ {-# NOINLINE[1] rule34 #-}+ {-# LINE 247 "src-ag/DefaultRules.ag" #-}+ rule34 = \ (_ :: ()) ->+ {-# LINE 247 "src-ag/DefaultRules.ag" #-}+ []+ {-# LINE 933 "src-generated/DefaultRules.hs" #-}+ {-# NOINLINE[1] rule35 #-}+ {-# LINE 571 "src-ag/DefaultRules.ag" #-}+ rule35 = \ (_ :: ()) ->+ {-# LINE 571 "src-ag/DefaultRules.ag" #-}+ []+ {-# LINE 939 "src-generated/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 "src-generated/DefaultRules.hs" #-}+ {-# INLINE rule40 #-}+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}+ rule40 = \ ((!_nontsIsynMap') :: Map Identifier Attributes) ->+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}+ _nontsIsynMap'+ {-# LINE 1023 "src-generated/DefaultRules.hs" #-}+ {-# INLINE rule41 #-}+ {-# LINE 60 "src-ag/DefaultRules.ag" #-}+ rule41 = \ ((!_lhsIoptions) :: Options) ->+ {-# LINE 60 "src-ag/DefaultRules.ag" #-}+ rename _lhsIoptions+ {-# LINE 1029 "src-generated/DefaultRules.hs" #-}+ {-# INLINE rule42 #-}+ {-# LINE 61 "src-ag/DefaultRules.ag" #-}+ rule42 = \ ((!_lhsIoptions) :: Options) ->+ {-# LINE 61 "src-ag/DefaultRules.ag" #-}+ modcopy _lhsIoptions+ {-# LINE 1035 "src-generated/DefaultRules.hs" #-}+ {-# INLINE rule43 #-}+ {-# LINE 69 "src-ag/DefaultRules.ag" #-}+ rule43 = \ !wrappers_ ->+ {-# LINE 69 "src-ag/DefaultRules.ag" #-}+ wrappers_+ {-# LINE 1041 "src-generated/DefaultRules.hs" #-}+ {-# INLINE rule45 #-}+ {-# LINE 231 "src-ag/DefaultRules.ag" #-}+ rule45 = \ !useMap_ ->+ {-# LINE 231 "src-ag/DefaultRules.ag" #-}+ useMap_+ {-# LINE 1047 "src-generated/DefaultRules.hs" #-}+ {-# INLINE rule46 #-}+ {-# LINE 233 "src-ag/DefaultRules.ag" #-}+ rule46 = \ !typeSyns_ ->+ {-# LINE 233 "src-ag/DefaultRules.ag" #-}+ typeSyns_+ {-# LINE 1053 "src-generated/DefaultRules.hs" #-}+ {-# INLINE rule47 #-}+ {-# LINE 623 "src-ag/DefaultRules.ag" #-}+ rule47 = \ (_ :: ()) ->+ {-# LINE 623 "src-ag/DefaultRules.ag" #-}+ 1+ {-# LINE 1059 "src-generated/DefaultRules.hs" #-}+ {-# INLINE rule48 #-}+ {-# LINE 737 "src-ag/DefaultRules.ag" #-}+ rule48 = \ !manualAttrOrderMap_ ->+ {-# LINE 737 "src-ag/DefaultRules.ag" #-}+ manualAttrOrderMap_+ {-# LINE 1065 "src-generated/DefaultRules.hs" #-}+ {-# INLINE rule49 #-}+ {-# LINE 803 "src-ag/DefaultRules.ag" #-}+ rule49 = \ !augmentsMap_ ->+ {-# LINE 803 "src-ag/DefaultRules.ag" #-}+ augmentsMap_+ {-# LINE 1071 "src-generated/DefaultRules.hs" #-}+ {-# INLINE rule50 #-}+ {-# LINE 810 "src-ag/DefaultRules.ag" #-}+ rule50 = \ !aroundsMap_ ->+ {-# LINE 810 "src-ag/DefaultRules.ag" #-}+ aroundsMap_+ {-# LINE 1077 "src-generated/DefaultRules.hs" #-}+ {-# INLINE rule51 #-}+ {-# LINE 818 "src-ag/DefaultRules.ag" #-}+ rule51 = \ !mergeMap_ ->+ {-# LINE 818 "src-ag/DefaultRules.ag" #-}+ mergeMap_+ {-# LINE 1083 "src-generated/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 "src-generated/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 "src-generated/DefaultRules.hs" #-}+ {-# NOINLINE rule59 #-}+ {-# LINE 44 "src-ag/DefaultRules.ag" #-}+ rule59 = \ !params_ ->+ {-# LINE 44 "src-ag/DefaultRules.ag" #-}+ params_+ {-# LINE 1429 "src-generated/DefaultRules.hs" #-}+ {-# NOINLINE[1] rule60 #-}+ {-# LINE 205 "src-ag/DefaultRules.ag" #-}+ rule60 = \ !nt_ ->+ {-# LINE 205 "src-ag/DefaultRules.ag" #-}+ Set.singleton nt_+ {-# LINE 1435 "src-generated/DefaultRules.hs" #-}+ {-# NOINLINE rule61 #-}+ {-# LINE 219 "src-ag/DefaultRules.ag" #-}+ rule61 = \ !_inh1 ->+ {-# LINE 219 "src-ag/DefaultRules.ag" #-}+ _inh1+ {-# LINE 1441 "src-generated/DefaultRules.hs" #-}+ {-# NOINLINE rule62 #-}+ {-# LINE 220 "src-ag/DefaultRules.ag" #-}+ rule62 = \ !_syn1 ->+ {-# LINE 220 "src-ag/DefaultRules.ag" #-}+ _syn1+ {-# LINE 1447 "src-generated/DefaultRules.hs" #-}+ {-# NOINLINE rule64 #-}+ {-# LINE 222 "src-ag/DefaultRules.ag" #-}+ rule64 = \ !syn_ ->+ {-# LINE 222 "src-ag/DefaultRules.ag" #-}+ syn_+ {-# LINE 1453 "src-generated/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 "src-generated/DefaultRules.hs" #-}+ {-# NOINLINE rule66 #-}+ {-# LINE 235 "src-ag/DefaultRules.ag" #-}+ rule66 = \ !nt_ ->+ {-# LINE 235 "src-ag/DefaultRules.ag" #-}+ nt_+ {-# LINE 1465 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/DefaultRules.hs" #-}+ {-# NOINLINE rule156 #-}+ {-# LINE 582 "src-ag/DefaultRules.ag" #-}+ rule156 = \ (_ :: ()) ->+ {-# LINE 582 "src-ag/DefaultRules.ag" #-}+ True+ {-# LINE 2628 "src-generated/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 "src-generated/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><errs5)+ {-# LINE 3588 "src-generated/DefaultRules.hs" #-}+ {-# NOINLINE[1] rule206 #-}+ {-# LINE 636 "src-ag/DefaultRules.ag" #-}+ rule206 = \ !_augmentsIn !_newRls ((!_rulesIoutput) :: Rules) ->+ {-# LINE 636 "src-ag/DefaultRules.ag" #-}+ foldr addAugments (_rulesIoutput ++ _newRls) (Map.assocs _augmentsIn )+ {-# LINE 3594 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/DefaultRules.hs" #-}+ {-# NOINLINE[1] rule281 #-}+ {-# LINE 652 "src-ag/DefaultRules.ag" #-}+ rule281 = \ !_output ->+ {-# LINE 652 "src-ag/DefaultRules.ag" #-}+ mkRuleAlias _output+ {-# LINE 4277 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/DefaultRules.hs" #-}+ {-# INLINE rule318 #-}+ {-# LINE 645 "src-ag/DefaultRules.ag" #-}+ rule318 = \ !_tp1 !name_ ->+ {-# LINE 645 "src-ag/DefaultRules.ag" #-}+ TypeSig name_ _tp1+ {-# LINE 4638 "src-generated/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
src-generated/Desugar.hs view
@@ -1,4468 +1,4468 @@-{-# 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 "<ANY>" (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 "<ANY>" (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 +{-# 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 "src-generated/Desugar.hs" #-}++{-# LINE 2 "src-ag/Expression.ag" #-}+ +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 17 "src-generated/Desugar.hs" #-}++{-# LINE 2 "src-ag/Patterns.ag" #-}+ +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 24 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Desugar.hs" #-}++{-# LINE 204 "src-ag/Desugar.ag" #-}+ +mergeAttributes :: AttrMap -> AttrMap -> AttrMap +mergeAttributes = Map.unionWith $ Map.unionWith $ Set.union +{-# LINE 84 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Desugar.hs" #-}+ {-# INLINE rule24 #-}+ {-# LINE 59 "src-ag/Desugar.ag" #-}+ rule24 = \ !_tks' !pos_ ->+ {-# LINE 59 "src-ag/Desugar.ag" #-}+ Expression pos_ _tks'+ {-# LINE 449 "src-generated/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 "src-generated/Desugar.hs" #-}+ {-# INLINE rule27 #-}+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}+ rule27 = \ ((!_nontsIsynMap') :: Map Identifier Attributes) ->+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}+ _nontsIsynMap'+ {-# LINE 517 "src-generated/Desugar.hs" #-}+ {-# INLINE rule28 #-}+ {-# LINE 235 "src-ag/Desugar.ag" #-}+ rule28 = \ !augmentsMap_ ->+ {-# LINE 235 "src-ag/Desugar.ag" #-}+ augmentsMap_+ {-# LINE 523 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "<ANY>" (getPos field_)) False)) (const Seq.empty) _mField+ {-# LINE 756 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Desugar.hs" #-}+ {-# NOINLINE[1] rule95 #-}+ {-# LINE 157 "src-ag/Desugar.ag" #-}+ rule95 = \ !nt_ ->+ {-# LINE 157 "src-ag/Desugar.ag" #-}+ nt_+ {-# LINE 1512 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "<ANY>" (getPos field_)) attr_ True) $+ findField field_ attr_ _lhsIchildInhs+ {-# LINE 2470 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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
src-generated/ErrorMessages.hs view
@@ -1,199 +1,199 @@- - --- UUAGC 0.9.51 (src-ag/ErrorMessages.ag) -module ErrorMessages where -{-# LINE 2 "src-ag/ErrorMessages.ag" #-} +++-- UUAGC 0.9.53 (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: --} +{-# LINE 12 "src-generated/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]
src-generated/ExecutionPlan.hs view
@@ -1,8 +1,8 @@- - --- UUAGC 0.9.51 (src-ag/ExecutionPlan.ag) -module ExecutionPlan where -{-# LINE 2 "src-ag/ExecutionPlan.ag" #-} +++-- UUAGC 0.9.53 (src-ag/ExecutionPlan.ag)+module ExecutionPlan where+{-# LINE 2 "src-ag/ExecutionPlan.ag" #-} -- VisitSyntax.ag imports import Patterns (Pattern(..),Patterns) @@ -14,161 +14,161 @@ 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: --} +{-# LINE 18 "src-generated/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]
src-generated/ExecutionPlan2Caml.hs view
@@ -1,6147 +1,6147 @@-{-# 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 +{-# LANGUAGE Rank2Types, GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module ExecutionPlan2Caml where+{-# LINE 2 "src-ag/HsToken.ag" #-}+ +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 10 "src-generated/ExecutionPlan2Caml.hs" #-}++{-# LINE 2 "src-ag/Expression.ag" #-}+ +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 16 "src-generated/ExecutionPlan2Caml.hs" #-}++{-# LINE 2 "src-ag/Patterns.ag" #-}+ +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 23 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}++{-# LINE 428 "src-ag/ExecutionPlan2Caml.ag" #-}+type VisitStateState = (VisitIdentifier,StateIdentifier, StateIdentifier)+{-# LINE 139 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}++{-# LINE 822 "src-ag/ExecutionPlan2Caml.ag" #-}+ +resultValName :: String +resultValName = "__result_" + +nextStName :: String +nextStName = "__st_" +{-# LINE 228 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}++{-# LINE 1229 "src-ag/ExecutionPlan2Caml.ag" #-}+ +unionWithSum = Map.unionWith (+) +{-# LINE 309 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule1 #-}+ {-# LINE 279 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule1 = \ tp_ ->+ {-# LINE 279 "src-ag/ExecutionPlan2Caml.ag" #-}+ ppTp $ forceDeforested tp_+ {-# LINE 392 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule3 #-}+ {-# LINE 281 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule3 = \ name_ ->+ {-# LINE 281 "src-ag/ExecutionPlan2Caml.ag" #-}+ text (fieldname name_)+ {-# LINE 404 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule12 #-}+ {-# LINE 961 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule12 = \ tp_ ->+ {-# LINE 961 "src-ag/ExecutionPlan2Caml.ag" #-}+ extractNonterminal tp_+ {-# LINE 495 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule17 #-}+ {-# LINE 279 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule17 = \ tp_ ->+ {-# LINE 279 "src-ag/ExecutionPlan2Caml.ag" #-}+ ppTp $ forceDeforested tp_+ {-# LINE 547 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule19 #-}+ {-# LINE 281 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule19 = \ name_ ->+ {-# LINE 281 "src-ag/ExecutionPlan2Caml.ag" #-}+ text (fieldname name_)+ {-# LINE 559 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule21 #-}+ {-# LINE 286 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule21 = \ _field ->+ {-# LINE 286 "src-ag/ExecutionPlan2Caml.ag" #-}+ [_field ]+ {-# LINE 571 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule22 #-}+ {-# LINE 400 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule22 = \ name_ ->+ {-# LINE 400 "src-ag/ExecutionPlan2Caml.ag" #-}+ text $ fieldname name_+ {-# LINE 577 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule24 #-}+ {-# LINE 1266 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule24 = \ name_ ->+ {-# LINE 1266 "src-ag/ExecutionPlan2Caml.ag" #-}+ Set.singleton $ fieldname name_+ {-# LINE 589 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule49 #-}+ {-# LINE 86 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule49 = \ nt_ ->+ {-# LINE 86 "src-ag/ExecutionPlan2Caml.ag" #-}+ nt_+ {-# LINE 896 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule50 #-}+ {-# LINE 96 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule50 = \ params_ ->+ {-# LINE 96 "src-ag/ExecutionPlan2Caml.ag" #-}+ params_+ {-# LINE 902 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule53 #-}+ {-# LINE 163 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule53 = \ _moduleDecl ->+ {-# LINE 163 "src-ag/ExecutionPlan2Caml.ag" #-}+ _moduleDecl+ {-# LINE 961 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule55 #-}+ {-# LINE 216 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule55 = \ params_ ->+ {-# LINE 216 "src-ag/ExecutionPlan2Caml.ag" #-}+ ppTypeParams params_+ {-# LINE 973 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule61 #-}+ {-# LINE 253 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule61 = \ ((_prodsIdatatype) :: [PP_Doc]) ->+ {-# LINE 253 "src-ag/ExecutionPlan2Caml.ag" #-}+ vlist _prodsIdatatype+ {-# LINE 1030 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule63 #-}+ {-# LINE 314 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule63 = \ _fsemname nt_ ->+ {-# LINE 314 "src-ag/ExecutionPlan2Caml.ag" #-}+ _fsemname nt_+ {-# LINE 1042 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule68 #-}+ {-# LINE 323 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule68 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 323 "src-ag/ExecutionPlan2Caml.ag" #-}+ typeSigs _lhsIoptions+ {-# LINE 1074 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule73 #-}+ {-# LINE 422 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule73 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) ->+ {-# LINE 422 "src-ag/ExecutionPlan2Caml.ag" #-}+ _lhsIinhmap+ {-# LINE 1135 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule74 #-}+ {-# LINE 423 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule74 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) ->+ {-# LINE 423 "src-ag/ExecutionPlan2Caml.ag" #-}+ _lhsIsynmap+ {-# LINE 1141 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule87 #-}+ {-# LINE 596 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule87 = \ _inhAttrs ->+ {-# LINE 596 "src-ag/ExecutionPlan2Caml.ag" #-}+ Map.toList _inhAttrs+ {-# LINE 1243 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule90 #-}+ {-# LINE 602 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule90 = \ nt_ ->+ {-# LINE 602 "src-ag/ExecutionPlan2Caml.ag" #-}+ text ("wrap_" ++ show nt_)+ {-# LINE 1263 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule91 #-}+ {-# LINE 603 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule91 = \ nt_ ->+ {-# LINE 603 "src-ag/ExecutionPlan2Caml.ag" #-}+ text ("inh_" ++ show nt_)+ {-# LINE 1269 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule92 #-}+ {-# LINE 604 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule92 = \ nt_ ->+ {-# LINE 604 "src-ag/ExecutionPlan2Caml.ag" #-}+ text ("syn_" ++ show nt_)+ {-# LINE 1275 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule103 #-}+ {-# LINE 650 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule103 = \ _semFunBndNm _semname ->+ {-# LINE 650 "src-ag/ExecutionPlan2Caml.ag" #-}+ _semFunBndNm >#< "=" >#< _semname+ {-# LINE 1362 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule105 #-}+ {-# LINE 652 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule105 = \ nt_ ->+ {-# LINE 652 "src-ag/ExecutionPlan2Caml.ag" #-}+ lateSemNtLabel nt_+ {-# LINE 1374 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule106 #-}+ {-# LINE 682 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule106 = \ initial_ ->+ {-# LINE 682 "src-ag/ExecutionPlan2Caml.ag" #-}+ initial_+ {-# LINE 1380 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule107 #-}+ {-# LINE 683 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule107 = \ _allstates ->+ {-# LINE 683 "src-ag/ExecutionPlan2Caml.ag" #-}+ _allstates+ {-# LINE 1386 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule108 #-}+ {-# LINE 1390 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule108 = \ nextVisits_ ->+ {-# LINE 1390 "src-ag/ExecutionPlan2Caml.ag" #-}+ nextVisits_+ {-# LINE 1392 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule109 #-}+ {-# LINE 1391 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule109 = \ prevVisits_ ->+ {-# LINE 1391 "src-ag/ExecutionPlan2Caml.ag" #-}+ prevVisits_+ {-# LINE 1398 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule182 #-}+ {-# LINE 91 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule182 = \ con_ ->+ {-# LINE 91 "src-ag/ExecutionPlan2Caml.ag" #-}+ con_+ {-# LINE 1910 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule183 #-}+ {-# LINE 92 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule183 = \ con_ ->+ {-# LINE 92 "src-ag/ExecutionPlan2Caml.ag" #-}+ con_+ {-# LINE 1916 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule184 #-}+ {-# LINE 259 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule184 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 259 "src-ag/ExecutionPlan2Caml.ag" #-}+ dataRecords _lhsIoptions+ {-# LINE 1922 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule185 #-}+ {-# LINE 260 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule185 = \ ((_lhsIparams) :: [Identifier]) ->+ {-# LINE 260 "src-ag/ExecutionPlan2Caml.ag" #-}+ ppTypeParams _lhsIparams+ {-# LINE 1928 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule188 #-}+ {-# LINE 263 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule188 = \ _conname ->+ {-# LINE 263 "src-ag/ExecutionPlan2Caml.ag" #-}+ pp "fields_" >|< _conname+ {-# LINE 1946 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule192 #-}+ {-# LINE 384 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule192 = \ (_ :: ()) ->+ {-# LINE 384 "src-ag/ExecutionPlan2Caml.ag" #-}+ 1+ {-# LINE 1975 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule194 #-}+ {-# LINE 655 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule194 = \ _semFunBndDef ->+ {-# LINE 655 "src-ag/ExecutionPlan2Caml.ag" #-}+ Seq.singleton _semFunBndDef+ {-# LINE 1988 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule195 #-}+ {-# LINE 656 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule195 = \ _semFunBndTp ->+ {-# LINE 656 "src-ag/ExecutionPlan2Caml.ag" #-}+ Seq.singleton _semFunBndTp+ {-# LINE 1994 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule196 #-}+ {-# LINE 657 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule196 = \ _semFunBndNm _semname ->+ {-# LINE 657 "src-ag/ExecutionPlan2Caml.ag" #-}+ _semFunBndNm >#< "=" >#< _semname+ {-# LINE 2000 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule199 #-}+ {-# LINE 686 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule199 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 686 "src-ag/ExecutionPlan2Caml.ag" #-}+ typeSigs _lhsIoptions+ {-# LINE 2018 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule204 #-}+ {-# LINE 693 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule204 = \ (_ :: ()) ->+ {-# LINE 693 "src-ag/ExecutionPlan2Caml.ag" #-}+ empty+ {-# LINE 2048 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule215 #-}+ {-# LINE 1225 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule215 = \ ((_visitsIruleUsage) :: Map Identifier Int) ->+ {-# LINE 1225 "src-ag/ExecutionPlan2Caml.ag" #-}+ _visitsIruleUsage+ {-# LINE 2161 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule218 #-}+ {-# LINE 1270 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule218 = \ ((_childrenIterminaldefs) :: Set String) ->+ {-# LINE 1270 "src-ag/ExecutionPlan2Caml.ag" #-}+ _childrenIterminaldefs+ {-# LINE 2179 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule221 #-}+ {-# LINE 1349 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule221 = \ ((_visitsIlazyIntras) :: Set String) ->+ {-# LINE 1349 "src-ag/ExecutionPlan2Caml.ag" #-}+ _visitsIlazyIntras+ {-# LINE 2197 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule406 #-}+ {-# LINE 112 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule406 = \ wrappers_ ->+ {-# LINE 112 "src-ag/ExecutionPlan2Caml.ag" #-}+ wrappers_+ {-# LINE 3268 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule407 #-}+ {-# LINE 173 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule407 = \ typeSyns_ ->+ {-# LINE 173 "src-ag/ExecutionPlan2Caml.ag" #-}+ typeSyns_+ {-# LINE 3274 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule416 #-}+ {-# LINE 1451 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule416 = \ ((_nontsIvisitKinds) :: Map VisitIdentifier VisitKind) ->+ {-# LINE 1451 "src-ag/ExecutionPlan2Caml.ag" #-}+ _nontsIvisitKinds+ {-# LINE 3333 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule417 #-}+ {-# LINE 1465 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule417 = \ ((_nontsIinitStates) :: Map NontermIdent Int) ->+ {-# LINE 1465 "src-ag/ExecutionPlan2Caml.ag" #-}+ _nontsIinitStates+ {-# LINE 3339 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule427 #-}+ {-# LINE 1049 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule427 = \ pos_ ->+ {-# LINE 1049 "src-ag/ExecutionPlan2Caml.ag" #-}+ pos_+ {-# LINE 3425 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule430 #-}+ {-# LINE 1143 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule430 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 1143 "src-ag/ExecutionPlan2Caml.ag" #-}+ Inh_HsToken _lhsIoptions+ {-# LINE 3443 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule432 #-}+ {-# LINE 1363 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule432 = \ pos_ var_ ->+ {-# LINE 1363 "src-ag/ExecutionPlan2Caml.ag" #-}+ (pos_,fieldname var_)+ {-# LINE 3506 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule452 #-}+ {-# LINE 1075 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule452 = \ (_ :: ()) ->+ {-# LINE 1075 "src-ag/ExecutionPlan2Caml.ag" #-}+ False+ {-# LINE 3853 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule466 #-}+ {-# LINE 1076 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule466 = \ (_ :: ()) ->+ {-# LINE 1076 "src-ag/ExecutionPlan2Caml.ag" #-}+ False+ {-# LINE 3933 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule480 #-}+ {-# LINE 1058 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule480 = \ _mbTp ->+ {-# LINE 1058 "src-ag/ExecutionPlan2Caml.ag" #-}+ isJust _mbTp+ {-# LINE 4017 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule481 #-}+ {-# LINE 1059 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule481 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 1059 "src-ag/ExecutionPlan2Caml.ag" #-}+ typeSigs _lhsIoptions+ {-# LINE 4023 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule484 #-}+ {-# LINE 1077 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule484 = \ (_ :: ()) ->+ {-# LINE 1077 "src-ag/ExecutionPlan2Caml.ag" #-}+ False+ {-# LINE 4043 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule512 #-}+ {-# LINE 1078 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule512 = \ (_ :: ()) ->+ {-# LINE 1078 "src-ag/ExecutionPlan2Caml.ag" #-}+ True+ {-# LINE 4205 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule550 #-}+ {-# LINE 546 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule550 = \ ((_lhsIparams) :: [Identifier]) ->+ {-# LINE 546 "src-ag/ExecutionPlan2Caml.ag" #-}+ ppTypeParams _lhsIparams+ {-# LINE 4543 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule557 #-}+ {-# LINE 798 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule557 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 798 "src-ag/ExecutionPlan2Caml.ag" #-}+ typeSigs _lhsIoptions+ {-# LINE 4593 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule559 #-}+ {-# LINE 806 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule559 = \ _nextStBuild _resultval ->+ {-# LINE 806 "src-ag/ExecutionPlan2Caml.ag" #-}+ _nextStBuild >-< _resultval+ {-# LINE 4610 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule561 #-}+ {-# LINE 809 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule561 = \ _nextArgsMp ->+ {-# LINE 809 "src-ag/ExecutionPlan2Caml.ag" #-}+ ppSpaced $ Map.keys $ _nextArgsMp+ {-# LINE 4622 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule565 #-}+ {-# LINE 832 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule565 = \ kind_ ->+ {-# LINE 832 "src-ag/ExecutionPlan2Caml.ag" #-}+ kind_+ {-# LINE 4651 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule566 #-}+ {-# LINE 884 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule566 = \ (_ :: ()) ->+ {-# LINE 884 "src-ag/ExecutionPlan2Caml.ag" #-}+ 0+ {-# LINE 4657 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule567 #-}+ {-# LINE 891 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule567 = \ (_ :: ()) ->+ {-# LINE 891 "src-ag/ExecutionPlan2Caml.ag" #-}+ 0+ {-# LINE 4663 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule568 #-}+ {-# LINE 908 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule568 = \ (_ :: ()) ->+ {-# LINE 908 "src-ag/ExecutionPlan2Caml.ag" #-}+ False+ {-# LINE 4669 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule603 #-}+ {-# LINE 1226 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule603 = \ name_ ->+ {-# LINE 1226 "src-ag/ExecutionPlan2Caml.ag" #-}+ Map.singleton name_ 1+ {-# LINE 4935 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule654 #-}+ {-# LINE 886 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule654 = \ ((_lhsIindex) :: Int) ->+ {-# LINE 886 "src-ag/ExecutionPlan2Caml.ag" #-}+ _lhsIindex+ {-# LINE 5270 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule694 #-}+ {-# LINE 876 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule694 = \ ((_tlIsize) :: Int) ->+ {-# LINE 876 "src-ag/ExecutionPlan2Caml.ag" #-}+ 1 + _tlIsize+ {-# LINE 5553 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule695 #-}+ {-# LINE 881 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule695 = \ ((_lhsIindex) :: Int) ->+ {-# LINE 881 "src-ag/ExecutionPlan2Caml.ag" #-}+ _lhsIindex+ {-# LINE 5559 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule696 #-}+ {-# LINE 882 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule696 = \ ((_lhsIindex) :: Int) ->+ {-# LINE 882 "src-ag/ExecutionPlan2Caml.ag" #-}+ 1 + _lhsIindex+ {-# LINE 5565 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule697 #-}+ {-# LINE 883 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule697 = \ ((_tlIindex) :: Int) ->+ {-# LINE 883 "src-ag/ExecutionPlan2Caml.ag" #-}+ _tlIindex+ {-# LINE 5571 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule698 #-}+ {-# LINE 902 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule698 = \ (_ :: ()) ->+ {-# LINE 902 "src-ag/ExecutionPlan2Caml.ag" #-}+ False+ {-# LINE 5577 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule699 #-}+ {-# LINE 903 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule699 = \ ((_tlIisLast) :: Bool) ->+ {-# LINE 903 "src-ag/ExecutionPlan2Caml.ag" #-}+ _tlIisLast+ {-# LINE 5583 "src-generated/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 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule740 #-}+ {-# LINE 875 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule740 = \ (_ :: ()) ->+ {-# LINE 875 "src-ag/ExecutionPlan2Caml.ag" #-}+ 0+ {-# LINE 5746 "src-generated/ExecutionPlan2Caml.hs" #-}+ {-# INLINE rule741 #-}+ {-# LINE 901 "src-ag/ExecutionPlan2Caml.ag" #-}+ rule741 = \ (_ :: ()) ->+ {-# LINE 901 "src-ag/ExecutionPlan2Caml.ag" #-}+ True+ {-# LINE 5752 "src-generated/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
src-generated/ExecutionPlan2Clean.hs view
@@ -1,7001 +1,7001 @@-{-# 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 +{-# LANGUAGE Rank2Types, GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module ExecutionPlan2Clean where+{-# LINE 2 "src-ag/HsToken.ag" #-}+ +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 10 "src-generated/ExecutionPlan2Clean.hs" #-}++{-# LINE 2 "src-ag/Expression.ag" #-}+ +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 16 "src-generated/ExecutionPlan2Clean.hs" #-}++{-# LINE 2 "src-ag/Patterns.ag" #-}+ +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 23 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}++{-# LINE 260 "src-ag/ExecutionPlan2Clean.ag" #-}+ +ppTp :: Type -> PP_Doc +ppTp = text . typeToHaskellString Nothing [] +{-# LINE 97 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}++{-# LINE 374 "src-ag/ExecutionPlan2Clean.ag" #-}+type VisitStateState = (VisitIdentifier,StateIdentifier, StateIdentifier)+{-# LINE 107 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}++{-# LINE 817 "src-ag/ExecutionPlan2Clean.ag" #-}+ +resultValName :: String +resultValName = "ag__result_" + +nextStName :: String +nextStName = "ag__st_" +{-# LINE 147 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}++{-# LINE 1281 "src-ag/ExecutionPlan2Clean.ag" #-}+ +unionWithSum = Map.unionWith (+) +{-# LINE 266 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule5 #-}+ {-# LINE 248 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule5 = \ _strNm _tpDoc ->+ {-# LINE 248 "src-ag/ExecutionPlan2Clean.ag" #-}+ _strNm >#< "::" >#< _tpDoc+ {-# LINE 446 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule18 #-}+ {-# LINE 990 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule18 = \ tp_ ->+ {-# LINE 990 "src-ag/ExecutionPlan2Clean.ag" #-}+ extractNonterminal tp_+ {-# LINE 578 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule28 #-}+ {-# LINE 248 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule28 = \ _strNm _tpDoc ->+ {-# LINE 248 "src-ag/ExecutionPlan2Clean.ag" #-}+ _strNm >#< "::" >#< _tpDoc+ {-# LINE 668 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule30 #-}+ {-# LINE 257 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule30 = \ _field ->+ {-# LINE 257 "src-ag/ExecutionPlan2Clean.ag" #-}+ _field+ {-# LINE 680 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule31 #-}+ {-# LINE 258 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule31 = \ _recordfield ->+ {-# LINE 258 "src-ag/ExecutionPlan2Clean.ag" #-}+ _recordfield+ {-# LINE 686 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule32 #-}+ {-# LINE 346 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule32 = \ name_ ->+ {-# LINE 346 "src-ag/ExecutionPlan2Clean.ag" #-}+ text $ fieldname name_+ {-# LINE 692 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule33 #-}+ {-# LINE 648 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule33 = \ tp_ ->+ {-# LINE 648 "src-ag/ExecutionPlan2Clean.ag" #-}+ pp_parens $ show tp_+ {-# LINE 698 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule35 #-}+ {-# LINE 650 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule35 = \ name_ ->+ {-# LINE 650 "src-ag/ExecutionPlan2Clean.ag" #-}+ [name_]+ {-# LINE 710 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule37 #-}+ {-# LINE 1318 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule37 = \ name_ ->+ {-# LINE 1318 "src-ag/ExecutionPlan2Clean.ag" #-}+ Set.singleton $ fieldname name_+ {-# LINE 722 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule85 #-}+ {-# LINE 66 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule85 = \ nt_ ->+ {-# LINE 66 "src-ag/ExecutionPlan2Clean.ag" #-}+ nt_+ {-# LINE 1146 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule86 #-}+ {-# LINE 78 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule86 = \ params_ ->+ {-# LINE 78 "src-ag/ExecutionPlan2Clean.ag" #-}+ params_+ {-# LINE 1152 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule87 #-}+ {-# LINE 82 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule87 = \ classCtxs_ ->+ {-# LINE 82 "src-ag/ExecutionPlan2Clean.ag" #-}+ classCtxs_+ {-# LINE 1158 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule91 #-}+ {-# LINE 163 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule91 = \ classCtxs_ ->+ {-# LINE 163 "src-ag/ExecutionPlan2Clean.ag" #-}+ ppClasses $ classCtxsToDocs classCtxs_+ {-# LINE 1227 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule95 #-}+ {-# LINE 269 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule95 = \ (_ :: ()) ->+ {-# LINE 269 "src-ag/ExecutionPlan2Clean.ag" #-}+ \x -> "sem_" ++ show x+ {-# LINE 1272 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule96 #-}+ {-# LINE 270 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule96 = \ _fsemname nt_ ->+ {-# LINE 270 "src-ag/ExecutionPlan2Clean.ag" #-}+ _fsemname nt_+ {-# LINE 1278 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule99 #-}+ {-# LINE 278 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule99 = \ params_ ->+ {-# LINE 278 "src-ag/ExecutionPlan2Clean.ag" #-}+ ppQuants params_+ {-# LINE 1298 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule103 #-}+ {-# LINE 368 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule103 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) ->+ {-# LINE 368 "src-ag/ExecutionPlan2Clean.ag" #-}+ _lhsIinhmap+ {-# LINE 1357 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule104 #-}+ {-# LINE 369 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule104 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) ->+ {-# LINE 369 "src-ag/ExecutionPlan2Clean.ag" #-}+ _lhsIsynmap+ {-# LINE 1363 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule109 #-}+ {-# LINE 394 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule109 = \ nt_ ->+ {-# LINE 394 "src-ag/ExecutionPlan2Clean.ag" #-}+ "T_" >|< nt_+ {-# LINE 1393 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule110 #-}+ {-# LINE 395 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule110 = \ nt_ ->+ {-# LINE 395 "src-ag/ExecutionPlan2Clean.ag" #-}+ "t_" >|< nt_+ {-# LINE 1399 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule111 #-}+ {-# LINE 396 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule111 = \ params_ ->+ {-# LINE 396 "src-ag/ExecutionPlan2Clean.ag" #-}+ ppSpaced params_+ {-# LINE 1405 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule116 #-}+ {-# LINE 430 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule116 = \ nt_ ->+ {-# LINE 430 "src-ag/ExecutionPlan2Clean.ag" #-}+ "K_" ++ show nt_+ {-# LINE 1461 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule126 #-}+ {-# LINE 523 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule126 = \ _synAttrs ->+ {-# LINE 523 "src-ag/ExecutionPlan2Clean.ag" #-}+ Map.toList _synAttrs+ {-# LINE 1550 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule132 #-}+ {-# LINE 531 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule132 = \ nt_ ->+ {-# LINE 531 "src-ag/ExecutionPlan2Clean.ag" #-}+ "wrap_" ++ show nt_+ {-# LINE 1588 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule133 #-}+ {-# LINE 532 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule133 = \ nt_ ->+ {-# LINE 532 "src-ag/ExecutionPlan2Clean.ag" #-}+ "Inh_" ++ show nt_+ {-# LINE 1594 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule134 #-}+ {-# LINE 533 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule134 = \ nt_ ->+ {-# LINE 533 "src-ag/ExecutionPlan2Clean.ag" #-}+ "Syn_" ++ show nt_+ {-# LINE 1600 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule140 #-}+ {-# LINE 586 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule140 = \ _semFunBndNm _semname ->+ {-# LINE 586 "src-ag/ExecutionPlan2Clean.ag" #-}+ _semFunBndNm >#< "=" >#< _semname+ {-# LINE 1675 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule142 #-}+ {-# LINE 588 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule142 = \ nt_ ->+ {-# LINE 588 "src-ag/ExecutionPlan2Clean.ag" #-}+ lateSemNtLabel nt_+ {-# LINE 1687 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule143 #-}+ {-# LINE 622 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule143 = \ initial_ ->+ {-# LINE 622 "src-ag/ExecutionPlan2Clean.ag" #-}+ initial_+ {-# LINE 1693 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule144 #-}+ {-# LINE 623 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule144 = \ _allstates ->+ {-# LINE 623 "src-ag/ExecutionPlan2Clean.ag" #-}+ _allstates+ {-# LINE 1699 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule148 #-}+ {-# LINE 1574 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule148 = \ (_ :: ()) ->+ {-# LINE 1574 "src-ag/ExecutionPlan2Clean.ag" #-}+ id+ {-# LINE 1732 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule149 #-}+ {-# LINE 1586 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule149 = \ nextVisits_ ->+ {-# LINE 1586 "src-ag/ExecutionPlan2Clean.ag" #-}+ nextVisits_+ {-# LINE 1738 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule150 #-}+ {-# LINE 1587 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule150 = \ prevVisits_ ->+ {-# LINE 1587 "src-ag/ExecutionPlan2Clean.ag" #-}+ prevVisits_+ {-# LINE 1744 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule248 #-}+ {-# LINE 73 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule248 = \ con_ ->+ {-# LINE 73 "src-ag/ExecutionPlan2Clean.ag" #-}+ con_+ {-# LINE 2375 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule249 #-}+ {-# LINE 74 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule249 = \ con_ ->+ {-# LINE 74 "src-ag/ExecutionPlan2Clean.ag" #-}+ con_+ {-# LINE 2381 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule252 #-}+ {-# LINE 220 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule252 = \ constraints_ ->+ {-# LINE 220 "src-ag/ExecutionPlan2Clean.ag" #-}+ ppClasses (classConstrsToDocs constraints_)+ {-# LINE 2402 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule253 #-}+ {-# LINE 221 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule253 = \ params_ ->+ {-# LINE 221 "src-ag/ExecutionPlan2Clean.ag" #-}+ ppQuants params_+ {-# LINE 2408 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule254 #-}+ {-# LINE 320 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule254 = \ (_ :: ()) ->+ {-# LINE 320 "src-ag/ExecutionPlan2Clean.ag" #-}+ 1+ {-# LINE 2414 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule256 #-}+ {-# LINE 591 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule256 = \ _semFunBndDef ->+ {-# LINE 591 "src-ag/ExecutionPlan2Clean.ag" #-}+ Seq.singleton _semFunBndDef+ {-# LINE 2432 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule257 #-}+ {-# LINE 592 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule257 = \ _semFunBndTp ->+ {-# LINE 592 "src-ag/ExecutionPlan2Clean.ag" #-}+ Seq.singleton _semFunBndTp+ {-# LINE 2438 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule258 #-}+ {-# LINE 593 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule258 = \ _semFunBndNm _semname ->+ {-# LINE 593 "src-ag/ExecutionPlan2Clean.ag" #-}+ _semFunBndNm >#< "=" >#< _semname+ {-# LINE 2444 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule261 #-}+ {-# LINE 659 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule261 = \ ((_lhsInt) :: NontermIdent) ->+ {-# LINE 659 "src-ag/ExecutionPlan2Clean.ag" #-}+ "T_" >|< _lhsInt+ {-# LINE 2462 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule262 #-}+ {-# LINE 660 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule262 = \ ((_lhsIparams) :: [Identifier]) ->+ {-# LINE 660 "src-ag/ExecutionPlan2Clean.ag" #-}+ ppSpaced _lhsIparams+ {-# LINE 2468 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule282 #-}+ {-# LINE 1277 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule282 = \ ((_visitsIruleUsage) :: Map Identifier Int) ->+ {-# LINE 1277 "src-ag/ExecutionPlan2Clean.ag" #-}+ _visitsIruleUsage+ {-# LINE 2646 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule285 #-}+ {-# LINE 1322 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule285 = \ ((_childrenIterminaldefs) :: Set String) ->+ {-# LINE 1322 "src-ag/ExecutionPlan2Clean.ag" #-}+ _childrenIterminaldefs+ {-# LINE 2664 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule288 #-}+ {-# LINE 1401 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule288 = \ ((_visitsIlazyIntras) :: Set String) ->+ {-# LINE 1401 "src-ag/ExecutionPlan2Clean.ag" #-}+ _visitsIlazyIntras+ {-# LINE 2682 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule289 #-}+ {-# LINE 1486 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule289 = \ _moduleName ->+ {-# LINE 1486 "src-ag/ExecutionPlan2Clean.ag" #-}+ [pp $ "import " ++ _moduleName ]+ {-# LINE 2688 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule290 #-}+ {-# LINE 1487 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule290 = \ ((_lhsImainName) :: String) _suffix ->+ {-# LINE 1487 "src-ag/ExecutionPlan2Clean.ag" #-}+ _lhsImainName ++ _suffix+ {-# LINE 2694 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule350 #-}+ {-# LINE 385 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule350 = \ ((_hdIallvisits) :: [VisitStateState]) ->+ {-# LINE 385 "src-ag/ExecutionPlan2Clean.ag" #-}+ _hdIallvisits+ {-# LINE 3044 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule523 #-}+ {-# LINE 99 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule523 = \ wrappers_ ->+ {-# LINE 99 "src-ag/ExecutionPlan2Clean.ag" #-}+ wrappers_+ {-# LINE 4000 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule524 #-}+ {-# LINE 159 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule524 = \ typeSyns_ ->+ {-# LINE 159 "src-ag/ExecutionPlan2Clean.ag" #-}+ typeSyns_+ {-# LINE 4006 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule525 #-}+ {-# LINE 160 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule525 = \ derivings_ ->+ {-# LINE 160 "src-ag/ExecutionPlan2Clean.ag" #-}+ derivings_+ {-# LINE 4012 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule534 #-}+ {-# LINE 1442 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule534 = \ ((_lhsImainFile) :: String) ->+ {-# LINE 1442 "src-ag/ExecutionPlan2Clean.ag" #-}+ _lhsImainFile+ {-# LINE 4075 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule540 #-}+ {-# LINE 1647 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule540 = \ ((_nontsIvisitKinds) :: Map VisitIdentifier VisitKind) ->+ {-# LINE 1647 "src-ag/ExecutionPlan2Clean.ag" #-}+ _nontsIvisitKinds+ {-# LINE 4128 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule541 #-}+ {-# LINE 1661 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule541 = \ ((_nontsIinitStates) :: Map NontermIdent Int) ->+ {-# LINE 1661 "src-ag/ExecutionPlan2Clean.ag" #-}+ _nontsIinitStates+ {-# LINE 4134 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule555 #-}+ {-# LINE 1120 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule555 = \ pos_ ->+ {-# LINE 1120 "src-ag/ExecutionPlan2Clean.ag" #-}+ pos_+ {-# LINE 4232 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule558 #-}+ {-# LINE 1209 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule558 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 1209 "src-ag/ExecutionPlan2Clean.ag" #-}+ Inh_HsToken _lhsIoptions+ {-# LINE 4250 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule560 #-}+ {-# LINE 1412 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule560 = \ pos_ var_ ->+ {-# LINE 1412 "src-ag/ExecutionPlan2Clean.ag" #-}+ (pos_,fieldname var_)+ {-# LINE 4313 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule580 #-}+ {-# LINE 1141 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule580 = \ (_ :: ()) ->+ {-# LINE 1141 "src-ag/ExecutionPlan2Clean.ag" #-}+ False+ {-# LINE 4660 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule595 #-}+ {-# LINE 1142 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule595 = \ (_ :: ()) ->+ {-# LINE 1142 "src-ag/ExecutionPlan2Clean.ag" #-}+ False+ {-# LINE 4749 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule611 #-}+ {-# LINE 1132 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule611 = \ _addbang1 _patExpr ->+ {-# LINE 1132 "src-ag/ExecutionPlan2Clean.ag" #-}+ _addbang1 _patExpr+ {-# LINE 4849 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule612 #-}+ {-# LINE 1143 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule612 = \ (_ :: ()) ->+ {-# LINE 1143 "src-ag/ExecutionPlan2Clean.ag" #-}+ False+ {-# LINE 4855 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule615 #-}+ {-# LINE 1159 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule615 = \ (_ :: ()) ->+ {-# LINE 1159 "src-ag/ExecutionPlan2Clean.ag" #-}+ empty+ {-# LINE 4877 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule641 #-}+ {-# LINE 1144 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule641 = \ (_ :: ()) ->+ {-# LINE 1144 "src-ag/ExecutionPlan2Clean.ag" #-}+ True+ {-# LINE 5021 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule677 #-}+ {-# LINE 463 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule677 = \ ((_lhsIparams) :: [Identifier]) ->+ {-# LINE 463 "src-ag/ExecutionPlan2Clean.ag" #-}+ ppSpaced _lhsIparams+ {-# LINE 5360 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule685 #-}+ {-# LINE 804 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule685 = \ ident_ ->+ {-# LINE 804 "src-ag/ExecutionPlan2Clean.ag" #-}+ "v" >|< ident_+ {-# LINE 5441 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule690 #-}+ {-# LINE 809 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule690 = \ _nextargsMp ->+ {-# LINE 809 "src-ag/ExecutionPlan2Clean.ag" #-}+ ppSpaced $ Map.keys $ _nextargsMp+ {-# LINE 5471 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule694 #-}+ {-# LINE 827 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule694 = \ kind_ ->+ {-# LINE 827 "src-ag/ExecutionPlan2Clean.ag" #-}+ kind_+ {-# LINE 5497 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule696 #-}+ {-# LINE 917 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule696 = \ (_ :: ()) ->+ {-# LINE 917 "src-ag/ExecutionPlan2Clean.ag" #-}+ 0+ {-# LINE 5512 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule733 #-}+ {-# LINE 1278 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule733 = \ name_ ->+ {-# LINE 1278 "src-ag/ExecutionPlan2Clean.ag" #-}+ Map.singleton name_ 1+ {-# LINE 5788 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule786 #-}+ {-# LINE 918 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule786 = \ (_ :: ()) ->+ {-# LINE 918 "src-ag/ExecutionPlan2Clean.ag" #-}+ 0+ {-# LINE 6152 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule787 #-}+ {-# LINE 919 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule787 = \ ((_lhsIindex) :: Int) ->+ {-# LINE 919 "src-ag/ExecutionPlan2Clean.ag" #-}+ _lhsIindex+ {-# LINE 6158 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule822 #-}+ {-# LINE 914 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule822 = \ ((_lhsIindex) :: Int) ->+ {-# LINE 914 "src-ag/ExecutionPlan2Clean.ag" #-}+ _lhsIindex+ {-# LINE 6412 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule823 #-}+ {-# LINE 915 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule823 = \ ((_lhsIindex) :: Int) ->+ {-# LINE 915 "src-ag/ExecutionPlan2Clean.ag" #-}+ 1 + _lhsIindex+ {-# LINE 6418 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule824 #-}+ {-# LINE 916 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule824 = \ ((_tlIindex) :: Int) ->+ {-# LINE 916 "src-ag/ExecutionPlan2Clean.ag" #-}+ _tlIindex+ {-# LINE 6424 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule825 #-}+ {-# LINE 926 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule825 = \ (_ :: ()) ->+ {-# LINE 926 "src-ag/ExecutionPlan2Clean.ag" #-}+ False+ {-# LINE 6430 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule826 #-}+ {-# LINE 927 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule826 = \ ((_tlIisLast) :: Bool) ->+ {-# LINE 927 "src-ag/ExecutionPlan2Clean.ag" #-}+ _tlIisLast+ {-# LINE 6436 "src-generated/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 "src-generated/ExecutionPlan2Clean.hs" #-}+ {-# INLINE rule865 #-}+ {-# LINE 925 "src-ag/ExecutionPlan2Clean.ag" #-}+ rule865 = \ (_ :: ()) ->+ {-# LINE 925 "src-ag/ExecutionPlan2Clean.ag" #-}+ True+ {-# LINE 6593 "src-generated/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
src-generated/ExecutionPlan2Hs.hs view
@@ -1,7007 +1,7007 @@-{-# 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 +{-# LANGUAGE Rank2Types, GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module ExecutionPlan2Hs where+{-# LINE 2 "src-ag/HsToken.ag" #-}+ +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 10 "src-generated/ExecutionPlan2Hs.hs" #-}++{-# LINE 2 "src-ag/Expression.ag" #-}+ +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 16 "src-generated/ExecutionPlan2Hs.hs" #-}++{-# LINE 2 "src-ag/Patterns.ag" #-}+ +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 23 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}++{-# LINE 218 "src-ag/ExecutionPlan2Hs.ag" #-}+ +ppTp :: Type -> PP_Doc +ppTp = text . typeToHaskellString Nothing [] +{-# LINE 97 "src-generated/ExecutionPlan2Hs.hs" #-}++{-# LINE 332 "src-ag/ExecutionPlan2Hs.ag" #-}+type VisitStateState = (VisitIdentifier,StateIdentifier, StateIdentifier)+{-# LINE 101 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}++{-# LINE 779 "src-ag/ExecutionPlan2Hs.ag" #-}+ +resultValName :: String +resultValName = "__result_" + +nextStName :: String +nextStName = "__st_" +{-# LINE 139 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}++{-# LINE 1285 "src-ag/ExecutionPlan2Hs.ag" #-}+ +unionWithSum = Map.unionWith (+) +{-# LINE 258 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule15 #-}+ {-# LINE 974 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule15 = \ tp_ ->+ {-# LINE 974 "src-ag/ExecutionPlan2Hs.ag" #-}+ extractNonterminal tp_+ {-# LINE 543 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule26 #-}+ {-# LINE 216 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule26 = \ _field ->+ {-# LINE 216 "src-ag/ExecutionPlan2Hs.ag" #-}+ _field+ {-# LINE 634 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule27 #-}+ {-# LINE 304 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule27 = \ name_ ->+ {-# LINE 304 "src-ag/ExecutionPlan2Hs.ag" #-}+ text $ fieldname name_+ {-# LINE 640 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule28 #-}+ {-# LINE 586 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule28 = \ tp_ ->+ {-# LINE 586 "src-ag/ExecutionPlan2Hs.ag" #-}+ (pp_parens $ show tp_) >#< "->"+ {-# LINE 646 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule31 #-}+ {-# LINE 1322 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule31 = \ name_ ->+ {-# LINE 1322 "src-ag/ExecutionPlan2Hs.ag" #-}+ Set.singleton $ fieldname name_+ {-# LINE 664 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule73 #-}+ {-# LINE 65 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule73 = \ nt_ ->+ {-# LINE 65 "src-ag/ExecutionPlan2Hs.ag" #-}+ nt_+ {-# LINE 1053 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule74 #-}+ {-# LINE 77 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule74 = \ params_ ->+ {-# LINE 77 "src-ag/ExecutionPlan2Hs.ag" #-}+ params_+ {-# LINE 1059 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule75 #-}+ {-# LINE 81 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule75 = \ classCtxs_ ->+ {-# LINE 81 "src-ag/ExecutionPlan2Hs.ag" #-}+ classCtxs_+ {-# LINE 1065 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule78 #-}+ {-# LINE 138 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule78 = \ classCtxs_ ->+ {-# LINE 138 "src-ag/ExecutionPlan2Hs.ag" #-}+ ppClasses $ classCtxsToDocs classCtxs_+ {-# LINE 1109 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule82 #-}+ {-# LINE 227 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule82 = \ (_ :: ()) ->+ {-# LINE 227 "src-ag/ExecutionPlan2Hs.ag" #-}+ \x -> "sem_" ++ show x+ {-# LINE 1152 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule83 #-}+ {-# LINE 228 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule83 = \ _fsemname nt_ ->+ {-# LINE 228 "src-ag/ExecutionPlan2Hs.ag" #-}+ _fsemname nt_+ {-# LINE 1158 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule86 #-}+ {-# LINE 236 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule86 = \ params_ ->+ {-# LINE 236 "src-ag/ExecutionPlan2Hs.ag" #-}+ ppQuants params_+ {-# LINE 1178 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule92 #-}+ {-# LINE 326 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule92 = \ ((_lhsIinhmap) :: Map NontermIdent Attributes) ->+ {-# LINE 326 "src-ag/ExecutionPlan2Hs.ag" #-}+ _lhsIinhmap+ {-# LINE 1256 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule93 #-}+ {-# LINE 327 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule93 = \ ((_lhsIsynmap) :: Map NontermIdent Attributes) ->+ {-# LINE 327 "src-ag/ExecutionPlan2Hs.ag" #-}+ _lhsIsynmap+ {-# LINE 1262 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule98 #-}+ {-# LINE 352 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule98 = \ nt_ ->+ {-# LINE 352 "src-ag/ExecutionPlan2Hs.ag" #-}+ "T_" >|< nt_+ {-# LINE 1292 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule99 #-}+ {-# LINE 353 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule99 = \ params_ ->+ {-# LINE 353 "src-ag/ExecutionPlan2Hs.ag" #-}+ ppSpaced params_+ {-# LINE 1298 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule102 #-}+ {-# LINE 376 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule102 = \ nt_ ->+ {-# LINE 376 "src-ag/ExecutionPlan2Hs.ag" #-}+ "K_" ++ show nt_+ {-# LINE 1333 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule109 #-}+ {-# LINE 451 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule109 = \ _synAttrs ->+ {-# LINE 451 "src-ag/ExecutionPlan2Hs.ag" #-}+ Map.toList _synAttrs+ {-# LINE 1390 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule115 #-}+ {-# LINE 459 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule115 = \ nt_ ->+ {-# LINE 459 "src-ag/ExecutionPlan2Hs.ag" #-}+ "wrap_" ++ show nt_+ {-# LINE 1428 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule116 #-}+ {-# LINE 460 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule116 = \ nt_ ->+ {-# LINE 460 "src-ag/ExecutionPlan2Hs.ag" #-}+ "Inh_" ++ show nt_+ {-# LINE 1434 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule117 #-}+ {-# LINE 461 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule117 = \ nt_ ->+ {-# LINE 461 "src-ag/ExecutionPlan2Hs.ag" #-}+ "Syn_" ++ show nt_+ {-# LINE 1440 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule123 #-}+ {-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule123 = \ _semFunBndNm _semname ->+ {-# LINE 529 "src-ag/ExecutionPlan2Hs.ag" #-}+ _semFunBndNm >#< "=" >#< _semname+ {-# LINE 1529 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule125 #-}+ {-# LINE 531 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule125 = \ nt_ ->+ {-# LINE 531 "src-ag/ExecutionPlan2Hs.ag" #-}+ lateSemNtLabel nt_+ {-# LINE 1541 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule126 #-}+ {-# LINE 569 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule126 = \ initial_ ->+ {-# LINE 569 "src-ag/ExecutionPlan2Hs.ag" #-}+ initial_+ {-# LINE 1547 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule127 #-}+ {-# LINE 570 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule127 = \ _allstates ->+ {-# LINE 570 "src-ag/ExecutionPlan2Hs.ag" #-}+ _allstates+ {-# LINE 1553 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule131 #-}+ {-# LINE 1559 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule131 = \ (_ :: ()) ->+ {-# LINE 1559 "src-ag/ExecutionPlan2Hs.ag" #-}+ id+ {-# LINE 1586 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule132 #-}+ {-# LINE 1571 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule132 = \ nextVisits_ ->+ {-# LINE 1571 "src-ag/ExecutionPlan2Hs.ag" #-}+ nextVisits_+ {-# LINE 1592 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule133 #-}+ {-# LINE 1572 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule133 = \ prevVisits_ ->+ {-# LINE 1572 "src-ag/ExecutionPlan2Hs.ag" #-}+ prevVisits_+ {-# LINE 1598 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule226 #-}+ {-# LINE 72 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule226 = \ con_ ->+ {-# LINE 72 "src-ag/ExecutionPlan2Hs.ag" #-}+ con_+ {-# LINE 2204 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule227 #-}+ {-# LINE 73 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule227 = \ con_ ->+ {-# LINE 73 "src-ag/ExecutionPlan2Hs.ag" #-}+ con_+ {-# LINE 2210 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule229 #-}+ {-# LINE 189 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule229 = \ constraints_ ->+ {-# LINE 189 "src-ag/ExecutionPlan2Hs.ag" #-}+ ppClasses (classConstrsToDocs constraints_)+ {-# LINE 2224 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule230 #-}+ {-# LINE 190 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule230 = \ params_ ->+ {-# LINE 190 "src-ag/ExecutionPlan2Hs.ag" #-}+ ppQuants params_+ {-# LINE 2230 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule231 #-}+ {-# LINE 288 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule231 = \ (_ :: ()) ->+ {-# LINE 288 "src-ag/ExecutionPlan2Hs.ag" #-}+ 1+ {-# LINE 2236 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule233 #-}+ {-# LINE 534 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule233 = \ _semFunBndDef ->+ {-# LINE 534 "src-ag/ExecutionPlan2Hs.ag" #-}+ Seq.singleton _semFunBndDef+ {-# LINE 2249 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule234 #-}+ {-# LINE 535 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule234 = \ _semFunBndTp ->+ {-# LINE 535 "src-ag/ExecutionPlan2Hs.ag" #-}+ Seq.singleton _semFunBndTp+ {-# LINE 2255 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule235 #-}+ {-# LINE 536 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule235 = \ _semFunBndNm _semname ->+ {-# LINE 536 "src-ag/ExecutionPlan2Hs.ag" #-}+ _semFunBndNm >#< "=" >#< _semname+ {-# LINE 2261 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule238 #-}+ {-# LINE 596 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule238 = \ ((_lhsInt) :: NontermIdent) ->+ {-# LINE 596 "src-ag/ExecutionPlan2Hs.ag" #-}+ "T_" >|< _lhsInt+ {-# LINE 2279 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule239 #-}+ {-# LINE 597 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule239 = \ ((_lhsIparams) :: [Identifier]) ->+ {-# LINE 597 "src-ag/ExecutionPlan2Hs.ag" #-}+ ppSpaced _lhsIparams+ {-# LINE 2285 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule260 #-}+ {-# LINE 1281 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule260 = \ ((_visitsIruleUsage) :: Map Identifier Int) ->+ {-# LINE 1281 "src-ag/ExecutionPlan2Hs.ag" #-}+ _visitsIruleUsage+ {-# LINE 2490 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule263 #-}+ {-# LINE 1326 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule263 = \ ((_childrenIterminaldefs) :: Set String) ->+ {-# LINE 1326 "src-ag/ExecutionPlan2Hs.ag" #-}+ _childrenIterminaldefs+ {-# LINE 2508 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule266 #-}+ {-# LINE 1405 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule266 = \ ((_visitsIlazyIntras) :: Set String) ->+ {-# LINE 1405 "src-ag/ExecutionPlan2Hs.ag" #-}+ _visitsIlazyIntras+ {-# LINE 2526 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule267 #-}+ {-# LINE 1502 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule267 = \ _moduleName ->+ {-# LINE 1502 "src-ag/ExecutionPlan2Hs.ag" #-}+ [pp $ "import " ++ _moduleName ]+ {-# LINE 2532 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule268 #-}+ {-# LINE 1503 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule268 = \ ((_lhsImainName) :: String) _suffix ->+ {-# LINE 1503 "src-ag/ExecutionPlan2Hs.ag" #-}+ _lhsImainName ++ _suffix+ {-# LINE 2538 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule492 #-}+ {-# LINE 95 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule492 = \ wrappers_ ->+ {-# LINE 95 "src-ag/ExecutionPlan2Hs.ag" #-}+ wrappers_+ {-# LINE 3834 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule493 #-}+ {-# LINE 134 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule493 = \ typeSyns_ ->+ {-# LINE 134 "src-ag/ExecutionPlan2Hs.ag" #-}+ typeSyns_+ {-# LINE 3840 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule494 #-}+ {-# LINE 135 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule494 = \ derivings_ ->+ {-# LINE 135 "src-ag/ExecutionPlan2Hs.ag" #-}+ derivings_+ {-# LINE 3846 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule503 #-}+ {-# LINE 1446 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule503 = \ ((_lhsImainFile) :: String) ->+ {-# LINE 1446 "src-ag/ExecutionPlan2Hs.ag" #-}+ _lhsImainFile+ {-# LINE 3915 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule509 #-}+ {-# LINE 1632 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule509 = \ ((_nontsIvisitKinds) :: Map VisitIdentifier VisitKind) ->+ {-# LINE 1632 "src-ag/ExecutionPlan2Hs.ag" #-}+ _nontsIvisitKinds+ {-# LINE 3980 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule510 #-}+ {-# LINE 1646 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule510 = \ ((_nontsIinitStates) :: Map NontermIdent Int) ->+ {-# LINE 1646 "src-ag/ExecutionPlan2Hs.ag" #-}+ _nontsIinitStates+ {-# LINE 3986 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule523 #-}+ {-# LINE 1125 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule523 = \ pos_ ->+ {-# LINE 1125 "src-ag/ExecutionPlan2Hs.ag" #-}+ pos_+ {-# LINE 4081 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule526 #-}+ {-# LINE 1213 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule526 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 1213 "src-ag/ExecutionPlan2Hs.ag" #-}+ Inh_HsToken _lhsIoptions+ {-# LINE 4099 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule528 #-}+ {-# LINE 1416 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule528 = \ pos_ var_ ->+ {-# LINE 1416 "src-ag/ExecutionPlan2Hs.ag" #-}+ (pos_,fieldname var_)+ {-# LINE 4162 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule548 #-}+ {-# LINE 1146 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule548 = \ (_ :: ()) ->+ {-# LINE 1146 "src-ag/ExecutionPlan2Hs.ag" #-}+ False+ {-# LINE 4509 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule563 #-}+ {-# LINE 1147 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule563 = \ (_ :: ()) ->+ {-# LINE 1147 "src-ag/ExecutionPlan2Hs.ag" #-}+ False+ {-# LINE 4598 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule579 #-}+ {-# LINE 1137 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule579 = \ _addbang1 _patExpr ->+ {-# LINE 1137 "src-ag/ExecutionPlan2Hs.ag" #-}+ _addbang1 _patExpr+ {-# LINE 4698 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule580 #-}+ {-# LINE 1148 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule580 = \ (_ :: ()) ->+ {-# LINE 1148 "src-ag/ExecutionPlan2Hs.ag" #-}+ False+ {-# LINE 4704 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule609 #-}+ {-# LINE 1149 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule609 = \ (_ :: ()) ->+ {-# LINE 1149 "src-ag/ExecutionPlan2Hs.ag" #-}+ True+ {-# LINE 4871 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule645 #-}+ {-# LINE 409 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule645 = \ ((_lhsIparams) :: [Identifier]) ->+ {-# LINE 409 "src-ag/ExecutionPlan2Hs.ag" #-}+ ppSpaced _lhsIparams+ {-# LINE 5212 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule653 #-}+ {-# LINE 766 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule653 = \ ident_ ->+ {-# LINE 766 "src-ag/ExecutionPlan2Hs.ag" #-}+ "v" >|< ident_+ {-# LINE 5306 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule658 #-}+ {-# LINE 771 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule658 = \ _nextargsMp ->+ {-# LINE 771 "src-ag/ExecutionPlan2Hs.ag" #-}+ ppSpaced $ Map.keys $ _nextargsMp+ {-# LINE 5336 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule662 #-}+ {-# LINE 789 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule662 = \ kind_ ->+ {-# LINE 789 "src-ag/ExecutionPlan2Hs.ag" #-}+ kind_+ {-# LINE 5362 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule664 #-}+ {-# LINE 889 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule664 = \ (_ :: ()) ->+ {-# LINE 889 "src-ag/ExecutionPlan2Hs.ag" #-}+ 0+ {-# LINE 5377 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule665 #-}+ {-# LINE 896 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule665 = \ (_ :: ()) ->+ {-# LINE 896 "src-ag/ExecutionPlan2Hs.ag" #-}+ 0+ {-# LINE 5383 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule666 #-}+ {-# LINE 912 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule666 = \ (_ :: ()) ->+ {-# LINE 912 "src-ag/ExecutionPlan2Hs.ag" #-}+ False+ {-# LINE 5389 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule703 #-}+ {-# LINE 1282 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule703 = \ name_ ->+ {-# LINE 1282 "src-ag/ExecutionPlan2Hs.ag" #-}+ Map.singleton name_ 1+ {-# LINE 5669 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule765 #-}+ {-# LINE 890 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule765 = \ (_ :: ()) ->+ {-# LINE 890 "src-ag/ExecutionPlan2Hs.ag" #-}+ 0+ {-# LINE 6089 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule766 #-}+ {-# LINE 891 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule766 = \ ((_lhsIindex) :: Int) ->+ {-# LINE 891 "src-ag/ExecutionPlan2Hs.ag" #-}+ _lhsIindex+ {-# LINE 6095 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule808 #-}+ {-# LINE 886 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule808 = \ ((_lhsIindex) :: Int) ->+ {-# LINE 886 "src-ag/ExecutionPlan2Hs.ag" #-}+ _lhsIindex+ {-# LINE 6390 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule809 #-}+ {-# LINE 887 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule809 = \ ((_lhsIindex) :: Int) ->+ {-# LINE 887 "src-ag/ExecutionPlan2Hs.ag" #-}+ 1 + _lhsIindex+ {-# LINE 6396 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule810 #-}+ {-# LINE 888 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule810 = \ ((_tlIindex) :: Int) ->+ {-# LINE 888 "src-ag/ExecutionPlan2Hs.ag" #-}+ _tlIindex+ {-# LINE 6402 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule811 #-}+ {-# LINE 907 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule811 = \ (_ :: ()) ->+ {-# LINE 907 "src-ag/ExecutionPlan2Hs.ag" #-}+ False+ {-# LINE 6408 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule812 #-}+ {-# LINE 908 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule812 = \ ((_tlIisLast) :: Bool) ->+ {-# LINE 908 "src-ag/ExecutionPlan2Hs.ag" #-}+ _tlIisLast+ {-# LINE 6414 "src-generated/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 "src-generated/ExecutionPlan2Hs.hs" #-}+ {-# INLINE rule857 #-}+ {-# LINE 906 "src-ag/ExecutionPlan2Hs.ag" #-}+ rule857 = \ (_ :: ()) ->+ {-# LINE 906 "src-ag/ExecutionPlan2Hs.ag" #-}+ True+ {-# LINE 6593 "src-generated/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
src-generated/Expression.hs view
@@ -1,17 +1,17 @@- - --- UUAGC 0.9.51 (src-ag/Expression.ag) -module Expression where -{-# LINE 2 "src-ag/Expression.ag" #-} +++-- UUAGC 0.9.53 (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]} --} +{-# LINE 10 "src-generated/Expression.hs" #-}+-- Expression --------------------------------------------------+{-+ alternatives:+ alternative Expression:+ child pos : {Pos}+ child tks : {[HsToken]}+-} data Expression = Expression (Pos) (([HsToken]))
src-generated/GenerateCode.hs view
@@ -1,5287 +1,5291 @@-{-# 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 +{-# LANGUAGE Rank2Types, GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module GenerateCode where+{-# LINE 2 "src-ag/DeclBlocks.ag" #-}+ +import Code (Decl,Expr) +{-# LINE 9 "src-generated/GenerateCode.hs" #-}++{-# LINE 2 "src-ag/Patterns.ag" #-}+ +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 16 "src-generated/GenerateCode.hs" #-}++{-# LINE 2 "src-ag/CodeSyntax.ag" #-}+ +import Patterns +import CommonTypes +import Data.Map(Map) +import Data.Set(Set) +{-# LINE 24 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/GenerateCode.hs" #-}++{-# LINE 249 "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 "src-generated/GenerateCode.hs" #-}++{-# LINE 545 "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 "src-generated/GenerateCode.hs" #-}++{-# LINE 642 "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 "src-generated/GenerateCode.hs" #-}++{-# LINE 692 "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 "src-generated/GenerateCode.hs" #-}++{-# LINE 770 "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 "src-generated/GenerateCode.hs" #-}++{-# LINE 896 "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 "src-generated/GenerateCode.hs" #-}++{-# LINE 917 "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 "src-generated/GenerateCode.hs" #-}++{-# LINE 951 "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 "src-generated/GenerateCode.hs" #-}++{-# LINE 1042 "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 "src-generated/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 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule1 #-}+ {-# LINE 53 "src-ag/GenerateCode.ag" #-}+ rule1 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 53 "src-ag/GenerateCode.ag" #-}+ folds _lhsIoptions+ {-# LINE 358 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule2 #-}+ {-# LINE 54 "src-ag/GenerateCode.ag" #-}+ rule2 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 54 "src-ag/GenerateCode.ag" #-}+ semfuns _lhsIoptions+ {-# LINE 364 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule3 #-}+ {-# LINE 55 "src-ag/GenerateCode.ag" #-}+ rule3 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 55 "src-ag/GenerateCode.ag" #-}+ newtypes _lhsIoptions+ {-# LINE 370 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule4 #-}+ {-# LINE 56 "src-ag/GenerateCode.ag" #-}+ rule4 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 56 "src-ag/GenerateCode.ag" #-}+ unbox _lhsIoptions+ {-# LINE 376 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule5 #-}+ {-# LINE 57 "src-ag/GenerateCode.ag" #-}+ rule5 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 57 "src-ag/GenerateCode.ag" #-}+ cases _lhsIoptions+ {-# LINE 382 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule6 #-}+ {-# LINE 58 "src-ag/GenerateCode.ag" #-}+ rule6 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 58 "src-ag/GenerateCode.ag" #-}+ attrInfo _lhsIoptions+ {-# LINE 388 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule7 #-}+ {-# LINE 59 "src-ag/GenerateCode.ag" #-}+ rule7 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 59 "src-ag/GenerateCode.ag" #-}+ rename _lhsIoptions+ {-# LINE 394 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule8 #-}+ {-# LINE 60 "src-ag/GenerateCode.ag" #-}+ rule8 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 60 "src-ag/GenerateCode.ag" #-}+ strictWrap _lhsIoptions+ {-# LINE 400 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule9 #-}+ {-# LINE 61 "src-ag/GenerateCode.ag" #-}+ rule9 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 61 "src-ag/GenerateCode.ag" #-}+ splitSems _lhsIoptions+ {-# LINE 406 "src-generated/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 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule11 #-}+ {-# LINE 63 "src-ag/GenerateCode.ag" #-}+ rule11 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 63 "src-ag/GenerateCode.ag" #-}+ prefix _lhsIoptions+ {-# LINE 418 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule12 #-}+ {-# LINE 64 "src-ag/GenerateCode.ag" #-}+ rule12 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 64 "src-ag/GenerateCode.ag" #-}+ genTraces _lhsIoptions+ {-# LINE 424 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule13 #-}+ {-# LINE 65 "src-ag/GenerateCode.ag" #-}+ rule13 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 65 "src-ag/GenerateCode.ag" #-}+ genCostCentres _lhsIoptions+ {-# LINE 430 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule14 #-}+ {-# LINE 66 "src-ag/GenerateCode.ag" #-}+ rule14 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 66 "src-ag/GenerateCode.ag" #-}+ genLinePragmas _lhsIoptions+ {-# LINE 436 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule15 #-}+ {-# LINE 67 "src-ag/GenerateCode.ag" #-}+ rule15 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 67 "src-ag/GenerateCode.ag" #-}+ monadic _lhsIoptions+ {-# LINE 442 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule16 #-}+ {-# LINE 68 "src-ag/GenerateCode.ag" #-}+ rule16 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 68 "src-ag/GenerateCode.ag" #-}+ clean _lhsIoptions+ {-# LINE 448 "src-generated/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 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule18 #-}+ {-# LINE 76 "src-ag/GenerateCode.ag" #-}+ rule18 = \ pragmas_ ->+ {-# LINE 76 "src-ag/GenerateCode.ag" #-}+ pragmas_+ {-# LINE 460 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule19 #-}+ {-# LINE 98 "src-ag/GenerateCode.ag" #-}+ rule19 = \ paramMap_ ->+ {-# LINE 98 "src-ag/GenerateCode.ag" #-}+ paramMap_+ {-# LINE 466 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule20 #-}+ {-# LINE 120 "src-ag/GenerateCode.ag" #-}+ rule20 = \ contextMap_ ->+ {-# LINE 120 "src-ag/GenerateCode.ag" #-}+ contextMap_+ {-# LINE 472 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule21 #-}+ {-# LINE 121 "src-ag/GenerateCode.ag" #-}+ rule21 = \ quantMap_ ->+ {-# LINE 121 "src-ag/GenerateCode.ag" #-}+ quantMap_+ {-# LINE 478 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule22 #-}+ {-# LINE 137 "src-ag/GenerateCode.ag" #-}+ rule22 = \ ((_nontsIgathNts) :: Set NontermIdent) ->+ {-# LINE 137 "src-ag/GenerateCode.ag" #-}+ _nontsIgathNts+ {-# LINE 484 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule23 #-}+ {-# LINE 591 "src-ag/GenerateCode.ag" #-}+ rule23 = \ aroundsMap_ ->+ {-# LINE 591 "src-ag/GenerateCode.ag" #-}+ aroundsMap_+ {-# LINE 490 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule24 #-}+ {-# LINE 607 "src-ag/GenerateCode.ag" #-}+ rule24 = \ mergeMap_ ->+ {-# LINE 607 "src-ag/GenerateCode.ag" #-}+ mergeMap_+ {-# LINE 496 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule25 #-}+ {-# LINE 764 "src-ag/GenerateCode.ag" #-}+ rule25 = \ ((_lhsIoptions) :: Options) ((_nontsIsemDomUnfoldGath) :: Map (NontermIdent, Int) ([String], Code.Type)) ->+ {-# LINE 764 "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 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule26 #-}+ {-# LINE 865 "src-ag/GenerateCode.ag" #-}+ rule26 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 865 "src-ag/GenerateCode.ag" #-}+ typeSigs _lhsIoptions+ {-# LINE 512 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule27 #-}+ {-# LINE 868 "src-ag/GenerateCode.ag" #-}+ rule27 = \ (_ :: ()) ->+ {-# LINE 868 "src-ag/GenerateCode.ag" #-}+ Seq.empty+ {-# LINE 518 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule28 #-}+ {-# LINE 937 "src-ag/GenerateCode.ag" #-}+ rule28 = \ ((_nontsIchunks) :: Chunks) multivisit_ ->+ {-# LINE 937 "src-ag/GenerateCode.ag" #-}+ Program _nontsIchunks multivisit_+ {-# LINE 524 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule29 #-}+ {-# LINE 1005 "src-ag/GenerateCode.ag" #-}+ rule29 = \ typeSyns_ ->+ {-# LINE 1005 "src-ag/GenerateCode.ag" #-}+ typeSyns_+ {-# LINE 530 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule30 #-}+ {-# LINE 1006 "src-ag/GenerateCode.ag" #-}+ rule30 = \ derivings_ ->+ {-# LINE 1006 "src-ag/GenerateCode.ag" #-}+ derivings_+ {-# LINE 536 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule31 #-}+ {-# LINE 1007 "src-ag/GenerateCode.ag" #-}+ rule31 = \ wrappers_ ->+ {-# LINE 1007 "src-ag/GenerateCode.ag" #-}+ wrappers_+ {-# LINE 542 "src-generated/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 287 "src-ag/GenerateCode.ag" #-}+ rule36 = \ (_ :: ()) ->+ {-# LINE 287 "src-ag/GenerateCode.ag" #-}+ 0+ {-# LINE 634 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule37 #-}+ {-# LINE 721 "src-ag/GenerateCode.ag" #-}+ rule37 = \ ((_segIsemDom) :: [Decl]) ->+ {-# LINE 721 "src-ag/GenerateCode.ag" #-}+ Comment "semantic domain" : _segIsemDom+ {-# LINE 640 "src-generated/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 "src-generated/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 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule65 #-}+ {-# LINE 143 "src-ag/GenerateCode.ag" #-}+ rule65 = \ nt_ ->+ {-# LINE 143 "src-ag/GenerateCode.ag" #-}+ Set.singleton nt_+ {-# LINE 840 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule66 #-}+ {-# LINE 592 "src-ag/GenerateCode.ag" #-}+ rule66 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Set Identifier))) nt_ ->+ {-# LINE 592 "src-ag/GenerateCode.ag" #-}+ Map.findWithDefault Map.empty nt_ _lhsIaroundMap+ {-# LINE 846 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule67 #-}+ {-# LINE 608 "src-ag/GenerateCode.ag" #-}+ rule67 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) nt_ ->+ {-# LINE 608 "src-ag/GenerateCode.ag" #-}+ Map.findWithDefault Map.empty nt_ _lhsImergeMap+ {-# LINE 852 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule68 #-}+ {-# LINE 814 "src-ag/GenerateCode.ag" #-}+ rule68 = \ ((_interIwrapDecls) :: Decls) ((_lhsIo_newtypes) :: Bool) ((_lhsIo_strictwrap) :: Bool) ((_lhsIoptions) :: Options) inh_ nt_ params_ syn_ ->+ {-# LINE 814 "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 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule69 #-}+ {-# LINE 875 "src-ag/GenerateCode.ag" #-}+ rule69 = \ ((_interIcomments) :: [String]) ((_prodsIcomments) :: [String]) ->+ {-# LINE 875 "src-ag/GenerateCode.ag" #-}+ Comment . unlines . map ind $ ( _interIcomments ++ ("alternatives:" : map ind _prodsIcomments) )+ {-# LINE 887 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule70 #-}+ {-# LINE 940 "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 940 "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 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule71 #-}+ {-# LINE 1010 "src-ag/GenerateCode.ag" #-}+ rule71 = \ ((_lhsIderivings) :: Derivings) ((_lhsIo_data) :: Maybe Bool) ((_lhsIoptions) :: Options) ((_lhsItypeSyns) :: TypeSyns) ((_prodsIdataAlts) :: DataAlts) nt_ params_ ->+ {-# LINE 1010 "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 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule72 #-}+ {-# LINE 1054 "src-ag/GenerateCode.ag" #-}+ rule72 = \ ((_lhsIoptions) :: Options) nt_ ->+ {-# LINE 1054 "src-ag/GenerateCode.ag" #-}+ not (nt_ `Set.member` nocatas _lhsIoptions)+ {-# LINE 928 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule73 #-}+ {-# LINE 1055 "src-ag/GenerateCode.ag" #-}+ rule73 = \ ((_lhsIcontextMap) :: ContextMap) ((_lhsIo_sig) :: Bool) ((_lhsIoptions) :: Options) ((_lhsIprefix) :: String) ((_lhsIquantMap) :: QuantMap) ((_lhsItypeSyns) :: TypeSyns) ((_prodsIcataAlts) :: Decls) nt_ params_ ->+ {-# LINE 1055 "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 "src-generated/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 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule189 #-}+ {-# LINE 93 "src-ag/GenerateCode.ag" #-}+ rule189 = \ terminals_ ->+ {-# LINE 93 "src-ag/GenerateCode.ag" #-}+ terminals_+ {-# LINE 1609 "src-generated/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 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule191 #-}+ {-# LINE 147 "src-ag/GenerateCode.ag" #-}+ rule191 = \ (_ :: ()) ->+ {-# LINE 147 "src-ag/GenerateCode.ag" #-}+ Set.empty+ {-# LINE 1621 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule192 #-}+ {-# LINE 283 "src-ag/GenerateCode.ag" #-}+ rule192 = \ (_ :: ()) ->+ {-# LINE 283 "src-ag/GenerateCode.ag" #-}+ 0+ {-# LINE 1627 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule193 #-}+ {-# LINE 418 "src-ag/GenerateCode.ag" #-}+ rule193 = \ children_ ->+ {-# LINE 418 "src-ag/GenerateCode.ag" #-}+ children_+ {-# LINE 1633 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule194 #-}+ {-# LINE 573 "src-ag/GenerateCode.ag" #-}+ rule194 = \ ((_visitsIgatherInstVisitNrs) :: Map Identifier Int) ->+ {-# LINE 573 "src-ag/GenerateCode.ag" #-}+ _visitsIgatherInstVisitNrs+ {-# LINE 1639 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule195 #-}+ {-# LINE 593 "src-ag/GenerateCode.ag" #-}+ rule195 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Set Identifier)) con_ ->+ {-# LINE 593 "src-ag/GenerateCode.ag" #-}+ Map.findWithDefault Set.empty con_ _lhsIaroundMap+ {-# LINE 1645 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule196 #-}+ {-# LINE 609 "src-ag/GenerateCode.ag" #-}+ rule196 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) con_ ->+ {-# LINE 609 "src-ag/GenerateCode.ag" #-}+ Map.findWithDefault Map.empty con_ _lhsImergeMap+ {-# LINE 1651 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule197 #-}+ {-# LINE 890 "src-ag/GenerateCode.ag" #-}+ rule197 = \ children_ ->+ {-# LINE 890 "src-ag/GenerateCode.ag" #-}+ [ (nm,fromJust mb,virt) | (nm,tp,virt) <- children_, let mb = isFirstOrder virt tp, isJust mb ]+ {-# LINE 1657 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule198 #-}+ {-# LINE 891 "src-ag/GenerateCode.ag" #-}+ rule198 = \ _firstOrderChildren ((_visitsIcomments) :: [String]) con_ ->+ {-# LINE 891 "src-ag/GenerateCode.ag" #-}+ ("alternative " ++ getName con_ ++ ":")+ : map ind ( map (\(x,y,_) -> makeLocalComment 14 "child" x (Just y)) _firstOrderChildren+ ++ _visitsIcomments+ )+ {-# LINE 1666 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule199 #-}+ {-# LINE 1034 "src-ag/GenerateCode.ag" #-}+ rule199 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) ->+ {-# LINE 1034 "src-ag/GenerateCode.ag" #-}+ map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap+ {-# LINE 1672 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule200 #-}+ {-# LINE 1035 "src-ag/GenerateCode.ag" #-}+ rule200 = \ _firstOrderChildren ((_lhsInt) :: NontermIdent) ((_lhsIo_rename) :: Bool) ((_lhsIoptions) :: Options) _params con_ ->+ {-# LINE 1035 "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 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule201 #-}+ {-# LINE 1165 "src-ag/GenerateCode.ag" #-}+ rule201 = \ _firstOrderChildren ((_lhsInt) :: NontermIdent) ((_lhsIo_rename) :: Bool) ((_lhsIoptions) :: Options) ((_lhsIprefix) :: String) con_ ->+ {-# LINE 1165 "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 "src-generated/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 1030 "src-ag/GenerateCode.ag" #-}+ rule236 = \ ((_hdIdataAlt) :: DataAlt) ((_tlIdataAlts) :: DataAlts) ->+ {-# LINE 1030 "src-ag/GenerateCode.ag" #-}+ _hdIdataAlt : _tlIdataAlts+ {-# LINE 1922 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule237 #-}+ {-# LINE 1161 "src-ag/GenerateCode.ag" #-}+ rule237 = \ ((_hdIcataAlt) :: Decl) ((_tlIcataAlts) :: Decls) ->+ {-# LINE 1161 "src-ag/GenerateCode.ag" #-}+ _hdIcataAlt : _tlIcataAlts+ {-# LINE 1928 "src-generated/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 1031 "src-ag/GenerateCode.ag" #-}+ rule303 = \ (_ :: ()) ->+ {-# LINE 1031 "src-ag/GenerateCode.ag" #-}+ []+ {-# LINE 2149 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule304 #-}+ {-# LINE 1162 "src-ag/GenerateCode.ag" #-}+ rule304 = \ (_ :: ()) ->+ {-# LINE 1162 "src-ag/GenerateCode.ag" #-}+ []+ {-# LINE 2155 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule318 #-}+ {-# LINE 269 "src-ag/GenerateCode.ag" #-}+ rule318 = \ ((_patternIdefinedInsts) :: [Identifier]) isIn_ ->+ {-# LINE 269 "src-ag/GenerateCode.ag" #-}+ if isIn_ then [] else _patternIdefinedInsts+ {-# LINE 2345 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule319 #-}+ {-# LINE 339 "src-ag/GenerateCode.ag" #-}+ rule319 = \ ((_lhsIoptions) :: Options) ((_lhsIterminals) :: [Identifier]) field_ isIn_ name_ ->+ {-# LINE 339 "src-ag/GenerateCode.ag" #-}+ if field_ == _LOC && name_ `elem` _lhsIterminals+ then funname name_ 0+ else attrname _lhsIoptions isIn_ field_ name_+ {-# LINE 2353 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule320 #-}+ {-# LINE 342 "src-ag/GenerateCode.ag" #-}+ rule320 = \ _rulename ->+ {-# LINE 342 "src-ag/GenerateCode.ag" #-}+ [SimpleExpr _rulename ]+ {-# LINE 2359 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule321 #-}+ {-# LINE 358 "src-ag/GenerateCode.ag" #-}+ rule321 = \ _rulename ->+ {-# LINE 358 "src-ag/GenerateCode.ag" #-}+ Set.singleton _rulename+ {-# LINE 2365 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule322 #-}+ {-# LINE 368 "src-ag/GenerateCode.ag" #-}+ rule322 = \ ((_lhsInt) :: NontermIdent) _orgParams ->+ {-# LINE 368 "src-ag/GenerateCode.ag" #-}+ typeToCodeType (Just _lhsInt) _orgParams+ {-# LINE 2371 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule323 #-}+ {-# LINE 369 "src-ag/GenerateCode.ag" #-}+ rule323 = \ _evalTp ((_lhsIchildren) :: [(Identifier,Type,ChildKind)]) ((_lhsIoptions) :: Options) _mkTp defines_ ->+ {-# LINE 369 "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 tp'' = case tp' of+ NT n params b -> NT (Ident ("T_" ++ show n) (getPos n)) params b+ _ -> tp'+ 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 2393 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule324 #-}+ {-# LINE 387 "src-ag/GenerateCode.ag" #-}+ rule324 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) ->+ {-# LINE 387 "src-ag/GenerateCode.ag" #-}+ map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap+ {-# LINE 2399 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule325 #-}+ {-# LINE 389 "src-ag/GenerateCode.ag" #-}+ rule325 = \ ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) ((_lhsIparamInstMap) :: Map Identifier (NontermIdent, [String])) ((_lhsIparamMap) :: ParamMap) _orgParams ->+ {-# LINE 389 "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 2413 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule326 #-}+ {-# LINE 424 "src-ag/GenerateCode.ag" #-}+ rule326 = \ tp_ ->+ {-# LINE 424 "src-ag/GenerateCode.ag" #-}+ maybe ([],False) (\tp -> ([tp],True)) tp_+ {-# LINE 2419 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule327 #-}+ {-# LINE 625 "src-ag/GenerateCode.ag" #-}+ rule327 = \ _decls ((_lhsIdeclsAbove) :: [Decl]) ->+ {-# LINE 625 "src-ag/GenerateCode.ag" #-}+ _lhsIdeclsAbove ++ _decls+ {-# LINE 2425 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule328 #-}+ {-# LINE 638 "src-ag/GenerateCode.ag" #-}+ rule328 = \ (_ :: ()) ->+ {-# LINE 638 "src-ag/GenerateCode.ag" #-}+ id+ {-# LINE 2431 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule329 #-}+ {-# LINE 914 "src-ag/GenerateCode.ag" #-}+ rule329 = \ ((_lhsIwhat) :: String) defines_ ->+ {-# LINE 914 "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 2438 "src-generated/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 2499 "src-generated/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 2505 "src-generated/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 2513 "src-generated/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+ ChildReplace _ -> 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 2557 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule337 #-}+ {-# LINE 331 "src-ag/GenerateCode.ag" #-}+ rule337 = \ ((_lhsIinstVisitNrs) :: Map Identifier Int) ((_lhsInr) :: Int) name_ ->+ {-# LINE 331 "src-ag/GenerateCode.ag" #-}+ _lhsInr <= Map.findWithDefault (-1) name_ _lhsIinstVisitNrs+ {-# LINE 2563 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule338 #-}+ {-# LINE 344 "src-ag/GenerateCode.ag" #-}+ rule338 = \ _isSuperfluousHigherOrderIntra name_ nr_ ->+ {-# LINE 344 "src-ag/GenerateCode.ag" #-}+ if _isSuperfluousHigherOrderIntra+ then []+ else [funname name_ (nr_+1)]+ {-# LINE 2571 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule339 #-}+ {-# LINE 348 "src-ag/GenerateCode.ag" #-}+ rule339 = \ _instParams ((_lhsIo_newtypes) :: Bool) ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) _names nr_ nt_ ->+ {-# LINE 348 "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 2580 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule340 #-}+ {-# LINE 360 "src-ag/GenerateCode.ag" #-}+ rule340 = \ _names ->+ {-# LINE 360 "src-ag/GenerateCode.ag" #-}+ Set.fromList _names+ {-# LINE 2586 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule341 #-}+ {-# LINE 399 "src-ag/GenerateCode.ag" #-}+ rule341 = \ _evalTp _orgParams nt_ ->+ {-# LINE 399 "src-ag/GenerateCode.ag" #-}+ _evalTp . typeToCodeType (Just nt_) _orgParams+ {-# LINE 2592 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule342 #-}+ {-# LINE 400 "src-ag/GenerateCode.ag" #-}+ rule342 = \ ((_lhsIoptions) :: Options) _mkTp name_ syn_ ->+ {-# LINE 400 "src-ag/GenerateCode.ag" #-}+ [ TSig (attrname _lhsIoptions True name_ a) (_mkTp tp) | (a,tp) <- Map.toList syn_ ]+ {-# LINE 2598 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule343 #-}+ {-# LINE 401 "src-ag/GenerateCode.ag" #-}+ rule343 = \ nr_ nt_ ->+ {-# LINE 401 "src-ag/GenerateCode.ag" #-}+ typeName nt_ (nr_+1)+ {-# LINE 2604 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule344 #-}+ {-# LINE 402 "src-ag/GenerateCode.ag" #-}+ rule344 = \ _definedTps _instParams _nextTp isLast_ name_ nr_ ->+ {-# LINE 402 "src-ag/GenerateCode.ag" #-}+ (if isLast_ then id else (TSig (funname name_ (nr_+1)) (TypeApp (SimpleType _nextTp) (map SimpleType _instParams )) :)) _definedTps+ {-# LINE 2610 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule345 #-}+ {-# LINE 404 "src-ag/GenerateCode.ag" #-}+ rule345 = \ ((_lhsIparamMap) :: ParamMap) nt_ ->+ {-# LINE 404 "src-ag/GenerateCode.ag" #-}+ map getName $ Map.findWithDefault [] nt_ _lhsIparamMap+ {-# LINE 2616 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule346 #-}+ {-# LINE 405 "src-ag/GenerateCode.ag" #-}+ rule346 = \ ((_lhsIparamInstMap) :: Map Identifier (NontermIdent, [String])) name_ nt_ ->+ {-# LINE 405 "src-ag/GenerateCode.ag" #-}+ snd $ Map.findWithDefault (nt_,[]) name_ _lhsIparamInstMap+ {-# LINE 2622 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule347 #-}+ {-# LINE 406 "src-ag/GenerateCode.ag" #-}+ rule347 = \ _instParams _orgParams ->+ {-# LINE 406 "src-ag/GenerateCode.ag" #-}+ Map.fromList (zip _orgParams _instParams )+ {-# LINE 2628 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule348 #-}+ {-# LINE 407 "src-ag/GenerateCode.ag" #-}+ rule348 = \ _replParamMap ->+ {-# LINE 407 "src-ag/GenerateCode.ag" #-}+ \k -> Map.findWithDefault k k _replParamMap+ {-# LINE 2634 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule349 #-}+ {-# LINE 408 "src-ag/GenerateCode.ag" #-}+ rule349 = \ ((_lhsIoptions) :: Options) _orgParams _replace ->+ {-# LINE 408 "src-ag/GenerateCode.ag" #-}+ if null _orgParams then id else evalType _lhsIoptions _replace+ {-# LINE 2640 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule350 #-}+ {-# LINE 425 "src-ag/GenerateCode.ag" #-}+ rule350 = \ _instParams _isSuperfluousHigherOrderIntra nr_ nt_ ->+ {-# LINE 425 "src-ag/GenerateCode.ag" #-}+ if _isSuperfluousHigherOrderIntra+ then []+ else [NT (ntOfVisit nt_ (nr_+1)) _instParams False]+ {-# LINE 2648 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule351 #-}+ {-# LINE 627 "src-ag/GenerateCode.ag" #-}+ rule351 = \ (_ :: ()) ->+ {-# LINE 627 "src-ag/GenerateCode.ag" #-}+ []+ {-# LINE 2654 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule352 #-}+ {-# LINE 640 "src-ag/GenerateCode.ag" #-}+ rule352 = \ _decls ((_lhsIdeclsAbove) :: [Decl]) ->+ {-# LINE 640 "src-ag/GenerateCode.ag" #-}+ DeclBlock _lhsIdeclsAbove (head _decls )+ {-# LINE 2660 "src-generated/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 724 "src-ag/GenerateCode.ag" #-}+ rule358 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 724 "src-ag/GenerateCode.ag" #-}+ breadthFirst _lhsIoptions+ {-# LINE 2745 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule359 #-}+ {-# LINE 725 "src-ag/GenerateCode.ag" #-}+ rule359 = \ _altSemForm _indexExpr _inhTps _synTps ->+ {-# LINE 725 "src-ag/GenerateCode.ag" #-}+ if _altSemForm+ then TypeApp (SimpleType "Child") [SimpleType "EvalInfo", _indexExpr ]+ else foldr Arr _synTps _inhTps+ {-# LINE 2753 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule360 #-}+ {-# LINE 728 "src-ag/GenerateCode.ag" #-}+ rule360 = \ ((_lhsInt) :: NontermIdent) _params inh_ ->+ {-# LINE 728 "src-ag/GenerateCode.ag" #-}+ [typeToCodeType (Just _lhsInt) _params tp | tp <- Map.elems inh_]+ {-# LINE 2759 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule361 #-}+ {-# LINE 729 "src-ag/GenerateCode.ag" #-}+ rule361 = \ _inhTps ((_lhsIo_unbox) :: Bool) ->+ {-# LINE 729 "src-ag/GenerateCode.ag" #-}+ mkTupleType _lhsIo_unbox (null _inhTps ) _inhTps+ {-# LINE 2765 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule362 #-}+ {-# LINE 730 "src-ag/GenerateCode.ag" #-}+ rule362 = \ _continuation _inhTps ((_lhsInt) :: NontermIdent) ((_lhsIo_unbox) :: Bool) _params syn_ ->+ {-# LINE 730 "src-ag/GenerateCode.ag" #-}+ mkTupleType _lhsIo_unbox (null _inhTps ) ([typeToCodeType (Just _lhsInt) _params tp | tp <- Map.elems syn_] ++ _continuation )+ {-# LINE 2771 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule363 #-}+ {-# LINE 731 "src-ag/GenerateCode.ag" #-}+ rule363 = \ ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ->+ {-# LINE 731 "src-ag/GenerateCode.ag" #-}+ typeName _lhsInt _lhsInr+ {-# LINE 2777 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule364 #-}+ {-# LINE 732 "src-ag/GenerateCode.ag" #-}+ rule364 = \ ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ->+ {-# LINE 732 "src-ag/GenerateCode.ag" #-}+ typeName _lhsInt (_lhsInr + 1)+ {-# LINE 2783 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule365 #-}+ {-# LINE 733 "src-ag/GenerateCode.ag" #-}+ rule365 = \ _curTypeName ->+ {-# LINE 733 "src-ag/GenerateCode.ag" #-}+ "I_" ++ _curTypeName+ {-# LINE 2789 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule366 #-}+ {-# LINE 734 "src-ag/GenerateCode.ag" #-}+ rule366 = \ _indexName _params ->+ {-# LINE 734 "src-ag/GenerateCode.ag" #-}+ Code.Data _indexName _params [DataAlt _indexName []] False []+ {-# LINE 2795 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule367 #-}+ {-# LINE 735 "src-ag/GenerateCode.ag" #-}+ rule367 = \ _indexName _params ->+ {-# LINE 735 "src-ag/GenerateCode.ag" #-}+ TypeApp (SimpleType _indexName ) (map (SimpleType . ('@':)) _params )+ {-# LINE 2801 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule368 #-}+ {-# LINE 736 "src-ag/GenerateCode.ag" #-}+ rule368 = \ _indexName _params ->+ {-# LINE 736 "src-ag/GenerateCode.ag" #-}+ "(" ++ _indexName ++ concatMap (\p -> " " ++ p) _params ++ ")"+ {-# LINE 2807 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule369 #-}+ {-# LINE 737 "src-ag/GenerateCode.ag" #-}+ rule369 = \ _indexStr _inhTup ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ->+ {-# LINE 737 "src-ag/GenerateCode.ag" #-}+ Code.Data "instance Inh" [_indexStr ] [DataAlt (typeName _lhsInt _lhsInr ++ "_Inh") [_inhTup ] ] False []+ {-# LINE 2813 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule370 #-}+ {-# LINE 738 "src-ag/GenerateCode.ag" #-}+ rule370 = \ _indexStr ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) _synTps ->+ {-# LINE 738 "src-ag/GenerateCode.ag" #-}+ Code.Data "instance Syn" [_indexStr ] [DataAlt (typeName _lhsInt _lhsInr ++ "_Syn") [_synTps ] ] False []+ {-# LINE 2819 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule371 #-}+ {-# LINE 739 "src-ag/GenerateCode.ag" #-}+ rule371 = \ ((_lhsIisLast) :: Bool) _nextTypeName _params ->+ {-# LINE 739 "src-ag/GenerateCode.ag" #-}+ if _lhsIisLast+ then []+ else [TypeApp (SimpleType _nextTypeName ) (map (SimpleType . ('@':)) _params )]+ {-# LINE 2827 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule372 #-}+ {-# LINE 742 "src-ag/GenerateCode.ag" #-}+ rule372 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) ->+ {-# LINE 742 "src-ag/GenerateCode.ag" #-}+ map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap+ {-# LINE 2833 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule373 #-}+ {-# LINE 743 "src-ag/GenerateCode.ag" #-}+ rule373 = \ _altSemForm _dataIndex _inhInstance ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIo_newtypes) :: Bool) ((_lhsIoptions) :: Options) _params _synInstance _tp ->+ {-# LINE 743 "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 2847 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule374 #-}+ {-# LINE 757 "src-ag/GenerateCode.ag" #-}+ rule374 = \ ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) _params _tp ->+ {-# LINE 757 "src-ag/GenerateCode.ag" #-}+ Map.singleton (_lhsInt, _lhsInr) (_params , _tp )+ {-# LINE 2853 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule375 #-}+ {-# LINE 842 "src-ag/GenerateCode.ag" #-}+ rule375 = \ ((_lhsIisLast) :: Bool) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIo_newtypes) :: Bool) ((_lhsIo_unbox) :: Bool) ((_lhsIoptions) :: Options) inh_ syn_ ->+ {-# LINE 842 "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 2868 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule376 #-}+ {-# LINE 884 "src-ag/GenerateCode.ag" #-}+ rule376 = \ ((_lhsInr) :: Int) inh_ syn_ ->+ {-# LINE 884 "src-ag/GenerateCode.ag" #-}+ let body = map ind (showsSegment (CSegment inh_ syn_))+ in if null body+ then []+ else ("visit " ++ show _lhsInr ++ ":") : body+ {-# LINE 2877 "src-generated/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 289 "src-ag/GenerateCode.ag" #-}+ rule377 = \ ((_lhsInr) :: Int) ->+ {-# LINE 289 "src-ag/GenerateCode.ag" #-}+ _lhsInr + 1+ {-# LINE 2985 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule378 #-}+ {-# LINE 302 "src-ag/GenerateCode.ag" #-}+ rule378 = \ (_ :: ()) ->+ {-# LINE 302 "src-ag/GenerateCode.ag" #-}+ False+ {-# LINE 2991 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule379 #-}+ {-# LINE 303 "src-ag/GenerateCode.ag" #-}+ rule379 = \ ((_tlIisNil) :: Bool) ->+ {-# LINE 303 "src-ag/GenerateCode.ag" #-}+ _tlIisNil+ {-# LINE 2997 "src-generated/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 304 "src-ag/GenerateCode.ag" #-}+ rule429 = \ (_ :: ()) ->+ {-# LINE 304 "src-ag/GenerateCode.ag" #-}+ True+ {-# LINE 3170 "src-generated/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 313 "src-ag/GenerateCode.ag" #-}+ rule434 = \ ((_intraIexprs) :: Exprs) ->+ {-# LINE 313 "src-ag/GenerateCode.ag" #-}+ _intraIexprs+ {-# LINE 3341 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule435 #-}+ {-# LINE 314 "src-ag/GenerateCode.ag" #-}+ rule435 = \ ((_intraIusedVars) :: Set String) ->+ {-# LINE 314 "src-ag/GenerateCode.ag" #-}+ _intraIusedVars+ {-# LINE 3347 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule436 #-}+ {-# LINE 447 "src-ag/GenerateCode.ag" #-}+ rule436 = \ ((_lhsIchildren) :: [(Identifier,Type, ChildKind)]) ->+ {-# LINE 447 "src-ag/GenerateCode.ag" #-}+ partition (\(_,_,virt) -> isHigherOrder virt) _lhsIchildren+ {-# LINE 3353 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule437 #-}+ {-# LINE 448 "src-ag/GenerateCode.ag" #-}+ rule437 = \ _firstOrderChildren ->+ {-# LINE 448 "src-ag/GenerateCode.ag" #-}+ map pickOrigType _firstOrderChildren+ {-# LINE 3359 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule438 #-}+ {-# LINE 449 "src-ag/GenerateCode.ag" #-}+ rule438 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIprefix) :: String) ->+ {-# LINE 449 "src-ag/GenerateCode.ag" #-}+ seqSemname _lhsIprefix _lhsInt _lhsIcon _lhsInr+ {-# LINE 3365 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule439 #-}+ {-# LINE 450 "src-ag/GenerateCode.ag" #-}+ rule439 = \ ((_lhsIisLast) :: Bool) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIprefix) :: String) ->+ {-# LINE 450 "src-ag/GenerateCode.ag" #-}+ if _lhsIisLast then [] else [visitname _lhsIprefix _lhsInt (_lhsInr+1)]+ {-# LINE 3371 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule440 #-}+ {-# LINE 451 "src-ag/GenerateCode.ag" #-}+ rule440 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsIdecls) :: Decls) ((_lhsIisLast) :: Bool) ((_lhsInextIntraVars) :: Set String) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIprefix) :: String) _nextVisitName ->+ {-# LINE 451 "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 3382 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule441 #-}+ {-# LINE 458 "src-ag/GenerateCode.ag" #-}+ rule441 = \ ((_lhsIisLast) :: Bool) ((_lhsInr) :: Int) ->+ {-# LINE 458 "src-ag/GenerateCode.ag" #-}+ _lhsIisLast && _lhsInr == 0+ {-# LINE 3388 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule442 #-}+ {-# LINE 459 "src-ag/GenerateCode.ag" #-}+ rule442 = \ ((_lhsInt) :: NontermIdent) ((_lhsIwrappers) :: Set NontermIdent) ->+ {-# LINE 459 "src-ag/GenerateCode.ag" #-}+ _lhsInt `Set.member` _lhsIwrappers+ {-# LINE 3394 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule443 #-}+ {-# LINE 460 "src-ag/GenerateCode.ag" #-}+ rule443 = \ _hasWrappers _isOneVisit ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) syn_ ->+ {-# LINE 460 "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 3407 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule444 #-}+ {-# LINE 468 "src-ag/GenerateCode.ag" #-}+ rule444 = \ ((_lhsIo_clean) :: Bool) _nextVisitDecl _refDecls _typeSigs ((_vssIdecls) :: Decls) ->+ {-# LINE 468 "src-ag/GenerateCode.ag" #-}+ if _lhsIo_clean+ then _vssIdecls ++ _nextVisitDecl ++ _refDecls+ else _typeSigs ++ _vssIdecls ++ _nextVisitDecl ++ _refDecls+ {-# LINE 3415 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule445 #-}+ {-# LINE 471 "src-ag/GenerateCode.ag" #-}+ rule445 = \ ((_lhsIo_unbox) :: Bool) ((_lhsIoptions) :: Options) _nextVisitName inh_ syn_ ->+ {-# LINE 471 "src-ag/GenerateCode.ag" #-}+ mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_) $ map (SimpleExpr . lhsname _lhsIoptions False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName+ {-# LINE 3421 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule446 #-}+ {-# LINE 472 "src-ag/GenerateCode.ag" #-}+ rule446 = \ (_ :: ()) ->+ {-# LINE 472 "src-ag/GenerateCode.ag" #-}+ error "lastExpr: not used here"+ {-# LINE 3427 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule447 #-}+ {-# LINE 473 "src-ag/GenerateCode.ag" #-}+ rule447 = \ ((_lhsIoptions) :: Options) _nextVisitName syn_ ->+ {-# LINE 473 "src-ag/GenerateCode.ag" #-}+ map (lhsname _lhsIoptions False) (Map.keys syn_) ++ _nextVisitName+ {-# LINE 3433 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule448 #-}+ {-# LINE 474 "src-ag/GenerateCode.ag" #-}+ rule448 = \ _funcname _lastExprVars _nextVisitDecl _o_case ((_vssIblockDecls) :: DeclBlocks) ->+ {-# LINE 474 "src-ag/GenerateCode.ag" #-}+ mkPartitionedFunction _funcname _o_case _nextVisitDecl _lastExprVars _vssIblockDecls+ {-# LINE 3439 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule449 #-}+ {-# LINE 476 "src-ag/GenerateCode.ag" #-}+ rule449 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ->+ {-# LINE 476 "src-ag/GenerateCode.ag" #-}+ "b" ++ ":" ++ show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show _lhsInr+ {-# LINE 3445 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule450 #-}+ {-# LINE 477 "src-ag/GenerateCode.ag" #-}+ rule450 = \ _costCentreDescr ((_lhsIo_costcentre) :: Bool) ->+ {-# LINE 477 "src-ag/GenerateCode.ag" #-}+ \v -> if _lhsIo_costcentre+ then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v+ else v+ {-# LINE 3453 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule451 #-}+ {-# LINE 481 "src-ag/GenerateCode.ag" #-}+ rule451 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) ->+ {-# LINE 481 "src-ag/GenerateCode.ag" #-}+ map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap+ {-# LINE 3459 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule452 #-}+ {-# LINE 482 "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 482 "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 3490 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule453 #-}+ {-# LINE 513 "src-ag/GenerateCode.ag" #-}+ rule453 = \ _funcname _semType ->+ {-# LINE 513 "src-ag/GenerateCode.ag" #-}+ TSig _funcname _semType+ {-# LINE 3496 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule454 #-}+ {-# LINE 514 "src-ag/GenerateCode.ag" #-}+ rule454 = \ _firstOrderOrig ((_lhsIcontextMap) :: ContextMap) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) ((_lhsIquantMap) :: QuantMap) _params ->+ {-# LINE 514 "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 3511 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule455 #-}+ {-# LINE 525 "src-ag/GenerateCode.ag" #-}+ rule455 = \ _blockFunDecls ((_lhsIwith_sig) :: Bool) _o_splitsems _semFun _tsig ordered_ ->+ {-# LINE 525 "src-ag/GenerateCode.ag" #-}+ ( if _lhsIwith_sig+ then [_tsig, _semFun]+ else [_semFun]+ ) +++ ( if ordered_ && _o_splitsems+ then _blockFunDecls+ else []+ )+ {-# LINE 3524 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule456 #-}+ {-# LINE 533 "src-ag/GenerateCode.ag" #-}+ rule456 = \ ((_lhsIo_sig) :: Bool) _o_case ((_vssItSigs) :: [Decl]) ->+ {-# LINE 533 "src-ag/GenerateCode.ag" #-}+ if _lhsIo_sig && not _o_case+ then _vssItSigs+ else []+ {-# LINE 3532 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule457 #-}+ {-# LINE 536 "src-ag/GenerateCode.ag" #-}+ rule457 = \ ((_lhsIo_monadic) :: Bool) ordered_ ->+ {-# LINE 536 "src-ag/GenerateCode.ag" #-}+ ordered_ && _lhsIo_monadic+ {-# LINE 3538 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule458 #-}+ {-# LINE 537 "src-ag/GenerateCode.ag" #-}+ rule458 = \ ((_lhsIallPragmas) :: PragmaMap) ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) ((_lhsIo_case) :: Bool) _o_do ordered_ ->+ {-# LINE 537 "src-ag/GenerateCode.ag" #-}+ not _o_do && _lhsIo_case && ordered_ && not (hasPragma _lhsIallPragmas _lhsInt _lhsIcon _NOCASE)+ {-# LINE 3544 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule459 #-}+ {-# LINE 538 "src-ag/GenerateCode.ag" #-}+ rule459 = \ _o_case _o_do ->+ {-# LINE 538 "src-ag/GenerateCode.ag" #-}+ if _o_do+ then DeclsDo+ else if _o_case+ then DeclsCase+ else DeclsLet+ {-# LINE 3554 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule460 #-}+ {-# LINE 543 "src-ag/GenerateCode.ag" #-}+ rule460 = \ ((_lhsIo_splitsems) :: Bool) ordered_ ->+ {-# LINE 543 "src-ag/GenerateCode.ag" #-}+ ordered_ && _lhsIo_splitsems+ {-# LINE 3560 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule461 #-}+ {-# LINE 577 "src-ag/GenerateCode.ag" #-}+ rule461 = \ ((_lhsInr) :: Int) ((_vssIdefinedInsts) :: [Identifier]) ->+ {-# LINE 577 "src-ag/GenerateCode.ag" #-}+ Map.fromList [(i,_lhsInr) | i <- _vssIdefinedInsts]+ {-# LINE 3566 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule462 #-}+ {-# LINE 620 "src-ag/GenerateCode.ag" #-}+ rule462 = \ (_ :: ()) ->+ {-# LINE 620 "src-ag/GenerateCode.ag" #-}+ []+ {-# LINE 3572 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule463 #-}+ {-# LINE 621 "src-ag/GenerateCode.ag" #-}+ rule463 = \ (_ :: ()) ->+ {-# LINE 621 "src-ag/GenerateCode.ag" #-}+ error "declsAbove: not used here"+ {-# LINE 3578 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule464 #-}+ {-# LINE 905 "src-ag/GenerateCode.ag" #-}+ rule464 = \ ((_intraIcomments) :: [String]) ((_lhsInr) :: Int) ((_vssIcomments) :: [String]) ->+ {-# LINE 905 "src-ag/GenerateCode.ag" #-}+ let body = map ind (_vssIcomments ++ _intraIcomments)+ in if null body+ then []+ else ("visit " ++ show _lhsInr ++ ":") : body+ {-# LINE 3587 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule465 #-}+ {-# LINE 909 "src-ag/GenerateCode.ag" #-}+ rule465 = \ (_ :: ()) ->+ {-# LINE 909 "src-ag/GenerateCode.ag" #-}+ "local"+ {-# LINE 3593 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule466 #-}+ {-# LINE 910 "src-ag/GenerateCode.ag" #-}+ rule466 = \ (_ :: ()) ->+ {-# LINE 910 "src-ag/GenerateCode.ag" #-}+ "intra"+ {-# LINE 3599 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule467 #-}+ {-# LINE 1190 "src-ag/GenerateCode.ag" #-}+ rule467 = \ _funcname ->+ {-# LINE 1190 "src-ag/GenerateCode.ag" #-}+ [_funcname ]+ {-# LINE 3605 "src-generated/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 285 "src-ag/GenerateCode.ag" #-}+ rule535 = \ ((_lhsInr) :: Int) ->+ {-# LINE 285 "src-ag/GenerateCode.ag" #-}+ _lhsInr + 1+ {-# LINE 3953 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule536 #-}+ {-# LINE 298 "src-ag/GenerateCode.ag" #-}+ rule536 = \ (_ :: ()) ->+ {-# LINE 298 "src-ag/GenerateCode.ag" #-}+ False+ {-# LINE 3959 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule537 #-}+ {-# LINE 299 "src-ag/GenerateCode.ag" #-}+ rule537 = \ ((_tlIisNil) :: Bool) ->+ {-# LINE 299 "src-ag/GenerateCode.ag" #-}+ _tlIisNil+ {-# LINE 3965 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule538 #-}+ {-# LINE 316 "src-ag/GenerateCode.ag" #-}+ rule538 = \ ((_tlIintra) :: Exprs) ->+ {-# LINE 316 "src-ag/GenerateCode.ag" #-}+ _tlIintra+ {-# LINE 3971 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule539 #-}+ {-# LINE 317 "src-ag/GenerateCode.ag" #-}+ rule539 = \ ((_tlIintraVars) :: Set String) ->+ {-# LINE 317 "src-ag/GenerateCode.ag" #-}+ _tlIintraVars+ {-# LINE 3977 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule540 #-}+ {-# LINE 318 "src-ag/GenerateCode.ag" #-}+ rule540 = \ ((_hdIintra) :: Exprs) ->+ {-# LINE 318 "src-ag/GenerateCode.ag" #-}+ _hdIintra+ {-# LINE 3983 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule541 #-}+ {-# LINE 319 "src-ag/GenerateCode.ag" #-}+ rule541 = \ ((_hdIintraVars) :: Set String) ->+ {-# LINE 319 "src-ag/GenerateCode.ag" #-}+ _hdIintraVars+ {-# LINE 3989 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule542 #-}+ {-# LINE 437 "src-ag/GenerateCode.ag" #-}+ rule542 = \ ((_hdIdecls) :: Decls) ->+ {-# LINE 437 "src-ag/GenerateCode.ag" #-}+ _hdIdecls+ {-# LINE 3995 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule543 #-}+ {-# LINE 438 "src-ag/GenerateCode.ag" #-}+ rule543 = \ ((_tlIdecls) :: Decls) ->+ {-# LINE 438 "src-ag/GenerateCode.ag" #-}+ _tlIdecls+ {-# LINE 4001 "src-generated/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 300 "src-ag/GenerateCode.ag" #-}+ rule623 = \ (_ :: ()) ->+ {-# LINE 300 "src-ag/GenerateCode.ag" #-}+ True+ {-# LINE 4270 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule624 #-}+ {-# LINE 320 "src-ag/GenerateCode.ag" #-}+ rule624 = \ (_ :: ()) ->+ {-# LINE 320 "src-ag/GenerateCode.ag" #-}+ []+ {-# LINE 4276 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule625 #-}+ {-# LINE 321 "src-ag/GenerateCode.ag" #-}+ rule625 = \ (_ :: ()) ->+ {-# LINE 321 "src-ag/GenerateCode.ag" #-}+ Set.empty+ {-# LINE 4282 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule626 #-}+ {-# LINE 436 "src-ag/GenerateCode.ag" #-}+ rule626 = \ (_ :: ()) ->+ {-# LINE 436 "src-ag/GenerateCode.ag" #-}+ []+ {-# LINE 4288 "src-generated/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 671 "src-ag/GenerateCode.ag" #-}+ rule631 = \ ((_lhsIblockNr) :: Int) ->+ {-# LINE 671 "src-ag/GenerateCode.ag" #-}+ _lhsIblockNr + 1+ {-# LINE 4365 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule632 #-}+ {-# LINE 676 "src-ag/GenerateCode.ag" #-}+ rule632 = \ ((_lhsIblockNr) :: Int) ((_lhsIprefix) :: String) ->+ {-# LINE 676 "src-ag/GenerateCode.ag" #-}+ _lhsIprefix ++ "_block" ++ show _lhsIblockNr+ {-# LINE 4371 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule633 #-}+ {-# LINE 677 "src-ag/GenerateCode.ag" #-}+ rule633 = \ _lambdaName ->+ {-# LINE 677 "src-ag/GenerateCode.ag" #-}+ PragmaDecl ("NOINLINE " ++ _lambdaName )+ {-# LINE 4377 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule634 #-}+ {-# LINE 678 "src-ag/GenerateCode.ag" #-}+ rule634 = \ _freeVars _lambdaName ->+ {-# LINE 678 "src-ag/GenerateCode.ag" #-}+ App _lambdaName (map SimpleExpr _freeVars )+ {-# LINE 4383 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule635 #-}+ {-# LINE 682 "src-ag/GenerateCode.ag" #-}+ rule635 = \ ((_nextIfreeVars) :: [String]) defs_ visit_ ->+ {-# LINE 682 "src-ag/GenerateCode.ag" #-}+ freevars _nextIfreeVars (visit_ : defs_)+ {-# LINE 4389 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule636 #-}+ {-# LINE 689 "src-ag/GenerateCode.ag" #-}+ rule636 = \ _freeVars _lambdaName ((_lhsIoptCase) :: Bool) ((_nextIcallExpr) :: Expr) defs_ visit_ ->+ {-# LINE 689 "src-ag/GenerateCode.ag" #-}+ mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ [visit_]) _nextIcallExpr+ {-# LINE 4395 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule637 #-}+ {-# LINE 690 "src-ag/GenerateCode.ag" #-}+ rule637 = \ _decl ((_lhsIblockNr) :: Int) ((_nextIdecls) :: [Decl]) _pragmaDecl ->+ {-# LINE 690 "src-ag/GenerateCode.ag" #-}+ (if _lhsIblockNr > 1 then [_pragmaDecl ] else []) ++ [_decl ] ++ _nextIdecls+ {-# LINE 4401 "src-generated/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 676 "src-ag/GenerateCode.ag" #-}+ rule643 = \ ((_lhsIblockNr) :: Int) ((_lhsIprefix) :: String) ->+ {-# LINE 676 "src-ag/GenerateCode.ag" #-}+ _lhsIprefix ++ "_block" ++ show _lhsIblockNr+ {-# LINE 4441 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule644 #-}+ {-# LINE 677 "src-ag/GenerateCode.ag" #-}+ rule644 = \ _lambdaName ->+ {-# LINE 677 "src-ag/GenerateCode.ag" #-}+ PragmaDecl ("NOINLINE " ++ _lambdaName )+ {-# LINE 4447 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule645 #-}+ {-# LINE 678 "src-ag/GenerateCode.ag" #-}+ rule645 = \ _freeVars _lambdaName ->+ {-# LINE 678 "src-ag/GenerateCode.ag" #-}+ App _lambdaName (map SimpleExpr _freeVars )+ {-# LINE 4453 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule646 #-}+ {-# LINE 680 "src-ag/GenerateCode.ag" #-}+ rule646 = \ ((_lhsIlastExprVars) :: [String]) ((_lhsInextVisitDecls) :: [Decl]) defs_ ->+ {-# LINE 680 "src-ag/GenerateCode.ag" #-}+ freevars _lhsIlastExprVars (defs_ ++ _lhsInextVisitDecls)+ {-# LINE 4459 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule647 #-}+ {-# LINE 687 "src-ag/GenerateCode.ag" #-}+ rule647 = \ _freeVars _lambdaName ((_lhsInextVisitDecls) :: [Decl]) ((_lhsIoptCase) :: Bool) defs_ result_ ->+ {-# LINE 687 "src-ag/GenerateCode.ag" #-}+ [ mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ _lhsInextVisitDecls) result_ ]+ {-# LINE 4465 "src-generated/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 662 "src-ag/GenerateCode.ag" #-}+ rule649 = \ ((_blocksIdecls) :: [Decl]) ->+ {-# LINE 662 "src-ag/GenerateCode.ag" #-}+ _blocksIdecls+ {-# LINE 4526 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule650 #-}+ {-# LINE 663 "src-ag/GenerateCode.ag" #-}+ rule650 = \ ((_blocksIcallExpr) :: Expr) ->+ {-# LINE 663 "src-ag/GenerateCode.ag" #-}+ _blocksIcallExpr+ {-# LINE 4532 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule651 #-}+ {-# LINE 668 "src-ag/GenerateCode.ag" #-}+ rule651 = \ (_ :: ()) ->+ {-# LINE 668 "src-ag/GenerateCode.ag" #-}+ 1+ {-# LINE 4538 "src-generated/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 266 "src-ag/GenerateCode.ag" #-}+ rule664 = \ ((_patIdefinedInsts) :: [Identifier]) attr_ field_ ->+ {-# LINE 266 "src-ag/GenerateCode.ag" #-}+ (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts+ {-# LINE 4672 "src-generated/GenerateCode.hs" #-}+ {-# INLINE rule665 #-}+ {-# LINE 274 "src-ag/GenerateCode.ag" #-}+ rule665 = \ ((_patIpatternAttributes) :: [(Identifier, Identifier)]) attr_ field_ ->+ {-# LINE 274 "src-ag/GenerateCode.ag" #-}+ (field_,attr_) : _patIpatternAttributes+ {-# LINE 4678 "src-generated/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 631 "src-ag/GenerateCode.ag" #-}+ rule684 = \ ((_hdIbldBlocksFun) :: DeclBlocks -> DeclBlocks) ((_tlIblockDecls) :: DeclBlocks) ->+ {-# LINE 631 "src-ag/GenerateCode.ag" #-}+ _hdIbldBlocksFun _tlIblockDecls+ {-# LINE 4981 "src-generated/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 633 "src-ag/GenerateCode.ag" #-}+ rule766 = \ ((_lhsIdeclsAbove) :: [Decl]) ((_lhsIlastExpr) :: Expr) ->+ {-# LINE 633 "src-ag/GenerateCode.ag" #-}+ DeclTerminator _lhsIdeclsAbove _lhsIlastExpr+ {-# LINE 5262 "src-generated/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
src-generated/HsToken.hs view
@@ -1,57 +1,57 @@- - --- UUAGC 0.9.51 (src-ag/HsToken.ag) -module HsToken where -{-# LINE 2 "src-ag/HsToken.ag" #-} +++-- UUAGC 0.9.53 (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 --} +{-# LINE 10 "src-generated/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)
src-generated/Interfaces.hs view
@@ -1,51 +1,51 @@- - --- UUAGC 0.9.51 (src-ag/Interfaces.ag) -module Interfaces where -{-# LINE 2 "src-ag/Interfaces.ag" #-} +++-- UUAGC 0.9.53 (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: --} +{-# LINE 10 "src-generated/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]
src-generated/InterfacesRules.hs view
@@ -1,1213 +1,1213 @@-{-# 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 +{-# LANGUAGE Rank2Types, GADTs #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module InterfacesRules where+{-# LINE 2 "src-ag/Interfaces.ag" #-}+ +import CommonTypes +import SequentialTypes +{-# LINE 11 "src-generated/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 "src-generated/InterfacesRules.hs" #-}+import Control.Monad.Identity (Identity)+import qualified Control.Monad.Identity+{-# LINE 53 "src-ag/InterfacesRules.lag" #-}++type VisitSS = [Vertex]+{-# LINE 35 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/InterfacesRules.hs" #-}++{-# LINE 323 "src-ag/InterfacesRules.lag" #-}++type IntraVisit = [Vertex]+{-# LINE 76 "src-generated/InterfacesRules.hs" #-}++{-# LINE 345 "src-ag/InterfacesRules.lag" #-}++swap :: (a,b) -> (b,a)+swap (a,b) = (b,a)+{-# LINE 82 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule3 #-}+ {-# LINE 122 "src-ag/InterfacesRules.lag" #-}+ rule3 = \ _descr ->+ {-# LINE 122 "src-ag/InterfacesRules.lag" #-}+ Map.fromList _descr+ {-# LINE 177 "src-generated/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 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule5 #-}+ {-# LINE 214 "src-ag/InterfacesRules.lag" #-}+ rule5 = \ _visitssGraph ->+ {-# LINE 214 "src-ag/InterfacesRules.lag" #-}+ _visitssGraph+ {-# LINE 189 "src-generated/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 "src-generated/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 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule8 #-}+ {-# LINE 381 "src-ag/InterfacesRules.lag" #-}+ rule8 = \ ((_intersIinters) :: CInterfaceMap) ->+ {-# LINE 381 "src-ag/InterfacesRules.lag" #-}+ _intersIinters+ {-# LINE 208 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule9 #-}+ {-# LINE 443 "src-ag/InterfacesRules.lag" #-}+ rule9 = \ ((_intersIedp) :: Seq Edge) ->+ {-# LINE 443 "src-ag/InterfacesRules.lag" #-}+ toList _intersIedp+ {-# LINE 214 "src-generated/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 "src-generated/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 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule15 #-}+ {-# LINE 185 "src-ag/InterfacesRules.lag" #-}+ rule15 = \ _v ->+ {-# LINE 185 "src-ag/InterfacesRules.lag" #-}+ _v+ {-# LINE 317 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule22 #-}+ {-# LINE 201 "src-ag/InterfacesRules.lag" #-}+ rule22 = \ (_ :: ()) ->+ {-# LINE 201 "src-ag/InterfacesRules.lag" #-}+ 0+ {-# LINE 359 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule23 #-}+ {-# LINE 233 "src-ag/InterfacesRules.lag" #-}+ rule23 = \ cons_ ->+ {-# LINE 233 "src-ag/InterfacesRules.lag" #-}+ cons_+ {-# LINE 365 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule24 #-}+ {-# LINE 314 "src-ag/InterfacesRules.lag" #-}+ rule24 = \ (_ :: ()) ->+ {-# LINE 314 "src-ag/InterfacesRules.lag" #-}+ True+ {-# LINE 371 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule25 #-}+ {-# LINE 352 "src-ag/InterfacesRules.lag" #-}+ rule25 = \ ((_lhsIprev) :: [Vertex]) ->+ {-# LINE 352 "src-ag/InterfacesRules.lag" #-}+ _lhsIprev+ {-# LINE 377 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule26 #-}+ {-# LINE 392 "src-ag/InterfacesRules.lag" #-}+ rule26 = \ nt_ ->+ {-# LINE 392 "src-ag/InterfacesRules.lag" #-}+ nt_+ {-# LINE 383 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule27 #-}+ {-# LINE 396 "src-ag/InterfacesRules.lag" #-}+ rule27 = \ ((_segIsegs) :: CSegments) ->+ {-# LINE 396 "src-ag/InterfacesRules.lag" #-}+ CInterface _segIsegs+ {-# LINE 389 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule59 #-}+ {-# LINE 389 "src-ag/InterfacesRules.lag" #-}+ rule59 = \ (_ :: ()) ->+ {-# LINE 389 "src-ag/InterfacesRules.lag" #-}+ Map.empty+ {-# LINE 597 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule78 #-}+ {-# LINE 275 "src-ag/InterfacesRules.lag" #-}+ rule78 = \ _defined ((_lhsIprev) :: [Vertex]) ->+ {-# LINE 275 "src-ag/InterfacesRules.lag" #-}+ _lhsIprev ++ _defined+ {-# LINE 795 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule88 #-}+ {-# LINE 445 "src-ag/InterfacesRules.lag" #-}+ rule88 = \ inh_ ->+ {-# LINE 445 "src-ag/InterfacesRules.lag" #-}+ inh_+ {-# LINE 883 "src-generated/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 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule95 #-}+ {-# LINE 166 "src-ag/InterfacesRules.lag" #-}+ rule95 = \ ((_hdInewvertices) :: [Vertex]) ->+ {-# LINE 166 "src-ag/InterfacesRules.lag" #-}+ _hdInewvertices+ {-# LINE 1002 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule96 #-}+ {-# LINE 180 "src-ag/InterfacesRules.lag" #-}+ rule96 = \ ((_hdIgroups) :: [([Vertex],[Vertex])]) ->+ {-# LINE 180 "src-ag/InterfacesRules.lag" #-}+ _hdIgroups+ {-# LINE 1008 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule97 #-}+ {-# LINE 203 "src-ag/InterfacesRules.lag" #-}+ rule97 = \ ((_lhsIn) :: Int) ->+ {-# LINE 203 "src-ag/InterfacesRules.lag" #-}+ _lhsIn + 1+ {-# LINE 1014 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule98 #-}+ {-# LINE 316 "src-ag/InterfacesRules.lag" #-}+ rule98 = \ (_ :: ()) ->+ {-# LINE 316 "src-ag/InterfacesRules.lag" #-}+ False+ {-# LINE 1020 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule99 #-}+ {-# LINE 329 "src-ag/InterfacesRules.lag" #-}+ rule99 = \ ((_tlIhdIntravisits) :: [IntraVisit]) ->+ {-# LINE 329 "src-ag/InterfacesRules.lag" #-}+ _tlIhdIntravisits+ {-# LINE 1026 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule100 #-}+ {-# LINE 330 "src-ag/InterfacesRules.lag" #-}+ rule100 = \ ((_hdIintravisits) :: [IntraVisit]) ->+ {-# LINE 330 "src-ag/InterfacesRules.lag" #-}+ _hdIintravisits+ {-# LINE 1032 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule101 #-}+ {-# LINE 354 "src-ag/InterfacesRules.lag" #-}+ rule101 = \ ((_lhsIfromLhs) :: [Vertex]) ->+ {-# LINE 354 "src-ag/InterfacesRules.lag" #-}+ _lhsIfromLhs+ {-# LINE 1038 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule102 #-}+ {-# LINE 355 "src-ag/InterfacesRules.lag" #-}+ rule102 = \ (_ :: ()) ->+ {-# LINE 355 "src-ag/InterfacesRules.lag" #-}+ []+ {-# LINE 1044 "src-generated/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 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule104 #-}+ {-# LINE 447 "src-ag/InterfacesRules.lag" #-}+ rule104 = \ ((_tlIfirstInh) :: [Vertex]) ->+ {-# LINE 447 "src-ag/InterfacesRules.lag" #-}+ _tlIfirstInh+ {-# LINE 1056 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule105 #-}+ {-# LINE 448 "src-ag/InterfacesRules.lag" #-}+ rule105 = \ ((_hdIinh) :: [Vertex]) ->+ {-# LINE 448 "src-ag/InterfacesRules.lag" #-}+ _hdIinh+ {-# LINE 1062 "src-generated/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 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule131 #-}+ {-# LINE 181 "src-ag/InterfacesRules.lag" #-}+ rule131 = \ (_ :: ()) ->+ {-# LINE 181 "src-ag/InterfacesRules.lag" #-}+ []+ {-# LINE 1178 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule132 #-}+ {-# LINE 331 "src-ag/InterfacesRules.lag" #-}+ rule132 = \ (_ :: ()) ->+ {-# LINE 331 "src-ag/InterfacesRules.lag" #-}+ repeat []+ {-# LINE 1184 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule133 #-}+ {-# LINE 402 "src-ag/InterfacesRules.lag" #-}+ rule133 = \ (_ :: ()) ->+ {-# LINE 402 "src-ag/InterfacesRules.lag" #-}+ []+ {-# LINE 1190 "src-generated/InterfacesRules.hs" #-}+ {-# INLINE rule134 #-}+ {-# LINE 449 "src-ag/InterfacesRules.lag" #-}+ rule134 = \ (_ :: ()) ->+ {-# LINE 449 "src-ag/InterfacesRules.lag" #-}+ []+ {-# LINE 1196 "src-generated/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
src-generated/KWOrder.hs view
@@ -1,2305 +1,2305 @@-{-# 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 +{-# 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 "src-generated/KWOrder.hs" #-}++{-# LINE 2 "src-ag/Expression.ag" #-}+ +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 17 "src-generated/KWOrder.hs" #-}++{-# LINE 2 "src-ag/HsToken.ag" #-}+ +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 23 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/KWOrder.hs" #-}+ {-# INLINE rule10 #-}+ {-# LINE 65 "src-ag/KWOrder.ag" #-}+ rule10 = \ name_ ->+ {-# LINE 65 "src-ag/KWOrder.ag" #-}+ VChild name_+ {-# LINE 224 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/KWOrder.hs" #-}+ {-# INLINE rule17 #-}+ {-# LINE 111 "src-ag/KWOrder.ag" #-}+ rule17 = \ _higherOrderEdges ->+ {-# LINE 111 "src-ag/KWOrder.ag" #-}+ _higherOrderEdges+ {-# LINE 275 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/KWOrder.hs" #-}+ {-# INLINE rule52 #-}+ {-# LINE 42 "src-ag/ExecutionPlanCommon.ag" #-}+ rule52 = \ _closedHoNtDeps ->+ {-# LINE 42 "src-ag/ExecutionPlanCommon.ag" #-}+ revDeps _closedHoNtDeps+ {-# LINE 609 "src-generated/KWOrder.hs" #-}+ {-# INLINE rule53 #-}+ {-# LINE 51 "src-ag/ExecutionPlanCommon.ag" #-}+ rule53 = \ contextMap_ ->+ {-# LINE 51 "src-ag/ExecutionPlanCommon.ag" #-}+ contextMap_+ {-# LINE 615 "src-generated/KWOrder.hs" #-}+ {-# INLINE rule54 #-}+ {-# LINE 92 "src-ag/ExecutionPlanCommon.ag" #-}+ rule54 = \ aroundsMap_ ->+ {-# LINE 92 "src-ag/ExecutionPlanCommon.ag" #-}+ aroundsMap_+ {-# LINE 621 "src-generated/KWOrder.hs" #-}+ {-# INLINE rule55 #-}+ {-# LINE 117 "src-ag/ExecutionPlanCommon.ag" #-}+ rule55 = \ mergeMap_ ->+ {-# LINE 117 "src-ag/ExecutionPlanCommon.ag" #-}+ mergeMap_+ {-# LINE 627 "src-generated/KWOrder.hs" #-}+ {-# INLINE rule56 #-}+ {-# LINE 9 "src-ag/ExecutionPlanPre.ag" #-}+ rule56 = \ (_ :: ()) ->+ {-# LINE 9 "src-ag/ExecutionPlanPre.ag" #-}+ 0+ {-# LINE 633 "src-generated/KWOrder.hs" #-}+ {-# INLINE rule57 #-}+ {-# LINE 15 "src-ag/DistChildAttr.ag" #-}+ rule57 = \ ((_nontsIinhMap') :: Map Identifier Attributes) ->+ {-# LINE 15 "src-ag/DistChildAttr.ag" #-}+ _nontsIinhMap'+ {-# LINE 639 "src-generated/KWOrder.hs" #-}+ {-# INLINE rule58 #-}+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}+ rule58 = \ ((_nontsIsynMap') :: Map Identifier Attributes) ->+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}+ _nontsIsynMap'+ {-# LINE 645 "src-generated/KWOrder.hs" #-}+ {-# INLINE rule59 #-}+ {-# LINE 119 "src-ag/KWOrder.ag" #-}+ rule59 = \ manualAttrOrderMap_ ->+ {-# LINE 119 "src-ag/KWOrder.ag" #-}+ manualAttrOrderMap_+ {-# LINE 651 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/KWOrder.hs" #-}+ {-# INLINE rule93 #-}+ {-# LINE 177 "src-ag/KWOrder.ag" #-}+ rule93 = \ _inhvertices _synvertices ->+ {-# LINE 177 "src-ag/KWOrder.ag" #-}+ _synvertices ++ _inhvertices+ {-# LINE 1119 "src-generated/KWOrder.hs" #-}+ {-# INLINE rule94 #-}+ {-# LINE 181 "src-ag/KWOrder.ag" #-}+ rule94 = \ _vertices ->+ {-# LINE 181 "src-ag/KWOrder.ag" #-}+ NontDependencyGraph { ndgVertices = _vertices+ , ndgEdges = [] }+ {-# LINE 1126 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/KWOrder.hs" #-}+ {-# INLINE rule171 #-}+ {-# LINE 123 "src-ag/KWOrder.ag" #-}+ rule171 = \ _manualDeps ->+ {-# LINE 123 "src-ag/KWOrder.ag" #-}+ Set.map depToEdge _manualDeps+ {-# LINE 1767 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/KWOrder.hs" #-}+ {-# INLINE rule209 #-}+ {-# LINE 12 "src-ag/ExecutionPlanPre.ag" #-}+ rule209 = \ ((_lhsIrulenumber) :: Int) ->+ {-# LINE 12 "src-ag/ExecutionPlanPre.ag" #-}+ _lhsIrulenumber + 1+ {-# LINE 2053 "src-generated/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 "src-generated/KWOrder.hs" #-}+ {-# INLINE rule211 #-}+ {-# LINE 74 "src-ag/KWOrder.ag" #-}+ rule211 = \ _rulename ->+ {-# LINE 74 "src-ag/KWOrder.ag" #-}+ VRule _rulename+ {-# LINE 2065 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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
src-generated/LOAG/Order.hs view
@@ -1,6238 +1,6251 @@-{-# 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 +{-# 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 "src-generated/LOAG/Order.hs" #-}++{-# LINE 2 "src-ag/HsToken.ag" #-}+ +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 18 "src-generated/LOAG/Order.hs" #-}++{-# LINE 2 "src-ag/Expression.ag" #-}+ +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 24 "src-generated/LOAG/Order.hs" #-}++{-# LINE 2 "src-ag/CodeSyntax.ag" #-}+ +import Patterns +import CommonTypes +import Data.Map(Map) +import Data.Set(Set) +{-# LINE 32 "src-generated/LOAG/Order.hs" #-}++{-# LINE 2 "src-ag/Patterns.ag" #-}+ +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 39 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/LOAG/Order.hs" #-}++{-# LINE 292 "src-ag/LOAG/Prepare.ag" #-}+ +-- | 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 +{-# LINE 131 "src-generated/LOAG/Order.hs" #-}++{-# LINE 42 "src-ag/LOAG/Order.ag" #-}+ +fst' (a,_,_) = a +snd' (_,b,_) = b +trd' (_,_,c) = c +{-# LINE 138 "src-generated/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 168 "src-generated/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 $ + lfp Map.! occ + rep :: MyOccurrence -> Set.Set MyOccurrence + rep occ | isLoc occ = Set.insert occ $ + setConcatMap rep $ lfp Map.! 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-> visMap IMap.! x) (nmpr Map.! (nt <.> attr o)) + nt = fty Map.! (ps,child) +{-# LINE 248 "src-generated/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 330 "src-generated/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 1110 "src-generated/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 1116 "src-generated/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 1124 "src-generated/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 1132 "src-generated/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 1138 "src-generated/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 1144 "src-generated/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 1152 "src-generated/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 1158 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule40 #-}+ {-# LINE 175 "src-ag/LOAG/Prepare.ag" #-}+ rule40 = \ tp_ ->+ {-# LINE 175 "src-ag/LOAG/Prepare.ag" #-}+ toMyTy tp_+ {-# LINE 1164 "src-generated/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 1171 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule42 #-}+ {-# LINE 179 "src-ag/LOAG/Prepare.ag" #-}+ rule42 = \ _flab ->+ {-# LINE 179 "src-ag/LOAG/Prepare.ag" #-}+ _flab+ {-# LINE 1177 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule43 #-}+ {-# LINE 180 "src-ag/LOAG/Prepare.ag" #-}+ rule43 = \ name_ ->+ {-# LINE 180 "src-ag/LOAG/Prepare.ag" #-}+ getName name_+ {-# LINE 1183 "src-generated/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 1189 "src-generated/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 1195 "src-generated/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 1201 "src-generated/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 1209 "src-generated/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 1217 "src-generated/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 1223 "src-generated/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 1229 "src-generated/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 1611 "src-generated/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 1617 "src-generated/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 1624 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule123 #-}+ {-# LINE 166 "src-ag/LOAG/Prepare.ag" #-}+ rule123 = \ _flab ->+ {-# LINE 166 "src-ag/LOAG/Prepare.ag" #-}+ _flab+ {-# LINE 1630 "src-generated/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 1636 "src-generated/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 1642 "src-generated/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 1648 "src-generated/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 1654 "src-generated/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 1660 "src-generated/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 1777 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule149 #-}+ {-# LINE 274 "src-ag/LOAG/Prepare.ag" #-}+ rule149 = \ ((_lhsIpll) :: PLabel) ->+ {-# LINE 274 "src-ag/LOAG/Prepare.ag" #-}+ _lhsIpll+ {-# LINE 1783 "src-generated/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 1789 "src-generated/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 1795 "src-generated/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 1883 "src-generated/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 1889 "src-generated/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 1895 "src-generated/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 1901 "src-generated/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 1907 "src-generated/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 1913 "src-generated/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 1919 "src-generated/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 1925 "src-generated/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 1931 "src-generated/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 1937 "src-generated/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 2269 "src-generated/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 2275 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule207 #-}+ {-# LINE 42 "src-ag/ExecutionPlanCommon.ag" #-}+ rule207 = \ _closedHoNtDeps ->+ {-# LINE 42 "src-ag/ExecutionPlanCommon.ag" #-}+ revDeps _closedHoNtDeps+ {-# LINE 2281 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule208 #-}+ {-# LINE 51 "src-ag/ExecutionPlanCommon.ag" #-}+ rule208 = \ contextMap_ ->+ {-# LINE 51 "src-ag/ExecutionPlanCommon.ag" #-}+ contextMap_+ {-# LINE 2287 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule209 #-}+ {-# LINE 92 "src-ag/ExecutionPlanCommon.ag" #-}+ rule209 = \ aroundsMap_ ->+ {-# LINE 92 "src-ag/ExecutionPlanCommon.ag" #-}+ aroundsMap_+ {-# LINE 2293 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule210 #-}+ {-# LINE 117 "src-ag/ExecutionPlanCommon.ag" #-}+ rule210 = \ mergeMap_ ->+ {-# LINE 117 "src-ag/ExecutionPlanCommon.ag" #-}+ mergeMap_+ {-# LINE 2299 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule211 #-}+ {-# LINE 9 "src-ag/ExecutionPlanPre.ag" #-}+ rule211 = \ (_ :: ()) ->+ {-# LINE 9 "src-ag/ExecutionPlanPre.ag" #-}+ 0+ {-# LINE 2305 "src-generated/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 2311 "src-generated/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 2325 "src-generated/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 2331 "src-generated/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 2337 "src-generated/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 2343 "src-generated/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 2349 "src-generated/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 2355 "src-generated/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 2361 "src-generated/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 2367 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule221 #-}+ {-# LINE 56 "src-ag/LOAG/Prepare.ag" #-}+ rule221 = \ manualAttrOrderMap_ ->+ {-# LINE 56 "src-ag/LOAG/Prepare.ag" #-}+ manualAttrOrderMap_+ {-# LINE 2373 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule222 #-}+ {-# LINE 87 "src-ag/LOAG/Prepare.ag" #-}+ rule222 = \ _ain ->+ {-# LINE 87 "src-ag/LOAG/Prepare.ag" #-}+ map2F _ain+ {-# LINE 2379 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule223 #-}+ {-# LINE 88 "src-ag/LOAG/Prepare.ag" #-}+ rule223 = \ _asn ->+ {-# LINE 88 "src-ag/LOAG/Prepare.ag" #-}+ map2F _asn+ {-# LINE 2385 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule224 #-}+ {-# LINE 89 "src-ag/LOAG/Prepare.ag" #-}+ rule224 = \ ((_nontsIpmp) :: PMP) ->+ {-# LINE 89 "src-ag/LOAG/Prepare.ag" #-}+ _nontsIpmp+ {-# LINE 2391 "src-generated/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 2397 "src-generated/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 2403 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule227 #-}+ {-# LINE 92 "src-ag/LOAG/Prepare.ag" #-}+ rule227 = \ ((_nontsIhoMap) :: HOMap) ->+ {-# LINE 92 "src-ag/LOAG/Prepare.ag" #-}+ _nontsIhoMap+ {-# LINE 2409 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule228 #-}+ {-# LINE 93 "src-ag/LOAG/Prepare.ag" #-}+ rule228 = \ ((_nontsIfty) :: FTY) ->+ {-# LINE 93 "src-ag/LOAG/Prepare.ag" #-}+ _nontsIfty+ {-# LINE 2415 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule229 #-}+ {-# LINE 94 "src-ag/LOAG/Prepare.ag" #-}+ rule229 = \ ((_nontsIfty) :: FTY) ->+ {-# LINE 94 "src-ag/LOAG/Prepare.ag" #-}+ _nontsIfty+ {-# LINE 2421 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule230 #-}+ {-# LINE 103 "src-ag/LOAG/Prepare.ag" #-}+ rule230 = \ ((_nontsIps) :: [PLabel]) ->+ {-# LINE 103 "src-ag/LOAG/Prepare.ag" #-}+ _nontsIps+ {-# LINE 2427 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule231 #-}+ {-# LINE 150 "src-ag/LOAG/Prepare.ag" #-}+ rule231 = \ _an ->+ {-# LINE 150 "src-ag/LOAG/Prepare.ag" #-}+ map2F _an+ {-# LINE 2433 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule232 #-}+ {-# LINE 151 "src-ag/LOAG/Prepare.ag" #-}+ rule232 = \ _nmpr ->+ {-# LINE 151 "src-ag/LOAG/Prepare.ag" #-}+ _nmpr+ {-# LINE 2439 "src-generated/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 2445 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule234 #-}+ {-# LINE 153 "src-ag/LOAG/Prepare.ag" #-}+ rule234 = \ (_ :: ()) ->+ {-# LINE 153 "src-ag/LOAG/Prepare.ag" #-}+ 0+ {-# LINE 2451 "src-generated/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 $ addHigherOrders _nontsIlfp _nontsIsfp+ {-# LINE 2457 "src-generated/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 2463 "src-generated/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 2471 "src-generated/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 2477 "src-generated/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 2483 "src-generated/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 2489 "src-generated/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 2499 "src-generated/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 2506 "src-generated/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 2512 "src-generated/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 2518 "src-generated/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 2524 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule246 #-}+ {-# LINE 134 "src-ag/LOAG/Order.ag" #-}+ rule246 = \ (_ :: ()) ->+ {-# LINE 134 "src-ag/LOAG/Order.ag" #-}+ 0+ {-# LINE 2530 "src-generated/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 2620 "src-generated/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 2648 "src-generated/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 3043 "src-generated/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 3049 "src-generated/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 3055 "src-generated/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 3061 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule298 #-}+ {-# LINE 229 "src-ag/LOAG/Order.ag" #-}+ rule298 = \ visnr_ ->+ {-# LINE 229 "src-ag/LOAG/Order.ag" #-}+ visnr_+ {-# LINE 3067 "src-generated/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 3073 "src-generated/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 3080 "src-generated/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 3087 "src-generated/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 3096 "src-generated/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 3201 "src-generated/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 3208 "src-generated/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 3495 "src-generated/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 3501 "src-generated/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 3507 "src-generated/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 3513 "src-generated/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 3519 "src-generated/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 3525 "src-generated/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 3531 "src-generated/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 3540 "src-generated/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 3546 "src-generated/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 3552 "src-generated/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 3558 "src-generated/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 3564 "src-generated/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 3570 "src-generated/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 3576 "src-generated/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 3583 "src-generated/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 3590 "src-generated/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 3598 "src-generated/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 3604 "src-generated/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 3610 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule366 #-}+ {-# LINE 138 "src-ag/LOAG/Order.ag" #-}+ rule366 = \ ((_lhsIvisitnum) :: Int) ->+ {-# LINE 138 "src-ag/LOAG/Order.ag" #-}+ _lhsIvisitnum+ {-# LINE 3616 "src-generated/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 3622 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule368 #-}+ {-# LINE 140 "src-ag/LOAG/Order.ag" #-}+ rule368 = \ _vnums ->+ {-# LINE 140 "src-ag/LOAG/Order.ag" #-}+ _vnums+ {-# LINE 3628 "src-generated/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 3635 "src-generated/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 3642 "src-generated/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 3650 "src-generated/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 3666 "src-generated/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 3673 "src-generated/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 3682 "src-generated/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 3692 "src-generated/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 3701 "src-generated/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 4561 "src-generated/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 4896 "src-generated/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 4902 "src-generated/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 4908 "src-generated/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 4914 "src-generated/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 4920 "src-generated/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 4928 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule582 #-}+ {-# LINE 120 "src-ag/LOAG/Prepare.ag" #-}+ rule582 = \ ((_lhsIdty) :: MyType) ->+ {-# LINE 120 "src-ag/LOAG/Prepare.ag" #-}+ _lhsIdty+ {-# LINE 4934 "src-generated/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 4940 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule584 #-}+ {-# LINE 215 "src-ag/LOAG/Prepare.ag" #-}+ rule584 = \ _pll ->+ {-# LINE 215 "src-ag/LOAG/Prepare.ag" #-}+ _pll+ {-# LINE 4946 "src-generated/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 4952 "src-generated/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 4958 "src-generated/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 4969 "src-generated/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 4975 "src-generated/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 4981 "src-generated/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 4990 "src-generated/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 5007 "src-generated/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 5021 "src-generated/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 5341 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule650 #-}+ {-# LINE 193 "src-ag/LOAG/Order.ag" #-}+ rule650 = \ ((_hdIvisitnum) :: Int) ->+ {-# LINE 193 "src-ag/LOAG/Order.ag" #-}+ _hdIvisitnum+ {-# LINE 5347 "src-generated/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 5789 "src-generated/LOAG/Order.hs" #-}+ {-# INLINE rule752 #-}+ {-# LINE 12 "src-ag/ExecutionPlanPre.ag" #-}+ rule752 = \ ((_lhsIrulenumber) :: Int) ->+ {-# LINE 12 "src-ag/ExecutionPlanPre.ag" #-}+ _lhsIrulenumber + 1+ {-# LINE 5795 "src-generated/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 5801 "src-generated/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 5807 "src-generated/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 5813 "src-generated/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 5837 "src-generated/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 6163 "src-generated/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
src-generated/LOAG/Rep.hs view
@@ -1,7 +1,7 @@- - --- UUAGC 0.9.51 (src-ag/LOAG/Rep.ag) -module LOAG.Rep where +++-- UUAGC 0.9.53 (src-ag/LOAG/Rep.ag)+module LOAG.Rep where import CommonTypes import AbstractSyntax @@ -9,99 +9,99 @@ 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 : _ --} +-- 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]
src-generated/Macro.hs view
@@ -1,53 +1,53 @@- - --- UUAGC 0.9.51 (src-ag/Macro.ag) -module Macro where -{-# LINE 4 "src-ag/Macro.ag" #-} +++-- UUAGC 0.9.53 (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: --} +{-# LINE 9 "src-generated/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)
src-generated/Order.hs view
@@ -1,3846 +1,3846 @@-{-# 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<n = xs ++ replicate (n-k) ' ' - | otherwise = xs - where k = length xs - -alignR n xs | k<n = replicate (n-k) ' ' ++ xs - | otherwise = xs - where k = length xs - -localCycleErr :: Table CRule -> 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 +{-# 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 "src-generated/Order.hs" #-}++{-# LINE 2 "src-ag/Expression.ag" #-}+ +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 22 "src-generated/Order.hs" #-}++{-# LINE 2 "src-ag/Patterns.ag" #-}+ +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 29 "src-generated/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 "src-generated/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 "src-generated/Order.hs" #-}++{-# LINE 71 "src-ag/Order.ag" #-}+ +startsWith :: String -> String -> Bool +startsWith k h = k == take (length k) h +{-# LINE 85 "src-generated/Order.hs" #-}++{-# LINE 138 "src-ag/Order.ag" #-}+ +getNtName :: Type -> NontermIdent +getNtName (NT nt _ _) = nt +getNtName _ = nullIdent +{-# LINE 92 "src-generated/Order.hs" #-}++{-# LINE 166 "src-ag/Order.ag" #-}+ +data AltAttr = AltAttr Identifier Identifier Bool + deriving (Eq, Ord, Show) +{-# LINE 98 "src-generated/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 "src-generated/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<n = xs ++ replicate (n-k) ' ' + | otherwise = xs + where k = length xs + +alignR n xs | k<n = replicate (n-k) ' ' ++ xs + | otherwise = xs + where k = length xs + +localCycleErr :: Table CRule -> 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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Order.hs" #-}+ {-# INLINE rule61 #-}+ {-# LINE 492 "src-ag/Order.ag" #-}+ rule61 = \ (_ :: ()) ->+ {-# LINE 492 "src-ag/Order.ag" #-}+ Seq.empty+ {-# LINE 748 "src-generated/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 "src-generated/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 "src-generated/Order.hs" #-}+ {-# INLINE rule70 #-}+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}+ rule70 = \ ((_nontsIsynMap') :: Map Identifier Attributes) ->+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}+ _nontsIsynMap'+ {-# LINE 875 "src-generated/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 "src-generated/Order.hs" #-}+ {-# INLINE rule72 #-}+ {-# LINE 124 "src-ag/Order.ag" #-}+ rule72 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 124 "src-ag/Order.ag" #-}+ folds _lhsIoptions+ {-# LINE 887 "src-generated/Order.hs" #-}+ {-# INLINE rule73 #-}+ {-# LINE 125 "src-ag/Order.ag" #-}+ rule73 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 125 "src-ag/Order.ag" #-}+ dataTypes _lhsIoptions+ {-# LINE 893 "src-generated/Order.hs" #-}+ {-# INLINE rule74 #-}+ {-# LINE 126 "src-ag/Order.ag" #-}+ rule74 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 126 "src-ag/Order.ag" #-}+ typeSigs _lhsIoptions+ {-# LINE 899 "src-generated/Order.hs" #-}+ {-# INLINE rule75 #-}+ {-# LINE 127 "src-ag/Order.ag" #-}+ rule75 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 127 "src-ag/Order.ag" #-}+ semfuns _lhsIoptions+ {-# LINE 905 "src-generated/Order.hs" #-}+ {-# INLINE rule76 #-}+ {-# LINE 128 "src-ag/Order.ag" #-}+ rule76 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 128 "src-ag/Order.ag" #-}+ rename _lhsIoptions+ {-# LINE 911 "src-generated/Order.hs" #-}+ {-# INLINE rule77 #-}+ {-# LINE 129 "src-ag/Order.ag" #-}+ rule77 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 129 "src-ag/Order.ag" #-}+ newtypes _lhsIoptions+ {-# LINE 917 "src-generated/Order.hs" #-}+ {-# INLINE rule78 #-}+ {-# LINE 130 "src-ag/Order.ag" #-}+ rule78 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 130 "src-ag/Order.ag" #-}+ visit _lhsIoptions+ {-# LINE 923 "src-generated/Order.hs" #-}+ {-# INLINE rule79 #-}+ {-# LINE 131 "src-ag/Order.ag" #-}+ rule79 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 131 "src-ag/Order.ag" #-}+ unbox _lhsIoptions+ {-# LINE 929 "src-generated/Order.hs" #-}+ {-# INLINE rule80 #-}+ {-# LINE 132 "src-ag/Order.ag" #-}+ rule80 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 132 "src-ag/Order.ag" #-}+ cases _lhsIoptions+ {-# LINE 935 "src-generated/Order.hs" #-}+ {-# INLINE rule81 #-}+ {-# LINE 133 "src-ag/Order.ag" #-}+ rule81 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 133 "src-ag/Order.ag" #-}+ prefix _lhsIoptions+ {-# LINE 941 "src-generated/Order.hs" #-}+ {-# INLINE rule82 #-}+ {-# LINE 262 "src-ag/Order.ag" #-}+ rule82 = \ (_ :: ()) ->+ {-# LINE 262 "src-ag/Order.ag" #-}+ 0+ {-# LINE 947 "src-generated/Order.hs" #-}+ {-# INLINE rule83 #-}+ {-# LINE 288 "src-ag/Order.ag" #-}+ rule83 = \ manualAttrOrderMap_ ->+ {-# LINE 288 "src-ag/Order.ag" #-}+ manualAttrOrderMap_+ {-# LINE 953 "src-generated/Order.hs" #-}+ {-# INLINE rule84 #-}+ {-# LINE 417 "src-ag/Order.ag" #-}+ rule84 = \ aroundsMap_ ->+ {-# LINE 417 "src-ag/Order.ag" #-}+ aroundsMap_+ {-# LINE 959 "src-generated/Order.hs" #-}+ {-# INLINE rule85 #-}+ {-# LINE 508 "src-ag/Order.ag" #-}+ rule85 = \ (_ :: ()) ->+ {-# LINE 508 "src-ag/Order.ag" #-}+ 0+ {-# LINE 965 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Order.hs" #-}+ {-# INLINE rule92 #-}+ {-# LINE 556 "src-ag/Order.ag" #-}+ rule92 = \ ((_nontsIinstDep) :: Seq Edge) ->+ {-# LINE 556 "src-ag/Order.ag" #-}+ toList _nontsIinstDep+ {-# LINE 1011 "src-generated/Order.hs" #-}+ {-# INLINE rule93 #-}+ {-# LINE 557 "src-ag/Order.ag" #-}+ rule93 = \ ((_nontsIaroundDep) :: Seq Edge) ->+ {-# LINE 557 "src-ag/Order.ag" #-}+ toList _nontsIaroundDep+ {-# LINE 1017 "src-generated/Order.hs" #-}+ {-# INLINE rule94 #-}+ {-# LINE 558 "src-ag/Order.ag" #-}+ rule94 = \ ((_nontsImergeDep) :: Seq Edge) ->+ {-# LINE 558 "src-ag/Order.ag" #-}+ toList _nontsImergeDep+ {-# LINE 1023 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Order.hs" #-}+ {-# INLINE rule111 #-}+ {-# LINE 97 "src-ag/Order.ag" #-}+ rule111 = \ nt_ ->+ {-# LINE 97 "src-ag/Order.ag" #-}+ nt_+ {-# LINE 1237 "src-generated/Order.hs" #-}+ {-# INLINE rule112 #-}+ {-# LINE 100 "src-ag/Order.ag" #-}+ rule112 = \ inh_ ->+ {-# LINE 100 "src-ag/Order.ag" #-}+ inh_+ {-# LINE 1243 "src-generated/Order.hs" #-}+ {-# INLINE rule113 #-}+ {-# LINE 101 "src-ag/Order.ag" #-}+ rule113 = \ syn_ ->+ {-# LINE 101 "src-ag/Order.ag" #-}+ syn_+ {-# LINE 1249 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Order.hs" #-}+ {-# INLINE rule120 #-}+ {-# LINE 524 "src-ag/Order.ag" #-}+ rule120 = \ ((_prodsIcons) :: [ConstructorIdent]) nt_ ->+ {-# LINE 524 "src-ag/Order.ag" #-}+ [(nt_,_prodsIcons)]+ {-# LINE 1295 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Order.hs" #-}+ {-# INLINE rule316 #-}+ {-# LINE 95 "src-ag/Order.ag" #-}+ rule316 = \ con_ ->+ {-# LINE 95 "src-ag/Order.ag" #-}+ con_+ {-# LINE 2484 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Order.hs" #-}+ {-# INLINE rule327 #-}+ {-# LINE 342 "src-ag/Order.ag" #-}+ rule327 = \ ((_childrenIcollectChildrenSyns) :: Map Identifier Attributes ) ->+ {-# LINE 342 "src-ag/Order.ag" #-}+ _childrenIcollectChildrenSyns+ {-# LINE 2559 "src-generated/Order.hs" #-}+ {-# INLINE rule328 #-}+ {-# LINE 343 "src-ag/Order.ag" #-}+ rule328 = \ ((_childrenIcollectChildrenInhs) :: Map Identifier Attributes ) ->+ {-# LINE 343 "src-ag/Order.ag" #-}+ _childrenIcollectChildrenInhs+ {-# LINE 2565 "src-generated/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 "src-generated/Order.hs" #-}+ {-# INLINE rule330 #-}+ {-# LINE 372 "src-ag/Order.ag" #-}+ rule330 = \ _mergeDep1 _mergeDep2 ->+ {-# LINE 372 "src-ag/Order.ag" #-}+ _mergeDep1 Seq.>< _mergeDep2+ {-# LINE 2577 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Order.hs" #-}+ {-# INLINE rule336 #-}+ {-# LINE 443 "src-ag/Order.ag" #-}+ rule336 = \ _aroundDep1 _aroundDep2 ->+ {-# LINE 443 "src-ag/Order.ag" #-}+ _aroundDep1 Seq.>< _aroundDep2+ {-# LINE 2649 "src-generated/Order.hs" #-}+ {-# INLINE rule337 #-}+ {-# LINE 527 "src-ag/Order.ag" #-}+ rule337 = \ con_ ->+ {-# LINE 527 "src-ag/Order.ag" #-}+ [con_]+ {-# LINE 2655 "src-generated/Order.hs" #-}+ {-# INLINE rule338 #-}+ {-# LINE 534 "src-ag/Order.ag" #-}+ rule338 = \ (_ :: ()) ->+ {-# LINE 534 "src-ag/Order.ag" #-}+ Map.empty+ {-# LINE 2661 "src-generated/Order.hs" #-}+ {-# INLINE rule339 #-}+ {-# LINE 540 "src-ag/Order.ag" #-}+ rule339 = \ ((_typeSigsItypeSigs) :: Map Identifier Type) ->+ {-# LINE 540 "src-ag/Order.ag" #-}+ _typeSigsItypeSigs+ {-# LINE 2667 "src-generated/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 "src-generated/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 "src-generated/Order.hs" #-}+ {-# INLINE rule342 #-}+ {-# LINE 662 "src-ag/Order.ag" #-}+ rule342 = \ ((_childrenIfields) :: [(Identifier,Type,ChildKind)]) ->+ {-# LINE 662 "src-ag/Order.ag" #-}+ _childrenIfields+ {-# LINE 2690 "src-generated/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 "src-generated/Order.hs" #-}+ {-# INLINE rule344 #-}+ {-# LINE 667 "src-ag/Order.ag" #-}+ rule344 = \ ((_lhsIinh) :: Attributes) ->+ {-# LINE 667 "src-ag/Order.ag" #-}+ Map.keys _lhsIinh+ {-# LINE 2705 "src-generated/Order.hs" #-}+ {-# INLINE rule345 #-}+ {-# LINE 668 "src-ag/Order.ag" #-}+ rule345 = \ ((_lhsIsyn) :: Attributes) ->+ {-# LINE 668 "src-ag/Order.ag" #-}+ Map.keys _lhsIsyn+ {-# LINE 2711 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Order.hs" #-}+ {-# INLINE rule454 #-}+ {-# LINE 338 "src-ag/Order.ag" #-}+ rule454 = \ _instDep1 _instDep2 ->+ {-# LINE 338 "src-ag/Order.ag" #-}+ _instDep1 Seq.>< _instDep2+ {-# LINE 3334 "src-generated/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 "src-generated/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
src-generated/Patterns.hs view
@@ -1,63 +1,63 @@- - --- UUAGC 0.9.51 (src-ag/Patterns.ag) -module Patterns where -{-# LINE 2 "src-ag/Patterns.ag" #-} +++-- UUAGC 0.9.53 (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 : _ --} +{-# LINE 11 "src-generated/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]
src-generated/PrintCleanCode.hs view
@@ -1,4407 +1,4407 @@-{-# 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 +{-# 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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}++{-# LINE 23 "src-ag/PrintCleanCode.ag" #-}+ +type PP_Docs = [PP_Doc] +{-# LINE 60 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}++{-# LINE 425 "src-ag/PrintCleanCode.ag" #-}+ +locname' :: Identifier -> [Char] +locname' n = "_loc_" ++ getName n +{-# LINE 96 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule1 #-}+ {-# LINE 449 "src-ag/PrintCleanCode.ag" #-}+ rule1 = \ (_ :: ()) ->+ {-# LINE 449 "src-ag/PrintCleanCode.ag" #-}+ False+ {-# LINE 184 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule22 #-}+ {-# LINE 546 "src-ag/PrintCleanCode.ag" #-}+ rule22 = \ semNames_ ->+ {-# LINE 546 "src-ag/PrintCleanCode.ag" #-}+ concat $ intersperse "," semNames_+ {-# LINE 461 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule84 #-}+ {-# LINE 232 "src-ag/PrintCleanCode.ag" #-}+ rule84 = \ (_ :: ()) ->+ {-# LINE 232 "src-ag/PrintCleanCode.ag" #-}+ empty+ {-# LINE 805 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule96 #-}+ {-# LINE 79 "src-ag/PrintCleanCode.ag" #-}+ rule96 = \ (_ :: ()) ->+ {-# LINE 79 "src-ag/PrintCleanCode.ag" #-}+ []+ {-# LINE 946 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule171 #-}+ {-# LINE 441 "src-ag/PrintCleanCode.ag" #-}+ rule171 = \ (_ :: ()) ->+ {-# LINE 441 "src-ag/PrintCleanCode.ag" #-}+ True+ {-# LINE 1646 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule186 #-}+ {-# LINE 443 "src-ag/PrintCleanCode.ag" #-}+ rule186 = \ (_ :: ()) ->+ {-# LINE 443 "src-ag/PrintCleanCode.ag" #-}+ False+ {-# LINE 1749 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule245 #-}+ {-# LINE 445 "src-ag/PrintCleanCode.ag" #-}+ rule245 = \ (_ :: ()) ->+ {-# LINE 445 "src-ag/PrintCleanCode.ag" #-}+ False+ {-# LINE 2247 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule276 #-}+ {-# LINE 406 "src-ag/PrintCleanCode.ag" #-}+ rule276 = \ (_ :: ()) ->+ {-# LINE 406 "src-ag/PrintCleanCode.ag" #-}+ False+ {-# LINE 2528 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule280 #-}+ {-# LINE 406 "src-ag/PrintCleanCode.ag" #-}+ rule280 = \ (_ :: ()) ->+ {-# LINE 406 "src-ag/PrintCleanCode.ag" #-}+ False+ {-# LINE 2563 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule285 #-}+ {-# LINE 256 "src-ag/PrintCleanCode.ag" #-}+ rule285 = \ comps_ ->+ {-# LINE 256 "src-ag/PrintCleanCode.ag" #-}+ not (null comps_)+ {-# LINE 2605 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule290 #-}+ {-# LINE 256 "src-ag/PrintCleanCode.ag" #-}+ rule290 = \ comps_ ->+ {-# LINE 256 "src-ag/PrintCleanCode.ag" #-}+ not (null comps_)+ {-# LINE 2655 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule307 #-}+ {-# LINE 244 "src-ag/PrintCleanCode.ag" #-}+ rule307 = \ name_ ->+ {-# LINE 244 "src-ag/PrintCleanCode.ag" #-}+ pp name_+ {-# LINE 2829 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule314 #-}+ {-# LINE 89 "src-ag/PrintCleanCode.ag" #-}+ rule314 = \ (_ :: ()) ->+ {-# LINE 89 "src-ag/PrintCleanCode.ag" #-}+ []+ {-# LINE 2927 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule317 #-}+ {-# LINE 394 "src-ag/PrintCleanCode.ag" #-}+ rule317 = \ (_ :: ()) ->+ {-# LINE 394 "src-ag/PrintCleanCode.ag" #-}+ False+ {-# LINE 3009 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule327 #-}+ {-# LINE 395 "src-ag/PrintCleanCode.ag" #-}+ rule327 = \ (_ :: ()) ->+ {-# LINE 395 "src-ag/PrintCleanCode.ag" #-}+ False+ {-# LINE 3080 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule337 #-}+ {-# LINE 364 "src-ag/PrintCleanCode.ag" #-}+ rule337 = \ _strictPatVars _strictVar ->+ {-# LINE 364 "src-ag/PrintCleanCode.ag" #-}+ _strictVar ++ _strictPatVars+ {-# LINE 3157 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule340 #-}+ {-# LINE 386 "src-ag/PrintCleanCode.ag" #-}+ rule340 = \ _addBang _ppVar ->+ {-# LINE 386 "src-ag/PrintCleanCode.ag" #-}+ _addBang $ _ppVar+ {-# LINE 3177 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule342 #-}+ {-# LINE 396 "src-ag/PrintCleanCode.ag" #-}+ rule342 = \ (_ :: ()) ->+ {-# LINE 396 "src-ag/PrintCleanCode.ag" #-}+ False+ {-# LINE 3191 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule351 #-}+ {-# LINE 402 "src-ag/PrintCleanCode.ag" #-}+ rule351 = \ (_ :: ()) ->+ {-# LINE 402 "src-ag/PrintCleanCode.ag" #-}+ True+ {-# LINE 3258 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule359 #-}+ {-# LINE 397 "src-ag/PrintCleanCode.ag" #-}+ rule359 = \ (_ :: ()) ->+ {-# LINE 397 "src-ag/PrintCleanCode.ag" #-}+ True+ {-# LINE 3312 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule360 #-}+ {-# LINE 423 "src-ag/PrintCleanCode.ag" #-}+ rule360 = \ (_ :: ()) ->+ {-# LINE 423 "src-ag/PrintCleanCode.ag" #-}+ text "_"+ {-# LINE 3318 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule376 #-}+ {-# LINE 414 "src-ag/PrintCleanCode.ag" #-}+ rule376 = \ (_ :: ()) ->+ {-# LINE 414 "src-ag/PrintCleanCode.ag" #-}+ []+ {-# LINE 3457 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule381 #-}+ {-# LINE 65 "src-ag/PrintCleanCode.ag" #-}+ rule381 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 65 "src-ag/PrintCleanCode.ag" #-}+ nest _lhsIoptions+ {-# LINE 3541 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule382 #-}+ {-# LINE 101 "src-ag/PrintCleanCode.ag" #-}+ rule382 = \ ((_chunksIpps) :: PP_Docs) ->+ {-# LINE 101 "src-ag/PrintCleanCode.ag" #-}+ _chunksIpps+ {-# LINE 3547 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule383 #-}+ {-# LINE 437 "src-ag/PrintCleanCode.ag" #-}+ rule383 = \ (_ :: ()) ->+ {-# LINE 437 "src-ag/PrintCleanCode.ag" #-}+ False+ {-# LINE 3553 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule384 #-}+ {-# LINE 471 "src-ag/PrintCleanCode.ag" #-}+ rule384 = \ ((_lhsImainFile) :: String) ->+ {-# LINE 471 "src-ag/PrintCleanCode.ag" #-}+ _lhsImainFile+ {-# LINE 3559 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule433 #-}+ {-# LINE 298 "src-ag/PrintCleanCode.ag" #-}+ rule433 = \ ((_tpIpp) :: PP_Doc) ->+ {-# LINE 298 "src-ag/PrintCleanCode.ag" #-}+ "[" >|< _tpIpp >|< "]"+ {-# LINE 3971 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule474 #-}+ {-# LINE 319 "src-ag/PrintCleanCode.ag" #-}+ rule474 = \ (_ :: ()) ->+ {-# LINE 319 "src-ag/PrintCleanCode.ag" #-}+ text "'Data.IntSet'.IntSet"+ {-# LINE 4305 "src-generated/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 "src-generated/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 "src-generated/PrintCleanCode.hs" #-}+ {-# INLINE rule483 #-}+ rule483 = \ (_ :: ()) ->+ []+ {-# INLINE rule484 #-}+ rule484 = \ _copy ->+ _copy
src-generated/PrintCode.hs view
@@ -1,4135 +1,4135 @@-{-# 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"#-} +{-# 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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}++{-# LINE 23 "src-ag/PrintCode.ag" #-}+ +type PP_Docs = [PP_Doc] +{-# LINE 60 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}++{-# LINE 404 "src-ag/PrintCode.ag" #-}+ +locname' :: Identifier -> [Char] +locname' n = "_loc_" ++ getName n +{-# LINE 94 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule1 #-}+ {-# LINE 428 "src-ag/PrintCode.ag" #-}+ rule1 = \ (_ :: ()) ->+ {-# LINE 428 "src-ag/PrintCode.ag" #-}+ False+ {-# LINE 182 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule22 #-}+ {-# LINE 525 "src-ag/PrintCode.ag" #-}+ rule22 = \ semNames_ ->+ {-# LINE 525 "src-ag/PrintCode.ag" #-}+ concat $ intersperse "," semNames_+ {-# LINE 459 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule156 #-}+ {-# LINE 420 "src-ag/PrintCode.ag" #-}+ rule156 = \ (_ :: ()) ->+ {-# LINE 420 "src-ag/PrintCode.ag" #-}+ True+ {-# LINE 1553 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule171 #-}+ {-# LINE 422 "src-ag/PrintCode.ag" #-}+ rule171 = \ (_ :: ()) ->+ {-# LINE 422 "src-ag/PrintCode.ag" #-}+ False+ {-# LINE 1656 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule230 #-}+ {-# LINE 424 "src-ag/PrintCode.ag" #-}+ rule230 = \ (_ :: ()) ->+ {-# LINE 424 "src-ag/PrintCode.ag" #-}+ False+ {-# LINE 2154 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule261 #-}+ {-# LINE 385 "src-ag/PrintCode.ag" #-}+ rule261 = \ (_ :: ()) ->+ {-# LINE 385 "src-ag/PrintCode.ag" #-}+ False+ {-# LINE 2435 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule265 #-}+ {-# LINE 385 "src-ag/PrintCode.ag" #-}+ rule265 = \ (_ :: ()) ->+ {-# LINE 385 "src-ag/PrintCode.ag" #-}+ False+ {-# LINE 2470 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule270 #-}+ {-# LINE 239 "src-ag/PrintCode.ag" #-}+ rule270 = \ comps_ ->+ {-# LINE 239 "src-ag/PrintCode.ag" #-}+ not (null comps_)+ {-# LINE 2512 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule275 #-}+ {-# LINE 239 "src-ag/PrintCode.ag" #-}+ rule275 = \ comps_ ->+ {-# LINE 239 "src-ag/PrintCode.ag" #-}+ not (null comps_)+ {-# LINE 2562 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule299 #-}+ {-# LINE 373 "src-ag/PrintCode.ag" #-}+ rule299 = \ (_ :: ()) ->+ {-# LINE 373 "src-ag/PrintCode.ag" #-}+ False+ {-# LINE 2892 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule309 #-}+ {-# LINE 374 "src-ag/PrintCode.ag" #-}+ rule309 = \ (_ :: ()) ->+ {-# LINE 374 "src-ag/PrintCode.ag" #-}+ False+ {-# LINE 2963 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule319 #-}+ {-# LINE 343 "src-ag/PrintCode.ag" #-}+ rule319 = \ _strictPatVars _strictVar ->+ {-# LINE 343 "src-ag/PrintCode.ag" #-}+ _strictVar ++ _strictPatVars+ {-# LINE 3040 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule322 #-}+ {-# LINE 365 "src-ag/PrintCode.ag" #-}+ rule322 = \ _addBang _ppVar ->+ {-# LINE 365 "src-ag/PrintCode.ag" #-}+ _addBang $ _ppVar+ {-# LINE 3060 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule324 #-}+ {-# LINE 375 "src-ag/PrintCode.ag" #-}+ rule324 = \ (_ :: ()) ->+ {-# LINE 375 "src-ag/PrintCode.ag" #-}+ False+ {-# LINE 3074 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule333 #-}+ {-# LINE 381 "src-ag/PrintCode.ag" #-}+ rule333 = \ (_ :: ()) ->+ {-# LINE 381 "src-ag/PrintCode.ag" #-}+ True+ {-# LINE 3141 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule341 #-}+ {-# LINE 376 "src-ag/PrintCode.ag" #-}+ rule341 = \ (_ :: ()) ->+ {-# LINE 376 "src-ag/PrintCode.ag" #-}+ True+ {-# LINE 3195 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule342 #-}+ {-# LINE 402 "src-ag/PrintCode.ag" #-}+ rule342 = \ (_ :: ()) ->+ {-# LINE 402 "src-ag/PrintCode.ag" #-}+ text "_"+ {-# LINE 3201 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule358 #-}+ {-# LINE 393 "src-ag/PrintCode.ag" #-}+ rule358 = \ (_ :: ()) ->+ {-# LINE 393 "src-ag/PrintCode.ag" #-}+ []+ {-# LINE 3340 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule363 #-}+ {-# LINE 61 "src-ag/PrintCode.ag" #-}+ rule363 = \ ((_lhsIoptions) :: Options) ->+ {-# LINE 61 "src-ag/PrintCode.ag" #-}+ nest _lhsIoptions+ {-# LINE 3424 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule364 #-}+ {-# LINE 93 "src-ag/PrintCode.ag" #-}+ rule364 = \ ((_chunksIpps) :: PP_Docs) ->+ {-# LINE 93 "src-ag/PrintCode.ag" #-}+ _chunksIpps+ {-# LINE 3430 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule365 #-}+ {-# LINE 416 "src-ag/PrintCode.ag" #-}+ rule365 = \ (_ :: ()) ->+ {-# LINE 416 "src-ag/PrintCode.ag" #-}+ False+ {-# LINE 3436 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule366 #-}+ {-# LINE 450 "src-ag/PrintCode.ag" #-}+ rule366 = \ ((_lhsImainFile) :: String) ->+ {-# LINE 450 "src-ag/PrintCode.ag" #-}+ _lhsImainFile+ {-# LINE 3442 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule381 #-}+ {-# LINE 260 "src-ag/PrintCode.ag" #-}+ rule381 = \ _l _r ->+ {-# LINE 260 "src-ag/PrintCode.ag" #-}+ _l >#< "->" >-< _r+ {-# LINE 3591 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule403 #-}+ {-# LINE 279 "src-ag/PrintCode.ag" #-}+ rule403 = \ ((_tpIpp) :: PP_Doc) ->+ {-# LINE 279 "src-ag/PrintCode.ag" #-}+ "[" >|< _tpIpp >|< "]"+ {-# LINE 3795 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}+ {-# INLINE rule428 #-}+ {-# LINE 300 "src-ag/PrintCode.ag" #-}+ rule428 = \ (_ :: ()) ->+ {-# LINE 300 "src-ag/PrintCode.ag" #-}+ text "Data.IntSet.IntSet"+ {-# LINE 4057 "src-generated/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 "src-generated/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 "src-generated/PrintCode.hs" #-}
src-generated/PrintErrorMessages.hs view
@@ -1,1665 +1,1665 @@-{-# 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<n = xs ++ replicate (n-k) ' ' - | otherwise = xs - where k = length xs - -showEdge :: ((Identifier,Identifier),[String],[String]) -> 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 "<attr>") >#< "= ...") - 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_ >#< "<field>.<attr> = " - >#< "..." >#< "@" >|< 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_ >#< "<field>.<attr> = " - >#< "..." >#< 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.<some attribte>" >#< "...") - 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"#-} +{-# 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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintErrorMessages.hs" #-}++{-# LINE 548 "src-ag/PrintErrorMessages.ag" #-}+ +toWidth :: Int -> String -> String +toWidth n xs | k<n = xs ++ replicate (n-k) ' ' + | otherwise = xs + where k = length xs + +showEdge :: ((Identifier,Identifier),[String],[String]) -> 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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "<attr>") >#< "= ...")+ 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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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_ >#< "<field>.<attr> = "+ >#< "..." >#< "@" >|< 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 "src-generated/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 "src-generated/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_ >#< "<field>.<attr> = "+ >#< "..." >#< 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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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.<some attribte>" >#< "...")+ 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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintErrorMessages.hs" #-}+ {-# INLINE rule108 #-}+ {-# LINE 82 "src-ag/PrintErrorMessages.ag" #-}+ rule108 = \ ((_lhsIdups) :: [String]) _str ->+ {-# LINE 82 "src-ag/PrintErrorMessages.ag" #-}+ _str : _lhsIdups+ {-# LINE 1632 "src-generated/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 "src-generated/PrintErrorMessages.hs" #-}+ {-# INLINE rule113 #-}+ {-# LINE 83 "src-ag/PrintErrorMessages.ag" #-}+ rule113 = \ (_ :: ()) ->+ {-# LINE 83 "src-ag/PrintErrorMessages.ag" #-}+ text ""+ {-# LINE 1666 "src-generated/PrintErrorMessages.hs" #-}
src-generated/PrintOcamlCode.hs view
@@ -1,2662 +1,2662 @@-{-# 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"#-} +{-# 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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintOcamlCode.hs" #-}++{-# LINE 177 "src-ag/PrintOcamlCode.ag" #-}+ +toOcamlTC :: String -> String +toOcamlTC (c:cs) = toLower c : cs +toOcamlTC xs = xs +{-# LINE 78 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintOcamlCode.hs" #-}+ {-# INLINE rule62 #-}+ {-# LINE 220 "src-ag/PrintOcamlCode.ag" #-}+ rule62 = \ (_ :: ()) ->+ {-# LINE 220 "src-ag/PrintOcamlCode.ag" #-}+ False+ {-# LINE 1059 "src-generated/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 "src-generated/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 "src-generated/PrintOcamlCode.hs" #-}+ {-# INLINE rule69 #-}+ {-# LINE 222 "src-ag/PrintOcamlCode.ag" #-}+ rule69 = \ (_ :: ()) ->+ {-# LINE 222 "src-ag/PrintOcamlCode.ag" #-}+ False+ {-# LINE 1132 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintOcamlCode.hs" #-}+ {-# INLINE rule121 #-}+ {-# LINE 204 "src-ag/PrintOcamlCode.ag" #-}+ rule121 = \ (_ :: ()) ->+ {-# LINE 204 "src-ag/PrintOcamlCode.ag" #-}+ False+ {-# LINE 1919 "src-generated/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 "src-generated/PrintOcamlCode.hs" #-}+ {-# INLINE rule126 #-}+ {-# LINE 205 "src-ag/PrintOcamlCode.ag" #-}+ rule126 = \ (_ :: ()) ->+ {-# LINE 205 "src-ag/PrintOcamlCode.ag" #-}+ False+ {-# LINE 1960 "src-generated/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 "src-generated/PrintOcamlCode.hs" #-}+ {-# INLINE rule131 #-}+ {-# LINE 206 "src-ag/PrintOcamlCode.ag" #-}+ rule131 = \ (_ :: ()) ->+ {-# LINE 206 "src-ag/PrintOcamlCode.ag" #-}+ False+ {-# LINE 2003 "src-generated/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 "src-generated/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 "src-generated/PrintOcamlCode.hs" #-}+ {-# INLINE rule141 #-}+ {-# LINE 207 "src-ag/PrintOcamlCode.ag" #-}+ rule141 = \ (_ :: ()) ->+ {-# LINE 207 "src-ag/PrintOcamlCode.ag" #-}+ True+ {-# LINE 2079 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintOcamlCode.hs" #-}+ {-# INLINE rule153 #-}+ {-# LINE 216 "src-ag/PrintOcamlCode.ag" #-}+ rule153 = \ (_ :: ()) ->+ {-# LINE 216 "src-ag/PrintOcamlCode.ag" #-}+ True+ {-# LINE 2242 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/PrintOcamlCode.hs" #-}
src-generated/PrintVisitCode.hs view
@@ -1,966 +1,966 @@-{-# 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 +{-# LANGUAGE Rank2Types, GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module PrintVisitCode where+{-# LINE 2 "src-ag/DeclBlocks.ag" #-}+ +import Code (Decl,Expr) +{-# LINE 9 "src-generated/PrintVisitCode.hs" #-}++{-# LINE 2 "src-ag/Patterns.ag" #-}+ +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 16 "src-generated/PrintVisitCode.hs" #-}++{-# LINE 2 "src-ag/CodeSyntax.ag" #-}+ +import Patterns +import CommonTypes +import Data.Map(Map) +import Data.Set(Set) +{-# LINE 24 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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
src-generated/ResolveLocals.hs view
@@ -1,2005 +1,2005 @@-{-# 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 +{-# LANGUAGE Rank2Types, GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module ResolveLocals where+{-# LINE 2 "src-ag/Expression.ag" #-}+ +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 10 "src-generated/ResolveLocals.hs" #-}++{-# LINE 2 "src-ag/Patterns.ag" #-}+ +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 17 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ResolveLocals.hs" #-}+ {-# INLINE rule36 #-}+ {-# LINE 157 "src-ag/ResolveLocals.ag" #-}+ rule36 = \ _newTks pos_ ->+ {-# LINE 157 "src-ag/ResolveLocals.ag" #-}+ Expression pos_ _newTks+ {-# LINE 387 "src-generated/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 "src-generated/ResolveLocals.hs" #-}+ {-# INLINE rule40 #-}+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}+ rule40 = \ ((_nontsIsynMap') :: Map Identifier Attributes) ->+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}+ _nontsIsynMap'+ {-# LINE 458 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ResolveLocals.hs" #-}+ {-# INLINE rule49 #-}+ {-# LINE 63 "src-ag/ResolveLocals.ag" #-}+ rule49 = \ ((_prodsIcons) :: [ConstructorIdent]) nt_ ->+ {-# LINE 63 "src-ag/ResolveLocals.ag" #-}+ [(nt_,_prodsIcons)]+ {-# LINE 563 "src-generated/ResolveLocals.hs" #-}+ {-# INLINE rule50 #-}+ {-# LINE 111 "src-ag/ResolveLocals.ag" #-}+ rule50 = \ nt_ ->+ {-# LINE 111 "src-ag/ResolveLocals.ag" #-}+ nt_+ {-# LINE 569 "src-generated/ResolveLocals.hs" #-}+ {-# INLINE rule51 #-}+ {-# LINE 114 "src-ag/ResolveLocals.ag" #-}+ rule51 = \ inh_ ->+ {-# LINE 114 "src-ag/ResolveLocals.ag" #-}+ inh_+ {-# LINE 575 "src-generated/ResolveLocals.hs" #-}+ {-# INLINE rule52 #-}+ {-# LINE 115 "src-ag/ResolveLocals.ag" #-}+ rule52 = \ syn_ ->+ {-# LINE 115 "src-ag/ResolveLocals.ag" #-}+ syn_+ {-# LINE 581 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/ResolveLocals.hs" #-}+ {-# INLINE rule158 #-}+ {-# LINE 73 "src-ag/ResolveLocals.ag" #-}+ rule158 = \ ((_childrenIfields) :: [(Identifier,Type,ChildKind)]) ->+ {-# LINE 73 "src-ag/ResolveLocals.ag" #-}+ _childrenIfields+ {-# LINE 1339 "src-generated/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 "src-generated/ResolveLocals.hs" #-}+ {-# INLINE rule160 #-}+ {-# LINE 78 "src-ag/ResolveLocals.ag" #-}+ rule160 = \ ((_lhsIinh) :: Attributes) ->+ {-# LINE 78 "src-ag/ResolveLocals.ag" #-}+ Map.keys _lhsIinh+ {-# LINE 1354 "src-generated/ResolveLocals.hs" #-}+ {-# INLINE rule161 #-}+ {-# LINE 79 "src-ag/ResolveLocals.ag" #-}+ rule161 = \ ((_lhsIsyn) :: Attributes) ->+ {-# LINE 79 "src-ag/ResolveLocals.ag" #-}+ Map.keys _lhsIsyn+ {-# LINE 1360 "src-generated/ResolveLocals.hs" #-}+ {-# INLINE rule162 #-}+ {-# LINE 107 "src-ag/ResolveLocals.ag" #-}+ rule162 = \ con_ ->+ {-# LINE 107 "src-ag/ResolveLocals.ag" #-}+ con_+ {-# LINE 1366 "src-generated/ResolveLocals.hs" #-}+ {-# INLINE rule163 #-}+ {-# LINE 109 "src-ag/ResolveLocals.ag" #-}+ rule163 = \ con_ ->+ {-# LINE 109 "src-ag/ResolveLocals.ag" #-}+ con_+ {-# LINE 1372 "src-generated/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 "src-generated/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
src-generated/SemHsTokens.hs view
@@ -1,689 +1,689 @@-{-# 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 +{-# LANGUAGE Rank2Types, GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module SemHsTokens where+{-# LINE 2 "src-ag/HsToken.ag" #-}+ +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 10 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/SemHsTokens.hs" #-}+ {-# INLINE rule38 #-}+ {-# LINE 136 "src-ag/SemHsTokens.ag" #-}+ rule38 = \ pos_ ->+ {-# LINE 136 "src-ag/SemHsTokens.ag" #-}+ (pos_, "")+ {-# LINE 380 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/SemHsTokens.hs" #-}+ {-# INLINE rule73 #-}+ {-# LINE 108 "src-ag/SemHsTokens.ag" #-}+ rule73 = \ ((_tokensIusedFields) :: Seq Identifier) ->+ {-# LINE 108 "src-ag/SemHsTokens.ag" #-}+ toList _tokensIusedFields+ {-# LINE 654 "src-generated/SemHsTokens.hs" #-}+ {-# INLINE rule74 #-}+ {-# LINE 115 "src-ag/SemHsTokens.ag" #-}+ rule74 = \ ((_tokensItks) :: [(Pos,String)]) ->+ {-# LINE 115 "src-ag/SemHsTokens.ag" #-}+ showTokens _tokensItks+ {-# LINE 660 "src-generated/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
src-generated/TfmToVisage.hs view
@@ -1,1324 +1,1324 @@-{-# 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 +{-# LANGUAGE Rank2Types, GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module TfmToVisage where+{-# LINE 2 "src-ag/Expression.ag" #-}+ +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 10 "src-generated/TfmToVisage.hs" #-}++{-# LINE 2 "src-ag/Patterns.ag" #-}+ +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 17 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/TfmToVisage.hs" #-}+ {-# INLINE rule15 #-}+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}+ rule15 = \ ((_nontsIsynMap') :: Map Identifier Attributes) ->+ {-# LINE 16 "src-ag/DistChildAttr.ag" #-}+ _nontsIsynMap'+ {-# LINE 372 "src-generated/TfmToVisage.hs" #-}+ {-# INLINE rule16 #-}+ {-# LINE 90 "src-ag/TfmToVisage.ag" #-}+ rule16 = \ ((_nontsIvnonts) :: [VisageNonterminal]) ->+ {-# LINE 90 "src-ag/TfmToVisage.ag" #-}+ VGrammar _nontsIvnonts+ {-# LINE 378 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/TfmToVisage.hs" #-}+ {-# INLINE rule45 #-}+ {-# LINE 147 "src-ag/TfmToVisage.ag" #-}+ rule45 = \ attr_ field_ ->+ {-# LINE 147 "src-ag/TfmToVisage.ag" #-}+ [(field_, attr_)]+ {-# LINE 717 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/TfmToVisage.hs" #-}+ {-# INLINE rule75 #-}+ {-# LINE 111 "src-ag/TfmToVisage.ag" #-}+ rule75 = \ ((_rulesIvrules) :: [VisageRule]) ->+ {-# LINE 111 "src-ag/TfmToVisage.ag" #-}+ splitVRules _rulesIvrules+ {-# LINE 994 "src-generated/TfmToVisage.hs" #-}+ {-# INLINE rule76 #-}+ {-# LINE 112 "src-ag/TfmToVisage.ag" #-}+ rule76 = \ _splitVRules ->+ {-# LINE 112 "src-ag/TfmToVisage.ag" #-}+ getForField "loc" _splitVRules+ {-# LINE 1000 "src-generated/TfmToVisage.hs" #-}+ {-# INLINE rule77 #-}+ {-# LINE 113 "src-ag/TfmToVisage.ag" #-}+ rule77 = \ _splitVRules ->+ {-# LINE 113 "src-ag/TfmToVisage.ag" #-}+ getForField "lhs" _splitVRules+ {-# LINE 1006 "src-generated/TfmToVisage.hs" #-}+ {-# INLINE rule78 #-}+ {-# LINE 114 "src-ag/TfmToVisage.ag" #-}+ rule78 = \ _splitVRules ->+ {-# LINE 114 "src-ag/TfmToVisage.ag" #-}+ _splitVRules+ {-# LINE 1012 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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
src-generated/Transform.hs view
@@ -1,6258 +1,6258 @@-{-# 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 "<unknown>") 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 = \ (_ :: ()) -> - [] +{-# 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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}++{-# LINE 124 "src-ag/Transform.ag" #-}+type FieldMap = [(Identifier, Type)] +{-# LINE 52 "src-generated/Transform.hs" #-}++{-# LINE 125 "src-ag/Transform.ag" #-}+type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap) +{-# LINE 56 "src-generated/Transform.hs" #-}++{-# LINE 148 "src-ag/Transform.ag" #-}+type AttrName = (Identifier,Identifier) +{-# LINE 60 "src-generated/Transform.hs" #-}++{-# LINE 149 "src-ag/Transform.ag" #-}+type RuleInfo = (Maybe Identifier, [AttrName]->Pattern, Expression, [AttrName], Bool, String, Bool, Bool) +{-# LINE 64 "src-generated/Transform.hs" #-}++{-# LINE 150 "src-ag/Transform.ag" #-}+type SigInfo = (Identifier,Type) +{-# LINE 68 "src-generated/Transform.hs" #-}++{-# LINE 151 "src-ag/Transform.ag" #-}+type UniqueInfo = (Identifier,Identifier) +{-# LINE 72 "src-generated/Transform.hs" #-}++{-# LINE 152 "src-ag/Transform.ag" #-}+type AugmentInfo = (Identifier,Expression)+{-# LINE 76 "src-generated/Transform.hs" #-}++{-# LINE 153 "src-ag/Transform.ag" #-}+type AroundInfo = (Identifier,Expression)+{-# LINE 80 "src-generated/Transform.hs" #-}++{-# LINE 154 "src-ag/Transform.ag" #-}+type MergeInfo = (Identifier, Identifier, [Identifier], Expression)+{-# LINE 84 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}++{-# LINE 958 "src-ag/Transform.ag" #-}+ +mergeParams :: ParamMap -> ParamMap -> ParamMap +mergeParams = Map.unionWith (++) +{-# LINE 373 "src-generated/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 "src-generated/Transform.hs" #-}++{-# LINE 1000 "src-ag/Transform.ag" #-}+ +mergeQuant :: QuantMap -> QuantMap -> QuantMap +mergeQuant = Map.unionWith (++) +{-# LINE 387 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}++{-# LINE 1216 "src-ag/Transform.ag" #-}+ +-- We want the last Just in the list +flipmplus = flip mplus +{-# LINE 424 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "<unknown>") 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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule32 #-}+ {-# LINE 324 "src-ag/Transform.ag" #-}+ rule32 = \ (_ :: ()) ->+ {-# LINE 324 "src-ag/Transform.ag" #-}+ let+ in Seq.empty+ {-# LINE 865 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule46 #-}+ {-# LINE 1030 "src-ag/Transform.ag" #-}+ rule46 = \ (_ :: ()) ->+ {-# LINE 1030 "src-ag/Transform.ag" #-}+ Map.empty+ {-# LINE 957 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule51 #-}+ {-# LINE 1351 "src-ag/Transform.ag" #-}+ rule51 = \ (_ :: ()) ->+ {-# LINE 1351 "src-ag/Transform.ag" #-}+ Map.empty+ {-# LINE 992 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule87 #-}+ {-# LINE 1063 "src-ag/Transform.ag" #-}+ rule87 = \ _errors _errors1 ->+ {-# LINE 1063 "src-ag/Transform.ag" #-}+ _errors Seq.>< _errors1+ {-# LINE 1346 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule91 #-}+ {-# LINE 777 "src-ag/Transform.ag" #-}+ rule91 = \ name_ ->+ {-# LINE 777 "src-ag/Transform.ag" #-}+ \_ -> Set.singleton name_+ {-# LINE 1421 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule106 #-}+ {-# LINE 1033 "src-ag/Transform.ag" #-}+ rule106 = \ ((_namesInontSet) :: Set NontermIdent) ->+ {-# LINE 1033 "src-ag/Transform.ag" #-}+ _namesInontSet+ {-# LINE 1684 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule146 #-}+ {-# LINE 600 "src-ag/Transform.ag" #-}+ rule146 = \ name_ ->+ {-# LINE 600 "src-ag/Transform.ag" #-}+ Set.singleton name_+ {-# LINE 1887 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule149 #-}+ {-# LINE 700 "src-ag/Transform.ag" #-}+ rule149 = \ _argType name_ ->+ {-# LINE 700 "src-ag/Transform.ag" #-}+ [(name_,_argType)]+ {-# LINE 1949 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule180 #-}+ {-# LINE 1034 "src-ag/Transform.ag" #-}+ rule180 = \ ((_namesInontSet) :: Set NontermIdent) ->+ {-# LINE 1034 "src-ag/Transform.ag" #-}+ _namesInontSet+ {-# LINE 2150 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule221 #-}+ {-# LINE 1035 "src-ag/Transform.ag" #-}+ rule221 = \ ((_namesInontSet) :: Set NontermIdent) ->+ {-# LINE 1035 "src-ag/Transform.ag" #-}+ _namesInontSet+ {-# LINE 2381 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule264 #-}+ {-# LINE 189 "src-ag/Transform.ag" #-}+ rule264 = \ lines_ pos_ ->+ {-# LINE 189 "src-ag/Transform.ag" #-}+ [(lines_, pos_)]+ {-# LINE 2592 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule298 #-}+ {-# LINE 728 "src-ag/Transform.ag" #-}+ rule298 = \ _defSets2 ->+ {-# LINE 728 "src-ag/Transform.ag" #-}+ _defSets2+ {-# LINE 2805 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule625 #-}+ {-# LINE 1201 "src-ag/Transform.ag" #-}+ rule625 = \ name_ ->+ {-# LINE 1201 "src-ag/Transform.ag" #-}+ getPos name_+ {-# LINE 4831 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule631 #-}+ {-# LINE 1202 "src-ag/Transform.ag" #-}+ rule631 = \ pos_ ->+ {-# LINE 1202 "src-ag/Transform.ag" #-}+ pos_+ {-# LINE 4878 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule639 #-}+ {-# LINE 1203 "src-ag/Transform.ag" #-}+ rule639 = \ field_ ->+ {-# LINE 1203 "src-ag/Transform.ag" #-}+ getPos field_+ {-# LINE 4937 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule649 #-}+ {-# LINE 1204 "src-ag/Transform.ag" #-}+ rule649 = \ pos_ ->+ {-# LINE 1204 "src-ag/Transform.ag" #-}+ pos_+ {-# LINE 5020 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule719 #-}+ {-# LINE 1165 "src-ag/Transform.ag" #-}+ rule719 = \ ident_ tp_ ->+ {-# LINE 1165 "src-ag/Transform.ag" #-}+ [ (ident_, tp_) ]+ {-# LINE 5682 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Transform.hs" #-}+ {-# INLINE rule779 #-}+ {-# LINE 930 "src-ag/Transform.ag" #-}+ rule779 = \ _dependency ->+ {-# LINE 930 "src-ag/Transform.ag" #-}+ Set.fromList _dependency+ {-# LINE 6069 "src-generated/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 = \ (_ :: ()) ->+ []
src-generated/Visage.hs view
@@ -1,902 +1,902 @@-{-# 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"#-} +{-# LANGUAGE Rank2Types, GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Visage where+{-# LINE 2 "src-ag/Expression.ag" #-}+ +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 10 "src-generated/Visage.hs" #-}++{-# LINE 2 "src-ag/VisagePatterns.ag" #-}+ +import UU.Scanner.Position(Pos) +import CommonTypes +{-# LINE 16 "src-generated/Visage.hs" #-}++{-# LINE 2 "src-ag/VisageSyntax.ag" #-}+ +import CommonTypes +import UU.Pretty +import AbstractSyntax +import VisagePatterns +import Expression +{-# LINE 25 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Visage.hs" #-}+ {-# INLINE rule2 #-}+ {-# LINE 89 "src-ag/Visage.ag" #-}+ rule2 = \ (_ :: ()) ->+ {-# LINE 89 "src-ag/Visage.ag" #-}+ False+ {-# LINE 176 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Visage.hs" #-}+ {-# INLINE rule17 #-}+ {-# LINE 76 "src-ag/Visage.ag" #-}+ rule17 = \ (_ :: ()) ->+ {-# LINE 76 "src-ag/Visage.ag" #-}+ True+ {-# LINE 693 "src-generated/Visage.hs" #-}+ {-# INLINE rule18 #-}+ {-# LINE 77 "src-ag/Visage.ag" #-}+ rule18 = \ (_ :: ()) ->+ {-# LINE 77 "src-ag/Visage.ag" #-}+ False+ {-# LINE 699 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/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 "src-generated/Visage.hs" #-}
src-generated/VisagePatterns.hs view
@@ -1,42 +1,42 @@- - --- UUAGC 0.9.51 (src-ag/VisagePatterns.ag) -module VisagePatterns where -{-# LINE 2 "src-ag/VisagePatterns.ag" #-} +++-- UUAGC 0.9.53 (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: --} +{-# LINE 10 "src-generated/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]
src-generated/VisageSyntax.hs view
@@ -1,97 +1,97 @@- - --- UUAGC 0.9.51 (src-ag/VisageSyntax.ag) -module VisageSyntax where -{-# LINE 2 "src-ag/VisageSyntax.ag" #-} +++-- UUAGC 0.9.53 (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: --} +{-# LINE 13 "src-generated/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]
src/ATermAbstractSyntax.hs view
@@ -1,9 +1,9 @@ {----------------------------------------------------------------------------- - Haskell ATerm Library - - Joost Visser - CWI, Amsterdam + 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.
src/LOAG/Chordal.hs view
@@ -138,7 +138,13 @@ f_idst <- freeze idst f_edp <- freeze edp return ((f_idsf,f_idst),f_edp) - where addEdges (f,t) es (idsf,idst) edp = do + where addEdges + :: (Vertex, Vertex) + -> [(Vertex, Vertex)] + -> (IOArray Vertex Vertices, IOArray Vertex Vertices) + -> IOArray Vertex Vertices + -> IO [()] + 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
src/LOAG/Optimise.hs view
@@ -148,7 +148,7 @@ vars <- tryExtreme sat des literals assertVars sat vars return True - where literals = M.foldWithKey select [] varMap + where literals = M.foldrWithKey select [] varMap select k a b | fst k == f = a : b --inh | snd k == f = varnot a : b --syn | otherwise = b @@ -205,7 +205,11 @@ newsched | newmx < oldmx = newinterface | otherwise = sched return $ (newmx < oldmx, newsched) - where addEdges (f,t) (idsf,idst) = do + where addEdges + :: (Vertex, Vertex) + -> (IOArray Vertex Vertices, IOArray Vertex Vertices) + -> IO () + addEdges (f,t) (idsf,idst) = do modifyArray idsf f (t `IS.insert`) modifyArray idst t (f `IS.insert`)
uuagc.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.10 build-type: Custom name: uuagc -version: 0.9.53 +version: 0.9.53.1 license: BSD3 license-file: LICENSE maintainer: Jeroen Bransen <J.Bransen@uu.nl> @@ -16,10 +16,8 @@ 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 +extra-source-files: src-ag/*.ag +extra-source-files: src-ag/LOAG/*.ag -- This flag will be set by Setup.hs, use -- cabal configure --ghc-options="-DEXTERNAL_UUAGC" @@ -34,7 +32,7 @@ manual: True custom-setup - setup-depends: base, Cabal + setup-depends: base, Cabal, uuagc-cabal executable uuagc build-depends: uuagc-cabal >= 1.0.2.0