diff --git a/src-ag/ExecutionPlan.ag b/src-ag/ExecutionPlan.ag --- a/src-ag/ExecutionPlan.ag +++ b/src-ag/ExecutionPlan.ag @@ -33,7 +33,7 @@ params : {[Identifier]} classCtxs : {ClassContext} -- class context at the datatype level initial : {StateIdentifier} - initialv : {Maybe VisitIdentifier} + 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 diff --git a/src-ag/ExecutionPlan2Caml.ag b/src-ag/ExecutionPlan2Caml.ag --- a/src-ag/ExecutionPlan2Caml.ag +++ b/src-ag/ExecutionPlan2Caml.ag @@ -617,8 +617,8 @@ >-< @loc.wrapperBody loc.wrapperBody = case @initialv of - Nothing -> text "{ }" -- case where there are no inherited or synthesized attributes - Just initv -> + [] -> 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 diff --git a/src-ag/ExecutionPlan2Clean.ag b/src-ag/ExecutionPlan2Clean.ag --- a/src-ag/ExecutionPlan2Clean.ag +++ b/src-ag/ExecutionPlan2Clean.ag @@ -540,8 +540,8 @@ >-< indent 3 (case @initialv of -- case where there are no inherited or synthesized attributes - Nothing -> text @loc.synname -- TODO : Remove? >#< " { }" - Just initv -> + [] -> 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 diff --git a/src-ag/ExecutionPlan2Hs.ag b/src-ag/ExecutionPlan2Hs.ag --- a/src-ag/ExecutionPlan2Hs.ag +++ b/src-ag/ExecutionPlan2Hs.ag @@ -469,31 +469,42 @@ >-< indent 3 (case @initialv of -- case where there are no inherited or synthesized attributes - Nothing -> @loc.synname >#< " { }" - Just initv -> - 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 + [] -> @loc.synname >#< " { }" + initvs@(initv:_) -> + let 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 "return" - VisitMonadic -> 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) - >-< "let" >#< @loc.addbangWrap (pp "arg") >#< "=" >#< arg - >-< pat >#< "<-" >#< convert >#< pp_parens ("inv_" >|< @nt >|< "_s" >|< @initial >#< "sem" >#< ind >#< "arg" >#< extra) -- invoke initial state (of the root) + >-< vlist (genSteps @initial initvs) >-< "return" >#< pp_parens (@loc.synname >#< ppSpaced @loc.synlist) ) ) diff --git a/src-ag/KWOrder.ag b/src-ag/KWOrder.ag --- a/src-ag/KWOrder.ag +++ b/src-ag/KWOrder.ag @@ -3,6 +3,8 @@ INCLUDE "Expression.ag" INCLUDE "Patterns.ag" INCLUDE "DistChildAttr.ag" +INCLUDE "ExecutionPlanPre.ag" +INCLUDE "ExecutionPlanCommon.ag" imports { @@ -28,158 +30,6 @@ } ------------------------------------------------------------------------------- --- Distributing options -------------------------------------------------------------------------------- -ATTR Grammar Nonterminals Nonterminal Productions Production Children Child - [ options : {Options} | | ] - -------------------------------------------------------------------------------- --- Give unique names to rules -------------------------------------------------------------------------------- -ATTR Nonterminal Nonterminals - Production Productions - Rule Rules [ | rulenumber : Int | ] - -SEM Grammar - | Grammar nonts.rulenumber = 0 - -SEM Rule - | Rule lhs.rulenumber = @lhs.rulenumber + 1 - loc.rulename = maybe (identifier $ "rule" ++ show @lhs.rulenumber) id @mbName - -------------------------------------------------------------------------------- --- Find out which nonterminals are recursive -------------------------------------------------------------------------------- - -ATTR Nonterminals Nonterminal [ | | ntDeps, ntHoDeps USE {`mappend`} {mempty} : {Map NontermIdent (Set NontermIdent)} ] -ATTR Nonterminals Nonterminal [ closedNtDeps, closedHoNtDeps, closedHoNtRevDeps : {Map NontermIdent (Set NontermIdent)} | | ] -ATTR Productions Production Children Child [ | | refNts, refHoNts USE {`mappend`} {mempty} : {Set NontermIdent} ] - -SEM Nonterminal | Nonterminal - lhs.ntDeps = Map.singleton @nt @prods.refNts - lhs.ntHoDeps = Map.singleton @nt @prods.refHoNts - - loc.closedNtDeps = Map.findWithDefault Set.empty @nt @lhs.closedNtDeps - loc.closedHoNtDeps = Map.findWithDefault Set.empty @nt @lhs.closedHoNtDeps - loc.closedHoNtRevDeps = Map.findWithDefault Set.empty @nt @lhs.closedHoNtRevDeps - - loc.recursive = @nt `Set.member` @loc.closedNtDeps - loc.nontrivAcyc = @nt `Set.member` @loc.closedHoNtDeps - loc.hoInfo = HigherOrderInfo { hoNtDeps = @loc.closedHoNtDeps - , hoNtRevDeps = @loc.closedHoNtRevDeps - , hoAcyclic = @loc.nontrivAcyc - } - -SEM Child | Child - loc.refNts = case @tp of - NT nt _ _ -> Set.singleton nt - _ -> mempty - loc.refHoNts = if @loc.isHigherOrder then @loc.refNts else mempty - loc.isHigherOrder = case @kind of - ChildSyntax -> False - _ -> True - -SEM Grammar | Grammar - loc.closedNtDeps = closeMap @nonts.ntDeps - loc.closedHoNtDeps = closeMap @nonts.ntHoDeps - loc.closedHoNtRevDeps = revDeps @loc.closedHoNtDeps - -------------------------------------------------------------------------------- --- Determine which children have an around-rule -------------------------------------------------------------------------------- - --- Propagate the around-map downward -ATTR Nonterminals Nonterminal - [ aroundMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))} || ] - -ATTR Productions Production - [ aroundMap : {Map ConstructorIdent (Map Identifier [Expression])} || ] - -ATTR Children Child - [ aroundMap : {Map Identifier [Expression]} | | ] - -SEM Nonterminal | Nonterminal loc.aroundMap = Map.findWithDefault Map.empty @nt @lhs.aroundMap -SEM Production | Production loc.aroundMap = Map.findWithDefault Map.empty @con @lhs.aroundMap - -SEM Grammar | Grammar - nonts.aroundMap = @aroundsMap - -SEM Child | Child - loc.hasArounds = case Map.lookup @name @lhs.aroundMap of - Nothing -> False - Just as -> not (null as) - -------------------------------------------------------------------------------- --- Determine which children are used by merges -------------------------------------------------------------------------------- - --- Propagate the around-map downward -ATTR Nonterminals Nonterminal - [ mergeMap : {Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))} || ] - -ATTR Productions Production - [ mergeMap : {Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))} || ] - -ATTR Children Child - [ mergeMap : {Map Identifier (Identifier, [Identifier], Expression)} mergedChildren : {Set Identifier} | | ] - -SEM Nonterminal | Nonterminal loc.mergeMap = Map.findWithDefault Map.empty @nt @lhs.mergeMap -SEM Production | Production loc.mergeMap = Map.findWithDefault Map.empty @con @lhs.mergeMap - -SEM Grammar | Grammar - nonts.mergeMap = @mergeMap - -SEM Production | Production - loc.mergedChildren = Set.unions [ Set.fromList ms | (_,ms,_) <- Map.elems @loc.mergeMap ] - -SEM Child | Child - loc.merges = maybe Nothing (\(_,ms,_) -> Just ms) $ Map.lookup @name @lhs.mergeMap - loc.isMerged = @name `Set.member` @lhs.mergedChildren - -------------------------------------------------------------------------------- --- Distribute the ContextMap to nonterminals -------------------------------------------------------------------------------- - -ATTR Nonterminals Nonterminal [ classContexts : ContextMap | | ] - -SEM Grammar | Grammar - nonts.classContexts = @contextMap - -SEM Nonterminal | Nonterminal - loc.classContexts = Map.findWithDefault [] @nt @lhs.classContexts - -------------------------------------------------------------------------------- --- Gather all rules per production for the execution plan -------------------------------------------------------------------------------- -ATTR Expression [ | | copy : SELF ] - -ATTR Rule [ | | erules : ERule ] -ATTR Rules [ | | erules USE {:} {[]} : ERules ] - -SEM Rule - | Rule lhs.erules = ERule @loc.rulename - @pattern.copy - @rhs.copy - @owrt - @origin - @explicit - @pure - @mbError - - -------------------------------------------------------------------------------- --- Gather all childs per production for the execution plan -------------------------------------------------------------------------------- - -ATTR Child [ | | echilds : EChild ] -ATTR Children [ | | echilds USE {:} {[]} : EChildren ] - -SEM Child - | Child lhs.echilds = case @tp of - NT _ _ _ -> EChild @name @tp @kind @loc.hasArounds @loc.merges @loc.isMerged - _ -> ETerm @name @tp - -------------------------------------------------------------------------------- -- Dependency graph per production ------------------------------------------------------------------------------- -- Gather vertices @@ -364,26 +214,4 @@ Right (o,d,v) -> (o,d,v,Seq.empty) else (lazyPlan,empty,empty,Seq.empty) -------------------------------------------------------------------------------- --- Output nonterminal type mappings -------------------------------------------------------------------------------- -ATTR Grammar - Nonterminals [ | | inhmap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent Attributes} - synmap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent Attributes} ] -ATTR Nonterminal [ | | inhmap : {Map.Map NontermIdent Attributes} - synmap : {Map.Map NontermIdent Attributes} ] -SEM Nonterminal - | Nonterminal lhs.inhmap = Map.singleton @nt @inh - lhs.synmap = Map.singleton @nt @syn - -------------------------------------------------------------------------------- --- Output nonterminal type mappings -------------------------------------------------------------------------------- -ATTR Grammar Nonterminals Nonterminal [ | | localSigMap USE {`Map.union`} {Map.empty} : {Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type))} ] -ATTR Productions Production [ | | localSigMap USE {`Map.union`} {Map.empty} : {Map.Map ConstructorIdent (Map.Map Identifier Type)} ] -ATTR TypeSigs TypeSig [ | | localSigMap USE {`Map.union`} {Map.empty} : {Map Identifier Type} ] - -SEM Nonterminal | Nonterminal lhs.localSigMap = Map.singleton @nt @prods.localSigMap -SEM Production | Production lhs.localSigMap = Map.singleton @con @typeSigs.localSigMap -SEM TypeSig | TypeSig lhs.localSigMap = Map.singleton @name @tp diff --git a/src-ag/LOAG/Order.ag b/src-ag/LOAG/Order.ag new file mode 100644 --- /dev/null +++ b/src-ag/LOAG/Order.ag @@ -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 $ + 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) +} + +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 + + +} diff --git a/src-ag/LOAG/Rep.ag b/src-ag/LOAG/Rep.ag new file mode 100644 --- /dev/null +++ b/src-ag/LOAG/Rep.ag @@ -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 + + diff --git a/src-ag/Transform.ag b/src-ag/Transform.ag --- a/src-ag/Transform.ag +++ b/src-ag/Transform.ag @@ -812,7 +812,7 @@ "nogensems" -> o { semfuns = False } "gentypesigs" -> o { typeSigs = True } "nogentypesigs"-> o { typeSigs = False } - "nocycle" -> o { withCycle = False } + "nocycle" -> o { withCycle = False, loag = False } "cycle" -> o { withCycle = True } "nostrictdata" -> o { strictData = False } "strictdata" -> o { strictData = True } @@ -821,7 +821,7 @@ "strictercase" -> o { strictCases = True, stricterCases = True } "nostrictwrap" -> o { strictWrap = False } "strictwrap" -> o { strictWrap = True } - "novisit" -> o { visit = False } + "novisit" -> o { visit = False, loag = False } "visit" -> o { visit = True } "nocase" -> o { cases = False } "case" -> o { cases = True } diff --git a/src-generated/AG2AspectAG.hs b/src-generated/AG2AspectAG.hs --- a/src-generated/AG2AspectAG.hs +++ b/src-generated/AG2AspectAG.hs @@ -2,26 +2,26 @@ {-# LANGUAGE ScopedTypeVariables #-} module AG2AspectAG where -{-# LINE 2 "./src-ag/HsToken.ag" #-} +{-# 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" #-} +{-# 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" #-} +{-# 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" #-} +{-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) @@ -33,7 +33,7 @@ import ErrorMessages {-# LINE 35 "dist/build/AG2AspectAG.hs" #-} -{-# LINE 8 "./src-ag/AG2AspectAG.ag" #-} +{-# LINE 8 "src-ag/AG2AspectAG.ag" #-} import Options @@ -55,24 +55,24 @@ {-# LINE 56 "dist/build/AG2AspectAG.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 28 "./src-ag/AG2AspectAG.ag" #-} +{-# 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" #-} +{-# LINE 33 "src-ag/AG2AspectAG.ag" #-} ppName l = ppListSep "" "" "_" l {-# LINE 68 "dist/build/AG2AspectAG.hs" #-} -{-# LINE 70 "./src-ag/AG2AspectAG.ag" #-} +{-# 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" #-} +{-# 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)) @@ -101,14 +101,14 @@ {-# LINE 103 "dist/build/AG2AspectAG.hs" #-} -{-# LINE 397 "./src-ag/AG2AspectAG.ag" #-} +{-# 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" #-} +{-# LINE 455 "src-ag/AG2AspectAG.ag" #-} data PPRule = PPRule Identifier Identifier Bool ([(Identifier,Type)] -> [Identifier] -> PP_Doc) @@ -120,7 +120,7 @@ {-# LINE 122 "dist/build/AG2AspectAG.hs" #-} -{-# LINE 494 "./src-ag/AG2AspectAG.ag" #-} +{-# LINE 494 "src-ag/AG2AspectAG.ag" #-} defInhGRule ppNt prodName newNT newProd ch rules inhNoGroup synNoGroup chids locals = @@ -345,7 +345,7 @@ {-# LINE 347 "dist/build/AG2AspectAG.hs" #-} -{-# LINE 721 "./src-ag/AG2AspectAG.ag" #-} +{-# LINE 721 "src-ag/AG2AspectAG.ag" #-} ppMacro (Macro con children) = "( atts_" >|< show con >|< ", " >|< ppListSep "" "" " <.> " ppChildren >|<")" where ppChildren = map ppChild children @@ -355,7 +355,7 @@ chName ch = ppName [pp "ch", pp ch, pp con] {-# LINE 357 "dist/build/AG2AspectAG.hs" #-} -{-# LINE 754 "./src-ag/AG2AspectAG.ag" #-} +{-# 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 @@ -365,12 +365,12 @@ elemNT a b = False {-# LINE 367 "dist/build/AG2AspectAG.hs" #-} -{-# LINE 797 "./src-ag/AG2AspectAG.ag" #-} +{-# 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" #-} +{-# LINE 851 "src-ag/AG2AspectAG.ag" #-} attVars atts = map (\(a,_) -> "_" >|< a >|< " ") $ Map.toAscList atts attFields atts noGroup ppNt = @@ -387,8 +387,8 @@ 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 arg = 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 arg) + 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) ) @@ -441,74 +441,74 @@ in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 19 "src-ag/DistChildAttr.ag" #-} rule0 = \ name_ tp_ -> - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 23 "src-ag/DistChildAttr.ag" #-} rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 24 "src-ag/DistChildAttr.ag" #-} rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 67 "src-ag/AG2AspectAG.ag" #-} rule3 = \ _inh -> - {-# LINE 67 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 67 "src-ag/AG2AspectAG.ag" #-} _inh {-# LINE 470 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule4 #-} - {-# LINE 182 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 182 "src-ag/AG2AspectAG.ag" #-} rule4 = \ name_ -> - {-# LINE 182 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 182 "src-ag/AG2AspectAG.ag" #-} pp name_ {-# LINE 476 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule5 #-} - {-# LINE 183 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 183 "src-ag/AG2AspectAG.ag" #-} rule5 = \ tp_ -> - {-# LINE 183 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 183 "src-ag/AG2AspectAG.ag" #-} ppShow tp_ {-# LINE 482 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule6 #-} - {-# LINE 184 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 184 "src-ag/AG2AspectAG.ag" #-} rule6 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) _ppCh -> - {-# LINE 184 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 184 "src-ag/AG2AspectAG.ag" #-} ppName [_ppCh , _lhsIppNt, _lhsIppProd] {-# LINE 488 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule7 #-} - {-# LINE 242 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 242 "src-ag/AG2AspectAG.ag" #-} rule7 = \ _chName _ppTCh kind_ -> - {-# LINE 242 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 285 "src-ag/AG2AspectAG.ag" #-} rule8 = \ _chName -> - {-# LINE 285 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 285 "src-ag/AG2AspectAG.ag" #-} "ch_" >|< _chName {-# LINE 502 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule9 #-} - {-# LINE 286 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 286 "src-ag/AG2AspectAG.ag" #-} rule9 = \ _chName -> - {-# LINE 286 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 286 "src-ag/AG2AspectAG.ag" #-} "Ch_" >|< _chName {-# LINE 508 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule10 #-} - {-# LINE 287 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 287 "src-ag/AG2AspectAG.ag" #-} rule10 = \ _chLabel _chTLabel _ppTCh kind_ -> - {-# LINE 287 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 287 "src-ag/AG2AspectAG.ag" #-} "data " >|< _chTLabel >|< "; " >|< _chLabel >|< pp " = proxy :: " >|< case kind_ of ChildSyntax -> "Proxy " >|< "(" >|< _chTLabel >|< ", " >|< _ppTCh >|< ")" @@ -516,28 +516,28 @@ "(" >|< _chTLabel >|< ", nt)" {-# LINE 518 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule11 #-} - {-# LINE 293 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 293 "src-ag/AG2AspectAG.ag" #-} rule11 = \ _chLabel _chTLabel -> - {-# LINE 293 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 293 "src-ag/AG2AspectAG.ag" #-} [ _chLabel , _chTLabel ] {-# LINE 524 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule12 #-} - {-# LINE 451 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 451 "src-ag/AG2AspectAG.ag" #-} rule12 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) name_ -> - {-# LINE 451 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 489 "src-ag/AG2AspectAG.ag" #-} rule13 = \ name_ tp_ -> - {-# LINE 489 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 489 "src-ag/AG2AspectAG.ag" #-} [ (name_, removeDeforested tp_ ) ] {-# LINE 537 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule14 #-} - {-# LINE 827 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 827 "src-ag/AG2AspectAG.ag" #-} rule14 = \ _chLabel kind_ name_ tp_ -> - {-# LINE 827 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 827 "src-ag/AG2AspectAG.ag" #-} let semC = if (isNonterminal tp_) then "sem_" >|< ppShow tp_ >|< " _" >|< name_ @@ -557,8 +557,8 @@ 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 arg = 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 arg) + 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) ) @@ -627,9 +627,9 @@ in __result_ ) in C_Children_s5 v4 {-# INLINE rule15 #-} - {-# LINE 238 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 238 "src-ag/AG2AspectAG.ag" #-} rule15 = \ ((_hdIppDL) :: [PP_Doc]) ((_tlIppDL) :: [PP_Doc]) -> - {-# LINE 238 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 238 "src-ag/AG2AspectAG.ag" #-} _hdIppDL ++ _tlIppDL {-# LINE 635 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule16 #-} @@ -735,9 +735,9 @@ in __result_ ) in C_Children_s5 v4 {-# INLINE rule42 #-} - {-# LINE 239 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 239 "src-ag/AG2AspectAG.ag" #-} rule42 = \ (_ :: ()) -> - {-# LINE 239 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 239 "src-ag/AG2AspectAG.ag" #-} [] {-# LINE 743 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule43 #-} @@ -768,8 +768,8 @@ wrap_Expression (T_Expression act) (Inh_Expression _lhsIppNt _lhsIppProd) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Expression_vIn7 _lhsIppNt _lhsIppProd - (T_Expression_vOut7 _lhsOppRE) <- return (inv_Expression_s8 sem arg) + let arg7 = T_Expression_vIn7 _lhsIppNt _lhsIppProd + (T_Expression_vOut7 _lhsOppRE) <- return (inv_Expression_s8 sem arg7) return (Syn_Expression _lhsOppRE) ) @@ -802,9 +802,9 @@ in __result_ ) in C_Expression_s8 v7 {-# INLINE rule49 #-} - {-# LINE 484 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 484 "src-ag/AG2AspectAG.ag" #-} rule49 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) tks_ -> - {-# LINE 484 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 484 "src-ag/AG2AspectAG.ag" #-} rhsRule _lhsIppNt _lhsIppProd tks_ {-# LINE 810 "dist/build/AG2AspectAG.hs"#-} @@ -817,8 +817,8 @@ wrap_Grammar (T_Grammar act) (Inh_Grammar _lhsIagi _lhsIext _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Grammar_vIn10 _lhsIagi _lhsIext _lhsIoptions - (T_Grammar_vOut10 _lhsOimp _lhsOpp) <- return (inv_Grammar_s11 sem arg) + let arg10 = T_Grammar_vIn10 _lhsIagi _lhsIext _lhsIoptions + (T_Grammar_vOut10 _lhsOimp _lhsOpp) <- return (inv_Grammar_s11 sem arg10) return (Syn_Grammar _lhsOimp _lhsOpp) ) @@ -873,72 +873,72 @@ in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule50 #-} - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 15 "src-ag/DistChildAttr.ag" #-} rule50 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 15 "src-ag/DistChildAttr.ag" #-} _nontsIinhMap' {-# LINE 881 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule51 #-} - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 16 "src-ag/DistChildAttr.ag" #-} rule51 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 16 "src-ag/DistChildAttr.ag" #-} _nontsIsynMap' {-# LINE 887 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule52 #-} - {-# LINE 43 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 43 "src-ag/AG2AspectAG.ag" #-} rule52 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 43 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 43 "src-ag/AG2AspectAG.ag" #-} rename _lhsIoptions {-# LINE 893 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule53 #-} - {-# LINE 47 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 47 "src-ag/AG2AspectAG.ag" #-} rule53 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 47 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 47 "src-ag/AG2AspectAG.ag" #-} sort $ noGroup _lhsIoptions {-# LINE 899 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule54 #-} - {-# LINE 48 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 48 "src-ag/AG2AspectAG.ag" #-} rule54 = \ _o_noGroup -> - {-# LINE 48 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 48 "src-ag/AG2AspectAG.ag" #-} _o_noGroup {-# LINE 905 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule55 #-} - {-# LINE 80 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 80 "src-ag/AG2AspectAG.ag" #-} rule55 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) -> - {-# LINE 80 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 82 "src-ag/AG2AspectAG.ag" #-} rule56 = \ _newAtts -> - {-# LINE 82 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 82 "src-ag/AG2AspectAG.ag" #-} _newAtts {-# LINE 918 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule57 #-} - {-# LINE 88 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 88 "src-ag/AG2AspectAG.ag" #-} rule57 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) -> - {-# LINE 88 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 90 "src-ag/AG2AspectAG.ag" #-} rule58 = \ _newProds -> - {-# LINE 90 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 90 "src-ag/AG2AspectAG.ag" #-} _newProds {-# LINE 931 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule59 #-} - {-# LINE 112 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 112 "src-ag/AG2AspectAG.ag" #-} rule59 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) ((_nontsIextendedNTs) :: Set NontermIdent) -> - {-# LINE 112 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 127 "src-ag/AG2AspectAG.ag" #-} rule60 = \ ((_lhsIext) :: Maybe String) ((_nontsIppDI) :: [PP_Doc]) ((_nontsIppLI) :: [PP_Doc]) _ppAI _ppANT -> - {-# LINE 127 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 127 "src-ag/AG2AspectAG.ag" #-} "import Language.Grammars.AspectAG" >-< "import Language.Grammars.AspectAG.Derive" >-< "import Data.HList.Label4" >-< @@ -948,9 +948,9 @@ 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" #-} + {-# 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" #-} + {-# LINE 140 "src-ag/AG2AspectAG.ag" #-} (if dataTypes _lhsIoptions then "-- datatypes" >-< _nontsIppD >-< "-- labels" >-< _nontsIppL @@ -971,21 +971,21 @@ else empty) {-# LINE 973 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule62 #-} - {-# LINE 202 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 202 "src-ag/AG2AspectAG.ag" #-} rule62 = \ derivings_ -> - {-# LINE 202 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 202 "src-ag/AG2AspectAG.ag" #-} derivings_ {-# LINE 979 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule63 #-} - {-# LINE 251 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 251 "src-ag/AG2AspectAG.ag" #-} rule63 = \ typeSyns_ -> - {-# LINE 251 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 251 "src-ag/AG2AspectAG.ag" #-} typeSyns_ {-# LINE 985 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule64 #-} - {-# LINE 300 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 300 "src-ag/AG2AspectAG.ag" #-} rule64 = \ ((_lhsIext) :: Maybe String) _newAtts ((_nontsIppA) :: PP_Doc) _o_noGroup -> - {-# LINE 300 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 300 "src-ag/AG2AspectAG.ag" #-} vlist (map defAtt (filterAtts _newAtts _o_noGroup )) >-< defAtt "loc" >-< (case _lhsIext of @@ -994,9 +994,9 @@ _nontsIppA {-# LINE 996 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule65 #-} - {-# LINE 308 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 308 "src-ag/AG2AspectAG.ag" #-} rule65 = \ ((_lhsIext) :: Maybe String) _newAtts ((_nontsIppAI) :: [PP_Doc]) _o_noGroup -> - {-# LINE 308 "./src-ag/AG2AspectAG.ag" #-} + {-# 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) ++ @@ -1006,22 +1006,22 @@ _nontsIppAI {-# LINE 1008 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule66 #-} - {-# LINE 318 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 318 "src-ag/AG2AspectAG.ag" #-} rule66 = \ _newAtts _o_noGroup -> - {-# LINE 318 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 392 "src-ag/AG2AspectAG.ag" #-} rule67 = \ ((_nontsIppNtL) :: [(PP_Doc, Attributes)]) -> - {-# LINE 392 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 392 "src-ag/AG2AspectAG.ag" #-} _nontsIppNtL {-# LINE 1021 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule68 #-} - {-# LINE 393 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 393 "src-ag/AG2AspectAG.ag" #-} rule68 = \ _newAtts ((_nontsIppR) :: PP_Doc) _o_noGroup _ppNtL -> - {-# LINE 393 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 393 "src-ag/AG2AspectAG.ag" #-} ntsList "group" _ppNtL >-< vlist (map (\att -> ntsList att (filterNts att _ppNtL )) (filterAtts _newAtts _o_noGroup )) >-< _nontsIppR @@ -1039,8 +1039,8 @@ wrap_HsToken (T_HsToken act) (Inh_HsToken ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_HsToken_vIn13 - (T_HsToken_vOut13 ) <- return (inv_HsToken_s14 sem arg) + let arg13 = T_HsToken_vIn13 + (T_HsToken_vOut13 ) <- return (inv_HsToken_s14 sem arg13) return (Syn_HsToken ) ) @@ -1135,8 +1135,8 @@ wrap_HsTokens (T_HsTokens act) (Inh_HsTokens ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_HsTokens_vIn16 - (T_HsTokens_vOut16 ) <- return (inv_HsTokens_s17 sem arg) + let arg16 = T_HsTokens_vIn16 + (T_HsTokens_vOut16 ) <- return (inv_HsTokens_s17 sem arg16) return (Syn_HsTokens ) ) @@ -1190,8 +1190,8 @@ wrap_HsTokensRoot (T_HsTokensRoot act) (Inh_HsTokensRoot ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_HsTokensRoot_vIn19 - (T_HsTokensRoot_vOut19 ) <- return (inv_HsTokensRoot_s20 sem arg) + let arg19 = T_HsTokensRoot_vIn19 + (T_HsTokensRoot_vOut19 ) <- return (inv_HsTokensRoot_s20 sem arg19) return (Syn_HsTokensRoot ) ) @@ -1233,8 +1233,8 @@ 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 arg = 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 arg) + 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') ) @@ -1312,73 +1312,73 @@ in __result_ ) in C_Nonterminal_s23 v22 {-# INLINE rule70 #-} - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 7 "src-ag/DistChildAttr.ag" #-} rule70 = \ inh_ nt_ -> - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 7 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ inh_ {-# LINE 1320 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule71 #-} - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 8 "src-ag/DistChildAttr.ag" #-} rule71 = \ nt_ syn_ -> - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 8 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ syn_ {-# LINE 1326 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule72 #-} - {-# LINE 51 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 51 "src-ag/AG2AspectAG.ag" #-} rule72 = \ ((_lhsIo_noGroup) :: [String]) ((_prodsIprdInh) :: Attributes) -> - {-# LINE 51 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 52 "src-ag/AG2AspectAG.ag" #-} rule73 = \ ((_lhsIo_noGroup) :: [String]) syn_ -> - {-# LINE 52 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 57 "src-ag/AG2AspectAG.ag" #-} rule74 = \ _inhNoGroup -> - {-# LINE 57 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 58 "src-ag/AG2AspectAG.ag" #-} rule75 = \ _synNoGroup -> - {-# LINE 58 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 94 "src-ag/AG2AspectAG.ag" #-} rule76 = \ ((_lhsInewProds) :: DataTypes ) nt_ -> - {-# LINE 94 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 107 "src-ag/AG2AspectAG.ag" #-} rule77 = \ ((_prodsIhasMoreProds) :: Bool ) nt_ -> - {-# LINE 107 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 173 "src-ag/AG2AspectAG.ag" #-} rule78 = \ nt_ -> - {-# LINE 173 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 173 "src-ag/AG2AspectAG.ag" #-} pp nt_ {-# LINE 1372 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule79 #-} - {-# LINE 190 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 190 "src-ag/AG2AspectAG.ag" #-} rule79 = \ _ppNt -> - {-# LINE 190 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 190 "src-ag/AG2AspectAG.ag" #-} _ppNt {-# LINE 1378 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule80 #-} - {-# LINE 209 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 209 "src-ag/AG2AspectAG.ag" #-} if (Set.member nt_ _lhsInewNTs) then case (lookup nt_ _lhsItSyns) of Nothing -> "data " >|< _ppNt @@ -1390,41 +1390,41 @@ else empty {-# LINE 1392 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule81 #-} - {-# LINE 222 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 222 "src-ag/AG2AspectAG.ag" #-} rule81 = \ ((_lhsInewNTs) :: Set NontermIdent) _ppNt nt_ -> - {-# LINE 222 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 262 "src-ag/AG2AspectAG.ag" #-} rule82 = \ _ppNt -> - {-# LINE 262 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 262 "src-ag/AG2AspectAG.ag" #-} "nt_" >|< _ppNt {-# LINE 1406 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule83 #-} - {-# LINE 264 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 264 "src-ag/AG2AspectAG.ag" #-} rule83 = \ ((_lhsInewNTs) :: Set NontermIdent) _ntLabel _ppNt ((_prodsIppL) :: PP_Doc) nt_ -> - {-# LINE 264 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 269 "src-ag/AG2AspectAG.ag" #-} rule84 = \ ((_lhsInewNTs) :: Set NontermIdent) _ntLabel ((_prodsIppLI) :: [PP_Doc]) nt_ -> - {-# LINE 269 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 324 "src-ag/AG2AspectAG.ag" #-} ( if (Set.member nt_ _lhsInewNTs) then defAttRec (pp "InhG") _ppNt inh_ _inhNoGroup >-< @@ -1433,53 +1433,53 @@ _prodsIppA {-# LINE 1435 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule86 #-} - {-# LINE 338 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 338 "src-ag/AG2AspectAG.ag" #-} rule86 = \ ((_lhsInewNTs) :: Set NontermIdent) _ppNt nt_ -> - {-# LINE 338 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 406 "src-ag/AG2AspectAG.ag" #-} rule87 = \ inh_ nt_ syn_ -> - {-# LINE 406 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 415 "src-ag/AG2AspectAG.ag" #-} rule88 = \ ((_lhsInewNTs) :: Set NontermIdent) nt_ -> - {-# LINE 415 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 415 "src-ag/AG2AspectAG.ag" #-} Set.member nt_ _lhsInewNTs {-# LINE 1455 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule89 #-} - {-# LINE 425 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 425 "src-ag/AG2AspectAG.ag" #-} rule89 = \ ((_prodsIppR) :: PP_Doc) nt_ -> - {-# LINE 425 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 425 "src-ag/AG2AspectAG.ag" #-} pp "----" >|< pp nt_ >-< _prodsIppR {-# LINE 1461 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule90 #-} - {-# LINE 735 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 735 "src-ag/AG2AspectAG.ag" #-} rule90 = \ _ppNt ((_prodsIppCata) :: PP_Doc) -> - {-# LINE 735 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 735 "src-ag/AG2AspectAG.ag" #-} "----" >|< _ppNt >-< _prodsIppCata {-# LINE 1467 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule91 #-} - {-# LINE 766 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 766 "src-ag/AG2AspectAG.ag" #-} rule91 = \ syn_ -> - {-# LINE 766 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 766 "src-ag/AG2AspectAG.ag" #-} syn_ {-# LINE 1473 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule92 #-} - {-# LINE 767 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 767 "src-ag/AG2AspectAG.ag" #-} rule92 = \ inh_ -> - {-# LINE 767 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 767 "src-ag/AG2AspectAG.ag" #-} inh_ {-# LINE 1479 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule93 #-} - {-# LINE 779 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 779 "src-ag/AG2AspectAG.ag" #-} rule93 = \ _inhNoGroup _ppNt ((_prodsIppSPF) :: PP_Doc) _synNoGroup -> - {-# LINE 779 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 779 "src-ag/AG2AspectAG.ag" #-} let inhAtts = attTypes _inhNoGroup synAtts = attTypes _synNoGroup in @@ -1498,9 +1498,9 @@ _prodsIppSPF {-# LINE 1500 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule94 #-} - {-# LINE 847 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 847 "src-ag/AG2AspectAG.ag" #-} rule94 = \ _inhNoGroup _ppNt inh_ -> - {-# LINE 847 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 847 "src-ag/AG2AspectAG.ag" #-} ppName [pp "wrap", _ppNt ] >|< " sem " >|< attVars inh_ >|< " = " >-< " sem " >|< attFields inh_ _inhNoGroup _ppNt {-# LINE 1507 "dist/build/AG2AspectAG.hs"#-} @@ -1532,8 +1532,8 @@ 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 arg = 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 arg) + 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') ) @@ -1807,8 +1807,8 @@ wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Pattern_vIn28 - (T_Pattern_vOut28 _lhsOcopy _lhsOinfo) <- return (inv_Pattern_s29 sem arg) + let arg28 = T_Pattern_vIn28 + (T_Pattern_vOut28 _lhsOcopy _lhsOinfo) <- return (inv_Pattern_s29 sem arg28) return (Syn_Pattern _lhsOcopy _lhsOinfo) ) @@ -1850,9 +1850,9 @@ in __result_ ) in C_Pattern_s29 v28 {-# INLINE rule149 #-} - {-# LINE 383 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 383 "src-ag/AG2AspectAG.ag" #-} rule149 = \ (_ :: ()) -> - {-# LINE 383 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 383 "src-ag/AG2AspectAG.ag" #-} error "Pattern Constr undefined!!" {-# LINE 1858 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule150 #-} @@ -1879,9 +1879,9 @@ in __result_ ) in C_Pattern_s29 v28 {-# INLINE rule152 #-} - {-# LINE 384 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 384 "src-ag/AG2AspectAG.ag" #-} rule152 = \ (_ :: ()) -> - {-# LINE 384 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 384 "src-ag/AG2AspectAG.ag" #-} error "Pattern Product undefined!!" {-# LINE 1887 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule153 #-} @@ -1908,9 +1908,9 @@ in __result_ ) in C_Pattern_s29 v28 {-# INLINE rule155 #-} - {-# LINE 382 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 382 "src-ag/AG2AspectAG.ag" #-} rule155 = \ attr_ field_ -> - {-# LINE 382 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 382 "src-ag/AG2AspectAG.ag" #-} (field_, attr_) {-# LINE 1916 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule156 #-} @@ -1961,9 +1961,9 @@ in __result_ ) in C_Pattern_s29 v28 {-# INLINE rule161 #-} - {-# LINE 385 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 385 "src-ag/AG2AspectAG.ag" #-} rule161 = \ (_ :: ()) -> - {-# LINE 385 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 385 "src-ag/AG2AspectAG.ag" #-} error "Pattern Underscore undefined!!" {-# LINE 1969 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule162 #-} @@ -1982,8 +1982,8 @@ wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Patterns_vIn31 - (T_Patterns_vOut31 _lhsOcopy) <- return (inv_Patterns_s32 sem arg) + let arg31 = T_Patterns_vIn31 + (T_Patterns_vOut31 _lhsOcopy) <- return (inv_Patterns_s32 sem arg31) return (Syn_Patterns _lhsOcopy) ) @@ -2055,8 +2055,8 @@ 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 arg = 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 arg) + 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) ) @@ -2140,81 +2140,81 @@ in __result_ ) in C_Production_s35 v34 {-# INLINE rule168 #-} - {-# LINE 103 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 103 "src-ag/AG2AspectAG.ag" #-} rule168 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ -> - {-# LINE 103 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 176 "src-ag/AG2AspectAG.ag" #-} rule169 = \ con_ -> - {-# LINE 176 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 176 "src-ag/AG2AspectAG.ag" #-} pp con_ {-# LINE 2154 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule170 #-} - {-# LINE 177 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 177 "src-ag/AG2AspectAG.ag" #-} rule170 = \ ((_lhsIppNt) :: PP_Doc) _ppProd -> - {-# LINE 177 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 177 "src-ag/AG2AspectAG.ag" #-} ppName [_lhsIppNt, _ppProd ] {-# LINE 2160 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule171 #-} - {-# LINE 178 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 178 "src-ag/AG2AspectAG.ag" #-} rule171 = \ ((_lhsIo_rename) :: Bool) _ppProd _prodName -> - {-# LINE 178 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 195 "src-ag/AG2AspectAG.ag" #-} rule172 = \ _ppProd -> - {-# LINE 195 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 195 "src-ag/AG2AspectAG.ag" #-} _ppProd {-# LINE 2174 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule173 #-} - {-# LINE 196 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 196 "src-ag/AG2AspectAG.ag" #-} rule173 = \ _ppProd -> - {-# LINE 196 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 196 "src-ag/AG2AspectAG.ag" #-} _ppProd {-# LINE 2180 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule174 #-} - {-# LINE 228 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 228 "src-ag/AG2AspectAG.ag" #-} rule174 = \ ((_childrenIppDL) :: [PP_Doc]) _conName -> - {-# LINE 228 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 228 "src-ag/AG2AspectAG.ag" #-} _conName >|< ppListSep " {" "}" ", " _childrenIppDL {-# LINE 2186 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule175 #-} - {-# LINE 275 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 275 "src-ag/AG2AspectAG.ag" #-} rule175 = \ ((_childrenIppL) :: PP_Doc) ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ -> - {-# LINE 275 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 279 "src-ag/AG2AspectAG.ag" #-} rule176 = \ ((_childrenIppLI) :: [PP_Doc]) ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ -> - {-# LINE 279 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 332 "src-ag/AG2AspectAG.ag" #-} rule177 = \ _prodName ((_rulesIlocals) :: [Identifier]) -> - {-# LINE 332 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 428 "src-ag/AG2AspectAG.ag" #-} rule178 = \ ((_lhsInewProds) :: Map.Map ConstructorIdent FieldMap ) con_ -> - {-# LINE 428 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 428 "src-ag/AG2AspectAG.ag" #-} Map.member con_ _lhsInewProds {-# LINE 2214 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule179 #-} - {-# LINE 430 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# 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 @@ -2235,9 +2235,9 @@ , instRA ++ locRA ++ inhGRA ++ synGRA ++ inhMRA ++ synMRA ++ inhRA ++ synRA) {-# LINE 2237 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule180 #-} - {-# LINE 740 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 740 "src-ag/AG2AspectAG.ag" #-} rule180 = \ ((_lhsIext) :: Maybe String) ((_lhsInewNT) :: Bool) _newProd _ppRA _prodName macro_ -> - {-# LINE 740 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 740 "src-ag/AG2AspectAG.ag" #-} let extend = maybe [] ( \ext -> if (_lhsInewNT || (not _lhsInewNT && _newProd )) then [] @@ -2253,9 +2253,9 @@ "semP_" >|< _prodName >|< pp " = knit atts_" >|< _prodName {-# LINE 2255 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule181 #-} - {-# LINE 804 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 804 "src-ag/AG2AspectAG.ag" #-} let chi = _childrenIppCSF ppPattern = case (show con_) of "Cons" -> ppParams (ppListSep "" "" " : ") @@ -2266,9 +2266,9 @@ " (" >|< map (fst . snd) chi >|< "emptyRecord)" {-# LINE 2268 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule182 #-} - {-# LINE 816 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 816 "src-ag/AG2AspectAG.ag" #-} rule182 = \ ((_childrenIppCSF) :: [(Identifier,(PP_Doc,PP_Doc))]) ((_lhsIppNt) :: PP_Doc) _prodName con_ -> - {-# LINE 816 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 816 "src-ag/AG2AspectAG.ag" #-} let chi = _childrenIppCSF ppParams f = f $ map (((>|<) (pp "_")) . fst) chi in "sem_" >|< _lhsIppNt >|< "_" >|< con_ >#< ppParams ppSpaced >|< " = semP_" >|< _prodName >|< @@ -2344,8 +2344,8 @@ 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 arg = 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 arg) + 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) ) @@ -2428,15 +2428,15 @@ in __result_ ) in C_Productions_s38 v37 {-# INLINE rule203 #-} - {-# LINE 62 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 62 "src-ag/AG2AspectAG.ag" #-} rule203 = \ ((_hdIprdInh) :: Attributes) ((_lhsIinhNoGroup) :: [String]) -> - {-# LINE 62 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# LINE 234 "src-ag/AG2AspectAG.ag" #-} rule204 = \ ((_hdIppD) :: PP_Doc) ((_tlIppDL) :: [PP_Doc]) -> - {-# LINE 234 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 234 "src-ag/AG2AspectAG.ag" #-} _hdIppD : _tlIppDL {-# LINE 2442 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule205 #-} @@ -2577,9 +2577,9 @@ in __result_ ) in C_Productions_s38 v37 {-# INLINE rule240 #-} - {-# LINE 235 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 235 "src-ag/AG2AspectAG.ag" #-} rule240 = \ (_ :: ()) -> - {-# LINE 235 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 235 "src-ag/AG2AspectAG.ag" #-} [] {-# LINE 2585 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule241 #-} @@ -2622,8 +2622,8 @@ wrap_Rule (T_Rule act) (Inh_Rule _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Rule_vIn40 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup - (T_Rule_vOut40 _lhsOlocals _lhsOppRL) <- return (inv_Rule_s41 sem arg) + 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) ) @@ -2664,17 +2664,17 @@ in __result_ ) in C_Rule_s41 v40 {-# INLINE rule251 #-} - {-# LINE 375 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 375 "src-ag/AG2AspectAG.ag" #-} rule251 = \ ((_patternIinfo) :: (Identifier, Identifier)) -> - {-# LINE 375 "./src-ag/AG2AspectAG.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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) ] @@ -2695,8 +2695,8 @@ wrap_Rules (T_Rules act) (Inh_Rules _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Rules_vIn43 _lhsIext _lhsIinhNoGroup _lhsInewAtts _lhsInewProd _lhsIo_noGroup _lhsIppNt _lhsIppProd _lhsIsynNoGroup - (T_Rules_vOut43 _lhsOlocals _lhsOppRL) <- return (inv_Rules_s44 sem arg) + 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) ) @@ -2751,9 +2751,9 @@ in __result_ ) in C_Rules_s44 v43 {-# INLINE rule255 #-} - {-# LINE 468 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 468 "src-ag/AG2AspectAG.ag" #-} rule255 = \ ((_hdIppRL) :: [ PPRule ]) ((_tlIppRL) :: [ PPRule ]) -> - {-# LINE 468 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 468 "src-ag/AG2AspectAG.ag" #-} _hdIppRL ++ _tlIppRL {-# LINE 2759 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule256 #-} @@ -2822,9 +2822,9 @@ in __result_ ) in C_Rules_s44 v43 {-# INLINE rule273 #-} - {-# LINE 469 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 469 "src-ag/AG2AspectAG.ag" #-} rule273 = \ (_ :: ()) -> - {-# LINE 469 "./src-ag/AG2AspectAG.ag" #-} + {-# LINE 469 "src-ag/AG2AspectAG.ag" #-} [] {-# LINE 2830 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule274 #-} @@ -2840,8 +2840,8 @@ wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_TypeSig_vIn46 - (T_TypeSig_vOut46 ) <- return (inv_TypeSig_s47 sem arg) + let arg46 = T_TypeSig_vIn46 + (T_TypeSig_vOut46 ) <- return (inv_TypeSig_s47 sem arg46) return (Syn_TypeSig ) ) @@ -2881,8 +2881,8 @@ wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_TypeSigs_vIn49 - (T_TypeSigs_vOut49 ) <- return (inv_TypeSigs_s50 sem arg) + let arg49 = T_TypeSigs_vIn49 + (T_TypeSigs_vOut49 ) <- return (inv_TypeSigs_s50 sem arg49) return (Syn_TypeSigs ) ) diff --git a/src-generated/AbstractSyntax.hs b/src-generated/AbstractSyntax.hs --- a/src-generated/AbstractSyntax.hs +++ b/src-generated/AbstractSyntax.hs @@ -1,8 +1,8 @@ --- UUAGC 0.9.50 (src-ag/AbstractSyntax.ag) +-- UUAGC 0.9.51 (src-ag/AbstractSyntax.ag) module AbstractSyntax where -{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} +{-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) diff --git a/src-generated/AbstractSyntaxDump.hs b/src-generated/AbstractSyntaxDump.hs --- a/src-generated/AbstractSyntaxDump.hs +++ b/src-generated/AbstractSyntaxDump.hs @@ -2,20 +2,20 @@ {-# LANGUAGE ScopedTypeVariables #-} module AbstractSyntaxDump where -{-# LINE 2 "./src-ag/Expression.ag" #-} +{-# 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" #-} +{-# 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" #-} +{-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) @@ -27,7 +27,7 @@ import ErrorMessages {-# LINE 29 "dist/build/AbstractSyntaxDump.hs" #-} -{-# LINE 6 "./src-ag/AbstractSyntaxDump.ag" #-} +{-# LINE 6 "src-ag/AbstractSyntaxDump.ag" #-} import Data.List import qualified Data.Map as Map @@ -49,8 +49,8 @@ wrap_Child (T_Child act) (Inh_Child ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Child_vIn1 - (T_Child_vOut1 _lhsOpp) <- return (inv_Child_s2 sem arg) + let arg1 = T_Child_vIn1 + (T_Child_vOut1 _lhsOpp) <- return (inv_Child_s2 sem arg1) return (Syn_Child _lhsOpp) ) @@ -83,9 +83,9 @@ in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} - {-# LINE 35 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 35 "src-ag/AbstractSyntaxDump.ag" #-} rule0 = \ kind_ name_ tp_ -> - {-# LINE 35 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 35 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Child","Child"] [pp name_, ppShow tp_] [ppF "kind" $ ppShow kind_] [] {-# LINE 91 "dist/build/AbstractSyntaxDump.hs"#-} @@ -98,8 +98,8 @@ wrap_Children (T_Children act) (Inh_Children ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Children_vIn4 - (T_Children_vOut4 _lhsOpp _lhsOppL) <- return (inv_Children_s5 sem arg) + let arg4 = T_Children_vIn4 + (T_Children_vOut4 _lhsOpp _lhsOppL) <- return (inv_Children_s5 sem arg4) return (Syn_Children _lhsOpp _lhsOppL) ) @@ -138,9 +138,9 @@ in __result_ ) in C_Children_s5 v4 {-# INLINE rule1 #-} - {-# LINE 67 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 67 "src-ag/AbstractSyntaxDump.ag" #-} rule1 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> - {-# LINE 67 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 67 "src-ag/AbstractSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 146 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule2 #-} @@ -161,9 +161,9 @@ in __result_ ) in C_Children_s5 v4 {-# INLINE rule3 #-} - {-# LINE 68 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 68 "src-ag/AbstractSyntaxDump.ag" #-} rule3 = \ (_ :: ()) -> - {-# LINE 68 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 68 "src-ag/AbstractSyntaxDump.ag" #-} [] {-# LINE 169 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule4 #-} @@ -179,8 +179,8 @@ wrap_Expression (T_Expression act) (Inh_Expression ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Expression_vIn7 - (T_Expression_vOut7 _lhsOpp) <- return (inv_Expression_s8 sem arg) + let arg7 = T_Expression_vIn7 + (T_Expression_vOut7 _lhsOpp) <- return (inv_Expression_s8 sem arg7) return (Syn_Expression _lhsOpp) ) @@ -213,9 +213,9 @@ in __result_ ) in C_Expression_s8 v7 {-# INLINE rule5 #-} - {-# LINE 50 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 50 "src-ag/AbstractSyntaxDump.ag" #-} rule5 = \ pos_ tks_ -> - {-# LINE 50 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 50 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Expression","Expression"] [ppShow pos_] [ppF "txt" $ vlist . showTokens . tokensToStrings $ tks_] [] {-# LINE 221 "dist/build/AbstractSyntaxDump.hs"#-} @@ -228,8 +228,8 @@ wrap_Grammar (T_Grammar act) (Inh_Grammar ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Grammar_vIn10 - (T_Grammar_vOut10 _lhsOpp) <- return (inv_Grammar_s11 sem arg) + let arg10 = T_Grammar_vIn10 + (T_Grammar_vOut10 _lhsOpp) <- return (inv_Grammar_s11 sem arg10) return (Syn_Grammar _lhsOpp) ) @@ -264,9 +264,9 @@ in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule6 #-} - {-# LINE 20 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 20 "src-ag/AbstractSyntaxDump.ag" #-} rule6 = \ ((_nontsIppL) :: [PP_Doc]) derivings_ typeSyns_ useMap_ wrappers_ -> - {-# LINE 20 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 20 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Grammar","Grammar"] [] [ ppF "typeSyns" $ ppAssocL typeSyns_ , ppF "useMap" $ ppMap $ Map.map ppMap $ useMap_ @@ -285,8 +285,8 @@ wrap_Nonterminal (T_Nonterminal act) (Inh_Nonterminal ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Nonterminal_vIn13 - (T_Nonterminal_vOut13 _lhsOpp) <- return (inv_Nonterminal_s14 sem arg) + let arg13 = T_Nonterminal_vIn13 + (T_Nonterminal_vOut13 _lhsOpp) <- return (inv_Nonterminal_s14 sem arg13) return (Syn_Nonterminal _lhsOpp) ) @@ -321,9 +321,9 @@ in __result_ ) in C_Nonterminal_s14 v13 {-# INLINE rule7 #-} - {-# LINE 29 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 29 "src-ag/AbstractSyntaxDump.ag" #-} rule7 = \ ((_prodsIppL) :: [PP_Doc]) inh_ nt_ params_ syn_ -> - {-# LINE 29 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# 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"#-} @@ -336,8 +336,8 @@ wrap_Nonterminals (T_Nonterminals act) (Inh_Nonterminals ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Nonterminals_vIn16 - (T_Nonterminals_vOut16 _lhsOpp _lhsOppL) <- return (inv_Nonterminals_s17 sem arg) + let arg16 = T_Nonterminals_vIn16 + (T_Nonterminals_vOut16 _lhsOpp _lhsOppL) <- return (inv_Nonterminals_s17 sem arg16) return (Syn_Nonterminals _lhsOpp _lhsOppL) ) @@ -376,9 +376,9 @@ in __result_ ) in C_Nonterminals_s17 v16 {-# INLINE rule8 #-} - {-# LINE 75 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 75 "src-ag/AbstractSyntaxDump.ag" #-} rule8 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> - {-# LINE 75 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 75 "src-ag/AbstractSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 384 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule9 #-} @@ -399,9 +399,9 @@ in __result_ ) in C_Nonterminals_s17 v16 {-# INLINE rule10 #-} - {-# LINE 76 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 76 "src-ag/AbstractSyntaxDump.ag" #-} rule10 = \ (_ :: ()) -> - {-# LINE 76 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 76 "src-ag/AbstractSyntaxDump.ag" #-} [] {-# LINE 407 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule11 #-} @@ -417,8 +417,8 @@ wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Pattern_vIn19 - (T_Pattern_vOut19 _lhsOcopy _lhsOpp) <- return (inv_Pattern_s20 sem arg) + let arg19 = T_Pattern_vIn19 + (T_Pattern_vOut19 _lhsOcopy _lhsOpp) <- return (inv_Pattern_s20 sem arg19) return (Syn_Pattern _lhsOcopy _lhsOpp) ) @@ -460,9 +460,9 @@ in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule12 #-} - {-# LINE 44 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 44 "src-ag/AbstractSyntaxDump.ag" #-} rule12 = \ ((_patsIppL) :: [PP_Doc]) name_ -> - {-# LINE 44 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 44 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] [] {-# LINE 468 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule13 #-} @@ -489,9 +489,9 @@ in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule15 #-} - {-# LINE 45 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 45 "src-ag/AbstractSyntaxDump.ag" #-} rule15 = \ ((_patsIppL) :: [PP_Doc]) pos_ -> - {-# LINE 45 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 45 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] [] {-# LINE 497 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule16 #-} @@ -518,9 +518,9 @@ in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule18 #-} - {-# LINE 46 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 46 "src-ag/AbstractSyntaxDump.ag" #-} rule18 = \ ((_patIpp) :: PP_Doc) attr_ field_ -> - {-# LINE 46 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 46 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] [] {-# LINE 526 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule19 #-} @@ -571,9 +571,9 @@ in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule24 #-} - {-# LINE 47 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 47 "src-ag/AbstractSyntaxDump.ag" #-} rule24 = \ pos_ -> - {-# LINE 47 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 47 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] [] {-# LINE 579 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule25 #-} @@ -592,8 +592,8 @@ wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Patterns_vIn22 - (T_Patterns_vOut22 _lhsOcopy _lhsOpp _lhsOppL) <- return (inv_Patterns_s23 sem arg) + let arg22 = T_Patterns_vIn22 + (T_Patterns_vOut22 _lhsOcopy _lhsOpp _lhsOppL) <- return (inv_Patterns_s23 sem arg22) return (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL) ) @@ -635,9 +635,9 @@ in __result_ ) in C_Patterns_s23 v22 {-# INLINE rule27 #-} - {-# LINE 55 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 55 "src-ag/AbstractSyntaxDump.ag" #-} rule27 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> - {-# LINE 55 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 55 "src-ag/AbstractSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 643 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule28 #-} @@ -667,9 +667,9 @@ in __result_ ) in C_Patterns_s23 v22 {-# INLINE rule31 #-} - {-# LINE 56 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 56 "src-ag/AbstractSyntaxDump.ag" #-} rule31 = \ (_ :: ()) -> - {-# LINE 56 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 56 "src-ag/AbstractSyntaxDump.ag" #-} [] {-# LINE 675 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule32 #-} @@ -691,8 +691,8 @@ wrap_Production (T_Production act) (Inh_Production ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Production_vIn25 - (T_Production_vOut25 _lhsOpp) <- return (inv_Production_s26 sem arg) + let arg25 = T_Production_vIn25 + (T_Production_vOut25 _lhsOpp) <- return (inv_Production_s26 sem arg25) return (Syn_Production _lhsOpp) ) @@ -731,9 +731,9 @@ in __result_ ) in C_Production_s26 v25 {-# INLINE rule35 #-} - {-# LINE 32 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 32 "src-ag/AbstractSyntaxDump.ag" #-} rule35 = \ ((_childrenIppL) :: [PP_Doc]) ((_rulesIppL) :: [PP_Doc]) ((_typeSigsIppL) :: [PP_Doc]) con_ -> - {-# LINE 32 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# 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"#-} @@ -746,8 +746,8 @@ wrap_Productions (T_Productions act) (Inh_Productions ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Productions_vIn28 - (T_Productions_vOut28 _lhsOpp _lhsOppL) <- return (inv_Productions_s29 sem arg) + let arg28 = T_Productions_vIn28 + (T_Productions_vOut28 _lhsOpp _lhsOppL) <- return (inv_Productions_s29 sem arg28) return (Syn_Productions _lhsOpp _lhsOppL) ) @@ -786,9 +786,9 @@ in __result_ ) in C_Productions_s29 v28 {-# INLINE rule36 #-} - {-# LINE 71 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 71 "src-ag/AbstractSyntaxDump.ag" #-} rule36 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> - {-# LINE 71 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 71 "src-ag/AbstractSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 794 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule37 #-} @@ -809,9 +809,9 @@ in __result_ ) in C_Productions_s29 v28 {-# INLINE rule38 #-} - {-# LINE 72 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 72 "src-ag/AbstractSyntaxDump.ag" #-} rule38 = \ (_ :: ()) -> - {-# LINE 72 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 72 "src-ag/AbstractSyntaxDump.ag" #-} [] {-# LINE 817 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule39 #-} @@ -827,8 +827,8 @@ wrap_Rule (T_Rule act) (Inh_Rule ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Rule_vIn31 - (T_Rule_vOut31 _lhsOpp) <- return (inv_Rule_s32 sem arg) + let arg31 = T_Rule_vIn31 + (T_Rule_vOut31 _lhsOpp) <- return (inv_Rule_s32 sem arg31) return (Syn_Rule _lhsOpp) ) @@ -865,9 +865,9 @@ in __result_ ) in C_Rule_s32 v31 {-# INLINE rule40 #-} - {-# LINE 38 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 38 "src-ag/AbstractSyntaxDump.ag" #-} rule40 = \ ((_patternIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) origin_ owrt_ -> - {-# LINE 38 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# 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"#-} @@ -880,8 +880,8 @@ wrap_Rules (T_Rules act) (Inh_Rules ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Rules_vIn34 - (T_Rules_vOut34 _lhsOpp _lhsOppL) <- return (inv_Rules_s35 sem arg) + let arg34 = T_Rules_vIn34 + (T_Rules_vOut34 _lhsOpp _lhsOppL) <- return (inv_Rules_s35 sem arg34) return (Syn_Rules _lhsOpp _lhsOppL) ) @@ -920,9 +920,9 @@ in __result_ ) in C_Rules_s35 v34 {-# INLINE rule41 #-} - {-# LINE 63 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 63 "src-ag/AbstractSyntaxDump.ag" #-} rule41 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> - {-# LINE 63 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 63 "src-ag/AbstractSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 928 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule42 #-} @@ -943,9 +943,9 @@ in __result_ ) in C_Rules_s35 v34 {-# INLINE rule43 #-} - {-# LINE 64 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 64 "src-ag/AbstractSyntaxDump.ag" #-} rule43 = \ (_ :: ()) -> - {-# LINE 64 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 64 "src-ag/AbstractSyntaxDump.ag" #-} [] {-# LINE 951 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule44 #-} @@ -961,8 +961,8 @@ wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_TypeSig_vIn37 - (T_TypeSig_vOut37 _lhsOpp) <- return (inv_TypeSig_s38 sem arg) + let arg37 = T_TypeSig_vIn37 + (T_TypeSig_vOut37 _lhsOpp) <- return (inv_TypeSig_s38 sem arg37) return (Syn_TypeSig _lhsOpp) ) @@ -995,9 +995,9 @@ in __result_ ) in C_TypeSig_s38 v37 {-# INLINE rule45 #-} - {-# LINE 41 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 41 "src-ag/AbstractSyntaxDump.ag" #-} rule45 = \ name_ tp_ -> - {-# LINE 41 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 41 "src-ag/AbstractSyntaxDump.ag" #-} ppNestInfo ["TypeSig","TypeSig"] [pp name_, ppShow tp_] [] [] {-# LINE 1003 "dist/build/AbstractSyntaxDump.hs"#-} @@ -1010,8 +1010,8 @@ wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_TypeSigs_vIn40 - (T_TypeSigs_vOut40 _lhsOpp _lhsOppL) <- return (inv_TypeSigs_s41 sem arg) + let arg40 = T_TypeSigs_vIn40 + (T_TypeSigs_vOut40 _lhsOpp _lhsOppL) <- return (inv_TypeSigs_s41 sem arg40) return (Syn_TypeSigs _lhsOpp _lhsOppL) ) @@ -1050,9 +1050,9 @@ in __result_ ) in C_TypeSigs_s41 v40 {-# INLINE rule46 #-} - {-# LINE 59 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 59 "src-ag/AbstractSyntaxDump.ag" #-} rule46 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> - {-# LINE 59 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 59 "src-ag/AbstractSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 1058 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule47 #-} @@ -1073,9 +1073,9 @@ in __result_ ) in C_TypeSigs_s41 v40 {-# INLINE rule48 #-} - {-# LINE 60 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 60 "src-ag/AbstractSyntaxDump.ag" #-} rule48 = \ (_ :: ()) -> - {-# LINE 60 "./src-ag/AbstractSyntaxDump.ag" #-} + {-# LINE 60 "src-ag/AbstractSyntaxDump.ag" #-} [] {-# LINE 1081 "dist/build/AbstractSyntaxDump.hs"#-} {-# INLINE rule49 #-} diff --git a/src-generated/Code.hs b/src-generated/Code.hs --- a/src-generated/Code.hs +++ b/src-generated/Code.hs @@ -1,8 +1,8 @@ --- UUAGC 0.9.50 (src-ag/Code.ag) +-- UUAGC 0.9.51 (src-ag/Code.ag) module Code where -{-# LINE 2 "./src-ag/Code.ag" #-} +{-# LINE 2 "src-ag/Code.ag" #-} import Patterns import Data.Set(Set) @@ -10,7 +10,7 @@ import Data.Map(Map) import qualified Data.Map as Map {-# LINE 13 "dist/build/Code.hs" #-} -{-# LINE 146 "./src-ag/Code.ag" #-} +{-# LINE 146 "src-ag/Code.ag" #-} -- Unboxed tuples -- unbox Whether unboxed tuples are wanted or not diff --git a/src-generated/CodeSyntax.hs b/src-generated/CodeSyntax.hs --- a/src-generated/CodeSyntax.hs +++ b/src-generated/CodeSyntax.hs @@ -1,8 +1,8 @@ --- UUAGC 0.9.50 (src-ag/CodeSyntax.ag) +-- UUAGC 0.9.51 (src-ag/CodeSyntax.ag) module CodeSyntax where -{-# LINE 2 "./src-ag/CodeSyntax.ag" #-} +{-# LINE 2 "src-ag/CodeSyntax.ag" #-} import Patterns import CommonTypes diff --git a/src-generated/CodeSyntaxDump.hs b/src-generated/CodeSyntaxDump.hs --- a/src-generated/CodeSyntaxDump.hs +++ b/src-generated/CodeSyntaxDump.hs @@ -2,14 +2,14 @@ {-# LANGUAGE ScopedTypeVariables #-} module CodeSyntaxDump where -{-# LINE 2 "./src-ag/Patterns.ag" #-} +{-# 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" #-} +{-# LINE 2 "src-ag/CodeSyntax.ag" #-} import Patterns import CommonTypes @@ -17,7 +17,7 @@ import Data.Set(Set) {-# LINE 19 "dist/build/CodeSyntaxDump.hs" #-} -{-# LINE 5 "./src-ag/CodeSyntaxDump.ag" #-} +{-# LINE 5 "src-ag/CodeSyntaxDump.ag" #-} import Data.List import qualified Data.Map as Map @@ -29,7 +29,7 @@ {-# LINE 30 "dist/build/CodeSyntaxDump.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 15 "./src-ag/CodeSyntaxDump.ag" #-} +{-# LINE 15 "src-ag/CodeSyntaxDump.ag" #-} ppChild :: (Identifier,Type,ChildKind) -> PP_Doc ppChild (nm,tp,_) @@ -66,8 +66,8 @@ wrap_CGrammar (T_CGrammar act) (Inh_CGrammar ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CGrammar_vIn1 - (T_CGrammar_vOut1 _lhsOpp) <- return (inv_CGrammar_s2 sem arg) + let arg1 = T_CGrammar_vIn1 + (T_CGrammar_vOut1 _lhsOpp) <- return (inv_CGrammar_s2 sem arg1) return (Syn_CGrammar _lhsOpp) ) @@ -102,9 +102,9 @@ in __result_ ) in C_CGrammar_s2 v1 {-# INLINE rule0 #-} - {-# LINE 47 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 47 "src-ag/CodeSyntaxDump.ag" #-} rule0 = \ ((_nontsIppL) :: [PP_Doc]) derivings_ typeSyns_ -> - {-# LINE 47 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 47 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["CGrammar","CGrammar"] [] [ ppF "typeSyns" $ ppAssocL typeSyns_ , ppF "derivings" $ ppMap $ derivings_ @@ -121,8 +121,8 @@ wrap_CInterface (T_CInterface act) (Inh_CInterface ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CInterface_vIn4 - (T_CInterface_vOut4 _lhsOpp) <- return (inv_CInterface_s5 sem arg) + let arg4 = T_CInterface_vIn4 + (T_CInterface_vOut4 _lhsOpp) <- return (inv_CInterface_s5 sem arg4) return (Syn_CInterface _lhsOpp) ) @@ -157,9 +157,9 @@ in __result_ ) in C_CInterface_s5 v4 {-# INLINE rule1 #-} - {-# LINE 57 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 57 "src-ag/CodeSyntaxDump.ag" #-} rule1 = \ ((_segIppL) :: [PP_Doc]) -> - {-# LINE 57 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 57 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["CInterface","CInterface"] [] [ppF "seg" $ ppVList _segIppL] [] {-# LINE 165 "dist/build/CodeSyntaxDump.hs"#-} @@ -172,8 +172,8 @@ wrap_CNonterminal (T_CNonterminal act) (Inh_CNonterminal ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CNonterminal_vIn7 - (T_CNonterminal_vOut7 _lhsOpp) <- return (inv_CNonterminal_s8 sem arg) + let arg7 = T_CNonterminal_vIn7 + (T_CNonterminal_vOut7 _lhsOpp) <- return (inv_CNonterminal_s8 sem arg7) return (Syn_CNonterminal _lhsOpp) ) @@ -210,9 +210,9 @@ in __result_ ) in C_CNonterminal_s8 v7 {-# INLINE rule2 #-} - {-# LINE 54 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 54 "src-ag/CodeSyntaxDump.ag" #-} rule2 = \ ((_interIpp) :: PP_Doc) ((_prodsIppL) :: [PP_Doc]) inh_ nt_ params_ syn_ -> - {-# LINE 54 "./src-ag/CodeSyntaxDump.ag" #-} + {-# 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"#-} @@ -225,8 +225,8 @@ wrap_CNonterminals (T_CNonterminals act) (Inh_CNonterminals ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CNonterminals_vIn10 - (T_CNonterminals_vOut10 _lhsOpp _lhsOppL) <- return (inv_CNonterminals_s11 sem arg) + let arg10 = T_CNonterminals_vIn10 + (T_CNonterminals_vOut10 _lhsOpp _lhsOppL) <- return (inv_CNonterminals_s11 sem arg10) return (Syn_CNonterminals _lhsOpp _lhsOppL) ) @@ -265,9 +265,9 @@ in __result_ ) in C_CNonterminals_s11 v10 {-# INLINE rule3 #-} - {-# LINE 102 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 102 "src-ag/CodeSyntaxDump.ag" #-} rule3 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> - {-# LINE 102 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 102 "src-ag/CodeSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 273 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule4 #-} @@ -288,9 +288,9 @@ in __result_ ) in C_CNonterminals_s11 v10 {-# INLINE rule5 #-} - {-# LINE 103 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 103 "src-ag/CodeSyntaxDump.ag" #-} rule5 = \ (_ :: ()) -> - {-# LINE 103 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 103 "src-ag/CodeSyntaxDump.ag" #-} [] {-# LINE 296 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule6 #-} @@ -306,8 +306,8 @@ wrap_CProduction (T_CProduction act) (Inh_CProduction ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CProduction_vIn13 - (T_CProduction_vOut13 _lhsOpp) <- return (inv_CProduction_s14 sem arg) + let arg13 = T_CProduction_vIn13 + (T_CProduction_vOut13 _lhsOpp) <- return (inv_CProduction_s14 sem arg13) return (Syn_CProduction _lhsOpp) ) @@ -342,9 +342,9 @@ in __result_ ) in C_CProduction_s14 v13 {-# INLINE rule7 #-} - {-# LINE 63 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 63 "src-ag/CodeSyntaxDump.ag" #-} rule7 = \ ((_visitsIppL) :: [PP_Doc]) children_ con_ terminals_ -> - {-# LINE 63 "./src-ag/CodeSyntaxDump.ag" #-} + {-# 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"#-} @@ -357,8 +357,8 @@ wrap_CProductions (T_CProductions act) (Inh_CProductions ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CProductions_vIn16 - (T_CProductions_vOut16 _lhsOpp _lhsOppL) <- return (inv_CProductions_s17 sem arg) + let arg16 = T_CProductions_vIn16 + (T_CProductions_vOut16 _lhsOpp _lhsOppL) <- return (inv_CProductions_s17 sem arg16) return (Syn_CProductions _lhsOpp _lhsOppL) ) @@ -397,9 +397,9 @@ in __result_ ) in C_CProductions_s17 v16 {-# INLINE rule8 #-} - {-# LINE 94 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 94 "src-ag/CodeSyntaxDump.ag" #-} rule8 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> - {-# LINE 94 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 94 "src-ag/CodeSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 405 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule9 #-} @@ -420,9 +420,9 @@ in __result_ ) in C_CProductions_s17 v16 {-# INLINE rule10 #-} - {-# LINE 95 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 95 "src-ag/CodeSyntaxDump.ag" #-} rule10 = \ (_ :: ()) -> - {-# LINE 95 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 95 "src-ag/CodeSyntaxDump.ag" #-} [] {-# LINE 428 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule11 #-} @@ -438,8 +438,8 @@ wrap_CRule (T_CRule act) (Inh_CRule ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CRule_vIn19 - (T_CRule_vOut19 _lhsOpp) <- return (inv_CRule_s20 sem arg) + let arg19 = T_CRule_vIn19 + (T_CRule_vOut19 _lhsOpp) <- return (inv_CRule_s20 sem arg19) return (Syn_CRule _lhsOpp) ) @@ -475,9 +475,9 @@ in __result_ ) in C_CRule_s20 v19 {-# INLINE rule12 #-} - {-# LINE 69 "./src-ag/CodeSyntaxDump.ag" #-} + {-# 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" #-} + {-# LINE 69 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["CRule","CRule"] [pp name_] [ppF "isIn" $ ppBool isIn_, ppF "hasCode" $ ppBool hasCode_, ppF "nt" $ pp nt_, ppF "con" $ pp con_, ppF "field" $ pp field_, ppF "childnt" $ ppMaybeShow childnt_, ppF "tp" $ ppMaybeShow tp_, ppF "pattern" $ if isIn_ then pp "" else _patternIpp, ppF "rhs" $ ppStrings rhs_, ppF "defines" $ ppVertexMap defines_, ppF "owrt" $ ppBool owrt_, ppF "origin" $ pp origin_] [] {-# LINE 483 "dist/build/CodeSyntaxDump.hs"#-} {-# NOINLINE sem_CRule_CChildVisit #-} @@ -493,9 +493,9 @@ in __result_ ) in C_CRule_s20 v19 {-# INLINE rule13 #-} - {-# LINE 70 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 70 "src-ag/CodeSyntaxDump.ag" #-} rule13 = \ inh_ isLast_ name_ nr_ nt_ syn_ -> - {-# LINE 70 "./src-ag/CodeSyntaxDump.ag" #-} + {-# 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"#-} @@ -508,8 +508,8 @@ wrap_CSegment (T_CSegment act) (Inh_CSegment ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CSegment_vIn22 - (T_CSegment_vOut22 _lhsOpp) <- return (inv_CSegment_s23 sem arg) + let arg22 = T_CSegment_vIn22 + (T_CSegment_vOut22 _lhsOpp) <- return (inv_CSegment_s23 sem arg22) return (Syn_CSegment _lhsOpp) ) @@ -542,9 +542,9 @@ in __result_ ) in C_CSegment_s23 v22 {-# INLINE rule14 #-} - {-# LINE 60 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 60 "src-ag/CodeSyntaxDump.ag" #-} rule14 = \ inh_ syn_ -> - {-# LINE 60 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 60 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["CSegment","CSegment"] [] [ppF "inh" $ ppMap inh_, ppF "syn" $ ppMap syn_] [] {-# LINE 550 "dist/build/CodeSyntaxDump.hs"#-} @@ -557,8 +557,8 @@ wrap_CSegments (T_CSegments act) (Inh_CSegments ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CSegments_vIn25 - (T_CSegments_vOut25 _lhsOpp _lhsOppL) <- return (inv_CSegments_s26 sem arg) + let arg25 = T_CSegments_vIn25 + (T_CSegments_vOut25 _lhsOpp _lhsOppL) <- return (inv_CSegments_s26 sem arg25) return (Syn_CSegments _lhsOpp _lhsOppL) ) @@ -597,9 +597,9 @@ in __result_ ) in C_CSegments_s26 v25 {-# INLINE rule15 #-} - {-# LINE 98 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 98 "src-ag/CodeSyntaxDump.ag" #-} rule15 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> - {-# LINE 98 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 98 "src-ag/CodeSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 605 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule16 #-} @@ -620,9 +620,9 @@ in __result_ ) in C_CSegments_s26 v25 {-# INLINE rule17 #-} - {-# LINE 99 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 99 "src-ag/CodeSyntaxDump.ag" #-} rule17 = \ (_ :: ()) -> - {-# LINE 99 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 99 "src-ag/CodeSyntaxDump.ag" #-} [] {-# LINE 628 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule18 #-} @@ -638,8 +638,8 @@ wrap_CVisit (T_CVisit act) (Inh_CVisit ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CVisit_vIn28 - (T_CVisit_vOut28 _lhsOpp) <- return (inv_CVisit_s29 sem arg) + let arg28 = T_CVisit_vIn28 + (T_CVisit_vOut28 _lhsOpp) <- return (inv_CVisit_s29 sem arg28) return (Syn_CVisit _lhsOpp) ) @@ -676,9 +676,9 @@ in __result_ ) in C_CVisit_s29 v28 {-# INLINE rule19 #-} - {-# LINE 66 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 66 "src-ag/CodeSyntaxDump.ag" #-} rule19 = \ ((_intraIppL) :: [PP_Doc]) ((_vssIppL) :: [PP_Doc]) inh_ ordered_ syn_ -> - {-# LINE 66 "./src-ag/CodeSyntaxDump.ag" #-} + {-# 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"#-} @@ -691,8 +691,8 @@ wrap_CVisits (T_CVisits act) (Inh_CVisits ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CVisits_vIn31 - (T_CVisits_vOut31 _lhsOpp _lhsOppL) <- return (inv_CVisits_s32 sem arg) + let arg31 = T_CVisits_vIn31 + (T_CVisits_vOut31 _lhsOpp _lhsOppL) <- return (inv_CVisits_s32 sem arg31) return (Syn_CVisits _lhsOpp _lhsOppL) ) @@ -731,9 +731,9 @@ in __result_ ) in C_CVisits_s32 v31 {-# INLINE rule20 #-} - {-# LINE 90 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 90 "src-ag/CodeSyntaxDump.ag" #-} rule20 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> - {-# LINE 90 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 90 "src-ag/CodeSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 739 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule21 #-} @@ -754,9 +754,9 @@ in __result_ ) in C_CVisits_s32 v31 {-# INLINE rule22 #-} - {-# LINE 91 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 91 "src-ag/CodeSyntaxDump.ag" #-} rule22 = \ (_ :: ()) -> - {-# LINE 91 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 91 "src-ag/CodeSyntaxDump.ag" #-} [] {-# LINE 762 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule23 #-} @@ -772,8 +772,8 @@ wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Pattern_vIn34 - (T_Pattern_vOut34 _lhsOcopy _lhsOpp) <- return (inv_Pattern_s35 sem arg) + let arg34 = T_Pattern_vIn34 + (T_Pattern_vOut34 _lhsOcopy _lhsOpp) <- return (inv_Pattern_s35 sem arg34) return (Syn_Pattern _lhsOcopy _lhsOpp) ) @@ -815,9 +815,9 @@ in __result_ ) in C_Pattern_s35 v34 {-# INLINE rule24 #-} - {-# LINE 73 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 73 "src-ag/CodeSyntaxDump.ag" #-} rule24 = \ ((_patsIppL) :: [PP_Doc]) name_ -> - {-# LINE 73 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 73 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["Pattern","Constr"] [pp name_] [ppF "pats" $ ppVList _patsIppL] [] {-# LINE 823 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule25 #-} @@ -844,9 +844,9 @@ in __result_ ) in C_Pattern_s35 v34 {-# INLINE rule27 #-} - {-# LINE 74 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 74 "src-ag/CodeSyntaxDump.ag" #-} rule27 = \ ((_patsIppL) :: [PP_Doc]) pos_ -> - {-# LINE 74 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 74 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["Pattern","Product"] [ppShow pos_] [ppF "pats" $ ppVList _patsIppL] [] {-# LINE 852 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule28 #-} @@ -873,9 +873,9 @@ in __result_ ) in C_Pattern_s35 v34 {-# INLINE rule30 #-} - {-# LINE 75 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 75 "src-ag/CodeSyntaxDump.ag" #-} rule30 = \ ((_patIpp) :: PP_Doc) attr_ field_ -> - {-# LINE 75 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 75 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["Pattern","Alias"] [pp field_, pp attr_] [ppF "pat" $ _patIpp] [] {-# LINE 881 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule31 #-} @@ -926,9 +926,9 @@ in __result_ ) in C_Pattern_s35 v34 {-# INLINE rule36 #-} - {-# LINE 76 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 76 "src-ag/CodeSyntaxDump.ag" #-} rule36 = \ pos_ -> - {-# LINE 76 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 76 "src-ag/CodeSyntaxDump.ag" #-} ppNestInfo ["Pattern","Underscore"] [ppShow pos_] [] [] {-# LINE 934 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule37 #-} @@ -947,8 +947,8 @@ wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Patterns_vIn37 - (T_Patterns_vOut37 _lhsOcopy _lhsOpp _lhsOppL) <- return (inv_Patterns_s38 sem arg) + let arg37 = T_Patterns_vIn37 + (T_Patterns_vOut37 _lhsOcopy _lhsOpp _lhsOppL) <- return (inv_Patterns_s38 sem arg37) return (Syn_Patterns _lhsOcopy _lhsOpp _lhsOppL) ) @@ -990,9 +990,9 @@ in __result_ ) in C_Patterns_s38 v37 {-# INLINE rule39 #-} - {-# LINE 82 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 82 "src-ag/CodeSyntaxDump.ag" #-} rule39 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> - {-# LINE 82 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 82 "src-ag/CodeSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 998 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule40 #-} @@ -1022,9 +1022,9 @@ in __result_ ) in C_Patterns_s38 v37 {-# INLINE rule43 #-} - {-# LINE 83 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 83 "src-ag/CodeSyntaxDump.ag" #-} rule43 = \ (_ :: ()) -> - {-# LINE 83 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 83 "src-ag/CodeSyntaxDump.ag" #-} [] {-# LINE 1030 "dist/build/CodeSyntaxDump.hs"#-} {-# INLINE rule44 #-} @@ -1046,8 +1046,8 @@ wrap_Sequence (T_Sequence act) (Inh_Sequence ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Sequence_vIn40 - (T_Sequence_vOut40 _lhsOppL) <- return (inv_Sequence_s41 sem arg) + let arg40 = T_Sequence_vIn40 + (T_Sequence_vOut40 _lhsOppL) <- return (inv_Sequence_s41 sem arg40) return (Syn_Sequence _lhsOppL) ) @@ -1084,9 +1084,9 @@ in __result_ ) in C_Sequence_s41 v40 {-# INLINE rule47 #-} - {-# LINE 86 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 86 "src-ag/CodeSyntaxDump.ag" #-} rule47 = \ ((_hdIpp) :: PP_Doc) ((_tlIppL) :: [PP_Doc]) -> - {-# LINE 86 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 86 "src-ag/CodeSyntaxDump.ag" #-} _hdIpp : _tlIppL {-# LINE 1092 "dist/build/CodeSyntaxDump.hs"#-} {-# NOINLINE sem_Sequence_Nil #-} @@ -1102,8 +1102,8 @@ in __result_ ) in C_Sequence_s41 v40 {-# INLINE rule48 #-} - {-# LINE 87 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 87 "src-ag/CodeSyntaxDump.ag" #-} rule48 = \ (_ :: ()) -> - {-# LINE 87 "./src-ag/CodeSyntaxDump.ag" #-} + {-# LINE 87 "src-ag/CodeSyntaxDump.ag" #-} [] {-# LINE 1110 "dist/build/CodeSyntaxDump.hs"#-} diff --git a/src-generated/ConcreteSyntax.hs b/src-generated/ConcreteSyntax.hs --- a/src-generated/ConcreteSyntax.hs +++ b/src-generated/ConcreteSyntax.hs @@ -1,8 +1,8 @@ --- UUAGC 0.9.50 (src-ag/ConcreteSyntax.ag) +-- UUAGC 0.9.51 (src-ag/ConcreteSyntax.ag) module ConcreteSyntax where -{-# LINE 2 "./src-ag/ConcreteSyntax.ag" #-} +{-# LINE 2 "src-ag/ConcreteSyntax.ag" #-} import UU.Scanner.Position (Pos) import Patterns (Pattern) diff --git a/src-generated/DeclBlocks.hs b/src-generated/DeclBlocks.hs --- a/src-generated/DeclBlocks.hs +++ b/src-generated/DeclBlocks.hs @@ -1,8 +1,8 @@ --- UUAGC 0.9.50 (src-ag/DeclBlocks.ag) +-- UUAGC 0.9.51 (src-ag/DeclBlocks.ag) module DeclBlocks where -{-# LINE 2 "./src-ag/DeclBlocks.ag" #-} +{-# LINE 2 "src-ag/DeclBlocks.ag" #-} import Code (Decl,Expr) {-# LINE 9 "dist/build/DeclBlocks.hs" #-} diff --git a/src-generated/DefaultRules.hs b/src-generated/DefaultRules.hs --- a/src-generated/DefaultRules.hs +++ b/src-generated/DefaultRules.hs @@ -3,14 +3,14 @@ {-# LANGUAGE ScopedTypeVariables #-} module DefaultRules where -{-# LINE 2 "./src-ag/Patterns.ag" #-} +{-# 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" #-} +{-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) @@ -22,7 +22,7 @@ import ErrorMessages {-# LINE 24 "dist/build/DefaultRules.hs" #-} -{-# LINE 15 "./src-ag/DefaultRules.ag" #-} +{-# LINE 15 "src-ag/DefaultRules.ag" #-} import qualified Data.List import qualified Data.Set as Set @@ -45,7 +45,7 @@ {-# LINE 46 "dist/build/DefaultRules.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 80 "./src-ag/DefaultRules.ag" #-} +{-# LINE 80 "src-ag/DefaultRules.ag" #-} fieldName n = '@' : getName n @@ -157,7 +157,7 @@ {-# LINE 159 "dist/build/DefaultRules.hs" #-} -{-# LINE 255 "./src-ag/DefaultRules.ag" #-} +{-# LINE 255 "src-ag/DefaultRules.ag" #-} @@ -309,7 +309,7 @@ deprChild = maybe False (== _ACHILD) sel {-# LINE 311 "dist/build/DefaultRules.hs" #-} -{-# LINE 488 "./src-ag/DefaultRules.ag" #-} +{-# LINE 488 "src-ag/DefaultRules.ag" #-} buildTuple fs = "(" ++ concat (intersperse "," fs) ++ ")" @@ -378,7 +378,7 @@ childLoc = Ident (show target ++ "_merge") (getPos target) {-# LINE 380 "dist/build/DefaultRules.hs" #-} -{-# LINE 606 "./src-ag/DefaultRules.ag" #-} +{-# LINE 606 "src-ag/DefaultRules.ag" #-} elimSelfId :: NontermIdent -> [Identifier] -> Type -> Type elimSelfId nt args Self = NT nt (map getName args) False @@ -389,7 +389,7 @@ elimSelfStr _ _ tp = tp {-# LINE 391 "dist/build/DefaultRules.hs" #-} -{-# LINE 658 "./src-ag/DefaultRules.ag" #-} +{-# 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 @@ -404,13 +404,13 @@ r' = Rule Nothing pat expr' owrt origin False True identity Nothing False {-# LINE 406 "dist/build/DefaultRules.hs" #-} -{-# LINE 675 "./src-ag/DefaultRules.ag" #-} +{-# 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" #-} +{-# LINE 680 "src-ag/DefaultRules.ag" #-} {- multiRule replaces @@ -468,8 +468,8 @@ wrap_Child !(T_Child act) !(Inh_Child _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = 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 arg) + 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) ) @@ -591,77 +591,77 @@ in __result_ ) in C_Child_s56 v53 {-# NOINLINE[1] rule0 #-} - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 19 "src-ag/DistChildAttr.ag" #-} rule0 = \ !name_ !tp_ -> - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 23 "src-ag/DistChildAttr.ag" #-} rule1 = \ !_chnt ((!_lhsIinhMap) :: Map Identifier Attributes) -> - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 24 "src-ag/DistChildAttr.ag" #-} rule2 = \ !_chnt ((!_lhsIsynMap) :: Map Identifier Attributes) -> - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 229 "src-ag/DefaultRules.ag" #-} rule3 = \ !name_ -> - {-# LINE 229 "./src-ag/DefaultRules.ag" #-} + {-# LINE 229 "src-ag/DefaultRules.ag" #-} name_ {-# LINE 620 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule4 #-} - {-# LINE 238 "./src-ag/DefaultRules.ag" #-} + {-# LINE 238 "src-ag/DefaultRules.ag" #-} rule4 = \ !_inh1 -> - {-# LINE 238 "./src-ag/DefaultRules.ag" #-} + {-# LINE 238 "src-ag/DefaultRules.ag" #-} _inh1 {-# LINE 626 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule5 #-} - {-# LINE 239 "./src-ag/DefaultRules.ag" #-} + {-# LINE 239 "src-ag/DefaultRules.ag" #-} rule5 = \ ((!_lhsImerged) :: Set Identifier) !_syn1 !name_ -> - {-# LINE 239 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 574 "src-ag/DefaultRules.ag" #-} rule6 = \ !kind_ !name_ !tp_ -> - {-# LINE 574 "./src-ag/DefaultRules.ag" #-} + {-# LINE 574 "src-ag/DefaultRules.ag" #-} (name_,tp_,kind_) {-# LINE 640 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule7 #-} - {-# LINE 596 "./src-ag/DefaultRules.ag" #-} + {-# LINE 596 "src-ag/DefaultRules.ag" #-} rule7 = \ !name_ !tp_ -> - {-# LINE 596 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 600 "src-ag/DefaultRules.ag" #-} rule8 = \ !_inh !_nt !_params -> - {-# LINE 600 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 601 "src-ag/DefaultRules.ag" #-} rule9 = \ !_nt !_params !_syn -> - {-# LINE 601 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 642 "src-ag/DefaultRules.ag" #-} rule10 = \ !kind_ !name_ !tp_ -> - {-# LINE 642 "./src-ag/DefaultRules.ag" #-} + {-# LINE 642 "src-ag/DefaultRules.ag" #-} Child name_ tp_ kind_ {-# LINE 667 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule11 #-} @@ -677,8 +677,8 @@ wrap_Children !(T_Children act) !(Inh_Children _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = 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 arg) + 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) ) @@ -811,21 +811,21 @@ in __result_ ) in C_Children_s53 v48 {-# NOINLINE[1] rule13 #-} - {-# LINE 244 "./src-ag/DefaultRules.ag" #-} + {-# LINE 244 "src-ag/DefaultRules.ag" #-} rule13 = \ ((!_hdIinherited) :: Attributes) ((!_hdIname) :: Identifier) ((!_tlIinputs) :: [(Identifier, Attributes)]) -> - {-# LINE 244 "./src-ag/DefaultRules.ag" #-} + {-# LINE 244 "src-ag/DefaultRules.ag" #-} (_hdIname, _hdIinherited) : _tlIinputs {-# LINE 819 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule14 #-} - {-# LINE 245 "./src-ag/DefaultRules.ag" #-} + {-# LINE 245 "src-ag/DefaultRules.ag" #-} rule14 = \ ((!_hdIname) :: Identifier) ((!_hdIsynthesized) :: Attributes) ((!_tlIoutputs) :: [(Identifier, Attributes)]) -> - {-# LINE 245 "./src-ag/DefaultRules.ag" #-} + {-# LINE 245 "src-ag/DefaultRules.ag" #-} (_hdIname, _hdIsynthesized) : _tlIoutputs {-# LINE 825 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule15 #-} - {-# LINE 570 "./src-ag/DefaultRules.ag" #-} + {-# LINE 570 "src-ag/DefaultRules.ag" #-} rule15 = \ ((!_hdIfield) :: (Identifier,Type,ChildKind) ) ((!_tlIfields) :: [(Identifier,Type,ChildKind)]) -> - {-# LINE 570 "./src-ag/DefaultRules.ag" #-} + {-# LINE 570 "src-ag/DefaultRules.ag" #-} _hdIfield : _tlIfields {-# LINE 831 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule16 #-} @@ -919,21 +919,21 @@ in __result_ ) in C_Children_s53 v48 {-# NOINLINE[1] rule33 #-} - {-# LINE 246 "./src-ag/DefaultRules.ag" #-} + {-# LINE 246 "src-ag/DefaultRules.ag" #-} rule33 = \ (_ :: ()) -> - {-# LINE 246 "./src-ag/DefaultRules.ag" #-} + {-# LINE 246 "src-ag/DefaultRules.ag" #-} [] {-# LINE 927 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule34 #-} - {-# LINE 247 "./src-ag/DefaultRules.ag" #-} + {-# LINE 247 "src-ag/DefaultRules.ag" #-} rule34 = \ (_ :: ()) -> - {-# LINE 247 "./src-ag/DefaultRules.ag" #-} + {-# LINE 247 "src-ag/DefaultRules.ag" #-} [] {-# LINE 933 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule35 #-} - {-# LINE 571 "./src-ag/DefaultRules.ag" #-} + {-# LINE 571 "src-ag/DefaultRules.ag" #-} rule35 = \ (_ :: ()) -> - {-# LINE 571 "./src-ag/DefaultRules.ag" #-} + {-# LINE 571 "src-ag/DefaultRules.ag" #-} [] {-# LINE 939 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule36 #-} @@ -955,8 +955,8 @@ wrap_Grammar !(T_Grammar act) !(Inh_Grammar _lhsIconstructorTypeMap _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Grammar_vIn2 _lhsIconstructorTypeMap _lhsIoptions - !(T_Grammar_vOut2 _lhsOerrors _lhsOoutput) <- return (inv_Grammar_s4 sem arg) + let arg2 = T_Grammar_vIn2 _lhsIconstructorTypeMap _lhsIoptions + !(T_Grammar_vOut2 _lhsOerrors _lhsOoutput) <- return (inv_Grammar_s4 sem arg2) return (Syn_Grammar _lhsOerrors _lhsOoutput) ) @@ -1009,75 +1009,75 @@ in __result_ ) in C_Grammar_s4 v2 {-# INLINE rule39 #-} - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 15 "src-ag/DistChildAttr.ag" #-} rule39 = \ ((!_nontsIinhMap') :: Map Identifier Attributes) -> - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 15 "src-ag/DistChildAttr.ag" #-} _nontsIinhMap' {-# LINE 1017 "dist/build/DefaultRules.hs"#-} {-# INLINE rule40 #-} - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 16 "src-ag/DistChildAttr.ag" #-} rule40 = \ ((!_nontsIsynMap') :: Map Identifier Attributes) -> - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 16 "src-ag/DistChildAttr.ag" #-} _nontsIsynMap' {-# LINE 1023 "dist/build/DefaultRules.hs"#-} {-# INLINE rule41 #-} - {-# LINE 60 "./src-ag/DefaultRules.ag" #-} + {-# LINE 60 "src-ag/DefaultRules.ag" #-} rule41 = \ ((!_lhsIoptions) :: Options) -> - {-# LINE 60 "./src-ag/DefaultRules.ag" #-} + {-# LINE 60 "src-ag/DefaultRules.ag" #-} rename _lhsIoptions {-# LINE 1029 "dist/build/DefaultRules.hs"#-} {-# INLINE rule42 #-} - {-# LINE 61 "./src-ag/DefaultRules.ag" #-} + {-# LINE 61 "src-ag/DefaultRules.ag" #-} rule42 = \ ((!_lhsIoptions) :: Options) -> - {-# LINE 61 "./src-ag/DefaultRules.ag" #-} + {-# LINE 61 "src-ag/DefaultRules.ag" #-} modcopy _lhsIoptions {-# LINE 1035 "dist/build/DefaultRules.hs"#-} {-# INLINE rule43 #-} - {-# LINE 69 "./src-ag/DefaultRules.ag" #-} + {-# LINE 69 "src-ag/DefaultRules.ag" #-} rule43 = \ !wrappers_ -> - {-# LINE 69 "./src-ag/DefaultRules.ag" #-} + {-# LINE 69 "src-ag/DefaultRules.ag" #-} wrappers_ {-# LINE 1041 "dist/build/DefaultRules.hs"#-} {-# INLINE rule45 #-} - {-# LINE 231 "./src-ag/DefaultRules.ag" #-} + {-# LINE 231 "src-ag/DefaultRules.ag" #-} rule45 = \ !useMap_ -> - {-# LINE 231 "./src-ag/DefaultRules.ag" #-} + {-# LINE 231 "src-ag/DefaultRules.ag" #-} useMap_ {-# LINE 1047 "dist/build/DefaultRules.hs"#-} {-# INLINE rule46 #-} - {-# LINE 233 "./src-ag/DefaultRules.ag" #-} + {-# LINE 233 "src-ag/DefaultRules.ag" #-} rule46 = \ !typeSyns_ -> - {-# LINE 233 "./src-ag/DefaultRules.ag" #-} + {-# LINE 233 "src-ag/DefaultRules.ag" #-} typeSyns_ {-# LINE 1053 "dist/build/DefaultRules.hs"#-} {-# INLINE rule47 #-} - {-# LINE 623 "./src-ag/DefaultRules.ag" #-} + {-# LINE 623 "src-ag/DefaultRules.ag" #-} rule47 = \ (_ :: ()) -> - {-# LINE 623 "./src-ag/DefaultRules.ag" #-} + {-# LINE 623 "src-ag/DefaultRules.ag" #-} 1 {-# LINE 1059 "dist/build/DefaultRules.hs"#-} {-# INLINE rule48 #-} - {-# LINE 737 "./src-ag/DefaultRules.ag" #-} + {-# LINE 737 "src-ag/DefaultRules.ag" #-} rule48 = \ !manualAttrOrderMap_ -> - {-# LINE 737 "./src-ag/DefaultRules.ag" #-} + {-# LINE 737 "src-ag/DefaultRules.ag" #-} manualAttrOrderMap_ {-# LINE 1065 "dist/build/DefaultRules.hs"#-} {-# INLINE rule49 #-} - {-# LINE 803 "./src-ag/DefaultRules.ag" #-} + {-# LINE 803 "src-ag/DefaultRules.ag" #-} rule49 = \ !augmentsMap_ -> - {-# LINE 803 "./src-ag/DefaultRules.ag" #-} + {-# LINE 803 "src-ag/DefaultRules.ag" #-} augmentsMap_ {-# LINE 1071 "dist/build/DefaultRules.hs"#-} {-# INLINE rule50 #-} - {-# LINE 810 "./src-ag/DefaultRules.ag" #-} + {-# LINE 810 "src-ag/DefaultRules.ag" #-} rule50 = \ !aroundsMap_ -> - {-# LINE 810 "./src-ag/DefaultRules.ag" #-} + {-# LINE 810 "src-ag/DefaultRules.ag" #-} aroundsMap_ {-# LINE 1077 "dist/build/DefaultRules.hs"#-} {-# INLINE rule51 #-} - {-# LINE 818 "./src-ag/DefaultRules.ag" #-} + {-# LINE 818 "src-ag/DefaultRules.ag" #-} rule51 = \ !mergeMap_ -> - {-# LINE 818 "./src-ag/DefaultRules.ag" #-} + {-# LINE 818 "src-ag/DefaultRules.ag" #-} mergeMap_ {-# LINE 1083 "dist/build/DefaultRules.hs"#-} {-# INLINE rule52 #-} @@ -1105,8 +1105,8 @@ 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 arg = 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 arg) + 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) ) @@ -1409,93 +1409,93 @@ in __result_ ) in C_Nonterminal_s52 v46 {-# NOINLINE rule57 #-} - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 7 "src-ag/DistChildAttr.ag" #-} rule57 = \ !inh_ !nt_ -> - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 7 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ inh_ {-# LINE 1417 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule58 #-} - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 8 "src-ag/DistChildAttr.ag" #-} rule58 = \ !nt_ !syn_ -> - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 8 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ syn_ {-# LINE 1423 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule59 #-} - {-# LINE 44 "./src-ag/DefaultRules.ag" #-} + {-# LINE 44 "src-ag/DefaultRules.ag" #-} rule59 = \ !params_ -> - {-# LINE 44 "./src-ag/DefaultRules.ag" #-} + {-# LINE 44 "src-ag/DefaultRules.ag" #-} params_ {-# LINE 1429 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule60 #-} - {-# LINE 205 "./src-ag/DefaultRules.ag" #-} + {-# LINE 205 "src-ag/DefaultRules.ag" #-} rule60 = \ !nt_ -> - {-# LINE 205 "./src-ag/DefaultRules.ag" #-} + {-# LINE 205 "src-ag/DefaultRules.ag" #-} Set.singleton nt_ {-# LINE 1435 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule61 #-} - {-# LINE 219 "./src-ag/DefaultRules.ag" #-} + {-# LINE 219 "src-ag/DefaultRules.ag" #-} rule61 = \ !_inh1 -> - {-# LINE 219 "./src-ag/DefaultRules.ag" #-} + {-# LINE 219 "src-ag/DefaultRules.ag" #-} _inh1 {-# LINE 1441 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule62 #-} - {-# LINE 220 "./src-ag/DefaultRules.ag" #-} + {-# LINE 220 "src-ag/DefaultRules.ag" #-} rule62 = \ !_syn1 -> - {-# LINE 220 "./src-ag/DefaultRules.ag" #-} + {-# LINE 220 "src-ag/DefaultRules.ag" #-} _syn1 {-# LINE 1447 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule64 #-} - {-# LINE 222 "./src-ag/DefaultRules.ag" #-} + {-# LINE 222 "src-ag/DefaultRules.ag" #-} rule64 = \ !syn_ -> - {-# LINE 222 "./src-ag/DefaultRules.ag" #-} + {-# LINE 222 "src-ag/DefaultRules.ag" #-} syn_ {-# LINE 1453 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule65 #-} - {-# LINE 223 "./src-ag/DefaultRules.ag" #-} + {-# LINE 223 "src-ag/DefaultRules.ag" #-} rule65 = \ ((!_lhsIuseMap) :: UseMap) !nt_ -> - {-# LINE 223 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 235 "src-ag/DefaultRules.ag" #-} rule66 = \ !nt_ -> - {-# LINE 235 "./src-ag/DefaultRules.ag" #-} + {-# LINE 235 "src-ag/DefaultRules.ag" #-} nt_ {-# LINE 1465 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule67 #-} - {-# LINE 592 "./src-ag/DefaultRules.ag" #-} + {-# LINE 592 "src-ag/DefaultRules.ag" #-} rule67 = \ !inh_ !nt_ !params_ -> - {-# LINE 592 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 593 "src-ag/DefaultRules.ag" #-} rule68 = \ !nt_ !params_ !syn_ -> - {-# LINE 593 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 632 "src-ag/DefaultRules.ag" #-} rule69 = \ !_inh1 ((!_prodsIoutput) :: Productions) !_syn1 !nt_ !params_ -> - {-# LINE 632 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 804 "src-ag/DefaultRules.ag" #-} rule70 = \ ((!_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !nt_ -> - {-# LINE 804 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 811 "src-ag/DefaultRules.ag" #-} rule71 = \ ((!_lhsIaroundsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !nt_ -> - {-# LINE 811 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 819 "src-ag/DefaultRules.ag" #-} rule72 = \ ((!_lhsImergesIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !nt_ -> - {-# LINE 819 "./src-ag/DefaultRules.ag" #-} + {-# LINE 819 "src-ag/DefaultRules.ag" #-} Map.findWithDefault Map.empty nt_ _lhsImergesIn {-# LINE 1501 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule73 #-} @@ -1553,8 +1553,8 @@ 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 arg = 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 arg) + 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) ) @@ -2074,8 +2074,8 @@ wrap_Pattern !(T_Pattern act) !(Inh_Pattern _lhsIcon _lhsInt) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Pattern_vIn5 _lhsIcon _lhsInt - !(T_Pattern_vOut5 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput) <- return (inv_Pattern_s10 sem K_Pattern_v5 arg) + 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) ) @@ -2606,23 +2606,23 @@ in __result_ ) in C_Pattern_s55 k55 {-# NOINLINE rule154 #-} - {-# LINE 564 "./src-ag/DefaultRules.ag" #-} + {-# LINE 564 "src-ag/DefaultRules.ag" #-} rule154 = \ ((!_patIdefinedAttrs) :: Set (Identifier,Identifier)) !attr_ !field_ -> - {-# LINE 564 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 565 "src-ag/DefaultRules.ag" #-} rule155 = \ ((!_patIlocals) :: Set Identifier) !attr_ !field_ -> - {-# LINE 565 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 582 "src-ag/DefaultRules.ag" #-} rule156 = \ (_ :: ()) -> - {-# LINE 582 "./src-ag/DefaultRules.ag" #-} + {-# LINE 582 "src-ag/DefaultRules.ag" #-} True {-# LINE 2628 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule157 #-} @@ -2964,8 +2964,8 @@ wrap_Patterns !(T_Patterns act) !(Inh_Patterns _lhsIcon _lhsInt) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Patterns_vIn6 _lhsIcon _lhsInt - !(T_Patterns_vOut6 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput) <- return (inv_Patterns_s12 sem K_Patterns_v6 arg) + 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) ) @@ -3361,8 +3361,8 @@ 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 arg = 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 arg) + 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) ) @@ -3519,15 +3519,15 @@ in __result_ ) in C_Production_s48 v40 {-# NOINLINE[1] rule204 #-} - {-# LINE 412 "./src-ag/DefaultRules.ag" #-} + {-# LINE 412 "src-ag/DefaultRules.ag" #-} rule204 = \ ((!_childrenIerrors) :: Seq Error) !_errs !_orderErrs ((!_rulesIerrors) :: Seq Error) -> - {-# LINE 412 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 416 "src-ag/DefaultRules.ag" #-} let locals = _rulesIlocals initenv = Map.fromList ( [ (a,_ACHILD) | (a,_,_) <- _childrenIfields @@ -3586,39 +3586,39 @@ in (uRules++selfLocRules++selfRules++rules5++rules1, errors1> - {-# LINE 636 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 637 "src-ag/DefaultRules.ag" #-} rule207 = \ !_aroundsIn !_extra1 -> - {-# LINE 637 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 638 "src-ag/DefaultRules.ag" #-} rule208 = \ !_extra2 !_mergesIn -> - {-# LINE 638 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 639 "src-ag/DefaultRules.ag" #-} rule209 = \ ((!_childrenIoutput) :: Children) !_extra3 ((!_typeSigsIoutput) :: TypeSigs) !con_ !constraints_ !macro_ !params_ -> - {-# LINE 639 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 747 "src-ag/DefaultRules.ag" #-} rule210 = \ ((!_lhsImanualAttrOrderMap) :: AttrOrderMap) ((!_lhsInt) :: NontermIdent) !con_ -> - {-# LINE 747 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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] @@ -3656,27 +3656,27 @@ ] {-# LINE 3658 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule212 #-} - {-# LINE 805 "./src-ag/DefaultRules.ag" #-} + {-# LINE 805 "src-ag/DefaultRules.ag" #-} rule212 = \ ((!_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) !con_ -> - {-# LINE 805 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 812 "src-ag/DefaultRules.ag" #-} rule213 = \ ((!_lhsIaroundsIn) :: Map ConstructorIdent (Map Identifier [Expression])) !con_ -> - {-# LINE 812 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 820 "src-ag/DefaultRules.ag" #-} rule214 = \ ((!_lhsImergesIn) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !con_ -> - {-# LINE 820 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 821 "src-ag/DefaultRules.ag" #-} rule215 = \ !_mergesIn -> - {-# LINE 821 "./src-ag/DefaultRules.ag" #-} + {-# LINE 821 "src-ag/DefaultRules.ag" #-} Set.fromList [ c | (_,cs,_) <- Map.elems _mergesIn , c <- cs ] {-# LINE 3682 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule217 #-} @@ -3713,8 +3713,8 @@ 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 arg = 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 arg) + 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) ) @@ -4131,8 +4131,8 @@ wrap_Rule !(T_Rule act) !(Inh_Rule _lhsIcon _lhsIconstructorTypeMap _lhsInt _lhsIoptions _lhsIuniq) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = 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 arg) + 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) ) @@ -4263,35 +4263,35 @@ in __result_ ) in C_Rule_s51 v44 {-# NOINLINE[1] rule280 #-} - {-# LINE 585 "./src-ag/DefaultRules.ag" #-} + {-# LINE 585 "src-ag/DefaultRules.ag" #-} rule280 = \ !pure_ -> - {-# LINE 585 "./src-ag/DefaultRules.ag" #-} + {-# LINE 585 "src-ag/DefaultRules.ag" #-} pure_ {-# LINE 4271 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule281 #-} - {-# LINE 652 "./src-ag/DefaultRules.ag" #-} + {-# LINE 652 "src-ag/DefaultRules.ag" #-} rule281 = \ !_output -> - {-# LINE 652 "./src-ag/DefaultRules.ag" #-} + {-# LINE 652 "src-ag/DefaultRules.ag" #-} mkRuleAlias _output {-# LINE 4277 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule282 #-} - {-# LINE 653 "./src-ag/DefaultRules.ag" #-} + {-# LINE 653 "src-ag/DefaultRules.ag" #-} rule282 = \ ((!_lhsIoptions) :: Options) ((!_lhsIuniq) :: Int) !_output1 -> - {-# LINE 653 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 656 "src-ag/DefaultRules.ag" #-} rule283 = \ !_mbAlias !_outputs -> - {-# LINE 656 "./src-ag/DefaultRules.ag" #-} + {-# 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" #-} + {-# LINE 741 "src-ag/DefaultRules.ag" #-} rule284 = \ !mbName_ -> - {-# LINE 741 "./src-ag/DefaultRules.ag" #-} + {-# LINE 741 "src-ag/DefaultRules.ag" #-} case mbName_ of Nothing -> Set.empty Just nm -> Set.singleton nm @@ -4324,8 +4324,8 @@ wrap_Rules !(T_Rules act) !(Inh_Rules _lhsIcon _lhsIconstructorTypeMap _lhsInt _lhsIoptions _lhsIuniq) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = 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 arg) + 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) ) @@ -4457,9 +4457,9 @@ in __result_ ) in C_Rules_s42 v31 {-# NOINLINE[1] rule293 #-} - {-# LINE 648 "./src-ag/DefaultRules.ag" #-} + {-# LINE 648 "src-ag/DefaultRules.ag" #-} rule293 = \ ((!_hdIcontainsVars) :: Bool) ((!_hdIisPure) :: Bool) ((!_hdIoutputs) :: Rules) ((!_tlIoutput) :: Rules) -> - {-# LINE 648 "./src-ag/DefaultRules.ag" #-} + {-# LINE 648 "src-ag/DefaultRules.ag" #-} if _hdIcontainsVars && _hdIisPure then _hdIoutputs ++ _tlIoutput else _tlIoutput {-# LINE 4465 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule294 #-} @@ -4589,8 +4589,8 @@ wrap_TypeSig !(T_TypeSig act) !(Inh_TypeSig _lhsInt _lhsIparams) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_TypeSig_vIn11 _lhsInt _lhsIparams - !(T_TypeSig_vOut11 _lhsOoutput) <- return (inv_TypeSig_s22 sem arg) + let arg11 = T_TypeSig_vIn11 _lhsInt _lhsIparams + !(T_TypeSig_vOut11 _lhsOoutput) <- return (inv_TypeSig_s22 sem arg11) return (Syn_TypeSig _lhsOoutput) ) @@ -4624,15 +4624,15 @@ in __result_ ) in C_TypeSig_s22 v11 {-# INLINE rule317 #-} - {-# LINE 604 "./src-ag/DefaultRules.ag" #-} + {-# LINE 604 "src-ag/DefaultRules.ag" #-} rule317 = \ ((!_lhsInt) :: NontermIdent) ((!_lhsIparams) :: [Identifier]) !tp_ -> - {-# LINE 604 "./src-ag/DefaultRules.ag" #-} + {-# LINE 604 "src-ag/DefaultRules.ag" #-} elimSelfId _lhsInt _lhsIparams tp_ {-# LINE 4632 "dist/build/DefaultRules.hs"#-} {-# INLINE rule318 #-} - {-# LINE 645 "./src-ag/DefaultRules.ag" #-} + {-# LINE 645 "src-ag/DefaultRules.ag" #-} rule318 = \ !_tp1 !name_ -> - {-# LINE 645 "./src-ag/DefaultRules.ag" #-} + {-# LINE 645 "src-ag/DefaultRules.ag" #-} TypeSig name_ _tp1 {-# LINE 4638 "dist/build/DefaultRules.hs"#-} @@ -4645,8 +4645,8 @@ wrap_TypeSigs !(T_TypeSigs act) !(Inh_TypeSigs _lhsInt _lhsIparams) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_TypeSigs_vIn12 _lhsInt _lhsIparams - !(T_TypeSigs_vOut12 _lhsOoutput) <- return (inv_TypeSigs_s24 sem arg) + let arg12 = T_TypeSigs_vIn12 _lhsInt _lhsIparams + !(T_TypeSigs_vOut12 _lhsOoutput) <- return (inv_TypeSigs_s24 sem arg12) return (Syn_TypeSigs _lhsOoutput) ) diff --git a/src-generated/Desugar.hs b/src-generated/Desugar.hs --- a/src-generated/Desugar.hs +++ b/src-generated/Desugar.hs @@ -3,26 +3,26 @@ {-# LANGUAGE ScopedTypeVariables #-} module Desugar where -{-# LINE 2 "./src-ag/HsToken.ag" #-} +{-# 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" #-} +{-# 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" #-} +{-# 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" #-} +{-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) @@ -34,7 +34,7 @@ import ErrorMessages {-# LINE 36 "dist/build/Desugar.hs" #-} -{-# LINE 14 "./src-ag/Desugar.ag" #-} +{-# LINE 14 "src-ag/Desugar.ag" #-} import qualified Data.Set as Set import qualified Data.Map as Map @@ -55,13 +55,13 @@ {-# LINE 56 "dist/build/Desugar.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 98 "./src-ag/Desugar.ag" #-} +{-# 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" #-} +{-# LINE 133 "src-ag/Desugar.ag" #-} maybeError :: a -> Error -> Maybe a -> (a, Seq Error) maybeError def err mb @@ -76,13 +76,13 @@ f = lookup attr {-# LINE 78 "dist/build/Desugar.hs" #-} -{-# LINE 204 "./src-ag/Desugar.ag" #-} +{-# 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" #-} +{-# LINE 251 "src-ag/Desugar.ag" #-} desugarExprs :: Options -> NontermIdent -> ConstructorIdent -> [(Identifier, Identifier)] -> [(Identifier, Identifier)] -> @@ -108,7 +108,7 @@ syn = wrap_Expression sem inh {-# LINE 110 "dist/build/Desugar.hs" #-} -{-# LINE 294 "./src-ag/Desugar.ag" #-} +{-# LINE 294 "src-ag/Desugar.ag" #-} addLateAttr :: Options -> String -> Attributes addLateAttr options mainName @@ -126,8 +126,8 @@ wrap_Child !(T_Child act) !(Inh_Child _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Child_vIn0 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap - !(T_Child_vOut0 _lhsOchildInhs _lhsOchildSyns _lhsOoutput) <- return (inv_Child_s0 sem K_Child_v0 arg) + 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) ) @@ -190,42 +190,42 @@ in __result_ ) in C_Child_s0 k0 {-# NOINLINE[1] rule0 #-} - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 19 "src-ag/DistChildAttr.ag" #-} rule0 = \ !name_ !tp_ -> - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 23 "src-ag/DistChildAttr.ag" #-} rule1 = \ !_chnt ((!_lhsIinhMap) :: Map Identifier Attributes) -> - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 24 "src-ag/DistChildAttr.ag" #-} rule2 = \ !_chnt ((!_lhsIsynMap) :: Map Identifier Attributes) -> - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 130 "src-ag/Desugar.ag" #-} rule3 = \ !_inh !name_ -> - {-# LINE 130 "./src-ag/Desugar.ag" #-} + {-# 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" #-} + {-# LINE 131 "src-ag/Desugar.ag" #-} rule4 = \ !_syn !name_ -> - {-# LINE 131 "./src-ag/Desugar.ag" #-} + {-# 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" #-} + {-# LINE 315 "src-ag/Desugar.ag" #-} rule5 = \ !kind_ !name_ !tp_ -> - {-# LINE 315 "./src-ag/Desugar.ag" #-} + {-# LINE 315 "src-ag/Desugar.ag" #-} Child name_ tp_ kind_ {-# LINE 231 "dist/build/Desugar.hs"#-} @@ -238,8 +238,8 @@ wrap_Children !(T_Children act) !(Inh_Children _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Children_vIn1 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap - !(T_Children_vOut1 _lhsOchildInhs _lhsOchildSyns _lhsOoutput) <- return (inv_Children_s2 sem K_Children_v1 arg) + 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) ) @@ -390,8 +390,8 @@ wrap_Expression !(T_Expression act) !(Inh_Expression _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Expression_vIn2 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr - !(T_Expression_vOut2 _lhsOerrors _lhsOoutput) <- return (inv_Expression_s4 sem arg) + 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) ) @@ -426,9 +426,9 @@ in __result_ ) in C_Expression_s4 v2 {-# INLINE rule23 #-} - {-# LINE 49 "./src-ag/Desugar.ag" #-} + {-# 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" #-} + {-# LINE 49 "src-ag/Desugar.ag" #-} let inh = Inh_HsTokensRoot { childInhs_Inh_HsTokensRoot = _lhsIchildInhs , childSyns_Inh_HsTokensRoot = _lhsIchildSyns , nt_Inh_HsTokensRoot = _lhsInt @@ -441,9 +441,9 @@ in (tks_Syn_HsTokensRoot syn, errors_Syn_HsTokensRoot syn) {-# LINE 443 "dist/build/Desugar.hs"#-} {-# INLINE rule24 #-} - {-# LINE 59 "./src-ag/Desugar.ag" #-} + {-# LINE 59 "src-ag/Desugar.ag" #-} rule24 = \ !_tks' !pos_ -> - {-# LINE 59 "./src-ag/Desugar.ag" #-} + {-# LINE 59 "src-ag/Desugar.ag" #-} Expression pos_ _tks' {-# LINE 449 "dist/build/Desugar.hs"#-} @@ -456,8 +456,8 @@ wrap_Grammar !(T_Grammar act) !(Inh_Grammar _lhsIforcedIrrefutables _lhsImainName _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Grammar_vIn3 _lhsIforcedIrrefutables _lhsImainName _lhsIoptions - !(T_Grammar_vOut3 _lhsOallAttributes _lhsOerrors _lhsOoutput) <- return (inv_Grammar_s6 sem arg) + 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) ) @@ -503,27 +503,27 @@ in __result_ ) in C_Grammar_s6 v3 {-# INLINE rule26 #-} - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 15 "src-ag/DistChildAttr.ag" #-} rule26 = \ ((!_nontsIinhMap') :: Map Identifier Attributes) -> - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 15 "src-ag/DistChildAttr.ag" #-} _nontsIinhMap' {-# LINE 511 "dist/build/Desugar.hs"#-} {-# INLINE rule27 #-} - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 16 "src-ag/DistChildAttr.ag" #-} rule27 = \ ((!_nontsIsynMap') :: Map Identifier Attributes) -> - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 16 "src-ag/DistChildAttr.ag" #-} _nontsIsynMap' {-# LINE 517 "dist/build/Desugar.hs"#-} {-# INLINE rule28 #-} - {-# LINE 235 "./src-ag/Desugar.ag" #-} + {-# LINE 235 "src-ag/Desugar.ag" #-} rule28 = \ !augmentsMap_ -> - {-# LINE 235 "./src-ag/Desugar.ag" #-} + {-# LINE 235 "src-ag/Desugar.ag" #-} augmentsMap_ {-# LINE 523 "dist/build/Desugar.hs"#-} {-# INLINE rule29 #-} - {-# LINE 319 "./src-ag/Desugar.ag" #-} + {-# 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" #-} + {-# LINE 319 "src-ag/Desugar.ag" #-} Grammar typeSyns_ useMap_ derivings_ @@ -564,8 +564,8 @@ wrap_HsToken !(T_HsToken act) !(Inh_HsToken _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_HsToken_vIn4 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent - !(T_HsToken_vOut4 _lhsOaddLines _lhsOerrors _lhsOtks) <- return (inv_HsToken_s8 sem K_HsToken_v4 arg) + 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) ) @@ -659,17 +659,17 @@ in __result_ ) in C_HsToken_s47 v35 {-# NOINLINE[1] rule36 #-} - {-# LINE 74 "./src-ag/Desugar.ag" #-} + {-# LINE 74 "src-ag/Desugar.ag" #-} rule36 = \ ((!_lhsIaddLines) :: Int) ((!_lhsIuseFieldIdent) :: Bool) -> - {-# LINE 74 "./src-ag/Desugar.ag" #-} + {-# 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" #-} + {-# LINE 77 "src-ag/Desugar.ag" #-} rule37 = \ ((!_lhsIaddLines) :: Int) ((!_lhsIruleDescr) :: String) ((!_lhsIuseFieldIdent) :: Bool) !pos_ !var_ -> - {-# LINE 77 "./src-ag/Desugar.ag" #-} + {-# 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 #-} @@ -736,35 +736,35 @@ in __result_ ) in C_HsToken_s47 v35 {-# NOINLINE[1] rule40 #-} - {-# LINE 79 "./src-ag/Desugar.ag" #-} + {-# LINE 79 "src-ag/Desugar.ag" #-} rule40 = \ ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) !attr_ !field_ -> - {-# LINE 79 "./src-ag/Desugar.ag" #-} + {-# 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" #-} + {-# LINE 81 "src-ag/Desugar.ag" #-} rule41 = \ !_mField !field_ -> - {-# LINE 81 "./src-ag/Desugar.ag" #-} + {-# 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" #-} + {-# LINE 82 "src-ag/Desugar.ag" #-} rule42 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) !_mField !field_ -> - {-# LINE 82 "./src-ag/Desugar.ag" #-} + {-# LINE 82 "src-ag/Desugar.ag" #-} maybe (Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ (Ident "" (getPos field_)) False)) (const Seq.empty) _mField {-# LINE 756 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule43 #-} - {-# LINE 84 "./src-ag/Desugar.ag" #-} + {-# LINE 84 "src-ag/Desugar.ag" #-} rule43 = \ !_field' ((!_lhsIaddLines) :: Int) ((!_lhsIuseFieldIdent) :: Bool) !field_ -> - {-# LINE 84 "./src-ag/Desugar.ag" #-} + {-# 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" #-} + {-# LINE 88 "src-ag/Desugar.ag" #-} rule44 = \ !_field' ((!_lhsIaddLines) :: Int) ((!_lhsIruleDescr) :: String) ((!_lhsIuseFieldIdent) :: Bool) !attr_ !pos_ -> - {-# LINE 88 "./src-ag/Desugar.ag" #-} + {-# 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 #-} @@ -822,9 +822,9 @@ in __result_ ) in C_HsToken_s47 v35 {-# NOINLINE[1] rule46 #-} - {-# LINE 90 "./src-ag/Desugar.ag" #-} + {-# LINE 90 "src-ag/Desugar.ag" #-} rule46 = \ ((!_lhsIaddLines) :: Int) !pos_ !value_ -> - {-# LINE 90 "./src-ag/Desugar.ag" #-} + {-# LINE 90 "src-ag/Desugar.ag" #-} HsToken value_ (addl _lhsIaddLines pos_) {-# LINE 830 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule47 #-} @@ -888,9 +888,9 @@ in __result_ ) in C_HsToken_s47 v35 {-# NOINLINE[1] rule50 #-} - {-# LINE 92 "./src-ag/Desugar.ag" #-} + {-# LINE 92 "src-ag/Desugar.ag" #-} rule50 = \ ((!_lhsIaddLines) :: Int) !pos_ !value_ -> - {-# LINE 92 "./src-ag/Desugar.ag" #-} + {-# LINE 92 "src-ag/Desugar.ag" #-} CharToken value_ (addl _lhsIaddLines pos_) {-# LINE 896 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule51 #-} @@ -954,9 +954,9 @@ in __result_ ) in C_HsToken_s47 v35 {-# NOINLINE[1] rule54 #-} - {-# LINE 94 "./src-ag/Desugar.ag" #-} + {-# LINE 94 "src-ag/Desugar.ag" #-} rule54 = \ ((!_lhsIaddLines) :: Int) !pos_ !value_ -> - {-# LINE 94 "./src-ag/Desugar.ag" #-} + {-# LINE 94 "src-ag/Desugar.ag" #-} StrToken value_ (addl _lhsIaddLines pos_) {-# LINE 962 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule55 #-} @@ -1020,9 +1020,9 @@ in __result_ ) in C_HsToken_s47 v35 {-# NOINLINE[1] rule58 #-} - {-# LINE 96 "./src-ag/Desugar.ag" #-} + {-# LINE 96 "src-ag/Desugar.ag" #-} rule58 = \ ((!_lhsIaddLines) :: Int) !mesg_ !pos_ -> - {-# LINE 96 "./src-ag/Desugar.ag" #-} + {-# LINE 96 "src-ag/Desugar.ag" #-} Err mesg_ (addl _lhsIaddLines pos_) {-# LINE 1028 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule59 #-} @@ -1044,8 +1044,8 @@ wrap_HsTokens !(T_HsTokens act) !(Inh_HsTokens _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_HsTokens_vIn5 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent - !(T_HsTokens_vOut5 _lhsOaddLines _lhsOerrors _lhsOtks) <- return (inv_HsTokens_s10 sem K_HsTokens_v5 arg) + 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) ) @@ -1306,8 +1306,8 @@ wrap_HsTokensRoot !(T_HsTokensRoot act) !(Inh_HsTokensRoot _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_HsTokensRoot_vIn6 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent - !(T_HsTokensRoot_vOut6 _lhsOerrors _lhsOtks) <- return (inv_HsTokensRoot_s12 sem arg) + 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) ) @@ -1350,9 +1350,9 @@ in __result_ ) in C_HsTokensRoot_s12 v6 {-# INLINE rule84 #-} - {-# LINE 67 "./src-ag/Desugar.ag" #-} + {-# LINE 67 "src-ag/Desugar.ag" #-} rule84 = \ (_ :: ()) -> - {-# LINE 67 "./src-ag/Desugar.ag" #-} + {-# LINE 67 "src-ag/Desugar.ag" #-} 0 {-# LINE 1358 "dist/build/Desugar.hs"#-} {-# INLINE rule85 #-} @@ -1386,8 +1386,8 @@ wrap_Nonterminal !(T_Nonterminal act) !(Inh_Nonterminal _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = 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 arg) + 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') ) @@ -1492,45 +1492,45 @@ in __result_ ) in C_Nonterminal_s46 v33 {-# NOINLINE[1] rule93 #-} - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 7 "src-ag/DistChildAttr.ag" #-} rule93 = \ !inh_ !nt_ -> - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 8 "src-ag/DistChildAttr.ag" #-} rule94 = \ !nt_ !syn_ -> - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 157 "src-ag/Desugar.ag" #-} rule95 = \ !nt_ -> - {-# LINE 157 "./src-ag/Desugar.ag" #-} + {-# LINE 157 "src-ag/Desugar.ag" #-} nt_ {-# LINE 1512 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule96 #-} - {-# LINE 239 "./src-ag/Desugar.ag" #-} + {-# LINE 239 "src-ag/Desugar.ag" #-} rule96 = \ ((!_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !nt_ -> - {-# LINE 239 "./src-ag/Desugar.ag" #-} + {-# 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" #-} + {-# LINE 240 "src-ag/Desugar.ag" #-} rule97 = \ ((!_prodsIaugmentsOut) :: Map ConstructorIdent (Map Identifier [Expression])) !nt_ -> - {-# LINE 240 "./src-ag/Desugar.ag" #-} + {-# 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" #-} + {-# LINE 292 "src-ag/Desugar.ag" #-} rule98 = \ ((!_lhsImainName) :: String) ((!_lhsIoptions) :: Options) -> - {-# LINE 292 "./src-ag/Desugar.ag" #-} + {-# LINE 292 "src-ag/Desugar.ag" #-} addLateAttr _lhsIoptions _lhsImainName {-# LINE 1530 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule99 #-} - {-# LINE 308 "./src-ag/Desugar.ag" #-} + {-# LINE 308 "src-ag/Desugar.ag" #-} rule99 = \ !_extraInh ((!_prodsIoutput) :: Productions) !inh_ !nt_ !params_ !syn_ -> - {-# LINE 308 "./src-ag/Desugar.ag" #-} + {-# LINE 308 "src-ag/Desugar.ag" #-} Nonterminal nt_ params_ (_extraInh `Map.union` inh_) @@ -1571,8 +1571,8 @@ wrap_Nonterminals !(T_Nonterminals act) !(Inh_Nonterminals _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = 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 arg) + 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') ) @@ -1828,8 +1828,8 @@ wrap_Pattern !(T_Pattern act) !(Inh_Pattern _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = 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 arg) + 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) ) @@ -2461,16 +2461,16 @@ in __result_ ) in C_Pattern_s58 v56 {-# NOINLINE rule162 #-} - {-# LINE 110 "./src-ag/Desugar.ag" #-} + {-# LINE 110 "src-ag/Desugar.ag" #-} rule162 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) !attr_ !field_ -> - {-# LINE 110 "./src-ag/Desugar.ag" #-} + {-# LINE 110 "src-ag/Desugar.ag" #-} maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "" (getPos field_)) attr_ True) $ findField field_ attr_ _lhsIchildInhs {-# LINE 2470 "dist/build/Desugar.hs"#-} {-# NOINLINE rule163 #-} - {-# LINE 112 "./src-ag/Desugar.ag" #-} + {-# LINE 112 "src-ag/Desugar.ag" #-} rule163 = \ !_field' ((!_lhsIcon) :: ConstructorIdent) ((!_lhsIdefs) :: Set (Identifier, Identifier)) ((!_lhsInt) :: NontermIdent) !attr_ !field_ -> - {-# LINE 112 "./src-ag/Desugar.ag" #-} + {-# LINE 112 "src-ag/Desugar.ag" #-} if _field' == field_ then Seq.empty else if (_field' , attr_) `Set.member` _lhsIdefs @@ -2478,39 +2478,39 @@ else Seq.empty {-# LINE 2480 "dist/build/Desugar.hs"#-} {-# NOINLINE rule164 #-} - {-# LINE 117 "./src-ag/Desugar.ag" #-} + {-# LINE 117 "src-ag/Desugar.ag" #-} rule164 = \ !_err1 !_err2 ((!_patIerrors) :: Seq Error) -> - {-# LINE 117 "./src-ag/Desugar.ag" #-} + {-# 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" #-} + {-# LINE 118 "src-ag/Desugar.ag" #-} rule165 = \ !_field' ((!_patIoutput) :: Pattern) !attr_ -> - {-# LINE 118 "./src-ag/Desugar.ag" #-} + {-# LINE 118 "src-ag/Desugar.ag" #-} Alias _field' attr_ _patIoutput {-# LINE 2492 "dist/build/Desugar.hs"#-} {-# NOINLINE rule166 #-} - {-# LINE 182 "./src-ag/Desugar.ag" #-} + {-# LINE 182 "src-ag/Desugar.ag" #-} rule166 = \ !attr_ !field_ -> - {-# LINE 182 "./src-ag/Desugar.ag" #-} + {-# LINE 182 "src-ag/Desugar.ag" #-} Set.singleton (field_, attr_) {-# LINE 2498 "dist/build/Desugar.hs"#-} {-# NOINLINE rule167 #-} - {-# LINE 183 "./src-ag/Desugar.ag" #-} + {-# LINE 183 "src-ag/Desugar.ag" #-} rule167 = \ !_def ((!_patIdefsCollect) :: Set (Identifier, Identifier)) -> - {-# LINE 183 "./src-ag/Desugar.ag" #-} + {-# LINE 183 "src-ag/Desugar.ag" #-} _def `Set.union` _patIdefsCollect {-# LINE 2504 "dist/build/Desugar.hs"#-} {-# NOINLINE rule168 #-} - {-# LINE 200 "./src-ag/Desugar.ag" #-} + {-# LINE 200 "src-ag/Desugar.ag" #-} rule168 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) ((!_patIallAttributes) :: AttrMap) !attr_ !field_ -> - {-# LINE 200 "./src-ag/Desugar.ag" #-} + {-# 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" #-} + {-# LINE 219 "src-ag/Desugar.ag" #-} rule169 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsIforcedIrrefutables) :: AttrMap) ((!_lhsInt) :: NontermIdent) !_output !attr_ !field_ -> - {-# LINE 219 "./src-ag/Desugar.ag" #-} + {-# 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 @@ -2693,9 +2693,9 @@ in __result_ ) in C_Pattern_s58 v56 {-# NOINLINE rule178 #-} - {-# LINE 202 "./src-ag/Desugar.ag" #-} + {-# LINE 202 "src-ag/Desugar.ag" #-} rule178 = \ (_ :: ()) -> - {-# LINE 202 "./src-ag/Desugar.ag" #-} + {-# LINE 202 "src-ag/Desugar.ag" #-} Map.empty {-# LINE 2701 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule179 #-} @@ -2879,8 +2879,8 @@ wrap_Patterns !(T_Patterns act) !(Inh_Patterns _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = 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 arg) + 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) ) @@ -3342,8 +3342,8 @@ wrap_Production !(T_Production act) !(Inh_Production _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = 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 arg) + 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) ) @@ -3496,39 +3496,39 @@ in __result_ ) in C_Production_s52 v44 {-# NOINLINE[1] rule224 #-} - {-# LINE 161 "./src-ag/Desugar.ag" #-} + {-# LINE 161 "src-ag/Desugar.ag" #-} rule224 = \ !con_ -> - {-# LINE 161 "./src-ag/Desugar.ag" #-} + {-# LINE 161 "src-ag/Desugar.ag" #-} con_ {-# LINE 3504 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule225 #-} - {-# LINE 188 "./src-ag/Desugar.ag" #-} + {-# LINE 188 "src-ag/Desugar.ag" #-} rule225 = \ ((!_rulesIdefsCollect) :: Set (Identifier, Identifier)) -> - {-# LINE 188 "./src-ag/Desugar.ag" #-} + {-# LINE 188 "src-ag/Desugar.ag" #-} _rulesIdefsCollect {-# LINE 3510 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule226 #-} - {-# LINE 244 "./src-ag/Desugar.ag" #-} + {-# LINE 244 "src-ag/Desugar.ag" #-} rule226 = \ ((!_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) !con_ -> - {-# LINE 244 "./src-ag/Desugar.ag" #-} + {-# 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" #-} + {-# LINE 245 "src-ag/Desugar.ag" #-} rule227 = \ !_augmentsOut1 !con_ -> - {-# LINE 245 "./src-ag/Desugar.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 283 "src-ag/Desugar.ag" #-} rule229 = \ !_augmentErrs ((!_rulesIerrors) :: Seq Error) -> - {-# LINE 283 "./src-ag/Desugar.ag" #-} + {-# LINE 283 "src-ag/Desugar.ag" #-} _rulesIerrors Seq.>< _augmentErrs {-# LINE 3534 "dist/build/Desugar.hs"#-} {-# NOINLINE[1] rule230 #-} @@ -3574,8 +3574,8 @@ wrap_Productions !(T_Productions act) !(Inh_Productions _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = 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 arg) + 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) ) @@ -3852,8 +3852,8 @@ wrap_Rule !(T_Rule act) !(Inh_Rule _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = 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 arg) + 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) ) @@ -3995,9 +3995,9 @@ in __result_ ) in C_Rule_s57 v54 {-# NOINLINE[1] rule267 #-} - {-# LINE 172 "./src-ag/Desugar.ag" #-} + {-# LINE 172 "src-ag/Desugar.ag" #-} rule267 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) ((!_patternIdefsCollect) :: Set (Identifier, Identifier)) -> - {-# LINE 172 "./src-ag/Desugar.ag" #-} + {-# 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 #-} @@ -4058,8 +4058,8 @@ wrap_Rules !(T_Rules act) !(Inh_Rules _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = 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 arg) + 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) ) @@ -4353,8 +4353,8 @@ wrap_TypeSig !(T_TypeSig act) !(Inh_TypeSig ) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_TypeSig_vIn15 - !(T_TypeSig_vOut15 _lhsOoutput) <- return (inv_TypeSig_s30 sem arg) + let arg15 = T_TypeSig_vIn15 + !(T_TypeSig_vOut15 _lhsOoutput) <- return (inv_TypeSig_s30 sem arg15) return (Syn_TypeSig _lhsOoutput) ) @@ -4403,8 +4403,8 @@ wrap_TypeSigs !(T_TypeSigs act) !(Inh_TypeSigs ) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_TypeSigs_vIn16 - !(T_TypeSigs_vOut16 _lhsOoutput) <- return (inv_TypeSigs_s32 sem arg) + let arg16 = T_TypeSigs_vIn16 + !(T_TypeSigs_vOut16 _lhsOoutput) <- return (inv_TypeSigs_s32 sem arg16) return (Syn_TypeSigs _lhsOoutput) ) diff --git a/src-generated/ErrorMessages.hs b/src-generated/ErrorMessages.hs --- a/src-generated/ErrorMessages.hs +++ b/src-generated/ErrorMessages.hs @@ -1,8 +1,8 @@ --- UUAGC 0.9.50 (src-ag/ErrorMessages.ag) +-- UUAGC 0.9.51 (src-ag/ErrorMessages.ag) module ErrorMessages where -{-# LINE 2 "./src-ag/ErrorMessages.ag" #-} +{-# LINE 2 "src-ag/ErrorMessages.ag" #-} import UU.Scanner.Position(Pos) import Pretty diff --git a/src-generated/ExecutionPlan.hs b/src-generated/ExecutionPlan.hs --- a/src-generated/ExecutionPlan.hs +++ b/src-generated/ExecutionPlan.hs @@ -1,8 +1,8 @@ --- UUAGC 0.9.50 (src-ag/ExecutionPlan.ag) +-- UUAGC 0.9.51 (src-ag/ExecutionPlan.ag) module ExecutionPlan where -{-# LINE 2 "./src-ag/ExecutionPlan.ag" #-} +{-# LINE 2 "src-ag/ExecutionPlan.ag" #-} -- VisitSyntax.ag imports import Patterns (Pattern(..),Patterns) @@ -48,14 +48,14 @@ child params : {[Identifier]} child classCtxs : {ClassContext} child initial : {StateIdentifier} - child initialv : {Maybe VisitIdentifier} + 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) ((Maybe VisitIdentifier)) ((Map StateIdentifier StateCtx)) ((Map StateIdentifier StateCtx)) (EProductions) (Bool) (HigherOrderInfo) +data ENonterminal = ENonterminal (NontermIdent) (([Identifier])) (ClassContext) (StateIdentifier) (([VisitIdentifier])) ((Map StateIdentifier StateCtx)) ((Map StateIdentifier StateCtx)) (EProductions) (Bool) (HigherOrderInfo) -- ENonterminals ----------------------------------------------- {- alternatives: diff --git a/src-generated/ExecutionPlan2Caml.hs b/src-generated/ExecutionPlan2Caml.hs --- a/src-generated/ExecutionPlan2Caml.hs +++ b/src-generated/ExecutionPlan2Caml.hs @@ -2,5792 +2,5792 @@ {-# 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 arg = T_EChild_vIn1 _lhsIallInitStates _lhsIcon _lhsImainFile _lhsImainName _lhsInt _lhsIoptions - (T_EChild_vOut1 _lhsOargnamesw _lhsOchildTypes _lhsOchildintros _lhsOsigs _lhsOterminaldefs) <- return (inv_EChild_s2 sem arg) - 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 arg = T_EChildren_vIn4 _lhsIallInitStates _lhsIcon _lhsImainFile _lhsImainName _lhsInt _lhsIoptions - (T_EChildren_vOut4 _lhsOargnamesw _lhsOchildTypes _lhsOchildintros _lhsOsigs _lhsOterminaldefs) <- return (inv_EChildren_s5 sem arg) - 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 arg = 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 arg) - 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) -> (Maybe 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 - Nothing -> text "{ }" - Just 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 arg = 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 arg) - 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 arg = 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 arg) - 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 arg = 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 arg) - 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 arg = 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 arg) - 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 arg = 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 arg) - 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 arg = T_ExecutionPlan_vIn25 _lhsIinhmap _lhsIlocalAttrTypes _lhsImainFile _lhsImainName _lhsIoptions _lhsIsynmap - (T_ExecutionPlan_vOut25 _lhsOcode _lhsOdatas _lhsOerrors _lhsOmodules) <- return (inv_ExecutionPlan_s26 sem arg) - 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 arg = T_Expression_vIn28 _lhsIoptions - (T_Expression_vOut28 _lhsOattrs _lhsOpos _lhsOsemfunc _lhsOtks) <- return (inv_Expression_s29 sem arg) - 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 arg = T_HsToken_vIn31 _lhsIoptions - (T_HsToken_vOut31 _lhsOattrs _lhsOtok) <- return (inv_HsToken_s32 sem arg) - 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 arg = T_HsTokens_vIn34 _lhsIoptions - (T_HsTokens_vOut34 _lhsOtks) <- return (inv_HsTokens_s35 sem arg) - 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 arg = T_HsTokensRoot_vIn37 _lhsIoptions - (T_HsTokensRoot_vOut37 ) <- return (inv_HsTokensRoot_s38 sem arg) - 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 arg = 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 arg) - 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 arg = T_Patterns_vIn43 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap - (T_Patterns_vOut43 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOextraDefs _lhsOsem_lhs) <- return (inv_Patterns_s44 sem arg) - 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 arg = 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 arg) - 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 arg = 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 arg) - 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 arg = 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 arg) - 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 arg = 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 arg) +{-# 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) ) diff --git a/src-generated/ExecutionPlan2Clean.hs b/src-generated/ExecutionPlan2Clean.hs --- a/src-generated/ExecutionPlan2Clean.hs +++ b/src-generated/ExecutionPlan2Clean.hs @@ -2,6636 +2,6636 @@ {-# 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 arg = 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 arg) - 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 arg = 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 arg) - 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 arg = 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 arg) - 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) -> (Maybe 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 - Nothing -> text _synname - Just 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 arg = 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 arg) - 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 arg = 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 arg) - 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 arg = 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 arg) - 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 arg = 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 arg) - 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 arg = 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 arg) - 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 arg = 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 arg) - 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 arg = T_Expression_vIn28 _lhsIoptions - (T_Expression_vOut28 _lhsOattrs _lhsOpos _lhsOsemfunc _lhsOtks) <- return (inv_Expression_s29 sem arg) - 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 arg = T_HsToken_vIn31 _lhsIoptions - (T_HsToken_vOut31 _lhsOattrs _lhsOtok) <- return (inv_HsToken_s32 sem arg) - 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 arg = T_HsTokens_vIn34 _lhsIoptions - (T_HsTokens_vOut34 _lhsOtks) <- return (inv_HsTokens_s35 sem arg) - 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 arg = T_HsTokensRoot_vIn37 _lhsIoptions - (T_HsTokensRoot_vOut37 ) <- return (inv_HsTokensRoot_s38 sem arg) - 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 arg = T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap - (T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs) <- return (inv_Pattern_s41 sem arg) - 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 arg = T_Patterns_vIn43 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap - (T_Patterns_vOut43 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOsem_lhs) <- return (inv_Patterns_s44 sem arg) - 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 arg = 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 arg) - 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 arg = 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 arg) - 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 arg = 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 arg) - 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 arg = 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 arg) +{-# 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) ) diff --git a/src-generated/ExecutionPlan2Hs.hs b/src-generated/ExecutionPlan2Hs.hs --- a/src-generated/ExecutionPlan2Hs.hs +++ b/src-generated/ExecutionPlan2Hs.hs @@ -2,6632 +2,6642 @@ {-# 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 578 "./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 702 "./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 768 "./src-ag/ExecutionPlan2Hs.ag" #-} - -resultValName :: String -resultValName = "__result_" - -nextStName :: String -nextStName = "__st_" -{-# LINE 139 "dist/build/ExecutionPlan2Hs.hs" #-} - -{-# LINE 839 "./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 965 "./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 1073 "./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 1099 "./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 1165 "./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 1252 "./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 1274 "./src-ag/ExecutionPlan2Hs.ag" #-} - -unionWithSum = Map.unionWith (+) -{-# LINE 258 "dist/build/ExecutionPlan2Hs.hs" #-} - -{-# LINE 1297 "./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 1514 "./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 1661 "./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 arg = 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 arg) - 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 567 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule8 = \ kind_ tp_ -> - {-# LINE 567 "./src-ag/ExecutionPlan2Hs.ag" #-} - case kind_ of - ChildSyntax -> ppDefor tp_ >#< "->" - ChildReplace tp -> ppDefor tp >#< "->" - _ -> empty - {-# LINE 460 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule9 #-} - {-# LINE 571 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule9 = \ kind_ name_ -> - {-# LINE 571 "./src-ag/ExecutionPlan2Hs.ag" #-} - case kind_ of - ChildSyntax -> name_ >|< "_" - ChildReplace _ -> name_ >|< "_" - _ -> empty - {-# LINE 469 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule10 #-} - {-# LINE 919 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule10 = \ _introcode name_ -> - {-# LINE 919 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton name_ _introcode - {-# LINE 475 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule11 #-} - {-# LINE 920 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule11 = \ tp_ -> - {-# LINE 920 "./src-ag/ExecutionPlan2Hs.ag" #-} - case tp_ of - NT _ _ defor -> defor - _ -> False - {-# LINE 483 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule12 #-} - {-# LINE 923 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule12 = \ _isDefor ((_lhsIoptions) :: Options) _nt kind_ name_ -> - {-# LINE 923 "./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 934 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule13 = \ ((_lhsIoptions) :: Options) hasAround_ name_ -> - {-# LINE 934 "./src-ag/ExecutionPlan2Hs.ag" #-} - if hasAround_ - then locname _lhsIoptions name_ >|< "_around" - else empty - {-# LINE 506 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule14 #-} - {-# LINE 937 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule14 = \ _addbang _aroundcode _initSt _isDefor ((_lhsIoptions) :: Options) _nt _valcode hasAround_ kind_ name_ -> - {-# LINE 937 "./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 963 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule15 = \ tp_ -> - {-# LINE 963 "./src-ag/ExecutionPlan2Hs.ag" #-} - extractNonterminal tp_ - {-# LINE 543 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule16 #-} - {-# LINE 1542 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule16 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 1542 "./src-ag/ExecutionPlan2Hs.ag" #-} - \x -> if bangpats _lhsIoptions then "!" >|< x else x - {-# LINE 549 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule17 #-} - {-# LINE 1594 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule17 = \ name_ tp_ -> - {-# LINE 1594 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton name_ tp_ - {-# LINE 555 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule18 #-} - {-# LINE 1638 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule18 = \ ((_lhsIallInitStates) :: Map NontermIdent Int) _nt -> - {-# LINE 1638 "./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 575 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule28 = \ tp_ -> - {-# LINE 575 "./src-ag/ExecutionPlan2Hs.ag" #-} - (pp_parens $ show tp_) >#< "->" - {-# LINE 646 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule29 #-} - {-# LINE 576 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule29 = \ _addbang name_ -> - {-# LINE 576 "./src-ag/ExecutionPlan2Hs.ag" #-} - _addbang $ text $ fieldname name_ - {-# LINE 652 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule30 #-} - {-# LINE 918 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule30 = \ name_ -> - {-# LINE 918 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton name_ (\_ _ -> Right (empty, Set.empty, Map.empty)) - {-# LINE 658 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule31 #-} - {-# LINE 1311 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule31 = \ name_ -> - {-# LINE 1311 "./src-ag/ExecutionPlan2Hs.ag" #-} - Set.singleton $ fieldname name_ - {-# LINE 664 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule32 #-} - {-# LINE 1543 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule32 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 1543 "./src-ag/ExecutionPlan2Hs.ag" #-} - \x -> if bangpats _lhsIoptions then "!" >|< x else x - {-# LINE 670 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule33 #-} - {-# LINE 1594 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule33 = \ name_ tp_ -> - {-# LINE 1594 "./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 arg = 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 arg) - 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 arg = 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 arg) - 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) -> (Maybe 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 _firstVisitInfo _inhlist _inhlist1 _inhname _k_type _lhsIallVisitKinds _lhsImainName _lhsIoptions _quantPP _synlist _synname _t_params _t_type _wrapPragma _wrapname arg_initial_ arg_initialv_ 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 _firstVisitInfo _inhlist _inhlist1 _inhname _k_type ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) ((_lhsImainName) :: String) ((_lhsIoptions) :: Options) _quantPP _synlist _synname _t_params _t_type _wrapPragma _wrapname initial_ initialv_ 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 - Nothing -> _synname >#< " { }" - Just 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 "return" - VisitMonadic -> empty - unMonad | monadicWrappers _lhsIoptions = empty - | otherwise = unMon _lhsIoptions - in unMonad >#< "(" - >-< indent 2 ( - "do" >#< ( _addbang (pp "sem") >#< "<-" >#< "act" - >-< "let" >#< _addbangWrap (pp "arg") >#< "=" >#< arg - >-< pat >#< "<-" >#< convert >#< pp_parens ("inv_" >|< nt_ >|< "_s" >|< initial_ >#< "sem" >#< ind >#< "arg" >#< extra) - >-< "return" >#< pp_parens (_synname >#< ppSpaced _synlist ) - ) - ) - >-< ")" ) - >-< if lateHigherOrderBinding _lhsIoptions - then indent 2 ("where" >#< lhsname _lhsIoptions True idLateBindingAttr >#< "=" >#< lateBindingFieldNm _lhsImainName) - else empty - {-# LINE 1491 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule120 #-} - {-# LINE 504 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule120 = \ ((_lhsIoptions) :: Options) _wrapname -> - {-# LINE 504 "./src-ag/ExecutionPlan2Hs.ag" #-} - if parallelInvoke _lhsIoptions && not (monadicWrappers _lhsIoptions) - then ppNoInline _wrapname - else if noInlinePragmas _lhsIoptions - then empty - else ppInlinable _wrapname - {-# LINE 1501 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule121 #-} - {-# LINE 516 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule121 = \ ((_prodsIsemFunBndDefs) :: Seq PP_Doc) _semFunBndDef -> - {-# LINE 516 "./src-ag/ExecutionPlan2Hs.ag" #-} - _semFunBndDef Seq.<| _prodsIsemFunBndDefs - {-# LINE 1507 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule122 #-} - {-# LINE 517 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule122 = \ ((_prodsIsemFunBndTps) :: Seq PP_Doc) _semFunBndTp -> - {-# LINE 517 "./src-ag/ExecutionPlan2Hs.ag" #-} - _semFunBndTp Seq.<| _prodsIsemFunBndTps - {-# LINE 1513 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule123 #-} - {-# LINE 518 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule123 = \ _semFunBndNm _semname -> - {-# LINE 518 "./src-ag/ExecutionPlan2Hs.ag" #-} - _semFunBndNm >#< "=" >#< _semname - {-# LINE 1519 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule124 #-} - {-# LINE 519 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule124 = \ _semFunBndNm _sem_tp -> - {-# LINE 519 "./src-ag/ExecutionPlan2Hs.ag" #-} - _semFunBndNm >#< "::" >#< _sem_tp - {-# LINE 1525 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule125 #-} - {-# LINE 520 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule125 = \ nt_ -> - {-# LINE 520 "./src-ag/ExecutionPlan2Hs.ag" #-} - lateSemNtLabel nt_ - {-# LINE 1531 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule126 #-} - {-# LINE 558 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule126 = \ initial_ -> - {-# LINE 558 "./src-ag/ExecutionPlan2Hs.ag" #-} - initial_ - {-# LINE 1537 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule127 #-} - {-# LINE 559 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule127 = \ _allstates -> - {-# LINE 559 "./src-ag/ExecutionPlan2Hs.ag" #-} - _allstates - {-# LINE 1543 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule128 #-} - {-# LINE 1474 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule128 = \ ((_lhsIwrappers) :: Set NontermIdent) _sem_nt _wr_inh _wr_syn _wrapper nt_ -> - {-# LINE 1474 "./src-ag/ExecutionPlan2Hs.ag" #-} - (if nt_ `Set.member` _lhsIwrappers - then _wr_inh - >-< _wr_syn - >-< _wrapper - else empty) - >-< _sem_nt - {-# LINE 1554 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule129 #-} - {-# LINE 1480 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule129 = \ _datatype _k_states ((_lhsIoptions) :: Options) ((_prodsIt_visits) :: PP_Doc) _t_init _t_states -> - {-# LINE 1480 "./src-ag/ExecutionPlan2Hs.ag" #-} - (if dataTypes _lhsIoptions then _datatype else empty) - >-< _t_init - >-< _t_states - >-< _k_states - >-< _prodsIt_visits - {-# LINE 1564 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule130 #-} - {-# LINE 1540 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule130 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 1540 "./src-ag/ExecutionPlan2Hs.ag" #-} - \x -> if bangpats _lhsIoptions then "!" >|< x else x - {-# LINE 1570 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule131 #-} - {-# LINE 1548 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule131 = \ (_ :: ()) -> - {-# LINE 1548 "./src-ag/ExecutionPlan2Hs.ag" #-} - id - {-# LINE 1576 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule132 #-} - {-# LINE 1560 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule132 = \ nextVisits_ -> - {-# LINE 1560 "./src-ag/ExecutionPlan2Hs.ag" #-} - nextVisits_ - {-# LINE 1582 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule133 #-} - {-# LINE 1561 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule133 = \ prevVisits_ -> - {-# LINE 1561 "./src-ag/ExecutionPlan2Hs.ag" #-} - prevVisits_ - {-# LINE 1588 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule134 #-} - {-# LINE 1605 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule134 = \ ((_lhsIlocalAttrTypes) :: Map NontermIdent (Map ConstructorIdent (Map Identifier Type))) nt_ -> - {-# LINE 1605 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsIlocalAttrTypes - {-# LINE 1594 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule135 #-} - {-# LINE 1632 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule135 = \ initial_ nt_ -> - {-# LINE 1632 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton nt_ initial_ - {-# LINE 1600 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule136 #-} - {-# LINE 1646 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule136 = \ nt_ params_ -> - {-# LINE 1646 "./src-ag/ExecutionPlan2Hs.ag" #-} - NT nt_ (map show params_) False - {-# LINE 1606 "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 arg = 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 arg) - 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 arg = 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 arg) - 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 2188 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule226 #-} - {-# LINE 72 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule226 = \ con_ -> - {-# LINE 72 "./src-ag/ExecutionPlan2Hs.ag" #-} - con_ - {-# LINE 2194 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule227 #-} - {-# LINE 73 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule227 = \ con_ -> - {-# LINE 73 "./src-ag/ExecutionPlan2Hs.ag" #-} - con_ - {-# LINE 2200 "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 2208 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule229 #-} - {-# LINE 189 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule229 = \ constraints_ -> - {-# LINE 189 "./src-ag/ExecutionPlan2Hs.ag" #-} - ppClasses (classConstrsToDocs constraints_) - {-# LINE 2214 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule230 #-} - {-# LINE 190 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule230 = \ params_ -> - {-# LINE 190 "./src-ag/ExecutionPlan2Hs.ag" #-} - ppQuants params_ - {-# LINE 2220 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule231 #-} - {-# LINE 288 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule231 = \ (_ :: ()) -> - {-# LINE 288 "./src-ag/ExecutionPlan2Hs.ag" #-} - 1 - {-# LINE 2226 "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 2233 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule233 #-} - {-# LINE 523 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule233 = \ _semFunBndDef -> - {-# LINE 523 "./src-ag/ExecutionPlan2Hs.ag" #-} - Seq.singleton _semFunBndDef - {-# LINE 2239 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule234 #-} - {-# LINE 524 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule234 = \ _semFunBndTp -> - {-# LINE 524 "./src-ag/ExecutionPlan2Hs.ag" #-} - Seq.singleton _semFunBndTp - {-# LINE 2245 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule235 #-} - {-# LINE 525 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule235 = \ _semFunBndNm _semname -> - {-# LINE 525 "./src-ag/ExecutionPlan2Hs.ag" #-} - _semFunBndNm >#< "=" >#< _semname - {-# LINE 2251 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule236 #-} - {-# LINE 526 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule236 = \ _semFunBndNm _sem_tp -> - {-# LINE 526 "./src-ag/ExecutionPlan2Hs.ag" #-} - _semFunBndNm >#< "::" >#< _sem_tp - {-# LINE 2257 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule237 #-} - {-# LINE 527 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule237 = \ ((_lhsInt) :: NontermIdent) con_ -> - {-# LINE 527 "./src-ag/ExecutionPlan2Hs.ag" #-} - lateSemConLabel _lhsInt con_ - {-# LINE 2263 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule238 #-} - {-# LINE 585 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule238 = \ ((_lhsInt) :: NontermIdent) -> - {-# LINE 585 "./src-ag/ExecutionPlan2Hs.ag" #-} - "T_" >|< _lhsInt - {-# LINE 2269 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule239 #-} - {-# LINE 586 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule239 = \ ((_lhsIparams) :: [Identifier]) -> - {-# LINE 586 "./src-ag/ExecutionPlan2Hs.ag" #-} - ppSpaced _lhsIparams - {-# LINE 2275 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule240 #-} - {-# LINE 587 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule240 = \ ((_childrenIusedArgs) :: Set String) ((_rulesIusedArgs) :: Set String) ((_visitsIusedArgs) :: Set String) -> - {-# LINE 587 "./src-ag/ExecutionPlan2Hs.ag" #-} - _childrenIusedArgs `Set.union` _visitsIusedArgs `Set.union` _rulesIusedArgs - {-# LINE 2281 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule241 #-} - {-# LINE 590 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule241 = \ ((_childrenIargpats) :: [PP_Doc] ) _usedArgs -> - {-# LINE 590 "./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 2293 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule242 #-} - {-# LINE 597 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule242 = \ ((_lhsInt) :: NontermIdent) con_ -> - {-# LINE 597 "./src-ag/ExecutionPlan2Hs.ag" #-} - "sem_" ++ show _lhsInt ++ "_" ++ show con_ - {-# LINE 2299 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule243 #-} - {-# LINE 598 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule243 = \ ((_childrenIargtps) :: [PP_Doc] ) _classPP2 _quantPP2 _t_params _t_type -> - {-# LINE 598 "./src-ag/ExecutionPlan2Hs.ag" #-} - _quantPP2 >#< _classPP2 >#< ppSpaced _childrenIargtps >#< _t_type >#< _t_params - {-# LINE 2305 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule244 #-} - {-# LINE 599 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule244 = \ ((_lhsIclassCtxs) :: ClassContext) constraints_ -> - {-# LINE 599 "./src-ag/ExecutionPlan2Hs.ag" #-} - ppClasses (classCtxsToDocs _lhsIclassCtxs ++ classConstrsToDocs constraints_) - {-# LINE 2311 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule245 #-} - {-# LINE 600 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule245 = \ ((_lhsIparams) :: [Identifier]) params_ -> - {-# LINE 600 "./src-ag/ExecutionPlan2Hs.ag" #-} - ppQuants (_lhsIparams ++ params_) - {-# LINE 2317 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule246 #-} - {-# LINE 601 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule246 = \ _args ((_lhsIinitial) :: StateIdentifier) _mbInitializer _mkSemBody _outerlet _scc _semInlinePragma _sem_tp _semname _t_type -> - {-# LINE 601 "./src-ag/ExecutionPlan2Hs.ag" #-} - _semInlinePragma - >-< _semname >#< "::" >#< _sem_tp - >-< _mkSemBody (_semname >#< ppSpaced _args >#< "=" >#< _scc >#< _t_type ) - _mbInitializer _outerlet ("return" >#< "st" >|< _lhsIinitial) - {-# LINE 2326 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule247 #-} - {-# LINE 605 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule247 = \ (_ :: ()) -> - {-# LINE 605 "./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 2342 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule248 #-} - {-# LINE 617 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule248 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 617 "./src-ag/ExecutionPlan2Hs.ag" #-} - if parallelInvoke _lhsIoptions - then (Nothing :: Maybe PP_Doc) - else Nothing - {-# LINE 2350 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule249 #-} - {-# LINE 623 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule249 = \ ((_lhsIoptions) :: Options) _semname -> - {-# LINE 623 "./src-ag/ExecutionPlan2Hs.ag" #-} - if genCostCentres _lhsIoptions - then ppCostCentre _semname - else empty - {-# LINE 2358 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule250 #-} - {-# LINE 626 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule250 = \ ((_lhsIoptions) :: Options) _semname -> - {-# LINE 626 "./src-ag/ExecutionPlan2Hs.ag" #-} - if noInlinePragmas _lhsIoptions - then empty - else ppNoInline _semname - {-# LINE 2366 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule251 #-} - {-# LINE 629 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule251 = \ ((_rulesIsem_rules) :: PP_Doc) _statefns -> - {-# LINE 629 "./src-ag/ExecutionPlan2Hs.ag" #-} - vlist _statefns >-< _rulesIsem_rules - {-# LINE 2372 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule252 #-} - {-# LINE 630 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule252 = \ _genstfn ((_lhsIallstates) :: Set StateIdentifier) -> - {-# LINE 630 "./src-ag/ExecutionPlan2Hs.ag" #-} - map _genstfn $ Set.toList _lhsIallstates - {-# LINE 2378 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule253 #-} - {-# LINE 631 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule253 = \ _addbang ((_lhsIinitial) :: StateIdentifier) ((_lhsInextVisits) :: Map StateIdentifier StateCtx) ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) ((_lhsIprevVisits) :: Map StateIdentifier StateCtx) _stargs _stks _stvs -> - {-# LINE 631 "./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 2416 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule254 #-} - {-# LINE 673 "./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 673 "./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 2436 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule255 #-} - {-# LINE 689 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule255 = \ ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) _stvisits _t_params -> - {-# LINE 689 "./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 2450 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule256 #-} - {-# LINE 698 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule256 = \ ((_visitsIallvisits) :: [VisitStateState]) -> - {-# LINE 698 "./src-ag/ExecutionPlan2Hs.ag" #-} - \st -> filter (\(v,f,t) -> f == st) _visitsIallvisits - {-# LINE 2456 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule257 #-} - {-# LINE 699 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule257 = \ ((_visitsIsem_visit) :: [(StateIdentifier,Bool -> PP_Doc)] ) -> - {-# LINE 699 "./src-ag/ExecutionPlan2Hs.ag" #-} - \st inlinePragma -> vlist [ppf inlinePragma | (f,ppf) <- _visitsIsem_visit, f == st] - {-# LINE 2462 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule258 #-} - {-# LINE 700 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule258 = \ ((_rulesImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) -> - {-# LINE 700 "./src-ag/ExecutionPlan2Hs.ag" #-} - _rulesImrules - {-# LINE 2468 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule259 #-} - {-# LINE 915 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule259 = \ ((_childrenIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) -> - {-# LINE 915 "./src-ag/ExecutionPlan2Hs.ag" #-} - _childrenIchildintros - {-# LINE 2474 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule260 #-} - {-# LINE 1270 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule260 = \ ((_visitsIruleUsage) :: Map Identifier Int) -> - {-# LINE 1270 "./src-ag/ExecutionPlan2Hs.ag" #-} - _visitsIruleUsage - {-# LINE 2480 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule261 #-} - {-# LINE 1285 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule261 = \ ((_visitsIruleKinds) :: Map Identifier (Set VisitKind)) -> - {-# LINE 1285 "./src-ag/ExecutionPlan2Hs.ag" #-} - _visitsIruleKinds - {-# LINE 2486 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule262 #-} - {-# LINE 1314 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule262 = \ ((_visitsIintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) -> - {-# LINE 1314 "./src-ag/ExecutionPlan2Hs.ag" #-} - _visitsIintramap - {-# LINE 2492 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule263 #-} - {-# LINE 1315 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule263 = \ ((_childrenIterminaldefs) :: Set String) -> - {-# LINE 1315 "./src-ag/ExecutionPlan2Hs.ag" #-} - _childrenIterminaldefs - {-# LINE 2498 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule264 #-} - {-# LINE 1339 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule264 = \ ((_rulesIruledefs) :: Map Identifier (Set String)) -> - {-# LINE 1339 "./src-ag/ExecutionPlan2Hs.ag" #-} - _rulesIruledefs - {-# LINE 2504 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule265 #-} - {-# LINE 1340 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule265 = \ ((_rulesIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) -> - {-# LINE 1340 "./src-ag/ExecutionPlan2Hs.ag" #-} - _rulesIruleuses - {-# LINE 2510 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule266 #-} - {-# LINE 1394 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule266 = \ ((_visitsIlazyIntras) :: Set String) -> - {-# LINE 1394 "./src-ag/ExecutionPlan2Hs.ag" #-} - _visitsIlazyIntras - {-# LINE 2516 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule267 #-} - {-# LINE 1491 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule267 = \ _moduleName -> - {-# LINE 1491 "./src-ag/ExecutionPlan2Hs.ag" #-} - [pp $ "import " ++ _moduleName ] - {-# LINE 2522 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule268 #-} - {-# LINE 1492 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule268 = \ ((_lhsImainName) :: String) _suffix -> - {-# LINE 1492 "./src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainName ++ _suffix - {-# LINE 2528 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule269 #-} - {-# LINE 1493 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule269 = \ ((_lhsInt) :: NontermIdent) con_ -> - {-# LINE 1493 "./src-ag/ExecutionPlan2Hs.ag" #-} - "_" ++ show _lhsInt ++ "_" ++ show con_ - {-# LINE 2534 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule270 #-} - {-# LINE 1494 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule270 = \ ((_lhsImainFile) :: String) _suffix -> - {-# LINE 1494 "./src-ag/ExecutionPlan2Hs.ag" #-} - replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ _suffix ) - {-# LINE 2540 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule271 #-} - {-# LINE 1495 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule271 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 1495 "./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 2550 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule272 #-} - {-# LINE 1500 "./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 1500 "./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 2568 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule273 #-} - {-# LINE 1541 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule273 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 1541 "./src-ag/ExecutionPlan2Hs.ag" #-} - \x -> if bangpats _lhsIoptions then "!" >|< x else x - {-# LINE 2574 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule274 #-} - {-# LINE 1591 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule274 = \ ((_childrenIchildTypes) :: Map Identifier Type) ((_lhsIntType) :: Type) -> - {-# LINE 1591 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton _LHS _lhsIntType `Map.union` _childrenIchildTypes - {-# LINE 2580 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule275 #-} - {-# LINE 1608 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule275 = \ ((_lhsIlocalAttrTypes) :: Map ConstructorIdent (Map Identifier Type)) con_ -> - {-# LINE 1608 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.findWithDefault Map.empty con_ _lhsIlocalAttrTypes - {-# LINE 2586 "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 arg = 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 arg) - 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 2870 "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 2876 "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 3128 "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 arg = 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 arg) - 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 984 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule413 = \ _rulePragma _rulecode _used -> - {-# LINE 984 "./src-ag/ExecutionPlan2Hs.ag" #-} - if _used == 0 - then empty - else _rulePragma >-< _rulecode - {-# LINE 3270 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule414 #-} - {-# LINE 987 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule414 = \ _endpragma _genpragma _lambda _pragma ((_rhsIpos) :: Pos) ((_rhsIsemfunc) :: PP_Doc) _scc -> - {-# LINE 987 "./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 3285 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule415 #-} - {-# LINE 999 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule415 = \ ((_lhsIoptions) :: Options) _used explicit_ name_ -> - {-# LINE 999 "./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 3312 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule416 #-} - {-# LINE 1021 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule416 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) ((_rhsIpos) :: Pos) explicit_ name_ pure_ -> - {-# LINE 1021 "./src-ag/ExecutionPlan2Hs.ag" #-} - if genCostCentres _lhsIoptions && explicit_ && pure_ && not (noPerRuleCostCentres _lhsIoptions) - then ppCostCentre (name_ >|< "_" >|< line _rhsIpos >|< "_" >|< _lhsInt >|< "_" >|< _lhsIcon) - else empty - {-# LINE 3320 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule417 #-} - {-# LINE 1024 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule417 = \ ((_rhsIpos) :: Pos) -> - {-# LINE 1024 "./src-ag/ExecutionPlan2Hs.ag" #-} - "{-# LINE" >#< show (line _rhsIpos) >#< show (file _rhsIpos) >#< "#-}" - {-# LINE 3326 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule418 #-} - {-# LINE 1025 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule418 = \ ((_lhsImainFile) :: String) -> - {-# LINE 1025 "./src-ag/ExecutionPlan2Hs.ag" #-} - ppWithLineNr (\ln -> "{-# LINE " ++ show (ln+1) ++ " " ++ show _lhsImainFile ++ "#-}") - {-# LINE 3332 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule419 #-} - {-# LINE 1026 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule419 = \ _haspos ((_lhsIoptions) :: Options) explicit_ -> - {-# LINE 1026 "./src-ag/ExecutionPlan2Hs.ag" #-} - genLinePragmas _lhsIoptions && explicit_ && _haspos - {-# LINE 3338 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule420 #-} - {-# LINE 1027 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule420 = \ ((_rhsIpos) :: Pos) -> - {-# LINE 1027 "./src-ag/ExecutionPlan2Hs.ag" #-} - line _rhsIpos > 0 && column _rhsIpos >= 0 && not (null (file _rhsIpos)) - {-# LINE 3344 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule421 #-} - {-# LINE 1036 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule421 = \ _argPats ((_lhsIoptions) :: Options) ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) name_ -> - {-# LINE 1036 "./src-ag/ExecutionPlan2Hs.ag" #-} - name_ >#< "=" >#< "\\" >#< _argPats >#< dummyPat _lhsIoptions (Map.null _rhsIattrs) >#< "->" - {-# LINE 3350 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule422 #-} - {-# LINE 1038 "./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 1038 "./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 3369 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule423 #-} - {-# LINE 1052 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule423 = \ ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) -> - {-# LINE 1052 "./src-ag/ExecutionPlan2Hs.ag" #-} - ppSpaced [ case mbAttr of - Nothing -> "arg_" >|< str - _ -> text str - | (str,mbAttr) <- Map.assocs _rhsIattrs - ] - {-# LINE 3379 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule424 #-} - {-# LINE 1057 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule424 = \ _argExprs ((_lhsIoptions) :: Options) ((_patternIattrTypes) :: PP_Doc) ((_patternIsem_lhs) :: PP_Doc ) ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) name_ pure_ -> - {-# LINE 1057 "./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 3393 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule425 #-} - {-# LINE 1067 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule425 = \ _stepcode name_ -> - {-# LINE 1067 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton name_ _stepcode - {-# LINE 3399 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule426 #-} - {-# LINE 1272 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule426 = \ ((_lhsIusageInfo) :: Map Identifier Int) name_ -> - {-# LINE 1272 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.findWithDefault 0 name_ _lhsIusageInfo - {-# LINE 3405 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule427 #-} - {-# LINE 1288 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule427 = \ ((_lhsIruleKinds) :: Map Identifier (Set VisitKind)) name_ -> - {-# LINE 1288 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.findWithDefault Set.empty name_ _lhsIruleKinds - {-# LINE 3411 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule428 #-} - {-# LINE 1289 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule428 = \ _kinds -> - {-# LINE 1289 "./src-ag/ExecutionPlan2Hs.ag" #-} - Set.fold (\k r -> isLazyKind k || r) False _kinds - {-# LINE 3417 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule429 #-} - {-# LINE 1335 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule429 = \ ((_patternIattrs) :: Set String) name_ -> - {-# LINE 1335 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton name_ _patternIattrs - {-# LINE 3423 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule430 #-} - {-# LINE 1336 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule430 = \ ((_rhsIattrs) :: Map String (Maybe NonLocalAttr)) name_ -> - {-# LINE 1336 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton name_ _rhsIattrs - {-# LINE 3429 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule431 #-} - {-# LINE 1538 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule431 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 1538 "./src-ag/ExecutionPlan2Hs.ag" #-} - \x -> if bangpats _lhsIoptions then "!" >|< x else x - {-# LINE 3435 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule432 #-} - {-# LINE 1549 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule432 = \ _addbang _anyLazyKind -> - {-# LINE 1549 "./src-ag/ExecutionPlan2Hs.ag" #-} - if _anyLazyKind then id else _addbang - {-# LINE 3441 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule433 #-} - {-# LINE 1655 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule433 = \ _used mbError_ -> - {-# LINE 1655 "./src-ag/ExecutionPlan2Hs.ag" #-} - case mbError_ of - Just e | _used > 0 -> Seq.singleton e - _ -> Seq.empty - {-# LINE 3449 "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 arg = 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 arg) - 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 arg = 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 arg) - 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 3818 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule492 #-} - {-# LINE 95 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule492 = \ wrappers_ -> - {-# LINE 95 "./src-ag/ExecutionPlan2Hs.ag" #-} - wrappers_ - {-# LINE 3824 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule493 #-} - {-# LINE 134 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule493 = \ typeSyns_ -> - {-# LINE 134 "./src-ag/ExecutionPlan2Hs.ag" #-} - typeSyns_ - {-# LINE 3830 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule494 #-} - {-# LINE 135 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule494 = \ derivings_ -> - {-# LINE 135 "./src-ag/ExecutionPlan2Hs.ag" #-} - derivings_ - {-# LINE 3836 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule495 #-} - {-# LINE 531 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule495 = \ _lateSemBndDef ((_lhsIoptions) :: Options) -> - {-# LINE 531 "./src-ag/ExecutionPlan2Hs.ag" #-} - if lateHigherOrderBinding _lhsIoptions - then _lateSemBndDef - else empty - {-# LINE 3844 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule496 #-} - {-# LINE 534 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule496 = \ _lateSemBndTp ((_lhsIoptions) :: Options) -> - {-# LINE 534 "./src-ag/ExecutionPlan2Hs.ag" #-} - if lateHigherOrderBinding _lhsIoptions - then _lateSemBndTp - else empty - {-# LINE 3852 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule497 #-} - {-# LINE 537 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule497 = \ ((_lhsImainName) :: String) ((_nontsIsemFunBndTps) :: Seq PP_Doc) -> - {-# LINE 537 "./src-ag/ExecutionPlan2Hs.ag" #-} - "data" >#< lateBindingTypeNm _lhsImainName >#< "=" >#< lateBindingTypeNm _lhsImainName - >-< (indent 2 $ pp_block "{" "}" "," $ toList _nontsIsemFunBndTps) - {-# LINE 3859 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule498 #-} - {-# LINE 539 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule498 = \ ((_lhsImainName) :: String) ((_lhsIoptions) :: Options) ((_nontsIsemFunBndDefs) :: Seq PP_Doc) wrappers_ -> - {-# LINE 539 "./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 3873 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule499 #-} - {-# LINE 1216 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule499 = \ ((_nontsIchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) -> - {-# LINE 1216 "./src-ag/ExecutionPlan2Hs.ag" #-} - _nontsIchildvisit - {-# LINE 3879 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule500 #-} - {-# LINE 1360 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule500 = \ ((_nontsIvisitdefs) :: Map VisitIdentifier (Set Identifier)) -> - {-# LINE 1360 "./src-ag/ExecutionPlan2Hs.ag" #-} - _nontsIvisitdefs - {-# LINE 3885 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule501 #-} - {-# LINE 1361 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule501 = \ ((_nontsIvisituses) :: Map VisitIdentifier (Set Identifier)) -> - {-# LINE 1361 "./src-ag/ExecutionPlan2Hs.ag" #-} - _nontsIvisituses - {-# LINE 3891 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule502 #-} - {-# LINE 1432 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule502 = \ _genCommonModule _genMainModule ((_nontsIgenProdIO) :: IO ()) -> - {-# LINE 1432 "./src-ag/ExecutionPlan2Hs.ag" #-} - do _genMainModule - _genCommonModule - _nontsIgenProdIO - {-# LINE 3899 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule503 #-} - {-# LINE 1435 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule503 = \ ((_lhsImainFile) :: String) -> - {-# LINE 1435 "./src-ag/ExecutionPlan2Hs.ag" #-} - _lhsImainFile - {-# LINE 3905 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule504 #-} - {-# LINE 1436 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule504 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 1436 "./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 3919 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule505 #-} - {-# LINE 1445 "./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 1445 "./src-ag/ExecutionPlan2Hs.ag" #-} - writeModule _mainModuleFile - ( [ warrenFlagsPP _lhsIoptions - , pp $ _lhsIpragmaBlocks - , pp $ _lhsImoduleHeader _lhsImainName "" "" False - , _ppMonadImports - , pp $ "import " ++ _lhsImainName ++ "_common" - ] - ++ _nontsIimports - ++ [_lhsImainBlocksDoc] - ++ [_wrappersExtra ] - ++ _nontsIappendMain - ) - {-# LINE 3936 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule506 #-} - {-# LINE 1457 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule506 = \ ((_lhsImainFile) :: String) -> - {-# LINE 1457 "./src-ag/ExecutionPlan2Hs.ag" #-} - replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ "_common") - {-# LINE 3942 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule507 #-} - {-# LINE 1458 "./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 1458 "./src-ag/ExecutionPlan2Hs.ag" #-} - writeModule _commonFile - ( [ pp $ "{-# LANGUAGE Rank2Types, GADTs #-}" - , pp $ _lhsIpragmaBlocks - , pp $ _lhsImoduleHeader _lhsImainName "_common" "" True - , _ppMonadImports - , _lhsIimportBlocks - , _lhsItextBlocks - , _commonExtra - ] - ++ _nontsIappendCommon - ) - {-# LINE 3958 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule508 #-} - {-# LINE 1577 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule508 = \ ((_nontsIfromToStates) :: Map VisitIdentifier (Int,Int)) -> - {-# LINE 1577 "./src-ag/ExecutionPlan2Hs.ag" #-} - _nontsIfromToStates - {-# LINE 3964 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule509 #-} - {-# LINE 1621 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule509 = \ ((_nontsIvisitKinds) :: Map VisitIdentifier VisitKind) -> - {-# LINE 1621 "./src-ag/ExecutionPlan2Hs.ag" #-} - _nontsIvisitKinds - {-# LINE 3970 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule510 #-} - {-# LINE 1635 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule510 = \ ((_nontsIinitStates) :: Map NontermIdent Int) -> - {-# LINE 1635 "./src-ag/ExecutionPlan2Hs.ag" #-} - _nontsIinitStates - {-# LINE 3976 "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 arg = T_Expression_vIn28 _lhsIoptions - (T_Expression_vOut28 _lhsOattrs _lhsOpos _lhsOsemfunc _lhsOtks) <- return (inv_Expression_s29 sem arg) - 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 1071 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule522 = \ tks_ -> - {-# LINE 1071 "./src-ag/ExecutionPlan2Hs.ag" #-} - tks_ - {-# LINE 4065 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule523 #-} - {-# LINE 1114 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule523 = \ pos_ -> - {-# LINE 1114 "./src-ag/ExecutionPlan2Hs.ag" #-} - pos_ - {-# LINE 4071 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule524 #-} - {-# LINE 1200 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule524 = \ _inhhstoken tks_ -> - {-# LINE 1200 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.unions $ map (\tok -> attrs_Syn_HsToken (wrap_HsToken (sem_HsToken tok) _inhhstoken )) tks_ - {-# LINE 4077 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule525 #-} - {-# LINE 1201 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule525 = \ _inhhstoken tks_ -> - {-# LINE 1201 "./src-ag/ExecutionPlan2Hs.ag" #-} - vlist $ showTokens $ map (\tok -> tok_Syn_HsToken (wrap_HsToken (sem_HsToken tok) _inhhstoken )) tks_ - {-# LINE 4083 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule526 #-} - {-# LINE 1202 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule526 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 1202 "./src-ag/ExecutionPlan2Hs.ag" #-} - Inh_HsToken _lhsIoptions - {-# LINE 4089 "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 arg = T_HsToken_vIn31 _lhsIoptions - (T_HsToken_vOut31 _lhsOattrs _lhsOtok) <- return (inv_HsToken_s32 sem arg) - 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 1159 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule527 = \ var_ -> - {-# LINE 1159 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton (fieldname var_) Nothing - {-# LINE 4146 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule528 #-} - {-# LINE 1405 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule528 = \ pos_ var_ -> - {-# LINE 1405 "./src-ag/ExecutionPlan2Hs.ag" #-} - (pos_,fieldname var_) - {-# LINE 4152 "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 1160 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule530 = \ attr_ field_ -> - {-# LINE 1160 "./src-ag/ExecutionPlan2Hs.ag" #-} - if field_ == _INST || field_ == _FIELD || field_ == _INST' - then Nothing - else Just $ mkNonLocalAttr (field_ == _LHS) field_ attr_ - {-# LINE 4179 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule531 #-} - {-# LINE 1163 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule531 = \ ((_lhsIoptions) :: Options) _mbAttr attr_ field_ -> - {-# LINE 1163 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton (attrname _lhsIoptions True field_ attr_) _mbAttr - {-# LINE 4185 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule532 #-} - {-# LINE 1409 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule532 = \ attr_ field_ rdesc_ -> - {-# LINE 1409 "./src-ag/ExecutionPlan2Hs.ag" #-} - case rdesc_ of - Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))" - Nothing -> id - {-# LINE 4193 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule533 #-} - {-# LINE 1412 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule533 = \ _addTrace ((_lhsIoptions) :: Options) attr_ field_ pos_ -> - {-# LINE 1412 "./src-ag/ExecutionPlan2Hs.ag" #-} - (pos_, _addTrace $ attrname _lhsIoptions True field_ attr_) - {-# LINE 4199 "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 1414 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule534 = \ pos_ value_ -> - {-# LINE 1414 "./src-ag/ExecutionPlan2Hs.ag" #-} - (pos_, value_) - {-# LINE 4219 "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 1416 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule536 = \ pos_ value_ -> - {-# LINE 1416 "./src-ag/ExecutionPlan2Hs.ag" #-} - (pos_, if null value_ - then "" - else showCharShort (head value_) - ) - {-# LINE 4245 "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 1421 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule538 = \ pos_ value_ -> - {-# LINE 1421 "./src-ag/ExecutionPlan2Hs.ag" #-} - (pos_, showStrShort value_) - {-# LINE 4268 "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 1422 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule540 = \ pos_ -> - {-# LINE 1422 "./src-ag/ExecutionPlan2Hs.ag" #-} - (pos_, "") - {-# LINE 4291 "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 arg = T_HsTokens_vIn34 _lhsIoptions - (T_HsTokens_vOut34 _lhsOtks) <- return (inv_HsTokens_s35 sem arg) - 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 1401 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule542 = \ ((_hdItok) :: (Pos,String)) ((_tlItks) :: [(Pos,String)]) -> - {-# LINE 1401 "./src-ag/ExecutionPlan2Hs.ag" #-} - _hdItok : _tlItks - {-# LINE 4349 "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 1402 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule545 = \ (_ :: ()) -> - {-# LINE 1402 "./src-ag/ExecutionPlan2Hs.ag" #-} - [] - {-# LINE 4373 "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 arg = T_HsTokensRoot_vIn37 _lhsIoptions - (T_HsTokensRoot_vOut37 ) <- return (inv_HsTokensRoot_s38 sem arg) - 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 arg = T_Pattern_vIn40 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap - (T_Pattern_vOut40 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOisUnderscore _lhsOsem_lhs) <- return (inv_Pattern_s41 sem arg) - 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 1128 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule547 = \ _addbang1 ((_patsIsem_lhs) :: [PP_Doc]) name_ -> - {-# LINE 1128 "./src-ag/ExecutionPlan2Hs.ag" #-} - _addbang1 $ pp_parens $ name_ >#< hv_sp _patsIsem_lhs - {-# LINE 4493 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule548 #-} - {-# LINE 1135 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule548 = \ (_ :: ()) -> - {-# LINE 1135 "./src-ag/ExecutionPlan2Hs.ag" #-} - False - {-# LINE 4499 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule549 #-} - {-# LINE 1545 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule549 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 1545 "./src-ag/ExecutionPlan2Hs.ag" #-} - \x -> if bangpats _lhsIoptions then "!" >|< x else x - {-# LINE 4505 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule550 #-} - {-# LINE 1550 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule550 = \ _addbang ((_lhsIanyLazyKind) :: Bool) -> - {-# LINE 1550 "./src-ag/ExecutionPlan2Hs.ag" #-} - if _lhsIanyLazyKind then id else _addbang - {-# LINE 4511 "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 1127 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule562 = \ _addbang1 ((_patsIsem_lhs) :: [PP_Doc]) -> - {-# LINE 1127 "./src-ag/ExecutionPlan2Hs.ag" #-} - _addbang1 $ pp_block "(" ")" "," _patsIsem_lhs - {-# LINE 4582 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule563 #-} - {-# LINE 1136 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule563 = \ (_ :: ()) -> - {-# LINE 1136 "./src-ag/ExecutionPlan2Hs.ag" #-} - False - {-# LINE 4588 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule564 #-} - {-# LINE 1545 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule564 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 1545 "./src-ag/ExecutionPlan2Hs.ag" #-} - \x -> if bangpats _lhsIoptions then "!" >|< x else x - {-# LINE 4594 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule565 #-} - {-# LINE 1550 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule565 = \ _addbang ((_lhsIanyLazyKind) :: Bool) -> - {-# LINE 1550 "./src-ag/ExecutionPlan2Hs.ag" #-} - if _lhsIanyLazyKind then id else _addbang - {-# LINE 4600 "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 1122 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule577 = \ ((_lhsIoptions) :: Options) attr_ field_ -> - {-# LINE 1122 "./src-ag/ExecutionPlan2Hs.ag" #-} - text $ attrname _lhsIoptions False field_ attr_ - {-# LINE 4674 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule578 #-} - {-# LINE 1123 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule578 = \ ((_patIisUnderscore) :: Bool) ((_patIsem_lhs) :: PP_Doc ) _varPat -> - {-# LINE 1123 "./src-ag/ExecutionPlan2Hs.ag" #-} - if _patIisUnderscore - then _varPat - else _varPat >|< "@" >|< _patIsem_lhs - {-# LINE 4682 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule579 #-} - {-# LINE 1126 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule579 = \ _addbang1 _patExpr -> - {-# LINE 1126 "./src-ag/ExecutionPlan2Hs.ag" #-} - _addbang1 _patExpr - {-# LINE 4688 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule580 #-} - {-# LINE 1137 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule580 = \ (_ :: ()) -> - {-# LINE 1137 "./src-ag/ExecutionPlan2Hs.ag" #-} - False - {-# LINE 4694 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule581 #-} - {-# LINE 1143 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule581 = \ ((_lhsIoptions) :: Options) ((_patIattrs) :: Set String) attr_ field_ -> - {-# LINE 1143 "./src-ag/ExecutionPlan2Hs.ag" #-} - Set.insert (attrname _lhsIoptions False field_ attr_) _patIattrs - {-# LINE 4700 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule582 #-} - {-# LINE 1148 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule582 = \ ((_lhsIlocalAttrTypes) :: Map Identifier Type) ((_lhsIsynmap) :: Attributes) attr_ field_ -> - {-# LINE 1148 "./src-ag/ExecutionPlan2Hs.ag" #-} - if field_ == _LHS - then Map.lookup attr_ _lhsIsynmap - else if field_ == _LOC - then Map.lookup attr_ _lhsIlocalAttrTypes - else Nothing - {-# LINE 4710 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule583 #-} - {-# LINE 1153 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule583 = \ ((_lhsIoptions) :: Options) _mbTp ((_patIattrTypes) :: PP_Doc) attr_ field_ -> - {-# LINE 1153 "./src-ag/ExecutionPlan2Hs.ag" #-} - maybe empty (\tp -> (attrname _lhsIoptions False field_ attr_) >#< "::" >#< ppTp tp) _mbTp - >-< _patIattrTypes - {-# LINE 4717 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule584 #-} - {-# LINE 1545 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule584 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 1545 "./src-ag/ExecutionPlan2Hs.ag" #-} - \x -> if bangpats _lhsIoptions then "!" >|< x else x - {-# LINE 4723 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule585 #-} - {-# LINE 1550 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule585 = \ _addbang ((_lhsIanyLazyKind) :: Bool) -> - {-# LINE 1550 "./src-ag/ExecutionPlan2Hs.ag" #-} - if _lhsIanyLazyKind then id else _addbang - {-# LINE 4729 "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 1130 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule595 = \ ((_patIsem_lhs) :: PP_Doc ) -> - {-# LINE 1130 "./src-ag/ExecutionPlan2Hs.ag" #-} - text "~" >|< pp_parens _patIsem_lhs - {-# LINE 4792 "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 1129 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule608 = \ (_ :: ()) -> - {-# LINE 1129 "./src-ag/ExecutionPlan2Hs.ag" #-} - text "_" - {-# LINE 4855 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule609 #-} - {-# LINE 1138 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule609 = \ (_ :: ()) -> - {-# LINE 1138 "./src-ag/ExecutionPlan2Hs.ag" #-} - True - {-# LINE 4861 "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 arg = T_Patterns_vIn43 _lhsIallInhmap _lhsIallSynmap _lhsIanyLazyKind _lhsIinhmap _lhsIlocalAttrTypes _lhsIoptions _lhsIsynmap - (T_Patterns_vOut43 _lhsOattrTypes _lhsOattrs _lhsOcopy _lhsOsem_lhs) <- return (inv_Patterns_s44 sem arg) - 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 arg = 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 arg) - 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 5158 "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 5164 "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 5170 "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 5176 "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 5182 "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 5188 "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 5196 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule645 #-} - {-# LINE 409 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule645 = \ ((_lhsIparams) :: [Identifier]) -> - {-# LINE 409 "./src-ag/ExecutionPlan2Hs.ag" #-} - ppSpaced _lhsIparams - {-# LINE 5202 "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 5220 "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 5226 "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 5232 "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 5239 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule650 #-} - {-# LINE 717 "./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 717 "./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 5267 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule651 #-} - {-# LINE 742 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule651 = \ kind_ -> - {-# LINE 742 "./src-ag/ExecutionPlan2Hs.ag" #-} - case kind_ of - VisitPure False -> text "let" - VisitPure True -> empty - VisitMonadic -> text "do" - {-# LINE 5276 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule652 #-} - {-# LINE 746 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule652 = \ _addbang _nextStBuild _resultval kind_ -> - {-# LINE 746 "./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 5290 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule653 #-} - {-# LINE 755 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule653 = \ ident_ -> - {-# LINE 755 "./src-ag/ExecutionPlan2Hs.ag" #-} - "v" >|< ident_ - {-# LINE 5296 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule654 #-} - {-# LINE 756 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule654 = \ ((_lhsIoptions) :: Options) inh_ -> - {-# LINE 756 "./src-ag/ExecutionPlan2Hs.ag" #-} - ppSpaced $ map (\arg -> pp $ attrname _lhsIoptions True _LHS arg) $ Set.toList inh_ - {-# LINE 5302 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule655 #-} - {-# LINE 757 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule655 = \ ((_lhsIoptions) :: Options) inh_ -> - {-# LINE 757 "./src-ag/ExecutionPlan2Hs.ag" #-} - \chn -> ppSpaced $ map (attrname _lhsIoptions False chn) $ Set.toList inh_ - {-# LINE 5308 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule656 #-} - {-# LINE 758 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule656 = \ ((_lhsIoptions) :: Options) syn_ -> - {-# LINE 758 "./src-ag/ExecutionPlan2Hs.ag" #-} - ppSpaced $ map (\arg -> attrname _lhsIoptions False _LHS arg) $ Set.toList syn_ - {-# LINE 5314 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule657 #-} - {-# LINE 759 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule657 = \ ((_lhsIallintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) to_ -> - {-# LINE 759 "./src-ag/ExecutionPlan2Hs.ag" #-} - maybe Map.empty id $ Map.lookup to_ _lhsIallintramap - {-# LINE 5320 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule658 #-} - {-# LINE 760 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule658 = \ _nextargsMp -> - {-# LINE 760 "./src-ag/ExecutionPlan2Hs.ag" #-} - ppSpaced $ Map.keys $ _nextargsMp - {-# LINE 5326 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule659 #-} - {-# LINE 761 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule659 = \ ((_lhsIoptions) :: Options) _nextargs _nextargsMp to_ -> - {-# LINE 761 "./src-ag/ExecutionPlan2Hs.ag" #-} - "st" >|< to_ >#< _nextargs >#< dummyArg _lhsIoptions (Map.null _nextargsMp ) - {-# LINE 5332 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule660 #-} - {-# LINE 762 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule660 = \ _nameTOut_visit _nextStRef _synargs -> - {-# LINE 762 "./src-ag/ExecutionPlan2Hs.ag" #-} - _nameTOut_visit >#< _synargs >#< _nextStRef - {-# LINE 5338 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule661 #-} - {-# LINE 764 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule661 = \ _addbang _nextVisitInfo _nextst -> - {-# LINE 764 "./src-ag/ExecutionPlan2Hs.ag" #-} - case _nextVisitInfo of - NoneVis -> (empty, empty) - _ -> (_addbang (pp nextStName) >#< "=" >#< _nextst , pp nextStName) - {-# LINE 5346 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule662 #-} - {-# LINE 778 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule662 = \ kind_ -> - {-# LINE 778 "./src-ag/ExecutionPlan2Hs.ag" #-} - kind_ - {-# LINE 5352 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule663 #-} - {-# LINE 829 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule663 = \ kind_ -> - {-# LINE 829 "./src-ag/ExecutionPlan2Hs.ag" #-} - case kind_ of - VisitPure False -> FormatLetDecl - VisitPure True -> FormatLetLine - VisitMonadic -> FormatDo - {-# LINE 5361 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule664 #-} - {-# LINE 878 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule664 = \ (_ :: ()) -> - {-# LINE 878 "./src-ag/ExecutionPlan2Hs.ag" #-} - 0 - {-# LINE 5367 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule665 #-} - {-# LINE 885 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule665 = \ (_ :: ()) -> - {-# LINE 885 "./src-ag/ExecutionPlan2Hs.ag" #-} - 0 - {-# LINE 5373 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule666 #-} - {-# LINE 901 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule666 = \ (_ :: ()) -> - {-# LINE 901 "./src-ag/ExecutionPlan2Hs.ag" #-} - False - {-# LINE 5379 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule667 #-} - {-# LINE 1220 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule667 = \ ((_lhsInextVisits) :: Map StateIdentifier StateCtx) from_ -> - {-# LINE 1220 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.findWithDefault ManyVis from_ _lhsInextVisits - {-# LINE 5385 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule668 #-} - {-# LINE 1221 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule668 = \ _invokecode ident_ -> - {-# LINE 1221 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton ident_ _invokecode - {-# LINE 5391 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule669 #-} - {-# LINE 1222 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule669 = \ _addbang _inhargs ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) _nameTIn_visit _nameTOut_visit _nextVisitInfo _prevVisitInfo from_ ident_ kind_ syn_ to_ -> - {-# LINE 1222 "./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 5425 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule670 #-} - {-# LINE 1318 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule670 = \ _defsAsMap _nextintra _uses -> - {-# LINE 1318 "./src-ag/ExecutionPlan2Hs.ag" #-} - (_uses `Map.union` _nextintra ) `Map.difference` _defsAsMap - {-# LINE 5431 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule671 #-} - {-# LINE 1319 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule671 = \ _thisintra from_ -> - {-# LINE 1319 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton from_ _thisintra - {-# LINE 5437 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule672 #-} - {-# LINE 1320 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule672 = \ ((_lhsIallintramap) :: Map StateIdentifier (Map String (Maybe NonLocalAttr))) to_ -> - {-# LINE 1320 "./src-ag/ExecutionPlan2Hs.ag" #-} - maybe Map.empty id $ Map.lookup to_ _lhsIallintramap - {-# LINE 5443 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule673 #-} - {-# LINE 1321 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule673 = \ ((_lhsIoptions) :: Options) ((_stepsIuses) :: Map String (Maybe NonLocalAttr)) syn_ -> - {-# LINE 1321 "./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 5451 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule674 #-} - {-# LINE 1324 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule674 = \ ((_lhsIoptions) :: Options) inh_ -> - {-# LINE 1324 "./src-ag/ExecutionPlan2Hs.ag" #-} - Set.map (lhsname _lhsIoptions True) inh_ - {-# LINE 5457 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule675 #-} - {-# LINE 1325 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule675 = \ _inhVarNms ((_lhsIterminaldefs) :: Set String) ((_stepsIdefs) :: Set String) -> - {-# LINE 1325 "./src-ag/ExecutionPlan2Hs.ag" #-} - _stepsIdefs `Set.union` _inhVarNms `Set.union` _lhsIterminaldefs - {-# LINE 5463 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule676 #-} - {-# LINE 1326 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule676 = \ _defs -> - {-# LINE 1326 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.fromList [ (a, Nothing) | a <- Set.elems _defs ] - {-# LINE 5469 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule677 #-} - {-# LINE 1350 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule677 = \ ident_ syn_ -> - {-# LINE 1350 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton ident_ syn_ - {-# LINE 5475 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule678 #-} - {-# LINE 1351 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule678 = \ ident_ inh_ -> - {-# LINE 1351 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton ident_ inh_ - {-# LINE 5481 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule679 #-} - {-# LINE 1383 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule679 = \ _inhVarNms ((_stepsIdefs) :: Set String) kind_ -> - {-# LINE 1383 "./src-ag/ExecutionPlan2Hs.ag" #-} - case kind_ of - VisitPure False -> _inhVarNms `Set.union` _stepsIdefs - _ -> Set.empty - {-# LINE 5489 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule680 #-} - {-# LINE 1386 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule680 = \ _lazyIntrasInh ((_stepsIlazyIntras) :: Set String) -> - {-# LINE 1386 "./src-ag/ExecutionPlan2Hs.ag" #-} - _lazyIntrasInh `Set.union` _stepsIlazyIntras - {-# LINE 5495 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule681 #-} - {-# LINE 1539 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule681 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 1539 "./src-ag/ExecutionPlan2Hs.ag" #-} - \x -> if bangpats _lhsIoptions then "!" >|< x else x - {-# LINE 5501 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule682 #-} - {-# LINE 1547 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule682 = \ _addbang kind_ -> - {-# LINE 1547 "./src-ag/ExecutionPlan2Hs.ag" #-} - if isLazyKind kind_ then id else _addbang - {-# LINE 5507 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule683 #-} - {-# LINE 1574 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule683 = \ from_ ident_ to_ -> - {-# LINE 1574 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton ident_ (from_, to_) - {-# LINE 5513 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule684 #-} - {-# LINE 1618 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule684 = \ ident_ kind_ -> - {-# LINE 1618 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton ident_ kind_ - {-# LINE 5519 "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 arg = 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 arg) - 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 787 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule701 = \ ((_lhsImrules) :: Map Identifier (VisitKind -> FormatMode -> Either Error PP_Doc)) name_ -> - {-# LINE 787 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.findWithDefault (error $ "Rule " ++ show name_ ++ " not found") name_ _lhsImrules - {-# LINE 5645 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule702 #-} - {-# LINE 788 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule702 = \ ((_lhsIfmtMode) :: FormatMode) ((_lhsIkind) :: VisitKind) _ruleItf -> - {-# LINE 788 "./src-ag/ExecutionPlan2Hs.ag" #-} - case _ruleItf _lhsIkind _lhsIfmtMode of - Left e -> (Seq.singleton e, empty) - Right stmt -> (Seq.empty, stmt) - {-# LINE 5653 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule703 #-} - {-# LINE 1271 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule703 = \ name_ -> - {-# LINE 1271 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton name_ 1 - {-# LINE 5659 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule704 #-} - {-# LINE 1281 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule704 = \ ((_lhsIkind) :: VisitKind) name_ -> - {-# LINE 1281 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.singleton name_ (Set.singleton _lhsIkind) - {-# LINE 5665 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule705 #-} - {-# LINE 1366 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule705 = \ ((_lhsIruledefs) :: Map Identifier (Set String)) name_ -> - {-# LINE 1366 "./src-ag/ExecutionPlan2Hs.ag" #-} - maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruledefs - {-# LINE 5671 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule706 #-} - {-# LINE 1367 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule706 = \ ((_lhsIruleuses) :: Map Identifier (Map String (Maybe NonLocalAttr))) name_ -> - {-# LINE 1367 "./src-ag/ExecutionPlan2Hs.ag" #-} - maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruleuses - {-# LINE 5677 "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 796 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule715 = \ ((_lhsIallchildvisit) :: Map VisitIdentifier (Identifier -> VisitKind -> Either Error (PP_Doc, PP_Doc))) visit_ -> - {-# LINE 796 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.findWithDefault (error $ "Visit " ++ show visit_ ++ " not found") visit_ _lhsIallchildvisit - {-# LINE 5749 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule716 #-} - {-# LINE 797 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule716 = \ ((_lhsIkind) :: VisitKind) _visitItf child_ -> - {-# LINE 797 "./src-ag/ExecutionPlan2Hs.ag" #-} - case _visitItf child_ _lhsIkind of - Left e -> (Seq.singleton e, empty, empty) - Right (pat,expr) -> (Seq.empty, pat, expr) - {-# LINE 5757 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule717 #-} - {-# LINE 801 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule717 = \ ((_lhsIisLast) :: Bool) ((_lhsIuseParallel) :: Bool) -> - {-# LINE 801 "./src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIuseParallel && not _lhsIisLast - {-# LINE 5763 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule718 #-} - {-# LINE 802 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule718 = \ _addbang _convToMonad _exprPP ((_lhsIfmtMode) :: FormatMode) ((_lhsIindex) :: Int) ((_lhsIkind) :: VisitKind) _patPP _useParallel -> - {-# LINE 802 "./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 5775 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule719 #-} - {-# LINE 809 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule719 = \ _callKind -> - {-# LINE 809 "./src-ag/ExecutionPlan2Hs.ag" #-} - case _callKind of - VisitPure _ -> text "return" - VisitMonadic -> empty - {-# LINE 5783 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule720 #-} - {-# LINE 812 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule720 = \ ((_lhsIallVisitKinds) :: Map VisitIdentifier VisitKind) visit_ -> - {-# LINE 812 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.findWithDefault (error "visit kind should be in the map") visit_ _lhsIallVisitKinds - {-# LINE 5789 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule721 #-} - {-# LINE 820 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule721 = \ ((_lhsIindex) :: Int) _patPP _useParallel -> - {-# LINE 820 "./src-ag/ExecutionPlan2Hs.ag" #-} - if _useParallel - then _patPP >#< "<-" >#< "takeMVar sync_" >|< _lhsIindex - else empty - {-# LINE 5797 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule722 #-} - {-# LINE 1368 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule722 = \ ((_lhsIavisitdefs) :: Map VisitIdentifier (Set Identifier)) ((_lhsIoptions) :: Options) _to child_ visit_ -> - {-# LINE 1368 "./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 5803 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule723 #-} - {-# LINE 1369 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule723 = \ _from ((_lhsIavisituses) :: Map VisitIdentifier (Set Identifier)) ((_lhsIoptions) :: Options) child_ visit_ -> - {-# LINE 1369 "./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 5811 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule724 #-} - {-# LINE 1544 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule724 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 1544 "./src-ag/ExecutionPlan2Hs.ag" #-} - \x -> if bangpats _lhsIoptions then "!" >|< x else x - {-# LINE 5817 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule725 #-} - {-# LINE 1580 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule725 = \ ((_lhsIallFromToStates) :: Map VisitIdentifier (Int,Int)) visit_ -> - {-# LINE 1580 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.findWithDefault (error "visit not in allFromToStates") visit_ _lhsIallFromToStates - {-# LINE 5823 "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 782 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule734 = \ ordered_ -> - {-# LINE 782 "./src-ag/ExecutionPlan2Hs.ag" #-} - VisitPure ordered_ - {-# LINE 5908 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule735 #-} - {-# LINE 814 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule735 = \ ((_lhsIfmtMode) :: FormatMode) ((_stepsIsem_steps) :: PP_Doc) -> - {-# LINE 814 "./src-ag/ExecutionPlan2Hs.ag" #-} - case _lhsIfmtMode of - FormatDo -> "let" >#< _stepsIsem_steps - _ -> _stepsIsem_steps - {-# LINE 5916 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule736 #-} - {-# LINE 835 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule736 = \ ((_lhsIfmtMode) :: FormatMode) -> - {-# LINE 835 "./src-ag/ExecutionPlan2Hs.ag" #-} - case _lhsIfmtMode of - FormatDo -> FormatLetDecl - mode -> mode - {-# LINE 5924 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule737 #-} - {-# LINE 1389 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule737 = \ ((_stepsIdefs) :: Set String) ((_stepsIlazyIntras) :: Set String) ordered_ -> - {-# LINE 1389 "./src-ag/ExecutionPlan2Hs.ag" #-} - if ordered_ - then _stepsIlazyIntras - else _stepsIdefs - {-# LINE 5932 "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 813 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule764 = \ ((_stepsIsem_steps) :: PP_Doc) ((_stepsIsync_steps) :: PP_Doc) -> - {-# LINE 813 "./src-ag/ExecutionPlan2Hs.ag" #-} - _stepsIsem_steps >-< _stepsIsync_steps - {-# LINE 6073 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule765 #-} - {-# LINE 879 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule765 = \ (_ :: ()) -> - {-# LINE 879 "./src-ag/ExecutionPlan2Hs.ag" #-} - 0 - {-# LINE 6079 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule766 #-} - {-# LINE 880 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule766 = \ ((_lhsIindex) :: Int) -> - {-# LINE 880 "./src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIindex - {-# LINE 6085 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule767 #-} - {-# LINE 887 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule767 = \ ((_lhsIprevMaxSimRefs) :: Int) ((_stepsIindex) :: Int) _useParallel -> - {-# LINE 887 "./src-ag/ExecutionPlan2Hs.ag" #-} - if _useParallel - then _lhsIprevMaxSimRefs `max` (_stepsIindex - 1) - else _lhsIprevMaxSimRefs - {-# LINE 6093 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule768 #-} - {-# LINE 902 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule768 = \ _isMonadic ((_lhsIoptions) :: Options) ((_stepsIsize) :: Int) -> - {-# LINE 902 "./src-ag/ExecutionPlan2Hs.ag" #-} - parallelInvoke _lhsIoptions && _stepsIsize > 1 && _isMonadic - {-# LINE 6099 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule769 #-} - {-# LINE 903 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule769 = \ ((_lhsIkind) :: VisitKind) -> - {-# LINE 903 "./src-ag/ExecutionPlan2Hs.ag" #-} - case _lhsIkind of - VisitMonadic -> True - _ -> False - {-# LINE 6107 "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 791 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule796 = \ ((_lhsIchildintros) :: Map Identifier (VisitKind -> FormatMode -> Either Error (PP_Doc, Set String, Map String (Maybe NonLocalAttr)))) child_ -> - {-# LINE 791 "./src-ag/ExecutionPlan2Hs.ag" #-} - Map.findWithDefault (error $ "Child " ++ show child_ ++ " not found") child_ _lhsIchildintros - {-# LINE 6225 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule797 #-} - {-# LINE 793 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule797 = \ _attachItf ((_lhsIfmtMode) :: FormatMode) ((_lhsIkind) :: VisitKind) -> - {-# LINE 793 "./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 6233 "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 arg = 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 arg) - 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 870 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule807 = \ ((_tlIsize) :: Int) -> - {-# LINE 870 "./src-ag/ExecutionPlan2Hs.ag" #-} - 1 + _tlIsize - {-# LINE 6374 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule808 #-} - {-# LINE 875 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule808 = \ ((_lhsIindex) :: Int) -> - {-# LINE 875 "./src-ag/ExecutionPlan2Hs.ag" #-} - _lhsIindex - {-# LINE 6380 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule809 #-} - {-# LINE 876 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule809 = \ ((_lhsIindex) :: Int) -> - {-# LINE 876 "./src-ag/ExecutionPlan2Hs.ag" #-} - 1 + _lhsIindex - {-# LINE 6386 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule810 #-} - {-# LINE 877 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule810 = \ ((_tlIindex) :: Int) -> - {-# LINE 877 "./src-ag/ExecutionPlan2Hs.ag" #-} - _tlIindex - {-# LINE 6392 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule811 #-} - {-# LINE 896 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule811 = \ (_ :: ()) -> - {-# LINE 896 "./src-ag/ExecutionPlan2Hs.ag" #-} - False - {-# LINE 6398 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule812 #-} - {-# LINE 897 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule812 = \ ((_tlIisLast) :: Bool) -> - {-# LINE 897 "./src-ag/ExecutionPlan2Hs.ag" #-} - _tlIisLast - {-# LINE 6404 "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 869 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule856 = \ (_ :: ()) -> - {-# LINE 869 "./src-ag/ExecutionPlan2Hs.ag" #-} - 0 - {-# LINE 6577 "dist/build/ExecutionPlan2Hs.hs"#-} - {-# INLINE rule857 #-} - {-# LINE 895 "./src-ag/ExecutionPlan2Hs.ag" #-} - rule857 = \ (_ :: ()) -> - {-# LINE 895 "./src-ag/ExecutionPlan2Hs.ag" #-} - True - {-# LINE 6583 "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 arg = 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 arg) +{-# 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) ) diff --git a/src-generated/Expression.hs b/src-generated/Expression.hs --- a/src-generated/Expression.hs +++ b/src-generated/Expression.hs @@ -1,8 +1,8 @@ --- UUAGC 0.9.50 (src-ag/Expression.ag) +-- UUAGC 0.9.51 (src-ag/Expression.ag) module Expression where -{-# LINE 2 "./src-ag/Expression.ag" #-} +{-# LINE 2 "src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken diff --git a/src-generated/GenerateCode.hs b/src-generated/GenerateCode.hs --- a/src-generated/GenerateCode.hs +++ b/src-generated/GenerateCode.hs @@ -2,19 +2,19 @@ {-# LANGUAGE ScopedTypeVariables #-} module GenerateCode where -{-# LINE 2 "./src-ag/DeclBlocks.ag" #-} +{-# LINE 2 "src-ag/DeclBlocks.ag" #-} import Code (Decl,Expr) {-# LINE 9 "dist/build/GenerateCode.hs" #-} -{-# LINE 2 "./src-ag/Patterns.ag" #-} +{-# 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" #-} +{-# LINE 2 "src-ag/CodeSyntax.ag" #-} import Patterns import CommonTypes @@ -22,7 +22,7 @@ import Data.Set(Set) {-# LINE 24 "dist/build/GenerateCode.hs" #-} -{-# LINE 9 "./src-ag/GenerateCode.ag" #-} +{-# LINE 9 "src-ag/GenerateCode.ag" #-} import CommonTypes import SequentialTypes @@ -51,7 +51,7 @@ {-# LINE 52 "dist/build/GenerateCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 107 "./src-ag/GenerateCode.ag" #-} +{-# LINE 107 "src-ag/GenerateCode.ag" #-} -- remove possible @v references in the types of a data type. cleanupArg :: Options -> String -> String @@ -61,7 +61,7 @@ _ -> error "Only SimpleType supported" {-# LINE 63 "dist/build/GenerateCode.hs" #-} -{-# LINE 123 "./src-ag/GenerateCode.ag" #-} +{-# LINE 123 "src-ag/GenerateCode.ag" #-} appContext :: ContextMap -> NontermIdent -> Code.Type -> Code.Type appContext mp nt tp @@ -72,7 +72,7 @@ = foldr QuantApp tp $ Map.findWithDefault [] nt mp {-# LINE 74 "dist/build/GenerateCode.hs" #-} -{-# LINE 248 "./src-ag/GenerateCode.ag" #-} +{-# LINE 248 "src-ag/GenerateCode.ag" #-} mkDecl :: Bool -> Lhs -> Expr -> Set String -> Set String -> Decl mkDecl True lhs rhs _ _ = Bind lhs rhs @@ -86,7 +86,7 @@ right = SimpleExpr "x" {-# LINE 88 "dist/build/GenerateCode.hs" #-} -{-# LINE 541 "./src-ag/GenerateCode.ag" #-} +{-# LINE 541 "src-ag/GenerateCode.ag" #-} mkLambdaArg :: String -> Maybe Code.Type -> Expr mkLambdaArg nm Nothing = SimpleExpr nm @@ -111,7 +111,7 @@ pickOrigType x = x {-# LINE 113 "dist/build/GenerateCode.hs" #-} -{-# LINE 638 "./src-ag/GenerateCode.ag" #-} +{-# LINE 638 "src-ag/GenerateCode.ag" #-} mkPartitionedFunction :: String -> Bool -> [Decl] -> [String] -> DeclBlocks -> ([Decl], Expr) mkPartitionedFunction prefix' optCase nextVisitDecls lastExprVars cpsTree @@ -125,7 +125,7 @@ in (lambdas_Syn_DeclBlocksRoot syn, firstCall_Syn_DeclBlocksRoot syn) {-# LINE 127 "dist/build/GenerateCode.hs" #-} -{-# LINE 688 "./src-ag/GenerateCode.ag" #-} +{-# LINE 688 "src-ag/GenerateCode.ag" #-} freevars :: [String] -> [Decl] -> [String] freevars additional decls @@ -148,7 +148,7 @@ rhs = mkLet optCase decls expr {-# LINE 150 "dist/build/GenerateCode.hs" #-} -{-# LINE 766 "./src-ag/GenerateCode.ag" #-} +{-# LINE 766 "src-ag/GenerateCode.ag" #-} typeToCodeType :: Maybe NontermIdent -> [String] -> Type -> Code.Type typeToCodeType _ _ tp @@ -188,7 +188,7 @@ idEvalType options = evalType options id {-# LINE 190 "dist/build/GenerateCode.hs" #-} -{-# LINE 892 "./src-ag/GenerateCode.ag" #-} +{-# LINE 892 "src-ag/GenerateCode.ag" #-} -- for a virtual child that already existed as a child, returns isFirstOrder :: ChildKind -> Type -> Maybe Type @@ -197,7 +197,7 @@ isFirstOrder (ChildReplace tp) _ = Just tp {-# LINE 199 "dist/build/GenerateCode.hs" #-} -{-# LINE 913 "./src-ag/GenerateCode.ag" #-} +{-# LINE 913 "src-ag/GenerateCode.ag" #-} makeLocalComment :: Int -> String -> Identifier -> Maybe Type -> String makeLocalComment width what name tp = let x = getName name @@ -209,7 +209,7 @@ {-# LINE 211 "dist/build/GenerateCode.hs" #-} -{-# LINE 947 "./src-ag/GenerateCode.ag" #-} +{-# LINE 947 "src-ag/GenerateCode.ag" #-} -- Lets or nested Cases? -- or even a do-expression? @@ -256,7 +256,7 @@ visitname pre nt n = pre ++ getName nt ++ "_" ++ show n {-# LINE 258 "dist/build/GenerateCode.hs" #-} -{-# LINE 1038 "./src-ag/GenerateCode.ag" #-} +{-# LINE 1038 "src-ag/GenerateCode.ag" #-} toNamedType :: Bool -> NontermIdent -> ConstructorIdent -> Identifier -> Code.Type -> Code.NamedType toNamedType genStrict nt con nm tp @@ -272,8 +272,8 @@ wrap_CGrammar (T_CGrammar act) (Inh_CGrammar _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CGrammar_vIn1 _lhsIoptions - (T_CGrammar_vOut1 _lhsOerrors _lhsOoutput) <- return (inv_CGrammar_s2 sem arg) + let arg1 = T_CGrammar_vIn1 _lhsIoptions + (T_CGrammar_vOut1 _lhsOerrors _lhsOoutput) <- return (inv_CGrammar_s2 sem arg1) return (Syn_CGrammar _lhsOerrors _lhsOoutput) ) @@ -344,159 +344,159 @@ in __result_ ) in C_CGrammar_s2 v1 {-# INLINE rule0 #-} - {-# LINE 52 "./src-ag/GenerateCode.ag" #-} + {-# LINE 52 "src-ag/GenerateCode.ag" #-} rule0 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 52 "./src-ag/GenerateCode.ag" #-} + {-# LINE 52 "src-ag/GenerateCode.ag" #-} typeSigs _lhsIoptions {-# LINE 352 "dist/build/GenerateCode.hs"#-} {-# INLINE rule1 #-} - {-# LINE 53 "./src-ag/GenerateCode.ag" #-} + {-# LINE 53 "src-ag/GenerateCode.ag" #-} rule1 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 53 "./src-ag/GenerateCode.ag" #-} + {-# LINE 53 "src-ag/GenerateCode.ag" #-} folds _lhsIoptions {-# LINE 358 "dist/build/GenerateCode.hs"#-} {-# INLINE rule2 #-} - {-# LINE 54 "./src-ag/GenerateCode.ag" #-} + {-# LINE 54 "src-ag/GenerateCode.ag" #-} rule2 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 54 "./src-ag/GenerateCode.ag" #-} + {-# LINE 54 "src-ag/GenerateCode.ag" #-} semfuns _lhsIoptions {-# LINE 364 "dist/build/GenerateCode.hs"#-} {-# INLINE rule3 #-} - {-# LINE 55 "./src-ag/GenerateCode.ag" #-} + {-# LINE 55 "src-ag/GenerateCode.ag" #-} rule3 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 55 "./src-ag/GenerateCode.ag" #-} + {-# LINE 55 "src-ag/GenerateCode.ag" #-} newtypes _lhsIoptions {-# LINE 370 "dist/build/GenerateCode.hs"#-} {-# INLINE rule4 #-} - {-# LINE 56 "./src-ag/GenerateCode.ag" #-} + {-# LINE 56 "src-ag/GenerateCode.ag" #-} rule4 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 56 "./src-ag/GenerateCode.ag" #-} + {-# LINE 56 "src-ag/GenerateCode.ag" #-} unbox _lhsIoptions {-# LINE 376 "dist/build/GenerateCode.hs"#-} {-# INLINE rule5 #-} - {-# LINE 57 "./src-ag/GenerateCode.ag" #-} + {-# LINE 57 "src-ag/GenerateCode.ag" #-} rule5 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 57 "./src-ag/GenerateCode.ag" #-} + {-# LINE 57 "src-ag/GenerateCode.ag" #-} cases _lhsIoptions {-# LINE 382 "dist/build/GenerateCode.hs"#-} {-# INLINE rule6 #-} - {-# LINE 58 "./src-ag/GenerateCode.ag" #-} + {-# LINE 58 "src-ag/GenerateCode.ag" #-} rule6 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 58 "./src-ag/GenerateCode.ag" #-} + {-# LINE 58 "src-ag/GenerateCode.ag" #-} attrInfo _lhsIoptions {-# LINE 388 "dist/build/GenerateCode.hs"#-} {-# INLINE rule7 #-} - {-# LINE 59 "./src-ag/GenerateCode.ag" #-} + {-# LINE 59 "src-ag/GenerateCode.ag" #-} rule7 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 59 "./src-ag/GenerateCode.ag" #-} + {-# LINE 59 "src-ag/GenerateCode.ag" #-} rename _lhsIoptions {-# LINE 394 "dist/build/GenerateCode.hs"#-} {-# INLINE rule8 #-} - {-# LINE 60 "./src-ag/GenerateCode.ag" #-} + {-# LINE 60 "src-ag/GenerateCode.ag" #-} rule8 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 60 "./src-ag/GenerateCode.ag" #-} + {-# LINE 60 "src-ag/GenerateCode.ag" #-} strictWrap _lhsIoptions {-# LINE 400 "dist/build/GenerateCode.hs"#-} {-# INLINE rule9 #-} - {-# LINE 61 "./src-ag/GenerateCode.ag" #-} + {-# LINE 61 "src-ag/GenerateCode.ag" #-} rule9 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 61 "./src-ag/GenerateCode.ag" #-} + {-# LINE 61 "src-ag/GenerateCode.ag" #-} splitSems _lhsIoptions {-# LINE 406 "dist/build/GenerateCode.hs"#-} {-# INLINE rule10 #-} - {-# LINE 62 "./src-ag/GenerateCode.ag" #-} + {-# LINE 62 "src-ag/GenerateCode.ag" #-} rule10 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 62 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 63 "src-ag/GenerateCode.ag" #-} rule11 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 63 "./src-ag/GenerateCode.ag" #-} + {-# LINE 63 "src-ag/GenerateCode.ag" #-} prefix _lhsIoptions {-# LINE 418 "dist/build/GenerateCode.hs"#-} {-# INLINE rule12 #-} - {-# LINE 64 "./src-ag/GenerateCode.ag" #-} + {-# LINE 64 "src-ag/GenerateCode.ag" #-} rule12 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 64 "./src-ag/GenerateCode.ag" #-} + {-# LINE 64 "src-ag/GenerateCode.ag" #-} genTraces _lhsIoptions {-# LINE 424 "dist/build/GenerateCode.hs"#-} {-# INLINE rule13 #-} - {-# LINE 65 "./src-ag/GenerateCode.ag" #-} + {-# LINE 65 "src-ag/GenerateCode.ag" #-} rule13 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 65 "./src-ag/GenerateCode.ag" #-} + {-# LINE 65 "src-ag/GenerateCode.ag" #-} genCostCentres _lhsIoptions {-# LINE 430 "dist/build/GenerateCode.hs"#-} {-# INLINE rule14 #-} - {-# LINE 66 "./src-ag/GenerateCode.ag" #-} + {-# LINE 66 "src-ag/GenerateCode.ag" #-} rule14 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 66 "./src-ag/GenerateCode.ag" #-} + {-# LINE 66 "src-ag/GenerateCode.ag" #-} genLinePragmas _lhsIoptions {-# LINE 436 "dist/build/GenerateCode.hs"#-} {-# INLINE rule15 #-} - {-# LINE 67 "./src-ag/GenerateCode.ag" #-} + {-# LINE 67 "src-ag/GenerateCode.ag" #-} rule15 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 67 "./src-ag/GenerateCode.ag" #-} + {-# LINE 67 "src-ag/GenerateCode.ag" #-} monadic _lhsIoptions {-# LINE 442 "dist/build/GenerateCode.hs"#-} {-# INLINE rule16 #-} - {-# LINE 68 "./src-ag/GenerateCode.ag" #-} + {-# LINE 68 "src-ag/GenerateCode.ag" #-} rule16 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 68 "./src-ag/GenerateCode.ag" #-} + {-# LINE 68 "src-ag/GenerateCode.ag" #-} clean _lhsIoptions {-# LINE 448 "dist/build/GenerateCode.hs"#-} {-# INLINE rule17 #-} - {-# LINE 71 "./src-ag/GenerateCode.ag" #-} + {-# LINE 71 "src-ag/GenerateCode.ag" #-} rule17 = \ ((_lhsIoptions) :: Options) multivisit_ -> - {-# LINE 71 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 76 "src-ag/GenerateCode.ag" #-} rule18 = \ pragmas_ -> - {-# LINE 76 "./src-ag/GenerateCode.ag" #-} + {-# LINE 76 "src-ag/GenerateCode.ag" #-} pragmas_ {-# LINE 460 "dist/build/GenerateCode.hs"#-} {-# INLINE rule19 #-} - {-# LINE 98 "./src-ag/GenerateCode.ag" #-} + {-# LINE 98 "src-ag/GenerateCode.ag" #-} rule19 = \ paramMap_ -> - {-# LINE 98 "./src-ag/GenerateCode.ag" #-} + {-# LINE 98 "src-ag/GenerateCode.ag" #-} paramMap_ {-# LINE 466 "dist/build/GenerateCode.hs"#-} {-# INLINE rule20 #-} - {-# LINE 120 "./src-ag/GenerateCode.ag" #-} + {-# LINE 120 "src-ag/GenerateCode.ag" #-} rule20 = \ contextMap_ -> - {-# LINE 120 "./src-ag/GenerateCode.ag" #-} + {-# LINE 120 "src-ag/GenerateCode.ag" #-} contextMap_ {-# LINE 472 "dist/build/GenerateCode.hs"#-} {-# INLINE rule21 #-} - {-# LINE 121 "./src-ag/GenerateCode.ag" #-} + {-# LINE 121 "src-ag/GenerateCode.ag" #-} rule21 = \ quantMap_ -> - {-# LINE 121 "./src-ag/GenerateCode.ag" #-} + {-# LINE 121 "src-ag/GenerateCode.ag" #-} quantMap_ {-# LINE 478 "dist/build/GenerateCode.hs"#-} {-# INLINE rule22 #-} - {-# LINE 137 "./src-ag/GenerateCode.ag" #-} + {-# LINE 137 "src-ag/GenerateCode.ag" #-} rule22 = \ ((_nontsIgathNts) :: Set NontermIdent) -> - {-# LINE 137 "./src-ag/GenerateCode.ag" #-} + {-# LINE 137 "src-ag/GenerateCode.ag" #-} _nontsIgathNts {-# LINE 484 "dist/build/GenerateCode.hs"#-} {-# INLINE rule23 #-} - {-# LINE 587 "./src-ag/GenerateCode.ag" #-} + {-# LINE 587 "src-ag/GenerateCode.ag" #-} rule23 = \ aroundsMap_ -> - {-# LINE 587 "./src-ag/GenerateCode.ag" #-} + {-# LINE 587 "src-ag/GenerateCode.ag" #-} aroundsMap_ {-# LINE 490 "dist/build/GenerateCode.hs"#-} {-# INLINE rule24 #-} - {-# LINE 603 "./src-ag/GenerateCode.ag" #-} + {-# LINE 603 "src-ag/GenerateCode.ag" #-} rule24 = \ mergeMap_ -> - {-# LINE 603 "./src-ag/GenerateCode.ag" #-} + {-# LINE 603 "src-ag/GenerateCode.ag" #-} mergeMap_ {-# LINE 496 "dist/build/GenerateCode.hs"#-} {-# INLINE rule25 #-} - {-# LINE 760 "./src-ag/GenerateCode.ag" #-} + {-# LINE 760 "src-ag/GenerateCode.ag" #-} rule25 = \ ((_lhsIoptions) :: Options) ((_nontsIsemDomUnfoldGath) :: Map (NontermIdent, Int) ([String], Code.Type)) -> - {-# LINE 760 "./src-ag/GenerateCode.ag" #-} + {-# 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) @@ -504,39 +504,39 @@ in evalType _lhsIoptions replace tp {-# LINE 506 "dist/build/GenerateCode.hs"#-} {-# INLINE rule26 #-} - {-# LINE 861 "./src-ag/GenerateCode.ag" #-} + {-# LINE 861 "src-ag/GenerateCode.ag" #-} rule26 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 861 "./src-ag/GenerateCode.ag" #-} + {-# LINE 861 "src-ag/GenerateCode.ag" #-} typeSigs _lhsIoptions {-# LINE 512 "dist/build/GenerateCode.hs"#-} {-# INLINE rule27 #-} - {-# LINE 864 "./src-ag/GenerateCode.ag" #-} + {-# LINE 864 "src-ag/GenerateCode.ag" #-} rule27 = \ (_ :: ()) -> - {-# LINE 864 "./src-ag/GenerateCode.ag" #-} + {-# LINE 864 "src-ag/GenerateCode.ag" #-} Seq.empty {-# LINE 518 "dist/build/GenerateCode.hs"#-} {-# INLINE rule28 #-} - {-# LINE 933 "./src-ag/GenerateCode.ag" #-} + {-# LINE 933 "src-ag/GenerateCode.ag" #-} rule28 = \ ((_nontsIchunks) :: Chunks) multivisit_ -> - {-# LINE 933 "./src-ag/GenerateCode.ag" #-} + {-# LINE 933 "src-ag/GenerateCode.ag" #-} Program _nontsIchunks multivisit_ {-# LINE 524 "dist/build/GenerateCode.hs"#-} {-# INLINE rule29 #-} - {-# LINE 1001 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1001 "src-ag/GenerateCode.ag" #-} rule29 = \ typeSyns_ -> - {-# LINE 1001 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1001 "src-ag/GenerateCode.ag" #-} typeSyns_ {-# LINE 530 "dist/build/GenerateCode.hs"#-} {-# INLINE rule30 #-} - {-# LINE 1002 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1002 "src-ag/GenerateCode.ag" #-} rule30 = \ derivings_ -> - {-# LINE 1002 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1002 "src-ag/GenerateCode.ag" #-} derivings_ {-# LINE 536 "dist/build/GenerateCode.hs"#-} {-# INLINE rule31 #-} - {-# LINE 1003 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1003 "src-ag/GenerateCode.ag" #-} rule31 = \ wrappers_ -> - {-# LINE 1003 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1003 "src-ag/GenerateCode.ag" #-} wrappers_ {-# LINE 542 "dist/build/GenerateCode.hs"#-} {-# INLINE rule32 #-} @@ -561,8 +561,8 @@ 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 arg = 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 arg) + 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) ) @@ -626,15 +626,15 @@ in __result_ ) in C_CInterface_s5 v4 {-# INLINE rule36 #-} - {-# LINE 286 "./src-ag/GenerateCode.ag" #-} + {-# LINE 286 "src-ag/GenerateCode.ag" #-} rule36 = \ (_ :: ()) -> - {-# LINE 286 "./src-ag/GenerateCode.ag" #-} + {-# LINE 286 "src-ag/GenerateCode.ag" #-} 0 {-# LINE 634 "dist/build/GenerateCode.hs"#-} {-# INLINE rule37 #-} - {-# LINE 717 "./src-ag/GenerateCode.ag" #-} + {-# LINE 717 "src-ag/GenerateCode.ag" #-} rule37 = \ ((_segIsemDom) :: [Decl]) -> - {-# LINE 717 "./src-ag/GenerateCode.ag" #-} + {-# LINE 717 "src-ag/GenerateCode.ag" #-} Comment "semantic domain" : _segIsemDom {-# LINE 640 "dist/build/GenerateCode.hs"#-} {-# INLINE rule38 #-} @@ -722,8 +722,8 @@ 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 arg = 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 arg) + 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) ) @@ -820,39 +820,39 @@ in __result_ ) in C_CNonterminal_s8 v7 {-# INLINE rule63 #-} - {-# LINE 86 "./src-ag/GenerateCode.ag" #-} + {-# LINE 86 "src-ag/GenerateCode.ag" #-} rule63 = \ inh_ nt_ syn_ -> - {-# LINE 86 "./src-ag/GenerateCode.ag" #-} + {-# LINE 86 "src-ag/GenerateCode.ag" #-} (inh_,syn_,nt_) {-# LINE 828 "dist/build/GenerateCode.hs"#-} {-# INLINE rule64 #-} - {-# LINE 87 "./src-ag/GenerateCode.ag" #-} + {-# LINE 87 "src-ag/GenerateCode.ag" #-} rule64 = \ inh_ nt_ syn_ -> - {-# LINE 87 "./src-ag/GenerateCode.ag" #-} + {-# LINE 87 "src-ag/GenerateCode.ag" #-} (inh_,syn_,nt_) {-# LINE 834 "dist/build/GenerateCode.hs"#-} {-# INLINE rule65 #-} - {-# LINE 143 "./src-ag/GenerateCode.ag" #-} + {-# LINE 143 "src-ag/GenerateCode.ag" #-} rule65 = \ nt_ -> - {-# LINE 143 "./src-ag/GenerateCode.ag" #-} + {-# LINE 143 "src-ag/GenerateCode.ag" #-} Set.singleton nt_ {-# LINE 840 "dist/build/GenerateCode.hs"#-} {-# INLINE rule66 #-} - {-# LINE 588 "./src-ag/GenerateCode.ag" #-} + {-# LINE 588 "src-ag/GenerateCode.ag" #-} rule66 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Set Identifier))) nt_ -> - {-# LINE 588 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 604 "src-ag/GenerateCode.ag" #-} rule67 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) nt_ -> - {-# LINE 604 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 810 "src-ag/GenerateCode.ag" #-} let params' = map getName params_ inhAttrs = Map.toList inh_ synAttrs = Map.toList syn_ @@ -879,15 +879,15 @@ ] {-# LINE 881 "dist/build/GenerateCode.hs"#-} {-# INLINE rule69 #-} - {-# LINE 871 "./src-ag/GenerateCode.ag" #-} + {-# LINE 871 "src-ag/GenerateCode.ag" #-} rule69 = \ ((_interIcomments) :: [String]) ((_prodsIcomments) :: [String]) -> - {-# LINE 871 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 936 "src-ag/GenerateCode.ag" #-} [ Chunk (getName nt_) (Comment (getName nt_ ++ " " ++ replicate (60 - length (getName nt_)) '-')) (if _lhsIo_pretty then [_comment ] else []) @@ -900,9 +900,9 @@ ] {-# LINE 902 "dist/build/GenerateCode.hs"#-} {-# INLINE rule71 #-} - {-# LINE 1006 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 1006 "src-ag/GenerateCode.ag" #-} let params' = map getName params_ typeSyn tp = let theType = case tp of @@ -920,15 +920,15 @@ in maybe dataDef typeSyn $ lookup nt_ _lhsItypeSyns {-# LINE 922 "dist/build/GenerateCode.hs"#-} {-# INLINE rule72 #-} - {-# LINE 1050 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1050 "src-ag/GenerateCode.ag" #-} rule72 = \ ((_lhsIoptions) :: Options) nt_ -> - {-# LINE 1050 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 1051 "src-ag/GenerateCode.ag" #-} let appParams nm = TypeApp (SimpleType nm) (map SimpleType (map getName params_)) evalTp | null params_ = id | otherwise = idEvalType _lhsIoptions @@ -1183,8 +1183,8 @@ 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 arg = 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 arg) + 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) ) @@ -1508,8 +1508,8 @@ 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 arg = 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 arg) + 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) ) @@ -1595,84 +1595,84 @@ in __result_ ) in C_CProduction_s14 v13 {-# INLINE rule188 #-} - {-# LINE 92 "./src-ag/GenerateCode.ag" #-} + {-# LINE 92 "src-ag/GenerateCode.ag" #-} rule188 = \ con_ -> - {-# LINE 92 "./src-ag/GenerateCode.ag" #-} + {-# LINE 92 "src-ag/GenerateCode.ag" #-} con_ {-# LINE 1603 "dist/build/GenerateCode.hs"#-} {-# INLINE rule189 #-} - {-# LINE 93 "./src-ag/GenerateCode.ag" #-} + {-# LINE 93 "src-ag/GenerateCode.ag" #-} rule189 = \ terminals_ -> - {-# LINE 93 "./src-ag/GenerateCode.ag" #-} + {-# LINE 93 "src-ag/GenerateCode.ag" #-} terminals_ {-# LINE 1609 "dist/build/GenerateCode.hs"#-} {-# INLINE rule190 #-} - {-# LINE 105 "./src-ag/GenerateCode.ag" #-} + {-# LINE 105 "src-ag/GenerateCode.ag" #-} rule190 = \ ((_lhsIoptions) :: Options) children_ -> - {-# LINE 105 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 147 "src-ag/GenerateCode.ag" #-} rule191 = \ (_ :: ()) -> - {-# LINE 147 "./src-ag/GenerateCode.ag" #-} + {-# LINE 147 "src-ag/GenerateCode.ag" #-} Set.empty {-# LINE 1621 "dist/build/GenerateCode.hs"#-} {-# INLINE rule192 #-} - {-# LINE 282 "./src-ag/GenerateCode.ag" #-} + {-# LINE 282 "src-ag/GenerateCode.ag" #-} rule192 = \ (_ :: ()) -> - {-# LINE 282 "./src-ag/GenerateCode.ag" #-} + {-# LINE 282 "src-ag/GenerateCode.ag" #-} 0 {-# LINE 1627 "dist/build/GenerateCode.hs"#-} {-# INLINE rule193 #-} - {-# LINE 414 "./src-ag/GenerateCode.ag" #-} + {-# LINE 414 "src-ag/GenerateCode.ag" #-} rule193 = \ children_ -> - {-# LINE 414 "./src-ag/GenerateCode.ag" #-} + {-# LINE 414 "src-ag/GenerateCode.ag" #-} children_ {-# LINE 1633 "dist/build/GenerateCode.hs"#-} {-# INLINE rule194 #-} - {-# LINE 569 "./src-ag/GenerateCode.ag" #-} + {-# LINE 569 "src-ag/GenerateCode.ag" #-} rule194 = \ ((_visitsIgatherInstVisitNrs) :: Map Identifier Int) -> - {-# LINE 569 "./src-ag/GenerateCode.ag" #-} + {-# LINE 569 "src-ag/GenerateCode.ag" #-} _visitsIgatherInstVisitNrs {-# LINE 1639 "dist/build/GenerateCode.hs"#-} {-# INLINE rule195 #-} - {-# LINE 589 "./src-ag/GenerateCode.ag" #-} + {-# LINE 589 "src-ag/GenerateCode.ag" #-} rule195 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Set Identifier)) con_ -> - {-# LINE 589 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 605 "src-ag/GenerateCode.ag" #-} rule196 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) con_ -> - {-# LINE 605 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 886 "src-ag/GenerateCode.ag" #-} rule197 = \ children_ -> - {-# LINE 886 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 887 "src-ag/GenerateCode.ag" #-} rule198 = \ _firstOrderChildren ((_visitsIcomments) :: [String]) con_ -> - {-# LINE 887 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 1030 "src-ag/GenerateCode.ag" #-} rule199 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) -> - {-# LINE 1030 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 1031 "src-ag/GenerateCode.ag" #-} rule200 = \ _firstOrderChildren ((_lhsInt) :: NontermIdent) ((_lhsIo_rename) :: Bool) ((_lhsIoptions) :: Options) _params con_ -> - {-# LINE 1031 "./src-ag/GenerateCode.ag" #-} + {-# 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 @@ -1681,9 +1681,9 @@ else DataAlt conNm $ mkFields $ \_ _ _ t -> t {-# LINE 1683 "dist/build/GenerateCode.hs"#-} {-# INLINE rule201 #-} - {-# LINE 1161 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1161 "src-ag/GenerateCode.ag" #-} rule201 = \ _firstOrderChildren ((_lhsInt) :: NontermIdent) ((_lhsIo_rename) :: Bool) ((_lhsIoptions) :: Options) ((_lhsIprefix) :: String) con_ -> - {-# LINE 1161 "./src-ag/GenerateCode.ag" #-} + {-# 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 ) @@ -1806,8 +1806,8 @@ 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 arg = 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 arg) + 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) ) @@ -1914,15 +1914,15 @@ in __result_ ) in C_CProductions_s17 v16 {-# INLINE rule236 #-} - {-# LINE 1026 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1026 "src-ag/GenerateCode.ag" #-} rule236 = \ ((_hdIdataAlt) :: DataAlt) ((_tlIdataAlts) :: DataAlts) -> - {-# LINE 1026 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1026 "src-ag/GenerateCode.ag" #-} _hdIdataAlt : _tlIdataAlts {-# LINE 1922 "dist/build/GenerateCode.hs"#-} {-# INLINE rule237 #-} - {-# LINE 1157 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1157 "src-ag/GenerateCode.ag" #-} rule237 = \ ((_hdIcataAlt) :: Decl) ((_tlIcataAlts) :: Decls) -> - {-# LINE 1157 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1157 "src-ag/GenerateCode.ag" #-} _hdIcataAlt : _tlIcataAlts {-# LINE 1928 "dist/build/GenerateCode.hs"#-} {-# INLINE rule238 #-} @@ -2141,15 +2141,15 @@ in __result_ ) in C_CProductions_s17 v16 {-# INLINE rule303 #-} - {-# LINE 1027 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1027 "src-ag/GenerateCode.ag" #-} rule303 = \ (_ :: ()) -> - {-# LINE 1027 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1027 "src-ag/GenerateCode.ag" #-} [] {-# LINE 2149 "dist/build/GenerateCode.hs"#-} {-# INLINE rule304 #-} - {-# LINE 1158 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1158 "src-ag/GenerateCode.ag" #-} rule304 = \ (_ :: ()) -> - {-# LINE 1158 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1158 "src-ag/GenerateCode.ag" #-} [] {-# LINE 2155 "dist/build/GenerateCode.hs"#-} {-# INLINE rule305 #-} @@ -2171,8 +2171,8 @@ 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 arg = 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 arg) + 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) ) @@ -2242,23 +2242,23 @@ in __result_ ) in C_CRule_s20 v19 {-# INLINE rule308 #-} - {-# LINE 158 "./src-ag/GenerateCode.ag" #-} + {-# LINE 158 "src-ag/GenerateCode.ag" #-} rule308 = \ ((_lhsIchildren) :: [(Identifier,Type,ChildKind)]) -> - {-# LINE 158 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 159 "src-ag/GenerateCode.ag" #-} rule309 = \ ((_lhsIo_pretty) :: Bool) origin_ -> - {-# LINE 159 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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 @@ -2278,45 +2278,45 @@ ] {-# LINE 2280 "dist/build/GenerateCode.hs"#-} {-# INLINE rule311 #-} - {-# LINE 179 "./src-ag/GenerateCode.ag" #-} + {-# LINE 179 "src-ag/GenerateCode.ag" #-} rule311 = \ ((_patternIpatternAttributes) :: [(Identifier, Identifier)]) isIn_ -> - {-# LINE 179 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 182 "src-ag/GenerateCode.ag" #-} rule312 = \ _patDescr con_ mbNamed_ nt_ -> - {-# LINE 182 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 184 "src-ag/GenerateCode.ag" #-} rule313 = \ ((_lhsIo_traces) :: Bool) _traceDescr -> - {-# LINE 184 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 187 "src-ag/GenerateCode.ag" #-} rule314 = \ _patDescr con_ nt_ -> - {-# LINE 187 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 188 "src-ag/GenerateCode.ag" #-} rule315 = \ _costCentreDescr ((_lhsIo_costcentre) :: Bool) -> - {-# LINE 188 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 191 "src-ag/GenerateCode.ag" #-} rule316 = \ ((_lhsIo_linePragmas) :: Bool) name_ -> - {-# LINE 191 "./src-ag/GenerateCode.ag" #-} + {-# 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 @@ -2326,9 +2326,9 @@ else v {-# LINE 2328 "dist/build/GenerateCode.hs"#-} {-# INLINE rule317 #-} - {-# LINE 198 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# 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_]) @@ -2337,41 +2337,41 @@ else _instDecls {-# LINE 2339 "dist/build/GenerateCode.hs"#-} {-# INLINE rule318 #-} - {-# LINE 268 "./src-ag/GenerateCode.ag" #-} + {-# LINE 268 "src-ag/GenerateCode.ag" #-} rule318 = \ ((_patternIdefinedInsts) :: [Identifier]) isIn_ -> - {-# LINE 268 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 338 "src-ag/GenerateCode.ag" #-} rule319 = \ ((_lhsIoptions) :: Options) ((_lhsIterminals) :: [Identifier]) field_ isIn_ name_ -> - {-# LINE 338 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 341 "src-ag/GenerateCode.ag" #-} rule320 = \ _rulename -> - {-# LINE 341 "./src-ag/GenerateCode.ag" #-} + {-# LINE 341 "src-ag/GenerateCode.ag" #-} [SimpleExpr _rulename ] {-# LINE 2359 "dist/build/GenerateCode.hs"#-} {-# INLINE rule321 #-} - {-# LINE 357 "./src-ag/GenerateCode.ag" #-} + {-# LINE 357 "src-ag/GenerateCode.ag" #-} rule321 = \ _rulename -> - {-# LINE 357 "./src-ag/GenerateCode.ag" #-} + {-# LINE 357 "src-ag/GenerateCode.ag" #-} Set.singleton _rulename {-# LINE 2365 "dist/build/GenerateCode.hs"#-} {-# INLINE rule322 #-} - {-# LINE 367 "./src-ag/GenerateCode.ag" #-} + {-# LINE 367 "src-ag/GenerateCode.ag" #-} rule322 = \ ((_lhsInt) :: NontermIdent) _orgParams -> - {-# LINE 367 "./src-ag/GenerateCode.ag" #-} + {-# LINE 367 "src-ag/GenerateCode.ag" #-} typeToCodeType (Just _lhsInt) _orgParams {-# LINE 2371 "dist/build/GenerateCode.hs"#-} {-# INLINE rule323 #-} - {-# LINE 368 "./src-ag/GenerateCode.ag" #-} + {-# LINE 368 "src-ag/GenerateCode.ag" #-} rule323 = \ _evalTp ((_lhsIchildren) :: [(Identifier,Type,ChildKind)]) ((_lhsIoptions) :: Options) _mkTp defines_ -> - {-# LINE 368 "./src-ag/GenerateCode.ag" #-} + {-# 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) @@ -2388,15 +2388,15 @@ ] {-# LINE 2390 "dist/build/GenerateCode.hs"#-} {-# INLINE rule324 #-} - {-# LINE 383 "./src-ag/GenerateCode.ag" #-} + {-# LINE 383 "src-ag/GenerateCode.ag" #-} rule324 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) -> - {-# LINE 383 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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) @@ -2408,27 +2408,27 @@ else evalType _lhsIoptions replace tp {-# LINE 2410 "dist/build/GenerateCode.hs"#-} {-# INLINE rule326 #-} - {-# LINE 420 "./src-ag/GenerateCode.ag" #-} + {-# LINE 420 "src-ag/GenerateCode.ag" #-} rule326 = \ tp_ -> - {-# LINE 420 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 621 "src-ag/GenerateCode.ag" #-} rule327 = \ _decls ((_lhsIdeclsAbove) :: [Decl]) -> - {-# LINE 621 "./src-ag/GenerateCode.ag" #-} + {-# LINE 621 "src-ag/GenerateCode.ag" #-} _lhsIdeclsAbove ++ _decls {-# LINE 2422 "dist/build/GenerateCode.hs"#-} {-# INLINE rule328 #-} - {-# LINE 634 "./src-ag/GenerateCode.ag" #-} + {-# LINE 634 "src-ag/GenerateCode.ag" #-} rule328 = \ (_ :: ()) -> - {-# LINE 634 "./src-ag/GenerateCode.ag" #-} + {-# LINE 634 "src-ag/GenerateCode.ag" #-} id {-# LINE 2428 "dist/build/GenerateCode.hs"#-} {-# INLINE rule329 #-} - {-# LINE 910 "./src-ag/GenerateCode.ag" #-} + {-# LINE 910 "src-ag/GenerateCode.ag" #-} rule329 = \ ((_lhsIwhat) :: String) defines_ -> - {-# LINE 910 "./src-ag/GenerateCode.ag" #-} + {-# 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"#-} @@ -2488,29 +2488,29 @@ in __result_ ) in C_CRule_s20 v19 {-# INLINE rule333 #-} - {-# LINE 148 "./src-ag/GenerateCode.ag" #-} + {-# LINE 148 "src-ag/GenerateCode.ag" #-} rule333 = \ ((_lhsIvisitedSet) :: Set Identifier) name_ -> - {-# LINE 148 "./src-ag/GenerateCode.ag" #-} + {-# LINE 148 "src-ag/GenerateCode.ag" #-} Set.insert name_ _lhsIvisitedSet {-# LINE 2496 "dist/build/GenerateCode.hs"#-} {-# INLINE rule334 #-} - {-# LINE 204 "./src-ag/GenerateCode.ag" #-} + {-# LINE 204 "src-ag/GenerateCode.ag" #-} rule334 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) name_ nr_ nt_ -> - {-# LINE 204 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 205 "src-ag/GenerateCode.ag" #-} rule335 = \ _costCentreDescr ((_lhsIo_costcentre) :: Bool) -> - {-# LINE 205 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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_) @@ -2551,106 +2551,106 @@ (outDecls ++ outMerged) {-# LINE 2553 "dist/build/GenerateCode.hs"#-} {-# INLINE rule337 #-} - {-# LINE 330 "./src-ag/GenerateCode.ag" #-} + {-# LINE 330 "src-ag/GenerateCode.ag" #-} rule337 = \ ((_lhsIinstVisitNrs) :: Map Identifier Int) ((_lhsInr) :: Int) name_ -> - {-# LINE 330 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 343 "src-ag/GenerateCode.ag" #-} rule338 = \ _isSuperfluousHigherOrderIntra name_ nr_ -> - {-# LINE 343 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 359 "src-ag/GenerateCode.ag" #-} rule340 = \ _names -> - {-# LINE 359 "./src-ag/GenerateCode.ag" #-} + {-# LINE 359 "src-ag/GenerateCode.ag" #-} Set.fromList _names {-# LINE 2582 "dist/build/GenerateCode.hs"#-} {-# INLINE rule341 #-} - {-# LINE 395 "./src-ag/GenerateCode.ag" #-} + {-# LINE 395 "src-ag/GenerateCode.ag" #-} rule341 = \ _evalTp _orgParams nt_ -> - {-# LINE 395 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 396 "src-ag/GenerateCode.ag" #-} rule342 = \ ((_lhsIoptions) :: Options) _mkTp name_ syn_ -> - {-# LINE 396 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 397 "src-ag/GenerateCode.ag" #-} rule343 = \ nr_ nt_ -> - {-# LINE 397 "./src-ag/GenerateCode.ag" #-} + {-# LINE 397 "src-ag/GenerateCode.ag" #-} typeName nt_ (nr_+1) {-# LINE 2600 "dist/build/GenerateCode.hs"#-} {-# INLINE rule344 #-} - {-# LINE 398 "./src-ag/GenerateCode.ag" #-} + {-# LINE 398 "src-ag/GenerateCode.ag" #-} rule344 = \ _definedTps _instParams _nextTp isLast_ name_ nr_ -> - {-# LINE 398 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 400 "src-ag/GenerateCode.ag" #-} rule345 = \ ((_lhsIparamMap) :: ParamMap) nt_ -> - {-# LINE 400 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 401 "src-ag/GenerateCode.ag" #-} rule346 = \ ((_lhsIparamInstMap) :: Map Identifier (NontermIdent, [String])) name_ nt_ -> - {-# LINE 401 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 402 "src-ag/GenerateCode.ag" #-} rule347 = \ _instParams _orgParams -> - {-# LINE 402 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 403 "src-ag/GenerateCode.ag" #-} rule348 = \ _replParamMap -> - {-# LINE 403 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 404 "src-ag/GenerateCode.ag" #-} rule349 = \ ((_lhsIoptions) :: Options) _orgParams _replace -> - {-# LINE 404 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 421 "src-ag/GenerateCode.ag" #-} rule350 = \ _instParams _isSuperfluousHigherOrderIntra nr_ nt_ -> - {-# LINE 421 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 623 "src-ag/GenerateCode.ag" #-} rule351 = \ (_ :: ()) -> - {-# LINE 623 "./src-ag/GenerateCode.ag" #-} + {-# LINE 623 "src-ag/GenerateCode.ag" #-} [] {-# LINE 2650 "dist/build/GenerateCode.hs"#-} {-# INLINE rule352 #-} - {-# LINE 636 "./src-ag/GenerateCode.ag" #-} + {-# LINE 636 "src-ag/GenerateCode.ag" #-} rule352 = \ _decls ((_lhsIdeclsAbove) :: [Decl]) -> - {-# LINE 636 "./src-ag/GenerateCode.ag" #-} + {-# LINE 636 "src-ag/GenerateCode.ag" #-} DeclBlock _lhsIdeclsAbove (head _decls ) {-# LINE 2656 "dist/build/GenerateCode.hs"#-} {-# INLINE rule353 #-} @@ -2678,8 +2678,8 @@ 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 arg = 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 arg) + 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) ) @@ -2733,103 +2733,103 @@ in __result_ ) in C_CSegment_s23 v22 {-# INLINE rule358 #-} - {-# LINE 720 "./src-ag/GenerateCode.ag" #-} + {-# LINE 720 "src-ag/GenerateCode.ag" #-} rule358 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 720 "./src-ag/GenerateCode.ag" #-} + {-# LINE 720 "src-ag/GenerateCode.ag" #-} breadthFirst _lhsIoptions {-# LINE 2741 "dist/build/GenerateCode.hs"#-} {-# INLINE rule359 #-} - {-# LINE 721 "./src-ag/GenerateCode.ag" #-} + {-# LINE 721 "src-ag/GenerateCode.ag" #-} rule359 = \ _altSemForm _indexExpr _inhTps _synTps -> - {-# LINE 721 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 724 "src-ag/GenerateCode.ag" #-} rule360 = \ ((_lhsInt) :: NontermIdent) _params inh_ -> - {-# LINE 724 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 725 "src-ag/GenerateCode.ag" #-} rule361 = \ _inhTps ((_lhsIo_unbox) :: Bool) -> - {-# LINE 725 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 726 "src-ag/GenerateCode.ag" #-} rule362 = \ _continuation _inhTps ((_lhsInt) :: NontermIdent) ((_lhsIo_unbox) :: Bool) _params syn_ -> - {-# LINE 726 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 727 "src-ag/GenerateCode.ag" #-} rule363 = \ ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) -> - {-# LINE 727 "./src-ag/GenerateCode.ag" #-} + {-# LINE 727 "src-ag/GenerateCode.ag" #-} typeName _lhsInt _lhsInr {-# LINE 2773 "dist/build/GenerateCode.hs"#-} {-# INLINE rule364 #-} - {-# LINE 728 "./src-ag/GenerateCode.ag" #-} + {-# LINE 728 "src-ag/GenerateCode.ag" #-} rule364 = \ ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) -> - {-# LINE 728 "./src-ag/GenerateCode.ag" #-} + {-# LINE 728 "src-ag/GenerateCode.ag" #-} typeName _lhsInt (_lhsInr + 1) {-# LINE 2779 "dist/build/GenerateCode.hs"#-} {-# INLINE rule365 #-} - {-# LINE 729 "./src-ag/GenerateCode.ag" #-} + {-# LINE 729 "src-ag/GenerateCode.ag" #-} rule365 = \ _curTypeName -> - {-# LINE 729 "./src-ag/GenerateCode.ag" #-} + {-# LINE 729 "src-ag/GenerateCode.ag" #-} "I_" ++ _curTypeName {-# LINE 2785 "dist/build/GenerateCode.hs"#-} {-# INLINE rule366 #-} - {-# LINE 730 "./src-ag/GenerateCode.ag" #-} + {-# LINE 730 "src-ag/GenerateCode.ag" #-} rule366 = \ _indexName _params -> - {-# LINE 730 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 731 "src-ag/GenerateCode.ag" #-} rule367 = \ _indexName _params -> - {-# LINE 731 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 732 "src-ag/GenerateCode.ag" #-} rule368 = \ _indexName _params -> - {-# LINE 732 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 733 "src-ag/GenerateCode.ag" #-} rule369 = \ _indexStr _inhTup ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) -> - {-# LINE 733 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 734 "src-ag/GenerateCode.ag" #-} rule370 = \ _indexStr ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) _synTps -> - {-# LINE 734 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 735 "src-ag/GenerateCode.ag" #-} rule371 = \ ((_lhsIisLast) :: Bool) _nextTypeName _params -> - {-# LINE 735 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 738 "src-ag/GenerateCode.ag" #-} rule372 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) -> - {-# LINE 738 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 739 "src-ag/GenerateCode.ag" #-} let name = typeName _lhsInt _lhsInr evalTp | null _params = id | otherwise = idEvalType _lhsIoptions @@ -2841,15 +2841,15 @@ else [] ) {-# LINE 2843 "dist/build/GenerateCode.hs"#-} {-# INLINE rule374 #-} - {-# LINE 753 "./src-ag/GenerateCode.ag" #-} + {-# LINE 753 "src-ag/GenerateCode.ag" #-} rule374 = \ ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) _params _tp -> - {-# LINE 753 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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_) @@ -2862,9 +2862,9 @@ 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" #-} + {-# LINE 880 "src-ag/GenerateCode.ag" #-} rule376 = \ ((_lhsInr) :: Int) inh_ syn_ -> - {-# LINE 880 "./src-ag/GenerateCode.ag" #-} + {-# LINE 880 "src-ag/GenerateCode.ag" #-} let body = map ind (showsSegment (CSegment inh_ syn_)) in if null body then [] @@ -2880,8 +2880,8 @@ 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 arg = 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 arg) + 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) ) @@ -2973,21 +2973,21 @@ in __result_ ) in C_CSegments_s26 v25 {-# INLINE rule377 #-} - {-# LINE 288 "./src-ag/GenerateCode.ag" #-} + {-# LINE 288 "src-ag/GenerateCode.ag" #-} rule377 = \ ((_lhsInr) :: Int) -> - {-# LINE 288 "./src-ag/GenerateCode.ag" #-} + {-# LINE 288 "src-ag/GenerateCode.ag" #-} _lhsInr + 1 {-# LINE 2981 "dist/build/GenerateCode.hs"#-} {-# INLINE rule378 #-} - {-# LINE 301 "./src-ag/GenerateCode.ag" #-} + {-# LINE 301 "src-ag/GenerateCode.ag" #-} rule378 = \ (_ :: ()) -> - {-# LINE 301 "./src-ag/GenerateCode.ag" #-} + {-# LINE 301 "src-ag/GenerateCode.ag" #-} False {-# LINE 2987 "dist/build/GenerateCode.hs"#-} {-# INLINE rule379 #-} - {-# LINE 302 "./src-ag/GenerateCode.ag" #-} + {-# LINE 302 "src-ag/GenerateCode.ag" #-} rule379 = \ ((_tlIisNil) :: Bool) -> - {-# LINE 302 "./src-ag/GenerateCode.ag" #-} + {-# LINE 302 "src-ag/GenerateCode.ag" #-} _tlIisNil {-# LINE 2993 "dist/build/GenerateCode.hs"#-} {-# INLINE rule380 #-} @@ -3158,9 +3158,9 @@ in __result_ ) in C_CSegments_s26 v25 {-# INLINE rule429 #-} - {-# LINE 303 "./src-ag/GenerateCode.ag" #-} + {-# LINE 303 "src-ag/GenerateCode.ag" #-} rule429 = \ (_ :: ()) -> - {-# LINE 303 "./src-ag/GenerateCode.ag" #-} + {-# LINE 303 "src-ag/GenerateCode.ag" #-} True {-# LINE 3166 "dist/build/GenerateCode.hs"#-} {-# INLINE rule430 #-} @@ -3185,8 +3185,8 @@ 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 arg = 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 arg) + 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) ) @@ -3329,45 +3329,45 @@ in __result_ ) in C_CVisit_s29 v28 {-# INLINE rule434 #-} - {-# LINE 312 "./src-ag/GenerateCode.ag" #-} + {-# LINE 312 "src-ag/GenerateCode.ag" #-} rule434 = \ ((_intraIexprs) :: Exprs) -> - {-# LINE 312 "./src-ag/GenerateCode.ag" #-} + {-# LINE 312 "src-ag/GenerateCode.ag" #-} _intraIexprs {-# LINE 3337 "dist/build/GenerateCode.hs"#-} {-# INLINE rule435 #-} - {-# LINE 313 "./src-ag/GenerateCode.ag" #-} + {-# LINE 313 "src-ag/GenerateCode.ag" #-} rule435 = \ ((_intraIusedVars) :: Set String) -> - {-# LINE 313 "./src-ag/GenerateCode.ag" #-} + {-# LINE 313 "src-ag/GenerateCode.ag" #-} _intraIusedVars {-# LINE 3343 "dist/build/GenerateCode.hs"#-} {-# INLINE rule436 #-} - {-# LINE 443 "./src-ag/GenerateCode.ag" #-} + {-# LINE 443 "src-ag/GenerateCode.ag" #-} rule436 = \ ((_lhsIchildren) :: [(Identifier,Type, ChildKind)]) -> - {-# LINE 443 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 444 "src-ag/GenerateCode.ag" #-} rule437 = \ _firstOrderChildren -> - {-# LINE 444 "./src-ag/GenerateCode.ag" #-} + {-# LINE 444 "src-ag/GenerateCode.ag" #-} map pickOrigType _firstOrderChildren {-# LINE 3355 "dist/build/GenerateCode.hs"#-} {-# INLINE rule438 #-} - {-# LINE 445 "./src-ag/GenerateCode.ag" #-} + {-# LINE 445 "src-ag/GenerateCode.ag" #-} rule438 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIprefix) :: String) -> - {-# LINE 445 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 446 "src-ag/GenerateCode.ag" #-} rule439 = \ ((_lhsIisLast) :: Bool) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIprefix) :: String) -> - {-# LINE 446 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 447 "src-ag/GenerateCode.ag" #-} let lhs = TupleLhs _nextVisitName rhs = Let _lhsIdecls (SimpleExpr fun) fun = seqSemname _lhsIprefix _lhsInt _lhsIcon (_lhsInr+1) @@ -3376,21 +3376,21 @@ else [Decl lhs rhs (Set.fromList _nextVisitName) _lhsInextIntraVars] {-# LINE 3378 "dist/build/GenerateCode.hs"#-} {-# INLINE rule441 #-} - {-# LINE 454 "./src-ag/GenerateCode.ag" #-} + {-# LINE 454 "src-ag/GenerateCode.ag" #-} rule441 = \ ((_lhsIisLast) :: Bool) ((_lhsInr) :: Int) -> - {-# LINE 454 "./src-ag/GenerateCode.ag" #-} + {-# LINE 454 "src-ag/GenerateCode.ag" #-} _lhsIisLast && _lhsInr == 0 {-# LINE 3384 "dist/build/GenerateCode.hs"#-} {-# INLINE rule442 #-} - {-# LINE 455 "./src-ag/GenerateCode.ag" #-} + {-# LINE 455 "src-ag/GenerateCode.ag" #-} rule442 = \ ((_lhsInt) :: NontermIdent) ((_lhsIwrappers) :: Set NontermIdent) -> - {-# LINE 455 "./src-ag/GenerateCode.ag" #-} + {-# LINE 455 "src-ag/GenerateCode.ag" #-} _lhsInt `Set.member` _lhsIwrappers {-# LINE 3390 "dist/build/GenerateCode.hs"#-} {-# INLINE rule443 #-} - {-# LINE 456 "./src-ag/GenerateCode.ag" #-} + {-# LINE 456 "src-ag/GenerateCode.ag" #-} rule443 = \ _hasWrappers _isOneVisit ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) syn_ -> - {-# LINE 456 "./src-ag/GenerateCode.ag" #-} + {-# LINE 456 "src-ag/GenerateCode.ag" #-} if _isOneVisit && _hasWrappers && reference _lhsIoptions then let synAttrs = Map.toList syn_ synNT = "Syn" ++ "_" ++ getName _lhsInt @@ -3401,61 +3401,61 @@ else [] {-# LINE 3403 "dist/build/GenerateCode.hs"#-} {-# INLINE rule444 #-} - {-# LINE 464 "./src-ag/GenerateCode.ag" #-} + {-# LINE 464 "src-ag/GenerateCode.ag" #-} rule444 = \ ((_lhsIo_clean) :: Bool) _nextVisitDecl _refDecls _typeSigs ((_vssIdecls) :: Decls) -> - {-# LINE 464 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 467 "src-ag/GenerateCode.ag" #-} rule445 = \ ((_lhsIo_unbox) :: Bool) ((_lhsIoptions) :: Options) _nextVisitName inh_ syn_ -> - {-# LINE 467 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 468 "src-ag/GenerateCode.ag" #-} rule446 = \ (_ :: ()) -> - {-# LINE 468 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 469 "src-ag/GenerateCode.ag" #-} rule447 = \ ((_lhsIoptions) :: Options) _nextVisitName syn_ -> - {-# LINE 469 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 470 "src-ag/GenerateCode.ag" #-} rule448 = \ _funcname _lastExprVars _nextVisitDecl _o_case ((_vssIblockDecls) :: DeclBlocks) -> - {-# LINE 470 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 472 "src-ag/GenerateCode.ag" #-} rule449 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) -> - {-# LINE 472 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 473 "src-ag/GenerateCode.ag" #-} rule450 = \ _costCentreDescr ((_lhsIo_costcentre) :: Bool) -> - {-# LINE 473 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 477 "src-ag/GenerateCode.ag" #-} rule451 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) -> - {-# LINE 477 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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] @@ -3484,15 +3484,15 @@ in Decl lhs rhs Set.empty Set.empty {-# LINE 3486 "dist/build/GenerateCode.hs"#-} {-# INLINE rule453 #-} - {-# LINE 509 "./src-ag/GenerateCode.ag" #-} + {-# LINE 509 "src-ag/GenerateCode.ag" #-} rule453 = \ _funcname _semType -> - {-# LINE 509 "./src-ag/GenerateCode.ag" #-} + {-# LINE 509 "src-ag/GenerateCode.ag" #-} TSig _funcname _semType {-# LINE 3492 "dist/build/GenerateCode.hs"#-} {-# INLINE rule454 #-} - {-# LINE 510 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# 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 @@ -3505,9 +3505,9 @@ else foldr argType (typeAppStrs (typeName _lhsInt _lhsInr) _params ) [] {-# LINE 3507 "dist/build/GenerateCode.hs"#-} {-# INLINE rule455 #-} - {-# LINE 521 "./src-ag/GenerateCode.ag" #-} + {-# LINE 521 "src-ag/GenerateCode.ag" #-} rule455 = \ _blockFunDecls ((_lhsIwith_sig) :: Bool) _o_splitsems _semFun _tsig ordered_ -> - {-# LINE 521 "./src-ag/GenerateCode.ag" #-} + {-# LINE 521 "src-ag/GenerateCode.ag" #-} ( if _lhsIwith_sig then [_tsig, _semFun] else [_semFun] @@ -3518,29 +3518,29 @@ ) {-# LINE 3520 "dist/build/GenerateCode.hs"#-} {-# INLINE rule456 #-} - {-# LINE 529 "./src-ag/GenerateCode.ag" #-} + {-# LINE 529 "src-ag/GenerateCode.ag" #-} rule456 = \ ((_lhsIo_sig) :: Bool) _o_case ((_vssItSigs) :: [Decl]) -> - {-# LINE 529 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 532 "src-ag/GenerateCode.ag" #-} rule457 = \ ((_lhsIo_monadic) :: Bool) ordered_ -> - {-# LINE 532 "./src-ag/GenerateCode.ag" #-} + {-# LINE 532 "src-ag/GenerateCode.ag" #-} ordered_ && _lhsIo_monadic {-# LINE 3534 "dist/build/GenerateCode.hs"#-} {-# INLINE rule458 #-} - {-# LINE 533 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 534 "src-ag/GenerateCode.ag" #-} rule459 = \ _o_case _o_do -> - {-# LINE 534 "./src-ag/GenerateCode.ag" #-} + {-# LINE 534 "src-ag/GenerateCode.ag" #-} if _o_do then DeclsDo else if _o_case @@ -3548,54 +3548,54 @@ else DeclsLet {-# LINE 3550 "dist/build/GenerateCode.hs"#-} {-# INLINE rule460 #-} - {-# LINE 539 "./src-ag/GenerateCode.ag" #-} + {-# LINE 539 "src-ag/GenerateCode.ag" #-} rule460 = \ ((_lhsIo_splitsems) :: Bool) ordered_ -> - {-# LINE 539 "./src-ag/GenerateCode.ag" #-} + {-# LINE 539 "src-ag/GenerateCode.ag" #-} ordered_ && _lhsIo_splitsems {-# LINE 3556 "dist/build/GenerateCode.hs"#-} {-# INLINE rule461 #-} - {-# LINE 573 "./src-ag/GenerateCode.ag" #-} + {-# LINE 573 "src-ag/GenerateCode.ag" #-} rule461 = \ ((_lhsInr) :: Int) ((_vssIdefinedInsts) :: [Identifier]) -> - {-# LINE 573 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 616 "src-ag/GenerateCode.ag" #-} rule462 = \ (_ :: ()) -> - {-# LINE 616 "./src-ag/GenerateCode.ag" #-} + {-# LINE 616 "src-ag/GenerateCode.ag" #-} [] {-# LINE 3568 "dist/build/GenerateCode.hs"#-} {-# INLINE rule463 #-} - {-# LINE 617 "./src-ag/GenerateCode.ag" #-} + {-# LINE 617 "src-ag/GenerateCode.ag" #-} rule463 = \ (_ :: ()) -> - {-# LINE 617 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 901 "src-ag/GenerateCode.ag" #-} rule464 = \ ((_intraIcomments) :: [String]) ((_lhsInr) :: Int) ((_vssIcomments) :: [String]) -> - {-# LINE 901 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 905 "src-ag/GenerateCode.ag" #-} rule465 = \ (_ :: ()) -> - {-# LINE 905 "./src-ag/GenerateCode.ag" #-} + {-# LINE 905 "src-ag/GenerateCode.ag" #-} "local" {-# LINE 3589 "dist/build/GenerateCode.hs"#-} {-# INLINE rule466 #-} - {-# LINE 906 "./src-ag/GenerateCode.ag" #-} + {-# LINE 906 "src-ag/GenerateCode.ag" #-} rule466 = \ (_ :: ()) -> - {-# LINE 906 "./src-ag/GenerateCode.ag" #-} + {-# LINE 906 "src-ag/GenerateCode.ag" #-} "intra" {-# LINE 3595 "dist/build/GenerateCode.hs"#-} {-# INLINE rule467 #-} - {-# LINE 1186 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1186 "src-ag/GenerateCode.ag" #-} rule467 = \ _funcname -> - {-# LINE 1186 "./src-ag/GenerateCode.ag" #-} + {-# LINE 1186 "src-ag/GenerateCode.ag" #-} [_funcname ] {-# LINE 3601 "dist/build/GenerateCode.hs"#-} {-# INLINE rule468 #-} @@ -3809,8 +3809,8 @@ 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 arg = 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 arg) + 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) ) @@ -3941,57 +3941,57 @@ in __result_ ) in C_CVisits_s32 v31 {-# INLINE rule535 #-} - {-# LINE 284 "./src-ag/GenerateCode.ag" #-} + {-# LINE 284 "src-ag/GenerateCode.ag" #-} rule535 = \ ((_lhsInr) :: Int) -> - {-# LINE 284 "./src-ag/GenerateCode.ag" #-} + {-# LINE 284 "src-ag/GenerateCode.ag" #-} _lhsInr + 1 {-# LINE 3949 "dist/build/GenerateCode.hs"#-} {-# INLINE rule536 #-} - {-# LINE 297 "./src-ag/GenerateCode.ag" #-} + {-# LINE 297 "src-ag/GenerateCode.ag" #-} rule536 = \ (_ :: ()) -> - {-# LINE 297 "./src-ag/GenerateCode.ag" #-} + {-# LINE 297 "src-ag/GenerateCode.ag" #-} False {-# LINE 3955 "dist/build/GenerateCode.hs"#-} {-# INLINE rule537 #-} - {-# LINE 298 "./src-ag/GenerateCode.ag" #-} + {-# LINE 298 "src-ag/GenerateCode.ag" #-} rule537 = \ ((_tlIisNil) :: Bool) -> - {-# LINE 298 "./src-ag/GenerateCode.ag" #-} + {-# LINE 298 "src-ag/GenerateCode.ag" #-} _tlIisNil {-# LINE 3961 "dist/build/GenerateCode.hs"#-} {-# INLINE rule538 #-} - {-# LINE 315 "./src-ag/GenerateCode.ag" #-} + {-# LINE 315 "src-ag/GenerateCode.ag" #-} rule538 = \ ((_tlIintra) :: Exprs) -> - {-# LINE 315 "./src-ag/GenerateCode.ag" #-} + {-# LINE 315 "src-ag/GenerateCode.ag" #-} _tlIintra {-# LINE 3967 "dist/build/GenerateCode.hs"#-} {-# INLINE rule539 #-} - {-# LINE 316 "./src-ag/GenerateCode.ag" #-} + {-# LINE 316 "src-ag/GenerateCode.ag" #-} rule539 = \ ((_tlIintraVars) :: Set String) -> - {-# LINE 316 "./src-ag/GenerateCode.ag" #-} + {-# LINE 316 "src-ag/GenerateCode.ag" #-} _tlIintraVars {-# LINE 3973 "dist/build/GenerateCode.hs"#-} {-# INLINE rule540 #-} - {-# LINE 317 "./src-ag/GenerateCode.ag" #-} + {-# LINE 317 "src-ag/GenerateCode.ag" #-} rule540 = \ ((_hdIintra) :: Exprs) -> - {-# LINE 317 "./src-ag/GenerateCode.ag" #-} + {-# LINE 317 "src-ag/GenerateCode.ag" #-} _hdIintra {-# LINE 3979 "dist/build/GenerateCode.hs"#-} {-# INLINE rule541 #-} - {-# LINE 318 "./src-ag/GenerateCode.ag" #-} + {-# LINE 318 "src-ag/GenerateCode.ag" #-} rule541 = \ ((_hdIintraVars) :: Set String) -> - {-# LINE 318 "./src-ag/GenerateCode.ag" #-} + {-# LINE 318 "src-ag/GenerateCode.ag" #-} _hdIintraVars {-# LINE 3985 "dist/build/GenerateCode.hs"#-} {-# INLINE rule542 #-} - {-# LINE 433 "./src-ag/GenerateCode.ag" #-} + {-# LINE 433 "src-ag/GenerateCode.ag" #-} rule542 = \ ((_hdIdecls) :: Decls) -> - {-# LINE 433 "./src-ag/GenerateCode.ag" #-} + {-# LINE 433 "src-ag/GenerateCode.ag" #-} _hdIdecls {-# LINE 3991 "dist/build/GenerateCode.hs"#-} {-# INLINE rule543 #-} - {-# LINE 434 "./src-ag/GenerateCode.ag" #-} + {-# LINE 434 "src-ag/GenerateCode.ag" #-} rule543 = \ ((_tlIdecls) :: Decls) -> - {-# LINE 434 "./src-ag/GenerateCode.ag" #-} + {-# LINE 434 "src-ag/GenerateCode.ag" #-} _tlIdecls {-# LINE 3997 "dist/build/GenerateCode.hs"#-} {-# INLINE rule544 #-} @@ -4258,27 +4258,27 @@ in __result_ ) in C_CVisits_s32 v31 {-# INLINE rule623 #-} - {-# LINE 299 "./src-ag/GenerateCode.ag" #-} + {-# LINE 299 "src-ag/GenerateCode.ag" #-} rule623 = \ (_ :: ()) -> - {-# LINE 299 "./src-ag/GenerateCode.ag" #-} + {-# LINE 299 "src-ag/GenerateCode.ag" #-} True {-# LINE 4266 "dist/build/GenerateCode.hs"#-} {-# INLINE rule624 #-} - {-# LINE 319 "./src-ag/GenerateCode.ag" #-} + {-# LINE 319 "src-ag/GenerateCode.ag" #-} rule624 = \ (_ :: ()) -> - {-# LINE 319 "./src-ag/GenerateCode.ag" #-} + {-# LINE 319 "src-ag/GenerateCode.ag" #-} [] {-# LINE 4272 "dist/build/GenerateCode.hs"#-} {-# INLINE rule625 #-} - {-# LINE 320 "./src-ag/GenerateCode.ag" #-} + {-# LINE 320 "src-ag/GenerateCode.ag" #-} rule625 = \ (_ :: ()) -> - {-# LINE 320 "./src-ag/GenerateCode.ag" #-} + {-# LINE 320 "src-ag/GenerateCode.ag" #-} Set.empty {-# LINE 4278 "dist/build/GenerateCode.hs"#-} {-# INLINE rule626 #-} - {-# LINE 432 "./src-ag/GenerateCode.ag" #-} + {-# LINE 432 "src-ag/GenerateCode.ag" #-} rule626 = \ (_ :: ()) -> - {-# LINE 432 "./src-ag/GenerateCode.ag" #-} + {-# LINE 432 "src-ag/GenerateCode.ag" #-} [] {-# LINE 4284 "dist/build/GenerateCode.hs"#-} {-# INLINE rule627 #-} @@ -4303,8 +4303,8 @@ wrap_DeclBlocks (T_DeclBlocks act) (Inh_DeclBlocks _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_DeclBlocks_vIn34 _lhsIblockNr _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix - (T_DeclBlocks_vOut34 _lhsOcallExpr _lhsOdecls _lhsOfreeVars) <- return (inv_DeclBlocks_s35 sem arg) + 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) ) @@ -4353,45 +4353,45 @@ in __result_ ) in C_DeclBlocks_s35 v34 {-# INLINE rule631 #-} - {-# LINE 667 "./src-ag/GenerateCode.ag" #-} + {-# LINE 667 "src-ag/GenerateCode.ag" #-} rule631 = \ ((_lhsIblockNr) :: Int) -> - {-# LINE 667 "./src-ag/GenerateCode.ag" #-} + {-# LINE 667 "src-ag/GenerateCode.ag" #-} _lhsIblockNr + 1 {-# LINE 4361 "dist/build/GenerateCode.hs"#-} {-# INLINE rule632 #-} - {-# LINE 672 "./src-ag/GenerateCode.ag" #-} + {-# LINE 672 "src-ag/GenerateCode.ag" #-} rule632 = \ ((_lhsIblockNr) :: Int) ((_lhsIprefix) :: String) -> - {-# LINE 672 "./src-ag/GenerateCode.ag" #-} + {-# LINE 672 "src-ag/GenerateCode.ag" #-} _lhsIprefix ++ "_block" ++ show _lhsIblockNr {-# LINE 4367 "dist/build/GenerateCode.hs"#-} {-# INLINE rule633 #-} - {-# LINE 673 "./src-ag/GenerateCode.ag" #-} + {-# LINE 673 "src-ag/GenerateCode.ag" #-} rule633 = \ _lambdaName -> - {-# LINE 673 "./src-ag/GenerateCode.ag" #-} + {-# LINE 673 "src-ag/GenerateCode.ag" #-} PragmaDecl ("NOINLINE " ++ _lambdaName ) {-# LINE 4373 "dist/build/GenerateCode.hs"#-} {-# INLINE rule634 #-} - {-# LINE 674 "./src-ag/GenerateCode.ag" #-} + {-# LINE 674 "src-ag/GenerateCode.ag" #-} rule634 = \ _freeVars _lambdaName -> - {-# LINE 674 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 678 "src-ag/GenerateCode.ag" #-} rule635 = \ ((_nextIfreeVars) :: [String]) defs_ visit_ -> - {-# LINE 678 "./src-ag/GenerateCode.ag" #-} + {-# LINE 678 "src-ag/GenerateCode.ag" #-} freevars _nextIfreeVars (visit_ : defs_) {-# LINE 4385 "dist/build/GenerateCode.hs"#-} {-# INLINE rule636 #-} - {-# LINE 685 "./src-ag/GenerateCode.ag" #-} + {-# LINE 685 "src-ag/GenerateCode.ag" #-} rule636 = \ _freeVars _lambdaName ((_lhsIoptCase) :: Bool) ((_nextIcallExpr) :: Expr) defs_ visit_ -> - {-# LINE 685 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 686 "src-ag/GenerateCode.ag" #-} rule637 = \ _decl ((_lhsIblockNr) :: Int) ((_nextIdecls) :: [Decl]) _pragmaDecl -> - {-# LINE 686 "./src-ag/GenerateCode.ag" #-} + {-# LINE 686 "src-ag/GenerateCode.ag" #-} (if _lhsIblockNr > 1 then [_pragmaDecl ] else []) ++ [_decl ] ++ _nextIdecls {-# LINE 4397 "dist/build/GenerateCode.hs"#-} {-# INLINE rule638 #-} @@ -4429,33 +4429,33 @@ in __result_ ) in C_DeclBlocks_s35 v34 {-# INLINE rule643 #-} - {-# LINE 672 "./src-ag/GenerateCode.ag" #-} + {-# LINE 672 "src-ag/GenerateCode.ag" #-} rule643 = \ ((_lhsIblockNr) :: Int) ((_lhsIprefix) :: String) -> - {-# LINE 672 "./src-ag/GenerateCode.ag" #-} + {-# LINE 672 "src-ag/GenerateCode.ag" #-} _lhsIprefix ++ "_block" ++ show _lhsIblockNr {-# LINE 4437 "dist/build/GenerateCode.hs"#-} {-# INLINE rule644 #-} - {-# LINE 673 "./src-ag/GenerateCode.ag" #-} + {-# LINE 673 "src-ag/GenerateCode.ag" #-} rule644 = \ _lambdaName -> - {-# LINE 673 "./src-ag/GenerateCode.ag" #-} + {-# LINE 673 "src-ag/GenerateCode.ag" #-} PragmaDecl ("NOINLINE " ++ _lambdaName ) {-# LINE 4443 "dist/build/GenerateCode.hs"#-} {-# INLINE rule645 #-} - {-# LINE 674 "./src-ag/GenerateCode.ag" #-} + {-# LINE 674 "src-ag/GenerateCode.ag" #-} rule645 = \ _freeVars _lambdaName -> - {-# LINE 674 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 676 "src-ag/GenerateCode.ag" #-} rule646 = \ ((_lhsIlastExprVars) :: [String]) ((_lhsInextVisitDecls) :: [Decl]) defs_ -> - {-# LINE 676 "./src-ag/GenerateCode.ag" #-} + {-# LINE 676 "src-ag/GenerateCode.ag" #-} freevars _lhsIlastExprVars (defs_ ++ _lhsInextVisitDecls) {-# LINE 4455 "dist/build/GenerateCode.hs"#-} {-# INLINE rule647 #-} - {-# LINE 683 "./src-ag/GenerateCode.ag" #-} + {-# LINE 683 "src-ag/GenerateCode.ag" #-} rule647 = \ _freeVars _lambdaName ((_lhsInextVisitDecls) :: [Decl]) ((_lhsIoptCase) :: Bool) defs_ result_ -> - {-# LINE 683 "./src-ag/GenerateCode.ag" #-} + {-# LINE 683 "src-ag/GenerateCode.ag" #-} [ mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ _lhsInextVisitDecls) result_ ] {-# LINE 4461 "dist/build/GenerateCode.hs"#-} {-# INLINE rule648 #-} @@ -4471,8 +4471,8 @@ wrap_DeclBlocksRoot (T_DeclBlocksRoot act) (Inh_DeclBlocksRoot _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_DeclBlocksRoot_vIn37 _lhsIlastExprVars _lhsInextVisitDecls _lhsIoptCase _lhsIprefix - (T_DeclBlocksRoot_vOut37 _lhsOfirstCall _lhsOlambdas) <- return (inv_DeclBlocksRoot_s38 sem arg) + 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) ) @@ -4514,21 +4514,21 @@ in __result_ ) in C_DeclBlocksRoot_s38 v37 {-# INLINE rule649 #-} - {-# LINE 658 "./src-ag/GenerateCode.ag" #-} + {-# LINE 658 "src-ag/GenerateCode.ag" #-} rule649 = \ ((_blocksIdecls) :: [Decl]) -> - {-# LINE 658 "./src-ag/GenerateCode.ag" #-} + {-# LINE 658 "src-ag/GenerateCode.ag" #-} _blocksIdecls {-# LINE 4522 "dist/build/GenerateCode.hs"#-} {-# INLINE rule650 #-} - {-# LINE 659 "./src-ag/GenerateCode.ag" #-} + {-# LINE 659 "src-ag/GenerateCode.ag" #-} rule650 = \ ((_blocksIcallExpr) :: Expr) -> - {-# LINE 659 "./src-ag/GenerateCode.ag" #-} + {-# LINE 659 "src-ag/GenerateCode.ag" #-} _blocksIcallExpr {-# LINE 4528 "dist/build/GenerateCode.hs"#-} {-# INLINE rule651 #-} - {-# LINE 664 "./src-ag/GenerateCode.ag" #-} + {-# LINE 664 "src-ag/GenerateCode.ag" #-} rule651 = \ (_ :: ()) -> - {-# LINE 664 "./src-ag/GenerateCode.ag" #-} + {-# LINE 664 "src-ag/GenerateCode.ag" #-} 1 {-# LINE 4534 "dist/build/GenerateCode.hs"#-} {-# INLINE rule652 #-} @@ -4553,8 +4553,8 @@ wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Pattern_vIn40 - (T_Pattern_vOut40 _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes) <- return (inv_Pattern_s41 sem arg) + let arg40 = T_Pattern_vIn40 + (T_Pattern_vOut40 _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes) <- return (inv_Pattern_s41 sem arg40) return (Syn_Pattern _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes) ) @@ -4660,15 +4660,15 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule664 #-} - {-# LINE 265 "./src-ag/GenerateCode.ag" #-} + {-# LINE 265 "src-ag/GenerateCode.ag" #-} rule664 = \ ((_patIdefinedInsts) :: [Identifier]) attr_ field_ -> - {-# LINE 265 "./src-ag/GenerateCode.ag" #-} + {-# 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" #-} + {-# LINE 273 "src-ag/GenerateCode.ag" #-} rule665 = \ ((_patIpatternAttributes) :: [(Identifier, Identifier)]) attr_ field_ -> - {-# LINE 273 "./src-ag/GenerateCode.ag" #-} + {-# LINE 273 "src-ag/GenerateCode.ag" #-} (field_,attr_) : _patIpatternAttributes {-# LINE 4674 "dist/build/GenerateCode.hs"#-} {-# INLINE rule666 #-} @@ -4747,8 +4747,8 @@ wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Patterns_vIn43 - (T_Patterns_vOut43 _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes) <- return (inv_Patterns_s44 sem arg) + let arg43 = T_Patterns_vIn43 + (T_Patterns_vOut43 _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes) <- return (inv_Patterns_s44 sem arg43) return (Syn_Patterns _lhsOcopy _lhsOdefinedInsts _lhsOpatternAttributes) ) @@ -4840,8 +4840,8 @@ 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 arg = 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 arg) + 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) ) @@ -4969,9 +4969,9 @@ in __result_ ) in C_Sequence_s47 v46 {-# INLINE rule684 #-} - {-# LINE 627 "./src-ag/GenerateCode.ag" #-} + {-# LINE 627 "src-ag/GenerateCode.ag" #-} rule684 = \ ((_hdIbldBlocksFun) :: DeclBlocks -> DeclBlocks) ((_tlIblockDecls) :: DeclBlocks) -> - {-# LINE 627 "./src-ag/GenerateCode.ag" #-} + {-# LINE 627 "src-ag/GenerateCode.ag" #-} _hdIbldBlocksFun _tlIblockDecls {-# LINE 4977 "dist/build/GenerateCode.hs"#-} {-# INLINE rule685 #-} @@ -5250,9 +5250,9 @@ in __result_ ) in C_Sequence_s47 v46 {-# INLINE rule766 #-} - {-# LINE 629 "./src-ag/GenerateCode.ag" #-} + {-# LINE 629 "src-ag/GenerateCode.ag" #-} rule766 = \ ((_lhsIdeclsAbove) :: [Decl]) ((_lhsIlastExpr) :: Expr) -> - {-# LINE 629 "./src-ag/GenerateCode.ag" #-} + {-# LINE 629 "src-ag/GenerateCode.ag" #-} DeclTerminator _lhsIdeclsAbove _lhsIlastExpr {-# LINE 5258 "dist/build/GenerateCode.hs"#-} {-# INLINE rule767 #-} diff --git a/src-generated/HsToken.hs b/src-generated/HsToken.hs --- a/src-generated/HsToken.hs +++ b/src-generated/HsToken.hs @@ -1,8 +1,8 @@ --- UUAGC 0.9.50 (src-ag/HsToken.ag) +-- UUAGC 0.9.51 (src-ag/HsToken.ag) module HsToken where -{-# LINE 2 "./src-ag/HsToken.ag" #-} +{-# LINE 2 "src-ag/HsToken.ag" #-} import CommonTypes import UU.Scanner.Position(Pos) diff --git a/src-generated/Interfaces.hs b/src-generated/Interfaces.hs --- a/src-generated/Interfaces.hs +++ b/src-generated/Interfaces.hs @@ -1,8 +1,8 @@ --- UUAGC 0.9.50 (src-ag/Interfaces.ag) +-- UUAGC 0.9.51 (src-ag/Interfaces.ag) module Interfaces where -{-# LINE 2 "./src-ag/Interfaces.ag" #-} +{-# LINE 2 "src-ag/Interfaces.ag" #-} import CommonTypes import SequentialTypes diff --git a/src-generated/InterfacesRules.hs b/src-generated/InterfacesRules.hs --- a/src-generated/InterfacesRules.hs +++ b/src-generated/InterfacesRules.hs @@ -3,13 +3,13 @@ {-# LANGUAGE ScopedTypeVariables #-} module InterfacesRules where -{-# LINE 2 "./src-ag/Interfaces.ag" #-} +{-# LINE 2 "src-ag/Interfaces.ag" #-} import CommonTypes import SequentialTypes {-# LINE 11 "dist/build/InterfacesRules.hs" #-} -{-# LINE 10 "./src-ag/InterfacesRules.lag" #-} +{-# LINE 10 "src-ag/InterfacesRules.lag" #-} import Interfaces import CodeSyntax @@ -28,19 +28,19 @@ {-# LINE 29 "dist/build/InterfacesRules.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 53 "./src-ag/InterfacesRules.lag" #-} +{-# LINE 53 "src-ag/InterfacesRules.lag" #-} type VisitSS = [Vertex] {-# LINE 35 "dist/build/InterfacesRules.hs" #-} -{-# LINE 88 "./src-ag/InterfacesRules.lag" #-} +{-# 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" #-} +{-# 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 @@ -51,13 +51,13 @@ in (v,d) {-# LINE 53 "dist/build/InterfacesRules.hs" #-} -{-# LINE 152 "./src-ag/InterfacesRules.lag" #-} +{-# 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" #-} +{-# LINE 240 "src-ag/InterfacesRules.lag" #-} postorder :: Tree a -> [a] postorder (Node a ts) = postorderF ts ++ [a] @@ -69,18 +69,18 @@ topSort' g = postOrd g {-# LINE 71 "dist/build/InterfacesRules.hs" #-} -{-# LINE 323 "./src-ag/InterfacesRules.lag" #-} +{-# LINE 323 "src-ag/InterfacesRules.lag" #-} type IntraVisit = [Vertex] {-# LINE 76 "dist/build/InterfacesRules.hs" #-} -{-# LINE 345 "./src-ag/InterfacesRules.lag" #-} +{-# 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" #-} +{-# LINE 420 "src-ag/InterfacesRules.lag" #-} ccv :: Identifier -> NontermIdent -> Int -> CInterfaceMap -> CRule ccv name nt n table @@ -99,8 +99,8 @@ wrap_IRoot !(T_IRoot act) !(Inh_IRoot _lhsIdpr _lhsIinfo _lhsItdp) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_IRoot_vIn1 _lhsIdpr _lhsIinfo _lhsItdp - !(T_IRoot_vOut1 _lhsOedp _lhsOinters _lhsOvisits) <- return (inv_IRoot_s2 sem arg) + 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) ) @@ -149,66 +149,66 @@ in __result_ ) in C_IRoot_s2 v1 {-# INLINE rule0 #-} - {-# LINE 66 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 66 "src-ag/InterfacesRules.lag" #-} rule0 = \ ((_intersInewedges) :: Seq Edge ) -> - {-# LINE 66 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 66 "src-ag/InterfacesRules.lag" #-} toList _intersInewedges {-# LINE 157 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule1 #-} - {-# LINE 67 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 67 "src-ag/InterfacesRules.lag" #-} rule1 = \ ((_intersIv) :: Vertex) ((_lhsItdp) :: Graph) _newedges -> - {-# LINE 67 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# LINE 80 "src-ag/InterfacesRules.lag" #-} rule2 = \ ((_lhsItdp) :: Graph) -> - {-# LINE 80 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 80 "src-ag/InterfacesRules.lag" #-} snd (bounds _lhsItdp) + 1 {-# LINE 171 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule3 #-} - {-# LINE 122 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 122 "src-ag/InterfacesRules.lag" #-} rule3 = \ _descr -> - {-# LINE 122 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 122 "src-ag/InterfacesRules.lag" #-} Map.fromList _descr {-# LINE 177 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule4 #-} - {-# LINE 142 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 142 "src-ag/InterfacesRules.lag" #-} rule4 = \ ((_intersIdescr) :: Seq (Vertex,ChildVisit)) -> - {-# LINE 142 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 142 "src-ag/InterfacesRules.lag" #-} toList _intersIdescr {-# LINE 183 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule5 #-} - {-# LINE 214 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 214 "src-ag/InterfacesRules.lag" #-} rule5 = \ _visitssGraph -> - {-# LINE 214 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 214 "src-ag/InterfacesRules.lag" #-} _visitssGraph {-# LINE 189 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule6 #-} - {-# LINE 260 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 260 "src-ag/InterfacesRules.lag" #-} rule6 = \ ((_intersIfirstvisitvertices) :: [Vertex]) ((_lhsIinfo) :: Info) -> - {-# LINE 260 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# LINE 343 "src-ag/InterfacesRules.lag" #-} rule7 = \ ((_intersIv) :: Vertex) ((_lhsIdpr) :: [Edge]) _newedges -> - {-# LINE 343 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# LINE 381 "src-ag/InterfacesRules.lag" #-} rule8 = \ ((_intersIinters) :: CInterfaceMap) -> - {-# LINE 381 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 381 "src-ag/InterfacesRules.lag" #-} _intersIinters {-# LINE 208 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule9 #-} - {-# LINE 443 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 443 "src-ag/InterfacesRules.lag" #-} rule9 = \ ((_intersIedp) :: Seq Edge) -> - {-# LINE 443 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 443 "src-ag/InterfacesRules.lag" #-} toList _intersIedp {-# LINE 214 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule10 #-} @@ -230,8 +230,8 @@ wrap_Interface !(T_Interface act) !(Inh_Interface _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = 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 arg) + 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) ) @@ -297,99 +297,99 @@ in __result_ ) in C_Interface_s5 v4 {-# INLINE rule13 #-} - {-# LINE 183 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 183 "src-ag/InterfacesRules.lag" #-} rule13 = \ ((_lhsIv) :: Vertex) -> - {-# LINE 183 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 183 "src-ag/InterfacesRules.lag" #-} _lhsIv {-# LINE 305 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule14 #-} - {-# LINE 184 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 184 "src-ag/InterfacesRules.lag" #-} rule14 = \ ((_segInewvertices) :: [Vertex]) ((_segIv) :: Vertex) -> - {-# LINE 184 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 184 "src-ag/InterfacesRules.lag" #-} _segIv + length _segInewvertices {-# LINE 311 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule15 #-} - {-# LINE 185 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 185 "src-ag/InterfacesRules.lag" #-} rule15 = \ _v -> - {-# LINE 185 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 185 "src-ag/InterfacesRules.lag" #-} _v {-# LINE 317 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule16 #-} - {-# LINE 186 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 186 "src-ag/InterfacesRules.lag" #-} rule16 = \ ((_segIv) :: Vertex) _v -> - {-# LINE 186 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 186 "src-ag/InterfacesRules.lag" #-} [_segIv .. _v-1] {-# LINE 323 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule17 #-} - {-# LINE 187 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 187 "src-ag/InterfacesRules.lag" #-} rule17 = \ _firstvisitvertices ((_segInewvertices) :: [Vertex]) -> - {-# LINE 187 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 187 "src-ag/InterfacesRules.lag" #-} zip _firstvisitvertices _segInewvertices {-# LINE 329 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule18 #-} - {-# LINE 188 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 188 "src-ag/InterfacesRules.lag" #-} rule18 = \ _newedges ((_segInewedges) :: Seq Edge ) -> - {-# LINE 188 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# LINE 191 "src-ag/InterfacesRules.lag" #-} rule19 = \ ((_lhsIinfo) :: Info) -> - {-# LINE 191 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 191 "src-ag/InterfacesRules.lag" #-} \a -> ruleTable _lhsIinfo ! a {-# LINE 341 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule20 #-} - {-# LINE 192 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 192 "src-ag/InterfacesRules.lag" #-} rule20 = \ _firstvisitvertices ((_look) :: Vertex -> CRule) ((_segIgroups) :: [([Vertex],[Vertex])]) -> - {-# LINE 192 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# LINE 193 "src-ag/InterfacesRules.lag" #-} rule21 = \ _descr ((_segIdescr) :: Seq (Vertex,ChildVisit)) -> - {-# LINE 193 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# LINE 201 "src-ag/InterfacesRules.lag" #-} rule22 = \ (_ :: ()) -> - {-# LINE 201 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 201 "src-ag/InterfacesRules.lag" #-} 0 {-# LINE 359 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule23 #-} - {-# LINE 233 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 233 "src-ag/InterfacesRules.lag" #-} rule23 = \ cons_ -> - {-# LINE 233 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 233 "src-ag/InterfacesRules.lag" #-} cons_ {-# LINE 365 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule24 #-} - {-# LINE 314 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 314 "src-ag/InterfacesRules.lag" #-} rule24 = \ (_ :: ()) -> - {-# LINE 314 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 314 "src-ag/InterfacesRules.lag" #-} True {-# LINE 371 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule25 #-} - {-# LINE 352 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 352 "src-ag/InterfacesRules.lag" #-} rule25 = \ ((_lhsIprev) :: [Vertex]) -> - {-# LINE 352 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 352 "src-ag/InterfacesRules.lag" #-} _lhsIprev {-# LINE 377 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule26 #-} - {-# LINE 392 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 392 "src-ag/InterfacesRules.lag" #-} rule26 = \ nt_ -> - {-# LINE 392 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 392 "src-ag/InterfacesRules.lag" #-} nt_ {-# LINE 383 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule27 #-} - {-# LINE 396 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 396 "src-ag/InterfacesRules.lag" #-} rule27 = \ ((_segIsegs) :: CSegments) -> - {-# LINE 396 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 396 "src-ag/InterfacesRules.lag" #-} CInterface _segIsegs {-# LINE 389 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule28 #-} - {-# LINE 397 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 397 "src-ag/InterfacesRules.lag" #-} rule28 = \ ((_segIcvisits) :: [[CVisit]]) cons_ -> - {-# LINE 397 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 397 "src-ag/InterfacesRules.lag" #-} Map.fromList (zip cons_ (transpose _segIcvisits)) {-# LINE 395 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule29 #-} @@ -426,8 +426,8 @@ wrap_Interfaces !(T_Interfaces act) !(Inh_Interfaces _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = 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 arg) + 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) ) @@ -490,15 +490,15 @@ in __result_ ) in C_Interfaces_s8 v7 {-# INLINE rule37 #-} - {-# LINE 386 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 386 "src-ag/InterfacesRules.lag" #-} rule37 = \ ((_hdIinter) :: CInterface) ((_hdInt) :: NontermIdent) ((_tlIinters) :: CInterfaceMap) -> - {-# LINE 386 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# LINE 387 "src-ag/InterfacesRules.lag" #-} rule38 = \ ((_hdInt) :: NontermIdent) ((_hdIvisits) :: Map ConstructorIdent CVisits) ((_tlIvisits) :: CVisitsMap) -> - {-# LINE 387 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 387 "src-ag/InterfacesRules.lag" #-} Map.insert _hdInt _hdIvisits _tlIvisits {-# LINE 504 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule39 #-} @@ -583,15 +583,15 @@ in __result_ ) in C_Interfaces_s8 v7 {-# INLINE rule58 #-} - {-# LINE 388 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 388 "src-ag/InterfacesRules.lag" #-} rule58 = \ (_ :: ()) -> - {-# LINE 388 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 388 "src-ag/InterfacesRules.lag" #-} Map.empty {-# LINE 591 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule59 #-} - {-# LINE 389 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 389 "src-ag/InterfacesRules.lag" #-} rule59 = \ (_ :: ()) -> - {-# LINE 389 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 389 "src-ag/InterfacesRules.lag" #-} Map.empty {-# LINE 597 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule60 #-} @@ -619,8 +619,8 @@ 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 arg = 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 arg) + 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) ) @@ -699,72 +699,72 @@ in __result_ ) in C_Segment_s11 v10 {-# INLINE rule65 #-} - {-# LINE 101 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 101 "src-ag/InterfacesRules.lag" #-} rule65 = \ ((_lhsIinfo) :: Info) -> - {-# LINE 101 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 101 "src-ag/InterfacesRules.lag" #-} \a -> ruleTable _lhsIinfo ! a {-# LINE 707 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule66 #-} - {-# LINE 104 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 104 "src-ag/InterfacesRules.lag" #-} rule66 = \ ((_lhsIinfo) :: Info) ((_look) :: Vertex -> CRule) -> - {-# LINE 104 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 111 "src-ag/InterfacesRules.lag" #-} rule68 = \ ((_groups) :: [([Vertex],[Vertex])]) ((_lhsIv) :: Vertex) -> - {-# LINE 111 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 111 "src-ag/InterfacesRules.lag" #-} _lhsIv + length _groups {-# LINE 728 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule69 #-} - {-# LINE 112 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 112 "src-ag/InterfacesRules.lag" #-} rule69 = \ ((_lhsIv) :: Vertex) ((_v) :: Int) -> - {-# LINE 112 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 112 "src-ag/InterfacesRules.lag" #-} [_lhsIv .. _v -1] {-# LINE 734 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule70 #-} - {-# LINE 127 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 127 "src-ag/InterfacesRules.lag" #-} rule70 = \ ((_groups) :: [([Vertex],[Vertex])]) ((_lhsIn) :: Int) ((_look) :: Vertex -> CRule) _newvertices -> - {-# LINE 127 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# LINE 150 "src-ag/InterfacesRules.lag" #-} rule71 = \ ((_groups) :: [([Vertex],[Vertex])]) _newvertices -> - {-# LINE 150 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# LINE 170 "src-ag/InterfacesRules.lag" #-} rule72 = \ ((_lhsInextNewvertices) :: [Vertex]) _newvertices -> - {-# LINE 170 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 170 "src-ag/InterfacesRules.lag" #-} zip _newvertices _lhsInextNewvertices {-# LINE 752 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule73 #-} - {-# LINE 171 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 171 "src-ag/InterfacesRules.lag" #-} rule73 = \ _attredges _visitedges -> - {-# LINE 171 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# LINE 225 "src-ag/InterfacesRules.lag" #-} rule74 = \ ((_lhsIinfo) :: Info) ((_occurAs) :: (CRule -> Bool) -> [Vertex] -> [Vertex]) syn_ -> - {-# LINE 225 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# LINE 226 "src-ag/InterfacesRules.lag" #-} rule75 = \ ((_lhsIcons) :: [ConstructorIdent]) ((_lhsIinfo) :: Info) ((_lhsIvssGraph) :: Graph) _synOccur syn_ -> - {-# LINE 226 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 226 "src-ag/InterfacesRules.lag" #-} let hasCode' v | inRange (bounds (ruleTable _lhsIinfo)) v = getHasCode (ruleTable _lhsIinfo ! v) | otherwise = True in if null syn_ @@ -772,30 +772,30 @@ else map (filter hasCode' . topSort' _lhsIvssGraph) _synOccur {-# LINE 774 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule76 #-} - {-# LINE 270 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 270 "src-ag/InterfacesRules.lag" #-} rule76 = \ ((_lhsIprev) :: [Vertex]) _vss -> - {-# LINE 270 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 270 "src-ag/InterfacesRules.lag" #-} map (\\ _lhsIprev) _vss {-# LINE 780 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule77 #-} - {-# LINE 271 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 271 "src-ag/InterfacesRules.lag" #-} rule77 = \ ((_lhsIvisitDescr) :: Map Vertex ChildVisit) ((_visitss) :: [[Vertex]]) -> - {-# LINE 271 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# LINE 275 "src-ag/InterfacesRules.lag" #-} rule78 = \ _defined ((_lhsIprev) :: [Vertex]) -> - {-# LINE 275 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 275 "src-ag/InterfacesRules.lag" #-} _lhsIprev ++ _defined {-# LINE 795 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule79 #-} - {-# LINE 284 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 284 "src-ag/InterfacesRules.lag" #-} rule79 = \ ((_lhsIinfo) :: Info) _visitss' -> - {-# LINE 284 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 284 "src-ag/InterfacesRules.lag" #-} let rem' :: [(Identifier,Identifier,Maybe Type)] -> [Vertex] -> [Vertex] rem' _ [] = [] rem' prev (v:vs) @@ -814,52 +814,52 @@ in map (rem' []) _visitss' {-# LINE 816 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule80 #-} - {-# LINE 357 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 357 "src-ag/InterfacesRules.lag" #-} rule80 = \ ((_lhsIfromLhs) :: [Vertex]) ((_occurAs) :: (CRule -> Bool) -> [Vertex] -> [Vertex]) inh_ -> - {-# LINE 357 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 357 "src-ag/InterfacesRules.lag" #-} _occurAs isLhs inh_ ++ _lhsIfromLhs {-# LINE 822 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule81 #-} - {-# LINE 358 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 358 "src-ag/InterfacesRules.lag" #-} rule81 = \ ((_lhsIinfo) :: Info) ((_lhsIvisitDescr) :: Map Vertex ChildVisit) ((_visitss) :: [[Vertex]]) -> - {-# LINE 358 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# LINE 362 "src-ag/InterfacesRules.lag" #-} rule82 = \ _iv ((_lhsInextIntravisits) :: [IntraVisit]) ((_visitss) :: [[Vertex]]) -> - {-# LINE 362 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 362 "src-ag/InterfacesRules.lag" #-} zipWith _iv _visitss _lhsInextIntravisits {-# LINE 837 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule83 #-} - {-# LINE 363 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 363 "src-ag/InterfacesRules.lag" #-} rule83 = \ _computed _fromLhs ((_lhsIddp) :: Graph) -> - {-# LINE 363 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 410 "src-ag/InterfacesRules.lag" #-} rule85 = \ ((_lhsIinfo) :: Info) inh_ syn_ -> - {-# LINE 410 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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 @@ -868,16 +868,16 @@ in zipWith mkVisit _visitss _intravisits {-# LINE 870 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule87 #-} - {-# LINE 440 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 440 "src-ag/InterfacesRules.lag" #-} rule87 = \ ((_lhsInextInh) :: [Vertex]) inh_ syn_ -> - {-# LINE 440 "./src-ag/InterfacesRules.lag" #-} + {-# 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" #-} + {-# LINE 445 "src-ag/InterfacesRules.lag" #-} rule88 = \ inh_ -> - {-# LINE 445 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 445 "src-ag/InterfacesRules.lag" #-} inh_ {-# LINE 883 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule89 #-} @@ -905,8 +905,8 @@ 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 arg = 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 arg) + 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) ) @@ -988,75 +988,75 @@ in __result_ ) in C_Segments_s14 v13 {-# INLINE rule94 #-} - {-# LINE 165 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 165 "src-ag/InterfacesRules.lag" #-} rule94 = \ ((_tlInewvertices) :: [Vertex]) -> - {-# LINE 165 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 165 "src-ag/InterfacesRules.lag" #-} _tlInewvertices {-# LINE 996 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule95 #-} - {-# LINE 166 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 166 "src-ag/InterfacesRules.lag" #-} rule95 = \ ((_hdInewvertices) :: [Vertex]) -> - {-# LINE 166 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 166 "src-ag/InterfacesRules.lag" #-} _hdInewvertices {-# LINE 1002 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule96 #-} - {-# LINE 180 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 180 "src-ag/InterfacesRules.lag" #-} rule96 = \ ((_hdIgroups) :: [([Vertex],[Vertex])]) -> - {-# LINE 180 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 180 "src-ag/InterfacesRules.lag" #-} _hdIgroups {-# LINE 1008 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule97 #-} - {-# LINE 203 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 203 "src-ag/InterfacesRules.lag" #-} rule97 = \ ((_lhsIn) :: Int) -> - {-# LINE 203 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 203 "src-ag/InterfacesRules.lag" #-} _lhsIn + 1 {-# LINE 1014 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule98 #-} - {-# LINE 316 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 316 "src-ag/InterfacesRules.lag" #-} rule98 = \ (_ :: ()) -> - {-# LINE 316 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 316 "src-ag/InterfacesRules.lag" #-} False {-# LINE 1020 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule99 #-} - {-# LINE 329 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 329 "src-ag/InterfacesRules.lag" #-} rule99 = \ ((_tlIhdIntravisits) :: [IntraVisit]) -> - {-# LINE 329 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 329 "src-ag/InterfacesRules.lag" #-} _tlIhdIntravisits {-# LINE 1026 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule100 #-} - {-# LINE 330 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 330 "src-ag/InterfacesRules.lag" #-} rule100 = \ ((_hdIintravisits) :: [IntraVisit]) -> - {-# LINE 330 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 330 "src-ag/InterfacesRules.lag" #-} _hdIintravisits {-# LINE 1032 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule101 #-} - {-# LINE 354 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 354 "src-ag/InterfacesRules.lag" #-} rule101 = \ ((_lhsIfromLhs) :: [Vertex]) -> - {-# LINE 354 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 354 "src-ag/InterfacesRules.lag" #-} _lhsIfromLhs {-# LINE 1038 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule102 #-} - {-# LINE 355 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 355 "src-ag/InterfacesRules.lag" #-} rule102 = \ (_ :: ()) -> - {-# LINE 355 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 355 "src-ag/InterfacesRules.lag" #-} [] {-# LINE 1044 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule103 #-} - {-# LINE 401 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 401 "src-ag/InterfacesRules.lag" #-} rule103 = \ ((_hdIseg) :: CSegment) ((_tlIsegs) :: CSegments) -> - {-# LINE 401 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 401 "src-ag/InterfacesRules.lag" #-} _hdIseg : _tlIsegs {-# LINE 1050 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule104 #-} - {-# LINE 447 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 447 "src-ag/InterfacesRules.lag" #-} rule104 = \ ((_tlIfirstInh) :: [Vertex]) -> - {-# LINE 447 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 447 "src-ag/InterfacesRules.lag" #-} _tlIfirstInh {-# LINE 1056 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule105 #-} - {-# LINE 448 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 448 "src-ag/InterfacesRules.lag" #-} rule105 = \ ((_hdIinh) :: [Vertex]) -> - {-# LINE 448 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 448 "src-ag/InterfacesRules.lag" #-} _hdIinh {-# LINE 1062 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule106 #-} @@ -1164,33 +1164,33 @@ in __result_ ) in C_Segments_s14 v13 {-# INLINE rule130 #-} - {-# LINE 167 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 167 "src-ag/InterfacesRules.lag" #-} rule130 = \ (_ :: ()) -> - {-# LINE 167 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 167 "src-ag/InterfacesRules.lag" #-} [] {-# LINE 1172 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule131 #-} - {-# LINE 181 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 181 "src-ag/InterfacesRules.lag" #-} rule131 = \ (_ :: ()) -> - {-# LINE 181 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 181 "src-ag/InterfacesRules.lag" #-} [] {-# LINE 1178 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule132 #-} - {-# LINE 331 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 331 "src-ag/InterfacesRules.lag" #-} rule132 = \ (_ :: ()) -> - {-# LINE 331 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 331 "src-ag/InterfacesRules.lag" #-} repeat [] {-# LINE 1184 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule133 #-} - {-# LINE 402 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 402 "src-ag/InterfacesRules.lag" #-} rule133 = \ (_ :: ()) -> - {-# LINE 402 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 402 "src-ag/InterfacesRules.lag" #-} [] {-# LINE 1190 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule134 #-} - {-# LINE 449 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 449 "src-ag/InterfacesRules.lag" #-} rule134 = \ (_ :: ()) -> - {-# LINE 449 "./src-ag/InterfacesRules.lag" #-} + {-# LINE 449 "src-ag/InterfacesRules.lag" #-} [] {-# LINE 1196 "dist/build/InterfacesRules.hs"#-} {-# INLINE rule135 #-} diff --git a/src-generated/KWOrder.hs b/src-generated/KWOrder.hs --- a/src-generated/KWOrder.hs +++ b/src-generated/KWOrder.hs @@ -2,26 +2,26 @@ {-# LANGUAGE ScopedTypeVariables #-} module KWOrder where -{-# LINE 2 "./src-ag/Patterns.ag" #-} +{-# 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" #-} +{-# 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" #-} +{-# 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" #-} +{-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) @@ -33,7 +33,7 @@ import ErrorMessages {-# LINE 35 "dist/build/KWOrder.hs" #-} -{-# LINE 8 "./src-ag/KWOrder.ag" #-} +{-# LINE 10 "src-ag/KWOrder.ag" #-} import AbstractSyntax import HsToken @@ -57,7 +57,7 @@ {-# LINE 58 "dist/build/KWOrder.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 275 "./src-ag/KWOrder.ag" #-} +{-# LINE 125 "src-ag/KWOrder.ag" #-} -- a depends on b, thus a is a successor of b depToEdge :: Dependency -> Edge @@ -84,8 +84,8 @@ wrap_Child (T_Child act) (Inh_Child _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Child_vIn1 _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap - (T_Child_vOut1 _lhsOechilds _lhsOedges _lhsOnontnames _lhsOrefHoNts _lhsOrefNts _lhsOvertices) <- return (inv_Child_s2 sem arg) + 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) ) @@ -112,17 +112,17 @@ st2 = let v1 :: T_Child_v1 v1 = \ (T_Child_vIn1 _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap) -> ( let - _chnt = rule0 arg_name_ arg_tp_ - _inh = rule1 _chnt _lhsIinhMap - _syn = rule2 _chnt _lhsIsynMap - _refNts = rule3 arg_tp_ - _refHoNts = rule4 _isHigherOrder _refNts - _isHigherOrder = rule5 arg_kind_ - _hasArounds = rule6 _lhsIaroundMap arg_name_ - _merges = rule7 _lhsImergeMap arg_name_ - _isMerged = rule8 _lhsImergedChildren arg_name_ + _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 = rule9 _hasArounds _isMerged _merges arg_kind_ arg_name_ arg_tp_ + _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_ @@ -145,149 +145,149 @@ 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 156 "dist/build/KWOrder.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 162 "dist/build/KWOrder.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 168 "dist/build/KWOrder.hs"#-} - {-# INLINE rule3 #-} - {-# LINE 74 "./src-ag/KWOrder.ag" #-} - rule3 = \ tp_ -> - {-# LINE 74 "./src-ag/KWOrder.ag" #-} + {-# LINE 31 "src-ag/ExecutionPlanCommon.ag" #-} + rule0 = \ tp_ -> + {-# LINE 31 "src-ag/ExecutionPlanCommon.ag" #-} case tp_ of NT nt _ _ -> Set.singleton nt _ -> mempty - {-# LINE 176 "dist/build/KWOrder.hs"#-} - {-# INLINE rule4 #-} - {-# LINE 77 "./src-ag/KWOrder.ag" #-} - rule4 = \ _isHigherOrder _refNts -> - {-# LINE 77 "./src-ag/KWOrder.ag" #-} + {-# 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 182 "dist/build/KWOrder.hs"#-} - {-# INLINE rule5 #-} - {-# LINE 78 "./src-ag/KWOrder.ag" #-} - rule5 = \ kind_ -> - {-# LINE 78 "./src-ag/KWOrder.ag" #-} + {-# 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 190 "dist/build/KWOrder.hs"#-} - {-# INLINE rule6 #-} - {-# LINE 108 "./src-ag/KWOrder.ag" #-} - rule6 = \ ((_lhsIaroundMap) :: Map Identifier [Expression]) name_ -> - {-# LINE 108 "./src-ag/KWOrder.ag" #-} + {-# 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 198 "dist/build/KWOrder.hs"#-} - {-# INLINE rule7 #-} - {-# LINE 136 "./src-ag/KWOrder.ag" #-} - rule7 = \ ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier], Expression)) name_ -> - {-# LINE 136 "./src-ag/KWOrder.ag" #-} + {-# 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 204 "dist/build/KWOrder.hs"#-} - {-# INLINE rule8 #-} - {-# LINE 137 "./src-ag/KWOrder.ag" #-} - rule8 = \ ((_lhsImergedChildren) :: Set Identifier) name_ -> - {-# LINE 137 "./src-ag/KWOrder.ag" #-} + {-# 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 210 "dist/build/KWOrder.hs"#-} - {-# INLINE rule9 #-} - {-# LINE 178 "./src-ag/KWOrder.ag" #-} - rule9 = \ _hasArounds _isMerged _merges kind_ name_ tp_ -> - {-# LINE 178 "./src-ag/KWOrder.ag" #-} + {-# 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 218 "dist/build/KWOrder.hs"#-} + {-# 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 215 "./src-ag/KWOrder.ag" #-} + {-# LINE 65 "src-ag/KWOrder.ag" #-} rule10 = \ name_ -> - {-# LINE 215 "./src-ag/KWOrder.ag" #-} + {-# LINE 65 "src-ag/KWOrder.ag" #-} VChild name_ {-# LINE 224 "dist/build/KWOrder.hs"#-} {-# INLINE rule11 #-} - {-# LINE 216 "./src-ag/KWOrder.ag" #-} + {-# LINE 66 "src-ag/KWOrder.ag" #-} rule11 = \ _syn name_ -> - {-# LINE 216 "./src-ag/KWOrder.ag" #-} + {-# LINE 66 "src-ag/KWOrder.ag" #-} map (VAttr Syn name_) . Map.keys $ _syn {-# LINE 230 "dist/build/KWOrder.hs"#-} {-# INLINE rule12 #-} - {-# LINE 217 "./src-ag/KWOrder.ag" #-} + {-# LINE 67 "src-ag/KWOrder.ag" #-} rule12 = \ _inh name_ -> - {-# LINE 217 "./src-ag/KWOrder.ag" #-} + {-# LINE 67 "src-ag/KWOrder.ag" #-} map (VAttr Inh name_) . Map.keys $ _inh {-# LINE 236 "dist/build/KWOrder.hs"#-} {-# INLINE rule13 #-} - {-# LINE 218 "./src-ag/KWOrder.ag" #-} + {-# LINE 68 "src-ag/KWOrder.ag" #-} rule13 = \ _inhvertices _synvertices _vertex tp_ -> - {-# LINE 218 "./src-ag/KWOrder.ag" #-} + {-# 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 248 "./src-ag/KWOrder.ag" #-} + {-# LINE 98 "src-ag/KWOrder.ag" #-} rule14 = \ tp_ -> - {-# LINE 248 "./src-ag/KWOrder.ag" #-} + {-# LINE 98 "src-ag/KWOrder.ag" #-} case tp_ of NT _ _ defor -> defor _ -> False {-# LINE 252 "dist/build/KWOrder.hs"#-} {-# INLINE rule15 #-} - {-# LINE 251 "./src-ag/KWOrder.ag" #-} + {-# LINE 101 "src-ag/KWOrder.ag" #-} rule15 = \ _childIsDeforested ((_lhsIoptions) :: Options) _vertex kind_ -> - {-# LINE 251 "./src-ag/KWOrder.ag" #-} + {-# 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 255 "./src-ag/KWOrder.ag" #-} + {-# LINE 105 "src-ag/KWOrder.ag" #-} rule16 = \ _hasArounds _vertex name_ -> - {-# LINE 255 "./src-ag/KWOrder.ag" #-} + {-# 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 261 "./src-ag/KWOrder.ag" #-} + {-# LINE 111 "src-ag/KWOrder.ag" #-} rule17 = \ _higherOrderEdges -> - {-# LINE 261 "./src-ag/KWOrder.ag" #-} + {-# LINE 111 "src-ag/KWOrder.ag" #-} _higherOrderEdges {-# LINE 275 "dist/build/KWOrder.hs"#-} {-# INLINE rule18 #-} - {-# LINE 262 "./src-ag/KWOrder.ag" #-} + {-# LINE 112 "src-ag/KWOrder.ag" #-} rule18 = \ _synvertices _vertex -> - {-# LINE 262 "./src-ag/KWOrder.ag" #-} + {-# LINE 112 "src-ag/KWOrder.ag" #-} map (flip (,) _vertex ) _synvertices {-# LINE 281 "dist/build/KWOrder.hs"#-} {-# INLINE rule19 #-} - {-# LINE 263 "./src-ag/KWOrder.ag" #-} + {-# LINE 113 "src-ag/KWOrder.ag" #-} rule19 = \ _edgesin _edgesout -> - {-# LINE 263 "./src-ag/KWOrder.ag" #-} + {-# LINE 113 "src-ag/KWOrder.ag" #-} Set.fromList (_edgesout ++ _edgesin ) {-# LINE 287 "dist/build/KWOrder.hs"#-} {-# INLINE rule20 #-} - {-# LINE 301 "./src-ag/KWOrder.ag" #-} + {-# LINE 151 "src-ag/KWOrder.ag" #-} rule20 = \ name_ tp_ -> - {-# LINE 301 "./src-ag/KWOrder.ag" #-} + {-# LINE 151 "src-ag/KWOrder.ag" #-} case tp_ of NT nont _ _ -> [(name_, nont)] _ -> [] @@ -308,8 +308,8 @@ wrap_Children (T_Children act) (Inh_Children _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Children_vIn4 _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap - (T_Children_vOut4 _lhsOechilds _lhsOedges _lhsOnontnames _lhsOrefHoNts _lhsOrefNts _lhsOvertices) <- return (inv_Children_s5 sem arg) + 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) ) @@ -471,8 +471,8 @@ wrap_Expression (T_Expression act) (Inh_Expression ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Expression_vIn7 - (T_Expression_vOut7 _lhsOcopy _lhsOvertices) <- return (inv_Expression_s8 sem arg) + let arg7 = T_Expression_vIn7 + (T_Expression_vOut7 _lhsOcopy _lhsOvertices) <- return (inv_Expression_s8 sem arg7) return (Syn_Expression _lhsOcopy _lhsOvertices) ) @@ -508,9 +508,9 @@ in __result_ ) in C_Expression_s8 v7 {-# INLINE rule47 #-} - {-# LINE 200 "./src-ag/KWOrder.ag" #-} + {-# LINE 50 "src-ag/KWOrder.ag" #-} rule47 = \ tks_ -> - {-# LINE 200 "./src-ag/KWOrder.ag" #-} + {-# 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"#-} @@ -530,8 +530,8 @@ wrap_Grammar (T_Grammar act) (Inh_Grammar _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Grammar_vIn10 _lhsIoptions - (T_Grammar_vOut10 _lhsOdepgraphs _lhsOerrors _lhsOinhmap _lhsOlocalSigMap _lhsOoutput _lhsOsynmap _lhsOvisitgraph) <- return (inv_Grammar_s11 sem arg) + 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) ) @@ -560,15 +560,15 @@ 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) - _nontsOinhMap = rule50 _nontsIinhMap' - _nontsOsynMap = rule51 _nontsIsynMap' - _nontsOrulenumber = rule52 () - _closedNtDeps = rule53 _nontsIntDeps - _closedHoNtDeps = rule54 _nontsIntHoDeps - _closedHoNtRevDeps = rule55 _closedHoNtDeps - _nontsOaroundMap = rule56 arg_aroundsMap_ - _nontsOmergeMap = rule57 arg_mergeMap_ - _nontsOclassContexts = rule58 arg_contextMap_ + _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 @@ -589,69 +589,69 @@ 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 597 "dist/build/KWOrder.hs"#-} + {-# 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 16 "./src-ag/DistChildAttr.ag" #-} - rule51 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} - _nontsIsynMap' - {-# LINE 603 "dist/build/KWOrder.hs"#-} + {-# 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 44 "./src-ag/KWOrder.ag" #-} - rule52 = \ (_ :: ()) -> - {-# LINE 44 "./src-ag/KWOrder.ag" #-} - 0 - {-# LINE 609 "dist/build/KWOrder.hs"#-} + {-# 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 83 "./src-ag/KWOrder.ag" #-} - rule53 = \ ((_nontsIntDeps) :: Map NontermIdent (Set NontermIdent)) -> - {-# LINE 83 "./src-ag/KWOrder.ag" #-} - closeMap _nontsIntDeps - {-# LINE 615 "dist/build/KWOrder.hs"#-} + {-# LINE 51 "src-ag/ExecutionPlanCommon.ag" #-} + rule53 = \ contextMap_ -> + {-# LINE 51 "src-ag/ExecutionPlanCommon.ag" #-} + contextMap_ + {-# LINE 615 "dist/build/KWOrder.hs"#-} {-# INLINE rule54 #-} - {-# LINE 84 "./src-ag/KWOrder.ag" #-} - rule54 = \ ((_nontsIntHoDeps) :: Map NontermIdent (Set NontermIdent)) -> - {-# LINE 84 "./src-ag/KWOrder.ag" #-} - closeMap _nontsIntHoDeps - {-# LINE 621 "dist/build/KWOrder.hs"#-} + {-# LINE 92 "src-ag/ExecutionPlanCommon.ag" #-} + rule54 = \ aroundsMap_ -> + {-# LINE 92 "src-ag/ExecutionPlanCommon.ag" #-} + aroundsMap_ + {-# LINE 621 "dist/build/KWOrder.hs"#-} {-# INLINE rule55 #-} - {-# LINE 85 "./src-ag/KWOrder.ag" #-} - rule55 = \ _closedHoNtDeps -> - {-# LINE 85 "./src-ag/KWOrder.ag" #-} - revDeps _closedHoNtDeps - {-# LINE 627 "dist/build/KWOrder.hs"#-} + {-# LINE 117 "src-ag/ExecutionPlanCommon.ag" #-} + rule55 = \ mergeMap_ -> + {-# LINE 117 "src-ag/ExecutionPlanCommon.ag" #-} + mergeMap_ + {-# LINE 627 "dist/build/KWOrder.hs"#-} {-# INLINE rule56 #-} - {-# LINE 105 "./src-ag/KWOrder.ag" #-} - rule56 = \ aroundsMap_ -> - {-# LINE 105 "./src-ag/KWOrder.ag" #-} - aroundsMap_ - {-# LINE 633 "dist/build/KWOrder.hs"#-} + {-# LINE 9 "src-ag/ExecutionPlanPre.ag" #-} + rule56 = \ (_ :: ()) -> + {-# LINE 9 "src-ag/ExecutionPlanPre.ag" #-} + 0 + {-# LINE 633 "dist/build/KWOrder.hs"#-} {-# INLINE rule57 #-} - {-# LINE 130 "./src-ag/KWOrder.ag" #-} - rule57 = \ mergeMap_ -> - {-# LINE 130 "./src-ag/KWOrder.ag" #-} - mergeMap_ - {-# LINE 639 "dist/build/KWOrder.hs"#-} + {-# 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 146 "./src-ag/KWOrder.ag" #-} - rule58 = \ contextMap_ -> - {-# LINE 146 "./src-ag/KWOrder.ag" #-} - contextMap_ - {-# LINE 645 "dist/build/KWOrder.hs"#-} + {-# 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 269 "./src-ag/KWOrder.ag" #-} + {-# LINE 119 "src-ag/KWOrder.ag" #-} rule59 = \ manualAttrOrderMap_ -> - {-# LINE 269 "./src-ag/KWOrder.ag" #-} + {-# LINE 119 "src-ag/KWOrder.ag" #-} manualAttrOrderMap_ {-# LINE 651 "dist/build/KWOrder.hs"#-} {-# INLINE rule60 #-} - {-# LINE 360 "./src-ag/KWOrder.ag" #-} + {-# LINE 210 "src-ag/KWOrder.ag" #-} rule60 = \ ((_lhsIoptions) :: Options) ((_nontsIdepinfo) :: [NontDependencyInformation]) derivings_ typeSyns_ wrappers_ -> - {-# LINE 360 "./src-ag/KWOrder.ag" #-} + {-# 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 @@ -690,8 +690,8 @@ wrap_HsToken (T_HsToken act) (Inh_HsToken ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_HsToken_vIn13 - (T_HsToken_vOut13 _lhsOvertices) <- return (inv_HsToken_s14 sem arg) + let arg13 = T_HsToken_vIn13 + (T_HsToken_vOut13 _lhsOvertices) <- return (inv_HsToken_s14 sem arg13) return (Syn_HsToken _lhsOvertices) ) @@ -729,9 +729,9 @@ in __result_ ) in C_HsToken_s14 v13 {-# INLINE rule68 #-} - {-# LINE 193 "./src-ag/KWOrder.ag" #-} + {-# LINE 43 "src-ag/KWOrder.ag" #-} rule68 = \ var_ -> - {-# LINE 193 "./src-ag/KWOrder.ag" #-} + {-# LINE 43 "src-ag/KWOrder.ag" #-} Set.singleton $ VChild var_ {-# LINE 737 "dist/build/KWOrder.hs"#-} {-# NOINLINE sem_HsToken_AGField #-} @@ -747,9 +747,9 @@ in __result_ ) in C_HsToken_s14 v13 {-# INLINE rule69 #-} - {-# LINE 194 "./src-ag/KWOrder.ag" #-} + {-# LINE 44 "src-ag/KWOrder.ag" #-} rule69 = \ attr_ field_ -> - {-# LINE 194 "./src-ag/KWOrder.ag" #-} + {-# LINE 44 "src-ag/KWOrder.ag" #-} Set.singleton $ VAttr (if field_ == _LHS then Inh else if field_ == _LOC then Loc else Syn) field_ attr_ @@ -824,8 +824,8 @@ wrap_HsTokens (T_HsTokens act) (Inh_HsTokens ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_HsTokens_vIn16 - (T_HsTokens_vOut16 ) <- return (inv_HsTokens_s17 sem arg) + let arg16 = T_HsTokens_vIn16 + (T_HsTokens_vOut16 ) <- return (inv_HsTokens_s17 sem arg16) return (Syn_HsTokens ) ) @@ -879,8 +879,8 @@ wrap_HsTokensRoot (T_HsTokensRoot act) (Inh_HsTokensRoot ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_HsTokensRoot_vIn19 - (T_HsTokensRoot_vOut19 ) <- return (inv_HsTokensRoot_s20 sem arg) + let arg19 = T_HsTokensRoot_vIn19 + (T_HsTokensRoot_vOut19 ) <- return (inv_HsTokensRoot_s20 sem arg19) return (Syn_HsTokensRoot ) ) @@ -922,8 +922,8 @@ 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 arg = 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 arg) + 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) ) @@ -952,36 +952,36 @@ 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) - _lhsOinhMap' :: Map Identifier Attributes - _lhsOinhMap' = rule74 arg_inh_ arg_nt_ - _lhsOsynMap' :: Map Identifier Attributes - _lhsOsynMap' = rule75 arg_nt_ arg_syn_ _lhsOntDeps :: Map NontermIdent (Set NontermIdent) - _lhsOntDeps = rule76 _prodsIrefNts arg_nt_ + _lhsOntDeps = rule74 _prodsIrefNts arg_nt_ _lhsOntHoDeps :: Map NontermIdent (Set NontermIdent) - _lhsOntHoDeps = rule77 _prodsIrefHoNts arg_nt_ - _closedNtDeps = rule78 _lhsIclosedNtDeps arg_nt_ - _closedHoNtDeps = rule79 _lhsIclosedHoNtDeps arg_nt_ - _closedHoNtRevDeps = rule80 _lhsIclosedHoNtRevDeps arg_nt_ - _recursive = rule81 _closedNtDeps arg_nt_ - _nontrivAcyc = rule82 _closedHoNtDeps arg_nt_ - _hoInfo = rule83 _closedHoNtDeps _closedHoNtRevDeps _nontrivAcyc - _aroundMap = rule84 _lhsIaroundMap arg_nt_ - _mergeMap = rule85 _lhsImergeMap arg_nt_ - _classContexts = rule86 _lhsIclassContexts arg_nt_ - _prodsOmanualDeps = rule87 _lhsImanualDeps arg_nt_ - _synvertices = rule88 arg_nt_ arg_syn_ - _inhvertices = rule89 arg_inh_ arg_nt_ - _vertices = rule90 _inhvertices _synvertices - _nontgraph = rule91 _vertices - _lhsOdepinfo :: NontDependencyInformation - _lhsOdepinfo = rule92 _classContexts _hoInfo _nontgraph _prodsIdepgraph _recursive arg_inh_ arg_nt_ arg_params_ arg_syn_ + _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 = rule93 arg_inh_ arg_nt_ + _lhsOinhmap = rule85 arg_inh_ arg_nt_ _lhsOsynmap :: Map.Map NontermIdent Attributes - _lhsOsynmap = rule94 arg_nt_ arg_syn_ + _lhsOsynmap = rule86 arg_nt_ arg_syn_ _lhsOlocalSigMap :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type)) - _lhsOlocalSigMap = rule95 _prodsIlocalSigMap arg_nt_ + _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 @@ -994,121 +994,139 @@ in __result_ ) in C_Nonterminal_s23 v22 {-# INLINE rule74 #-} - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} - rule74 = \ inh_ nt_ -> - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} - Map.singleton nt_ inh_ - {-# LINE 1002 "dist/build/KWOrder.hs"#-} + {-# 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 8 "./src-ag/DistChildAttr.ag" #-} - rule75 = \ nt_ syn_ -> - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} - Map.singleton nt_ syn_ - {-# LINE 1008 "dist/build/KWOrder.hs"#-} + {-# 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 59 "./src-ag/KWOrder.ag" #-} - rule76 = \ ((_prodsIrefNts) :: Set NontermIdent) nt_ -> - {-# LINE 59 "./src-ag/KWOrder.ag" #-} - Map.singleton nt_ _prodsIrefNts + {-# 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 60 "./src-ag/KWOrder.ag" #-} - rule77 = \ ((_prodsIrefHoNts) :: Set NontermIdent) nt_ -> - {-# LINE 60 "./src-ag/KWOrder.ag" #-} - Map.singleton nt_ _prodsIrefHoNts + {-# 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 62 "./src-ag/KWOrder.ag" #-} - rule78 = \ ((_lhsIclosedNtDeps) :: Map NontermIdent (Set NontermIdent)) nt_ -> - {-# LINE 62 "./src-ag/KWOrder.ag" #-} - Map.findWithDefault Set.empty nt_ _lhsIclosedNtDeps + {-# 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 63 "./src-ag/KWOrder.ag" #-} - rule79 = \ ((_lhsIclosedHoNtDeps) :: Map NontermIdent (Set NontermIdent)) nt_ -> - {-# LINE 63 "./src-ag/KWOrder.ag" #-} - Map.findWithDefault Set.empty nt_ _lhsIclosedHoNtDeps + {-# 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 64 "./src-ag/KWOrder.ag" #-} - rule80 = \ ((_lhsIclosedHoNtRevDeps) :: Map NontermIdent (Set NontermIdent)) nt_ -> - {-# LINE 64 "./src-ag/KWOrder.ag" #-} - Map.findWithDefault Set.empty nt_ _lhsIclosedHoNtRevDeps + {-# 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 66 "./src-ag/KWOrder.ag" #-} - rule81 = \ _closedNtDeps nt_ -> - {-# LINE 66 "./src-ag/KWOrder.ag" #-} - nt_ `Set.member` _closedNtDeps - {-# LINE 1044 "dist/build/KWOrder.hs"#-} - {-# INLINE rule82 #-} - {-# LINE 67 "./src-ag/KWOrder.ag" #-} - rule82 = \ _closedHoNtDeps nt_ -> - {-# LINE 67 "./src-ag/KWOrder.ag" #-} - nt_ `Set.member` _closedHoNtDeps - {-# LINE 1050 "dist/build/KWOrder.hs"#-} - {-# INLINE rule83 #-} - {-# LINE 68 "./src-ag/KWOrder.ag" #-} - rule83 = \ _closedHoNtDeps _closedHoNtRevDeps _nontrivAcyc -> - {-# LINE 68 "./src-ag/KWOrder.ag" #-} + {-# LINE 25 "src-ag/ExecutionPlanCommon.ag" #-} + rule81 = \ _closedHoNtDeps _closedHoNtRevDeps _nontrivAcyc -> + {-# LINE 25 "src-ag/ExecutionPlanCommon.ag" #-} HigherOrderInfo { hoNtDeps = _closedHoNtDeps , hoNtRevDeps = _closedHoNtRevDeps , hoAcyclic = _nontrivAcyc } - {-# LINE 1059 "dist/build/KWOrder.hs"#-} - {-# INLINE rule84 #-} - {-# LINE 101 "./src-ag/KWOrder.ag" #-} - rule84 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) nt_ -> - {-# LINE 101 "./src-ag/KWOrder.ag" #-} + {-# 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 1065 "dist/build/KWOrder.hs"#-} - {-# INLINE rule85 #-} - {-# LINE 126 "./src-ag/KWOrder.ag" #-} - rule85 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) nt_ -> - {-# LINE 126 "./src-ag/KWOrder.ag" #-} + {-# 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 1071 "dist/build/KWOrder.hs"#-} + {-# 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 149 "./src-ag/KWOrder.ag" #-} - rule86 = \ ((_lhsIclassContexts) :: ContextMap) nt_ -> - {-# LINE 149 "./src-ag/KWOrder.ag" #-} - Map.findWithDefault [] nt_ _lhsIclassContexts - {-# LINE 1077 "dist/build/KWOrder.hs"#-} + {-# 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 270 "./src-ag/KWOrder.ag" #-} - rule87 = \ ((_lhsImanualDeps) :: AttrOrderMap) nt_ -> - {-# LINE 270 "./src-ag/KWOrder.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsImanualDeps + {-# 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 325 "./src-ag/KWOrder.ag" #-} - rule88 = \ nt_ syn_ -> - {-# LINE 325 "./src-ag/KWOrder.ag" #-} - map (VAttr Syn nt_) . Map.keys $ syn_ - {-# LINE 1089 "dist/build/KWOrder.hs"#-} + {-# 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 326 "./src-ag/KWOrder.ag" #-} - rule89 = \ inh_ nt_ -> - {-# LINE 326 "./src-ag/KWOrder.ag" #-} - map (VAttr Inh nt_) . Map.keys $ inh_ - {-# LINE 1095 "dist/build/KWOrder.hs"#-} + {-# 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 327 "./src-ag/KWOrder.ag" #-} - rule90 = \ _inhvertices _synvertices -> - {-# LINE 327 "./src-ag/KWOrder.ag" #-} - _synvertices ++ _inhvertices - {-# LINE 1101 "dist/build/KWOrder.hs"#-} + {-# 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 331 "./src-ag/KWOrder.ag" #-} - rule91 = \ _vertices -> - {-# LINE 331 "./src-ag/KWOrder.ag" #-} + {-# 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 1108 "dist/build/KWOrder.hs"#-} - {-# INLINE rule92 #-} - {-# LINE 339 "./src-ag/KWOrder.ag" #-} - rule92 = \ _classContexts _hoInfo _nontgraph ((_prodsIdepgraph) :: [ProdDependencyGraph]) _recursive inh_ nt_ params_ syn_ -> - {-# LINE 339 "./src-ag/KWOrder.ag" #-} + {-# 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_ @@ -1119,25 +1137,7 @@ , ndiHoInfo = _hoInfo , ndiClassCtxs = _classContexts } - {-# LINE 1123 "dist/build/KWOrder.hs"#-} - {-# INLINE rule93 #-} - {-# LINE 377 "./src-ag/KWOrder.ag" #-} - rule93 = \ inh_ nt_ -> - {-# LINE 377 "./src-ag/KWOrder.ag" #-} - Map.singleton nt_ inh_ - {-# LINE 1129 "dist/build/KWOrder.hs"#-} - {-# INLINE rule94 #-} - {-# LINE 378 "./src-ag/KWOrder.ag" #-} - rule94 = \ nt_ syn_ -> - {-# LINE 378 "./src-ag/KWOrder.ag" #-} - Map.singleton nt_ syn_ - {-# LINE 1135 "dist/build/KWOrder.hs"#-} - {-# INLINE rule95 #-} - {-# LINE 387 "./src-ag/KWOrder.ag" #-} - rule95 = \ ((_prodsIlocalSigMap) :: Map.Map ConstructorIdent (Map.Map Identifier Type)) nt_ -> - {-# LINE 387 "./src-ag/KWOrder.ag" #-} - Map.singleton nt_ _prodsIlocalSigMap - {-# LINE 1141 "dist/build/KWOrder.hs"#-} + {-# LINE 1141 "dist/build/KWOrder.hs"#-} {-# INLINE rule96 #-} rule96 = \ ((_prodsIrulenumber) :: Int) -> _prodsIrulenumber @@ -1169,8 +1169,8 @@ 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 arg = 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 arg) + 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) ) @@ -1402,8 +1402,8 @@ wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Pattern_vIn28 - (T_Pattern_vOut28 _lhsOcopy _lhsOvertices) <- return (inv_Pattern_s29 sem arg) + let arg28 = T_Pattern_vIn28 + (T_Pattern_vOut28 _lhsOcopy _lhsOvertices) <- return (inv_Pattern_s29 sem arg28) return (Syn_Pattern _lhsOcopy _lhsOvertices) ) @@ -1498,18 +1498,18 @@ in __result_ ) in C_Pattern_s29 v28 {-# INLINE rule149 #-} - {-# LINE 205 "./src-ag/KWOrder.ag" #-} + {-# LINE 55 "src-ag/KWOrder.ag" #-} rule149 = \ attr_ field_ -> - {-# LINE 205 "./src-ag/KWOrder.ag" #-} + {-# 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 209 "./src-ag/KWOrder.ag" #-} + {-# LINE 59 "src-ag/KWOrder.ag" #-} rule150 = \ ((_patIvertices) :: Set.Set Vertex) _vertex -> - {-# LINE 209 "./src-ag/KWOrder.ag" #-} + {-# LINE 59 "src-ag/KWOrder.ag" #-} Set.insert _vertex _patIvertices {-# LINE 1515 "dist/build/KWOrder.hs"#-} {-# INLINE rule151 #-} @@ -1578,8 +1578,8 @@ wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Patterns_vIn31 - (T_Patterns_vOut31 _lhsOcopy _lhsOvertices) <- return (inv_Patterns_s32 sem arg) + let arg31 = T_Patterns_vIn31 + (T_Patterns_vOut31 _lhsOcopy _lhsOvertices) <- return (inv_Patterns_s32 sem arg31) return (Syn_Patterns _lhsOcopy _lhsOvertices) ) @@ -1661,8 +1661,8 @@ wrap_Production (T_Production act) (Inh_Production _lhsIaroundMap _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Production_vIn34 _lhsIaroundMap _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap - (T_Production_vOut34 _lhsOdepgraph _lhsOlocalSigMap _lhsOrefHoNts _lhsOrefNts _lhsOrulenumber) <- return (inv_Production_s35 sem arg) + 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) ) @@ -1698,14 +1698,14 @@ _aroundMap = rule165 _lhsIaroundMap arg_con_ _mergeMap = rule166 _lhsImergeMap arg_con_ _mergedChildren = rule167 _mergeMap - _vertices = rule168 _childrenIvertices _rulesIvertices - _manualDeps = rule169 _lhsImanualDeps arg_con_ - _manualEdges = rule170 _manualDeps - _edges = rule171 _childrenIedges _rulesIedges - _lhsOdepgraph :: ProdDependencyGraph - _lhsOdepgraph = rule172 _childrenIechilds _childrenInontnames _edges _rulesIerules _vertices arg_con_ arg_constraints_ arg_params_ _lhsOlocalSigMap :: Map.Map ConstructorIdent (Map.Map Identifier Type) - _lhsOlocalSigMap = rule173 _typeSigsIlocalSigMap arg_con_ + _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 @@ -1723,51 +1723,57 @@ in __result_ ) in C_Production_s35 v34 {-# INLINE rule165 #-} - {-# LINE 102 "./src-ag/KWOrder.ag" #-} + {-# LINE 89 "src-ag/ExecutionPlanCommon.ag" #-} rule165 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Map Identifier [Expression])) con_ -> - {-# LINE 102 "./src-ag/KWOrder.ag" #-} + {-# LINE 89 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Map.empty con_ _lhsIaroundMap {-# LINE 1731 "dist/build/KWOrder.hs"#-} {-# INLINE rule166 #-} - {-# LINE 127 "./src-ag/KWOrder.ag" #-} + {-# LINE 114 "src-ag/ExecutionPlanCommon.ag" #-} rule166 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression))) con_ -> - {-# LINE 127 "./src-ag/KWOrder.ag" #-} + {-# LINE 114 "src-ag/ExecutionPlanCommon.ag" #-} Map.findWithDefault Map.empty con_ _lhsImergeMap {-# LINE 1737 "dist/build/KWOrder.hs"#-} {-# INLINE rule167 #-} - {-# LINE 133 "./src-ag/KWOrder.ag" #-} + {-# LINE 120 "src-ag/ExecutionPlanCommon.ag" #-} rule167 = \ _mergeMap -> - {-# LINE 133 "./src-ag/KWOrder.ag" #-} + {-# LINE 120 "src-ag/ExecutionPlanCommon.ag" #-} Set.unions [ Set.fromList ms | (_,ms,_) <- Map.elems _mergeMap ] {-# LINE 1743 "dist/build/KWOrder.hs"#-} {-# INLINE rule168 #-} - {-# LINE 229 "./src-ag/KWOrder.ag" #-} - rule168 = \ ((_childrenIvertices) :: Set.Set Vertex) ((_rulesIvertices) :: Set.Set Vertex) -> - {-# LINE 229 "./src-ag/KWOrder.ag" #-} - _rulesIvertices `Set.union` _childrenIvertices - {-# LINE 1749 "dist/build/KWOrder.hs"#-} + {-# 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 272 "./src-ag/KWOrder.ag" #-} - rule169 = \ ((_lhsImanualDeps) :: Map ConstructorIdent (Set Dependency)) con_ -> - {-# LINE 272 "./src-ag/KWOrder.ag" #-} - Map.findWithDefault Set.empty con_ _lhsImanualDeps - {-# LINE 1755 "dist/build/KWOrder.hs"#-} + {-# 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 273 "./src-ag/KWOrder.ag" #-} - rule170 = \ _manualDeps -> - {-# LINE 273 "./src-ag/KWOrder.ag" #-} - Set.map depToEdge _manualDeps + {-# 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 295 "./src-ag/KWOrder.ag" #-} - rule171 = \ ((_childrenIedges) :: Set.Set Edge) ((_rulesIedges) :: Set.Set Edge) -> - {-# LINE 295 "./src-ag/KWOrder.ag" #-} - _rulesIedges `Set.union` _childrenIedges - {-# LINE 1767 "dist/build/KWOrder.hs"#-} + {-# 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 310 "./src-ag/KWOrder.ag" #-} - rule172 = \ ((_childrenIechilds) :: EChildren) ((_childrenInontnames) :: [(Identifier, Identifier)]) _edges ((_rulesIerules) :: ERules) _vertices con_ constraints_ params_ -> - {-# LINE 310 "./src-ag/KWOrder.ag" #-} + {-# 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 @@ -1776,13 +1782,7 @@ , pdgChildMap = _childrenInontnames , pdgConstraints = constraints_ , pdgParams = params_ } - {-# LINE 1780 "dist/build/KWOrder.hs"#-} - {-# INLINE rule173 #-} - {-# LINE 388 "./src-ag/KWOrder.ag" #-} - rule173 = \ ((_typeSigsIlocalSigMap) :: Map Identifier Type) con_ -> - {-# LINE 388 "./src-ag/KWOrder.ag" #-} - Map.singleton con_ _typeSigsIlocalSigMap - {-# LINE 1786 "dist/build/KWOrder.hs"#-} + {-# LINE 1786 "dist/build/KWOrder.hs"#-} {-# INLINE rule174 #-} rule174 = \ ((_childrenIrefHoNts) :: Set NontermIdent) -> _childrenIrefHoNts @@ -1823,8 +1823,8 @@ wrap_Productions (T_Productions act) (Inh_Productions _lhsIaroundMap _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Productions_vIn37 _lhsIaroundMap _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap - (T_Productions_vOut37 _lhsOdepgraph _lhsOlocalSigMap _lhsOrefHoNts _lhsOrefNts _lhsOrulenumber) <- return (inv_Productions_s38 sem arg) + 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) ) @@ -1984,8 +1984,8 @@ wrap_Rule (T_Rule act) (Inh_Rule _lhsIrulenumber) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Rule_vIn40 _lhsIrulenumber - (T_Rule_vOut40 _lhsOedges _lhsOerules _lhsOrulenumber _lhsOvertices) <- return (inv_Rule_s41 sem arg) + 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) ) @@ -2016,11 +2016,11 @@ _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 ) - _lhsOrulenumber :: Int - _lhsOrulenumber = rule208 _lhsIrulenumber - _rulename = rule209 _lhsIrulenumber arg_mbName_ _lhsOerules :: ERule - _lhsOerules = rule210 _patternIcopy _rhsIcopy _rulename arg_explicit_ arg_mbError_ arg_origin_ arg_owrt_ arg_pure_ + _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 @@ -2032,21 +2032,9 @@ in __result_ ) in C_Rule_s41 v40 {-# INLINE rule208 #-} - {-# LINE 47 "./src-ag/KWOrder.ag" #-} - rule208 = \ ((_lhsIrulenumber) :: Int) -> - {-# LINE 47 "./src-ag/KWOrder.ag" #-} - _lhsIrulenumber + 1 - {-# LINE 2040 "dist/build/KWOrder.hs"#-} - {-# INLINE rule209 #-} - {-# LINE 48 "./src-ag/KWOrder.ag" #-} - rule209 = \ ((_lhsIrulenumber) :: Int) mbName_ -> - {-# LINE 48 "./src-ag/KWOrder.ag" #-} - maybe (identifier $ "rule" ++ show _lhsIrulenumber) id mbName_ - {-# LINE 2046 "dist/build/KWOrder.hs"#-} - {-# INLINE rule210 #-} - {-# LINE 160 "./src-ag/KWOrder.ag" #-} - rule210 = \ ((_patternIcopy) :: Pattern) ((_rhsIcopy) :: Expression) _rulename explicit_ mbError_ origin_ owrt_ pure_ -> - {-# LINE 160 "./src-ag/KWOrder.ag" #-} + {-# 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 @@ -2055,35 +2043,47 @@ explicit_ pure_ mbError_ - {-# LINE 2059 "dist/build/KWOrder.hs"#-} + {-# 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 224 "./src-ag/KWOrder.ag" #-} + {-# LINE 74 "src-ag/KWOrder.ag" #-} rule211 = \ _rulename -> - {-# LINE 224 "./src-ag/KWOrder.ag" #-} + {-# LINE 74 "src-ag/KWOrder.ag" #-} VRule _rulename {-# LINE 2065 "dist/build/KWOrder.hs"#-} {-# INLINE rule212 #-} - {-# LINE 225 "./src-ag/KWOrder.ag" #-} + {-# LINE 75 "src-ag/KWOrder.ag" #-} rule212 = \ ((_patternIvertices) :: Set.Set Vertex) ((_rhsIvertices) :: Set.Set Vertex) _vertex -> - {-# LINE 225 "./src-ag/KWOrder.ag" #-} + {-# LINE 75 "src-ag/KWOrder.ag" #-} Set.insert _vertex $ _patternIvertices `Set.union` _rhsIvertices {-# LINE 2071 "dist/build/KWOrder.hs"#-} {-# INLINE rule213 #-} - {-# LINE 237 "./src-ag/KWOrder.ag" #-} + {-# LINE 87 "src-ag/KWOrder.ag" #-} rule213 = \ ((_rhsIvertices) :: Set.Set Vertex) _vertex -> - {-# LINE 237 "./src-ag/KWOrder.ag" #-} + {-# LINE 87 "src-ag/KWOrder.ag" #-} map ((,) _vertex ) (Set.toList _rhsIvertices) {-# LINE 2077 "dist/build/KWOrder.hs"#-} {-# INLINE rule214 #-} - {-# LINE 238 "./src-ag/KWOrder.ag" #-} + {-# LINE 88 "src-ag/KWOrder.ag" #-} rule214 = \ ((_patternIvertices) :: Set.Set Vertex) _vertex -> - {-# LINE 238 "./src-ag/KWOrder.ag" #-} + {-# LINE 88 "src-ag/KWOrder.ag" #-} map (flip (,) _vertex ) (Set.toList _patternIvertices) {-# LINE 2083 "dist/build/KWOrder.hs"#-} {-# INLINE rule215 #-} - {-# LINE 239 "./src-ag/KWOrder.ag" #-} + {-# LINE 89 "src-ag/KWOrder.ag" #-} rule215 = \ _edgesin _edgesout -> - {-# LINE 239 "./src-ag/KWOrder.ag" #-} + {-# LINE 89 "src-ag/KWOrder.ag" #-} Set.fromList $ _edgesout ++ _edgesin {-# LINE 2089 "dist/build/KWOrder.hs"#-} @@ -2096,8 +2096,8 @@ wrap_Rules (T_Rules act) (Inh_Rules _lhsIrulenumber) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Rules_vIn43 _lhsIrulenumber - (T_Rules_vOut43 _lhsOedges _lhsOerules _lhsOrulenumber _lhsOvertices) <- return (inv_Rules_s44 sem arg) + 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) ) @@ -2199,8 +2199,8 @@ wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_TypeSig_vIn46 - (T_TypeSig_vOut46 _lhsOlocalSigMap) <- return (inv_TypeSig_s47 sem arg) + let arg46 = T_TypeSig_vIn46 + (T_TypeSig_vOut46 _lhsOlocalSigMap) <- return (inv_TypeSig_s47 sem arg46) return (Syn_TypeSig _lhsOlocalSigMap) ) @@ -2233,9 +2233,9 @@ in __result_ ) in C_TypeSig_s47 v46 {-# INLINE rule226 #-} - {-# LINE 389 "./src-ag/KWOrder.ag" #-} + {-# LINE 161 "src-ag/ExecutionPlanCommon.ag" #-} rule226 = \ name_ tp_ -> - {-# LINE 389 "./src-ag/KWOrder.ag" #-} + {-# LINE 161 "src-ag/ExecutionPlanCommon.ag" #-} Map.singleton name_ tp_ {-# LINE 2241 "dist/build/KWOrder.hs"#-} @@ -2248,8 +2248,8 @@ wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_TypeSigs_vIn49 - (T_TypeSigs_vOut49 _lhsOlocalSigMap) <- return (inv_TypeSigs_s50 sem arg) + let arg49 = T_TypeSigs_vIn49 + (T_TypeSigs_vOut49 _lhsOlocalSigMap) <- return (inv_TypeSigs_s50 sem arg49) return (Syn_TypeSigs _lhsOlocalSigMap) ) diff --git a/src-generated/LOAG/Order.hs b/src-generated/LOAG/Order.hs new file mode 100644 --- /dev/null +++ b/src-generated/LOAG/Order.hs @@ -0,0 +1,6238 @@ +{-# 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 diff --git a/src-generated/LOAG/Rep.hs b/src-generated/LOAG/Rep.hs new file mode 100644 --- /dev/null +++ b/src-generated/LOAG/Rep.hs @@ -0,0 +1,107 @@ + + +-- UUAGC 0.9.51 (src-ag/LOAG/Rep.ag) +module LOAG.Rep where + +import CommonTypes +import AbstractSyntax +import LOAG.Common +import qualified Data.Array as A +import qualified Data.Map as Map +import qualified Data.Set as Set + + +import Data.List (intercalate, foldl', nub) +import Data.Tuple (swap) +import Control.Arrow +-- FieldAtt ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + self : FieldAtt + alternatives: + alternative FieldAtt: + child t : {MyType} + child p : {PLabel} + child f : {FLabel} + child a : {ALabel} + visit 0: + local self : _ +-} +data FieldAtt = FieldAtt {t_FieldAtt_FieldAtt :: MyType,p_FieldAtt_FieldAtt :: PLabel,f_FieldAtt_FieldAtt :: FLabel,a_FieldAtt_FieldAtt :: ALabel} +-- FieldAtts --------------------------------------------------- +{- + visit 0: + synthesized attribute: + self : FieldAtts + alternatives: + alternative Cons: + child hd : FieldAtt + child tl : FieldAtts + visit 0: + local self : _ + alternative Nil: + visit 0: + local self : _ +-} +type FieldAtts = [FieldAtt] +-- LOAGRep ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + self : LOAGRep + alternatives: + alternative LOAGRep: + child ps : {[PLabel]} + child ap : {A_P} + child an : {A_N} + child ain : {AI_N} + child asn : {AS_N} + child sfp : {SF_P} + child pmp : {PMP} + child pmpr : {PMP_R} + child nmp : {NMP} + child nmpr : {NMP_R} + child gen : {A.Array Int Int} + child inss : {A.Array Int [Int]} + child ofld : {A.Array Int Int} + child fty : {FTY} + child fieldMap : {FMap} + child fsInP : {Map.Map PLabel [(PLabel,FLabel)]} + visit 0: + local self : _ +-} +data LOAGRep = LOAGRep {ps_LOAGRep_LOAGRep :: ([PLabel]),ap_LOAGRep_LOAGRep :: A_P,an_LOAGRep_LOAGRep :: A_N,ain_LOAGRep_LOAGRep :: AI_N,asn_LOAGRep_LOAGRep :: AS_N,sfp_LOAGRep_LOAGRep :: SF_P,pmp_LOAGRep_LOAGRep :: PMP,pmpr_LOAGRep_LOAGRep :: PMP_R,nmp_LOAGRep_LOAGRep :: NMP,nmpr_LOAGRep_LOAGRep :: NMP_R,gen_LOAGRep_LOAGRep :: (A.Array Int Int),inss_LOAGRep_LOAGRep :: (A.Array Int [Int]),ofld_LOAGRep_LOAGRep :: (A.Array Int Int),fty_LOAGRep_LOAGRep :: FTY,fieldMap_LOAGRep_LOAGRep :: FMap,fsInP_LOAGRep_LOAGRep :: (Map.Map PLabel [(PLabel,FLabel)])} +-- MySegment --------------------------------------------------- +{- + visit 0: + synthesized attribute: + self : MySegment + alternatives: + alternative MySegment: + child visnr : {Int} + child inhAttr : {[Int]} + child synAttr : {[Int]} + child inhOccs : {Maybe [Int]} + child synOccs : {Maybe [Int]} + visit 0: + local self : _ +-} +data MySegment = MySegment {visnr_MySegment_MySegment :: Int,inhAttr_MySegment_MySegment :: ([Int]),synAttr_MySegment_MySegment :: ([Int]),inhOccs_MySegment_MySegment :: (Maybe [Int]),synOccs_MySegment_MySegment :: (Maybe [Int])} + deriving ( Show) +-- MySegments -------------------------------------------------- +{- + visit 0: + synthesized attribute: + self : MySegments + alternatives: + alternative Cons: + child hd : MySegment + child tl : MySegments + visit 0: + local self : _ + alternative Nil: + visit 0: + local self : _ +-} +type MySegments = [MySegment] diff --git a/src-generated/Macro.hs b/src-generated/Macro.hs --- a/src-generated/Macro.hs +++ b/src-generated/Macro.hs @@ -1,8 +1,8 @@ --- UUAGC 0.9.50 (src-ag/Macro.ag) +-- UUAGC 0.9.51 (src-ag/Macro.ag) module Macro where -{-# LINE 4 "./src-ag/Macro.ag" #-} +{-# LINE 4 "src-ag/Macro.ag" #-} import CommonTypes {-# LINE 9 "dist/build/Macro.hs" #-} diff --git a/src-generated/Order.hs b/src-generated/Order.hs --- a/src-generated/Order.hs +++ b/src-generated/Order.hs @@ -2,7 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} module Order where -{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} +{-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) @@ -14,20 +14,20 @@ import ErrorMessages {-# LINE 16 "dist/build/Order.hs" #-} -{-# LINE 2 "./src-ag/Expression.ag" #-} +{-# 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" #-} +{-# 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" #-} +{-# LINE 10 "src-ag/Order.ag" #-} -- From uuagc import CommonTypes @@ -65,7 +65,7 @@ {-# LINE 66 "dist/build/Order.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 46 "./src-ag/Order.ag" #-} +{-# 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 @@ -77,26 +77,26 @@ = 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" #-} +{-# 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" #-} +{-# 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" #-} +{-# 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" #-} +{-# LINE 239 "src-ag/Order.ag" #-} substSelf nt tp = case tp of @@ -107,7 +107,7 @@ haskellTupel ts = Just ( Haskell ( '(' : (concat (intersperse "," (map show ts))) ++ ")" )) {-# LINE 109 "dist/build/Order.hs" #-} -{-# LINE 692 "./src-ag/Order.ag" #-} +{-# LINE 692 "src-ag/Order.ag" #-} swap (a,b) = (b,a) @@ -235,8 +235,8 @@ 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 arg = 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 arg) + 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) ) @@ -294,100 +294,100 @@ in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 19 "src-ag/DistChildAttr.ag" #-} rule0 = \ name_ tp_ -> - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 23 "src-ag/DistChildAttr.ag" #-} rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 24 "src-ag/DistChildAttr.ag" #-} rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 180 "src-ag/Order.ag" #-} rule3 = \ _syn tp_ -> - {-# LINE 180 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 183 "src-ag/Order.ag" #-} rule4 = \ _maptolocal _syn name_ -> - {-# LINE 183 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 198 "src-ag/Order.ag" #-} rule5 = \ name_ tp_ -> - {-# LINE 198 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 199 "src-ag/Order.ag" #-} rule6 = \ _inh name_ -> - {-# LINE 199 "./src-ag/Order.ag" #-} + {-# LINE 199 "src-ag/Order.ag" #-} Seq.singleton (name_,_inh ) {-# LINE 345 "dist/build/Order.hs"#-} {-# INLINE rule7 #-} - {-# LINE 215 "./src-ag/Order.ag" #-} + {-# LINE 215 "src-ag/Order.ag" #-} rule7 = \ ((_lhsIcon) :: Identifier) ((_lhsInt) :: Identifier) _maptolocal _syn name_ tp_ -> - {-# LINE 215 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 347 "src-ag/Order.ag" #-} rule8 = \ _syn name_ -> - {-# LINE 347 "./src-ag/Order.ag" #-} + {-# LINE 347 "src-ag/Order.ag" #-} Map.singleton name_ _syn {-# LINE 359 "dist/build/Order.hs"#-} {-# INLINE rule9 #-} - {-# LINE 348 "./src-ag/Order.ag" #-} + {-# LINE 348 "src-ag/Order.ag" #-} rule9 = \ _inh name_ -> - {-# LINE 348 "./src-ag/Order.ag" #-} + {-# LINE 348 "src-ag/Order.ag" #-} Map.singleton name_ _inh {-# LINE 365 "dist/build/Order.hs"#-} {-# INLINE rule10 #-} - {-# LINE 618 "./src-ag/Order.ag" #-} + {-# LINE 618 "src-ag/Order.ag" #-} rule10 = \ _inh _maptolocal _syn name_ tp_ -> - {-# LINE 618 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 643 "src-ag/Order.ag" #-} rule11 = \ _maptolocal name_ -> - {-# LINE 643 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 672 "src-ag/Order.ag" #-} rule12 = \ _inh _syn name_ -> - {-# LINE 672 "./src-ag/Order.ag" #-} + {-# LINE 672 "src-ag/Order.ag" #-} [(name_, _inh , _syn )] {-# LINE 387 "dist/build/Order.hs"#-} {-# INLINE rule13 #-} - {-# LINE 676 "./src-ag/Order.ag" #-} + {-# LINE 676 "src-ag/Order.ag" #-} rule13 = \ kind_ name_ tp_ -> - {-# LINE 676 "./src-ag/Order.ag" #-} + {-# LINE 676 "src-ag/Order.ag" #-} (name_, tp_, kind_) {-# LINE 393 "dist/build/Order.hs"#-} {-# INLINE rule14 #-} @@ -406,8 +406,8 @@ 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 arg = 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 arg) + 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) ) @@ -486,9 +486,9 @@ in __result_ ) in C_Children_s5 v4 {-# INLINE rule16 #-} - {-# LINE 679 "./src-ag/Order.ag" #-} + {-# LINE 679 "src-ag/Order.ag" #-} rule16 = \ ((_hdIfield) :: (Identifier,Type,ChildKind)) ((_tlIfields) :: [(Identifier,Type,ChildKind)]) -> - {-# LINE 679 "./src-ag/Order.ag" #-} + {-# LINE 679 "src-ag/Order.ag" #-} _hdIfield : _tlIfields {-# LINE 494 "dist/build/Order.hs"#-} {-# INLINE rule17 #-} @@ -620,9 +620,9 @@ in __result_ ) in C_Children_s5 v4 {-# INLINE rule49 #-} - {-# LINE 680 "./src-ag/Order.ag" #-} + {-# LINE 680 "src-ag/Order.ag" #-} rule49 = \ (_ :: ()) -> - {-# LINE 680 "./src-ag/Order.ag" #-} + {-# LINE 680 "src-ag/Order.ag" #-} [] {-# LINE 628 "dist/build/Order.hs"#-} {-# INLINE rule50 #-} @@ -665,8 +665,8 @@ wrap_Expression (T_Expression act) (Inh_Expression _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = 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 arg) + 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) ) @@ -713,9 +713,9 @@ in __result_ ) in C_Expression_s8 v7 {-# INLINE rule60 #-} - {-# LINE 469 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# 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 @@ -740,15 +740,15 @@ in (textLines,usedAttrs',usedLocals,usedFields) {-# LINE 742 "dist/build/Order.hs"#-} {-# INLINE rule61 #-} - {-# LINE 492 "./src-ag/Order.ag" #-} + {-# LINE 492 "src-ag/Order.ag" #-} rule61 = \ (_ :: ()) -> - {-# LINE 492 "./src-ag/Order.ag" #-} + {-# LINE 492 "src-ag/Order.ag" #-} Seq.empty {-# LINE 748 "dist/build/Order.hs"#-} {-# INLINE rule62 #-} - {-# LINE 493 "./src-ag/Order.ag" #-} + {-# LINE 493 "src-ag/Order.ag" #-} rule62 = \ _usedAttrs _usedFields _usedLocals -> - {-# LINE 493 "./src-ag/Order.ag" #-} + {-# LINE 493 "src-ag/Order.ag" #-} Set.fromList _usedAttrs `Set.union` Set.fromList [ (_LOC, l) | l <- _usedLocals ] @@ -783,8 +783,8 @@ wrap_Grammar (T_Grammar act) (Inh_Grammar _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Grammar_vIn10 _lhsIoptions - (T_Grammar_vOut10 _lhsOerrors _lhsOnAutoRules _lhsOnExplicitRules _lhsOoutput) <- return (inv_Grammar_s11 sem arg) + 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) ) @@ -861,169 +861,169 @@ in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule69 #-} - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 15 "src-ag/DistChildAttr.ag" #-} rule69 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 15 "src-ag/DistChildAttr.ag" #-} _nontsIinhMap' {-# LINE 869 "dist/build/Order.hs"#-} {-# INLINE rule70 #-} - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 16 "src-ag/DistChildAttr.ag" #-} rule70 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 16 "src-ag/DistChildAttr.ag" #-} _nontsIsynMap' {-# LINE 875 "dist/build/Order.hs"#-} {-# INLINE rule71 #-} - {-# LINE 123 "./src-ag/Order.ag" #-} + {-# LINE 123 "src-ag/Order.ag" #-} rule71 = \ _cyclesErrors ((_lhsIoptions) :: Options) -> - {-# LINE 123 "./src-ag/Order.ag" #-} + {-# LINE 123 "src-ag/Order.ag" #-} visit _lhsIoptions && null _cyclesErrors {-# LINE 881 "dist/build/Order.hs"#-} {-# INLINE rule72 #-} - {-# LINE 124 "./src-ag/Order.ag" #-} + {-# LINE 124 "src-ag/Order.ag" #-} rule72 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 124 "./src-ag/Order.ag" #-} + {-# LINE 124 "src-ag/Order.ag" #-} folds _lhsIoptions {-# LINE 887 "dist/build/Order.hs"#-} {-# INLINE rule73 #-} - {-# LINE 125 "./src-ag/Order.ag" #-} + {-# LINE 125 "src-ag/Order.ag" #-} rule73 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 125 "./src-ag/Order.ag" #-} + {-# LINE 125 "src-ag/Order.ag" #-} dataTypes _lhsIoptions {-# LINE 893 "dist/build/Order.hs"#-} {-# INLINE rule74 #-} - {-# LINE 126 "./src-ag/Order.ag" #-} + {-# LINE 126 "src-ag/Order.ag" #-} rule74 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 126 "./src-ag/Order.ag" #-} + {-# LINE 126 "src-ag/Order.ag" #-} typeSigs _lhsIoptions {-# LINE 899 "dist/build/Order.hs"#-} {-# INLINE rule75 #-} - {-# LINE 127 "./src-ag/Order.ag" #-} + {-# LINE 127 "src-ag/Order.ag" #-} rule75 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 127 "./src-ag/Order.ag" #-} + {-# LINE 127 "src-ag/Order.ag" #-} semfuns _lhsIoptions {-# LINE 905 "dist/build/Order.hs"#-} {-# INLINE rule76 #-} - {-# LINE 128 "./src-ag/Order.ag" #-} + {-# LINE 128 "src-ag/Order.ag" #-} rule76 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 128 "./src-ag/Order.ag" #-} + {-# LINE 128 "src-ag/Order.ag" #-} rename _lhsIoptions {-# LINE 911 "dist/build/Order.hs"#-} {-# INLINE rule77 #-} - {-# LINE 129 "./src-ag/Order.ag" #-} + {-# LINE 129 "src-ag/Order.ag" #-} rule77 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 129 "./src-ag/Order.ag" #-} + {-# LINE 129 "src-ag/Order.ag" #-} newtypes _lhsIoptions {-# LINE 917 "dist/build/Order.hs"#-} {-# INLINE rule78 #-} - {-# LINE 130 "./src-ag/Order.ag" #-} + {-# LINE 130 "src-ag/Order.ag" #-} rule78 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 130 "./src-ag/Order.ag" #-} + {-# LINE 130 "src-ag/Order.ag" #-} visit _lhsIoptions {-# LINE 923 "dist/build/Order.hs"#-} {-# INLINE rule79 #-} - {-# LINE 131 "./src-ag/Order.ag" #-} + {-# LINE 131 "src-ag/Order.ag" #-} rule79 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 131 "./src-ag/Order.ag" #-} + {-# LINE 131 "src-ag/Order.ag" #-} unbox _lhsIoptions {-# LINE 929 "dist/build/Order.hs"#-} {-# INLINE rule80 #-} - {-# LINE 132 "./src-ag/Order.ag" #-} + {-# LINE 132 "src-ag/Order.ag" #-} rule80 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 132 "./src-ag/Order.ag" #-} + {-# LINE 132 "src-ag/Order.ag" #-} cases _lhsIoptions {-# LINE 935 "dist/build/Order.hs"#-} {-# INLINE rule81 #-} - {-# LINE 133 "./src-ag/Order.ag" #-} + {-# LINE 133 "src-ag/Order.ag" #-} rule81 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 133 "./src-ag/Order.ag" #-} + {-# LINE 133 "src-ag/Order.ag" #-} prefix _lhsIoptions {-# LINE 941 "dist/build/Order.hs"#-} {-# INLINE rule82 #-} - {-# LINE 262 "./src-ag/Order.ag" #-} + {-# LINE 262 "src-ag/Order.ag" #-} rule82 = \ (_ :: ()) -> - {-# LINE 262 "./src-ag/Order.ag" #-} + {-# LINE 262 "src-ag/Order.ag" #-} 0 {-# LINE 947 "dist/build/Order.hs"#-} {-# INLINE rule83 #-} - {-# LINE 288 "./src-ag/Order.ag" #-} + {-# LINE 288 "src-ag/Order.ag" #-} rule83 = \ manualAttrOrderMap_ -> - {-# LINE 288 "./src-ag/Order.ag" #-} + {-# LINE 288 "src-ag/Order.ag" #-} manualAttrOrderMap_ {-# LINE 953 "dist/build/Order.hs"#-} {-# INLINE rule84 #-} - {-# LINE 417 "./src-ag/Order.ag" #-} + {-# LINE 417 "src-ag/Order.ag" #-} rule84 = \ aroundsMap_ -> - {-# LINE 417 "./src-ag/Order.ag" #-} + {-# LINE 417 "src-ag/Order.ag" #-} aroundsMap_ {-# LINE 959 "dist/build/Order.hs"#-} {-# INLINE rule85 #-} - {-# LINE 508 "./src-ag/Order.ag" #-} + {-# LINE 508 "src-ag/Order.ag" #-} rule85 = \ (_ :: ()) -> - {-# LINE 508 "./src-ag/Order.ag" #-} + {-# LINE 508 "src-ag/Order.ag" #-} 0 {-# LINE 965 "dist/build/Order.hs"#-} {-# INLINE rule86 #-} - {-# LINE 546 "./src-ag/Order.ag" #-} + {-# LINE 546 "src-ag/Order.ag" #-} rule86 = \ ((_nontsIrules) :: Seq (Vertex,CRule)) ((_nontsIvcount) :: Int) -> - {-# LINE 546 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 547 "src-ag/Order.ag" #-} rule87 = \ ((_nontsIacount) :: Int) ((_nontsIntattrs) :: Seq (Vertex,NTAttr)) -> - {-# LINE 547 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 548 "src-ag/Order.ag" #-} rule88 = \ ((_nontsIntattrs) :: Seq (Vertex,NTAttr)) -> - {-# LINE 548 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 549 "src-ag/Order.ag" #-} rule89 = \ _attrVertex ((_nontsIrules) :: Seq (Vertex,CRule)) -> - {-# LINE 549 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 551 "src-ag/Order.ag" #-} rule90 = \ _tdpToTds -> - {-# LINE 551 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 555 "src-ag/Order.ag" #-} rule91 = \ ((_nontsIadditionalDep) :: Seq Edge) ((_nontsIdirectDep) :: Seq Edge) -> - {-# LINE 555 "./src-ag/Order.ag" #-} + {-# LINE 555 "src-ag/Order.ag" #-} toList (_nontsIdirectDep Seq.>< _nontsIadditionalDep) {-# LINE 1005 "dist/build/Order.hs"#-} {-# INLINE rule92 #-} - {-# LINE 556 "./src-ag/Order.ag" #-} + {-# LINE 556 "src-ag/Order.ag" #-} rule92 = \ ((_nontsIinstDep) :: Seq Edge) -> - {-# LINE 556 "./src-ag/Order.ag" #-} + {-# LINE 556 "src-ag/Order.ag" #-} toList _nontsIinstDep {-# LINE 1011 "dist/build/Order.hs"#-} {-# INLINE rule93 #-} - {-# LINE 557 "./src-ag/Order.ag" #-} + {-# LINE 557 "src-ag/Order.ag" #-} rule93 = \ ((_nontsIaroundDep) :: Seq Edge) -> - {-# LINE 557 "./src-ag/Order.ag" #-} + {-# LINE 557 "src-ag/Order.ag" #-} toList _nontsIaroundDep {-# LINE 1017 "dist/build/Order.hs"#-} {-# INLINE rule94 #-} - {-# LINE 558 "./src-ag/Order.ag" #-} + {-# LINE 558 "src-ag/Order.ag" #-} rule94 = \ ((_nontsImergeDep) :: Seq Edge) -> - {-# LINE 558 "./src-ag/Order.ag" #-} + {-# LINE 558 "src-ag/Order.ag" #-} toList _nontsImergeDep {-# LINE 1023 "dist/build/Order.hs"#-} {-# INLINE rule95 #-} - {-# LINE 559 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 559 "src-ag/Order.ag" #-} let def [] = -1 def (v:vs) = v in Info { tdsToTdp = Array.array (0,_nontsIacount-1) _tdsToTdp @@ -1036,9 +1036,9 @@ } {-# LINE 1038 "dist/build/Order.hs"#-} {-# INLINE rule96 #-} - {-# LINE 571 "./src-ag/Order.ag" #-} + {-# LINE 571 "src-ag/Order.ag" #-} rule96 = \ _aroundDep _attrTable _directDep _info _instDep ((_lhsIoptions) :: Options) _mergeDep _ruleTable -> - {-# LINE 571 "./src-ag/Order.ag" #-} + {-# LINE 571 "src-ag/Order.ag" #-} case computeSequential _info _directDep (_instDep ++ _aroundDep ++ _mergeDep ) of CycleFree cim cvm -> ( cim , cvm @@ -1062,34 +1062,34 @@ ) {-# LINE 1064 "dist/build/Order.hs"#-} {-# INLINE rule97 #-} - {-# LINE 592 "./src-ag/Order.ag" #-} + {-# LINE 592 "src-ag/Order.ag" #-} rule97 = \ _cyclesErrors ((_lhsIoptions) :: Options) ((_nontsIerrors) :: Seq Error) -> - {-# LINE 592 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 637 "src-ag/Order.ag" #-} rule99 = \ aroundsMap_ -> - {-# LINE 637 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 638 "src-ag/Order.ag" #-} rule100 = \ mergeMap_ -> - {-# LINE 638 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 655 "src-ag/Order.ag" #-} rule101 = \ ((_nontsInonts) :: [(NontermIdent,[ConstructorIdent])]) -> - {-# LINE 655 "./src-ag/Order.ag" #-} + {-# LINE 655 "src-ag/Order.ag" #-} map fst (_nontsInonts) {-# LINE 1095 "dist/build/Order.hs"#-} {-# INLINE rule102 #-} @@ -1123,8 +1123,8 @@ 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 arg = 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 arg) + 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) ) @@ -1217,93 +1217,93 @@ in __result_ ) in C_Nonterminal_s14 v13 {-# INLINE rule109 #-} - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 7 "src-ag/DistChildAttr.ag" #-} rule109 = \ inh_ nt_ -> - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 7 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ inh_ {-# LINE 1225 "dist/build/Order.hs"#-} {-# INLINE rule110 #-} - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 8 "src-ag/DistChildAttr.ag" #-} rule110 = \ nt_ syn_ -> - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 8 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ syn_ {-# LINE 1231 "dist/build/Order.hs"#-} {-# INLINE rule111 #-} - {-# LINE 97 "./src-ag/Order.ag" #-} + {-# LINE 97 "src-ag/Order.ag" #-} rule111 = \ nt_ -> - {-# LINE 97 "./src-ag/Order.ag" #-} + {-# LINE 97 "src-ag/Order.ag" #-} nt_ {-# LINE 1237 "dist/build/Order.hs"#-} {-# INLINE rule112 #-} - {-# LINE 100 "./src-ag/Order.ag" #-} + {-# LINE 100 "src-ag/Order.ag" #-} rule112 = \ inh_ -> - {-# LINE 100 "./src-ag/Order.ag" #-} + {-# LINE 100 "src-ag/Order.ag" #-} inh_ {-# LINE 1243 "dist/build/Order.hs"#-} {-# INLINE rule113 #-} - {-# LINE 101 "./src-ag/Order.ag" #-} + {-# LINE 101 "src-ag/Order.ag" #-} rule113 = \ syn_ -> - {-# LINE 101 "./src-ag/Order.ag" #-} + {-# LINE 101 "src-ag/Order.ag" #-} syn_ {-# LINE 1249 "dist/build/Order.hs"#-} {-# INLINE rule114 #-} - {-# LINE 360 "./src-ag/Order.ag" #-} + {-# LINE 360 "src-ag/Order.ag" #-} rule114 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) nt_ -> - {-# LINE 360 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 413 "src-ag/Order.ag" #-} rule115 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) nt_ -> - {-# LINE 413 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 511 "src-ag/Order.ag" #-} rule116 = \ inh_ nt_ syn_ -> - {-# LINE 511 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 513 "src-ag/Order.ag" #-} rule117 = \ ((_lhsIacount) :: Int) _ntattrs -> - {-# LINE 513 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 514 "src-ag/Order.ag" #-} rule118 = \ ((_lhsIacount) :: Int) inh_ syn_ -> - {-# LINE 514 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 515 "src-ag/Order.ag" #-} rule119 = \ ((_lhsIacount) :: Int) inh_ syn_ -> - {-# LINE 515 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 524 "src-ag/Order.ag" #-} rule120 = \ ((_prodsIcons) :: [ConstructorIdent]) nt_ -> - {-# LINE 524 "./src-ag/Order.ag" #-} + {-# LINE 524 "src-ag/Order.ag" #-} [(nt_,_prodsIcons)] {-# LINE 1295 "dist/build/Order.hs"#-} {-# INLINE rule121 #-} - {-# LINE 601 "./src-ag/Order.ag" #-} + {-# LINE 601 "src-ag/Order.ag" #-} rule121 = \ ((_lhsIcInterfaceMap) :: CInterfaceMap) ((_lhsIo_dovisit) :: Bool) inh_ nt_ syn_ -> - {-# LINE 601 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 629 "src-ag/Order.ag" #-} rule122 = \ _cInter ((_prodsIcProductions) :: CProductions) inh_ nt_ params_ syn_ -> - {-# LINE 629 "./src-ag/Order.ag" #-} + {-# LINE 629 "src-ag/Order.ag" #-} CNonterminal nt_ params_ inh_ syn_ _prodsIcProductions _cInter {-# LINE 1309 "dist/build/Order.hs"#-} {-# INLINE rule123 #-} @@ -1403,8 +1403,8 @@ 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 arg = 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 arg) + 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) ) @@ -1517,9 +1517,9 @@ in __result_ ) in C_Nonterminals_s17 v16 {-# INLINE rule152 #-} - {-# LINE 626 "./src-ag/Order.ag" #-} + {-# LINE 626 "src-ag/Order.ag" #-} rule152 = \ ((_hdIcNonterminal) :: CNonterminal) ((_tlIcNonterminals) :: CNonterminals) -> - {-# LINE 626 "./src-ag/Order.ag" #-} + {-# LINE 626 "src-ag/Order.ag" #-} _hdIcNonterminal : _tlIcNonterminals {-# LINE 1525 "dist/build/Order.hs"#-} {-# INLINE rule153 #-} @@ -1747,9 +1747,9 @@ in __result_ ) in C_Nonterminals_s17 v16 {-# INLINE rule213 #-} - {-# LINE 627 "./src-ag/Order.ag" #-} + {-# LINE 627 "src-ag/Order.ag" #-} rule213 = \ (_ :: ()) -> - {-# LINE 627 "./src-ag/Order.ag" #-} + {-# LINE 627 "src-ag/Order.ag" #-} [] {-# LINE 1755 "dist/build/Order.hs"#-} {-# INLINE rule214 #-} @@ -1810,8 +1810,8 @@ wrap_Pattern (T_Pattern act) (Inh_Pattern _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Pattern_vIn19 _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn - (T_Pattern_vOut19 _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs) <- return (inv_Pattern_s20 sem arg) + 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) ) @@ -2007,29 +2007,29 @@ in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule256 #-} - {-# LINE 187 "./src-ag/Order.ag" #-} + {-# LINE 187 "src-ag/Order.ag" #-} rule256 = \ attr_ field_ -> - {-# LINE 187 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 253 "src-ag/Order.ag" #-} rule257 = \ attr_ field_ -> - {-# LINE 253 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 685 "src-ag/Order.ag" #-} rule258 = \ attr_ field_ -> - {-# LINE 685 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 688 "src-ag/Order.ag" #-} rule259 = \ attr_ field_ -> - {-# LINE 688 "./src-ag/Order.ag" #-} + {-# LINE 688 "src-ag/Order.ag" #-} if field_ == _INST then [attr_] else [] @@ -2185,8 +2185,8 @@ wrap_Patterns (T_Patterns act) (Inh_Patterns _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Patterns_vIn22 _lhsIallTypeSigs _lhsIaltAttrs _lhsIcon _lhsIinh _lhsInt _lhsIsyn - (T_Patterns_vOut22 _lhsOcopy _lhsOerrors _lhsOgathAltAttrs _lhsOinstVars _lhsOlocVars _lhsOpatternAttrs) <- return (inv_Patterns_s23 sem arg) + 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) ) @@ -2356,8 +2356,8 @@ 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 arg = 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 arg) + 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) ) @@ -2470,77 +2470,77 @@ in __result_ ) in C_Production_s26 v25 {-# INLINE rule315 #-} - {-# LINE 93 "./src-ag/Order.ag" #-} + {-# LINE 93 "src-ag/Order.ag" #-} rule315 = \ con_ -> - {-# LINE 93 "./src-ag/Order.ag" #-} + {-# LINE 93 "src-ag/Order.ag" #-} con_ {-# LINE 2478 "dist/build/Order.hs"#-} {-# INLINE rule316 #-} - {-# LINE 95 "./src-ag/Order.ag" #-} + {-# LINE 95 "src-ag/Order.ag" #-} rule316 = \ con_ -> - {-# LINE 95 "./src-ag/Order.ag" #-} + {-# LINE 95 "src-ag/Order.ag" #-} con_ {-# LINE 2484 "dist/build/Order.hs"#-} {-# INLINE rule317 #-} - {-# LINE 175 "./src-ag/Order.ag" #-} + {-# LINE 175 "src-ag/Order.ag" #-} rule317 = \ ((_childrenIgathAltAttrs) :: [AltAttr]) ((_lhsIinh) :: Attributes) ((_rulesIgathAltAttrs) :: [AltAttr]) -> - {-# LINE 175 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 191 "src-ag/Order.ag" #-} rule318 = \ _gathAltAttrs ((_lhsIvcount) :: Int) -> - {-# LINE 191 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 204 "src-ag/Order.ag" #-} rule319 = \ ((_childrenInts) :: Seq (Identifier,NontermIdent)) -> - {-# LINE 204 "./src-ag/Order.ag" #-} + {-# LINE 204 "src-ag/Order.ag" #-} Map.fromList (toList _childrenInts) {-# LINE 2504 "dist/build/Order.hs"#-} {-# INLINE rule320 #-} - {-# LINE 205 "./src-ag/Order.ag" #-} + {-# LINE 205 "src-ag/Order.ag" #-} rule320 = \ ((_childrenIinhs) :: Seq (Identifier,Attributes)) -> - {-# LINE 205 "./src-ag/Order.ag" #-} + {-# LINE 205 "src-ag/Order.ag" #-} Map.fromList (toList _childrenIinhs) {-# LINE 2510 "dist/build/Order.hs"#-} {-# INLINE rule321 #-} - {-# LINE 211 "./src-ag/Order.ag" #-} + {-# LINE 211 "src-ag/Order.ag" #-} rule321 = \ ((_lhsIinh) :: Attributes) ((_lhsInt) :: Identifier) con_ -> - {-# LINE 211 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 212 "src-ag/Order.ag" #-} rule322 = \ ((_childrenIgathRules) :: Seq CRule) _inhRules ((_rulesIgathRules) :: Seq CRule) -> - {-# LINE 212 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 264 "src-ag/Order.ag" #-} rule323 = \ _gathRules ((_lhsIvcount) :: Int) -> - {-# LINE 264 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 265 "src-ag/Order.ag" #-} rule324 = \ _gathRules ((_lhsIvcount) :: Int) -> - {-# LINE 265 "./src-ag/Order.ag" #-} + {-# LINE 265 "src-ag/Order.ag" #-} _lhsIvcount + length _gathRules {-# LINE 2534 "dist/build/Order.hs"#-} {-# INLINE rule325 #-} - {-# LINE 293 "./src-ag/Order.ag" #-} + {-# LINE 293 "src-ag/Order.ag" #-} rule325 = \ ((_lhsImanualAttrDepMap) :: AttrOrderMap) ((_lhsInt) :: Identifier) con_ -> - {-# LINE 293 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 296 "src-ag/Order.ag" #-} rule326 = \ _altAttrs _manualDeps -> - {-# LINE 296 "./src-ag/Order.ag" #-} + {-# LINE 296 "src-ag/Order.ag" #-} Seq.fromList [ (vertex True occA, vertex False occB) | Dependency occA occB <- _manualDeps , let vertex inout (OccAttr child nm) @@ -2551,33 +2551,33 @@ ] {-# LINE 2553 "dist/build/Order.hs"#-} {-# INLINE rule327 #-} - {-# LINE 342 "./src-ag/Order.ag" #-} + {-# LINE 342 "src-ag/Order.ag" #-} rule327 = \ ((_childrenIcollectChildrenSyns) :: Map Identifier Attributes ) -> - {-# LINE 342 "./src-ag/Order.ag" #-} + {-# LINE 342 "src-ag/Order.ag" #-} _childrenIcollectChildrenSyns {-# LINE 2559 "dist/build/Order.hs"#-} {-# INLINE rule328 #-} - {-# LINE 343 "./src-ag/Order.ag" #-} + {-# LINE 343 "src-ag/Order.ag" #-} rule328 = \ ((_childrenIcollectChildrenInhs) :: Map Identifier Attributes ) -> - {-# LINE 343 "./src-ag/Order.ag" #-} + {-# LINE 343 "src-ag/Order.ag" #-} _childrenIcollectChildrenInhs {-# LINE 2565 "dist/build/Order.hs"#-} {-# INLINE rule329 #-} - {-# LINE 361 "./src-ag/Order.ag" #-} + {-# LINE 361 "src-ag/Order.ag" #-} rule329 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) con_ -> - {-# LINE 361 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 372 "src-ag/Order.ag" #-} rule330 = \ _mergeDep1 _mergeDep2 -> - {-# LINE 372 "./src-ag/Order.ag" #-} + {-# LINE 372 "src-ag/Order.ag" #-} _mergeDep1 Seq.>< _mergeDep2 {-# LINE 2577 "dist/build/Order.hs"#-} {-# INLINE rule331 #-} - {-# LINE 374 "./src-ag/Order.ag" #-} + {-# LINE 374 "src-ag/Order.ag" #-} rule331 = \ _altAttrs ((_childrenIcollectChildrenSyns) :: Map Identifier Attributes ) _mergeMap -> - {-# LINE 374 "./src-ag/Order.ag" #-} + {-# LINE 374 "src-ag/Order.ag" #-} Seq.fromList $ [ (childVert, synVert) | childNm <- Map.keys _mergeMap @@ -2590,9 +2590,9 @@ ] {-# LINE 2592 "dist/build/Order.hs"#-} {-# INLINE rule332 #-} - {-# LINE 385 "./src-ag/Order.ag" #-} + {-# LINE 385 "src-ag/Order.ag" #-} rule332 = \ _altAttrs ((_childrenIcollectChildrenSyns) :: Map Identifier Attributes ) _mergeMap -> - {-# LINE 385 "./src-ag/Order.ag" #-} + {-# LINE 385 "src-ag/Order.ag" #-} Seq.fromList $ [ (mergedVert, sourceVert) | (childNm, (_,cs)) <- Map.assocs _mergeMap @@ -2605,15 +2605,15 @@ ] {-# LINE 2607 "dist/build/Order.hs"#-} {-# INLINE rule333 #-} - {-# LINE 414 "./src-ag/Order.ag" #-} + {-# LINE 414 "src-ag/Order.ag" #-} rule333 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Map Identifier [Expression])) con_ -> - {-# LINE 414 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 422 "src-ag/Order.ag" #-} rule334 = \ _altAttrs _aroundMap ((_childrenIcollectChildrenSyns) :: Map Identifier Attributes ) -> - {-# LINE 422 "./src-ag/Order.ag" #-} + {-# LINE 422 "src-ag/Order.ag" #-} Seq.fromList $ [ (childVert, synVert) | childNm <- Map.keys _aroundMap @@ -2626,9 +2626,9 @@ ] {-# LINE 2628 "dist/build/Order.hs"#-} {-# INLINE rule335 #-} - {-# LINE 433 "./src-ag/Order.ag" #-} + {-# LINE 433 "src-ag/Order.ag" #-} rule335 = \ _altAttrs _aroundMap ((_childrenIcollectChildrenInhs) :: Map Identifier Attributes ) -> - {-# LINE 433 "./src-ag/Order.ag" #-} + {-# LINE 433 "src-ag/Order.ag" #-} Seq.fromList $ [ (childVert, inhVert) | childNm <- Map.keys _aroundMap @@ -2641,33 +2641,33 @@ ] {-# LINE 2643 "dist/build/Order.hs"#-} {-# INLINE rule336 #-} - {-# LINE 443 "./src-ag/Order.ag" #-} + {-# LINE 443 "src-ag/Order.ag" #-} rule336 = \ _aroundDep1 _aroundDep2 -> - {-# LINE 443 "./src-ag/Order.ag" #-} + {-# LINE 443 "src-ag/Order.ag" #-} _aroundDep1 Seq.>< _aroundDep2 {-# LINE 2649 "dist/build/Order.hs"#-} {-# INLINE rule337 #-} - {-# LINE 527 "./src-ag/Order.ag" #-} + {-# LINE 527 "src-ag/Order.ag" #-} rule337 = \ con_ -> - {-# LINE 527 "./src-ag/Order.ag" #-} + {-# LINE 527 "src-ag/Order.ag" #-} [con_] {-# LINE 2655 "dist/build/Order.hs"#-} {-# INLINE rule338 #-} - {-# LINE 534 "./src-ag/Order.ag" #-} + {-# LINE 534 "src-ag/Order.ag" #-} rule338 = \ (_ :: ()) -> - {-# LINE 534 "./src-ag/Order.ag" #-} + {-# LINE 534 "src-ag/Order.ag" #-} Map.empty {-# LINE 2661 "dist/build/Order.hs"#-} {-# INLINE rule339 #-} - {-# LINE 540 "./src-ag/Order.ag" #-} + {-# LINE 540 "src-ag/Order.ag" #-} rule339 = \ ((_typeSigsItypeSigs) :: Map Identifier Type) -> - {-# LINE 540 "./src-ag/Order.ag" #-} + {-# LINE 540 "src-ag/Order.ag" #-} _typeSigsItypeSigs {-# LINE 2667 "dist/build/Order.hs"#-} {-# INLINE rule340 #-} - {-# LINE 608 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# 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 @@ -2676,36 +2676,36 @@ in [CVisit _lhsIinh _lhsIsyn vss [] False] {-# LINE 2678 "dist/build/Order.hs"#-} {-# INLINE rule341 #-} - {-# LINE 634 "./src-ag/Order.ag" #-} + {-# LINE 634 "src-ag/Order.ag" #-} rule341 = \ _cVisits ((_childrenIfields) :: [(Identifier,Type,ChildKind)]) ((_childrenIterminals) :: [Identifier]) con_ -> - {-# LINE 634 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 662 "src-ag/Order.ag" #-} rule342 = \ ((_childrenIfields) :: [(Identifier,Type,ChildKind)]) -> - {-# LINE 662 "./src-ag/Order.ag" #-} + {-# LINE 662 "src-ag/Order.ag" #-} _childrenIfields {-# LINE 2690 "dist/build/Order.hs"#-} {-# INLINE rule343 #-} - {-# LINE 663 "./src-ag/Order.ag" #-} + {-# LINE 663 "src-ag/Order.ag" #-} rule343 = \ ((_childrenIattributes) :: [(Identifier,Attributes,Attributes)]) _inhnames ((_rulesIinstVars) :: [Identifier]) ((_rulesIlocVars) :: [Identifier]) -> - {-# LINE 663 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 667 "src-ag/Order.ag" #-} rule344 = \ ((_lhsIinh) :: Attributes) -> - {-# LINE 667 "./src-ag/Order.ag" #-} + {-# LINE 667 "src-ag/Order.ag" #-} Map.keys _lhsIinh {-# LINE 2705 "dist/build/Order.hs"#-} {-# INLINE rule345 #-} - {-# LINE 668 "./src-ag/Order.ag" #-} + {-# LINE 668 "src-ag/Order.ag" #-} rule345 = \ ((_lhsIsyn) :: Attributes) -> - {-# LINE 668 "./src-ag/Order.ag" #-} + {-# LINE 668 "src-ag/Order.ag" #-} Map.keys _lhsIsyn {-# LINE 2711 "dist/build/Order.hs"#-} {-# INLINE rule346 #-} @@ -2817,8 +2817,8 @@ 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 arg = 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 arg) + 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) ) @@ -2921,9 +2921,9 @@ in __result_ ) in C_Productions_s29 v28 {-# INLINE rule379 #-} - {-# LINE 631 "./src-ag/Order.ag" #-} + {-# LINE 631 "src-ag/Order.ag" #-} rule379 = \ ((_hdIcProduction) :: CProduction) ((_tlIcProductions) :: CProductions) -> - {-# LINE 631 "./src-ag/Order.ag" #-} + {-# LINE 631 "src-ag/Order.ag" #-} _hdIcProduction : _tlIcProductions {-# LINE 2929 "dist/build/Order.hs"#-} {-# INLINE rule380 #-} @@ -3126,9 +3126,9 @@ in __result_ ) in C_Productions_s29 v28 {-# INLINE rule435 #-} - {-# LINE 632 "./src-ag/Order.ag" #-} + {-# LINE 632 "src-ag/Order.ag" #-} rule435 = \ (_ :: ()) -> - {-# LINE 632 "./src-ag/Order.ag" #-} + {-# LINE 632 "src-ag/Order.ag" #-} [] {-# LINE 3134 "dist/build/Order.hs"#-} {-# INLINE rule436 #-} @@ -3174,8 +3174,8 @@ 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 arg = 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 arg) + 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) ) @@ -3245,25 +3245,25 @@ in __result_ ) in C_Rule_s32 v31 {-# INLINE rule447 #-} - {-# LINE 64 "./src-ag/Order.ag" #-} + {-# LINE 64 "src-ag/Order.ag" #-} rule447 = \ explicit_ -> - {-# LINE 64 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# LINE 67 "src-ag/Order.ag" #-} rule448 = \ origin_ -> - {-# LINE 67 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 220 "src-ag/Order.ag" #-} let tp field attr | field == _LOC || field == _INST = Map.lookup attr _lhsIallTypeSigs | field == _LHS = Map.lookup attr _lhsIsyn @@ -3278,27 +3278,27 @@ ] {-# LINE 3280 "dist/build/Order.hs"#-} {-# INLINE rule450 #-} - {-# LINE 234 "./src-ag/Order.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 317 "src-ag/Order.ag" #-} rule452 = \ _defines ((_lhsIaltAttrs) :: Map AltAttr Vertex) ((_lhsIsynsOfChildren) :: Map Identifier Attributes) -> - {-# LINE 317 "./src-ag/Order.ag" #-} + {-# LINE 317 "src-ag/Order.ag" #-} Seq.fromList $ [ (instVert, synVert) | (field,instNm,_) <- Map.elems _defines @@ -3311,9 +3311,9 @@ ] {-# LINE 3313 "dist/build/Order.hs"#-} {-# INLINE rule453 #-} - {-# LINE 328 "./src-ag/Order.ag" #-} + {-# LINE 328 "src-ag/Order.ag" #-} rule453 = \ _defines ((_lhsIaltAttrs) :: Map AltAttr Vertex) ((_lhsIinhsOfChildren) :: Map Identifier Attributes) -> - {-# LINE 328 "./src-ag/Order.ag" #-} + {-# LINE 328 "src-ag/Order.ag" #-} Seq.fromList $ [ (instVert, inhVert) | (field,instNm,_) <- Map.elems _defines @@ -3326,9 +3326,9 @@ ] {-# LINE 3328 "dist/build/Order.hs"#-} {-# INLINE rule454 #-} - {-# LINE 338 "./src-ag/Order.ag" #-} + {-# LINE 338 "src-ag/Order.ag" #-} rule454 = \ _instDep1 _instDep2 -> - {-# LINE 338 "./src-ag/Order.ag" #-} + {-# LINE 338 "src-ag/Order.ag" #-} _instDep1 Seq.>< _instDep2 {-# LINE 3334 "dist/build/Order.hs"#-} {-# INLINE rule455 #-} @@ -3395,8 +3395,8 @@ 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 arg = 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 arg) + 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) ) @@ -3732,8 +3732,8 @@ wrap_TypeSig (T_TypeSig act) (Inh_TypeSig _lhsItypeSigs) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_TypeSig_vIn37 _lhsItypeSigs - (T_TypeSig_vOut37 _lhsOtypeSigs) <- return (inv_TypeSig_s38 sem arg) + let arg37 = T_TypeSig_vIn37 _lhsItypeSigs + (T_TypeSig_vOut37 _lhsOtypeSigs) <- return (inv_TypeSig_s38 sem arg37) return (Syn_TypeSig _lhsOtypeSigs) ) @@ -3766,9 +3766,9 @@ in __result_ ) in C_TypeSig_s38 v37 {-# INLINE rule539 #-} - {-# LINE 536 "./src-ag/Order.ag" #-} + {-# LINE 536 "src-ag/Order.ag" #-} rule539 = \ ((_lhsItypeSigs) :: Map Identifier Type) name_ tp_ -> - {-# LINE 536 "./src-ag/Order.ag" #-} + {-# LINE 536 "src-ag/Order.ag" #-} Map.insert name_ tp_ _lhsItypeSigs {-# LINE 3774 "dist/build/Order.hs"#-} @@ -3781,8 +3781,8 @@ wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs _lhsItypeSigs) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_TypeSigs_vIn40 _lhsItypeSigs - (T_TypeSigs_vOut40 _lhsOtypeSigs) <- return (inv_TypeSigs_s41 sem arg) + let arg40 = T_TypeSigs_vIn40 _lhsItypeSigs + (T_TypeSigs_vOut40 _lhsOtypeSigs) <- return (inv_TypeSigs_s41 sem arg40) return (Syn_TypeSigs _lhsOtypeSigs) ) diff --git a/src-generated/Patterns.hs b/src-generated/Patterns.hs --- a/src-generated/Patterns.hs +++ b/src-generated/Patterns.hs @@ -1,8 +1,8 @@ --- UUAGC 0.9.50 (src-ag/Patterns.ag) +-- UUAGC 0.9.51 (src-ag/Patterns.ag) module Patterns where -{-# LINE 2 "./src-ag/Patterns.ag" #-} +{-# LINE 2 "src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) diff --git a/src-generated/PrintCleanCode.hs b/src-generated/PrintCleanCode.hs --- a/src-generated/PrintCleanCode.hs +++ b/src-generated/PrintCleanCode.hs @@ -3,14 +3,14 @@ {-# LANGUAGE ScopedTypeVariables #-} module PrintCleanCode where -{-# LINE 2 "./src-ag/Patterns.ag" #-} +{-# 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" #-} +{-# LINE 2 "src-ag/Code.ag" #-} import Patterns import Data.Set(Set) @@ -19,7 +19,7 @@ import qualified Data.Map as Map {-# LINE 21 "dist/build/PrintCleanCode.hs" #-} -{-# LINE 10 "./src-ag/PrintCleanCode.ag" #-} +{-# LINE 10 "src-ag/PrintCleanCode.ag" #-} import Data.Char (isAlphaNum) import Pretty @@ -34,7 +34,7 @@ {-# LINE 35 "dist/build/PrintCleanCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 146 "./src-ag/Code.ag" #-} +{-# LINE 146 "src-ag/Code.ag" #-} -- Unboxed tuples -- unbox Whether unboxed tuples are wanted or not @@ -53,12 +53,12 @@ | otherwise = UnboxedTupleLhs comps {-# LINE 55 "dist/build/PrintCleanCode.hs" #-} -{-# LINE 23 "./src-ag/PrintCleanCode.ag" #-} +{-# LINE 23 "src-ag/PrintCleanCode.ag" #-} type PP_Docs = [PP_Doc] {-# LINE 60 "dist/build/PrintCleanCode.hs" #-} -{-# LINE 27 "./src-ag/PrintCleanCode.ag" #-} +{-# LINE 27 "src-ag/PrintCleanCode.ag" #-} ppMultiSeqH :: [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeqH = ppMultiSeq' (>#<) @@ -71,7 +71,7 @@ = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs {-# LINE 73 "dist/build/PrintCleanCode.hs" #-} -{-# LINE 322 "./src-ag/PrintCleanCode.ag" #-} +{-# LINE 322 "src-ag/PrintCleanCode.ag" #-} reallySimple :: String -> Bool @@ -88,19 +88,19 @@ {-# LINE 90 "dist/build/PrintCleanCode.hs" #-} -{-# LINE 425 "./src-ag/PrintCleanCode.ag" #-} +{-# 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" #-} +{-# 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" #-} +{-# LINE 548 "src-ag/PrintCleanCode.ag" #-} writeModule :: FilePath -> [PP_Doc] -> IO () writeModule path docs @@ -125,8 +125,8 @@ wrap_CaseAlt !(T_CaseAlt act) !(Inh_CaseAlt _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_CaseAlt_vIn1 _lhsInested _lhsIoptions _lhsIoutputfile - !(T_CaseAlt_vOut1 _lhsOpps) <- return (inv_CaseAlt_s2 sem arg) + let arg1 = T_CaseAlt_vIn1 _lhsInested _lhsIoptions _lhsIoutputfile + !(T_CaseAlt_vOut1 _lhsOpps) <- return (inv_CaseAlt_s2 sem arg1) return (Syn_CaseAlt _lhsOpps) ) @@ -170,15 +170,15 @@ in __result_ ) in C_CaseAlt_s2 v1 {-# INLINE rule0 #-} - {-# LINE 228 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 228 "src-ag/PrintCleanCode.ag" #-} rule0 = \ ((_exprIpp) :: PP_Doc) ((_leftIpp) :: PP_Doc) -> - {-# LINE 228 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 228 "src-ag/PrintCleanCode.ag" #-} ["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"] {-# LINE 178 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule1 #-} - {-# LINE 449 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 449 "src-ag/PrintCleanCode.ag" #-} rule1 = \ (_ :: ()) -> - {-# LINE 449 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 449 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 184 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule2 #-} @@ -209,8 +209,8 @@ wrap_CaseAlts !(T_CaseAlts act) !(Inh_CaseAlts _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_CaseAlts_vIn4 _lhsInested _lhsIoptions _lhsIoutputfile - !(T_CaseAlts_vOut4 _lhsOpps) <- return (inv_CaseAlts_s5 sem arg) + let arg4 = T_CaseAlts_vIn4 _lhsInested _lhsIoptions _lhsIoutputfile + !(T_CaseAlts_vOut4 _lhsOpps) <- return (inv_CaseAlts_s5 sem arg4) return (Syn_CaseAlts _lhsOpps) ) @@ -253,9 +253,9 @@ in __result_ ) in C_CaseAlts_s5 v4 {-# INLINE rule8 #-} - {-# LINE 72 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 72 "src-ag/PrintCleanCode.ag" #-} rule8 = \ ((_hdIpps) :: PP_Docs) ((_tlIpps) :: PP_Docs) -> - {-# LINE 72 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 72 "src-ag/PrintCleanCode.ag" #-} _hdIpps ++ _tlIpps {-# LINE 261 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule9 #-} @@ -289,9 +289,9 @@ in __result_ ) in C_CaseAlts_s5 v4 {-# INLINE rule15 #-} - {-# LINE 73 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 73 "src-ag/PrintCleanCode.ag" #-} rule15 = \ (_ :: ()) -> - {-# LINE 73 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 73 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 297 "dist/build/PrintCleanCode.hs"#-} @@ -304,8 +304,8 @@ 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 arg = 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 arg) + 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) ) @@ -390,17 +390,17 @@ in __result_ ) in C_Chunk_s8 v7 {-# INLINE rule16 #-} - {-# LINE 43 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 43 "src-ag/PrintCleanCode.ag" #-} rule16 = \ ((_lhsImainFile) :: String) ((_lhsIoptions) :: Options) name_ -> - {-# LINE 43 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 104 "src-ag/PrintCleanCode.ag" #-} _commentIpp : _infoIpps ++ _dataDefIpps @@ -411,15 +411,15 @@ ++ [Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap] {-# LINE 413 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule18 #-} - {-# LINE 508 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 508 "src-ag/PrintCleanCode.ag" #-} rule18 = \ ((_lhsImainName) :: String) name_ -> - {-# LINE 508 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 508 "src-ag/PrintCleanCode.ag" #-} ["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"] {-# LINE 419 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule19 #-} - {-# LINE 515 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 515 "src-ag/PrintCleanCode.ag" #-} [ [_commentIpp] , _dataDefIpps , _semDomIpps @@ -427,18 +427,18 @@ ] {-# LINE 429 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule20 #-} - {-# LINE 521 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 521 "src-ag/PrintCleanCode.ag" #-} rule20 = \ ((_cataFunIpps) :: PP_Docs) ((_commentIpp) :: PP_Doc) ((_lhsIoptions) :: Options) ((_semWrapperIpps) :: PP_Docs) -> - {-# LINE 521 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 531 "src-ag/PrintCleanCode.ag" #-} writeModule _outputfile [ pp $ _lhsIpragmaBlocks , pp $ Map.findWithDefault empty (BlockPragma, Just $ identifier name_) _lhsItextBlockMap @@ -453,9 +453,9 @@ ] {-# LINE 455 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule22 #-} - {-# LINE 546 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 546 "src-ag/PrintCleanCode.ag" #-} rule22 = \ semNames_ -> - {-# LINE 546 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 546 "src-ag/PrintCleanCode.ag" #-} concat $ intersperse "," semNames_ {-# LINE 461 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule23 #-} @@ -552,8 +552,8 @@ 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 arg = 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 arg) + 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) ) @@ -620,9 +620,9 @@ in __result_ ) in C_Chunks_s11 v10 {-# INLINE rule51 #-} - {-# LINE 96 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 96 "src-ag/PrintCleanCode.ag" #-} rule51 = \ ((_hdIpps) :: PP_Docs) ((_tlIpps) :: PP_Docs) -> - {-# LINE 96 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 96 "src-ag/PrintCleanCode.ag" #-} _hdIpps ++ _tlIpps {-# LINE 628 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule52 #-} @@ -724,9 +724,9 @@ in __result_ ) in C_Chunks_s11 v10 {-# INLINE rule78 #-} - {-# LINE 97 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 97 "src-ag/PrintCleanCode.ag" #-} rule78 = \ (_ :: ()) -> - {-# LINE 97 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 97 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 732 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule79 #-} @@ -751,8 +751,8 @@ wrap_DataAlt !(T_DataAlt act) !(Inh_DataAlt _lhsInested _lhsIstrictPre) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_DataAlt_vIn13 _lhsInested _lhsIstrictPre - !(T_DataAlt_vOut13 _lhsOpp _lhsOppa) <- return (inv_DataAlt_s14 sem arg) + let arg13 = T_DataAlt_vIn13 _lhsInested _lhsIstrictPre + !(T_DataAlt_vOut13 _lhsOpp _lhsOppa) <- return (inv_DataAlt_s14 sem arg13) return (Syn_DataAlt _lhsOpp _lhsOppa) ) @@ -791,15 +791,15 @@ in __result_ ) in C_DataAlt_s14 v13 {-# INLINE rule83 #-} - {-# LINE 231 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 231 "src-ag/PrintCleanCode.ag" #-} rule83 = \ ((_argsIpps) :: PP_Docs) ((_lhsIstrictPre) :: PP_Doc) name_ -> - {-# LINE 231 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 232 "src-ag/PrintCleanCode.ag" #-} rule84 = \ (_ :: ()) -> - {-# LINE 232 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 232 "src-ag/PrintCleanCode.ag" #-} empty {-# LINE 805 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule85 #-} @@ -823,15 +823,15 @@ in __result_ ) in C_DataAlt_s14 v13 {-# INLINE rule86 #-} - {-# LINE 233 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 233 "src-ag/PrintCleanCode.ag" #-} rule86 = \ ((_argsIpps) :: PP_Docs) ((_lhsIstrictPre) :: PP_Doc) name_ -> - {-# LINE 233 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 234 "src-ag/PrintCleanCode.ag" #-} rule87 = \ ((_argsIppas) :: PP_Docs) name_ -> - {-# LINE 234 "./src-ag/PrintCleanCode.ag" #-} + {-# 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 " _") @@ -850,8 +850,8 @@ wrap_DataAlts !(T_DataAlts act) !(Inh_DataAlts _lhsInested _lhsIstrictPre) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_DataAlts_vIn16 _lhsInested _lhsIstrictPre - !(T_DataAlts_vOut16 _lhsOppas _lhsOpps) <- return (inv_DataAlts_s17 sem arg) + let arg16 = T_DataAlts_vIn16 _lhsInested _lhsIstrictPre + !(T_DataAlts_vOut16 _lhsOppas _lhsOpps) <- return (inv_DataAlts_s17 sem arg16) return (Syn_DataAlts _lhsOppas _lhsOpps) ) @@ -894,15 +894,15 @@ in __result_ ) in C_DataAlts_s17 v16 {-# INLINE rule89 #-} - {-# LINE 76 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 76 "src-ag/PrintCleanCode.ag" #-} rule89 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 76 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 76 "src-ag/PrintCleanCode.ag" #-} _hdIpp : _tlIpps {-# LINE 902 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule90 #-} - {-# LINE 77 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 77 "src-ag/PrintCleanCode.ag" #-} rule90 = \ ((_hdIppa) :: PP_Doc) ((_tlIppas) :: PP_Docs) -> - {-# LINE 77 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 77 "src-ag/PrintCleanCode.ag" #-} _hdIppa : _tlIppas {-# LINE 908 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule91 #-} @@ -932,15 +932,15 @@ in __result_ ) in C_DataAlts_s17 v16 {-# INLINE rule95 #-} - {-# LINE 78 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 78 "src-ag/PrintCleanCode.ag" #-} rule95 = \ (_ :: ()) -> - {-# LINE 78 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 78 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 940 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule96 #-} - {-# LINE 79 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 79 "src-ag/PrintCleanCode.ag" #-} rule96 = \ (_ :: ()) -> - {-# LINE 79 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 79 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 946 "dist/build/PrintCleanCode.hs"#-} @@ -953,8 +953,8 @@ wrap_Decl !(T_Decl act) !(Inh_Decl _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile - !(T_Decl_vOut19 _lhsOpp _lhsOppa) <- return (inv_Decl_s20 sem arg) + 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) ) @@ -1010,9 +1010,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule97 #-} - {-# LINE 114 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 114 "src-ag/PrintCleanCode.ag" #-} rule97 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) -> - {-# LINE 114 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 114 "src-ag/PrintCleanCode.ag" #-} _leftIpp >#< "=" >-< indent 4 _rhsIpp {-# LINE 1019 "dist/build/PrintCleanCode.hs"#-} @@ -1066,9 +1066,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule106 #-} - {-# LINE 116 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 116 "src-ag/PrintCleanCode.ag" #-} rule106 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) -> - {-# LINE 116 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 116 "src-ag/PrintCleanCode.ag" #-} _leftIpp >#< "<-" >#< _rhsIpp {-# LINE 1074 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule107 #-} @@ -1121,9 +1121,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule115 #-} - {-# LINE 117 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 117 "src-ag/PrintCleanCode.ag" #-} rule115 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) -> - {-# LINE 117 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 117 "src-ag/PrintCleanCode.ag" #-} "let" >#< _leftIpp >#< "=" >#< _rhsIpp {-# LINE 1129 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule116 #-} @@ -1169,9 +1169,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule124 #-} - {-# LINE 118 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 118 "src-ag/PrintCleanCode.ag" #-} rule124 = \ ((_altsIppas) :: PP_Docs) ((_altsIpps) :: PP_Docs) derivings_ name_ params_ -> - {-# LINE 118 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 118 "src-ag/PrintCleanCode.ag" #-} "::" >#< hv_sp (name_ : params_) >#< ( case _altsIpps of [] -> empty @@ -1184,9 +1184,9 @@ >-< foldr (>-<) empty _altsIppas {-# LINE 1186 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule125 #-} - {-# LINE 346 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 346 "src-ag/PrintCleanCode.ag" #-} rule125 = \ strict_ -> - {-# LINE 346 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 346 "src-ag/PrintCleanCode.ag" #-} if strict_ then pp "!" else empty {-# LINE 1192 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule126 #-} @@ -1213,9 +1213,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule128 #-} - {-# LINE 129 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 129 "src-ag/PrintCleanCode.ag" #-} rule128 = \ ((_tpIpp) :: PP_Doc) con_ name_ params_ -> - {-# LINE 129 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 129 "src-ag/PrintCleanCode.ag" #-} "::" >#< hv_sp (name_ : params_) >#< "=" >#< con_ >#< pp_parens _tpIpp {-# LINE 1221 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule129 #-} @@ -1242,9 +1242,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule131 #-} - {-# LINE 130 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 130 "src-ag/PrintCleanCode.ag" #-} rule131 = \ ((_tpIpp) :: PP_Doc) name_ params_ -> - {-# LINE 130 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 130 "src-ag/PrintCleanCode.ag" #-} "::" >#< hv_sp (name_ : params_) >#< ":==" >#< _tpIpp {-# LINE 1250 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule132 #-} @@ -1271,9 +1271,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule134 #-} - {-# LINE 131 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 131 "src-ag/PrintCleanCode.ag" #-} rule134 = \ ((_tpIpp) :: PP_Doc) name_ -> - {-# LINE 131 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 131 "src-ag/PrintCleanCode.ag" #-} name_ >#< "::" >#< _tpIpp {-# LINE 1279 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule135 #-} @@ -1297,9 +1297,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule137 #-} - {-# LINE 132 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 132 "src-ag/PrintCleanCode.ag" #-} rule137 = \ txt_ -> - {-# LINE 132 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 132 "src-ag/PrintCleanCode.ag" #-} if '\n' `elem` txt_ then "/*" >-< vlist (lines txt_) >-< "*/" else "//" >#< txt_ @@ -1322,9 +1322,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule139 #-} - {-# LINE 135 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 135 "src-ag/PrintCleanCode.ag" #-} rule139 = \ txt_ -> - {-# LINE 135 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 135 "src-ag/PrintCleanCode.ag" #-} "/*#" >#< text txt_ >#< "#*/" {-# LINE 1330 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule140 #-} @@ -1356,9 +1356,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule141 #-} - {-# LINE 136 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 136 "src-ag/PrintCleanCode.ag" #-} rule141 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) monadic_ -> - {-# LINE 136 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 136 "src-ag/PrintCleanCode.ag" #-} if monadic_ then _leftIpp >#< "<-" >#< _rhsIpp else _leftIpp >#< "=" >-< indent 4 _rhsIpp @@ -1414,17 +1414,17 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule150 #-} - {-# LINE 139 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 139 "src-ag/PrintCleanCode.ag" #-} rule150 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 139 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 142 "src-ag/PrintCleanCode.ag" #-} rule151 = \ ((_leftIpp) :: PP_Doc) ((_lhsIoptions) :: Options) ((_rhsIpp) :: PP_Doc) _strat nt_ -> - {-# LINE 142 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 142 "src-ag/PrintCleanCode.ag" #-} if breadthFirst _lhsIoptions then _leftIpp >#< "=" >#< "case" >#< _strat >#< pp_parens _rhsIpp >#< "of" >-< indent 4 ( @@ -1466,8 +1466,8 @@ wrap_Decls !(T_Decls act) !(Inh_Decls _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Decls_vIn22 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile - !(T_Decls_vOut22 _lhsOpps) <- return (inv_Decls_s23 sem arg) + let arg22 = T_Decls_vIn22 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile + !(T_Decls_vOut22 _lhsOpps) <- return (inv_Decls_s23 sem arg22) return (Syn_Decls _lhsOpps) ) @@ -1512,9 +1512,9 @@ in __result_ ) in C_Decls_s23 v22 {-# INLINE rule160 #-} - {-# LINE 92 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 92 "src-ag/PrintCleanCode.ag" #-} rule160 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 92 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 92 "src-ag/PrintCleanCode.ag" #-} _hdIpp : _tlIpps {-# LINE 1520 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule161 #-} @@ -1554,9 +1554,9 @@ in __result_ ) in C_Decls_s23 v22 {-# INLINE rule169 #-} - {-# LINE 93 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 93 "src-ag/PrintCleanCode.ag" #-} rule169 = \ (_ :: ()) -> - {-# LINE 93 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 93 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 1562 "dist/build/PrintCleanCode.hs"#-} @@ -1569,8 +1569,8 @@ wrap_Expr !(T_Expr act) !(Inh_Expr _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile - !(T_Expr_vOut25 _lhsOpp) <- return (inv_Expr_s26 sem arg) + let arg25 = T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile + !(T_Expr_vOut25 _lhsOpp) <- return (inv_Expr_s26 sem arg25) return (Syn_Expr _lhsOpp) ) @@ -1630,17 +1630,17 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule170 #-} - {-# LINE 150 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 150 "src-ag/PrintCleanCode.ag" #-} rule170 = \ ((_bodyIpp) :: PP_Doc) ((_declsIpps) :: PP_Docs) -> - {-# LINE 150 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 441 "src-ag/PrintCleanCode.ag" #-} rule171 = \ (_ :: ()) -> - {-# LINE 441 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 441 "src-ag/PrintCleanCode.ag" #-} True {-# LINE 1646 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule172 #-} @@ -1684,9 +1684,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule178 #-} - {-# LINE 153 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 153 "src-ag/PrintCleanCode.ag" #-} rule178 = \ ((_altsIpps) :: PP_Docs) ((_exprIpp) :: PP_Doc) -> - {-# LINE 153 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 153 "src-ag/PrintCleanCode.ag" #-} pp_parens ( "case" >#< pp_parens _exprIpp >#< "of" >-< (vlist _altsIpps) ) @@ -1733,17 +1733,17 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule185 #-} - {-# LINE 156 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 156 "src-ag/PrintCleanCode.ag" #-} rule185 = \ ((_bodyIpp) :: PP_Doc) ((_stmtsIpps) :: PP_Docs) -> - {-# LINE 156 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 443 "src-ag/PrintCleanCode.ag" #-} rule186 = \ (_ :: ()) -> - {-# LINE 443 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 443 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 1749 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule187 #-} @@ -1789,25 +1789,25 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule193 #-} - {-# LINE 159 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 159 "src-ag/PrintCleanCode.ag" #-} rule193 = \ ((_argsIpps) :: PP_Docs) ((_lhsIoptions) :: Options) -> - {-# LINE 159 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 162 "src-ag/PrintCleanCode.ag" #-} rule194 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 162 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 165 "src-ag/PrintCleanCode.ag" #-} rule195 = \ _addBang ((_argsIpps) :: PP_Docs) ((_bodyIpp) :: PP_Doc) _strictParams -> - {-# LINE 165 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 165 "src-ag/PrintCleanCode.ag" #-} pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->" >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp) ) @@ -1848,9 +1848,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule202 #-} - {-# LINE 168 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 168 "src-ag/PrintCleanCode.ag" #-} rule202 = \ ((_exprsIpps) :: PP_Docs) ((_lhsInested) :: Bool) -> - {-# LINE 168 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 168 "src-ag/PrintCleanCode.ag" #-} ppTuple _lhsInested _exprsIpps {-# LINE 1856 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule203 #-} @@ -1880,9 +1880,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule206 #-} - {-# LINE 169 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 169 "src-ag/PrintCleanCode.ag" #-} rule206 = \ ((_exprsIpps) :: PP_Docs) ((_lhsInested) :: Bool) -> - {-# LINE 169 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 169 "src-ag/PrintCleanCode.ag" #-} ppUnboxedTuple _lhsInested _exprsIpps {-# LINE 1888 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule207 #-} @@ -1912,9 +1912,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule210 #-} - {-# LINE 170 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 170 "src-ag/PrintCleanCode.ag" #-} rule210 = \ ((_argsIpps) :: PP_Docs) name_ -> - {-# LINE 170 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 170 "src-ag/PrintCleanCode.ag" #-} pp_parens $ name_ >#< hv_sp _argsIpps {-# LINE 1920 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule211 #-} @@ -1939,9 +1939,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule214 #-} - {-# LINE 171 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 171 "src-ag/PrintCleanCode.ag" #-} rule214 = \ txt_ -> - {-# LINE 171 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 171 "src-ag/PrintCleanCode.ag" #-} text txt_ {-# LINE 1947 "dist/build/PrintCleanCode.hs"#-} {-# NOINLINE sem_Expr_TextExpr #-} @@ -1957,9 +1957,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule215 #-} - {-# LINE 172 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 172 "src-ag/PrintCleanCode.ag" #-} rule215 = \ lns_ -> - {-# LINE 172 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 172 "src-ag/PrintCleanCode.ag" #-} vlist (map text lns_) {-# LINE 1965 "dist/build/PrintCleanCode.hs"#-} {-# NOINLINE sem_Expr_Trace #-} @@ -1980,9 +1980,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule216 #-} - {-# LINE 173 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 173 "src-ag/PrintCleanCode.ag" #-} rule216 = \ ((_exprIpp) :: PP_Doc) txt_ -> - {-# LINE 173 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 173 "src-ag/PrintCleanCode.ag" #-} "trace" >#< ( pp_parens ("\"" >|< text txt_ >|< "\"") >-< pp_parens _exprIpp ) @@ -2014,9 +2014,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule220 #-} - {-# LINE 176 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 176 "src-ag/PrintCleanCode.ag" #-} rule220 = \ ((_exprIpp) :: PP_Doc) onLeftSide_ onNewLine_ txt_ -> - {-# LINE 176 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 176 "src-ag/PrintCleanCode.ag" #-} let pragmaDoc = "/*#" >#< txt_ >#< "#*/" op = if onNewLine_ then (>-<) @@ -2056,9 +2056,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule224 #-} - {-# LINE 187 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 187 "src-ag/PrintCleanCode.ag" #-} rule224 = \ ((_exprIpp) :: PP_Doc) ((_lhsIoutputfile) :: String) -> - {-# LINE 187 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 187 "src-ag/PrintCleanCode.ag" #-} _exprIpp >-< "/*# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show _lhsIoutputfile >#< "#*/" >-< "" {-# LINE 2065 "dist/build/PrintCleanCode.hs"#-} @@ -2092,9 +2092,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule228 #-} - {-# LINE 189 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 189 "src-ag/PrintCleanCode.ag" #-} rule228 = \ ((_exprIpp) :: PP_Doc) ((_tpIpp) :: PP_Doc) -> - {-# LINE 189 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 189 "src-ag/PrintCleanCode.ag" #-} pp_parens (_exprIpp >#< "::" >#< _tpIpp) {-# LINE 2100 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule229 #-} @@ -2127,9 +2127,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule233 #-} - {-# LINE 190 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 190 "src-ag/PrintCleanCode.ag" #-} rule233 = \ ((_exprIpp) :: PP_Doc) ((_lhsIoptions) :: Options) nt_ -> - {-# LINE 190 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 190 "src-ag/PrintCleanCode.ag" #-} if breadthFirst _lhsIoptions then "final" >#< pp_parens (nt_ >|< "_Syn" >#< pp_parens _exprIpp) @@ -2167,9 +2167,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule237 #-} - {-# LINE 194 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 194 "src-ag/PrintCleanCode.ag" #-} rule237 = \ ((_argsIpps) :: PP_Docs) ((_exprIpp) :: PP_Doc) ((_lhsIoptions) :: Options) nt_ -> - {-# LINE 194 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 194 "src-ag/PrintCleanCode.ag" #-} if breadthFirst _lhsIoptions then "invoke" >#< pp_parens _exprIpp >#< pp_parens ( nt_ >|< "_Inh" >#< pp_parens (ppTuple False _argsIpps)) @@ -2222,9 +2222,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule244 #-} - {-# LINE 198 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 198 "src-ag/PrintCleanCode.ag" #-} if breadthFirst _lhsIoptions then pp_parens ("resume" >#< pp_parens _exprIpp >-< indent 2 (pp_parens ( "\\" >|< @@ -2239,9 +2239,9 @@ ) {-# LINE 2241 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule245 #-} - {-# LINE 445 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 445 "src-ag/PrintCleanCode.ag" #-} rule245 = \ (_ :: ()) -> - {-# LINE 445 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 445 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 2247 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule246 #-} @@ -2296,25 +2296,25 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule255 #-} - {-# LINE 210 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 210 "src-ag/PrintCleanCode.ag" #-} rule255 = \ ((_argsIpps) :: PP_Docs) ((_lhsIoptions) :: Options) -> - {-# LINE 210 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 213 "src-ag/PrintCleanCode.ag" #-} rule256 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 213 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 216 "src-ag/PrintCleanCode.ag" #-} rule257 = \ _addBang ((_argsIpps) :: PP_Docs) ((_bodyIpp) :: PP_Doc) ((_lhsIoptions) :: Options) _strictParams nt_ -> - {-# LINE 216 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 216 "src-ag/PrintCleanCode.ag" #-} if breadthFirst _lhsIoptions then "Child" >#< pp_parens ( "\\" >|< pp_parens (nt_ >|< "_Inh" >#< @@ -2354,8 +2354,8 @@ wrap_Exprs !(T_Exprs act) !(Inh_Exprs _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Exprs_vIn28 _lhsInested _lhsIoptions _lhsIoutputfile - !(T_Exprs_vOut28 _lhsOpps) <- return (inv_Exprs_s29 sem arg) + let arg28 = T_Exprs_vIn28 _lhsInested _lhsIoptions _lhsIoutputfile + !(T_Exprs_vOut28 _lhsOpps) <- return (inv_Exprs_s29 sem arg28) return (Syn_Exprs _lhsOpps) ) @@ -2398,9 +2398,9 @@ in __result_ ) in C_Exprs_s29 v28 {-# INLINE rule264 #-} - {-# LINE 68 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 68 "src-ag/PrintCleanCode.ag" #-} rule264 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 68 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 68 "src-ag/PrintCleanCode.ag" #-} _hdIpp : _tlIpps {-# LINE 2406 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule265 #-} @@ -2434,9 +2434,9 @@ in __result_ ) in C_Exprs_s29 v28 {-# INLINE rule271 #-} - {-# LINE 69 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 69 "src-ag/PrintCleanCode.ag" #-} rule271 = \ (_ :: ()) -> - {-# LINE 69 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 69 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 2442 "dist/build/PrintCleanCode.hs"#-} @@ -2449,8 +2449,8 @@ wrap_Lhs !(T_Lhs act) !(Inh_Lhs _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile - !(T_Lhs_vOut31 _lhsOpp) <- return (inv_Lhs_s32 sem arg) + let arg31 = T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile + !(T_Lhs_vOut31 _lhsOpp) <- return (inv_Lhs_s32 sem arg31) return (Syn_Lhs _lhsOpp) ) @@ -2496,33 +2496,33 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule272 #-} - {-# LINE 248 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 248 "src-ag/PrintCleanCode.ag" #-} rule272 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> - {-# LINE 248 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 250 "src-ag/PrintCleanCode.ag" #-} rule273 = \ ((_pat3IstrictVars) :: [PP_Doc]) -> - {-# LINE 250 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 250 "src-ag/PrintCleanCode.ag" #-} _pat3IstrictVars `ppMultiSeqH` (pp "True") {-# LINE 2510 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule274 #-} - {-# LINE 251 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 251 "src-ag/PrintCleanCode.ag" #-} rule274 = \ ((_pat3IstrictVars) :: [PP_Doc]) -> - {-# LINE 251 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 251 "src-ag/PrintCleanCode.ag" #-} not (null _pat3IstrictVars) {-# LINE 2516 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule275 #-} - {-# LINE 268 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 268 "src-ag/PrintCleanCode.ag" #-} rule275 = \ _addStrictGuard ((_pat3Ipp) :: PP_Doc) -> - {-# LINE 268 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 268 "src-ag/PrintCleanCode.ag" #-} _addStrictGuard _pat3Ipp {-# LINE 2522 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule276 #-} - {-# LINE 406 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 406 "src-ag/PrintCleanCode.ag" #-} rule276 = \ (_ :: ()) -> - {-# LINE 406 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 406 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 2528 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule277 #-} @@ -2549,15 +2549,15 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule279 #-} - {-# LINE 269 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 269 "src-ag/PrintCleanCode.ag" #-} rule279 = \ ((_pat3Ipp') :: PP_Doc) -> - {-# LINE 269 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 269 "src-ag/PrintCleanCode.ag" #-} _pat3Ipp' {-# LINE 2557 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule280 #-} - {-# LINE 406 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 406 "src-ag/PrintCleanCode.ag" #-} rule280 = \ (_ :: ()) -> - {-# LINE 406 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 406 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 2563 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule281 #-} @@ -2583,37 +2583,37 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule283 #-} - {-# LINE 248 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 248 "src-ag/PrintCleanCode.ag" #-} rule283 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> - {-# LINE 248 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 253 "src-ag/PrintCleanCode.ag" #-} rule284 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) comps_ -> - {-# LINE 253 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 256 "src-ag/PrintCleanCode.ag" #-} rule285 = \ comps_ -> - {-# LINE 256 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 256 "src-ag/PrintCleanCode.ag" #-} not (null comps_) {-# LINE 2605 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule286 #-} - {-# LINE 264 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 264 "src-ag/PrintCleanCode.ag" #-} rule286 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 264 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 270 "src-ag/PrintCleanCode.ag" #-} rule287 = \ _addBang _addStrictGuard ((_lhsInested) :: Bool) comps_ -> - {-# LINE 270 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 270 "src-ag/PrintCleanCode.ag" #-} _addStrictGuard $ ppTuple _lhsInested (map (_addBang . text) comps_) {-# LINE 2619 "dist/build/PrintCleanCode.hs"#-} {-# NOINLINE sem_Lhs_UnboxedTupleLhs #-} @@ -2633,37 +2633,37 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule288 #-} - {-# LINE 248 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 248 "src-ag/PrintCleanCode.ag" #-} rule288 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> - {-# LINE 248 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 253 "src-ag/PrintCleanCode.ag" #-} rule289 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) comps_ -> - {-# LINE 253 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 256 "src-ag/PrintCleanCode.ag" #-} rule290 = \ comps_ -> - {-# LINE 256 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 256 "src-ag/PrintCleanCode.ag" #-} not (null comps_) {-# LINE 2655 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule291 #-} - {-# LINE 264 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 264 "src-ag/PrintCleanCode.ag" #-} rule291 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 264 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 271 "src-ag/PrintCleanCode.ag" #-} rule292 = \ _addBang _addStrictGuard ((_lhsInested) :: Bool) comps_ -> - {-# LINE 271 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 271 "src-ag/PrintCleanCode.ag" #-} _addStrictGuard $ ppUnboxedTuple _lhsInested (map (_addBang . text) comps_) {-# LINE 2669 "dist/build/PrintCleanCode.hs"#-} {-# NOINLINE sem_Lhs_Fun #-} @@ -2688,35 +2688,35 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule293 #-} - {-# LINE 259 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 259 "src-ag/PrintCleanCode.ag" #-} rule293 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> - {-# LINE 259 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 260 "src-ag/PrintCleanCode.ag" #-} rule294 = \ ((_argsIpps) :: PP_Docs) -> - {-# LINE 260 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 260 "src-ag/PrintCleanCode.ag" #-} not (null _argsIpps) {-# LINE 2702 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule295 #-} - {-# LINE 261 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 261 "src-ag/PrintCleanCode.ag" #-} rule295 = \ ((_argsIpps) :: PP_Docs) -> - {-# LINE 261 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 261 "src-ag/PrintCleanCode.ag" #-} _argsIpps `ppMultiSeqH` (pp "True") {-# LINE 2708 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule296 #-} - {-# LINE 264 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 264 "src-ag/PrintCleanCode.ag" #-} rule296 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 264 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 272 "src-ag/PrintCleanCode.ag" #-} rule297 = \ _addBang _addStrictGuard ((_argsIpps) :: PP_Docs) name_ -> - {-# LINE 272 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 272 "src-ag/PrintCleanCode.ag" #-} _addStrictGuard (name_ >#< hv_sp (map _addBang _argsIpps)) {-# LINE 2722 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule298 #-} @@ -2747,9 +2747,9 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule301 #-} - {-# LINE 273 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 273 "src-ag/PrintCleanCode.ag" #-} rule301 = \ ((_subIpp) :: PP_Doc) name_ -> - {-# LINE 273 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 273 "src-ag/PrintCleanCode.ag" #-} pp_parens (name_ >#< _subIpp) {-# LINE 2755 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule302 #-} @@ -2774,8 +2774,8 @@ wrap_NamedType !(T_NamedType act) !(Inh_NamedType _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_NamedType_vIn34 _lhsInested - !(T_NamedType_vOut34 _lhsOpp _lhsOppa) <- return (inv_NamedType_s35 sem arg) + let arg34 = T_NamedType_vIn34 _lhsInested + !(T_NamedType_vOut34 _lhsOpp _lhsOppa) <- return (inv_NamedType_s35 sem arg34) return (Syn_NamedType _lhsOpp _lhsOppa) ) @@ -2813,17 +2813,17 @@ in __result_ ) in C_NamedType_s35 v34 {-# INLINE rule306 #-} - {-# LINE 240 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 240 "src-ag/PrintCleanCode.ag" #-} rule306 = \ ((_tpIpp) :: PP_Doc) strict_ -> - {-# LINE 240 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 244 "src-ag/PrintCleanCode.ag" #-} rule307 = \ name_ -> - {-# LINE 244 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 244 "src-ag/PrintCleanCode.ag" #-} pp name_ {-# LINE 2829 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule308 #-} @@ -2839,8 +2839,8 @@ wrap_NamedTypes !(T_NamedTypes act) !(Inh_NamedTypes _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_NamedTypes_vIn37 _lhsInested - !(T_NamedTypes_vOut37 _lhsOppas _lhsOpps) <- return (inv_NamedTypes_s38 sem arg) + let arg37 = T_NamedTypes_vIn37 _lhsInested + !(T_NamedTypes_vOut37 _lhsOppas _lhsOpps) <- return (inv_NamedTypes_s38 sem arg37) return (Syn_NamedTypes _lhsOppas _lhsOpps) ) @@ -2881,15 +2881,15 @@ in __result_ ) in C_NamedTypes_s38 v37 {-# INLINE rule309 #-} - {-# LINE 86 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 86 "src-ag/PrintCleanCode.ag" #-} rule309 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 86 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 86 "src-ag/PrintCleanCode.ag" #-} _hdIpp : _tlIpps {-# LINE 2889 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule310 #-} - {-# LINE 87 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 87 "src-ag/PrintCleanCode.ag" #-} rule310 = \ ((_hdIppa) :: PP_Doc) ((_tlIppas) :: PP_Docs) -> - {-# LINE 87 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 87 "src-ag/PrintCleanCode.ag" #-} _hdIppa : _tlIppas {-# LINE 2895 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule311 #-} @@ -2913,15 +2913,15 @@ in __result_ ) in C_NamedTypes_s38 v37 {-# INLINE rule313 #-} - {-# LINE 88 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 88 "src-ag/PrintCleanCode.ag" #-} rule313 = \ (_ :: ()) -> - {-# LINE 88 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 88 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 2921 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule314 #-} - {-# LINE 89 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 89 "src-ag/PrintCleanCode.ag" #-} rule314 = \ (_ :: ()) -> - {-# LINE 89 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 89 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 2927 "dist/build/PrintCleanCode.hs"#-} @@ -2934,8 +2934,8 @@ wrap_Pattern !(T_Pattern act) !(Inh_Pattern _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Pattern_vIn40 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions - !(T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars) <- return (inv_Pattern_s41 sem arg) + 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) ) @@ -2987,29 +2987,29 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule315 #-} - {-# LINE 378 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 378 "src-ag/PrintCleanCode.ag" #-} rule315 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) -> - {-# LINE 378 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 383 "src-ag/PrintCleanCode.ag" #-} rule316 = \ _addBang ((_patsIpps) :: [PP_Doc]) name_ -> - {-# LINE 383 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 394 "src-ag/PrintCleanCode.ag" #-} rule317 = \ (_ :: ()) -> - {-# LINE 394 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 394 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 3009 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule318 #-} - {-# LINE 417 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 417 "src-ag/PrintCleanCode.ag" #-} rule318 = \ ((_patsIpps') :: [PP_Doc]) name_ -> - {-# LINE 417 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 417 "src-ag/PrintCleanCode.ag" #-} pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps') {-# LINE 3015 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule319 #-} @@ -3058,29 +3058,29 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule325 #-} - {-# LINE 378 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 378 "src-ag/PrintCleanCode.ag" #-} rule325 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) -> - {-# LINE 378 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 384 "src-ag/PrintCleanCode.ag" #-} rule326 = \ _addBang ((_patsIpps) :: [PP_Doc]) -> - {-# LINE 384 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 384 "src-ag/PrintCleanCode.ag" #-} _addBang $ pp_block "(" ")" "," _patsIpps {-# LINE 3074 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule327 #-} - {-# LINE 395 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 395 "src-ag/PrintCleanCode.ag" #-} rule327 = \ (_ :: ()) -> - {-# LINE 395 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 395 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 3080 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule328 #-} - {-# LINE 418 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 418 "src-ag/PrintCleanCode.ag" #-} rule328 = \ ((_patsIpps') :: [PP_Doc]) -> - {-# LINE 418 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 418 "src-ag/PrintCleanCode.ag" #-} pp_block "(" ")" "," _patsIpps' {-# LINE 3086 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule329 #-} @@ -3133,65 +3133,65 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule335 #-} - {-# LINE 356 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 356 "src-ag/PrintCleanCode.ag" #-} rule335 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) _ppVar -> - {-# LINE 356 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 360 "src-ag/PrintCleanCode.ag" #-} rule336 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) ((_patIstrictVars) :: [PP_Doc]) -> - {-# LINE 360 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 364 "src-ag/PrintCleanCode.ag" #-} rule337 = \ _strictPatVars _strictVar -> - {-# LINE 364 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 364 "src-ag/PrintCleanCode.ag" #-} _strictVar ++ _strictPatVars {-# LINE 3157 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule338 #-} - {-# LINE 378 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 378 "src-ag/PrintCleanCode.ag" #-} rule338 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) -> - {-# LINE 378 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 385 "src-ag/PrintCleanCode.ag" #-} rule339 = \ ((_lhsIoptions) :: Options) attr_ field_ -> - {-# LINE 385 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 386 "src-ag/PrintCleanCode.ag" #-} rule340 = \ _addBang _ppVar -> - {-# LINE 386 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 386 "src-ag/PrintCleanCode.ag" #-} _addBang $ _ppVar {-# LINE 3177 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule341 #-} - {-# LINE 387 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 387 "src-ag/PrintCleanCode.ag" #-} rule341 = \ ((_patIisUnderscore) :: Bool) ((_patIpp) :: PP_Doc) _ppVarBang -> - {-# LINE 387 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 396 "src-ag/PrintCleanCode.ag" #-} rule342 = \ (_ :: ()) -> - {-# LINE 396 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 396 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 3191 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule343 #-} - {-# LINE 419 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 419 "src-ag/PrintCleanCode.ag" #-} rule343 = \ ((_lhsIoptions) :: Options) ((_patIpp') :: PP_Doc) attr_ field_ -> - {-# LINE 419 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 419 "src-ag/PrintCleanCode.ag" #-} let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_ | otherwise = attrname _lhsIoptions False field_ attr_ in attribute >|< "@" >|< _patIpp' @@ -3238,27 +3238,27 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule349 #-} - {-# LINE 366 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 366 "src-ag/PrintCleanCode.ag" #-} rule349 = \ (_ :: ()) -> - {-# LINE 366 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 366 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 3246 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule350 #-} - {-# LINE 390 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 390 "src-ag/PrintCleanCode.ag" #-} rule350 = \ ((_patIpp) :: PP_Doc) -> - {-# LINE 390 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 390 "src-ag/PrintCleanCode.ag" #-} text "~" >|< pp_parens _patIpp {-# LINE 3252 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule351 #-} - {-# LINE 402 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 402 "src-ag/PrintCleanCode.ag" #-} rule351 = \ (_ :: ()) -> - {-# LINE 402 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 402 "src-ag/PrintCleanCode.ag" #-} True {-# LINE 3258 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule352 #-} - {-# LINE 422 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 422 "src-ag/PrintCleanCode.ag" #-} rule352 = \ ((_patIpp) :: PP_Doc) -> - {-# LINE 422 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 422 "src-ag/PrintCleanCode.ag" #-} text "~" >|< pp_parens _patIpp {-# LINE 3264 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule353 #-} @@ -3298,21 +3298,21 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule358 #-} - {-# LINE 391 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 391 "src-ag/PrintCleanCode.ag" #-} rule358 = \ (_ :: ()) -> - {-# LINE 391 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 391 "src-ag/PrintCleanCode.ag" #-} text "_" {-# LINE 3306 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule359 #-} - {-# LINE 397 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 397 "src-ag/PrintCleanCode.ag" #-} rule359 = \ (_ :: ()) -> - {-# LINE 397 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 397 "src-ag/PrintCleanCode.ag" #-} True {-# LINE 3312 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule360 #-} - {-# LINE 423 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 423 "src-ag/PrintCleanCode.ag" #-} rule360 = \ (_ :: ()) -> - {-# LINE 423 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 423 "src-ag/PrintCleanCode.ag" #-} text "_" {-# LINE 3318 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule361 #-} @@ -3334,8 +3334,8 @@ wrap_Patterns !(T_Patterns act) !(Inh_Patterns _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Patterns_vIn43 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions - !(T_Patterns_vOut43 _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars) <- return (inv_Patterns_s44 sem arg) + 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) ) @@ -3385,15 +3385,15 @@ in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule364 #-} - {-# LINE 373 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 373 "src-ag/PrintCleanCode.ag" #-} rule364 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: [PP_Doc]) -> - {-# LINE 373 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 373 "src-ag/PrintCleanCode.ag" #-} _hdIpp : _tlIpps {-# LINE 3393 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule365 #-} - {-# LINE 413 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 413 "src-ag/PrintCleanCode.ag" #-} rule365 = \ ((_hdIpp') :: PP_Doc) ((_tlIpps') :: [PP_Doc]) -> - {-# LINE 413 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 413 "src-ag/PrintCleanCode.ag" #-} _hdIpp' : _tlIpps' {-# LINE 3399 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule366 #-} @@ -3443,15 +3443,15 @@ in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule375 #-} - {-# LINE 374 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 374 "src-ag/PrintCleanCode.ag" #-} rule375 = \ (_ :: ()) -> - {-# LINE 374 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 374 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 3451 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule376 #-} - {-# LINE 414 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 414 "src-ag/PrintCleanCode.ag" #-} rule376 = \ (_ :: ()) -> - {-# LINE 414 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 414 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 3457 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule377 #-} @@ -3473,8 +3473,8 @@ 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 arg = T_Program_vIn46 _lhsIimportBlocks _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks - !(T_Program_vOut46 _lhsOgenIO _lhsOoutput) <- return (inv_Program_s47 sem arg) + 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) ) @@ -3527,39 +3527,39 @@ in __result_ ) in C_Program_s47 v46 {-# INLINE rule380 #-} - {-# LINE 62 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 62 "src-ag/PrintCleanCode.ag" #-} rule380 = \ ((_lhsIoptions) :: Options) ordered_ -> - {-# LINE 62 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 65 "src-ag/PrintCleanCode.ag" #-} rule381 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 65 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 65 "src-ag/PrintCleanCode.ag" #-} nest _lhsIoptions {-# LINE 3541 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule382 #-} - {-# LINE 101 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 101 "src-ag/PrintCleanCode.ag" #-} rule382 = \ ((_chunksIpps) :: PP_Docs) -> - {-# LINE 101 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 101 "src-ag/PrintCleanCode.ag" #-} _chunksIpps {-# LINE 3547 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule383 #-} - {-# LINE 437 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 437 "src-ag/PrintCleanCode.ag" #-} rule383 = \ (_ :: ()) -> - {-# LINE 437 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 437 "src-ag/PrintCleanCode.ag" #-} False {-# LINE 3553 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule384 #-} - {-# LINE 471 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 471 "src-ag/PrintCleanCode.ag" #-} rule384 = \ ((_lhsImainFile) :: String) -> - {-# LINE 471 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 471 "src-ag/PrintCleanCode.ag" #-} _lhsImainFile {-# LINE 3559 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule385 #-} - {-# LINE 473 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 473 "src-ag/PrintCleanCode.ag" #-} writeModule _mainModuleFile ( [ pp $ _lhsIpragmaBlocks , pp $ _lhsIoptionsLine @@ -3572,15 +3572,15 @@ ) {-# LINE 3574 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule386 #-} - {-# LINE 484 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 484 "src-ag/PrintCleanCode.ag" #-} rule386 = \ ((_lhsImainFile) :: String) -> - {-# LINE 484 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 486 "src-ag/PrintCleanCode.ag" #-} writeModule _commonFile ( [ pp $ _lhsIpragmaBlocks , pp $ _lhsIoptionsLine @@ -3592,9 +3592,9 @@ ) {-# LINE 3594 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule388 #-} - {-# LINE 496 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 496 "src-ag/PrintCleanCode.ag" #-} rule388 = \ ((_chunksIgenSems) :: IO ()) _genCommonModule _genMainModule -> - {-# LINE 496 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 496 "src-ag/PrintCleanCode.ag" #-} do _genMainModule _genCommonModule _chunksIgenSems @@ -3636,8 +3636,8 @@ wrap_Type !(T_Type act) !(Inh_Type _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Type_vIn49 _lhsInested - !(T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec) <- return (inv_Type_s50 sem arg) + let arg49 = T_Type_vIn49 _lhsInested + !(T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec) <- return (inv_Type_s50 sem arg49) return (Syn_Type _lhsOcopy _lhsOpp _lhsOprec) ) @@ -3697,29 +3697,29 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule398 #-} - {-# LINE 276 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 276 "src-ag/PrintCleanCode.ag" #-} rule398 = \ (_ :: ()) -> - {-# LINE 276 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 276 "src-ag/PrintCleanCode.ag" #-} 2 {-# LINE 3705 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule399 #-} - {-# LINE 277 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 277 "src-ag/PrintCleanCode.ag" #-} rule399 = \ _l _r ((_rightIcopy) :: Type) -> - {-# LINE 277 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 280 "src-ag/PrintCleanCode.ag" #-} rule400 = \ ((_leftIpp) :: PP_Doc) ((_leftIprec) :: Int) -> - {-# LINE 280 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 281 "src-ag/PrintCleanCode.ag" #-} rule401 = \ ((_rightIpp) :: PP_Doc) ((_rightIprec) :: Int) -> - {-# LINE 281 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 281 "src-ag/PrintCleanCode.ag" #-} if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp {-# LINE 3725 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule402 #-} @@ -3755,9 +3755,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule406 #-} - {-# LINE 287 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 287 "src-ag/PrintCleanCode.ag" #-} rule406 = \ ((_rightIpp) :: PP_Doc) left_ -> - {-# LINE 287 "./src-ag/PrintCleanCode.ag" #-} + {-# 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 #-} @@ -3793,9 +3793,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule411 #-} - {-# LINE 289 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 289 "src-ag/PrintCleanCode.ag" #-} rule411 = \ ((_rightIpp) :: PP_Doc) left_ -> - {-# LINE 289 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 289 "src-ag/PrintCleanCode.ag" #-} left_ >#< _rightIpp {-# LINE 3801 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule412 #-} @@ -3834,9 +3834,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule416 #-} - {-# LINE 284 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 284 "src-ag/PrintCleanCode.ag" #-} rule416 = \ ((_argsIpps) :: PP_Docs) ((_funcIpp) :: PP_Doc) -> - {-# LINE 284 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 284 "src-ag/PrintCleanCode.ag" #-} pp "(" >#< hv_sp (_funcIpp : _argsIpps) >#< pp ")" {-# LINE 3842 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule417 #-} @@ -3875,15 +3875,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule422 #-} - {-# LINE 291 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 291 "src-ag/PrintCleanCode.ag" #-} rule422 = \ (_ :: ()) -> - {-# LINE 291 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 291 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 3883 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule423 #-} - {-# LINE 292 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 292 "src-ag/PrintCleanCode.ag" #-} rule423 = \ ((_lhsInested) :: Bool) ((_tpsIpps) :: PP_Docs) -> - {-# LINE 292 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 292 "src-ag/PrintCleanCode.ag" #-} ppTuple _lhsInested _tpsIpps {-# LINE 3889 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule424 #-} @@ -3916,15 +3916,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule427 #-} - {-# LINE 294 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 294 "src-ag/PrintCleanCode.ag" #-} rule427 = \ (_ :: ()) -> - {-# LINE 294 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 294 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 3924 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule428 #-} - {-# LINE 295 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 295 "src-ag/PrintCleanCode.ag" #-} rule428 = \ ((_lhsInested) :: Bool) ((_tpsIpps) :: PP_Docs) -> - {-# LINE 295 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 295 "src-ag/PrintCleanCode.ag" #-} ppUnboxedTuple _lhsInested _tpsIpps {-# LINE 3930 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule429 #-} @@ -3957,15 +3957,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule432 #-} - {-# LINE 297 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 297 "src-ag/PrintCleanCode.ag" #-} rule432 = \ (_ :: ()) -> - {-# LINE 297 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 297 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 3965 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule433 #-} - {-# LINE 298 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 298 "src-ag/PrintCleanCode.ag" #-} rule433 = \ ((_tpIpp) :: PP_Doc) -> - {-# LINE 298 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 298 "src-ag/PrintCleanCode.ag" #-} "[" >|< _tpIpp >|< "]" {-# LINE 3971 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule434 #-} @@ -3995,15 +3995,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule437 #-} - {-# LINE 300 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 300 "src-ag/PrintCleanCode.ag" #-} rule437 = \ (_ :: ()) -> - {-# LINE 300 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 300 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4003 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule438 #-} - {-# LINE 301 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 301 "src-ag/PrintCleanCode.ag" #-} rule438 = \ txt_ -> - {-# LINE 301 "./src-ag/PrintCleanCode.ag" #-} + {-# 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 #-} @@ -4031,21 +4031,21 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule441 #-} - {-# LINE 303 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 303 "src-ag/PrintCleanCode.ag" #-} rule441 = \ (_ :: ()) -> - {-# LINE 303 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 303 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4039 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule442 #-} - {-# LINE 304 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 304 "src-ag/PrintCleanCode.ag" #-} rule442 = \ _prefix name_ params_ -> - {-# LINE 304 "./src-ag/PrintCleanCode.ag" #-} + {-# 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" #-} + {-# LINE 305 "src-ag/PrintCleanCode.ag" #-} rule443 = \ deforested_ -> - {-# LINE 305 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 305 "src-ag/PrintCleanCode.ag" #-} if deforested_ then text "T_" else empty @@ -4077,15 +4077,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule446 #-} - {-# LINE 308 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 308 "src-ag/PrintCleanCode.ag" #-} rule446 = \ (_ :: ()) -> - {-# LINE 308 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 308 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4085 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule447 #-} - {-# LINE 309 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 309 "src-ag/PrintCleanCode.ag" #-} rule447 = \ ((_tpIpp) :: PP_Doc) -> - {-# LINE 309 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 309 "src-ag/PrintCleanCode.ag" #-} text "Maybe" >#< pp_parens _tpIpp {-# LINE 4091 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule448 #-} @@ -4121,15 +4121,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule451 #-} - {-# LINE 310 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 310 "src-ag/PrintCleanCode.ag" #-} rule451 = \ (_ :: ()) -> - {-# LINE 310 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 310 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4129 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule452 #-} - {-# LINE 311 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 311 "src-ag/PrintCleanCode.ag" #-} rule452 = \ ((_leftIpp) :: PP_Doc) ((_rightIpp) :: PP_Doc) -> - {-# LINE 311 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 311 "src-ag/PrintCleanCode.ag" #-} text "Either" >#< pp_parens _leftIpp >#< pp_parens _rightIpp {-# LINE 4135 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule453 #-} @@ -4168,15 +4168,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule457 #-} - {-# LINE 312 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 312 "src-ag/PrintCleanCode.ag" #-} rule457 = \ (_ :: ()) -> - {-# LINE 312 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 312 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4176 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule458 #-} - {-# LINE 313 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 313 "src-ag/PrintCleanCode.ag" #-} rule458 = \ ((_keyIpp) :: PP_Doc) ((_valueIpp) :: PP_Doc) -> - {-# LINE 313 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 313 "src-ag/PrintCleanCode.ag" #-} text "'Data.Map'.Map" >#< pp_parens _keyIpp >#< pp_parens _valueIpp {-# LINE 4182 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule459 #-} @@ -4212,15 +4212,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule463 #-} - {-# LINE 314 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 314 "src-ag/PrintCleanCode.ag" #-} rule463 = \ (_ :: ()) -> - {-# LINE 314 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 314 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4220 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule464 #-} - {-# LINE 315 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 315 "src-ag/PrintCleanCode.ag" #-} rule464 = \ ((_valueIpp) :: PP_Doc) -> - {-# LINE 315 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 315 "src-ag/PrintCleanCode.ag" #-} text "'Data.IntMap'.IntMap" >#< pp_parens _valueIpp {-# LINE 4226 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule465 #-} @@ -4253,15 +4253,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule468 #-} - {-# LINE 316 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 316 "src-ag/PrintCleanCode.ag" #-} rule468 = \ (_ :: ()) -> - {-# LINE 316 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 316 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4261 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule469 #-} - {-# LINE 317 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 317 "src-ag/PrintCleanCode.ag" #-} rule469 = \ ((_tpIpp) :: PP_Doc) -> - {-# LINE 317 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 317 "src-ag/PrintCleanCode.ag" #-} text "'Data.Set'.Set" >#< pp_parens _tpIpp {-# LINE 4267 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule470 #-} @@ -4291,15 +4291,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule473 #-} - {-# LINE 318 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 318 "src-ag/PrintCleanCode.ag" #-} rule473 = \ (_ :: ()) -> - {-# LINE 318 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 318 "src-ag/PrintCleanCode.ag" #-} 5 {-# LINE 4299 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule474 #-} - {-# LINE 319 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 319 "src-ag/PrintCleanCode.ag" #-} rule474 = \ (_ :: ()) -> - {-# LINE 319 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 319 "src-ag/PrintCleanCode.ag" #-} text "'Data.IntSet'.IntSet" {-# LINE 4305 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule475 #-} @@ -4318,8 +4318,8 @@ wrap_Types !(T_Types act) !(Inh_Types _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Types_vIn52 _lhsInested - !(T_Types_vOut52 _lhsOcopy _lhsOpps) <- return (inv_Types_s53 sem arg) + let arg52 = T_Types_vIn52 _lhsInested + !(T_Types_vOut52 _lhsOcopy _lhsOpps) <- return (inv_Types_s53 sem arg52) return (Syn_Types _lhsOcopy _lhsOpps) ) @@ -4361,9 +4361,9 @@ in __result_ ) in C_Types_s53 v52 {-# INLINE rule477 #-} - {-# LINE 82 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 82 "src-ag/PrintCleanCode.ag" #-} rule477 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 82 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 82 "src-ag/PrintCleanCode.ag" #-} _hdIpp : _tlIpps {-# LINE 4369 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule478 #-} @@ -4394,9 +4394,9 @@ in __result_ ) in C_Types_s53 v52 {-# INLINE rule482 #-} - {-# LINE 83 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 83 "src-ag/PrintCleanCode.ag" #-} rule482 = \ (_ :: ()) -> - {-# LINE 83 "./src-ag/PrintCleanCode.ag" #-} + {-# LINE 83 "src-ag/PrintCleanCode.ag" #-} [] {-# LINE 4402 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule483 #-} diff --git a/src-generated/PrintCode.hs b/src-generated/PrintCode.hs --- a/src-generated/PrintCode.hs +++ b/src-generated/PrintCode.hs @@ -3,14 +3,14 @@ {-# LANGUAGE ScopedTypeVariables #-} module PrintCode where -{-# LINE 2 "./src-ag/Patterns.ag" #-} +{-# 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" #-} +{-# LINE 2 "src-ag/Code.ag" #-} import Patterns import Data.Set(Set) @@ -19,7 +19,7 @@ import qualified Data.Map as Map {-# LINE 21 "dist/build/PrintCode.hs" #-} -{-# LINE 10 "./src-ag/PrintCode.ag" #-} +{-# LINE 10 "src-ag/PrintCode.ag" #-} import Data.Char (isAlphaNum) import Pretty @@ -34,7 +34,7 @@ {-# LINE 35 "dist/build/PrintCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 146 "./src-ag/Code.ag" #-} +{-# LINE 146 "src-ag/Code.ag" #-} -- Unboxed tuples -- unbox Whether unboxed tuples are wanted or not @@ -53,12 +53,12 @@ | otherwise = UnboxedTupleLhs comps {-# LINE 55 "dist/build/PrintCode.hs" #-} -{-# LINE 23 "./src-ag/PrintCode.ag" #-} +{-# LINE 23 "src-ag/PrintCode.ag" #-} type PP_Docs = [PP_Doc] {-# LINE 60 "dist/build/PrintCode.hs" #-} -{-# LINE 27 "./src-ag/PrintCode.ag" #-} +{-# LINE 27 "src-ag/PrintCode.ag" #-} ppMultiSeqH :: [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeqH = ppMultiSeq' (>#<) @@ -71,7 +71,7 @@ = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs {-# LINE 73 "dist/build/PrintCode.hs" #-} -{-# LINE 303 "./src-ag/PrintCode.ag" #-} +{-# LINE 303 "src-ag/PrintCode.ag" #-} reallySimple :: String -> Bool @@ -86,19 +86,19 @@ {-# LINE 88 "dist/build/PrintCode.hs" #-} -{-# LINE 404 "./src-ag/PrintCode.ag" #-} +{-# 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" #-} +{-# 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" #-} +{-# LINE 527 "src-ag/PrintCode.ag" #-} writeModule :: FilePath -> [PP_Doc] -> IO () writeModule path docs @@ -123,8 +123,8 @@ wrap_CaseAlt !(T_CaseAlt act) !(Inh_CaseAlt _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_CaseAlt_vIn1 _lhsInested _lhsIoptions _lhsIoutputfile - !(T_CaseAlt_vOut1 _lhsOpps) <- return (inv_CaseAlt_s2 sem arg) + let arg1 = T_CaseAlt_vIn1 _lhsInested _lhsIoptions _lhsIoutputfile + !(T_CaseAlt_vOut1 _lhsOpps) <- return (inv_CaseAlt_s2 sem arg1) return (Syn_CaseAlt _lhsOpps) ) @@ -168,15 +168,15 @@ in __result_ ) in C_CaseAlt_s2 v1 {-# INLINE rule0 #-} - {-# LINE 218 "./src-ag/PrintCode.ag" #-} + {-# LINE 218 "src-ag/PrintCode.ag" #-} rule0 = \ ((_exprIpp) :: PP_Doc) ((_leftIpp) :: PP_Doc) -> - {-# LINE 218 "./src-ag/PrintCode.ag" #-} + {-# LINE 218 "src-ag/PrintCode.ag" #-} ["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"] {-# LINE 176 "dist/build/PrintCode.hs"#-} {-# INLINE rule1 #-} - {-# LINE 428 "./src-ag/PrintCode.ag" #-} + {-# LINE 428 "src-ag/PrintCode.ag" #-} rule1 = \ (_ :: ()) -> - {-# LINE 428 "./src-ag/PrintCode.ag" #-} + {-# LINE 428 "src-ag/PrintCode.ag" #-} False {-# LINE 182 "dist/build/PrintCode.hs"#-} {-# INLINE rule2 #-} @@ -207,8 +207,8 @@ wrap_CaseAlts !(T_CaseAlts act) !(Inh_CaseAlts _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_CaseAlts_vIn4 _lhsInested _lhsIoptions _lhsIoutputfile - !(T_CaseAlts_vOut4 _lhsOpps) <- return (inv_CaseAlts_s5 sem arg) + let arg4 = T_CaseAlts_vIn4 _lhsInested _lhsIoptions _lhsIoutputfile + !(T_CaseAlts_vOut4 _lhsOpps) <- return (inv_CaseAlts_s5 sem arg4) return (Syn_CaseAlts _lhsOpps) ) @@ -251,9 +251,9 @@ in __result_ ) in C_CaseAlts_s5 v4 {-# INLINE rule8 #-} - {-# LINE 68 "./src-ag/PrintCode.ag" #-} + {-# LINE 68 "src-ag/PrintCode.ag" #-} rule8 = \ ((_hdIpps) :: PP_Docs) ((_tlIpps) :: PP_Docs) -> - {-# LINE 68 "./src-ag/PrintCode.ag" #-} + {-# LINE 68 "src-ag/PrintCode.ag" #-} _hdIpps ++ _tlIpps {-# LINE 259 "dist/build/PrintCode.hs"#-} {-# INLINE rule9 #-} @@ -287,9 +287,9 @@ in __result_ ) in C_CaseAlts_s5 v4 {-# INLINE rule15 #-} - {-# LINE 69 "./src-ag/PrintCode.ag" #-} + {-# LINE 69 "src-ag/PrintCode.ag" #-} rule15 = \ (_ :: ()) -> - {-# LINE 69 "./src-ag/PrintCode.ag" #-} + {-# LINE 69 "src-ag/PrintCode.ag" #-} [] {-# LINE 295 "dist/build/PrintCode.hs"#-} @@ -302,8 +302,8 @@ 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 arg = 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 arg) + 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) ) @@ -388,17 +388,17 @@ in __result_ ) in C_Chunk_s8 v7 {-# INLINE rule16 #-} - {-# LINE 43 "./src-ag/PrintCode.ag" #-} + {-# LINE 43 "src-ag/PrintCode.ag" #-} rule16 = \ ((_lhsImainFile) :: String) ((_lhsIoptions) :: Options) name_ -> - {-# LINE 43 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 96 "src-ag/PrintCode.ag" #-} _commentIpp : _infoIpps ++ _dataDefIpps @@ -409,15 +409,15 @@ ++ [Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap] {-# LINE 411 "dist/build/PrintCode.hs"#-} {-# INLINE rule18 #-} - {-# LINE 487 "./src-ag/PrintCode.ag" #-} + {-# LINE 487 "src-ag/PrintCode.ag" #-} rule18 = \ ((_lhsImainName) :: String) name_ -> - {-# LINE 487 "./src-ag/PrintCode.ag" #-} + {-# LINE 487 "src-ag/PrintCode.ag" #-} ["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"] {-# LINE 417 "dist/build/PrintCode.hs"#-} {-# INLINE rule19 #-} - {-# LINE 494 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 494 "src-ag/PrintCode.ag" #-} [ [_commentIpp] , _dataDefIpps , _semDomIpps @@ -425,18 +425,18 @@ ] {-# LINE 427 "dist/build/PrintCode.hs"#-} {-# INLINE rule20 #-} - {-# LINE 500 "./src-ag/PrintCode.ag" #-} + {-# LINE 500 "src-ag/PrintCode.ag" #-} rule20 = \ ((_cataFunIpps) :: PP_Docs) ((_commentIpp) :: PP_Doc) ((_lhsIoptions) :: Options) ((_semWrapperIpps) :: PP_Docs) -> - {-# LINE 500 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 510 "src-ag/PrintCode.ag" #-} writeModule _outputfile [ pp $ _lhsIpragmaBlocks , pp $ Map.findWithDefault empty (BlockPragma, Just $ identifier name_) _lhsItextBlockMap @@ -451,9 +451,9 @@ ] {-# LINE 453 "dist/build/PrintCode.hs"#-} {-# INLINE rule22 #-} - {-# LINE 525 "./src-ag/PrintCode.ag" #-} + {-# LINE 525 "src-ag/PrintCode.ag" #-} rule22 = \ semNames_ -> - {-# LINE 525 "./src-ag/PrintCode.ag" #-} + {-# LINE 525 "src-ag/PrintCode.ag" #-} concat $ intersperse "," semNames_ {-# LINE 459 "dist/build/PrintCode.hs"#-} {-# INLINE rule23 #-} @@ -550,8 +550,8 @@ 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 arg = 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 arg) + 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) ) @@ -618,9 +618,9 @@ in __result_ ) in C_Chunks_s11 v10 {-# INLINE rule51 #-} - {-# LINE 88 "./src-ag/PrintCode.ag" #-} + {-# LINE 88 "src-ag/PrintCode.ag" #-} rule51 = \ ((_hdIpps) :: PP_Docs) ((_tlIpps) :: PP_Docs) -> - {-# LINE 88 "./src-ag/PrintCode.ag" #-} + {-# LINE 88 "src-ag/PrintCode.ag" #-} _hdIpps ++ _tlIpps {-# LINE 626 "dist/build/PrintCode.hs"#-} {-# INLINE rule52 #-} @@ -722,9 +722,9 @@ in __result_ ) in C_Chunks_s11 v10 {-# INLINE rule78 #-} - {-# LINE 89 "./src-ag/PrintCode.ag" #-} + {-# LINE 89 "src-ag/PrintCode.ag" #-} rule78 = \ (_ :: ()) -> - {-# LINE 89 "./src-ag/PrintCode.ag" #-} + {-# LINE 89 "src-ag/PrintCode.ag" #-} [] {-# LINE 730 "dist/build/PrintCode.hs"#-} {-# INLINE rule79 #-} @@ -749,8 +749,8 @@ wrap_DataAlt !(T_DataAlt act) !(Inh_DataAlt _lhsInested _lhsIstrictPre) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_DataAlt_vIn13 _lhsInested _lhsIstrictPre - !(T_DataAlt_vOut13 _lhsOpp) <- return (inv_DataAlt_s14 sem arg) + let arg13 = T_DataAlt_vIn13 _lhsInested _lhsIstrictPre + !(T_DataAlt_vOut13 _lhsOpp) <- return (inv_DataAlt_s14 sem arg13) return (Syn_DataAlt _lhsOpp) ) @@ -787,9 +787,9 @@ in __result_ ) in C_DataAlt_s14 v13 {-# INLINE rule83 #-} - {-# LINE 221 "./src-ag/PrintCode.ag" #-} + {-# LINE 221 "src-ag/PrintCode.ag" #-} rule83 = \ ((_argsIpps) :: PP_Docs) ((_lhsIstrictPre) :: PP_Doc) name_ -> - {-# LINE 221 "./src-ag/PrintCode.ag" #-} + {-# LINE 221 "src-ag/PrintCode.ag" #-} name_ >#< hv_sp (map ((_lhsIstrictPre >|<) . pp_parens) _argsIpps) {-# LINE 795 "dist/build/PrintCode.hs"#-} {-# INLINE rule84 #-} @@ -811,9 +811,9 @@ in __result_ ) in C_DataAlt_s14 v13 {-# INLINE rule85 #-} - {-# LINE 222 "./src-ag/PrintCode.ag" #-} + {-# LINE 222 "src-ag/PrintCode.ag" #-} rule85 = \ ((_argsIpps) :: PP_Docs) name_ -> - {-# LINE 222 "./src-ag/PrintCode.ag" #-} + {-# LINE 222 "src-ag/PrintCode.ag" #-} name_ >#< pp_block "{" "}" "," _argsIpps {-# LINE 819 "dist/build/PrintCode.hs"#-} {-# INLINE rule86 #-} @@ -829,8 +829,8 @@ wrap_DataAlts !(T_DataAlts act) !(Inh_DataAlts _lhsInested _lhsIstrictPre) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_DataAlts_vIn16 _lhsInested _lhsIstrictPre - !(T_DataAlts_vOut16 _lhsOpps) <- return (inv_DataAlts_s17 sem arg) + let arg16 = T_DataAlts_vIn16 _lhsInested _lhsIstrictPre + !(T_DataAlts_vOut16 _lhsOpps) <- return (inv_DataAlts_s17 sem arg16) return (Syn_DataAlts _lhsOpps) ) @@ -871,9 +871,9 @@ in __result_ ) in C_DataAlts_s17 v16 {-# INLINE rule87 #-} - {-# LINE 72 "./src-ag/PrintCode.ag" #-} + {-# LINE 72 "src-ag/PrintCode.ag" #-} rule87 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 72 "./src-ag/PrintCode.ag" #-} + {-# LINE 72 "src-ag/PrintCode.ag" #-} _hdIpp : _tlIpps {-# LINE 879 "dist/build/PrintCode.hs"#-} {-# INLINE rule88 #-} @@ -901,9 +901,9 @@ in __result_ ) in C_DataAlts_s17 v16 {-# INLINE rule92 #-} - {-# LINE 73 "./src-ag/PrintCode.ag" #-} + {-# LINE 73 "src-ag/PrintCode.ag" #-} rule92 = \ (_ :: ()) -> - {-# LINE 73 "./src-ag/PrintCode.ag" #-} + {-# LINE 73 "src-ag/PrintCode.ag" #-} [] {-# LINE 909 "dist/build/PrintCode.hs"#-} @@ -916,8 +916,8 @@ wrap_Decl !(T_Decl act) !(Inh_Decl _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile - !(T_Decl_vOut19 _lhsOpp) <- return (inv_Decl_s20 sem arg) + let arg19 = T_Decl_vIn19 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile + !(T_Decl_vOut19 _lhsOpp) <- return (inv_Decl_s20 sem arg19) return (Syn_Decl _lhsOpp) ) @@ -971,9 +971,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule93 #-} - {-# LINE 106 "./src-ag/PrintCode.ag" #-} + {-# LINE 106 "src-ag/PrintCode.ag" #-} rule93 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) -> - {-# LINE 106 "./src-ag/PrintCode.ag" #-} + {-# LINE 106 "src-ag/PrintCode.ag" #-} _leftIpp >#< "=" >-< indent 4 _rhsIpp {-# LINE 980 "dist/build/PrintCode.hs"#-} @@ -1022,9 +1022,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule101 #-} - {-# LINE 108 "./src-ag/PrintCode.ag" #-} + {-# LINE 108 "src-ag/PrintCode.ag" #-} rule101 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) -> - {-# LINE 108 "./src-ag/PrintCode.ag" #-} + {-# LINE 108 "src-ag/PrintCode.ag" #-} _leftIpp >#< "<-" >#< _rhsIpp {-# LINE 1030 "dist/build/PrintCode.hs"#-} {-# INLINE rule102 #-} @@ -1072,9 +1072,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule109 #-} - {-# LINE 109 "./src-ag/PrintCode.ag" #-} + {-# LINE 109 "src-ag/PrintCode.ag" #-} rule109 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) -> - {-# LINE 109 "./src-ag/PrintCode.ag" #-} + {-# LINE 109 "src-ag/PrintCode.ag" #-} "let" >#< _leftIpp >#< "=" >#< _rhsIpp {-# LINE 1080 "dist/build/PrintCode.hs"#-} {-# INLINE rule110 #-} @@ -1115,9 +1115,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule117 #-} - {-# LINE 110 "./src-ag/PrintCode.ag" #-} + {-# LINE 110 "src-ag/PrintCode.ag" #-} rule117 = \ ((_altsIpps) :: PP_Docs) derivings_ name_ params_ -> - {-# LINE 110 "./src-ag/PrintCode.ag" #-} + {-# LINE 110 "src-ag/PrintCode.ag" #-} "data" >#< hv_sp (name_ : params_) >#< ( case _altsIpps of [] -> empty @@ -1129,9 +1129,9 @@ ) {-# LINE 1131 "dist/build/PrintCode.hs"#-} {-# INLINE rule118 #-} - {-# LINE 325 "./src-ag/PrintCode.ag" #-} + {-# LINE 325 "src-ag/PrintCode.ag" #-} rule118 = \ strict_ -> - {-# LINE 325 "./src-ag/PrintCode.ag" #-} + {-# LINE 325 "src-ag/PrintCode.ag" #-} if strict_ then pp "!" else empty {-# LINE 1137 "dist/build/PrintCode.hs"#-} {-# INLINE rule119 #-} @@ -1153,9 +1153,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule120 #-} - {-# LINE 119 "./src-ag/PrintCode.ag" #-} + {-# LINE 119 "src-ag/PrintCode.ag" #-} rule120 = \ ((_tpIpp) :: PP_Doc) con_ name_ params_ -> - {-# LINE 119 "./src-ag/PrintCode.ag" #-} + {-# LINE 119 "src-ag/PrintCode.ag" #-} "newtype" >#< hv_sp (name_ : params_) >#< "=" >#< con_ >#< pp_parens _tpIpp {-# LINE 1161 "dist/build/PrintCode.hs"#-} {-# INLINE rule121 #-} @@ -1177,9 +1177,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule122 #-} - {-# LINE 120 "./src-ag/PrintCode.ag" #-} + {-# LINE 120 "src-ag/PrintCode.ag" #-} rule122 = \ ((_tpIpp) :: PP_Doc) name_ params_ -> - {-# LINE 120 "./src-ag/PrintCode.ag" #-} + {-# LINE 120 "src-ag/PrintCode.ag" #-} "type" >#< hv_sp (name_ : params_) >#< "=" >#< _tpIpp {-# LINE 1185 "dist/build/PrintCode.hs"#-} {-# INLINE rule123 #-} @@ -1201,9 +1201,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule124 #-} - {-# LINE 121 "./src-ag/PrintCode.ag" #-} + {-# LINE 121 "src-ag/PrintCode.ag" #-} rule124 = \ ((_tpIpp) :: PP_Doc) name_ -> - {-# LINE 121 "./src-ag/PrintCode.ag" #-} + {-# LINE 121 "src-ag/PrintCode.ag" #-} name_ >#< "::" >#< _tpIpp {-# LINE 1209 "dist/build/PrintCode.hs"#-} {-# INLINE rule125 #-} @@ -1222,9 +1222,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule126 #-} - {-# LINE 122 "./src-ag/PrintCode.ag" #-} + {-# LINE 122 "src-ag/PrintCode.ag" #-} rule126 = \ txt_ -> - {-# LINE 122 "./src-ag/PrintCode.ag" #-} + {-# LINE 122 "src-ag/PrintCode.ag" #-} if '\n' `elem` txt_ then "{-" >-< vlist (lines txt_) >-< "-}" else "--" >#< txt_ @@ -1242,9 +1242,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule127 #-} - {-# LINE 125 "./src-ag/PrintCode.ag" #-} + {-# LINE 125 "src-ag/PrintCode.ag" #-} rule127 = \ txt_ -> - {-# LINE 125 "./src-ag/PrintCode.ag" #-} + {-# LINE 125 "src-ag/PrintCode.ag" #-} "{-#" >#< text txt_ >#< "#-}" {-# LINE 1250 "dist/build/PrintCode.hs"#-} {-# NOINLINE sem_Decl_Resume #-} @@ -1271,9 +1271,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule128 #-} - {-# LINE 126 "./src-ag/PrintCode.ag" #-} + {-# LINE 126 "src-ag/PrintCode.ag" #-} rule128 = \ ((_leftIpp) :: PP_Doc) ((_rhsIpp) :: PP_Doc) monadic_ -> - {-# LINE 126 "./src-ag/PrintCode.ag" #-} + {-# LINE 126 "src-ag/PrintCode.ag" #-} if monadic_ then _leftIpp >#< "<-" >#< _rhsIpp else _leftIpp >#< "=" >-< indent 4 _rhsIpp @@ -1324,17 +1324,17 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule136 #-} - {-# LINE 129 "./src-ag/PrintCode.ag" #-} + {-# LINE 129 "src-ag/PrintCode.ag" #-} rule136 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 129 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 132 "src-ag/PrintCode.ag" #-} rule137 = \ ((_leftIpp) :: PP_Doc) ((_lhsIoptions) :: Options) ((_rhsIpp) :: PP_Doc) _strat nt_ -> - {-# LINE 132 "./src-ag/PrintCode.ag" #-} + {-# LINE 132 "src-ag/PrintCode.ag" #-} if breadthFirst _lhsIoptions then _leftIpp >#< "=" >#< "case" >#< _strat >#< pp_parens _rhsIpp >#< "of" >-< indent 4 ( @@ -1373,8 +1373,8 @@ wrap_Decls !(T_Decls act) !(Inh_Decls _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Decls_vIn22 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile - !(T_Decls_vOut22 _lhsOpps) <- return (inv_Decls_s23 sem arg) + let arg22 = T_Decls_vIn22 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile + !(T_Decls_vOut22 _lhsOpps) <- return (inv_Decls_s23 sem arg22) return (Syn_Decls _lhsOpps) ) @@ -1419,9 +1419,9 @@ in __result_ ) in C_Decls_s23 v22 {-# INLINE rule145 #-} - {-# LINE 84 "./src-ag/PrintCode.ag" #-} + {-# LINE 84 "src-ag/PrintCode.ag" #-} rule145 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 84 "./src-ag/PrintCode.ag" #-} + {-# LINE 84 "src-ag/PrintCode.ag" #-} _hdIpp : _tlIpps {-# LINE 1427 "dist/build/PrintCode.hs"#-} {-# INLINE rule146 #-} @@ -1461,9 +1461,9 @@ in __result_ ) in C_Decls_s23 v22 {-# INLINE rule154 #-} - {-# LINE 85 "./src-ag/PrintCode.ag" #-} + {-# LINE 85 "src-ag/PrintCode.ag" #-} rule154 = \ (_ :: ()) -> - {-# LINE 85 "./src-ag/PrintCode.ag" #-} + {-# LINE 85 "src-ag/PrintCode.ag" #-} [] {-# LINE 1469 "dist/build/PrintCode.hs"#-} @@ -1476,8 +1476,8 @@ wrap_Expr !(T_Expr act) !(Inh_Expr _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile - !(T_Expr_vOut25 _lhsOpp) <- return (inv_Expr_s26 sem arg) + let arg25 = T_Expr_vIn25 _lhsInested _lhsIoptions _lhsIoutputfile + !(T_Expr_vOut25 _lhsOpp) <- return (inv_Expr_s26 sem arg25) return (Syn_Expr _lhsOpp) ) @@ -1537,17 +1537,17 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule155 #-} - {-# LINE 140 "./src-ag/PrintCode.ag" #-} + {-# LINE 140 "src-ag/PrintCode.ag" #-} rule155 = \ ((_bodyIpp) :: PP_Doc) ((_declsIpps) :: PP_Docs) -> - {-# LINE 140 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 420 "src-ag/PrintCode.ag" #-} rule156 = \ (_ :: ()) -> - {-# LINE 420 "./src-ag/PrintCode.ag" #-} + {-# LINE 420 "src-ag/PrintCode.ag" #-} True {-# LINE 1553 "dist/build/PrintCode.hs"#-} {-# INLINE rule157 #-} @@ -1591,9 +1591,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule163 #-} - {-# LINE 143 "./src-ag/PrintCode.ag" #-} + {-# LINE 143 "src-ag/PrintCode.ag" #-} rule163 = \ ((_altsIpps) :: PP_Docs) ((_exprIpp) :: PP_Doc) -> - {-# LINE 143 "./src-ag/PrintCode.ag" #-} + {-# LINE 143 "src-ag/PrintCode.ag" #-} pp_parens ( "case" >#< pp_parens _exprIpp >#< "of" >-< (vlist _altsIpps) ) @@ -1640,17 +1640,17 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule170 #-} - {-# LINE 146 "./src-ag/PrintCode.ag" #-} + {-# LINE 146 "src-ag/PrintCode.ag" #-} rule170 = \ ((_bodyIpp) :: PP_Doc) ((_stmtsIpps) :: PP_Docs) -> - {-# LINE 146 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 422 "src-ag/PrintCode.ag" #-} rule171 = \ (_ :: ()) -> - {-# LINE 422 "./src-ag/PrintCode.ag" #-} + {-# LINE 422 "src-ag/PrintCode.ag" #-} False {-# LINE 1656 "dist/build/PrintCode.hs"#-} {-# INLINE rule172 #-} @@ -1696,25 +1696,25 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule178 #-} - {-# LINE 149 "./src-ag/PrintCode.ag" #-} + {-# LINE 149 "src-ag/PrintCode.ag" #-} rule178 = \ ((_argsIpps) :: PP_Docs) ((_lhsIoptions) :: Options) -> - {-# LINE 149 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 152 "src-ag/PrintCode.ag" #-} rule179 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 152 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 155 "src-ag/PrintCode.ag" #-} rule180 = \ _addBang ((_argsIpps) :: PP_Docs) ((_bodyIpp) :: PP_Doc) _strictParams -> - {-# LINE 155 "./src-ag/PrintCode.ag" #-} + {-# LINE 155 "src-ag/PrintCode.ag" #-} pp_parens ( "\\" >#< (vlist (map _addBang _argsIpps)) >#< "->" >-< indent 4 (_strictParams `ppMultiSeqV` _bodyIpp) ) @@ -1755,9 +1755,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule187 #-} - {-# LINE 158 "./src-ag/PrintCode.ag" #-} + {-# LINE 158 "src-ag/PrintCode.ag" #-} rule187 = \ ((_exprsIpps) :: PP_Docs) ((_lhsInested) :: Bool) -> - {-# LINE 158 "./src-ag/PrintCode.ag" #-} + {-# LINE 158 "src-ag/PrintCode.ag" #-} ppTuple _lhsInested _exprsIpps {-# LINE 1763 "dist/build/PrintCode.hs"#-} {-# INLINE rule188 #-} @@ -1787,9 +1787,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule191 #-} - {-# LINE 159 "./src-ag/PrintCode.ag" #-} + {-# LINE 159 "src-ag/PrintCode.ag" #-} rule191 = \ ((_exprsIpps) :: PP_Docs) ((_lhsInested) :: Bool) -> - {-# LINE 159 "./src-ag/PrintCode.ag" #-} + {-# LINE 159 "src-ag/PrintCode.ag" #-} ppUnboxedTuple _lhsInested _exprsIpps {-# LINE 1795 "dist/build/PrintCode.hs"#-} {-# INLINE rule192 #-} @@ -1819,9 +1819,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule195 #-} - {-# LINE 160 "./src-ag/PrintCode.ag" #-} + {-# LINE 160 "src-ag/PrintCode.ag" #-} rule195 = \ ((_argsIpps) :: PP_Docs) name_ -> - {-# LINE 160 "./src-ag/PrintCode.ag" #-} + {-# LINE 160 "src-ag/PrintCode.ag" #-} pp_parens $ name_ >#< hv_sp _argsIpps {-# LINE 1827 "dist/build/PrintCode.hs"#-} {-# INLINE rule196 #-} @@ -1846,9 +1846,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule199 #-} - {-# LINE 161 "./src-ag/PrintCode.ag" #-} + {-# LINE 161 "src-ag/PrintCode.ag" #-} rule199 = \ txt_ -> - {-# LINE 161 "./src-ag/PrintCode.ag" #-} + {-# LINE 161 "src-ag/PrintCode.ag" #-} text txt_ {-# LINE 1854 "dist/build/PrintCode.hs"#-} {-# NOINLINE sem_Expr_TextExpr #-} @@ -1864,9 +1864,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule200 #-} - {-# LINE 162 "./src-ag/PrintCode.ag" #-} + {-# LINE 162 "src-ag/PrintCode.ag" #-} rule200 = \ lns_ -> - {-# LINE 162 "./src-ag/PrintCode.ag" #-} + {-# LINE 162 "src-ag/PrintCode.ag" #-} vlist (map text lns_) {-# LINE 1872 "dist/build/PrintCode.hs"#-} {-# NOINLINE sem_Expr_Trace #-} @@ -1887,9 +1887,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule201 #-} - {-# LINE 163 "./src-ag/PrintCode.ag" #-} + {-# LINE 163 "src-ag/PrintCode.ag" #-} rule201 = \ ((_exprIpp) :: PP_Doc) txt_ -> - {-# LINE 163 "./src-ag/PrintCode.ag" #-} + {-# LINE 163 "src-ag/PrintCode.ag" #-} "trace" >#< ( pp_parens ("\"" >|< text txt_ >|< "\"") >-< pp_parens _exprIpp ) @@ -1921,9 +1921,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule205 #-} - {-# LINE 166 "./src-ag/PrintCode.ag" #-} + {-# LINE 166 "src-ag/PrintCode.ag" #-} rule205 = \ ((_exprIpp) :: PP_Doc) onLeftSide_ onNewLine_ txt_ -> - {-# LINE 166 "./src-ag/PrintCode.ag" #-} + {-# LINE 166 "src-ag/PrintCode.ag" #-} let pragmaDoc = "{-#" >#< txt_ >#< "#-}" op = if onNewLine_ then (>-<) @@ -1963,9 +1963,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule209 #-} - {-# LINE 177 "./src-ag/PrintCode.ag" #-} + {-# LINE 177 "src-ag/PrintCode.ag" #-} rule209 = \ ((_exprIpp) :: PP_Doc) ((_lhsIoutputfile) :: String) -> - {-# LINE 177 "./src-ag/PrintCode.ag" #-} + {-# LINE 177 "src-ag/PrintCode.ag" #-} _exprIpp >-< "{-# LINE" >#< ppWithLineNr (\n -> pp $ show $ n + 1) >#< show _lhsIoutputfile >#< "#-}" >-< "" {-# LINE 1972 "dist/build/PrintCode.hs"#-} @@ -1999,9 +1999,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule213 #-} - {-# LINE 179 "./src-ag/PrintCode.ag" #-} + {-# LINE 179 "src-ag/PrintCode.ag" #-} rule213 = \ ((_exprIpp) :: PP_Doc) ((_tpIpp) :: PP_Doc) -> - {-# LINE 179 "./src-ag/PrintCode.ag" #-} + {-# LINE 179 "src-ag/PrintCode.ag" #-} pp_parens (_exprIpp >#< "::" >#< _tpIpp) {-# LINE 2007 "dist/build/PrintCode.hs"#-} {-# INLINE rule214 #-} @@ -2034,9 +2034,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule218 #-} - {-# LINE 180 "./src-ag/PrintCode.ag" #-} + {-# LINE 180 "src-ag/PrintCode.ag" #-} rule218 = \ ((_exprIpp) :: PP_Doc) ((_lhsIoptions) :: Options) nt_ -> - {-# LINE 180 "./src-ag/PrintCode.ag" #-} + {-# LINE 180 "src-ag/PrintCode.ag" #-} if breadthFirst _lhsIoptions then "final" >#< pp_parens (nt_ >|< "_Syn" >#< pp_parens _exprIpp) @@ -2074,9 +2074,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule222 #-} - {-# LINE 184 "./src-ag/PrintCode.ag" #-} + {-# LINE 184 "src-ag/PrintCode.ag" #-} rule222 = \ ((_argsIpps) :: PP_Docs) ((_exprIpp) :: PP_Doc) ((_lhsIoptions) :: Options) nt_ -> - {-# LINE 184 "./src-ag/PrintCode.ag" #-} + {-# LINE 184 "src-ag/PrintCode.ag" #-} if breadthFirst _lhsIoptions then "invoke" >#< pp_parens _exprIpp >#< pp_parens ( nt_ >|< "_Inh" >#< pp_parens (ppTuple False _argsIpps)) @@ -2129,9 +2129,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule229 #-} - {-# LINE 188 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 188 "src-ag/PrintCode.ag" #-} if breadthFirst _lhsIoptions then pp_parens ("resume" >#< pp_parens _exprIpp >-< indent 2 (pp_parens ( "\\" >|< @@ -2146,9 +2146,9 @@ ) {-# LINE 2148 "dist/build/PrintCode.hs"#-} {-# INLINE rule230 #-} - {-# LINE 424 "./src-ag/PrintCode.ag" #-} + {-# LINE 424 "src-ag/PrintCode.ag" #-} rule230 = \ (_ :: ()) -> - {-# LINE 424 "./src-ag/PrintCode.ag" #-} + {-# LINE 424 "src-ag/PrintCode.ag" #-} False {-# LINE 2154 "dist/build/PrintCode.hs"#-} {-# INLINE rule231 #-} @@ -2203,25 +2203,25 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule240 #-} - {-# LINE 200 "./src-ag/PrintCode.ag" #-} + {-# LINE 200 "src-ag/PrintCode.ag" #-} rule240 = \ ((_argsIpps) :: PP_Docs) ((_lhsIoptions) :: Options) -> - {-# LINE 200 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 203 "src-ag/PrintCode.ag" #-} rule241 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 203 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 206 "src-ag/PrintCode.ag" #-} rule242 = \ _addBang ((_argsIpps) :: PP_Docs) ((_bodyIpp) :: PP_Doc) ((_lhsIoptions) :: Options) _strictParams nt_ -> - {-# LINE 206 "./src-ag/PrintCode.ag" #-} + {-# LINE 206 "src-ag/PrintCode.ag" #-} if breadthFirst _lhsIoptions then "Child" >#< pp_parens ( "\\" >|< pp_parens (nt_ >|< "_Inh" >#< @@ -2261,8 +2261,8 @@ wrap_Exprs !(T_Exprs act) !(Inh_Exprs _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Exprs_vIn28 _lhsInested _lhsIoptions _lhsIoutputfile - !(T_Exprs_vOut28 _lhsOpps) <- return (inv_Exprs_s29 sem arg) + let arg28 = T_Exprs_vIn28 _lhsInested _lhsIoptions _lhsIoutputfile + !(T_Exprs_vOut28 _lhsOpps) <- return (inv_Exprs_s29 sem arg28) return (Syn_Exprs _lhsOpps) ) @@ -2305,9 +2305,9 @@ in __result_ ) in C_Exprs_s29 v28 {-# INLINE rule249 #-} - {-# LINE 64 "./src-ag/PrintCode.ag" #-} + {-# LINE 64 "src-ag/PrintCode.ag" #-} rule249 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 64 "./src-ag/PrintCode.ag" #-} + {-# LINE 64 "src-ag/PrintCode.ag" #-} _hdIpp : _tlIpps {-# LINE 2313 "dist/build/PrintCode.hs"#-} {-# INLINE rule250 #-} @@ -2341,9 +2341,9 @@ in __result_ ) in C_Exprs_s29 v28 {-# INLINE rule256 #-} - {-# LINE 65 "./src-ag/PrintCode.ag" #-} + {-# LINE 65 "src-ag/PrintCode.ag" #-} rule256 = \ (_ :: ()) -> - {-# LINE 65 "./src-ag/PrintCode.ag" #-} + {-# LINE 65 "src-ag/PrintCode.ag" #-} [] {-# LINE 2349 "dist/build/PrintCode.hs"#-} @@ -2356,8 +2356,8 @@ wrap_Lhs !(T_Lhs act) !(Inh_Lhs _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile - !(T_Lhs_vOut31 _lhsOpp) <- return (inv_Lhs_s32 sem arg) + let arg31 = T_Lhs_vIn31 _lhsIisDeclOfLet _lhsInested _lhsIoptions _lhsIoutputfile + !(T_Lhs_vOut31 _lhsOpp) <- return (inv_Lhs_s32 sem arg31) return (Syn_Lhs _lhsOpp) ) @@ -2403,33 +2403,33 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule257 #-} - {-# LINE 231 "./src-ag/PrintCode.ag" #-} + {-# LINE 231 "src-ag/PrintCode.ag" #-} rule257 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> - {-# LINE 231 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 233 "src-ag/PrintCode.ag" #-} rule258 = \ ((_pat3IstrictVars) :: [PP_Doc]) -> - {-# LINE 233 "./src-ag/PrintCode.ag" #-} + {-# LINE 233 "src-ag/PrintCode.ag" #-} _pat3IstrictVars `ppMultiSeqH` (pp "True") {-# LINE 2417 "dist/build/PrintCode.hs"#-} {-# INLINE rule259 #-} - {-# LINE 234 "./src-ag/PrintCode.ag" #-} + {-# LINE 234 "src-ag/PrintCode.ag" #-} rule259 = \ ((_pat3IstrictVars) :: [PP_Doc]) -> - {-# LINE 234 "./src-ag/PrintCode.ag" #-} + {-# LINE 234 "src-ag/PrintCode.ag" #-} not (null _pat3IstrictVars) {-# LINE 2423 "dist/build/PrintCode.hs"#-} {-# INLINE rule260 #-} - {-# LINE 251 "./src-ag/PrintCode.ag" #-} + {-# LINE 251 "src-ag/PrintCode.ag" #-} rule260 = \ _addStrictGuard ((_pat3Ipp) :: PP_Doc) -> - {-# LINE 251 "./src-ag/PrintCode.ag" #-} + {-# LINE 251 "src-ag/PrintCode.ag" #-} _addStrictGuard _pat3Ipp {-# LINE 2429 "dist/build/PrintCode.hs"#-} {-# INLINE rule261 #-} - {-# LINE 385 "./src-ag/PrintCode.ag" #-} + {-# LINE 385 "src-ag/PrintCode.ag" #-} rule261 = \ (_ :: ()) -> - {-# LINE 385 "./src-ag/PrintCode.ag" #-} + {-# LINE 385 "src-ag/PrintCode.ag" #-} False {-# LINE 2435 "dist/build/PrintCode.hs"#-} {-# INLINE rule262 #-} @@ -2456,15 +2456,15 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule264 #-} - {-# LINE 252 "./src-ag/PrintCode.ag" #-} + {-# LINE 252 "src-ag/PrintCode.ag" #-} rule264 = \ ((_pat3Ipp') :: PP_Doc) -> - {-# LINE 252 "./src-ag/PrintCode.ag" #-} + {-# LINE 252 "src-ag/PrintCode.ag" #-} _pat3Ipp' {-# LINE 2464 "dist/build/PrintCode.hs"#-} {-# INLINE rule265 #-} - {-# LINE 385 "./src-ag/PrintCode.ag" #-} + {-# LINE 385 "src-ag/PrintCode.ag" #-} rule265 = \ (_ :: ()) -> - {-# LINE 385 "./src-ag/PrintCode.ag" #-} + {-# LINE 385 "src-ag/PrintCode.ag" #-} False {-# LINE 2470 "dist/build/PrintCode.hs"#-} {-# INLINE rule266 #-} @@ -2490,37 +2490,37 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule268 #-} - {-# LINE 231 "./src-ag/PrintCode.ag" #-} + {-# LINE 231 "src-ag/PrintCode.ag" #-} rule268 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> - {-# LINE 231 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 236 "src-ag/PrintCode.ag" #-} rule269 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) comps_ -> - {-# LINE 236 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 239 "src-ag/PrintCode.ag" #-} rule270 = \ comps_ -> - {-# LINE 239 "./src-ag/PrintCode.ag" #-} + {-# LINE 239 "src-ag/PrintCode.ag" #-} not (null comps_) {-# LINE 2512 "dist/build/PrintCode.hs"#-} {-# INLINE rule271 #-} - {-# LINE 247 "./src-ag/PrintCode.ag" #-} + {-# LINE 247 "src-ag/PrintCode.ag" #-} rule271 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 247 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 253 "src-ag/PrintCode.ag" #-} rule272 = \ _addBang _addStrictGuard ((_lhsInested) :: Bool) comps_ -> - {-# LINE 253 "./src-ag/PrintCode.ag" #-} + {-# LINE 253 "src-ag/PrintCode.ag" #-} _addStrictGuard $ ppTuple _lhsInested (map (_addBang . text) comps_) {-# LINE 2526 "dist/build/PrintCode.hs"#-} {-# NOINLINE sem_Lhs_UnboxedTupleLhs #-} @@ -2540,37 +2540,37 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule273 #-} - {-# LINE 231 "./src-ag/PrintCode.ag" #-} + {-# LINE 231 "src-ag/PrintCode.ag" #-} rule273 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> - {-# LINE 231 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 236 "src-ag/PrintCode.ag" #-} rule274 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) comps_ -> - {-# LINE 236 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 239 "src-ag/PrintCode.ag" #-} rule275 = \ comps_ -> - {-# LINE 239 "./src-ag/PrintCode.ag" #-} + {-# LINE 239 "src-ag/PrintCode.ag" #-} not (null comps_) {-# LINE 2562 "dist/build/PrintCode.hs"#-} {-# INLINE rule276 #-} - {-# LINE 247 "./src-ag/PrintCode.ag" #-} + {-# LINE 247 "src-ag/PrintCode.ag" #-} rule276 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 247 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 254 "src-ag/PrintCode.ag" #-} rule277 = \ _addBang _addStrictGuard ((_lhsInested) :: Bool) comps_ -> - {-# LINE 254 "./src-ag/PrintCode.ag" #-} + {-# LINE 254 "src-ag/PrintCode.ag" #-} _addStrictGuard $ ppUnboxedTuple _lhsInested (map (_addBang . text) comps_) {-# LINE 2576 "dist/build/PrintCode.hs"#-} {-# NOINLINE sem_Lhs_Fun #-} @@ -2595,35 +2595,35 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule278 #-} - {-# LINE 242 "./src-ag/PrintCode.ag" #-} + {-# LINE 242 "src-ag/PrintCode.ag" #-} rule278 = \ _hasStrictVars ((_lhsIoptions) :: Options) _strictGuard -> - {-# LINE 242 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 243 "src-ag/PrintCode.ag" #-} rule279 = \ ((_argsIpps) :: PP_Docs) -> - {-# LINE 243 "./src-ag/PrintCode.ag" #-} + {-# LINE 243 "src-ag/PrintCode.ag" #-} not (null _argsIpps) {-# LINE 2609 "dist/build/PrintCode.hs"#-} {-# INLINE rule280 #-} - {-# LINE 244 "./src-ag/PrintCode.ag" #-} + {-# LINE 244 "src-ag/PrintCode.ag" #-} rule280 = \ ((_argsIpps) :: PP_Docs) -> - {-# LINE 244 "./src-ag/PrintCode.ag" #-} + {-# LINE 244 "src-ag/PrintCode.ag" #-} _argsIpps `ppMultiSeqH` (pp "True") {-# LINE 2615 "dist/build/PrintCode.hs"#-} {-# INLINE rule281 #-} - {-# LINE 247 "./src-ag/PrintCode.ag" #-} + {-# LINE 247 "src-ag/PrintCode.ag" #-} rule281 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 247 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 255 "src-ag/PrintCode.ag" #-} rule282 = \ _addBang _addStrictGuard ((_argsIpps) :: PP_Docs) name_ -> - {-# LINE 255 "./src-ag/PrintCode.ag" #-} + {-# LINE 255 "src-ag/PrintCode.ag" #-} _addStrictGuard (name_ >#< hv_sp (map _addBang _argsIpps)) {-# LINE 2629 "dist/build/PrintCode.hs"#-} {-# INLINE rule283 #-} @@ -2654,9 +2654,9 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule286 #-} - {-# LINE 256 "./src-ag/PrintCode.ag" #-} + {-# LINE 256 "src-ag/PrintCode.ag" #-} rule286 = \ ((_subIpp) :: PP_Doc) name_ -> - {-# LINE 256 "./src-ag/PrintCode.ag" #-} + {-# LINE 256 "src-ag/PrintCode.ag" #-} pp_parens (name_ >#< _subIpp) {-# LINE 2662 "dist/build/PrintCode.hs"#-} {-# INLINE rule287 #-} @@ -2681,8 +2681,8 @@ wrap_NamedType !(T_NamedType act) !(Inh_NamedType _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_NamedType_vIn34 _lhsInested - !(T_NamedType_vOut34 _lhsOpp) <- return (inv_NamedType_s35 sem arg) + let arg34 = T_NamedType_vIn34 _lhsInested + !(T_NamedType_vOut34 _lhsOpp) <- return (inv_NamedType_s35 sem arg34) return (Syn_NamedType _lhsOpp) ) @@ -2718,9 +2718,9 @@ in __result_ ) in C_NamedType_s35 v34 {-# INLINE rule291 #-} - {-# LINE 225 "./src-ag/PrintCode.ag" #-} + {-# LINE 225 "src-ag/PrintCode.ag" #-} rule291 = \ ((_tpIpp) :: PP_Doc) name_ strict_ -> - {-# LINE 225 "./src-ag/PrintCode.ag" #-} + {-# LINE 225 "src-ag/PrintCode.ag" #-} if strict_ then name_ >#< "::" >#< "!" >|< pp_parens _tpIpp else name_ >#< "::" >#< _tpIpp @@ -2738,8 +2738,8 @@ wrap_NamedTypes !(T_NamedTypes act) !(Inh_NamedTypes _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_NamedTypes_vIn37 _lhsInested - !(T_NamedTypes_vOut37 _lhsOpps) <- return (inv_NamedTypes_s38 sem arg) + let arg37 = T_NamedTypes_vIn37 _lhsInested + !(T_NamedTypes_vOut37 _lhsOpps) <- return (inv_NamedTypes_s38 sem arg37) return (Syn_NamedTypes _lhsOpps) ) @@ -2778,9 +2778,9 @@ in __result_ ) in C_NamedTypes_s38 v37 {-# INLINE rule293 #-} - {-# LINE 80 "./src-ag/PrintCode.ag" #-} + {-# LINE 80 "src-ag/PrintCode.ag" #-} rule293 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 80 "./src-ag/PrintCode.ag" #-} + {-# LINE 80 "src-ag/PrintCode.ag" #-} _hdIpp : _tlIpps {-# LINE 2786 "dist/build/PrintCode.hs"#-} {-# INLINE rule294 #-} @@ -2802,9 +2802,9 @@ in __result_ ) in C_NamedTypes_s38 v37 {-# INLINE rule296 #-} - {-# LINE 81 "./src-ag/PrintCode.ag" #-} + {-# LINE 81 "src-ag/PrintCode.ag" #-} rule296 = \ (_ :: ()) -> - {-# LINE 81 "./src-ag/PrintCode.ag" #-} + {-# LINE 81 "src-ag/PrintCode.ag" #-} [] {-# LINE 2810 "dist/build/PrintCode.hs"#-} @@ -2817,8 +2817,8 @@ wrap_Pattern !(T_Pattern act) !(Inh_Pattern _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Pattern_vIn40 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions - !(T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp _lhsOpp' _lhsOstrictVars) <- return (inv_Pattern_s41 sem arg) + 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) ) @@ -2870,29 +2870,29 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule297 #-} - {-# LINE 357 "./src-ag/PrintCode.ag" #-} + {-# LINE 357 "src-ag/PrintCode.ag" #-} rule297 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) -> - {-# LINE 357 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 362 "src-ag/PrintCode.ag" #-} rule298 = \ _addBang ((_patsIpps) :: [PP_Doc]) name_ -> - {-# LINE 362 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 373 "src-ag/PrintCode.ag" #-} rule299 = \ (_ :: ()) -> - {-# LINE 373 "./src-ag/PrintCode.ag" #-} + {-# LINE 373 "src-ag/PrintCode.ag" #-} False {-# LINE 2892 "dist/build/PrintCode.hs"#-} {-# INLINE rule300 #-} - {-# LINE 396 "./src-ag/PrintCode.ag" #-} + {-# LINE 396 "src-ag/PrintCode.ag" #-} rule300 = \ ((_patsIpps') :: [PP_Doc]) name_ -> - {-# LINE 396 "./src-ag/PrintCode.ag" #-} + {-# LINE 396 "src-ag/PrintCode.ag" #-} pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps') {-# LINE 2898 "dist/build/PrintCode.hs"#-} {-# INLINE rule301 #-} @@ -2941,29 +2941,29 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule307 #-} - {-# LINE 357 "./src-ag/PrintCode.ag" #-} + {-# LINE 357 "src-ag/PrintCode.ag" #-} rule307 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) -> - {-# LINE 357 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 363 "src-ag/PrintCode.ag" #-} rule308 = \ _addBang ((_patsIpps) :: [PP_Doc]) -> - {-# LINE 363 "./src-ag/PrintCode.ag" #-} + {-# LINE 363 "src-ag/PrintCode.ag" #-} _addBang $ pp_block "(" ")" "," _patsIpps {-# LINE 2957 "dist/build/PrintCode.hs"#-} {-# INLINE rule309 #-} - {-# LINE 374 "./src-ag/PrintCode.ag" #-} + {-# LINE 374 "src-ag/PrintCode.ag" #-} rule309 = \ (_ :: ()) -> - {-# LINE 374 "./src-ag/PrintCode.ag" #-} + {-# LINE 374 "src-ag/PrintCode.ag" #-} False {-# LINE 2963 "dist/build/PrintCode.hs"#-} {-# INLINE rule310 #-} - {-# LINE 397 "./src-ag/PrintCode.ag" #-} + {-# LINE 397 "src-ag/PrintCode.ag" #-} rule310 = \ ((_patsIpps') :: [PP_Doc]) -> - {-# LINE 397 "./src-ag/PrintCode.ag" #-} + {-# LINE 397 "src-ag/PrintCode.ag" #-} pp_block "(" ")" "," _patsIpps' {-# LINE 2969 "dist/build/PrintCode.hs"#-} {-# INLINE rule311 #-} @@ -3016,65 +3016,65 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule317 #-} - {-# LINE 335 "./src-ag/PrintCode.ag" #-} + {-# LINE 335 "src-ag/PrintCode.ag" #-} rule317 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) _ppVar -> - {-# LINE 335 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 339 "src-ag/PrintCode.ag" #-} rule318 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) ((_patIstrictVars) :: [PP_Doc]) -> - {-# LINE 339 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 343 "src-ag/PrintCode.ag" #-} rule319 = \ _strictPatVars _strictVar -> - {-# LINE 343 "./src-ag/PrintCode.ag" #-} + {-# LINE 343 "src-ag/PrintCode.ag" #-} _strictVar ++ _strictPatVars {-# LINE 3040 "dist/build/PrintCode.hs"#-} {-# INLINE rule320 #-} - {-# LINE 357 "./src-ag/PrintCode.ag" #-} + {-# LINE 357 "src-ag/PrintCode.ag" #-} rule320 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) -> - {-# LINE 357 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 364 "src-ag/PrintCode.ag" #-} rule321 = \ ((_lhsIoptions) :: Options) attr_ field_ -> - {-# LINE 364 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 365 "src-ag/PrintCode.ag" #-} rule322 = \ _addBang _ppVar -> - {-# LINE 365 "./src-ag/PrintCode.ag" #-} + {-# LINE 365 "src-ag/PrintCode.ag" #-} _addBang $ _ppVar {-# LINE 3060 "dist/build/PrintCode.hs"#-} {-# INLINE rule323 #-} - {-# LINE 366 "./src-ag/PrintCode.ag" #-} + {-# LINE 366 "src-ag/PrintCode.ag" #-} rule323 = \ ((_patIisUnderscore) :: Bool) ((_patIpp) :: PP_Doc) _ppVarBang -> - {-# LINE 366 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 375 "src-ag/PrintCode.ag" #-} rule324 = \ (_ :: ()) -> - {-# LINE 375 "./src-ag/PrintCode.ag" #-} + {-# LINE 375 "src-ag/PrintCode.ag" #-} False {-# LINE 3074 "dist/build/PrintCode.hs"#-} {-# INLINE rule325 #-} - {-# LINE 398 "./src-ag/PrintCode.ag" #-} + {-# LINE 398 "src-ag/PrintCode.ag" #-} rule325 = \ ((_lhsIoptions) :: Options) ((_patIpp') :: PP_Doc) attr_ field_ -> - {-# LINE 398 "./src-ag/PrintCode.ag" #-} + {-# LINE 398 "src-ag/PrintCode.ag" #-} let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_ | otherwise = attrname _lhsIoptions False field_ attr_ in attribute >|< "@" >|< _patIpp' @@ -3121,27 +3121,27 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule331 #-} - {-# LINE 345 "./src-ag/PrintCode.ag" #-} + {-# LINE 345 "src-ag/PrintCode.ag" #-} rule331 = \ (_ :: ()) -> - {-# LINE 345 "./src-ag/PrintCode.ag" #-} + {-# LINE 345 "src-ag/PrintCode.ag" #-} [] {-# LINE 3129 "dist/build/PrintCode.hs"#-} {-# INLINE rule332 #-} - {-# LINE 369 "./src-ag/PrintCode.ag" #-} + {-# LINE 369 "src-ag/PrintCode.ag" #-} rule332 = \ ((_patIpp) :: PP_Doc) -> - {-# LINE 369 "./src-ag/PrintCode.ag" #-} + {-# LINE 369 "src-ag/PrintCode.ag" #-} text "~" >|< pp_parens _patIpp {-# LINE 3135 "dist/build/PrintCode.hs"#-} {-# INLINE rule333 #-} - {-# LINE 381 "./src-ag/PrintCode.ag" #-} + {-# LINE 381 "src-ag/PrintCode.ag" #-} rule333 = \ (_ :: ()) -> - {-# LINE 381 "./src-ag/PrintCode.ag" #-} + {-# LINE 381 "src-ag/PrintCode.ag" #-} True {-# LINE 3141 "dist/build/PrintCode.hs"#-} {-# INLINE rule334 #-} - {-# LINE 401 "./src-ag/PrintCode.ag" #-} + {-# LINE 401 "src-ag/PrintCode.ag" #-} rule334 = \ ((_patIpp) :: PP_Doc) -> - {-# LINE 401 "./src-ag/PrintCode.ag" #-} + {-# LINE 401 "src-ag/PrintCode.ag" #-} text "~" >|< pp_parens _patIpp {-# LINE 3147 "dist/build/PrintCode.hs"#-} {-# INLINE rule335 #-} @@ -3181,21 +3181,21 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule340 #-} - {-# LINE 370 "./src-ag/PrintCode.ag" #-} + {-# LINE 370 "src-ag/PrintCode.ag" #-} rule340 = \ (_ :: ()) -> - {-# LINE 370 "./src-ag/PrintCode.ag" #-} + {-# LINE 370 "src-ag/PrintCode.ag" #-} text "_" {-# LINE 3189 "dist/build/PrintCode.hs"#-} {-# INLINE rule341 #-} - {-# LINE 376 "./src-ag/PrintCode.ag" #-} + {-# LINE 376 "src-ag/PrintCode.ag" #-} rule341 = \ (_ :: ()) -> - {-# LINE 376 "./src-ag/PrintCode.ag" #-} + {-# LINE 376 "src-ag/PrintCode.ag" #-} True {-# LINE 3195 "dist/build/PrintCode.hs"#-} {-# INLINE rule342 #-} - {-# LINE 402 "./src-ag/PrintCode.ag" #-} + {-# LINE 402 "src-ag/PrintCode.ag" #-} rule342 = \ (_ :: ()) -> - {-# LINE 402 "./src-ag/PrintCode.ag" #-} + {-# LINE 402 "src-ag/PrintCode.ag" #-} text "_" {-# LINE 3201 "dist/build/PrintCode.hs"#-} {-# INLINE rule343 #-} @@ -3217,8 +3217,8 @@ wrap_Patterns !(T_Patterns act) !(Inh_Patterns _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Patterns_vIn43 _lhsIbelowIrrefutable _lhsIisDeclOfLet _lhsIoptions - !(T_Patterns_vOut43 _lhsOcopy _lhsOpps _lhsOpps' _lhsOstrictVars) <- return (inv_Patterns_s44 sem arg) + 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) ) @@ -3268,15 +3268,15 @@ in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule346 #-} - {-# LINE 352 "./src-ag/PrintCode.ag" #-} + {-# LINE 352 "src-ag/PrintCode.ag" #-} rule346 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: [PP_Doc]) -> - {-# LINE 352 "./src-ag/PrintCode.ag" #-} + {-# LINE 352 "src-ag/PrintCode.ag" #-} _hdIpp : _tlIpps {-# LINE 3276 "dist/build/PrintCode.hs"#-} {-# INLINE rule347 #-} - {-# LINE 392 "./src-ag/PrintCode.ag" #-} + {-# LINE 392 "src-ag/PrintCode.ag" #-} rule347 = \ ((_hdIpp') :: PP_Doc) ((_tlIpps') :: [PP_Doc]) -> - {-# LINE 392 "./src-ag/PrintCode.ag" #-} + {-# LINE 392 "src-ag/PrintCode.ag" #-} _hdIpp' : _tlIpps' {-# LINE 3282 "dist/build/PrintCode.hs"#-} {-# INLINE rule348 #-} @@ -3326,15 +3326,15 @@ in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule357 #-} - {-# LINE 353 "./src-ag/PrintCode.ag" #-} + {-# LINE 353 "src-ag/PrintCode.ag" #-} rule357 = \ (_ :: ()) -> - {-# LINE 353 "./src-ag/PrintCode.ag" #-} + {-# LINE 353 "src-ag/PrintCode.ag" #-} [] {-# LINE 3334 "dist/build/PrintCode.hs"#-} {-# INLINE rule358 #-} - {-# LINE 393 "./src-ag/PrintCode.ag" #-} + {-# LINE 393 "src-ag/PrintCode.ag" #-} rule358 = \ (_ :: ()) -> - {-# LINE 393 "./src-ag/PrintCode.ag" #-} + {-# LINE 393 "src-ag/PrintCode.ag" #-} [] {-# LINE 3340 "dist/build/PrintCode.hs"#-} {-# INLINE rule359 #-} @@ -3356,8 +3356,8 @@ 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 arg = T_Program_vIn46 _lhsIimportBlocks _lhsImainBlocksDoc _lhsImainFile _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIoptionsLine _lhsIpragmaBlocks _lhsItextBlockMap _lhsItextBlocks - !(T_Program_vOut46 _lhsOgenIO _lhsOoutput) <- return (inv_Program_s47 sem arg) + 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) ) @@ -3410,39 +3410,39 @@ in __result_ ) in C_Program_s47 v46 {-# INLINE rule362 #-} - {-# LINE 58 "./src-ag/PrintCode.ag" #-} + {-# LINE 58 "src-ag/PrintCode.ag" #-} rule362 = \ ((_lhsIoptions) :: Options) ordered_ -> - {-# LINE 58 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 61 "src-ag/PrintCode.ag" #-} rule363 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 61 "./src-ag/PrintCode.ag" #-} + {-# LINE 61 "src-ag/PrintCode.ag" #-} nest _lhsIoptions {-# LINE 3424 "dist/build/PrintCode.hs"#-} {-# INLINE rule364 #-} - {-# LINE 93 "./src-ag/PrintCode.ag" #-} + {-# LINE 93 "src-ag/PrintCode.ag" #-} rule364 = \ ((_chunksIpps) :: PP_Docs) -> - {-# LINE 93 "./src-ag/PrintCode.ag" #-} + {-# LINE 93 "src-ag/PrintCode.ag" #-} _chunksIpps {-# LINE 3430 "dist/build/PrintCode.hs"#-} {-# INLINE rule365 #-} - {-# LINE 416 "./src-ag/PrintCode.ag" #-} + {-# LINE 416 "src-ag/PrintCode.ag" #-} rule365 = \ (_ :: ()) -> - {-# LINE 416 "./src-ag/PrintCode.ag" #-} + {-# LINE 416 "src-ag/PrintCode.ag" #-} False {-# LINE 3436 "dist/build/PrintCode.hs"#-} {-# INLINE rule366 #-} - {-# LINE 450 "./src-ag/PrintCode.ag" #-} + {-# LINE 450 "src-ag/PrintCode.ag" #-} rule366 = \ ((_lhsImainFile) :: String) -> - {-# LINE 450 "./src-ag/PrintCode.ag" #-} + {-# LINE 450 "src-ag/PrintCode.ag" #-} _lhsImainFile {-# LINE 3442 "dist/build/PrintCode.hs"#-} {-# INLINE rule367 #-} - {-# LINE 452 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 452 "src-ag/PrintCode.ag" #-} writeModule _mainModuleFile ( [ pp $ _lhsIpragmaBlocks , pp $ _lhsIoptionsLine @@ -3455,15 +3455,15 @@ ) {-# LINE 3457 "dist/build/PrintCode.hs"#-} {-# INLINE rule368 #-} - {-# LINE 463 "./src-ag/PrintCode.ag" #-} + {-# LINE 463 "src-ag/PrintCode.ag" #-} rule368 = \ ((_lhsImainFile) :: String) -> - {-# LINE 463 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 465 "src-ag/PrintCode.ag" #-} writeModule _commonFile ( [ pp $ _lhsIpragmaBlocks , pp $ _lhsIoptionsLine @@ -3475,9 +3475,9 @@ ) {-# LINE 3477 "dist/build/PrintCode.hs"#-} {-# INLINE rule370 #-} - {-# LINE 475 "./src-ag/PrintCode.ag" #-} + {-# LINE 475 "src-ag/PrintCode.ag" #-} rule370 = \ ((_chunksIgenSems) :: IO ()) _genCommonModule _genMainModule -> - {-# LINE 475 "./src-ag/PrintCode.ag" #-} + {-# LINE 475 "src-ag/PrintCode.ag" #-} do _genMainModule _genCommonModule _chunksIgenSems @@ -3519,8 +3519,8 @@ wrap_Type !(T_Type act) !(Inh_Type _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Type_vIn49 _lhsInested - !(T_Type_vOut49 _lhsOpp _lhsOprec) <- return (inv_Type_s50 sem arg) + let arg49 = T_Type_vIn49 _lhsInested + !(T_Type_vOut49 _lhsOpp _lhsOprec) <- return (inv_Type_s50 sem arg49) return (Syn_Type _lhsOpp _lhsOprec) ) @@ -3577,27 +3577,27 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule380 #-} - {-# LINE 259 "./src-ag/PrintCode.ag" #-} + {-# LINE 259 "src-ag/PrintCode.ag" #-} rule380 = \ (_ :: ()) -> - {-# LINE 259 "./src-ag/PrintCode.ag" #-} + {-# LINE 259 "src-ag/PrintCode.ag" #-} 2 {-# LINE 3585 "dist/build/PrintCode.hs"#-} {-# INLINE rule381 #-} - {-# LINE 260 "./src-ag/PrintCode.ag" #-} + {-# LINE 260 "src-ag/PrintCode.ag" #-} rule381 = \ _l _r -> - {-# LINE 260 "./src-ag/PrintCode.ag" #-} + {-# LINE 260 "src-ag/PrintCode.ag" #-} _l >#< "->" >-< _r {-# LINE 3591 "dist/build/PrintCode.hs"#-} {-# INLINE rule382 #-} - {-# LINE 261 "./src-ag/PrintCode.ag" #-} + {-# LINE 261 "src-ag/PrintCode.ag" #-} rule382 = \ ((_leftIpp) :: PP_Doc) ((_leftIprec) :: Int) -> - {-# LINE 261 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 262 "src-ag/PrintCode.ag" #-} rule383 = \ ((_rightIpp) :: PP_Doc) ((_rightIprec) :: Int) -> - {-# LINE 262 "./src-ag/PrintCode.ag" #-} + {-# LINE 262 "src-ag/PrintCode.ag" #-} if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp {-# LINE 3603 "dist/build/PrintCode.hs"#-} {-# INLINE rule384 #-} @@ -3624,9 +3624,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule386 #-} - {-# LINE 268 "./src-ag/PrintCode.ag" #-} + {-# LINE 268 "src-ag/PrintCode.ag" #-} rule386 = \ ((_rightIpp) :: PP_Doc) left_ -> - {-# LINE 268 "./src-ag/PrintCode.ag" #-} + {-# 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 #-} @@ -3653,9 +3653,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule389 #-} - {-# LINE 270 "./src-ag/PrintCode.ag" #-} + {-# LINE 270 "src-ag/PrintCode.ag" #-} rule389 = \ ((_rightIpp) :: PP_Doc) left_ -> - {-# LINE 270 "./src-ag/PrintCode.ag" #-} + {-# LINE 270 "src-ag/PrintCode.ag" #-} left_ >#< _rightIpp {-# LINE 3661 "dist/build/PrintCode.hs"#-} {-# INLINE rule390 #-} @@ -3685,9 +3685,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule392 #-} - {-# LINE 265 "./src-ag/PrintCode.ag" #-} + {-# LINE 265 "src-ag/PrintCode.ag" #-} rule392 = \ ((_argsIpps) :: PP_Docs) ((_funcIpp) :: PP_Doc) -> - {-# LINE 265 "./src-ag/PrintCode.ag" #-} + {-# LINE 265 "src-ag/PrintCode.ag" #-} hv_sp (_funcIpp : _argsIpps) {-# LINE 3693 "dist/build/PrintCode.hs"#-} {-# INLINE rule393 #-} @@ -3717,15 +3717,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule396 #-} - {-# LINE 272 "./src-ag/PrintCode.ag" #-} + {-# LINE 272 "src-ag/PrintCode.ag" #-} rule396 = \ (_ :: ()) -> - {-# LINE 272 "./src-ag/PrintCode.ag" #-} + {-# LINE 272 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3725 "dist/build/PrintCode.hs"#-} {-# INLINE rule397 #-} - {-# LINE 273 "./src-ag/PrintCode.ag" #-} + {-# LINE 273 "src-ag/PrintCode.ag" #-} rule397 = \ ((_lhsInested) :: Bool) ((_tpsIpps) :: PP_Docs) -> - {-# LINE 273 "./src-ag/PrintCode.ag" #-} + {-# LINE 273 "src-ag/PrintCode.ag" #-} ppTuple _lhsInested _tpsIpps {-# LINE 3731 "dist/build/PrintCode.hs"#-} {-# INLINE rule398 #-} @@ -3749,15 +3749,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule399 #-} - {-# LINE 275 "./src-ag/PrintCode.ag" #-} + {-# LINE 275 "src-ag/PrintCode.ag" #-} rule399 = \ (_ :: ()) -> - {-# LINE 275 "./src-ag/PrintCode.ag" #-} + {-# LINE 275 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3757 "dist/build/PrintCode.hs"#-} {-# INLINE rule400 #-} - {-# LINE 276 "./src-ag/PrintCode.ag" #-} + {-# LINE 276 "src-ag/PrintCode.ag" #-} rule400 = \ ((_lhsInested) :: Bool) ((_tpsIpps) :: PP_Docs) -> - {-# LINE 276 "./src-ag/PrintCode.ag" #-} + {-# LINE 276 "src-ag/PrintCode.ag" #-} ppUnboxedTuple _lhsInested _tpsIpps {-# LINE 3763 "dist/build/PrintCode.hs"#-} {-# INLINE rule401 #-} @@ -3781,15 +3781,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule402 #-} - {-# LINE 278 "./src-ag/PrintCode.ag" #-} + {-# LINE 278 "src-ag/PrintCode.ag" #-} rule402 = \ (_ :: ()) -> - {-# LINE 278 "./src-ag/PrintCode.ag" #-} + {-# LINE 278 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3789 "dist/build/PrintCode.hs"#-} {-# INLINE rule403 #-} - {-# LINE 279 "./src-ag/PrintCode.ag" #-} + {-# LINE 279 "src-ag/PrintCode.ag" #-} rule403 = \ ((_tpIpp) :: PP_Doc) -> - {-# LINE 279 "./src-ag/PrintCode.ag" #-} + {-# LINE 279 "src-ag/PrintCode.ag" #-} "[" >|< _tpIpp >|< "]" {-# LINE 3795 "dist/build/PrintCode.hs"#-} {-# INLINE rule404 #-} @@ -3810,15 +3810,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule405 #-} - {-# LINE 281 "./src-ag/PrintCode.ag" #-} + {-# LINE 281 "src-ag/PrintCode.ag" #-} rule405 = \ (_ :: ()) -> - {-# LINE 281 "./src-ag/PrintCode.ag" #-} + {-# LINE 281 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3818 "dist/build/PrintCode.hs"#-} {-# INLINE rule406 #-} - {-# LINE 282 "./src-ag/PrintCode.ag" #-} + {-# LINE 282 "src-ag/PrintCode.ag" #-} rule406 = \ txt_ -> - {-# LINE 282 "./src-ag/PrintCode.ag" #-} + {-# 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 #-} @@ -3837,21 +3837,21 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule407 #-} - {-# LINE 284 "./src-ag/PrintCode.ag" #-} + {-# LINE 284 "src-ag/PrintCode.ag" #-} rule407 = \ (_ :: ()) -> - {-# LINE 284 "./src-ag/PrintCode.ag" #-} + {-# LINE 284 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3845 "dist/build/PrintCode.hs"#-} {-# INLINE rule408 #-} - {-# LINE 285 "./src-ag/PrintCode.ag" #-} + {-# LINE 285 "src-ag/PrintCode.ag" #-} rule408 = \ _prefix name_ params_ -> - {-# LINE 285 "./src-ag/PrintCode.ag" #-} + {-# 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" #-} + {-# LINE 286 "src-ag/PrintCode.ag" #-} rule409 = \ deforested_ -> - {-# LINE 286 "./src-ag/PrintCode.ag" #-} + {-# LINE 286 "src-ag/PrintCode.ag" #-} if deforested_ then text "T_" else empty @@ -3874,15 +3874,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule410 #-} - {-# LINE 289 "./src-ag/PrintCode.ag" #-} + {-# LINE 289 "src-ag/PrintCode.ag" #-} rule410 = \ (_ :: ()) -> - {-# LINE 289 "./src-ag/PrintCode.ag" #-} + {-# LINE 289 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3882 "dist/build/PrintCode.hs"#-} {-# INLINE rule411 #-} - {-# LINE 290 "./src-ag/PrintCode.ag" #-} + {-# LINE 290 "src-ag/PrintCode.ag" #-} rule411 = \ ((_tpIpp) :: PP_Doc) -> - {-# LINE 290 "./src-ag/PrintCode.ag" #-} + {-# LINE 290 "src-ag/PrintCode.ag" #-} text "Maybe" >#< pp_parens _tpIpp {-# LINE 3888 "dist/build/PrintCode.hs"#-} {-# INLINE rule412 #-} @@ -3909,15 +3909,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule413 #-} - {-# LINE 291 "./src-ag/PrintCode.ag" #-} + {-# LINE 291 "src-ag/PrintCode.ag" #-} rule413 = \ (_ :: ()) -> - {-# LINE 291 "./src-ag/PrintCode.ag" #-} + {-# LINE 291 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3917 "dist/build/PrintCode.hs"#-} {-# INLINE rule414 #-} - {-# LINE 292 "./src-ag/PrintCode.ag" #-} + {-# LINE 292 "src-ag/PrintCode.ag" #-} rule414 = \ ((_leftIpp) :: PP_Doc) ((_rightIpp) :: PP_Doc) -> - {-# LINE 292 "./src-ag/PrintCode.ag" #-} + {-# LINE 292 "src-ag/PrintCode.ag" #-} text "Either" >#< pp_parens _leftIpp >#< pp_parens _rightIpp {-# LINE 3923 "dist/build/PrintCode.hs"#-} {-# INLINE rule415 #-} @@ -3947,15 +3947,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule417 #-} - {-# LINE 293 "./src-ag/PrintCode.ag" #-} + {-# LINE 293 "src-ag/PrintCode.ag" #-} rule417 = \ (_ :: ()) -> - {-# LINE 293 "./src-ag/PrintCode.ag" #-} + {-# LINE 293 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3955 "dist/build/PrintCode.hs"#-} {-# INLINE rule418 #-} - {-# LINE 294 "./src-ag/PrintCode.ag" #-} + {-# LINE 294 "src-ag/PrintCode.ag" #-} rule418 = \ ((_keyIpp) :: PP_Doc) ((_valueIpp) :: PP_Doc) -> - {-# LINE 294 "./src-ag/PrintCode.ag" #-} + {-# LINE 294 "src-ag/PrintCode.ag" #-} text "Data.Map.Map" >#< pp_parens _keyIpp >#< pp_parens _valueIpp {-# LINE 3961 "dist/build/PrintCode.hs"#-} {-# INLINE rule419 #-} @@ -3982,15 +3982,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule421 #-} - {-# LINE 295 "./src-ag/PrintCode.ag" #-} + {-# LINE 295 "src-ag/PrintCode.ag" #-} rule421 = \ (_ :: ()) -> - {-# LINE 295 "./src-ag/PrintCode.ag" #-} + {-# LINE 295 "src-ag/PrintCode.ag" #-} 5 {-# LINE 3990 "dist/build/PrintCode.hs"#-} {-# INLINE rule422 #-} - {-# LINE 296 "./src-ag/PrintCode.ag" #-} + {-# LINE 296 "src-ag/PrintCode.ag" #-} rule422 = \ ((_valueIpp) :: PP_Doc) -> - {-# LINE 296 "./src-ag/PrintCode.ag" #-} + {-# LINE 296 "src-ag/PrintCode.ag" #-} text "Data.IntMap.IntMap" >#< pp_parens _valueIpp {-# LINE 3996 "dist/build/PrintCode.hs"#-} {-# INLINE rule423 #-} @@ -4014,15 +4014,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule424 #-} - {-# LINE 297 "./src-ag/PrintCode.ag" #-} + {-# LINE 297 "src-ag/PrintCode.ag" #-} rule424 = \ (_ :: ()) -> - {-# LINE 297 "./src-ag/PrintCode.ag" #-} + {-# LINE 297 "src-ag/PrintCode.ag" #-} 5 {-# LINE 4022 "dist/build/PrintCode.hs"#-} {-# INLINE rule425 #-} - {-# LINE 298 "./src-ag/PrintCode.ag" #-} + {-# LINE 298 "src-ag/PrintCode.ag" #-} rule425 = \ ((_tpIpp) :: PP_Doc) -> - {-# LINE 298 "./src-ag/PrintCode.ag" #-} + {-# LINE 298 "src-ag/PrintCode.ag" #-} text "Data.Set.Set" >#< pp_parens _tpIpp {-# LINE 4028 "dist/build/PrintCode.hs"#-} {-# INLINE rule426 #-} @@ -4043,15 +4043,15 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule427 #-} - {-# LINE 299 "./src-ag/PrintCode.ag" #-} + {-# LINE 299 "src-ag/PrintCode.ag" #-} rule427 = \ (_ :: ()) -> - {-# LINE 299 "./src-ag/PrintCode.ag" #-} + {-# LINE 299 "src-ag/PrintCode.ag" #-} 5 {-# LINE 4051 "dist/build/PrintCode.hs"#-} {-# INLINE rule428 #-} - {-# LINE 300 "./src-ag/PrintCode.ag" #-} + {-# LINE 300 "src-ag/PrintCode.ag" #-} rule428 = \ (_ :: ()) -> - {-# LINE 300 "./src-ag/PrintCode.ag" #-} + {-# LINE 300 "src-ag/PrintCode.ag" #-} text "Data.IntSet.IntSet" {-# LINE 4057 "dist/build/PrintCode.hs"#-} @@ -4064,8 +4064,8 @@ wrap_Types !(T_Types act) !(Inh_Types _lhsInested) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Types_vIn52 _lhsInested - !(T_Types_vOut52 _lhsOpps) <- return (inv_Types_s53 sem arg) + let arg52 = T_Types_vIn52 _lhsInested + !(T_Types_vOut52 _lhsOpps) <- return (inv_Types_s53 sem arg52) return (Syn_Types _lhsOpps) ) @@ -4104,9 +4104,9 @@ in __result_ ) in C_Types_s53 v52 {-# INLINE rule429 #-} - {-# LINE 76 "./src-ag/PrintCode.ag" #-} + {-# LINE 76 "src-ag/PrintCode.ag" #-} rule429 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 76 "./src-ag/PrintCode.ag" #-} + {-# LINE 76 "src-ag/PrintCode.ag" #-} _hdIpp : _tlIpps {-# LINE 4112 "dist/build/PrintCode.hs"#-} {-# INLINE rule430 #-} @@ -4128,8 +4128,8 @@ in __result_ ) in C_Types_s53 v52 {-# INLINE rule432 #-} - {-# LINE 77 "./src-ag/PrintCode.ag" #-} + {-# LINE 77 "src-ag/PrintCode.ag" #-} rule432 = \ (_ :: ()) -> - {-# LINE 77 "./src-ag/PrintCode.ag" #-} + {-# LINE 77 "src-ag/PrintCode.ag" #-} [] {-# LINE 4136 "dist/build/PrintCode.hs"#-} diff --git a/src-generated/PrintErrorMessages.hs b/src-generated/PrintErrorMessages.hs --- a/src-generated/PrintErrorMessages.hs +++ b/src-generated/PrintErrorMessages.hs @@ -2,7 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} module PrintErrorMessages where -{-# LINE 2 "./src-ag/ErrorMessages.ag" #-} +{-# LINE 2 "src-ag/ErrorMessages.ag" #-} import UU.Scanner.Position(Pos) import Pretty @@ -10,7 +10,7 @@ import CommonTypes {-# LINE 12 "dist/build/PrintErrorMessages.hs" #-} -{-# LINE 4 "./src-ag/PrintErrorMessages.ag" #-} +{-# LINE 4 "src-ag/PrintErrorMessages.ag" #-} import UU.Scanner.Position(Pos(..), noPos) import ErrorMessages @@ -20,14 +20,14 @@ {-# LINE 21 "dist/build/PrintErrorMessages.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 13 "./src-ag/PrintErrorMessages.ag" #-} +{-# 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" #-} +{-# LINE 20 "src-ag/PrintErrorMessages.ag" #-} isError :: Options -> Error -> Bool isError _ (ParserError _ _ _ ) = True @@ -71,7 +71,7 @@ = any ($ opts) [ wignore, bangpats, cases, strictCases, stricterCases, strictSems, withCycle ] {-# LINE 73 "dist/build/PrintErrorMessages.hs" #-} -{-# LINE 548 "./src-ag/PrintErrorMessages.ag" #-} +{-# LINE 548 "src-ag/PrintErrorMessages.ag" #-} toWidth :: Int -> String -> String toWidth n xs | k|< ppAttr f a {-# LINE 119 "dist/build/PrintErrorMessages.hs" #-} -{-# LINE 594 "./src-ag/PrintErrorMessages.ag" #-} +{-# LINE 594 "src-ag/PrintErrorMessages.ag" #-} infixr 5 +#+ (+#+) :: String -> String -> String @@ -189,8 +189,8 @@ wrap_Error (T_Error act) (Inh_Error _lhsIoptions _lhsIverbose) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Error_vIn1 _lhsIoptions _lhsIverbose - (T_Error_vOut1 _lhsOme _lhsOpp) <- return (inv_Error_s2 sem arg) + let arg1 = T_Error_vIn1 _lhsIoptions _lhsIverbose + (T_Error_vOut1 _lhsOme _lhsOpp) <- return (inv_Error_s2 sem arg1) return (Syn_Error _lhsOme _lhsOpp) ) @@ -260,9 +260,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule0 #-} - {-# LINE 87 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 87 "src-ag/PrintErrorMessages.ag" #-} rule0 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me action_ pos_ problem_ -> - {-# LINE 87 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 87 "src-ag/PrintErrorMessages.ag" #-} let mesg = text ("parser expecting " ++ problem_) pat = text "" help = text "" @@ -291,9 +291,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule3 #-} - {-# LINE 93 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 93 "src-ag/PrintErrorMessages.ag" #-} rule3 = \ ((_lhsIverbose) :: Bool) msg_ pos_ -> - {-# LINE 93 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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 #-} @@ -318,9 +318,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule6 #-} - {-# LINE 95 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 95 "src-ag/PrintErrorMessages.ag" #-} rule6 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ nt_ occ1_ -> - {-# LINE 95 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 95 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Repeated definition for alternative", getName con_ ,"of nonterminal", getName nt_, "." ] >-< @@ -362,9 +362,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule9 #-} - {-# LINE 117 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 117 "src-ag/PrintErrorMessages.ag" #-} rule9 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me nt_ occ1_ -> - {-# LINE 117 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 117 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Definition of type synonym", getName nt_, "clashes with another" ,"type synonym." ] >-< @@ -404,9 +404,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule12 #-} - {-# LINE 134 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 134 "src-ag/PrintErrorMessages.ag" #-} rule12 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me name_ occ1_ -> - {-# LINE 134 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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." ] >-< @@ -445,9 +445,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule15 #-} - {-# LINE 150 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 150 "src-ag/PrintErrorMessages.ag" #-} rule15 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ nt_ occ1_ -> - {-# LINE 150 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 150 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Repeated declaration of inherited attribute", getName attr_ , "of nonterminal", getName nt_, "." ] >-< @@ -487,9 +487,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule18 #-} - {-# LINE 169 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 169 "src-ag/PrintErrorMessages.ag" #-} rule18 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ nt_ occ1_ -> - {-# LINE 169 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 169 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Repeated declaration of synthesized attribute", getName attr_ , "of nonterminal", getName nt_, "." ] >-< @@ -529,9 +529,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule21 #-} - {-# LINE 188 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 188 "src-ag/PrintErrorMessages.ag" #-} rule21 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ name_ nt_ occ1_ -> - {-# LINE 188 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 188 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Repeated declaration for field", getName name_, "of alternative" ,getName con_, "of nonterminal", getName nt_, "." ] >-< @@ -572,9 +572,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule24 #-} - {-# LINE 208 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 208 "src-ag/PrintErrorMessages.ag" #-} rule24 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ field_ nt_ occ1_ -> - {-# LINE 208 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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_,"." ] >-< @@ -613,9 +613,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule27 #-} - {-# LINE 226 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 226 "src-ag/PrintErrorMessages.ag" #-} rule27 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ nm_ nt_ -> - {-# LINE 226 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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_,"." ] @@ -651,9 +651,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule30 #-} - {-# LINE 241 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 241 "src-ag/PrintErrorMessages.ag" #-} rule30 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ nt_ -> - {-# LINE 241 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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_,"." ] >-< @@ -691,9 +691,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule33 #-} - {-# LINE 258 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 258 "src-ag/PrintErrorMessages.ag" #-} rule33 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me nt_ -> - {-# LINE 258 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 258 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Nonterminal", getName nt_, "is not defined." ] pat = "DATA" >#< getName nt_ >#< "..." @@ -725,9 +725,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule36 #-} - {-# LINE 268 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 268 "src-ag/PrintErrorMessages.ag" #-} rule36 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ nt_ -> - {-# LINE 268 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 268 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_, "is not defined." ] pat = "DATA" >#< getName nt_ @@ -761,9 +761,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule39 #-} - {-# LINE 280 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 280 "src-ag/PrintErrorMessages.ag" #-} rule39 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ name_ nt_ -> - {-# LINE 280 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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_ , "." ] @@ -800,9 +800,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule42 #-} - {-# LINE 295 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 295 "src-ag/PrintErrorMessages.ag" #-} rule42 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ field_ nt_ -> - {-# LINE 295 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 295 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Missing rule for", showAttrDef field_ attr_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"." ] @@ -837,9 +837,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule45 #-} - {-# LINE 308 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 308 "src-ag/PrintErrorMessages.ag" #-} rule45 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ name_ nt_ -> - {-# LINE 308 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 308 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Missing rule name ", show name_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"." ] @@ -873,9 +873,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule48 #-} - {-# LINE 320 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 320 "src-ag/PrintErrorMessages.ag" #-} rule48 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ field_ nt_ -> - {-# LINE 320 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 320 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Rule for non-existing", showAttrDef field_ attr_ , "at alternative" , getName con_ , "of nonterminal",getName nt_, "." ] @@ -910,9 +910,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule51 #-} - {-# LINE 334 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 334 "src-ag/PrintErrorMessages.ag" #-} rule51 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ nt_ var_ -> - {-# LINE 334 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 334 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Undefined local variable or field",getName var_, "at constructor" , getName con_ , "of nonterminal",getName nt_, "." ] @@ -949,9 +949,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule54 #-} - {-# LINE 349 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 349 "src-ag/PrintErrorMessages.ag" #-} rule54 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me con_ nt_ var_ -> - {-# LINE 349 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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_, "." ] @@ -987,9 +987,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule57 #-} - {-# LINE 363 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 363 "src-ag/PrintErrorMessages.ag" #-} rule57 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ field_ isOut_ nt_ -> - {-# LINE 363 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 363 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Undefined" , if isOut_ then showAttrDef field_ attr_ @@ -1030,9 +1030,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule60 #-} - {-# LINE 391 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 391 "src-ag/PrintErrorMessages.ag" #-} rule60 = \ ((_lhsIoptions) :: Options) _me mbCon_ nt_ verts_ -> - {-# LINE 391 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 391 "src-ag/PrintErrorMessages.ag" #-} let pos = getPos nt_ mesg = text "Circular dependency for nonterminal" >#< getName nt_ >#< ( case mbCon_ of @@ -1070,9 +1070,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule63 #-} - {-# LINE 382 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 382 "src-ag/PrintErrorMessages.ag" #-} rule63 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me name_ -> - {-# LINE 382 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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_ @@ -1104,9 +1104,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule66 #-} - {-# LINE 406 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 406 "src-ag/PrintErrorMessages.ag" #-} rule66 = \ ((_lhsIoptions) :: Options) _me mesg_ pos_ -> - {-# LINE 406 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 406 "src-ag/PrintErrorMessages.ag" #-} let pat = text "unknown" help = wfill ["not available."] act = wfill ["unknown"] @@ -1134,9 +1134,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule69 #-} - {-# LINE 411 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 411 "src-ag/PrintErrorMessages.ag" #-} rule69 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ nt_ o_visit_ path_ -> - {-# LINE 411 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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_ @@ -1171,9 +1171,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule72 #-} - {-# LINE 423 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 423 "src-ag/PrintErrorMessages.ag" #-} rule72 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ nt_ o_visit_ path_ -> - {-# LINE 423 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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_ @@ -1208,9 +1208,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule75 #-} - {-# LINE 435 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 435 "src-ag/PrintErrorMessages.ag" #-} rule75 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me cyclic_ nt_ o_visit_ -> - {-# LINE 435 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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 "" @@ -1241,9 +1241,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule78 #-} - {-# LINE 443 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 443 "src-ag/PrintErrorMessages.ag" #-} rule78 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me cinter_ cyclic_ nt_ -> - {-# LINE 443 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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 "" @@ -1275,9 +1275,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule81 #-} - {-# LINE 452 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 452 "src-ag/PrintErrorMessages.ag" #-} rule81 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ nt_ -> - {-# LINE 452 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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_ ,"." ]>-< @@ -1314,9 +1314,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule84 #-} - {-# LINE 466 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 466 "src-ag/PrintErrorMessages.ag" #-} rule84 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ nt_ -> - {-# LINE 466 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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_ ,"." ]>-< @@ -1353,9 +1353,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule87 #-} - {-# LINE 496 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 496 "src-ag/PrintErrorMessages.ag" #-} rule87 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ con_ nt_ -> - {-# LINE 496 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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_,"." ] >-< @@ -1393,9 +1393,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule90 #-} - {-# LINE 480 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 480 "src-ag/PrintErrorMessages.ag" #-} rule90 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ nt_ -> - {-# LINE 480 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 480 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Missing unique counter (chained attribute)" , getName attr_ , "at nonterminal" @@ -1433,9 +1433,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule93 #-} - {-# LINE 513 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 513 "src-ag/PrintErrorMessages.ag" #-} rule93 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me attr_ nt_ -> - {-# LINE 513 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 513 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Missing synthesized attribute" , getName attr_ , "at nonterminal" @@ -1473,9 +1473,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule96 #-} - {-# LINE 529 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 529 "src-ag/PrintErrorMessages.ag" #-} rule96 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me child_ from_ to_ vis_ -> - {-# LINE 529 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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 @@ -1504,9 +1504,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule99 #-} - {-# LINE 535 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 535 "src-ag/PrintErrorMessages.ag" #-} rule99 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me kind_ rule_ -> - {-# LINE 535 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 535 "src-ag/PrintErrorMessages.ag" #-} let mesg = "rule" >#< rule_ >#< "cannot be called from a visit with kind " >#< show kind_ pat = empty help = empty @@ -1535,9 +1535,9 @@ in __result_ ) in C_Error_s2 v1 {-# INLINE rule102 #-} - {-# LINE 542 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 542 "src-ag/PrintErrorMessages.ag" #-} rule102 = \ ((_lhsIoptions) :: Options) ((_lhsIverbose) :: Bool) _me child_ kind_ -> - {-# LINE 542 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 542 "src-ag/PrintErrorMessages.ag" #-} let mesg = "child" >#< child_ >#< "cannot be called from a visit with kind " >#< show kind_ pat = empty help = empty @@ -1560,8 +1560,8 @@ wrap_Errors (T_Errors act) (Inh_Errors _lhsIdups _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Errors_vIn4 _lhsIdups _lhsIoptions - (T_Errors_vOut4 _lhsOpp) <- return (inv_Errors_s5 sem arg) + let arg4 = T_Errors_vIn4 _lhsIdups _lhsIoptions + (T_Errors_vOut4 _lhsOpp) <- return (inv_Errors_s5 sem arg4) return (Syn_Errors _lhsOpp) ) @@ -1604,29 +1604,29 @@ in __result_ ) in C_Errors_s5 v4 {-# INLINE rule105 #-} - {-# LINE 76 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 76 "src-ag/PrintErrorMessages.ag" #-} rule105 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 76 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 76 "src-ag/PrintErrorMessages.ag" #-} verbose _lhsIoptions {-# LINE 1612 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule106 #-} - {-# LINE 77 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 77 "src-ag/PrintErrorMessages.ag" #-} rule106 = \ ((_hdIpp) :: PP_Doc) -> - {-# LINE 77 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 77 "src-ag/PrintErrorMessages.ag" #-} disp _hdIpp 5000 "" {-# LINE 1618 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule107 #-} - {-# LINE 79 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 79 "src-ag/PrintErrorMessages.ag" #-} rule107 = \ ((_hdIpp) :: PP_Doc) ((_lhsIdups) :: [String]) _str ((_tlIpp) :: PP_Doc) -> - {-# LINE 79 "./src-ag/PrintErrorMessages.ag" #-} + {-# 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" #-} + {-# LINE 82 "src-ag/PrintErrorMessages.ag" #-} rule108 = \ ((_lhsIdups) :: [String]) _str -> - {-# LINE 82 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 82 "src-ag/PrintErrorMessages.ag" #-} _str : _lhsIdups {-# LINE 1632 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule109 #-} @@ -1652,14 +1652,14 @@ in __result_ ) in C_Errors_s5 v4 {-# INLINE rule112 #-} - {-# LINE 76 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 76 "src-ag/PrintErrorMessages.ag" #-} rule112 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 76 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 76 "src-ag/PrintErrorMessages.ag" #-} verbose _lhsIoptions {-# LINE 1660 "dist/build/PrintErrorMessages.hs"#-} {-# INLINE rule113 #-} - {-# LINE 83 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 83 "src-ag/PrintErrorMessages.ag" #-} rule113 = \ (_ :: ()) -> - {-# LINE 83 "./src-ag/PrintErrorMessages.ag" #-} + {-# LINE 83 "src-ag/PrintErrorMessages.ag" #-} text "" {-# LINE 1666 "dist/build/PrintErrorMessages.hs"#-} diff --git a/src-generated/PrintOcamlCode.hs b/src-generated/PrintOcamlCode.hs --- a/src-generated/PrintOcamlCode.hs +++ b/src-generated/PrintOcamlCode.hs @@ -3,14 +3,14 @@ {-# LANGUAGE ScopedTypeVariables #-} module PrintOcamlCode where -{-# LINE 2 "./src-ag/Patterns.ag" #-} +{-# 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" #-} +{-# LINE 2 "src-ag/Code.ag" #-} import Patterns import Data.Set(Set) @@ -19,7 +19,7 @@ import qualified Data.Map as Map {-# LINE 21 "dist/build/PrintOcamlCode.hs" #-} -{-# LINE 10 "./src-ag/PrintOcamlCode.ag" #-} +{-# LINE 10 "src-ag/PrintOcamlCode.ag" #-} import Pretty import Code @@ -31,7 +31,7 @@ {-# LINE 32 "dist/build/PrintOcamlCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 146 "./src-ag/Code.ag" #-} +{-# LINE 146 "src-ag/Code.ag" #-} -- Unboxed tuples -- unbox Whether unboxed tuples are wanted or not @@ -50,7 +50,7 @@ | otherwise = UnboxedTupleLhs comps {-# LINE 52 "dist/build/PrintOcamlCode.hs" #-} -{-# LINE 21 "./src-ag/PrintOcamlCode.ag" #-} +{-# LINE 21 "src-ag/PrintOcamlCode.ag" #-} type PP_Docs = [PP_Doc] @@ -69,7 +69,7 @@ ppTuple False pps = "(" >|< pp_block " " ")" "," pps {-# LINE 71 "dist/build/PrintOcamlCode.hs" #-} -{-# LINE 177 "./src-ag/PrintOcamlCode.ag" #-} +{-# LINE 177 "src-ag/PrintOcamlCode.ag" #-} toOcamlTC :: String -> String toOcamlTC (c:cs) = toLower c : cs @@ -84,8 +84,8 @@ wrap_CaseAlt !(T_CaseAlt act) !(Inh_CaseAlt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_CaseAlt_vIn1 _lhsIoptions - !(T_CaseAlt_vOut1 _lhsOpp) <- return (inv_CaseAlt_s2 sem arg) + let arg1 = T_CaseAlt_vIn1 _lhsIoptions + !(T_CaseAlt_vOut1 _lhsOpp) <- return (inv_CaseAlt_s2 sem arg1) return (Syn_CaseAlt _lhsOpp) ) @@ -124,9 +124,9 @@ in __result_ ) in C_CaseAlt_s2 v1 {-# INLINE rule0 #-} - {-# LINE 184 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 184 "src-ag/PrintOcamlCode.ag" #-} rule0 = \ ((_exprIpp) :: PP_Doc) ((_leftIpp) :: PP_Doc) -> - {-# LINE 184 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 184 "src-ag/PrintOcamlCode.ag" #-} _leftIpp >#< "->" >#< _exprIpp {-# LINE 132 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule1 #-} @@ -145,8 +145,8 @@ wrap_CaseAlts !(T_CaseAlts act) !(Inh_CaseAlts _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_CaseAlts_vIn4 _lhsIoptions - !(T_CaseAlts_vOut4 _lhsOpps) <- return (inv_CaseAlts_s5 sem arg) + let arg4 = T_CaseAlts_vIn4 _lhsIoptions + !(T_CaseAlts_vOut4 _lhsOpps) <- return (inv_CaseAlts_s5 sem arg4) return (Syn_CaseAlts _lhsOpps) ) @@ -185,9 +185,9 @@ in __result_ ) in C_CaseAlts_s5 v4 {-# INLINE rule3 #-} - {-# LINE 65 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 65 "src-ag/PrintOcamlCode.ag" #-} rule3 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 65 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 65 "src-ag/PrintOcamlCode.ag" #-} _hdIpp : _tlIpps {-# LINE 193 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule4 #-} @@ -209,9 +209,9 @@ in __result_ ) in C_CaseAlts_s5 v4 {-# INLINE rule6 #-} - {-# LINE 66 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 66 "src-ag/PrintOcamlCode.ag" #-} rule6 = \ (_ :: ()) -> - {-# LINE 66 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 66 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 217 "dist/build/PrintOcamlCode.hs"#-} @@ -224,8 +224,8 @@ wrap_Chunk !(T_Chunk act) !(Inh_Chunk _lhsIisToplevel _lhsIoptions _lhsItextBlockMap) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Chunk_vIn7 _lhsIisToplevel _lhsIoptions _lhsItextBlockMap - !(T_Chunk_vOut7 _lhsOpps) <- return (inv_Chunk_s8 sem arg) + let arg7 = T_Chunk_vIn7 _lhsIisToplevel _lhsIoptions _lhsItextBlockMap + !(T_Chunk_vOut7 _lhsOpps) <- return (inv_Chunk_s8 sem arg7) return (Syn_Chunk _lhsOpps) ) @@ -286,9 +286,9 @@ in __result_ ) in C_Chunk_s8 v7 {-# INLINE rule7 #-} - {-# LINE 97 "./src-ag/PrintOcamlCode.ag" #-} + {-# 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" #-} + {-# LINE 97 "src-ag/PrintOcamlCode.ag" #-} _commentIpp : _infoIpps ++ _dataDefIpps @@ -350,8 +350,8 @@ wrap_Chunks !(T_Chunks act) !(Inh_Chunks _lhsIisToplevel _lhsIoptions _lhsItextBlockMap) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Chunks_vIn10 _lhsIisToplevel _lhsIoptions _lhsItextBlockMap - !(T_Chunks_vOut10 _lhsOpps) <- return (inv_Chunks_s11 sem arg) + let arg10 = T_Chunks_vIn10 _lhsIisToplevel _lhsIoptions _lhsItextBlockMap + !(T_Chunks_vOut10 _lhsOpps) <- return (inv_Chunks_s11 sem arg10) return (Syn_Chunks _lhsOpps) ) @@ -394,9 +394,9 @@ in __result_ ) in C_Chunks_s11 v10 {-# INLINE rule22 #-} - {-# LINE 85 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 85 "src-ag/PrintOcamlCode.ag" #-} rule22 = \ ((_hdIpps) :: PP_Docs) ((_tlIpps) :: PP_Docs) -> - {-# LINE 85 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 85 "src-ag/PrintOcamlCode.ag" #-} _hdIpps ++ _tlIpps {-# LINE 402 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule23 #-} @@ -430,9 +430,9 @@ in __result_ ) in C_Chunks_s11 v10 {-# INLINE rule29 #-} - {-# LINE 86 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 86 "src-ag/PrintOcamlCode.ag" #-} rule29 = \ (_ :: ()) -> - {-# LINE 86 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 86 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 438 "dist/build/PrintOcamlCode.hs"#-} @@ -445,8 +445,8 @@ wrap_DataAlt !(T_DataAlt act) !(Inh_DataAlt ) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_DataAlt_vIn13 - !(T_DataAlt_vOut13 _lhsOpp) <- return (inv_DataAlt_s14 sem arg) + let arg13 = T_DataAlt_vIn13 + !(T_DataAlt_vOut13 _lhsOpp) <- return (inv_DataAlt_s14 sem arg13) return (Syn_DataAlt _lhsOpp) ) @@ -482,9 +482,9 @@ in __result_ ) in C_DataAlt_s14 v13 {-# INLINE rule30 #-} - {-# LINE 187 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 187 "src-ag/PrintOcamlCode.ag" #-} rule30 = \ ((_argsIpps) :: PP_Docs) name_ -> - {-# LINE 187 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 187 "src-ag/PrintOcamlCode.ag" #-} name_ >#< "of" >#< pp_block "" "" " * " (map pp_parens _argsIpps) {-# LINE 490 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_DataAlt_Record #-} @@ -502,9 +502,9 @@ in __result_ ) in C_DataAlt_s14 v13 {-# INLINE rule31 #-} - {-# LINE 188 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 188 "src-ag/PrintOcamlCode.ag" #-} rule31 = \ ((_argsIpps) :: PP_Docs) -> - {-# LINE 188 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 188 "src-ag/PrintOcamlCode.ag" #-} pp_block "{" "}" ";" _argsIpps {-# LINE 510 "dist/build/PrintOcamlCode.hs"#-} @@ -517,8 +517,8 @@ wrap_DataAlts !(T_DataAlts act) !(Inh_DataAlts ) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_DataAlts_vIn16 - !(T_DataAlts_vOut16 _lhsOpps) <- return (inv_DataAlts_s17 sem arg) + let arg16 = T_DataAlts_vIn16 + !(T_DataAlts_vOut16 _lhsOpps) <- return (inv_DataAlts_s17 sem arg16) return (Syn_DataAlts _lhsOpps) ) @@ -555,9 +555,9 @@ in __result_ ) in C_DataAlts_s17 v16 {-# INLINE rule32 #-} - {-# LINE 69 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 69 "src-ag/PrintOcamlCode.ag" #-} rule32 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 69 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 69 "src-ag/PrintOcamlCode.ag" #-} _hdIpp : _tlIpps {-# LINE 563 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_DataAlts_Nil #-} @@ -573,9 +573,9 @@ in __result_ ) in C_DataAlts_s17 v16 {-# INLINE rule33 #-} - {-# LINE 70 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 70 "src-ag/PrintOcamlCode.ag" #-} rule33 = \ (_ :: ()) -> - {-# LINE 70 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 70 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 581 "dist/build/PrintOcamlCode.hs"#-} @@ -588,8 +588,8 @@ wrap_Decl !(T_Decl act) !(Inh_Decl _lhsIisToplevel _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Decl_vIn19 _lhsIisToplevel _lhsIoptions - !(T_Decl_vOut19 _lhsOpp) <- return (inv_Decl_s20 sem arg) + let arg19 = T_Decl_vIn19 _lhsIisToplevel _lhsIoptions + !(T_Decl_vOut19 _lhsOpp) <- return (inv_Decl_s20 sem arg19) return (Syn_Decl _lhsOpp) ) @@ -638,9 +638,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule34 #-} - {-# LINE 107 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 107 "src-ag/PrintOcamlCode.ag" #-} rule34 = \ ((_leftIpp) :: PP_Doc) ((_lhsIisToplevel) :: Bool) ((_rhsIpp) :: PP_Doc) -> - {-# LINE 107 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 107 "src-ag/PrintOcamlCode.ag" #-} if _lhsIisToplevel then "let" >#< _leftIpp >#< "=" >-< indent 4 _rhsIpp >#< ";;" @@ -672,9 +672,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule37 #-} - {-# LINE 112 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 112 "src-ag/PrintOcamlCode.ag" #-} rule37 = \ (_ :: ()) -> - {-# LINE 112 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 112 "src-ag/PrintOcamlCode.ag" #-} error "pp of Decl.Bind not supported" {-# LINE 680 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule38 #-} @@ -702,9 +702,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule40 #-} - {-# LINE 113 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 113 "src-ag/PrintOcamlCode.ag" #-} rule40 = \ (_ :: ()) -> - {-# LINE 113 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 113 "src-ag/PrintOcamlCode.ag" #-} error "pp of Decl.BindLet not supported" {-# LINE 710 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule41 #-} @@ -728,9 +728,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule43 #-} - {-# LINE 114 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 114 "src-ag/PrintOcamlCode.ag" #-} rule43 = \ ((_altsIpps) :: PP_Docs) name_ params_ -> - {-# LINE 114 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 114 "src-ag/PrintOcamlCode.ag" #-} "type" >#< hv_sp (map (\p -> "'" >|< p) params_ ++ [text $ toOcamlTC name_]) >#< ( case _altsIpps of [] -> empty @@ -754,9 +754,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule44 #-} - {-# LINE 121 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 121 "src-ag/PrintOcamlCode.ag" #-} rule44 = \ (_ :: ()) -> - {-# LINE 121 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 121 "src-ag/PrintOcamlCode.ag" #-} error "pp of Decl.NewType not supported" {-# LINE 762 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Decl_Type #-} @@ -774,9 +774,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule45 #-} - {-# LINE 122 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 122 "src-ag/PrintOcamlCode.ag" #-} rule45 = \ ((_tpIpp) :: PP_Doc) name_ params_ -> - {-# LINE 122 "./src-ag/PrintOcamlCode.ag" #-} + {-# 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 #-} @@ -794,9 +794,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule46 #-} - {-# LINE 123 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 123 "src-ag/PrintOcamlCode.ag" #-} rule46 = \ ((_tpIpp) :: PP_Doc) name_ -> - {-# LINE 123 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 123 "src-ag/PrintOcamlCode.ag" #-} "(*" >#< name_ >#< ":" >#< _tpIpp >#< "*)" {-# LINE 802 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Decl_Comment #-} @@ -812,9 +812,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule47 #-} - {-# LINE 124 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 124 "src-ag/PrintOcamlCode.ag" #-} rule47 = \ txt_ -> - {-# LINE 124 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 124 "src-ag/PrintOcamlCode.ag" #-} if '\n' `elem` txt_ then "(* " >-< vlist (lines txt_) >-< "*)" else "(*" >#< txt_ >#< "*)" @@ -832,9 +832,9 @@ in __result_ ) in C_Decl_s20 v19 {-# INLINE rule48 #-} - {-# LINE 127 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 127 "src-ag/PrintOcamlCode.ag" #-} rule48 = \ (_ :: ()) -> - {-# LINE 127 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 127 "src-ag/PrintOcamlCode.ag" #-} error "pp of Decl.PragmaDecl not supported" {-# LINE 840 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Decl_Resume #-} @@ -901,8 +901,8 @@ wrap_Decls !(T_Decls act) !(Inh_Decls _lhsIisToplevel _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Decls_vIn22 _lhsIisToplevel _lhsIoptions - !(T_Decls_vOut22 _lhsOpps) <- return (inv_Decls_s23 sem arg) + let arg22 = T_Decls_vIn22 _lhsIisToplevel _lhsIoptions + !(T_Decls_vOut22 _lhsOpps) <- return (inv_Decls_s23 sem arg22) return (Syn_Decls _lhsOpps) ) @@ -943,9 +943,9 @@ in __result_ ) in C_Decls_s23 v22 {-# INLINE rule55 #-} - {-# LINE 81 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 81 "src-ag/PrintOcamlCode.ag" #-} rule55 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 81 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 81 "src-ag/PrintOcamlCode.ag" #-} _hdIpp : _tlIpps {-# LINE 951 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule56 #-} @@ -973,9 +973,9 @@ in __result_ ) in C_Decls_s23 v22 {-# INLINE rule60 #-} - {-# LINE 82 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 82 "src-ag/PrintOcamlCode.ag" #-} rule60 = \ (_ :: ()) -> - {-# LINE 82 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 82 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 981 "dist/build/PrintOcamlCode.hs"#-} @@ -988,8 +988,8 @@ wrap_Expr !(T_Expr act) !(Inh_Expr _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Expr_vIn25 _lhsIoptions - !(T_Expr_vOut25 _lhsOpp) <- return (inv_Expr_s26 sem arg) + let arg25 = T_Expr_vIn25 _lhsIoptions + !(T_Expr_vOut25 _lhsOpp) <- return (inv_Expr_s26 sem arg25) return (Syn_Expr _lhsOpp) ) @@ -1045,15 +1045,15 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule61 #-} - {-# LINE 131 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 131 "src-ag/PrintOcamlCode.ag" #-} rule61 = \ ((_bodyIpp) :: PP_Doc) ((_declsIpps) :: PP_Docs) -> - {-# LINE 131 "./src-ag/PrintOcamlCode.ag" #-} + {-# 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" #-} + {-# LINE 220 "src-ag/PrintOcamlCode.ag" #-} rule62 = \ (_ :: ()) -> - {-# LINE 220 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 220 "src-ag/PrintOcamlCode.ag" #-} False {-# LINE 1059 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule63 #-} @@ -1081,9 +1081,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule65 #-} - {-# LINE 132 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 132 "src-ag/PrintOcamlCode.ag" #-} rule65 = \ ((_altsIpps) :: PP_Docs) ((_exprIpp) :: PP_Doc) -> - {-# LINE 132 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 132 "src-ag/PrintOcamlCode.ag" #-} pp_parens ( "match" >#< _exprIpp >#< "with" >-< indent 2 ( case _altsIpps of [] -> empty @@ -1118,15 +1118,15 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule68 #-} - {-# LINE 139 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 139 "src-ag/PrintOcamlCode.ag" #-} rule68 = \ (_ :: ()) -> - {-# LINE 139 "./src-ag/PrintOcamlCode.ag" #-} + {-# 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" #-} + {-# LINE 222 "src-ag/PrintOcamlCode.ag" #-} rule69 = \ (_ :: ()) -> - {-# LINE 222 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 222 "src-ag/PrintOcamlCode.ag" #-} False {-# LINE 1132 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule70 #-} @@ -1154,9 +1154,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule72 #-} - {-# LINE 140 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 140 "src-ag/PrintOcamlCode.ag" #-} rule72 = \ ((_argsIpps) :: PP_Docs) ((_bodyIpp) :: PP_Doc) -> - {-# LINE 140 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 140 "src-ag/PrintOcamlCode.ag" #-} pp_parens ( pp "fun" >#< hv_sp _argsIpps >#< "->" >-< indent 2 _bodyIpp ) {-# LINE 1163 "dist/build/PrintOcamlCode.hs"#-} @@ -1182,9 +1182,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule75 #-} - {-# LINE 142 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 142 "src-ag/PrintOcamlCode.ag" #-} rule75 = \ ((_exprsIpps) :: PP_Docs) -> - {-# LINE 142 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 142 "src-ag/PrintOcamlCode.ag" #-} ppTuple False _exprsIpps {-# LINE 1190 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule76 #-} @@ -1206,9 +1206,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule77 #-} - {-# LINE 143 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 143 "src-ag/PrintOcamlCode.ag" #-} rule77 = \ (_ :: ()) -> - {-# LINE 143 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 143 "src-ag/PrintOcamlCode.ag" #-} error "pp of Expr.UnboxedTupleExpr not supported" {-# LINE 1214 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule78 #-} @@ -1230,9 +1230,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule79 #-} - {-# LINE 144 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 144 "src-ag/PrintOcamlCode.ag" #-} rule79 = \ ((_argsIpps) :: PP_Docs) name_ -> - {-# LINE 144 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 144 "src-ag/PrintOcamlCode.ag" #-} pp_parens $ name_ >#< hv_sp _argsIpps {-# LINE 1238 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule80 #-} @@ -1251,9 +1251,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule81 #-} - {-# LINE 145 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 145 "src-ag/PrintOcamlCode.ag" #-} rule81 = \ txt_ -> - {-# LINE 145 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 145 "src-ag/PrintOcamlCode.ag" #-} text txt_ {-# LINE 1259 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Expr_TextExpr #-} @@ -1269,9 +1269,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule82 #-} - {-# LINE 146 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 146 "src-ag/PrintOcamlCode.ag" #-} rule82 = \ lns_ -> - {-# LINE 146 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 146 "src-ag/PrintOcamlCode.ag" #-} vlist (map text lns_) {-# LINE 1277 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Expr_Trace #-} @@ -1290,9 +1290,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule83 #-} - {-# LINE 147 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 147 "src-ag/PrintOcamlCode.ag" #-} rule83 = \ ((_exprIpp) :: PP_Doc) -> - {-# LINE 147 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 147 "src-ag/PrintOcamlCode.ag" #-} _exprIpp {-# LINE 1298 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule84 #-} @@ -1314,9 +1314,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule85 #-} - {-# LINE 148 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 148 "src-ag/PrintOcamlCode.ag" #-} rule85 = \ ((_exprIpp) :: PP_Doc) -> - {-# LINE 148 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 148 "src-ag/PrintOcamlCode.ag" #-} _exprIpp {-# LINE 1322 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule86 #-} @@ -1338,9 +1338,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule87 #-} - {-# LINE 149 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 149 "src-ag/PrintOcamlCode.ag" #-} rule87 = \ ((_exprIpp) :: PP_Doc) -> - {-# LINE 149 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 149 "src-ag/PrintOcamlCode.ag" #-} _exprIpp {-# LINE 1346 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule88 #-} @@ -1364,9 +1364,9 @@ in __result_ ) in C_Expr_s26 v25 {-# INLINE rule89 #-} - {-# LINE 150 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 150 "src-ag/PrintOcamlCode.ag" #-} rule89 = \ ((_exprIpp) :: PP_Doc) -> - {-# LINE 150 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 150 "src-ag/PrintOcamlCode.ag" #-} _exprIpp {-# LINE 1372 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule90 #-} @@ -1490,8 +1490,8 @@ wrap_Exprs !(T_Exprs act) !(Inh_Exprs _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Exprs_vIn28 _lhsIoptions - !(T_Exprs_vOut28 _lhsOpps) <- return (inv_Exprs_s29 sem arg) + let arg28 = T_Exprs_vIn28 _lhsIoptions + !(T_Exprs_vOut28 _lhsOpps) <- return (inv_Exprs_s29 sem arg28) return (Syn_Exprs _lhsOpps) ) @@ -1530,9 +1530,9 @@ in __result_ ) in C_Exprs_s29 v28 {-# INLINE rule103 #-} - {-# LINE 61 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 61 "src-ag/PrintOcamlCode.ag" #-} rule103 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 61 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 61 "src-ag/PrintOcamlCode.ag" #-} _hdIpp : _tlIpps {-# LINE 1538 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule104 #-} @@ -1554,9 +1554,9 @@ in __result_ ) in C_Exprs_s29 v28 {-# INLINE rule106 #-} - {-# LINE 62 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 62 "src-ag/PrintOcamlCode.ag" #-} rule106 = \ (_ :: ()) -> - {-# LINE 62 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 62 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 1562 "dist/build/PrintOcamlCode.hs"#-} @@ -1569,8 +1569,8 @@ wrap_Lhs !(T_Lhs act) !(Inh_Lhs _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Lhs_vIn31 _lhsIoptions - !(T_Lhs_vOut31 _lhsOpp) <- return (inv_Lhs_s32 sem arg) + let arg31 = T_Lhs_vIn31 _lhsIoptions + !(T_Lhs_vOut31 _lhsOpp) <- return (inv_Lhs_s32 sem arg31) return (Syn_Lhs _lhsOpp) ) @@ -1611,9 +1611,9 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule107 #-} - {-# LINE 153 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 153 "src-ag/PrintOcamlCode.ag" #-} rule107 = \ ((_pat3Ipp) :: PP_Doc) -> - {-# LINE 153 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 153 "src-ag/PrintOcamlCode.ag" #-} _pat3Ipp {-# LINE 1619 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule108 #-} @@ -1635,9 +1635,9 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule109 #-} - {-# LINE 154 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 154 "src-ag/PrintOcamlCode.ag" #-} rule109 = \ (_ :: ()) -> - {-# LINE 154 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 154 "src-ag/PrintOcamlCode.ag" #-} error "pp of Lhs.Pattern3SM not supported" {-# LINE 1643 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule110 #-} @@ -1656,9 +1656,9 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule111 #-} - {-# LINE 155 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 155 "src-ag/PrintOcamlCode.ag" #-} rule111 = \ comps_ -> - {-# LINE 155 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 155 "src-ag/PrintOcamlCode.ag" #-} ppTuple False (map text comps_) {-# LINE 1664 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Lhs_UnboxedTupleLhs #-} @@ -1674,9 +1674,9 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule112 #-} - {-# LINE 156 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 156 "src-ag/PrintOcamlCode.ag" #-} rule112 = \ (_ :: ()) -> - {-# LINE 156 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 156 "src-ag/PrintOcamlCode.ag" #-} error "pp of Lhs.UnboxedTupleLhs not supported" {-# LINE 1682 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Lhs_Fun #-} @@ -1695,9 +1695,9 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule113 #-} - {-# LINE 157 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 157 "src-ag/PrintOcamlCode.ag" #-} rule113 = \ ((_argsIpps) :: PP_Docs) name_ -> - {-# LINE 157 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 157 "src-ag/PrintOcamlCode.ag" #-} name_ >#< hv_sp _argsIpps {-# LINE 1703 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule114 #-} @@ -1719,9 +1719,9 @@ in __result_ ) in C_Lhs_s32 v31 {-# INLINE rule115 #-} - {-# LINE 158 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 158 "src-ag/PrintOcamlCode.ag" #-} rule115 = \ ((_subIpp) :: PP_Doc) name_ -> - {-# LINE 158 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 158 "src-ag/PrintOcamlCode.ag" #-} pp_parens (name_ >#< _subIpp) {-# LINE 1727 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule116 #-} @@ -1737,8 +1737,8 @@ wrap_NamedType !(T_NamedType act) !(Inh_NamedType ) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_NamedType_vIn34 - !(T_NamedType_vOut34 _lhsOpp) <- return (inv_NamedType_s35 sem arg) + let arg34 = T_NamedType_vIn34 + !(T_NamedType_vOut34 _lhsOpp) <- return (inv_NamedType_s35 sem arg34) return (Syn_NamedType _lhsOpp) ) @@ -1773,9 +1773,9 @@ in __result_ ) in C_NamedType_s35 v34 {-# INLINE rule117 #-} - {-# LINE 191 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 191 "src-ag/PrintOcamlCode.ag" #-} rule117 = \ ((_tpIpp) :: PP_Doc) name_ -> - {-# LINE 191 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 191 "src-ag/PrintOcamlCode.ag" #-} name_ >#< ":" >#< _tpIpp {-# LINE 1781 "dist/build/PrintOcamlCode.hs"#-} @@ -1788,8 +1788,8 @@ wrap_NamedTypes !(T_NamedTypes act) !(Inh_NamedTypes ) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_NamedTypes_vIn37 - !(T_NamedTypes_vOut37 _lhsOpps) <- return (inv_NamedTypes_s38 sem arg) + let arg37 = T_NamedTypes_vIn37 + !(T_NamedTypes_vOut37 _lhsOpps) <- return (inv_NamedTypes_s38 sem arg37) return (Syn_NamedTypes _lhsOpps) ) @@ -1826,9 +1826,9 @@ in __result_ ) in C_NamedTypes_s38 v37 {-# INLINE rule118 #-} - {-# LINE 77 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 77 "src-ag/PrintOcamlCode.ag" #-} rule118 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 77 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 77 "src-ag/PrintOcamlCode.ag" #-} _hdIpp : _tlIpps {-# LINE 1834 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_NamedTypes_Nil #-} @@ -1844,9 +1844,9 @@ in __result_ ) in C_NamedTypes_s38 v37 {-# INLINE rule119 #-} - {-# LINE 78 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 78 "src-ag/PrintOcamlCode.ag" #-} rule119 = \ (_ :: ()) -> - {-# LINE 78 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 78 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 1852 "dist/build/PrintOcamlCode.hs"#-} @@ -1859,8 +1859,8 @@ wrap_Pattern !(T_Pattern act) !(Inh_Pattern _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Pattern_vIn40 _lhsIoptions - !(T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp) <- return (inv_Pattern_s41 sem arg) + let arg40 = T_Pattern_vIn40 _lhsIoptions + !(T_Pattern_vOut40 _lhsOcopy _lhsOisUnderscore _lhsOpp) <- return (inv_Pattern_s41 sem arg40) return (Syn_Pattern _lhsOcopy _lhsOisUnderscore _lhsOpp) ) @@ -1905,15 +1905,15 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule120 #-} - {-# LINE 194 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 194 "src-ag/PrintOcamlCode.ag" #-} rule120 = \ ((_patsIpps) :: PP_Docs) name_ -> - {-# LINE 194 "./src-ag/PrintOcamlCode.ag" #-} + {-# 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" #-} + {-# LINE 204 "src-ag/PrintOcamlCode.ag" #-} rule121 = \ (_ :: ()) -> - {-# LINE 204 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 204 "src-ag/PrintOcamlCode.ag" #-} False {-# LINE 1919 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule122 #-} @@ -1946,15 +1946,15 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule125 #-} - {-# LINE 195 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 195 "src-ag/PrintOcamlCode.ag" #-} rule125 = \ ((_patsIpps) :: PP_Docs) -> - {-# LINE 195 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 195 "src-ag/PrintOcamlCode.ag" #-} pp_block "(" ")" "," _patsIpps {-# LINE 1954 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule126 #-} - {-# LINE 205 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 205 "src-ag/PrintOcamlCode.ag" #-} rule126 = \ (_ :: ()) -> - {-# LINE 205 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 205 "src-ag/PrintOcamlCode.ag" #-} False {-# LINE 1960 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule127 #-} @@ -1987,17 +1987,17 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule130 #-} - {-# LINE 197 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 197 "src-ag/PrintOcamlCode.ag" #-} rule130 = \ ((_lhsIoptions) :: Options) ((_patIisUnderscore) :: Bool) attr_ field_ -> - {-# LINE 197 "./src-ag/PrintOcamlCode.ag" #-} + {-# 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" #-} + {-# LINE 206 "src-ag/PrintOcamlCode.ag" #-} rule131 = \ (_ :: ()) -> - {-# LINE 206 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 206 "src-ag/PrintOcamlCode.ag" #-} False {-# LINE 2003 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule132 #-} @@ -2030,9 +2030,9 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule135 #-} - {-# LINE 200 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 200 "src-ag/PrintOcamlCode.ag" #-} rule135 = \ (_ :: ()) -> - {-# LINE 200 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 200 "src-ag/PrintOcamlCode.ag" #-} error "pp of Pattern.Irrefutable not supported" {-# LINE 2038 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule136 #-} @@ -2065,15 +2065,15 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule140 #-} - {-# LINE 201 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 201 "src-ag/PrintOcamlCode.ag" #-} rule140 = \ (_ :: ()) -> - {-# LINE 201 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 201 "src-ag/PrintOcamlCode.ag" #-} text "_" {-# LINE 2073 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule141 #-} - {-# LINE 207 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 207 "src-ag/PrintOcamlCode.ag" #-} rule141 = \ (_ :: ()) -> - {-# LINE 207 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 207 "src-ag/PrintOcamlCode.ag" #-} True {-# LINE 2079 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule142 #-} @@ -2092,8 +2092,8 @@ wrap_Patterns !(T_Patterns act) !(Inh_Patterns _lhsIoptions) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Patterns_vIn43 _lhsIoptions - !(T_Patterns_vOut43 _lhsOcopy _lhsOpps) <- return (inv_Patterns_s44 sem arg) + let arg43 = T_Patterns_vIn43 _lhsIoptions + !(T_Patterns_vOut43 _lhsOcopy _lhsOpps) <- return (inv_Patterns_s44 sem arg43) return (Syn_Patterns _lhsOcopy _lhsOpps) ) @@ -2135,9 +2135,9 @@ in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule144 #-} - {-# LINE 89 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 89 "src-ag/PrintOcamlCode.ag" #-} rule144 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 89 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 89 "src-ag/PrintOcamlCode.ag" #-} _hdIpp : _tlIpps {-# LINE 2143 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule145 #-} @@ -2168,9 +2168,9 @@ in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule149 #-} - {-# LINE 90 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 90 "src-ag/PrintOcamlCode.ag" #-} rule149 = \ (_ :: ()) -> - {-# LINE 90 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 90 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 2176 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule150 #-} @@ -2189,8 +2189,8 @@ wrap_Program !(T_Program act) !(Inh_Program _lhsIoptions _lhsItextBlockMap) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Program_vIn46 _lhsIoptions _lhsItextBlockMap - !(T_Program_vOut46 _lhsOoutput) <- return (inv_Program_s47 sem arg) + let arg46 = T_Program_vIn46 _lhsIoptions _lhsItextBlockMap + !(T_Program_vOut46 _lhsOoutput) <- return (inv_Program_s47 sem arg46) return (Syn_Program _lhsOoutput) ) @@ -2228,15 +2228,15 @@ in __result_ ) in C_Program_s47 v46 {-# INLINE rule152 #-} - {-# LINE 58 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 58 "src-ag/PrintOcamlCode.ag" #-} rule152 = \ ((_chunksIpps) :: PP_Docs) -> - {-# LINE 58 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 58 "src-ag/PrintOcamlCode.ag" #-} _chunksIpps {-# LINE 2236 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule153 #-} - {-# LINE 216 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 216 "src-ag/PrintOcamlCode.ag" #-} rule153 = \ (_ :: ()) -> - {-# LINE 216 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 216 "src-ag/PrintOcamlCode.ag" #-} True {-# LINE 2242 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule154 #-} @@ -2255,8 +2255,8 @@ wrap_Type !(T_Type act) !(Inh_Type ) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Type_vIn49 - !(T_Type_vOut49 _lhsOpp) <- return (inv_Type_s50 sem arg) + let arg49 = T_Type_vIn49 + !(T_Type_vOut49 _lhsOpp) <- return (inv_Type_s50 sem arg49) return (Syn_Type _lhsOpp) ) @@ -2307,9 +2307,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule156 #-} - {-# LINE 161 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 161 "src-ag/PrintOcamlCode.ag" #-} rule156 = \ ((_leftIpp) :: PP_Doc) ((_rightIpp) :: PP_Doc) -> - {-# LINE 161 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 161 "src-ag/PrintOcamlCode.ag" #-} pp_parens (_leftIpp >#< "->" >#< _rightIpp) {-# LINE 2315 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_CtxApp #-} @@ -2327,9 +2327,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule157 #-} - {-# LINE 162 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 162 "src-ag/PrintOcamlCode.ag" #-} rule157 = \ (_ :: ()) -> - {-# LINE 162 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 162 "src-ag/PrintOcamlCode.ag" #-} error "pp of Type.CtxApp not supported" {-# LINE 2335 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_QuantApp #-} @@ -2366,9 +2366,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule159 #-} - {-# LINE 163 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 163 "src-ag/PrintOcamlCode.ag" #-} rule159 = \ ((_argsIpps) :: PP_Docs) ((_funcIpp) :: PP_Doc) -> - {-# LINE 163 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 163 "src-ag/PrintOcamlCode.ag" #-} pp_parens (hv_sp (_argsIpps ++ [_funcIpp])) {-# LINE 2374 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TupleType #-} @@ -2386,9 +2386,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule160 #-} - {-# LINE 164 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 164 "src-ag/PrintOcamlCode.ag" #-} rule160 = \ ((_tpsIpps) :: PP_Docs) -> - {-# LINE 164 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 164 "src-ag/PrintOcamlCode.ag" #-} pp_block "(" ")" "," _tpsIpps {-# LINE 2394 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_UnboxedTupleType #-} @@ -2406,9 +2406,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule161 #-} - {-# LINE 166 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 166 "src-ag/PrintOcamlCode.ag" #-} rule161 = \ (_ :: ()) -> - {-# LINE 166 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 166 "src-ag/PrintOcamlCode.ag" #-} error "pp of Type.UnboxedTupleType is not supported" {-# LINE 2414 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_List #-} @@ -2426,9 +2426,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule162 #-} - {-# LINE 167 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 167 "src-ag/PrintOcamlCode.ag" #-} rule162 = \ ((_tpIpp) :: PP_Doc) -> - {-# LINE 167 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 167 "src-ag/PrintOcamlCode.ag" #-} _tpIpp >#< "list" {-# LINE 2434 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_SimpleType #-} @@ -2444,9 +2444,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule163 #-} - {-# LINE 168 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 168 "src-ag/PrintOcamlCode.ag" #-} rule163 = \ txt_ -> - {-# LINE 168 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 168 "src-ag/PrintOcamlCode.ag" #-} text txt_ {-# LINE 2452 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_NontermType #-} @@ -2462,9 +2462,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule164 #-} - {-# LINE 169 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 169 "src-ag/PrintOcamlCode.ag" #-} rule164 = \ name_ params_ -> - {-# LINE 169 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 169 "src-ag/PrintOcamlCode.ag" #-} pp_block "(" ")" " " (map text params_ ++ [text $ toOcamlTC name_]) {-# LINE 2470 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TMaybe #-} @@ -2482,9 +2482,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule165 #-} - {-# LINE 170 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 170 "src-ag/PrintOcamlCode.ag" #-} rule165 = \ ((_tpIpp) :: PP_Doc) -> - {-# LINE 170 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 170 "src-ag/PrintOcamlCode.ag" #-} _tpIpp >#< "opt" {-# LINE 2490 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TEither #-} @@ -2504,9 +2504,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule166 #-} - {-# LINE 171 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 171 "src-ag/PrintOcamlCode.ag" #-} rule166 = \ (_ :: ()) -> - {-# LINE 171 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 171 "src-ag/PrintOcamlCode.ag" #-} error "pp of Type.TEither is not supported" {-# LINE 2512 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TMap #-} @@ -2526,9 +2526,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule167 #-} - {-# LINE 172 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 172 "src-ag/PrintOcamlCode.ag" #-} rule167 = \ (_ :: ()) -> - {-# LINE 172 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 172 "src-ag/PrintOcamlCode.ag" #-} error "pp of Type.TMap is not supported" {-# LINE 2534 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TIntMap #-} @@ -2546,9 +2546,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule168 #-} - {-# LINE 173 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 173 "src-ag/PrintOcamlCode.ag" #-} rule168 = \ (_ :: ()) -> - {-# LINE 173 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 173 "src-ag/PrintOcamlCode.ag" #-} error "pp of Type.TIntMap is not supported" {-# LINE 2554 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TSet #-} @@ -2566,9 +2566,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule169 #-} - {-# LINE 174 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 174 "src-ag/PrintOcamlCode.ag" #-} rule169 = \ (_ :: ()) -> - {-# LINE 174 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 174 "src-ag/PrintOcamlCode.ag" #-} error "pp of Type.TSet is not supported" {-# LINE 2574 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TIntSet #-} @@ -2584,9 +2584,9 @@ in __result_ ) in C_Type_s50 v49 {-# INLINE rule170 #-} - {-# LINE 175 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 175 "src-ag/PrintOcamlCode.ag" #-} rule170 = \ (_ :: ()) -> - {-# LINE 175 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 175 "src-ag/PrintOcamlCode.ag" #-} error "pp of Type.TIntSet is not supported" {-# LINE 2592 "dist/build/PrintOcamlCode.hs"#-} @@ -2599,8 +2599,8 @@ wrap_Types !(T_Types act) !(Inh_Types ) = Control.Monad.Identity.runIdentity ( do !sem <- act - let arg = T_Types_vIn52 - !(T_Types_vOut52 _lhsOpps) <- return (inv_Types_s53 sem arg) + let arg52 = T_Types_vIn52 + !(T_Types_vOut52 _lhsOpps) <- return (inv_Types_s53 sem arg52) return (Syn_Types _lhsOpps) ) @@ -2637,9 +2637,9 @@ in __result_ ) in C_Types_s53 v52 {-# INLINE rule171 #-} - {-# LINE 73 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 73 "src-ag/PrintOcamlCode.ag" #-} rule171 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> - {-# LINE 73 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 73 "src-ag/PrintOcamlCode.ag" #-} _hdIpp : _tlIpps {-# LINE 2645 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Types_Nil #-} @@ -2655,8 +2655,8 @@ in __result_ ) in C_Types_s53 v52 {-# INLINE rule172 #-} - {-# LINE 74 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 74 "src-ag/PrintOcamlCode.ag" #-} rule172 = \ (_ :: ()) -> - {-# LINE 74 "./src-ag/PrintOcamlCode.ag" #-} + {-# LINE 74 "src-ag/PrintOcamlCode.ag" #-} [] {-# LINE 2663 "dist/build/PrintOcamlCode.hs"#-} diff --git a/src-generated/PrintVisitCode.hs b/src-generated/PrintVisitCode.hs --- a/src-generated/PrintVisitCode.hs +++ b/src-generated/PrintVisitCode.hs @@ -2,19 +2,19 @@ {-# LANGUAGE ScopedTypeVariables #-} module PrintVisitCode where -{-# LINE 2 "./src-ag/DeclBlocks.ag" #-} +{-# LINE 2 "src-ag/DeclBlocks.ag" #-} import Code (Decl,Expr) {-# LINE 9 "dist/build/PrintVisitCode.hs" #-} -{-# LINE 2 "./src-ag/Patterns.ag" #-} +{-# 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" #-} +{-# LINE 2 "src-ag/CodeSyntax.ag" #-} import Patterns import CommonTypes @@ -22,7 +22,7 @@ import Data.Set(Set) {-# LINE 24 "dist/build/PrintVisitCode.hs" #-} -{-# LINE 10 "./src-ag/PrintVisitCode.ag" #-} +{-# LINE 10 "src-ag/PrintVisitCode.ag" #-} import CommonTypes import SequentialTypes @@ -46,7 +46,7 @@ {-# LINE 47 "dist/build/PrintVisitCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 32 "./src-ag/PrintVisitCode.ag" #-} +{-# LINE 32 "src-ag/PrintVisitCode.ag" #-} type PP_Docs = [PP_Doc] @@ -69,8 +69,8 @@ wrap_CGrammar (T_CGrammar act) (Inh_CGrammar _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CGrammar_vIn1 _lhsIoptions - (T_CGrammar_vOut1 _lhsOoutput) <- return (inv_CGrammar_s2 sem arg) + let arg1 = T_CGrammar_vIn1 _lhsIoptions + (T_CGrammar_vOut1 _lhsOoutput) <- return (inv_CGrammar_s2 sem arg1) return (Syn_CGrammar _lhsOoutput) ) @@ -105,9 +105,9 @@ in __result_ ) in C_CGrammar_s2 v1 {-# INLINE rule0 #-} - {-# LINE 53 "./src-ag/PrintVisitCode.ag" #-} + {-# LINE 53 "src-ag/PrintVisitCode.ag" #-} rule0 = \ (_ :: ()) -> - {-# LINE 53 "./src-ag/PrintVisitCode.ag" #-} + {-# LINE 53 "src-ag/PrintVisitCode.ag" #-} [] {-# LINE 113 "dist/build/PrintVisitCode.hs"#-} @@ -120,8 +120,8 @@ wrap_CInterface (T_CInterface act) (Inh_CInterface ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CInterface_vIn4 - (T_CInterface_vOut4 ) <- return (inv_CInterface_s5 sem arg) + let arg4 = T_CInterface_vIn4 + (T_CInterface_vOut4 ) <- return (inv_CInterface_s5 sem arg4) return (Syn_CInterface ) ) @@ -163,8 +163,8 @@ wrap_CNonterminal (T_CNonterminal act) (Inh_CNonterminal ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CNonterminal_vIn7 - (T_CNonterminal_vOut7 ) <- return (inv_CNonterminal_s8 sem arg) + let arg7 = T_CNonterminal_vIn7 + (T_CNonterminal_vOut7 ) <- return (inv_CNonterminal_s8 sem arg7) return (Syn_CNonterminal ) ) @@ -208,8 +208,8 @@ wrap_CNonterminals (T_CNonterminals act) (Inh_CNonterminals ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CNonterminals_vIn10 - (T_CNonterminals_vOut10 ) <- return (inv_CNonterminals_s11 sem arg) + let arg10 = T_CNonterminals_vIn10 + (T_CNonterminals_vOut10 ) <- return (inv_CNonterminals_s11 sem arg10) return (Syn_CNonterminals ) ) @@ -263,8 +263,8 @@ wrap_CProduction (T_CProduction act) (Inh_CProduction ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CProduction_vIn13 - (T_CProduction_vOut13 ) <- return (inv_CProduction_s14 sem arg) + let arg13 = T_CProduction_vIn13 + (T_CProduction_vOut13 ) <- return (inv_CProduction_s14 sem arg13) return (Syn_CProduction ) ) @@ -306,8 +306,8 @@ wrap_CProductions (T_CProductions act) (Inh_CProductions ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CProductions_vIn16 - (T_CProductions_vOut16 ) <- return (inv_CProductions_s17 sem arg) + let arg16 = T_CProductions_vIn16 + (T_CProductions_vOut16 ) <- return (inv_CProductions_s17 sem arg16) return (Syn_CProductions ) ) @@ -361,8 +361,8 @@ wrap_CRule (T_CRule act) (Inh_CRule ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CRule_vIn19 - (T_CRule_vOut19 ) <- return (inv_CRule_s20 sem arg) + let arg19 = T_CRule_vIn19 + (T_CRule_vOut19 ) <- return (inv_CRule_s20 sem arg19) return (Syn_CRule ) ) @@ -415,8 +415,8 @@ wrap_CSegment (T_CSegment act) (Inh_CSegment ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CSegment_vIn22 - (T_CSegment_vOut22 ) <- return (inv_CSegment_s23 sem arg) + let arg22 = T_CSegment_vIn22 + (T_CSegment_vOut22 ) <- return (inv_CSegment_s23 sem arg22) return (Syn_CSegment ) ) @@ -456,8 +456,8 @@ wrap_CSegments (T_CSegments act) (Inh_CSegments ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CSegments_vIn25 - (T_CSegments_vOut25 ) <- return (inv_CSegments_s26 sem arg) + let arg25 = T_CSegments_vIn25 + (T_CSegments_vOut25 ) <- return (inv_CSegments_s26 sem arg25) return (Syn_CSegments ) ) @@ -511,8 +511,8 @@ wrap_CVisit (T_CVisit act) (Inh_CVisit ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CVisit_vIn28 - (T_CVisit_vOut28 ) <- return (inv_CVisit_s29 sem arg) + let arg28 = T_CVisit_vIn28 + (T_CVisit_vOut28 ) <- return (inv_CVisit_s29 sem arg28) return (Syn_CVisit ) ) @@ -556,8 +556,8 @@ wrap_CVisits (T_CVisits act) (Inh_CVisits ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_CVisits_vIn31 - (T_CVisits_vOut31 ) <- return (inv_CVisits_s32 sem arg) + let arg31 = T_CVisits_vIn31 + (T_CVisits_vOut31 ) <- return (inv_CVisits_s32 sem arg31) return (Syn_CVisits ) ) @@ -611,8 +611,8 @@ wrap_DeclBlocks (T_DeclBlocks act) (Inh_DeclBlocks ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_DeclBlocks_vIn34 - (T_DeclBlocks_vOut34 ) <- return (inv_DeclBlocks_s35 sem arg) + let arg34 = T_DeclBlocks_vIn34 + (T_DeclBlocks_vOut34 ) <- return (inv_DeclBlocks_s35 sem arg34) return (Syn_DeclBlocks ) ) @@ -665,8 +665,8 @@ wrap_DeclBlocksRoot (T_DeclBlocksRoot act) (Inh_DeclBlocksRoot ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_DeclBlocksRoot_vIn37 - (T_DeclBlocksRoot_vOut37 ) <- return (inv_DeclBlocksRoot_s38 sem arg) + let arg37 = T_DeclBlocksRoot_vIn37 + (T_DeclBlocksRoot_vOut37 ) <- return (inv_DeclBlocksRoot_s38 sem arg37) return (Syn_DeclBlocksRoot ) ) @@ -708,8 +708,8 @@ wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Pattern_vIn40 - (T_Pattern_vOut40 _lhsOcopy) <- return (inv_Pattern_s41 sem arg) + let arg40 = T_Pattern_vIn40 + (T_Pattern_vOut40 _lhsOcopy) <- return (inv_Pattern_s41 sem arg40) return (Syn_Pattern _lhsOcopy) ) @@ -846,8 +846,8 @@ wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Patterns_vIn43 - (T_Patterns_vOut43 _lhsOcopy) <- return (inv_Patterns_s44 sem arg) + let arg43 = T_Patterns_vIn43 + (T_Patterns_vOut43 _lhsOcopy) <- return (inv_Patterns_s44 sem arg43) return (Syn_Patterns _lhsOcopy) ) @@ -919,8 +919,8 @@ wrap_Sequence (T_Sequence act) (Inh_Sequence ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Sequence_vIn46 - (T_Sequence_vOut46 ) <- return (inv_Sequence_s47 sem arg) + let arg46 = T_Sequence_vIn46 + (T_Sequence_vOut46 ) <- return (inv_Sequence_s47 sem arg46) return (Syn_Sequence ) ) diff --git a/src-generated/ResolveLocals.hs b/src-generated/ResolveLocals.hs --- a/src-generated/ResolveLocals.hs +++ b/src-generated/ResolveLocals.hs @@ -2,20 +2,20 @@ {-# LANGUAGE ScopedTypeVariables #-} module ResolveLocals where -{-# LINE 2 "./src-ag/Expression.ag" #-} +{-# 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" #-} +{-# 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" #-} +{-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) @@ -27,7 +27,7 @@ import ErrorMessages {-# LINE 29 "dist/build/ResolveLocals.hs" #-} -{-# LINE 15 "./src-ag/ResolveLocals.ag" #-} +{-# LINE 15 "src-ag/ResolveLocals.ag" #-} import qualified Data.Set as Set import qualified Data.Map as Map @@ -55,8 +55,8 @@ 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 arg = T_Child_vIn1 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIsyn _lhsIsynMap - (T_Child_vOut1 _lhsOattributes _lhsOfield _lhsOoutput) <- return (inv_Child_s2 sem arg) + 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) ) @@ -97,36 +97,36 @@ in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 19 "src-ag/DistChildAttr.ag" #-} rule0 = \ name_ tp_ -> - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 23 "src-ag/DistChildAttr.ag" #-} rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 24 "src-ag/DistChildAttr.ag" #-} rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 83 "src-ag/ResolveLocals.ag" #-} rule3 = \ _inh _syn name_ -> - {-# LINE 83 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 83 "src-ag/ResolveLocals.ag" #-} [(name_, _inh , _syn )] {-# LINE 126 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule4 #-} - {-# LINE 86 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 86 "src-ag/ResolveLocals.ag" #-} rule4 = \ kind_ name_ tp_ -> - {-# LINE 86 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 86 "src-ag/ResolveLocals.ag" #-} (name_, tp_, kind_) {-# LINE 132 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule5 #-} @@ -145,8 +145,8 @@ 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 arg = T_Children_vIn4 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIsyn _lhsIsynMap - (T_Children_vOut4 _lhsOattributes _lhsOfields _lhsOoutput) <- return (inv_Children_s5 sem arg) + 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) ) @@ -208,9 +208,9 @@ in __result_ ) in C_Children_s5 v4 {-# INLINE rule7 #-} - {-# LINE 89 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 89 "src-ag/ResolveLocals.ag" #-} rule7 = \ ((_hdIfield) :: (Identifier,Type,ChildKind)) ((_tlIfields) :: [(Identifier,Type,ChildKind)]) -> - {-# LINE 89 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 89 "src-ag/ResolveLocals.ag" #-} _hdIfield : _tlIfields {-# LINE 216 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule8 #-} @@ -300,9 +300,9 @@ in __result_ ) in C_Children_s5 v4 {-# INLINE rule31 #-} - {-# LINE 90 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 90 "src-ag/ResolveLocals.ag" #-} rule31 = \ (_ :: ()) -> - {-# LINE 90 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 90 "src-ag/ResolveLocals.ag" #-} [] {-# LINE 308 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule32 #-} @@ -324,8 +324,8 @@ wrap_Expression (T_Expression act) (Inh_Expression _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Expression_vIn7 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsImergeMap _lhsInt _lhsIoptions - (T_Expression_vOut7 _lhsOerrors _lhsOoutput) <- return (inv_Expression_s8 sem arg) + 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) ) @@ -362,9 +362,9 @@ in __result_ ) in C_Expression_s8 v7 {-# INLINE rule35 #-} - {-# LINE 145 "./src-ag/ResolveLocals.ag" #-} + {-# 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" #-} + {-# 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 @@ -379,9 +379,9 @@ in (errors_Syn_HsTokensRoot synthesized, output_Syn_HsTokensRoot synthesized) {-# LINE 381 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule36 #-} - {-# LINE 157 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 157 "src-ag/ResolveLocals.ag" #-} rule36 = \ _newTks pos_ -> - {-# LINE 157 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 157 "src-ag/ResolveLocals.ag" #-} Expression pos_ _newTks {-# LINE 387 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule37 #-} @@ -400,8 +400,8 @@ wrap_Grammar (T_Grammar act) (Inh_Grammar _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Grammar_vIn10 _lhsIoptions - (T_Grammar_vOut10 _lhsOerrors _lhsOoutput) <- return (inv_Grammar_s11 sem arg) + let arg10 = T_Grammar_vIn10 _lhsIoptions + (T_Grammar_vOut10 _lhsOerrors _lhsOoutput) <- return (inv_Grammar_s11 sem arg10) return (Syn_Grammar _lhsOerrors _lhsOoutput) ) @@ -444,27 +444,27 @@ in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule39 #-} - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 15 "src-ag/DistChildAttr.ag" #-} rule39 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 15 "src-ag/DistChildAttr.ag" #-} _nontsIinhMap' {-# LINE 452 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule40 #-} - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 16 "src-ag/DistChildAttr.ag" #-} rule40 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 16 "src-ag/DistChildAttr.ag" #-} _nontsIsynMap' {-# LINE 458 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule41 #-} - {-# LINE 59 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 59 "src-ag/ResolveLocals.ag" #-} rule41 = \ ((_nontsInonts) :: [(NontermIdent,[ConstructorIdent])]) -> - {-# LINE 59 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 59 "src-ag/ResolveLocals.ag" #-} map fst (_nontsInonts) {-# LINE 464 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule42 #-} - {-# LINE 119 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 119 "src-ag/ResolveLocals.ag" #-} rule42 = \ mergeMap_ -> - {-# LINE 119 "./src-ag/ResolveLocals.ag" #-} + {-# 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 #-} @@ -489,8 +489,8 @@ wrap_Nonterminal (T_Nonterminal act) (Inh_Nonterminal _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Nonterminal_vIn13 _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap - (T_Nonterminal_vOut13 _lhsOerrors _lhsOinhMap' _lhsOnonts _lhsOoutput _lhsOsynMap') <- return (inv_Nonterminal_s14 sem arg) + 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') ) @@ -543,45 +543,45 @@ in __result_ ) in C_Nonterminal_s14 v13 {-# INLINE rule47 #-} - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 7 "src-ag/DistChildAttr.ag" #-} rule47 = \ inh_ nt_ -> - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 7 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ inh_ {-# LINE 551 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule48 #-} - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 8 "src-ag/DistChildAttr.ag" #-} rule48 = \ nt_ syn_ -> - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 8 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ syn_ {-# LINE 557 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule49 #-} - {-# LINE 63 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 63 "src-ag/ResolveLocals.ag" #-} rule49 = \ ((_prodsIcons) :: [ConstructorIdent]) nt_ -> - {-# LINE 63 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 63 "src-ag/ResolveLocals.ag" #-} [(nt_,_prodsIcons)] {-# LINE 563 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule50 #-} - {-# LINE 111 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 111 "src-ag/ResolveLocals.ag" #-} rule50 = \ nt_ -> - {-# LINE 111 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 111 "src-ag/ResolveLocals.ag" #-} nt_ {-# LINE 569 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule51 #-} - {-# LINE 114 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 114 "src-ag/ResolveLocals.ag" #-} rule51 = \ inh_ -> - {-# LINE 114 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 114 "src-ag/ResolveLocals.ag" #-} inh_ {-# LINE 575 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule52 #-} - {-# LINE 115 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 115 "src-ag/ResolveLocals.ag" #-} rule52 = \ syn_ -> - {-# LINE 115 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 115 "src-ag/ResolveLocals.ag" #-} syn_ {-# LINE 581 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule53 #-} - {-# LINE 127 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 127 "src-ag/ResolveLocals.ag" #-} rule53 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) nt_ -> - {-# LINE 127 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 127 "src-ag/ResolveLocals.ag" #-} Map.findWithDefault Map.empty nt_ _lhsImergeMap {-# LINE 587 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule54 #-} @@ -618,8 +618,8 @@ wrap_Nonterminals (T_Nonterminals act) (Inh_Nonterminals _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Nonterminals_vIn16 _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap - (T_Nonterminals_vOut16 _lhsOerrors _lhsOinhMap' _lhsOnonts _lhsOoutput _lhsOsynMap') <- return (inv_Nonterminals_s17 sem arg) + 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') ) @@ -771,8 +771,8 @@ wrap_Pattern (T_Pattern act) (Inh_Pattern _lhsIcon _lhsIinh _lhsInt _lhsIsyn) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Pattern_vIn19 _lhsIcon _lhsIinh _lhsInt _lhsIsyn - (T_Pattern_vOut19 _lhsOcopy _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput) <- return (inv_Pattern_s20 sem arg) + 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) ) @@ -947,17 +947,17 @@ in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule106 #-} - {-# LINE 95 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 95 "src-ag/ResolveLocals.ag" #-} rule106 = \ attr_ field_ -> - {-# LINE 95 "./src-ag/ResolveLocals.ag" #-} + {-# 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" #-} + {-# LINE 98 "src-ag/ResolveLocals.ag" #-} rule107 = \ attr_ field_ -> - {-# LINE 98 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 98 "src-ag/ResolveLocals.ag" #-} if field_ == _INST then [attr_] else [] @@ -1103,8 +1103,8 @@ wrap_Patterns (T_Patterns act) (Inh_Patterns _lhsIcon _lhsIinh _lhsInt _lhsIsyn) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Patterns_vIn22 _lhsIcon _lhsIinh _lhsInt _lhsIsyn - (T_Patterns_vOut22 _lhsOcopy _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput) <- return (inv_Patterns_s23 sem arg) + 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) ) @@ -1256,8 +1256,8 @@ wrap_Production (T_Production act) (Inh_Production _lhsIallnts _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Production_vIn25 _lhsIallnts _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn _lhsIsynMap - (T_Production_vOut25 _lhsOcons _lhsOerrors _lhsOoutput) <- return (inv_Production_s26 sem arg) + 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) ) @@ -1325,54 +1325,54 @@ in __result_ ) in C_Production_s26 v25 {-# INLINE rule157 #-} - {-# LINE 66 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 66 "src-ag/ResolveLocals.ag" #-} rule157 = \ con_ -> - {-# LINE 66 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 66 "src-ag/ResolveLocals.ag" #-} [con_] {-# LINE 1333 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule158 #-} - {-# LINE 73 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 73 "src-ag/ResolveLocals.ag" #-} rule158 = \ ((_childrenIfields) :: [(Identifier,Type,ChildKind)]) -> - {-# LINE 73 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 73 "src-ag/ResolveLocals.ag" #-} _childrenIfields {-# LINE 1339 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule159 #-} - {-# LINE 74 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 74 "src-ag/ResolveLocals.ag" #-} rule159 = \ ((_childrenIattributes) :: [(Identifier,Attributes,Attributes)]) _inhnames ((_rulesIinstVars) :: [Identifier]) ((_rulesIlocVars) :: [Identifier]) -> - {-# LINE 74 "./src-ag/ResolveLocals.ag" #-} + {-# 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" #-} + {-# LINE 78 "src-ag/ResolveLocals.ag" #-} rule160 = \ ((_lhsIinh) :: Attributes) -> - {-# LINE 78 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 78 "src-ag/ResolveLocals.ag" #-} Map.keys _lhsIinh {-# LINE 1354 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule161 #-} - {-# LINE 79 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 79 "src-ag/ResolveLocals.ag" #-} rule161 = \ ((_lhsIsyn) :: Attributes) -> - {-# LINE 79 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 79 "src-ag/ResolveLocals.ag" #-} Map.keys _lhsIsyn {-# LINE 1360 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule162 #-} - {-# LINE 107 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 107 "src-ag/ResolveLocals.ag" #-} rule162 = \ con_ -> - {-# LINE 107 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 107 "src-ag/ResolveLocals.ag" #-} con_ {-# LINE 1366 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule163 #-} - {-# LINE 109 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 109 "src-ag/ResolveLocals.ag" #-} rule163 = \ con_ -> - {-# LINE 109 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 109 "src-ag/ResolveLocals.ag" #-} con_ {-# LINE 1372 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule164 #-} - {-# LINE 128 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 128 "src-ag/ResolveLocals.ag" #-} rule164 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier]))) con_ -> - {-# LINE 128 "./src-ag/ResolveLocals.ag" #-} + {-# LINE 128 "src-ag/ResolveLocals.ag" #-} Map.findWithDefault Map.empty con_ _lhsImergeMap {-# LINE 1378 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule165 #-} @@ -1445,8 +1445,8 @@ wrap_Productions (T_Productions act) (Inh_Productions _lhsIallnts _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Productions_vIn28 _lhsIallnts _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn _lhsIsynMap - (T_Productions_vOut28 _lhsOcons _lhsOerrors _lhsOoutput) <- return (inv_Productions_s29 sem arg) + 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) ) @@ -1602,8 +1602,8 @@ wrap_Rule (T_Rule act) (Inh_Rule _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Rule_vIn31 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn - (T_Rule_vOut31 _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput) <- return (inv_Rule_s32 sem arg) + 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) ) @@ -1715,8 +1715,8 @@ wrap_Rules (T_Rules act) (Inh_Rules _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Rules_vIn34 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsImergeMap _lhsInt _lhsIoptions _lhsIsyn - (T_Rules_vOut34 _lhsOerrors _lhsOinstVars _lhsOlocVars _lhsOoutput) <- return (inv_Rules_s35 sem arg) + 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) ) @@ -1890,8 +1890,8 @@ wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_TypeSig_vIn37 - (T_TypeSig_vOut37 _lhsOoutput) <- return (inv_TypeSig_s38 sem arg) + let arg37 = T_TypeSig_vIn37 + (T_TypeSig_vOut37 _lhsOoutput) <- return (inv_TypeSig_s38 sem arg37) return (Syn_TypeSig _lhsOoutput) ) @@ -1940,8 +1940,8 @@ wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_TypeSigs_vIn40 - (T_TypeSigs_vOut40 _lhsOoutput) <- return (inv_TypeSigs_s41 sem arg) + let arg40 = T_TypeSigs_vIn40 + (T_TypeSigs_vOut40 _lhsOoutput) <- return (inv_TypeSigs_s41 sem arg40) return (Syn_TypeSigs _lhsOoutput) ) diff --git a/src-generated/SemHsTokens.hs b/src-generated/SemHsTokens.hs --- a/src-generated/SemHsTokens.hs +++ b/src-generated/SemHsTokens.hs @@ -2,13 +2,13 @@ {-# LANGUAGE ScopedTypeVariables #-} module SemHsTokens where -{-# LINE 2 "./src-ag/HsToken.ag" #-} +{-# 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" #-} +{-# LINE 4 "src-ag/SemHsTokens.ag" #-} import qualified Data.Sequence as Seq import Data.Sequence(Seq,empty,singleton,(><)) @@ -21,7 +21,7 @@ {-# LINE 22 "dist/build/SemHsTokens.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 58 "./src-ag/SemHsTokens.ag" #-} +{-# LINE 58 "src-ag/SemHsTokens.ag" #-} isNTname allnts (Just (NT nt _ _)) = nt `elem` allnts isNTname allnts _ = False @@ -35,8 +35,8 @@ wrap_HsToken (T_HsToken act) (Inh_HsToken _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_HsToken_vIn1 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions - (T_HsToken_vOut1 _lhsOerrors _lhsOoutput _lhsOtok _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals) <- return (inv_HsToken_s2 sem arg) + 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) ) @@ -87,21 +87,21 @@ in __result_ ) in C_HsToken_s2 v1 {-# INLINE rule0 #-} - {-# LINE 66 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 66 "src-ag/SemHsTokens.ag" #-} rule0 = \ pos_ rdesc_ var_ -> - {-# LINE 66 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 66 "src-ag/SemHsTokens.ag" #-} AGLocal var_ pos_ rdesc_ {-# LINE 95 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule1 #-} - {-# LINE 67 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 67 "src-ag/SemHsTokens.ag" #-} rule1 = \ pos_ rdesc_ var_ -> - {-# LINE 67 "./src-ag/SemHsTokens.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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_), [] ) @@ -111,9 +111,9 @@ 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" #-} + {-# LINE 104 "src-ag/SemHsTokens.ag" #-} rule3 = \ ((_lhsIfieldnames) :: [Identifier]) var_ -> - {-# LINE 104 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 104 "src-ag/SemHsTokens.ag" #-} if var_ `elem` _lhsIfieldnames then Seq.singleton var_ else Seq.empty @@ -157,9 +157,9 @@ in __result_ ) in C_HsToken_s2 v1 {-# INLINE rule9 #-} - {-# LINE 78 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 78 "src-ag/SemHsTokens.ag" #-} rule9 = \ ((_lhsIattrs) :: [(Identifier,Identifier)]) ((_lhsIcon) :: Identifier) ((_lhsIfieldnames) :: [Identifier]) ((_lhsInt) :: Identifier) attr_ field_ -> - {-# LINE 78 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 78 "src-ag/SemHsTokens.ag" #-} if (field_,attr_) `elem` _lhsIattrs then Seq.empty else if not(field_ `elem` (_LHS : _LOC: _lhsIfieldnames)) @@ -167,25 +167,25 @@ else Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ attr_ False) {-# LINE 169 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule10 #-} - {-# LINE 93 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 93 "src-ag/SemHsTokens.ag" #-} rule10 = \ attr_ field_ -> - {-# LINE 93 "./src-ag/SemHsTokens.ag" #-} + {-# 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" #-} + {-# LINE 123 "src-ag/SemHsTokens.ag" #-} rule11 = \ attr_ field_ rdesc_ -> - {-# LINE 123 "./src-ag/SemHsTokens.ag" #-} + {-# 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" #-} + {-# LINE 126 "src-ag/SemHsTokens.ag" #-} rule12 = \ _addTrace ((_lhsIoptions) :: Options) attr_ field_ pos_ -> - {-# LINE 126 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 126 "src-ag/SemHsTokens.ag" #-} (pos_, _addTrace $ attrname _lhsIoptions True field_ attr_) {-# LINE 191 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule13 #-} @@ -221,9 +221,9 @@ in __result_ ) in C_HsToken_s2 v1 {-# INLINE rule16 #-} - {-# LINE 128 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 128 "src-ag/SemHsTokens.ag" #-} rule16 = \ pos_ value_ -> - {-# LINE 128 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 128 "src-ag/SemHsTokens.ag" #-} (pos_, value_) {-# LINE 229 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule17 #-} @@ -268,9 +268,9 @@ in __result_ ) in C_HsToken_s2 v1 {-# INLINE rule23 #-} - {-# LINE 130 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 130 "src-ag/SemHsTokens.ag" #-} rule23 = \ pos_ value_ -> - {-# LINE 130 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 130 "src-ag/SemHsTokens.ag" #-} (pos_, if null value_ then "" else showCharShort (head value_) @@ -318,9 +318,9 @@ in __result_ ) in C_HsToken_s2 v1 {-# INLINE rule30 #-} - {-# LINE 135 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 135 "src-ag/SemHsTokens.ag" #-} rule30 = \ pos_ value_ -> - {-# LINE 135 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 135 "src-ag/SemHsTokens.ag" #-} (pos_, showStrShort value_) {-# LINE 326 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule31 #-} @@ -365,16 +365,16 @@ in __result_ ) in C_HsToken_s2 v1 {-# INLINE rule37 #-} - {-# LINE 51 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 51 "src-ag/SemHsTokens.ag" #-} rule37 = \ mesg_ pos_ -> - {-# LINE 51 "./src-ag/SemHsTokens.ag" #-} + {-# 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" #-} + {-# LINE 136 "src-ag/SemHsTokens.ag" #-} rule38 = \ pos_ -> - {-# LINE 136 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 136 "src-ag/SemHsTokens.ag" #-} (pos_, "") {-# LINE 380 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule39 #-} @@ -402,8 +402,8 @@ wrap_HsTokens (T_HsTokens act) (Inh_HsTokens _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_HsTokens_vIn4 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIfieldnames _lhsInt _lhsIoptions - (T_HsTokens_vOut4 _lhsOerrors _lhsOoutput _lhsOtks _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals) <- return (inv_HsTokens_s5 sem arg) + 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) ) @@ -465,9 +465,9 @@ in __result_ ) in C_HsTokens_s5 v4 {-# INLINE rule44 #-} - {-# LINE 118 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 118 "src-ag/SemHsTokens.ag" #-} rule44 = \ ((_hdItok) :: (Pos,String)) ((_tlItks) :: [(Pos,String)]) -> - {-# LINE 118 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 118 "src-ag/SemHsTokens.ag" #-} _hdItok : _tlItks {-# LINE 473 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule45 #-} @@ -554,9 +554,9 @@ in __result_ ) in C_HsTokens_s5 v4 {-# INLINE rule65 #-} - {-# LINE 119 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 119 "src-ag/SemHsTokens.ag" #-} rule65 = \ (_ :: ()) -> - {-# LINE 119 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 119 "src-ag/SemHsTokens.ag" #-} [] {-# LINE 562 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule66 #-} @@ -587,8 +587,8 @@ wrap_HsTokensRoot (T_HsTokensRoot act) (Inh_HsTokensRoot _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_HsTokensRoot_vIn7 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsInt _lhsIoptions - (T_HsTokensRoot_vOut7 _lhsOerrors _lhsOoutput _lhsOtextLines _lhsOusedAttrs _lhsOusedFields _lhsOusedLocals) <- return (inv_HsTokensRoot_s8 sem arg) + 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) ) @@ -640,21 +640,21 @@ in __result_ ) in C_HsTokensRoot_s8 v7 {-# INLINE rule72 #-} - {-# LINE 39 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 39 "src-ag/SemHsTokens.ag" #-} rule72 = \ ((_lhsIallfields) :: [(Identifier,Type,ChildKind)]) -> - {-# LINE 39 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 39 "src-ag/SemHsTokens.ag" #-} map (\(n,_,_) -> n) _lhsIallfields {-# LINE 648 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule73 #-} - {-# LINE 108 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 108 "src-ag/SemHsTokens.ag" #-} rule73 = \ ((_tokensIusedFields) :: Seq Identifier) -> - {-# LINE 108 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 108 "src-ag/SemHsTokens.ag" #-} toList _tokensIusedFields {-# LINE 654 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule74 #-} - {-# LINE 115 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 115 "src-ag/SemHsTokens.ag" #-} rule74 = \ ((_tokensItks) :: [(Pos,String)]) -> - {-# LINE 115 "./src-ag/SemHsTokens.ag" #-} + {-# LINE 115 "src-ag/SemHsTokens.ag" #-} showTokens _tokensItks {-# LINE 660 "dist/build/SemHsTokens.hs"#-} {-# INLINE rule75 #-} diff --git a/src-generated/TfmToVisage.hs b/src-generated/TfmToVisage.hs --- a/src-generated/TfmToVisage.hs +++ b/src-generated/TfmToVisage.hs @@ -2,20 +2,20 @@ {-# LANGUAGE ScopedTypeVariables #-} module TfmToVisage where -{-# LINE 2 "./src-ag/Expression.ag" #-} +{-# 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" #-} +{-# 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" #-} +{-# LINE 2 "src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports import Data.Set(Set) @@ -27,7 +27,7 @@ import ErrorMessages {-# LINE 29 "dist/build/TfmToVisage.hs" #-} -{-# LINE 9 "./src-ag/TfmToVisage.ag" #-} +{-# LINE 9 "src-ag/TfmToVisage.ag" #-} import AbstractSyntax import VisagePatterns @@ -37,7 +37,7 @@ {-# LINE 38 "dist/build/TfmToVisage.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 17 "./src-ag/TfmToVisage.ag" #-} +{-# 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. @@ -102,8 +102,8 @@ wrap_Child (T_Child act) (Inh_Child _lhsIinhMap _lhsIrulemap _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Child_vIn1 _lhsIinhMap _lhsIrulemap _lhsIsynMap - (T_Child_vOut1 _lhsOvchild) <- return (inv_Child_s2 sem arg) + let arg1 = T_Child_vIn1 _lhsIinhMap _lhsIrulemap _lhsIsynMap + (T_Child_vOut1 _lhsOvchild) <- return (inv_Child_s2 sem arg1) return (Syn_Child _lhsOvchild) ) @@ -139,30 +139,30 @@ in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 19 "src-ag/DistChildAttr.ag" #-} rule0 = \ name_ tp_ -> - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 23 "src-ag/DistChildAttr.ag" #-} rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 24 "src-ag/DistChildAttr.ag" #-} rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + {-# 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" #-} + {-# LINE 121 "src-ag/TfmToVisage.ag" #-} rule3 = \ _inh ((_lhsIrulemap) :: VisageRuleMap) _syn name_ tp_ -> - {-# LINE 121 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 121 "src-ag/TfmToVisage.ag" #-} VChild name_ tp_ _inh _syn (getForField (getName name_) _lhsIrulemap) {-# LINE 168 "dist/build/TfmToVisage.hs"#-} @@ -175,8 +175,8 @@ wrap_Children (T_Children act) (Inh_Children _lhsIinhMap _lhsIrulemap _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Children_vIn4 _lhsIinhMap _lhsIrulemap _lhsIsynMap - (T_Children_vOut4 _lhsOvchildren) <- return (inv_Children_s5 sem arg) + let arg4 = T_Children_vIn4 _lhsIinhMap _lhsIrulemap _lhsIsynMap + (T_Children_vOut4 _lhsOvchildren) <- return (inv_Children_s5 sem arg4) return (Syn_Children _lhsOvchildren) ) @@ -219,9 +219,9 @@ in __result_ ) in C_Children_s5 v4 {-# INLINE rule4 #-} - {-# LINE 117 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 117 "src-ag/TfmToVisage.ag" #-} rule4 = \ ((_hdIvchild) :: VisageChild) ((_tlIvchildren) :: [VisageChild]) -> - {-# LINE 117 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 117 "src-ag/TfmToVisage.ag" #-} _hdIvchild : _tlIvchildren {-# LINE 227 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule5 #-} @@ -255,9 +255,9 @@ in __result_ ) in C_Children_s5 v4 {-# INLINE rule11 #-} - {-# LINE 118 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 118 "src-ag/TfmToVisage.ag" #-} rule11 = \ (_ :: ()) -> - {-# LINE 118 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 118 "src-ag/TfmToVisage.ag" #-} [] {-# LINE 263 "dist/build/TfmToVisage.hs"#-} @@ -270,8 +270,8 @@ wrap_Expression (T_Expression act) (Inh_Expression ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Expression_vIn7 - (T_Expression_vOut7 _lhsOself) <- return (inv_Expression_s8 sem arg) + let arg7 = T_Expression_vIn7 + (T_Expression_vOut7 _lhsOself) <- return (inv_Expression_s8 sem arg7) return (Syn_Expression _lhsOself) ) @@ -320,8 +320,8 @@ wrap_Grammar (T_Grammar act) (Inh_Grammar ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Grammar_vIn10 - (T_Grammar_vOut10 _lhsOvisage) <- return (inv_Grammar_s11 sem arg) + let arg10 = T_Grammar_vIn10 + (T_Grammar_vOut10 _lhsOvisage) <- return (inv_Grammar_s11 sem arg10) return (Syn_Grammar _lhsOvisage) ) @@ -358,21 +358,21 @@ in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule14 #-} - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 15 "src-ag/DistChildAttr.ag" #-} rule14 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 15 "src-ag/DistChildAttr.ag" #-} _nontsIinhMap' {-# LINE 366 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule15 #-} - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 16 "src-ag/DistChildAttr.ag" #-} rule15 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 16 "src-ag/DistChildAttr.ag" #-} _nontsIsynMap' {-# LINE 372 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule16 #-} - {-# LINE 90 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 90 "src-ag/TfmToVisage.ag" #-} rule16 = \ ((_nontsIvnonts) :: [VisageNonterminal]) -> - {-# LINE 90 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 90 "src-ag/TfmToVisage.ag" #-} VGrammar _nontsIvnonts {-# LINE 378 "dist/build/TfmToVisage.hs"#-} @@ -385,8 +385,8 @@ wrap_Nonterminal (T_Nonterminal act) (Inh_Nonterminal _lhsIinhMap _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Nonterminal_vIn13 _lhsIinhMap _lhsIsynMap - (T_Nonterminal_vOut13 _lhsOinhMap' _lhsOsynMap' _lhsOvnont) <- return (inv_Nonterminal_s14 sem arg) + 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) ) @@ -427,21 +427,21 @@ in __result_ ) in C_Nonterminal_s14 v13 {-# INLINE rule17 #-} - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 7 "src-ag/DistChildAttr.ag" #-} rule17 = \ inh_ nt_ -> - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 7 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ inh_ {-# LINE 435 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule18 #-} - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 8 "src-ag/DistChildAttr.ag" #-} rule18 = \ nt_ syn_ -> - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + {-# LINE 8 "src-ag/DistChildAttr.ag" #-} Map.singleton nt_ syn_ {-# LINE 441 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule19 #-} - {-# LINE 100 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 100 "src-ag/TfmToVisage.ag" #-} rule19 = \ ((_prodsIvprods) :: [VisageProduction]) inh_ nt_ syn_ -> - {-# LINE 100 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 100 "src-ag/TfmToVisage.ag" #-} VNonterminal nt_ inh_ syn_ _prodsIvprods {-# LINE 447 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule20 #-} @@ -460,8 +460,8 @@ wrap_Nonterminals (T_Nonterminals act) (Inh_Nonterminals _lhsIinhMap _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Nonterminals_vIn16 _lhsIinhMap _lhsIsynMap - (T_Nonterminals_vOut16 _lhsOinhMap' _lhsOsynMap' _lhsOvnonts) <- return (inv_Nonterminals_s17 sem arg) + 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) ) @@ -506,9 +506,9 @@ in __result_ ) in C_Nonterminals_s17 v16 {-# INLINE rule22 #-} - {-# LINE 94 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 94 "src-ag/TfmToVisage.ag" #-} rule22 = \ ((_hdIvnont) :: VisageNonterminal) ((_tlIvnonts) :: [VisageNonterminal]) -> - {-# LINE 94 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 94 "src-ag/TfmToVisage.ag" #-} _hdIvnont : _tlIvnonts {-# LINE 514 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule23 #-} @@ -546,9 +546,9 @@ in __result_ ) in C_Nonterminals_s17 v16 {-# INLINE rule29 #-} - {-# LINE 96 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 96 "src-ag/TfmToVisage.ag" #-} rule29 = \ (_ :: ()) -> - {-# LINE 96 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 96 "src-ag/TfmToVisage.ag" #-} [] {-# LINE 554 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule30 #-} @@ -567,8 +567,8 @@ wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Pattern_vIn19 - (T_Pattern_vOut19 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpat) <- return (inv_Pattern_s20 sem arg) + 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) ) @@ -615,9 +615,9 @@ in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule32 #-} - {-# LINE 136 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 136 "src-ag/TfmToVisage.ag" #-} rule32 = \ ((_patsIvpats) :: [VisagePattern]) name_ -> - {-# LINE 136 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 136 "src-ag/TfmToVisage.ag" #-} VConstr name_ _patsIvpats {-# LINE 623 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule33 #-} @@ -658,9 +658,9 @@ in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule38 #-} - {-# LINE 137 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 137 "src-ag/TfmToVisage.ag" #-} rule38 = \ ((_patsIvpats) :: [VisagePattern]) pos_ -> - {-# LINE 137 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 137 "src-ag/TfmToVisage.ag" #-} VProduct pos_ _patsIvpats {-# LINE 666 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule39 #-} @@ -701,17 +701,17 @@ in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule44 #-} - {-# LINE 138 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 138 "src-ag/TfmToVisage.ag" #-} rule44 = \ ((_patIvpat) :: VisagePattern) _self attr_ field_ -> - {-# LINE 138 "./src-ag/TfmToVisage.ag" #-} + {-# 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" #-} + {-# LINE 147 "src-ag/TfmToVisage.ag" #-} rule45 = \ attr_ field_ -> - {-# LINE 147 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 147 "src-ag/TfmToVisage.ag" #-} [(field_, attr_)] {-# LINE 717 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule46 #-} @@ -787,9 +787,9 @@ in __result_ ) in C_Pattern_s20 v19 {-# INLINE rule56 #-} - {-# LINE 141 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 141 "src-ag/TfmToVisage.ag" #-} rule56 = \ pos_ -> - {-# LINE 141 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 141 "src-ag/TfmToVisage.ag" #-} VUnderscore pos_ {-# LINE 795 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule57 #-} @@ -817,8 +817,8 @@ wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Patterns_vIn22 - (T_Patterns_vOut22 _lhsOcopy _lhsOfieldattrs _lhsOself _lhsOvpats) <- return (inv_Patterns_s23 sem arg) + 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) ) @@ -863,9 +863,9 @@ in __result_ ) in C_Patterns_s23 v22 {-# INLINE rule62 #-} - {-# LINE 132 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 132 "src-ag/TfmToVisage.ag" #-} rule62 = \ ((_hdIvpat) :: VisagePattern) ((_tlIvpats) :: [VisagePattern]) -> - {-# LINE 132 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 132 "src-ag/TfmToVisage.ag" #-} _hdIvpat : _tlIvpats {-# LINE 871 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule63 #-} @@ -904,9 +904,9 @@ in __result_ ) in C_Patterns_s23 v22 {-# INLINE rule68 #-} - {-# LINE 133 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 133 "src-ag/TfmToVisage.ag" #-} rule68 = \ (_ :: ()) -> - {-# LINE 133 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 133 "src-ag/TfmToVisage.ag" #-} [] {-# LINE 912 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule69 #-} @@ -934,8 +934,8 @@ wrap_Production (T_Production act) (Inh_Production _lhsIinhMap _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Production_vIn25 _lhsIinhMap _lhsIsynMap - (T_Production_vOut25 _lhsOvprod) <- return (inv_Production_s26 sem arg) + let arg25 = T_Production_vIn25 _lhsIinhMap _lhsIsynMap + (T_Production_vOut25 _lhsOvprod) <- return (inv_Production_s26 sem arg25) return (Syn_Production _lhsOvprod) ) @@ -980,33 +980,33 @@ in __result_ ) in C_Production_s26 v25 {-# INLINE rule74 #-} - {-# LINE 110 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 110 "src-ag/TfmToVisage.ag" #-} rule74 = \ ((_childrenIvchildren) :: [VisageChild]) _lhsrules _locrules con_ -> - {-# LINE 110 "./src-ag/TfmToVisage.ag" #-} + {-# 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" #-} + {-# LINE 111 "src-ag/TfmToVisage.ag" #-} rule75 = \ ((_rulesIvrules) :: [VisageRule]) -> - {-# LINE 111 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 111 "src-ag/TfmToVisage.ag" #-} splitVRules _rulesIvrules {-# LINE 994 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule76 #-} - {-# LINE 112 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 112 "src-ag/TfmToVisage.ag" #-} rule76 = \ _splitVRules -> - {-# LINE 112 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 112 "src-ag/TfmToVisage.ag" #-} getForField "loc" _splitVRules {-# LINE 1000 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule77 #-} - {-# LINE 113 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 113 "src-ag/TfmToVisage.ag" #-} rule77 = \ _splitVRules -> - {-# LINE 113 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 113 "src-ag/TfmToVisage.ag" #-} getForField "lhs" _splitVRules {-# LINE 1006 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule78 #-} - {-# LINE 114 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 114 "src-ag/TfmToVisage.ag" #-} rule78 = \ _splitVRules -> - {-# LINE 114 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 114 "src-ag/TfmToVisage.ag" #-} _splitVRules {-# LINE 1012 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule79 #-} @@ -1025,8 +1025,8 @@ wrap_Productions (T_Productions act) (Inh_Productions _lhsIinhMap _lhsIsynMap) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Productions_vIn28 _lhsIinhMap _lhsIsynMap - (T_Productions_vOut28 _lhsOvprods) <- return (inv_Productions_s29 sem arg) + let arg28 = T_Productions_vIn28 _lhsIinhMap _lhsIsynMap + (T_Productions_vOut28 _lhsOvprods) <- return (inv_Productions_s29 sem arg28) return (Syn_Productions _lhsOvprods) ) @@ -1067,9 +1067,9 @@ in __result_ ) in C_Productions_s29 v28 {-# INLINE rule81 #-} - {-# LINE 104 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 104 "src-ag/TfmToVisage.ag" #-} rule81 = \ ((_hdIvprod) :: VisageProduction) ((_tlIvprods) :: [VisageProduction]) -> - {-# LINE 104 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 104 "src-ag/TfmToVisage.ag" #-} _hdIvprod : _tlIvprods {-# LINE 1075 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule82 #-} @@ -1097,9 +1097,9 @@ in __result_ ) in C_Productions_s29 v28 {-# INLINE rule86 #-} - {-# LINE 106 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 106 "src-ag/TfmToVisage.ag" #-} rule86 = \ (_ :: ()) -> - {-# LINE 106 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 106 "src-ag/TfmToVisage.ag" #-} [] {-# LINE 1105 "dist/build/TfmToVisage.hs"#-} @@ -1112,8 +1112,8 @@ wrap_Rule (T_Rule act) (Inh_Rule ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Rule_vIn31 - (T_Rule_vOut31 _lhsOvrule) <- return (inv_Rule_s32 sem arg) + let arg31 = T_Rule_vIn31 + (T_Rule_vOut31 _lhsOvrule) <- return (inv_Rule_s32 sem arg31) return (Syn_Rule _lhsOvrule) ) @@ -1150,9 +1150,9 @@ in __result_ ) in C_Rule_s32 v31 {-# INLINE rule87 #-} - {-# LINE 129 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 129 "src-ag/TfmToVisage.ag" #-} rule87 = \ ((_patternIfieldattrs) :: [(Identifier,Identifier)] ) ((_patternIvpat) :: VisagePattern) ((_rhsIself) :: Expression) owrt_ -> - {-# LINE 129 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 129 "src-ag/TfmToVisage.ag" #-} VRule _patternIfieldattrs undefined _patternIvpat _rhsIself owrt_ {-# LINE 1158 "dist/build/TfmToVisage.hs"#-} @@ -1165,8 +1165,8 @@ wrap_Rules (T_Rules act) (Inh_Rules ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Rules_vIn34 - (T_Rules_vOut34 _lhsOvrules) <- return (inv_Rules_s35 sem arg) + let arg34 = T_Rules_vIn34 + (T_Rules_vOut34 _lhsOvrules) <- return (inv_Rules_s35 sem arg34) return (Syn_Rules _lhsOvrules) ) @@ -1203,9 +1203,9 @@ in __result_ ) in C_Rules_s35 v34 {-# INLINE rule88 #-} - {-# LINE 124 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 124 "src-ag/TfmToVisage.ag" #-} rule88 = \ ((_hdIvrule) :: VisageRule) ((_tlIvrules) :: [VisageRule]) -> - {-# LINE 124 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 124 "src-ag/TfmToVisage.ag" #-} _hdIvrule : _tlIvrules {-# LINE 1211 "dist/build/TfmToVisage.hs"#-} {-# NOINLINE sem_Rules_Nil #-} @@ -1221,9 +1221,9 @@ in __result_ ) in C_Rules_s35 v34 {-# INLINE rule89 #-} - {-# LINE 125 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 125 "src-ag/TfmToVisage.ag" #-} rule89 = \ (_ :: ()) -> - {-# LINE 125 "./src-ag/TfmToVisage.ag" #-} + {-# LINE 125 "src-ag/TfmToVisage.ag" #-} [] {-# LINE 1229 "dist/build/TfmToVisage.hs"#-} @@ -1236,8 +1236,8 @@ wrap_TypeSig (T_TypeSig act) (Inh_TypeSig ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_TypeSig_vIn37 - (T_TypeSig_vOut37 ) <- return (inv_TypeSig_s38 sem arg) + let arg37 = T_TypeSig_vIn37 + (T_TypeSig_vOut37 ) <- return (inv_TypeSig_s38 sem arg37) return (Syn_TypeSig ) ) @@ -1277,8 +1277,8 @@ wrap_TypeSigs (T_TypeSigs act) (Inh_TypeSigs ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_TypeSigs_vIn40 - (T_TypeSigs_vOut40 ) <- return (inv_TypeSigs_s41 sem arg) + let arg40 = T_TypeSigs_vIn40 + (T_TypeSigs_vOut40 ) <- return (inv_TypeSigs_s41 sem arg40) return (Syn_TypeSigs ) ) diff --git a/src-generated/Transform.hs b/src-generated/Transform.hs --- a/src-generated/Transform.hs +++ b/src-generated/Transform.hs @@ -2,14 +2,14 @@ {-# LANGUAGE ScopedTypeVariables #-} module Transform where -{-# LINE 2 "./src-ag/Patterns.ag" #-} +{-# 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" #-} +{-# LINE 2 "src-ag/ConcreteSyntax.ag" #-} import UU.Scanner.Position (Pos) import Patterns (Pattern) @@ -18,7 +18,7 @@ import Macro --marcos {-# LINE 20 "dist/build/Transform.hs" #-} -{-# LINE 8 "./src-ag/Transform.ag" #-} +{-# LINE 8 "src-ag/Transform.ag" #-} import Control.Monad(mplus,mzero) import Data.List (partition, nub,intersperse, union) @@ -42,47 +42,47 @@ {-# LINE 43 "dist/build/Transform.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 104 "./src-ag/Transform.ag" #-} +{-# LINE 104 "src-ag/Transform.ag" #-} type DefinedSets = Map Identifier (Set NontermIdent) {-# LINE 48 "dist/build/Transform.hs" #-} -{-# LINE 124 "./src-ag/Transform.ag" #-} +{-# LINE 124 "src-ag/Transform.ag" #-} type FieldMap = [(Identifier, Type)] {-# LINE 52 "dist/build/Transform.hs" #-} -{-# LINE 125 "./src-ag/Transform.ag" #-} +{-# 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" #-} +{-# LINE 148 "src-ag/Transform.ag" #-} type AttrName = (Identifier,Identifier) {-# LINE 60 "dist/build/Transform.hs" #-} -{-# LINE 149 "./src-ag/Transform.ag" #-} +{-# 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" #-} +{-# LINE 150 "src-ag/Transform.ag" #-} type SigInfo = (Identifier,Type) {-# LINE 68 "dist/build/Transform.hs" #-} -{-# LINE 151 "./src-ag/Transform.ag" #-} +{-# LINE 151 "src-ag/Transform.ag" #-} type UniqueInfo = (Identifier,Identifier) {-# LINE 72 "dist/build/Transform.hs" #-} -{-# LINE 152 "./src-ag/Transform.ag" #-} +{-# LINE 152 "src-ag/Transform.ag" #-} type AugmentInfo = (Identifier,Expression) {-# LINE 76 "dist/build/Transform.hs" #-} -{-# LINE 153 "./src-ag/Transform.ag" #-} +{-# LINE 153 "src-ag/Transform.ag" #-} type AroundInfo = (Identifier,Expression) {-# LINE 80 "dist/build/Transform.hs" #-} -{-# LINE 154 "./src-ag/Transform.ag" #-} +{-# LINE 154 "src-ag/Transform.ag" #-} type MergeInfo = (Identifier, Identifier, [Identifier], Expression) {-# LINE 84 "dist/build/Transform.hs" #-} -{-# LINE 203 "./src-ag/Transform.ag" #-} +{-# LINE 203 "src-ag/Transform.ag" #-} checkDuplicate :: (Identifier -> Identifier -> Error) @@ -114,7 +114,7 @@ {-# LINE 116 "dist/build/Transform.hs" #-} -{-# LINE 354 "./src-ag/Transform.ag" #-} +{-# LINE 354 "src-ag/Transform.ag" #-} type RulesAndErrors = ([Rule], Seq Error) type SigsAndErrors = ([TypeSig], Seq Error) @@ -271,7 +271,7 @@ unionunionplusplus = Map.unionWith (Map.unionWith (++)) {-# LINE 273 "dist/build/Transform.hs" #-} -{-# LINE 511 "./src-ag/Transform.ag" #-} +{-# 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 @@ -311,7 +311,7 @@ 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" #-} +{-# LINE 747 "src-ag/Transform.ag" #-} flattenDatas :: DataTypes -> Map NontermIdent (Set NontermIdent) flattenDatas ds = Map.map flatten ds @@ -336,7 +336,7 @@ in Set.intersection forward backward {-# LINE 338 "dist/build/Transform.hs" #-} -{-# LINE 874 "./src-ag/Transform.ag" #-} +{-# LINE 874 "src-ag/Transform.ag" #-} extract :: String -> [String] extract s = case dropWhile isSeparator s of @@ -347,7 +347,7 @@ isSeparator x = x == '_' {-# LINE 349 "dist/build/Transform.hs" #-} -{-# LINE 900 "./src-ag/Transform.ag" #-} +{-# LINE 900 "src-ag/Transform.ag" #-} pragmaMapUnion :: PragmaMap -> PragmaMap -> PragmaMap pragmaMapUnion = Map.unionWith (Map.unionWith Set.union) @@ -356,7 +356,7 @@ pragmaMapSingle nt con nms = Map.singleton nt (Map.singleton con nms) {-# LINE 358 "dist/build/Transform.hs" #-} -{-# LINE 932 "./src-ag/Transform.ag" #-} +{-# LINE 932 "src-ag/Transform.ag" #-} orderMapUnion :: AttrOrderMap -> AttrOrderMap -> AttrOrderMap orderMapUnion = Map.unionWith (Map.unionWith Set.union) @@ -365,13 +365,13 @@ orderMapSingle nt con deps = Map.singleton nt (Map.singleton con deps) {-# LINE 367 "dist/build/Transform.hs" #-} -{-# LINE 958 "./src-ag/Transform.ag" #-} +{-# 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" #-} +{-# LINE 981 "src-ag/Transform.ag" #-} mergeCtx :: ContextMap -> ContextMap -> ContextMap mergeCtx @@ -379,26 +379,26 @@ where nubconcat a b = nub (a ++ b) {-# LINE 381 "dist/build/Transform.hs" #-} -{-# LINE 1000 "./src-ag/Transform.ag" #-} +{-# 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" #-} +{-# 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" #-} +{-# 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" #-} +{-# 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 @@ -409,20 +409,20 @@ in (Map.insert nt (inh',syn') decls,einh >< esyn) {-# LINE 411 "dist/build/Transform.hs" #-} -{-# LINE 1078 "./src-ag/Transform.ag" #-} +{-# 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" #-} +{-# 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" #-} +{-# LINE 1224 "src-ag/Transform.ag" #-} makeType :: Set NontermIdent -> Type -> Type makeType nts tp@(NT x _ _) | Set.member x nts = tp @@ -430,7 +430,7 @@ makeType _ tp = tp {-# LINE 432 "dist/build/Transform.hs" #-} -{-# LINE 1230 "./src-ag/Transform.ag" #-} +{-# LINE 1230 "src-ag/Transform.ag" #-} constructGrammar :: Set NontermIdent -> ParamMap @@ -502,7 +502,7 @@ 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" #-} +{-# LINE 1301 "src-ag/Transform.ag" #-} mapUnionWithSetUnion :: Map NontermIdent (Set ConstructorIdent) -> Map NontermIdent (Set ConstructorIdent) -> Map NontermIdent (Set ConstructorIdent) mapUnionWithSetUnion = Map.unionWith Set.union @@ -518,8 +518,8 @@ wrap_AG (T_AG act) (Inh_AG _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_AG_vIn1 _lhsIoptions - (T_AG_vOut1 _lhsOagi _lhsOblocks _lhsOconstructorTypeMap _lhsOerrors _lhsOmoduleDecl _lhsOoutput _lhsOpragmas) <- return (inv_AG_s2 sem arg) + 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) ) @@ -620,9 +620,9 @@ in __result_ ) in C_AG_s2 v1 {-# INLINE rule0 #-} - {-# LINE 50 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 50 "src-ag/Transform.ag" #-} constructGrammar _allNonterminals _elemsIparamsCollect _allConParams @@ -648,9 +648,9 @@ _allMacros {-# LINE 650 "dist/build/Transform.hs"#-} {-# INLINE rule1 #-} - {-# LINE 258 "./src-ag/Transform.ag" #-} + {-# LINE 258 "src-ag/Transform.ag" #-} rule1 = \ ((_elemsIcollectedFields) :: [(NontermIdent, ConstructorIdent, FieldMap)]) -> - {-# LINE 258 "./src-ag/Transform.ag" #-} + {-# 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 @@ -658,44 +658,44 @@ in foldr f Map.empty _elemsIcollectedFields {-# LINE 660 "dist/build/Transform.hs"#-} {-# INLINE rule2 #-} - {-# LINE 263 "./src-ag/Transform.ag" #-} + {-# LINE 263 "src-ag/Transform.ag" #-} rule2 = \ ((_elemsIcollectedFields) :: [(NontermIdent, ConstructorIdent, FieldMap)]) -> - {-# LINE 263 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 266 "src-ag/Transform.ag" #-} rule3 = \ ((_elemsIcollectedConstraints) :: [(NontermIdent, ConstructorIdent, [Type])]) -> - {-# LINE 266 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 269 "src-ag/Transform.ag" #-} rule4 = \ ((_elemsIcollectedConParams) :: [(NontermIdent, ConstructorIdent, Set Identifier)]) -> - {-# LINE 269 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 272 "src-ag/Transform.ag" #-} rule5 = \ ((_elemsIcollectedFields) :: [(NontermIdent, ConstructorIdent, FieldMap)]) -> - {-# LINE 272 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 275 "src-ag/Transform.ag" #-} rule6 = \ ((_elemsIcollectedRules) :: [ (NontermIdent, ConstructorIdent, RuleInfo)]) -> - {-# LINE 275 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 278 "src-ag/Transform.ag" #-} rule7 = \ _allAttrDecls ((_elemsIcollectedSigs) :: [ (NontermIdent, ConstructorIdent, SigInfo) ]) ((_elemsIcollectedUniques) :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) -> - {-# LINE 278 "./src-ag/Transform.ag" #-} + {-# LINE 278 "src-ag/Transform.ag" #-} let f (nt,con,t) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [t]) typeof nt r = Map.findWithDefault (Haskell "") r $ fst $ Map.findWithDefault (Map.empty,Map.empty) nt _allAttrDecls in foldr f (Map.empty) ( _elemsIcollectedSigs @@ -703,290 +703,290 @@ ) {-# LINE 705 "dist/build/Transform.hs"#-} {-# INLINE rule8 #-} - {-# LINE 284 "./src-ag/Transform.ag" #-} + {-# LINE 284 "src-ag/Transform.ag" #-} rule8 = \ ((_elemsIcollectedInsts) :: [ (NontermIdent, ConstructorIdent, [Identifier]) ]) -> - {-# LINE 284 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 287 "src-ag/Transform.ag" #-} rule9 = \ ((_elemsIcollectedUniques) :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) -> - {-# LINE 287 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 289 "src-ag/Transform.ag" #-} rule10 = \ ((_elemsIcollectedAugments) :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) -> - {-# LINE 289 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 291 "src-ag/Transform.ag" #-} rule11 = \ ((_elemsIcollectedArounds) :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) -> - {-# LINE 291 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 293 "src-ag/Transform.ag" #-} rule12 = \ ((_elemsIcollectedMerges) :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) -> - {-# LINE 293 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 296 "src-ag/Transform.ag" #-} rule13 = \ _allAugments -> - {-# LINE 296 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 299 "src-ag/Transform.ag" #-} rule14 = \ _allAttrDecls _allFields _allInsts _allMerges _allRules _allSigs -> - {-# LINE 299 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 300 "src-ag/Transform.ag" #-} rule15 = \ _allRules -> - {-# LINE 300 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 301 "src-ag/Transform.ag" #-} rule16 = \ _allSigs -> - {-# LINE 301 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 302 "src-ag/Transform.ag" #-} rule17 = \ _allFields _allInsts _allNonterminals _allSigs -> - {-# LINE 302 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 303 "src-ag/Transform.ag" #-} rule18 = \ _allAttrDecls _allUniques -> - {-# LINE 303 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 304 "src-ag/Transform.ag" #-} rule19 = \ _allAttrDecls _allAugments -> - {-# LINE 304 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 305 "src-ag/Transform.ag" #-} rule20 = \ _allArounds _allFields -> - {-# LINE 305 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 306 "src-ag/Transform.ag" #-} rule21 = \ _allFields _allInsts _allMerges _allNonterminals -> - {-# LINE 306 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 308 "src-ag/Transform.ag" #-} rule22 = \ _allRulesErrs -> - {-# LINE 308 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 309 "src-ag/Transform.ag" #-} rule23 = \ _allSigsErrs _augmentSigs -> - {-# LINE 309 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 310 "src-ag/Transform.ag" #-} rule24 = \ _allInstsErrs -> - {-# LINE 310 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 311 "src-ag/Transform.ag" #-} rule25 = \ _allUniquesErrs -> - {-# LINE 311 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 312 "src-ag/Transform.ag" #-} rule26 = \ _allAugmentErrs -> - {-# LINE 312 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 313 "src-ag/Transform.ag" #-} rule27 = \ _allAroundsErrs -> - {-# LINE 313 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 314 "src-ag/Transform.ag" #-} rule28 = \ _allAttrDecls _allFields _allRules _checkedInsts _checkedRulesPre _checkedUniques ((_lhsIoptions) :: Options) -> - {-# LINE 314 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 315 "src-ag/Transform.ag" #-} rule29 = \ _allMergesErrs -> - {-# LINE 315 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 317 "src-ag/Transform.ag" #-} rule30 = \ ((_elemsItypeSyns) :: TypeSyns) -> - {-# LINE 317 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 320 "src-ag/Transform.ag" #-} rule31 = \ _allFields -> - {-# LINE 320 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 324 "src-ag/Transform.ag" #-} rule32 = \ (_ :: ()) -> - {-# LINE 324 "./src-ag/Transform.ag" #-} + {-# LINE 324 "src-ag/Transform.ag" #-} let in Seq.empty {-# LINE 865 "dist/build/Transform.hs"#-} {-# INLINE rule33 #-} - {-# LINE 328 "./src-ag/Transform.ag" #-} + {-# LINE 328 "src-ag/Transform.ag" #-} rule33 = \ _allRulesErrs -> - {-# LINE 328 "./src-ag/Transform.ag" #-} + {-# LINE 328 "src-ag/Transform.ag" #-} let f m s = Map.fold ((><) . snd) s m in Map.fold f Seq.empty _allRulesErrs {-# LINE 872 "dist/build/Transform.hs"#-} {-# INLINE rule34 #-} - {-# LINE 331 "./src-ag/Transform.ag" #-} + {-# LINE 331 "src-ag/Transform.ag" #-} rule34 = \ _allSigsErrs -> - {-# LINE 331 "./src-ag/Transform.ag" #-} + {-# LINE 331 "src-ag/Transform.ag" #-} let f m s = Map.fold ((><) . snd) s m in Map.fold f Seq.empty _allSigsErrs {-# LINE 879 "dist/build/Transform.hs"#-} {-# INLINE rule35 #-} - {-# LINE 334 "./src-ag/Transform.ag" #-} + {-# LINE 334 "src-ag/Transform.ag" #-} rule35 = \ _allInstsErrs -> - {-# LINE 334 "./src-ag/Transform.ag" #-} + {-# LINE 334 "src-ag/Transform.ag" #-} let f m s = Map.fold ((><) . snd) s m in Map.fold f Seq.empty _allInstsErrs {-# LINE 886 "dist/build/Transform.hs"#-} {-# INLINE rule36 #-} - {-# LINE 337 "./src-ag/Transform.ag" #-} + {-# LINE 337 "src-ag/Transform.ag" #-} rule36 = \ _allUniquesErrs -> - {-# LINE 337 "./src-ag/Transform.ag" #-} + {-# LINE 337 "src-ag/Transform.ag" #-} let f m s = Map.fold ((><) . snd) s m in Map.fold f Seq.empty _allUniquesErrs {-# LINE 893 "dist/build/Transform.hs"#-} {-# INLINE rule37 #-} - {-# LINE 340 "./src-ag/Transform.ag" #-} + {-# LINE 340 "src-ag/Transform.ag" #-} rule37 = \ _allAugmentErrs -> - {-# LINE 340 "./src-ag/Transform.ag" #-} + {-# LINE 340 "src-ag/Transform.ag" #-} let f m s = Map.fold ((><) . snd) s m in Map.fold f Seq.empty _allAugmentErrs {-# LINE 900 "dist/build/Transform.hs"#-} {-# INLINE rule38 #-} - {-# LINE 343 "./src-ag/Transform.ag" #-} + {-# LINE 343 "src-ag/Transform.ag" #-} rule38 = \ _allAroundsErrs -> - {-# LINE 343 "./src-ag/Transform.ag" #-} + {-# LINE 343 "src-ag/Transform.ag" #-} let f m s = Map.fold ((><) . snd) s m in Map.fold f Seq.empty _allAroundsErrs {-# LINE 907 "dist/build/Transform.hs"#-} {-# INLINE rule39 #-} - {-# LINE 346 "./src-ag/Transform.ag" #-} + {-# LINE 346 "src-ag/Transform.ag" #-} rule39 = \ _allNamesErrs -> - {-# LINE 346 "./src-ag/Transform.ag" #-} + {-# LINE 346 "src-ag/Transform.ag" #-} let f m s = Map.fold ((><)) s m in Map.fold f Seq.empty _allNamesErrs {-# LINE 914 "dist/build/Transform.hs"#-} {-# INLINE rule40 #-} - {-# LINE 349 "./src-ag/Transform.ag" #-} + {-# LINE 349 "src-ag/Transform.ag" #-} rule40 = \ _allMergesErrs -> - {-# LINE 349 "./src-ag/Transform.ag" #-} + {-# LINE 349 "src-ag/Transform.ag" #-} let f m s = Map.fold ((><) . snd) s m in Map.fold f Seq.empty _allMergesErrs {-# LINE 921 "dist/build/Transform.hs"#-} {-# INLINE rule41 #-} - {-# LINE 352 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 606 "src-ag/Transform.ag" #-} rule42 = \ ((_elemsIcollectedNames) :: Set Identifier) ((_elemsIcollectedSetNames) :: Set Identifier) -> - {-# LINE 606 "./src-ag/Transform.ag" #-} + {-# LINE 606 "src-ag/Transform.ag" #-} _elemsIcollectedNames `Set.difference` _elemsIcollectedSetNames {-# LINE 933 "dist/build/Transform.hs"#-} {-# INLINE rule43 #-} - {-# LINE 626 "./src-ag/Transform.ag" #-} + {-# LINE 626 "src-ag/Transform.ag" #-} rule43 = \ ((_elemsIcollectedConstructorsMap) :: Map NontermIdent (Set ConstructorIdent)) -> - {-# LINE 626 "./src-ag/Transform.ag" #-} + {-# LINE 626 "src-ag/Transform.ag" #-} _elemsIcollectedConstructorsMap {-# LINE 939 "dist/build/Transform.hs"#-} {-# INLINE rule44 #-} - {-# LINE 709 "./src-ag/Transform.ag" #-} + {-# LINE 709 "src-ag/Transform.ag" #-} rule44 = \ _allNonterminals -> - {-# LINE 709 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 710 "src-ag/Transform.ag" #-} rule45 = \ ((_elemsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> - {-# LINE 710 "./src-ag/Transform.ag" #-} + {-# LINE 710 "src-ag/Transform.ag" #-} Map.map fst _elemsIdefSets {-# LINE 951 "dist/build/Transform.hs"#-} {-# INLINE rule46 #-} - {-# LINE 1030 "./src-ag/Transform.ag" #-} + {-# LINE 1030 "src-ag/Transform.ag" #-} rule46 = \ (_ :: ()) -> - {-# LINE 1030 "./src-ag/Transform.ag" #-} + {-# LINE 1030 "src-ag/Transform.ag" #-} Map.empty {-# LINE 957 "dist/build/Transform.hs"#-} {-# INLINE rule47 #-} - {-# LINE 1086 "./src-ag/Transform.ag" #-} + {-# LINE 1086 "src-ag/Transform.ag" #-} rule47 = \ _allNonterminals ((_elemsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) ((_lhsIoptions) :: Options) -> - {-# LINE 1086 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1328 "src-ag/Transform.ag" #-} rule48 = \ ((_elemsIcollectedMacros) :: [(NontermIdent, ConstructorIdent, MaybeMacro)]) -> - {-# LINE 1328 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1341 "src-ag/Transform.ag" #-} rule49 = \ _allAttrs _allFields _allNonterminals -> - {-# LINE 1341 "./src-ag/Transform.ag" #-} + {-# LINE 1341 "src-ag/Transform.ag" #-} (_allNonterminals ,_allFields ,_allAttrs ) {-# LINE 978 "dist/build/Transform.hs"#-} {-# INLINE rule50 #-} - {-# LINE 1343 "./src-ag/Transform.ag" #-} + {-# LINE 1343 "src-ag/Transform.ag" #-} rule50 = \ _allNonterminals ((_elemsIattrs) :: Map NontermIdent (Attributes, Attributes)) ((_lhsIoptions) :: Options) -> - {-# LINE 1343 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1351 "src-ag/Transform.ag" #-} rule51 = \ (_ :: ()) -> - {-# LINE 1351 "./src-ag/Transform.ag" #-} + {-# LINE 1351 "src-ag/Transform.ag" #-} Map.empty {-# LINE 992 "dist/build/Transform.hs"#-} {-# INLINE rule52 #-} @@ -1026,8 +1026,8 @@ wrap_Alt (T_Alt act) (Inh_Alt _lhsIallConstructors _lhsIallNonterminals _lhsInts) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Alt_vIn4 _lhsIallConstructors _lhsIallNonterminals _lhsInts - (T_Alt_vOut4 _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorNames _lhsOcollectedFields _lhsOcollectedMacros) <- return (inv_Alt_s5 sem arg) + 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) ) @@ -1073,36 +1073,36 @@ in __result_ ) in C_Alt_s5 v4 {-# INLINE rule61 #-} - {-# LINE 240 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 1319 "src-ag/Transform.ag" #-} [ (nt, con, macro_) | nt <- Set.toList _lhsInts , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) @@ -1124,8 +1124,8 @@ wrap_Alts (T_Alts act) (Inh_Alts _lhsIallConstructors _lhsIallNonterminals _lhsInts) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Alts_vIn7 _lhsIallConstructors _lhsIallNonterminals _lhsInts - (T_Alts_vOut7 _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorNames _lhsOcollectedFields _lhsOcollectedMacros) <- return (inv_Alts_s8 sem arg) + 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) ) @@ -1253,8 +1253,8 @@ wrap_Attrs (T_Attrs act) (Inh_Attrs _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsInts _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Attrs_vIn10 _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsInts _lhsIoptions - (T_Attrs_vOut10 _lhsOattrDecls _lhsOattrs _lhsOerrors _lhsOuseMap) <- return (inv_Attrs_s11 sem arg) + 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) ) @@ -1296,15 +1296,15 @@ in __result_ ) in C_Attrs_s11 v10 {-# INLINE rule83 #-} - {-# LINE 1039 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 1041 "src-ag/Transform.ag" #-} rule84 = \ ((_lhsIallNonterminals) :: Set NontermIdent) chn_ inh_ syn_ -> - {-# LINE 1041 "./src-ag/Transform.ag" #-} + {-# LINE 1041 "src-ag/Transform.ag" #-} let splitAttrs xs = unzip [ ((n,makeType _lhsIallNonterminals t),(n,ud)) | (n,t,ud) <- xs ] @@ -1315,15 +1315,15 @@ 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" #-} + {-# LINE 1049 "src-ag/Transform.ag" #-} rule85 = \ ((_lhsInts) :: Set NontermIdent) _useMap -> - {-# LINE 1049 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1051 "src-ag/Transform.ag" #-} rule86 = \ ((_lhsIoptions) :: Options) chn_ inh_ syn_ -> - {-# LINE 1051 "./src-ag/Transform.ag" #-} + {-# LINE 1051 "src-ag/Transform.ag" #-} if checkParseTy _lhsIoptions then let attrs = inh_ ++ syn_ ++ chn_ items = map (\(ident,tp,_) -> (getPos ident, tp)) attrs @@ -1338,15 +1338,15 @@ else Seq.empty {-# LINE 1340 "dist/build/Transform.hs"#-} {-# INLINE rule87 #-} - {-# LINE 1063 "./src-ag/Transform.ag" #-} + {-# LINE 1063 "src-ag/Transform.ag" #-} rule87 = \ _errors _errors1 -> - {-# LINE 1063 "./src-ag/Transform.ag" #-} + {-# LINE 1063 "src-ag/Transform.ag" #-} _errors Seq.>< _errors1 {-# LINE 1346 "dist/build/Transform.hs"#-} {-# INLINE rule88 #-} - {-# LINE 1355 "./src-ag/Transform.ag" #-} + {-# LINE 1355 "src-ag/Transform.ag" #-} rule88 = \ _inherited ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) ((_lhsInts) :: Set NontermIdent) _synthesized -> - {-# LINE 1355 "./src-ag/Transform.ag" #-} + {-# 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 @@ -1366,8 +1366,8 @@ wrap_ConstructorSet (T_ConstructorSet act) (Inh_ConstructorSet ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_ConstructorSet_vIn13 - (T_ConstructorSet_vOut13 _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors) <- return (inv_ConstructorSet_s14 sem arg) + let arg13 = T_ConstructorSet_vIn13 + (T_ConstructorSet_vOut13 _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors) <- return (inv_ConstructorSet_s14 sem arg13) return (Syn_ConstructorSet _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors) ) @@ -1407,15 +1407,15 @@ in __result_ ) in C_ConstructorSet_s14 v13 {-# INLINE rule90 #-} - {-# LINE 614 "./src-ag/Transform.ag" #-} + {-# LINE 614 "src-ag/Transform.ag" #-} rule90 = \ name_ -> - {-# LINE 614 "./src-ag/Transform.ag" #-} + {-# LINE 614 "src-ag/Transform.ag" #-} Set.singleton name_ {-# LINE 1415 "dist/build/Transform.hs"#-} {-# INLINE rule91 #-} - {-# LINE 777 "./src-ag/Transform.ag" #-} + {-# LINE 777 "src-ag/Transform.ag" #-} rule91 = \ name_ -> - {-# LINE 777 "./src-ag/Transform.ag" #-} + {-# LINE 777 "src-ag/Transform.ag" #-} \_ -> Set.singleton name_ {-# LINE 1421 "dist/build/Transform.hs"#-} {-# INLINE rule92 #-} @@ -1442,9 +1442,9 @@ in __result_ ) in C_ConstructorSet_s14 v13 {-# INLINE rule93 #-} - {-# LINE 778 "./src-ag/Transform.ag" #-} + {-# LINE 778 "src-ag/Transform.ag" #-} rule93 = \ ((_set1Iconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) ((_set2Iconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) -> - {-# LINE 778 "./src-ag/Transform.ag" #-} + {-# LINE 778 "src-ag/Transform.ag" #-} \ds -> _set1Iconstructors ds `Set.union` _set2Iconstructors ds {-# LINE 1450 "dist/build/Transform.hs"#-} {-# INLINE rule94 #-} @@ -1474,9 +1474,9 @@ in __result_ ) in C_ConstructorSet_s14 v13 {-# INLINE rule96 #-} - {-# LINE 779 "./src-ag/Transform.ag" #-} + {-# LINE 779 "src-ag/Transform.ag" #-} rule96 = \ ((_set1Iconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) ((_set2Iconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) -> - {-# LINE 779 "./src-ag/Transform.ag" #-} + {-# LINE 779 "src-ag/Transform.ag" #-} \ds -> _set1Iconstructors ds `Set.difference` _set2Iconstructors ds {-# LINE 1482 "dist/build/Transform.hs"#-} {-# INLINE rule97 #-} @@ -1502,9 +1502,9 @@ in __result_ ) in C_ConstructorSet_s14 v13 {-# INLINE rule99 #-} - {-# LINE 780 "./src-ag/Transform.ag" #-} + {-# LINE 780 "src-ag/Transform.ag" #-} rule99 = \ (_ :: ()) -> - {-# LINE 780 "./src-ag/Transform.ag" #-} + {-# LINE 780 "src-ag/Transform.ag" #-} \ds -> ds {-# LINE 1510 "dist/build/Transform.hs"#-} {-# INLINE rule100 #-} @@ -1523,8 +1523,8 @@ 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 arg = 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 arg) + 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) ) @@ -1645,46 +1645,46 @@ in __result_ ) in C_Elem_s17 v16 {-# INLINE rule102 #-} - {-# LINE 176 "./src-ag/Transform.ag" #-} + {-# LINE 176 "src-ag/Transform.ag" #-} rule102 = \ ((_namesInontSet) :: Set NontermIdent) -> - {-# LINE 176 "./src-ag/Transform.ag" #-} + {-# LINE 176 "src-ag/Transform.ag" #-} _namesInontSet {-# LINE 1653 "dist/build/Transform.hs"#-} {-# INLINE rule103 #-} - {-# LINE 620 "./src-ag/Transform.ag" #-} + {-# LINE 620 "src-ag/Transform.ag" #-} rule103 = \ ((_altsIcollectedConstructorNames) :: Set ConstructorIdent) ((_namesInontSet) :: Set NontermIdent) -> - {-# LINE 620 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 948 "src-ag/Transform.ag" #-} rule104 = \ ((_namesInontSet) :: Set NontermIdent) params_ -> - {-# LINE 948 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 971 "src-ag/Transform.ag" #-} rule105 = \ ((_namesInontSet) :: Set NontermIdent) ctx_ -> - {-# LINE 971 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1033 "src-ag/Transform.ag" #-} rule106 = \ ((_namesInontSet) :: Set NontermIdent) -> - {-# LINE 1033 "./src-ag/Transform.ag" #-} + {-# LINE 1033 "src-ag/Transform.ag" #-} _namesInontSet {-# LINE 1684 "dist/build/Transform.hs"#-} {-# INLINE rule107 #-} - {-# LINE 1371 "./src-ag/Transform.ag" #-} + {-# LINE 1371 "src-ag/Transform.ag" #-} rule107 = \ ((_namesIcollectedNames) :: Set Identifier) contype_ -> - {-# LINE 1371 "./src-ag/Transform.ag" #-} + {-# 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 #-} @@ -1873,21 +1873,21 @@ in __result_ ) in C_Elem_s17 v16 {-# INLINE rule145 #-} - {-# LINE 254 "./src-ag/Transform.ag" #-} + {-# LINE 254 "src-ag/Transform.ag" #-} rule145 = \ _expanded name_ -> - {-# LINE 254 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 600 "src-ag/Transform.ag" #-} rule146 = \ name_ -> - {-# LINE 600 "./src-ag/Transform.ag" #-} + {-# LINE 600 "src-ag/Transform.ag" #-} Set.singleton name_ {-# LINE 1887 "dist/build/Transform.hs"#-} {-# INLINE rule147 #-} - {-# LINE 654 "./src-ag/Transform.ag" #-} + {-# LINE 654 "src-ag/Transform.ag" #-} rule147 = \ _argType name_ params_ pos_ -> - {-# LINE 654 "./src-ag/Transform.ag" #-} + {-# 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) @@ -1927,9 +1927,9 @@ Tuple xs -> [(Ident "Tuple" pos_, xs)] {-# LINE 1929 "dist/build/Transform.hs"#-} {-# INLINE rule148 #-} - {-# LINE 691 "./src-ag/Transform.ag" #-} + {-# LINE 691 "src-ag/Transform.ag" #-} rule148 = \ ((_lhsIallNonterminals) :: Set NontermIdent) type_ -> - {-# LINE 691 "./src-ag/Transform.ag" #-} + {-# 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) @@ -1941,23 +1941,23 @@ IntSet -> IntSet {-# LINE 1943 "dist/build/Transform.hs"#-} {-# INLINE rule149 #-} - {-# LINE 700 "./src-ag/Transform.ag" #-} + {-# LINE 700 "src-ag/Transform.ag" #-} rule149 = \ _argType name_ -> - {-# LINE 700 "./src-ag/Transform.ag" #-} + {-# LINE 700 "src-ag/Transform.ag" #-} [(name_,_argType)] {-# LINE 1949 "dist/build/Transform.hs"#-} {-# INLINE rule150 #-} - {-# LINE 954 "./src-ag/Transform.ag" #-} + {-# LINE 954 "src-ag/Transform.ag" #-} rule150 = \ name_ params_ -> - {-# LINE 954 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 977 "src-ag/Transform.ag" #-} rule151 = \ ctx_ name_ -> - {-# LINE 977 "./src-ag/Transform.ag" #-} + {-# LINE 977 "src-ag/Transform.ag" #-} if null ctx_ then Map.empty else Map.singleton name_ ctx_ @@ -2126,25 +2126,25 @@ in __result_ ) in C_Elem_s17 v16 {-# INLINE rule178 #-} - {-# LINE 971 "./src-ag/Transform.ag" #-} + {-# LINE 971 "src-ag/Transform.ag" #-} rule178 = \ ((_namesInontSet) :: Set NontermIdent) ctx_ -> - {-# LINE 971 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 996 "src-ag/Transform.ag" #-} rule179 = \ ((_namesInontSet) :: Set NontermIdent) quants_ -> - {-# LINE 996 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1034 "src-ag/Transform.ag" #-} rule180 = \ ((_namesInontSet) :: Set NontermIdent) -> - {-# LINE 1034 "./src-ag/Transform.ag" #-} + {-# LINE 1034 "src-ag/Transform.ag" #-} _namesInontSet {-# LINE 2150 "dist/build/Transform.hs"#-} {-# INLINE rule181 #-} @@ -2351,31 +2351,31 @@ in __result_ ) in C_Elem_s17 v16 {-# INLINE rule218 #-} - {-# LINE 177 "./src-ag/Transform.ag" #-} + {-# LINE 177 "src-ag/Transform.ag" #-} rule218 = \ ((_namesInontSet) :: Set NontermIdent) -> - {-# LINE 177 "./src-ag/Transform.ag" #-} + {-# LINE 177 "src-ag/Transform.ag" #-} _namesInontSet {-# LINE 2359 "dist/build/Transform.hs"#-} {-# INLINE rule219 #-} - {-# LINE 971 "./src-ag/Transform.ag" #-} + {-# LINE 971 "src-ag/Transform.ag" #-} rule219 = \ ((_namesInontSet) :: Set NontermIdent) ctx_ -> - {-# LINE 971 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 996 "src-ag/Transform.ag" #-} rule220 = \ ((_namesInontSet) :: Set NontermIdent) quants_ -> - {-# LINE 996 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1035 "src-ag/Transform.ag" #-} rule221 = \ ((_namesInontSet) :: Set NontermIdent) -> - {-# LINE 1035 "./src-ag/Transform.ag" #-} + {-# LINE 1035 "src-ag/Transform.ag" #-} _namesInontSet {-# LINE 2381 "dist/build/Transform.hs"#-} {-# INLINE rule222 #-} @@ -2576,29 +2576,29 @@ in __result_ ) in C_Elem_s17 v16 {-# INLINE rule263 #-} - {-# LINE 186 "./src-ag/Transform.ag" #-} + {-# LINE 186 "src-ag/Transform.ag" #-} rule263 = \ kind_ mbNt_ -> - {-# LINE 186 "./src-ag/Transform.ag" #-} + {-# LINE 186 "src-ag/Transform.ag" #-} ( kind_ , mbNt_ ) {-# LINE 2586 "dist/build/Transform.hs"#-} {-# INLINE rule264 #-} - {-# LINE 189 "./src-ag/Transform.ag" #-} + {-# LINE 189 "src-ag/Transform.ag" #-} rule264 = \ lines_ pos_ -> - {-# LINE 189 "./src-ag/Transform.ag" #-} + {-# LINE 189 "src-ag/Transform.ag" #-} [(lines_, pos_)] {-# LINE 2592 "dist/build/Transform.hs"#-} {-# INLINE rule265 #-} - {-# LINE 190 "./src-ag/Transform.ag" #-} + {-# LINE 190 "src-ag/Transform.ag" #-} rule265 = \ _blockInfo _blockValue -> - {-# LINE 190 "./src-ag/Transform.ag" #-} + {-# LINE 190 "src-ag/Transform.ag" #-} Map.singleton _blockInfo _blockValue {-# LINE 2598 "dist/build/Transform.hs"#-} {-# INLINE rule266 #-} - {-# LINE 191 "./src-ag/Transform.ag" #-} + {-# LINE 191 "src-ag/Transform.ag" #-} rule266 = \ ((_lhsIoptions) :: Options) lines_ pos_ -> - {-# LINE 191 "./src-ag/Transform.ag" #-} + {-# LINE 191 "src-ag/Transform.ag" #-} if checkParseBlock _lhsIoptions then let ex = Expression pos_ tks tks = [tk] @@ -2772,15 +2772,15 @@ in __result_ ) in C_Elem_s17 v16 {-# INLINE rule296 #-} - {-# LINE 597 "./src-ag/Transform.ag" #-} + {-# LINE 597 "src-ag/Transform.ag" #-} rule296 = \ name_ -> - {-# LINE 597 "./src-ag/Transform.ag" #-} + {-# LINE 597 "src-ag/Transform.ag" #-} Set.singleton name_ {-# LINE 2780 "dist/build/Transform.hs"#-} {-# INLINE rule297 #-} - {-# LINE 714 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 714 "src-ag/Transform.ag" #-} let allUsedNames = Set.unions [ maybe (Set.singleton n) snd (Map.lookup n _lhsIdefSets) @@ -2797,15 +2797,15 @@ in (res, e1 Seq.>< e2) {-# LINE 2799 "dist/build/Transform.hs"#-} {-# INLINE rule298 #-} - {-# LINE 728 "./src-ag/Transform.ag" #-} + {-# LINE 728 "src-ag/Transform.ag" #-} rule298 = \ _defSets2 -> - {-# LINE 728 "./src-ag/Transform.ag" #-} + {-# LINE 728 "src-ag/Transform.ag" #-} _defSets2 {-# LINE 2805 "dist/build/Transform.hs"#-} {-# INLINE rule299 #-} - {-# LINE 729 "./src-ag/Transform.ag" #-} + {-# LINE 729 "src-ag/Transform.ag" #-} rule299 = \ _errs ((_setIerrors) :: Seq Error) -> - {-# LINE 729 "./src-ag/Transform.ag" #-} + {-# LINE 729 "src-ag/Transform.ag" #-} _errs >< _setIerrors {-# LINE 2811 "dist/build/Transform.hs"#-} {-# INLINE rule300 #-} @@ -2979,9 +2979,9 @@ in __result_ ) in C_Elem_s17 v16 {-# INLINE rule331 #-} - {-# LINE 1017 "./src-ag/Transform.ag" #-} + {-# LINE 1017 "src-ag/Transform.ag" #-} rule331 = \ ((_setInontSet) :: Set NontermIdent) classes_ -> - {-# LINE 1017 "./src-ag/Transform.ag" #-} + {-# LINE 1017 "src-ag/Transform.ag" #-} Map.fromList [(nt,Set.fromList classes_) | nt <- Set.toList _setInontSet] {-# LINE 2987 "dist/build/Transform.hs"#-} {-# INLINE rule332 #-} @@ -3161,9 +3161,9 @@ in __result_ ) in C_Elem_s17 v16 {-# INLINE rule365 #-} - {-# LINE 789 "./src-ag/Transform.ag" #-} + {-# LINE 789 "src-ag/Transform.ag" #-} rule365 = \ ((_setInontSet) :: Set NontermIdent) -> - {-# LINE 789 "./src-ag/Transform.ag" #-} + {-# LINE 789 "src-ag/Transform.ag" #-} _setInontSet {-# LINE 3169 "dist/build/Transform.hs"#-} {-# INLINE rule366 #-} @@ -3343,9 +3343,9 @@ in __result_ ) in C_Elem_s17 v16 {-# INLINE rule399 #-} - {-# LINE 796 "./src-ag/Transform.ag" #-} + {-# LINE 796 "src-ag/Transform.ag" #-} rule399 = \ ((_setInontSet) :: Set NontermIdent) -> - {-# LINE 796 "./src-ag/Transform.ag" #-} + {-# LINE 796 "src-ag/Transform.ag" #-} \o -> o { nocatas = _setInontSet `Set.union` nocatas o } {-# LINE 3351 "dist/build/Transform.hs"#-} {-# INLINE rule400 #-} @@ -3520,9 +3520,9 @@ in __result_ ) in C_Elem_s17 v16 {-# INLINE rule433 #-} - {-# LINE 805 "./src-ag/Transform.ag" #-} + {-# LINE 805 "src-ag/Transform.ag" #-} rule433 = \ names_ -> - {-# LINE 805 "./src-ag/Transform.ag" #-} + {-# LINE 805 "src-ag/Transform.ag" #-} let mk n o = case getName n of "gencatas" -> o { folds = True } "nogencatas" -> o { folds = False } @@ -3533,7 +3533,7 @@ "nogensems" -> o { semfuns = False } "gentypesigs" -> o { typeSigs = True } "nogentypesigs"-> o { typeSigs = False } - "nocycle" -> o { withCycle = False } + "nocycle" -> o { withCycle = False, loag = False } "cycle" -> o { withCycle = True } "nostrictdata" -> o { strictData = False } "strictdata" -> o { strictData = True } @@ -3542,7 +3542,7 @@ "strictercase" -> o { strictCases = True, stricterCases = True } "nostrictwrap" -> o { strictWrap = False } "strictwrap" -> o { strictWrap = True } - "novisit" -> o { visit = False } + "novisit" -> o { visit = False, loag = False } "visit" -> o { visit = True } "nocase" -> o { cases = False } "case" -> o { cases = True } @@ -3753,9 +3753,9 @@ in __result_ ) in C_Elem_s17 v16 {-# INLINE rule464 #-} - {-# LINE 1214 "./src-ag/Transform.ag" #-} + {-# LINE 1214 "src-ag/Transform.ag" #-} rule464 = \ exports_ imports_ name_ -> - {-# LINE 1214 "./src-ag/Transform.ag" #-} + {-# LINE 1214 "src-ag/Transform.ag" #-} Just (name_, exports_, imports_) {-# LINE 3761 "dist/build/Transform.hs"#-} {-# INLINE rule465 #-} @@ -3858,8 +3858,8 @@ 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 arg = 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 arg) + 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) ) @@ -4303,8 +4303,8 @@ wrap_Field (T_Field act) (Inh_Field _lhsIallNonterminals) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Field_vIn22 _lhsIallNonterminals - (T_Field_vOut22 _lhsOcollectedConstraints _lhsOcollectedFields) <- return (inv_Field_s23 sem arg) + let arg22 = T_Field_vIn22 _lhsIallNonterminals + (T_Field_vOut22 _lhsOcollectedConstraints _lhsOcollectedFields) <- return (inv_Field_s23 sem arg22) return (Syn_Field _lhsOcollectedConstraints _lhsOcollectedFields) ) @@ -4340,9 +4340,9 @@ in __result_ ) in C_Field_s23 v22 {-# INLINE rule577 #-} - {-# LINE 579 "./src-ag/Transform.ag" #-} + {-# LINE 579 "src-ag/Transform.ag" #-} rule577 = \ ((_lhsIallNonterminals) :: Set NontermIdent) name_ tp_ -> - {-# LINE 579 "./src-ag/Transform.ag" #-} + {-# LINE 579 "src-ag/Transform.ag" #-} [(name_, makeType _lhsIallNonterminals tp_)] {-# LINE 4348 "dist/build/Transform.hs"#-} {-# INLINE rule578 #-} @@ -4363,9 +4363,9 @@ in __result_ ) in C_Field_s23 v22 {-# INLINE rule579 #-} - {-# LINE 588 "./src-ag/Transform.ag" #-} + {-# LINE 588 "src-ag/Transform.ag" #-} rule579 = \ tps_ -> - {-# LINE 588 "./src-ag/Transform.ag" #-} + {-# LINE 588 "src-ag/Transform.ag" #-} tps_ {-# LINE 4371 "dist/build/Transform.hs"#-} {-# INLINE rule580 #-} @@ -4381,8 +4381,8 @@ wrap_Fields (T_Fields act) (Inh_Fields _lhsIallNonterminals) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Fields_vIn25 _lhsIallNonterminals - (T_Fields_vOut25 _lhsOcollectedConstraints _lhsOcollectedFields) <- return (inv_Fields_s26 sem arg) + let arg25 = T_Fields_vIn25 _lhsIallNonterminals + (T_Fields_vOut25 _lhsOcollectedConstraints _lhsOcollectedFields) <- return (inv_Fields_s26 sem arg25) return (Syn_Fields _lhsOcollectedConstraints _lhsOcollectedFields) ) @@ -4464,8 +4464,8 @@ wrap_NontSet (T_NontSet act) (Inh_NontSet _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_NontSet_vIn28 _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets - (T_NontSet_vOut28 _lhsOcollectedNames _lhsOerrors _lhsOnontSet) <- return (inv_NontSet_s29 sem arg) + 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) ) @@ -4508,15 +4508,15 @@ in __result_ ) in C_NontSet_s29 v28 {-# INLINE rule587 #-} - {-# LINE 603 "./src-ag/Transform.ag" #-} + {-# LINE 603 "src-ag/Transform.ag" #-} rule587 = \ name_ -> - {-# LINE 603 "./src-ag/Transform.ag" #-} + {-# LINE 603 "src-ag/Transform.ag" #-} Set.singleton name_ {-# LINE 4516 "dist/build/Transform.hs"#-} {-# INLINE rule588 #-} - {-# LINE 733 "./src-ag/Transform.ag" #-} + {-# LINE 733 "src-ag/Transform.ag" #-} rule588 = \ ((_lhsIdefinedSets) :: DefinedSets) name_ -> - {-# LINE 733 "./src-ag/Transform.ag" #-} + {-# LINE 733 "src-ag/Transform.ag" #-} case Map.lookup name_ _lhsIdefinedSets of Nothing -> (Set.empty, Seq.singleton (UndefNont name_)) Just set -> (set, Seq.empty) @@ -4544,9 +4544,9 @@ in __result_ ) in C_NontSet_s29 v28 {-# INLINE rule591 #-} - {-# LINE 732 "./src-ag/Transform.ag" #-} + {-# LINE 732 "src-ag/Transform.ag" #-} rule591 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> - {-# LINE 732 "./src-ag/Transform.ag" #-} + {-# LINE 732 "src-ag/Transform.ag" #-} _lhsIallNonterminals {-# LINE 4552 "dist/build/Transform.hs"#-} {-# INLINE rule592 #-} @@ -4582,9 +4582,9 @@ in __result_ ) in C_NontSet_s29 v28 {-# INLINE rule594 #-} - {-# LINE 736 "./src-ag/Transform.ag" #-} + {-# LINE 736 "src-ag/Transform.ag" #-} rule594 = \ ((_set1InontSet) :: Set NontermIdent) ((_set2InontSet) :: Set NontermIdent) -> - {-# LINE 736 "./src-ag/Transform.ag" #-} + {-# LINE 736 "src-ag/Transform.ag" #-} Set.union _set1InontSet _set2InontSet {-# LINE 4590 "dist/build/Transform.hs"#-} {-# INLINE rule595 #-} @@ -4638,9 +4638,9 @@ in __result_ ) in C_NontSet_s29 v28 {-# INLINE rule603 #-} - {-# LINE 737 "./src-ag/Transform.ag" #-} + {-# LINE 737 "src-ag/Transform.ag" #-} rule603 = \ ((_set1InontSet) :: Set NontermIdent) ((_set2InontSet) :: Set NontermIdent) -> - {-# LINE 737 "./src-ag/Transform.ag" #-} + {-# LINE 737 "src-ag/Transform.ag" #-} Set.intersection _set1InontSet _set2InontSet {-# LINE 4646 "dist/build/Transform.hs"#-} {-# INLINE rule604 #-} @@ -4694,9 +4694,9 @@ in __result_ ) in C_NontSet_s29 v28 {-# INLINE rule612 #-} - {-# LINE 738 "./src-ag/Transform.ag" #-} + {-# LINE 738 "src-ag/Transform.ag" #-} rule612 = \ ((_set1InontSet) :: Set NontermIdent) ((_set2InontSet) :: Set NontermIdent) -> - {-# LINE 738 "./src-ag/Transform.ag" #-} + {-# LINE 738 "src-ag/Transform.ag" #-} Set.difference _set1InontSet _set2InontSet {-# LINE 4702 "dist/build/Transform.hs"#-} {-# INLINE rule613 #-} @@ -4740,16 +4740,16 @@ in __result_ ) in C_NontSet_s29 v28 {-# INLINE rule621 #-} - {-# LINE 739 "./src-ag/Transform.ag" #-} + {-# LINE 739 "src-ag/Transform.ag" #-} rule621 = \ ((_lhsIallFields) :: DataTypes) from_ to_ -> - {-# LINE 739 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 741 "src-ag/Transform.ag" #-} rule622 = \ ((_lhsIallNonterminals) :: Set NontermIdent) from_ to_ -> - {-# LINE 741 "./src-ag/Transform.ag" #-} + {-# LINE 741 "src-ag/Transform.ag" #-} let check name | Set.member name _lhsIallNonterminals = Seq.empty | otherwise = Seq.singleton (UndefNont name) @@ -4768,8 +4768,8 @@ wrap_Pattern (T_Pattern act) (Inh_Pattern ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Pattern_vIn31 - (T_Pattern_vOut31 _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder _lhsOstpos) <- return (inv_Pattern_s32 sem arg) + 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) ) @@ -4817,15 +4817,15 @@ in __result_ ) in C_Pattern_s32 v31 {-# INLINE rule624 #-} - {-# LINE 1190 "./src-ag/Transform.ag" #-} + {-# LINE 1190 "src-ag/Transform.ag" #-} rule624 = \ ((_patsIpatunder) :: [AttrName]->Patterns) name_ -> - {-# LINE 1190 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1201 "src-ag/Transform.ag" #-} rule625 = \ name_ -> - {-# LINE 1201 "./src-ag/Transform.ag" #-} + {-# LINE 1201 "src-ag/Transform.ag" #-} getPos name_ {-# LINE 4831 "dist/build/Transform.hs"#-} {-# INLINE rule626 #-} @@ -4864,15 +4864,15 @@ in __result_ ) in C_Pattern_s32 v31 {-# INLINE rule630 #-} - {-# LINE 1191 "./src-ag/Transform.ag" #-} + {-# LINE 1191 "src-ag/Transform.ag" #-} rule630 = \ ((_patsIpatunder) :: [AttrName]->Patterns) pos_ -> - {-# LINE 1191 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1202 "src-ag/Transform.ag" #-} rule631 = \ pos_ -> - {-# LINE 1202 "./src-ag/Transform.ag" #-} + {-# LINE 1202 "src-ag/Transform.ag" #-} pos_ {-# LINE 4878 "dist/build/Transform.hs"#-} {-# INLINE rule632 #-} @@ -4911,27 +4911,27 @@ in __result_ ) in C_Pattern_s32 v31 {-# INLINE rule636 #-} - {-# LINE 1186 "./src-ag/Transform.ag" #-} + {-# LINE 1186 "src-ag/Transform.ag" #-} rule636 = \ ((_patIdefinedAttrs) :: [AttrName]) attr_ field_ -> - {-# LINE 1186 "./src-ag/Transform.ag" #-} + {-# LINE 1186 "src-ag/Transform.ag" #-} (field_, attr_) : _patIdefinedAttrs {-# LINE 4919 "dist/build/Transform.hs"#-} {-# INLINE rule637 #-} - {-# LINE 1187 "./src-ag/Transform.ag" #-} + {-# LINE 1187 "src-ag/Transform.ag" #-} rule637 = \ _copy attr_ field_ -> - {-# LINE 1187 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1188 "src-ag/Transform.ag" #-} rule638 = \ ((_patIdefinedInsts) :: [Identifier]) attr_ field_ -> - {-# LINE 1188 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1203 "src-ag/Transform.ag" #-} rule639 = \ field_ -> - {-# LINE 1203 "./src-ag/Transform.ag" #-} + {-# LINE 1203 "src-ag/Transform.ag" #-} getPos field_ {-# LINE 4937 "dist/build/Transform.hs"#-} {-# INLINE rule640 #-} @@ -4964,9 +4964,9 @@ in __result_ ) in C_Pattern_s32 v31 {-# INLINE rule642 #-} - {-# LINE 1192 "./src-ag/Transform.ag" #-} + {-# LINE 1192 "src-ag/Transform.ag" #-} rule642 = \ ((_patIpatunder) :: [AttrName]->Pattern) -> - {-# LINE 1192 "./src-ag/Transform.ag" #-} + {-# LINE 1192 "src-ag/Transform.ag" #-} \us -> Irrefutable (_patIpatunder us) {-# LINE 4972 "dist/build/Transform.hs"#-} {-# INLINE rule643 #-} @@ -5006,15 +5006,15 @@ in __result_ ) in C_Pattern_s32 v31 {-# INLINE rule648 #-} - {-# LINE 1189 "./src-ag/Transform.ag" #-} + {-# LINE 1189 "src-ag/Transform.ag" #-} rule648 = \ _copy -> - {-# LINE 1189 "./src-ag/Transform.ag" #-} + {-# LINE 1189 "src-ag/Transform.ag" #-} \_ -> _copy {-# LINE 5014 "dist/build/Transform.hs"#-} {-# INLINE rule649 #-} - {-# LINE 1204 "./src-ag/Transform.ag" #-} + {-# LINE 1204 "src-ag/Transform.ag" #-} rule649 = \ pos_ -> - {-# LINE 1204 "./src-ag/Transform.ag" #-} + {-# LINE 1204 "src-ag/Transform.ag" #-} pos_ {-# LINE 5020 "dist/build/Transform.hs"#-} {-# INLINE rule650 #-} @@ -5039,8 +5039,8 @@ wrap_Patterns (T_Patterns act) (Inh_Patterns ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Patterns_vIn34 - (T_Patterns_vOut34 _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder) <- return (inv_Patterns_s35 sem arg) + 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) ) @@ -5084,9 +5084,9 @@ in __result_ ) in C_Patterns_s35 v34 {-# INLINE rule654 #-} - {-# LINE 1196 "./src-ag/Transform.ag" #-} + {-# LINE 1196 "src-ag/Transform.ag" #-} rule654 = \ ((_hdIpatunder) :: [AttrName]->Pattern) ((_tlIpatunder) :: [AttrName]->Patterns) -> - {-# LINE 1196 "./src-ag/Transform.ag" #-} + {-# LINE 1196 "src-ag/Transform.ag" #-} \us -> (_hdIpatunder us) : (_tlIpatunder us) {-# LINE 5092 "dist/build/Transform.hs"#-} {-# INLINE rule655 #-} @@ -5121,9 +5121,9 @@ in __result_ ) in C_Patterns_s35 v34 {-# INLINE rule659 #-} - {-# LINE 1195 "./src-ag/Transform.ag" #-} + {-# LINE 1195 "src-ag/Transform.ag" #-} rule659 = \ (_ :: ()) -> - {-# LINE 1195 "./src-ag/Transform.ag" #-} + {-# LINE 1195 "src-ag/Transform.ag" #-} \_ -> [] {-# LINE 5129 "dist/build/Transform.hs"#-} {-# INLINE rule660 #-} @@ -5148,8 +5148,8 @@ wrap_SemAlt (T_SemAlt act) (Inh_SemAlt _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = 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 arg) + 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) ) @@ -5208,39 +5208,39 @@ in __result_ ) in C_SemAlt_s38 v37 {-# INLINE rule664 #-} - {-# LINE 888 "./src-ag/Transform.ag" #-} + {-# LINE 888 "src-ag/Transform.ag" #-} rule664 = \ ((_rulesIpragmaNamesCollect) :: [Identifier]) -> - {-# LINE 888 "./src-ag/Transform.ag" #-} + {-# LINE 888 "src-ag/Transform.ag" #-} Set.fromList _rulesIpragmaNamesCollect {-# LINE 5216 "dist/build/Transform.hs"#-} {-# INLINE rule665 #-} - {-# LINE 889 "./src-ag/Transform.ag" #-} + {-# LINE 889 "src-ag/Transform.ag" #-} rule665 = \ _coninfo _pragmaNames -> - {-# LINE 889 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 918 "src-ag/Transform.ag" #-} rule666 = \ _coninfo ((_rulesIorderDepsCollect) :: Set Dependency) -> - {-# LINE 918 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 923 "src-ag/Transform.ag" #-} rule667 = \ _attrOrders -> - {-# LINE 923 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1105 "src-ag/Transform.ag" #-} rule668 = \ ((_constructorSetIconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) ((_lhsIallFields) :: DataTypes) ((_lhsInts) :: Set NontermIdent) -> - {-# LINE 1105 "./src-ag/Transform.ag" #-} + {-# LINE 1105 "src-ag/Transform.ag" #-} [ (nt, conset, conkeys) | nt <- Set.toList _lhsInts , let conmap = Map.findWithDefault Map.empty nt _lhsIallFields @@ -5249,9 +5249,9 @@ ] {-# LINE 5251 "dist/build/Transform.hs"#-} {-# INLINE rule669 #-} - {-# LINE 1112 "./src-ag/Transform.ag" #-} + {-# LINE 1112 "src-ag/Transform.ag" #-} rule669 = \ _coninfo ((_rulesIerrors) :: Seq Error) -> - {-# LINE 1112 "./src-ag/Transform.ag" #-} + {-# LINE 1112 "src-ag/Transform.ag" #-} Seq.fromList [ UndefAlt nt con | (nt, conset, conkeys) <- _coninfo @@ -5260,9 +5260,9 @@ Seq.>< _rulesIerrors {-# LINE 5262 "dist/build/Transform.hs"#-} {-# INLINE rule670 #-} - {-# LINE 1119 "./src-ag/Transform.ag" #-} + {-# LINE 1119 "src-ag/Transform.ag" #-} rule670 = \ _coninfo ((_rulesIruleInfos) :: [RuleInfo]) -> - {-# LINE 1119 "./src-ag/Transform.ag" #-} + {-# LINE 1119 "src-ag/Transform.ag" #-} [ (nt,con,r) | (nt, conset, _) <- _coninfo , con <- Set.toList conset @@ -5270,9 +5270,9 @@ ] {-# LINE 5272 "dist/build/Transform.hs"#-} {-# INLINE rule671 #-} - {-# LINE 1125 "./src-ag/Transform.ag" #-} + {-# LINE 1125 "src-ag/Transform.ag" #-} rule671 = \ _coninfo ((_rulesIsigInfos) :: [SigInfo]) -> - {-# LINE 1125 "./src-ag/Transform.ag" #-} + {-# LINE 1125 "src-ag/Transform.ag" #-} [ (nt,con,ts) | (nt, conset, _) <- _coninfo , con <- Set.toList conset @@ -5280,45 +5280,45 @@ ] {-# LINE 5282 "dist/build/Transform.hs"#-} {-# INLINE rule672 #-} - {-# LINE 1132 "./src-ag/Transform.ag" #-} + {-# LINE 1132 "src-ag/Transform.ag" #-} rule672 = \ _coninfo ((_rulesIdefinedInsts) :: [Identifier]) -> - {-# LINE 1132 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1138 "src-ag/Transform.ag" #-} rule673 = \ _coninfo ((_rulesIuniqueInfos) :: [UniqueInfo]) -> - {-# LINE 1138 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1144 "src-ag/Transform.ag" #-} rule674 = \ _coninfo ((_rulesIaugmentInfos) :: [AugmentInfo]) -> - {-# LINE 1144 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1150 "src-ag/Transform.ag" #-} rule675 = \ _coninfo ((_rulesIaroundInfos) :: [AroundInfo]) -> - {-# LINE 1150 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1156 "src-ag/Transform.ag" #-} rule676 = \ _coninfo ((_rulesImergeInfos) :: [MergeInfo]) -> - {-# LINE 1156 "./src-ag/Transform.ag" #-} + {-# LINE 1156 "src-ag/Transform.ag" #-} [ (nt, con, _rulesImergeInfos) | (nt, conset, _) <- _coninfo , con <- Set.toList conset @@ -5337,8 +5337,8 @@ wrap_SemAlts (T_SemAlts act) (Inh_SemAlts _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = 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 arg) + 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) ) @@ -5532,8 +5532,8 @@ wrap_SemDef (T_SemDef act) (Inh_SemDef _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_SemDef_vIn43 _lhsIoptions - (T_SemDef_vOut43 _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos) <- return (inv_SemDef_s44 sem arg) + 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) ) @@ -5593,17 +5593,17 @@ in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule708 #-} - {-# LINE 556 "./src-ag/Transform.ag" #-} + {-# LINE 556 "src-ag/Transform.ag" #-} rule708 = \ ((_lhsIoptions) :: Options) rhs_ -> - {-# LINE 556 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# 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" #-} + {-# LINE 1162 "src-ag/Transform.ag" #-} [ (mbName_, _patternIpatunder, rhs_, _patternIdefinedAttrs, owrt_, show _patternIstpos, pure_, eager_) ] {-# LINE 5609 "dist/build/Transform.hs"#-} {-# INLINE rule710 #-} @@ -5661,9 +5661,9 @@ in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule718 #-} - {-# LINE 563 "./src-ag/Transform.ag" #-} + {-# LINE 563 "src-ag/Transform.ag" #-} rule718 = \ ((_lhsIoptions) :: Options) pos_ tp_ -> - {-# LINE 563 "./src-ag/Transform.ag" #-} + {-# LINE 563 "src-ag/Transform.ag" #-} if checkParseTy _lhsIoptions then case tp_ of Haskell s -> let ex = Expression pos_ tks @@ -5674,9 +5674,9 @@ else Seq.empty {-# LINE 5676 "dist/build/Transform.hs"#-} {-# INLINE rule719 #-} - {-# LINE 1165 "./src-ag/Transform.ag" #-} + {-# LINE 1165 "src-ag/Transform.ag" #-} rule719 = \ ident_ tp_ -> - {-# LINE 1165 "./src-ag/Transform.ag" #-} + {-# LINE 1165 "src-ag/Transform.ag" #-} [ (ident_, tp_) ] {-# LINE 5682 "dist/build/Transform.hs"#-} {-# INLINE rule720 #-} @@ -5734,9 +5734,9 @@ in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule728 #-} - {-# LINE 1168 "./src-ag/Transform.ag" #-} + {-# LINE 1168 "src-ag/Transform.ag" #-} rule728 = \ ident_ ref_ -> - {-# LINE 1168 "./src-ag/Transform.ag" #-} + {-# LINE 1168 "src-ag/Transform.ag" #-} [ (ident_, ref_) ] {-# LINE 5742 "dist/build/Transform.hs"#-} {-# INLINE rule729 #-} @@ -5797,9 +5797,9 @@ in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule738 #-} - {-# LINE 1171 "./src-ag/Transform.ag" #-} + {-# LINE 1171 "src-ag/Transform.ag" #-} rule738 = \ ident_ rhs_ -> - {-# LINE 1171 "./src-ag/Transform.ag" #-} + {-# LINE 1171 "src-ag/Transform.ag" #-} [ (ident_, rhs_) ] {-# LINE 5805 "dist/build/Transform.hs"#-} {-# INLINE rule739 #-} @@ -5860,9 +5860,9 @@ in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule748 #-} - {-# LINE 1174 "./src-ag/Transform.ag" #-} + {-# LINE 1174 "src-ag/Transform.ag" #-} rule748 = \ ident_ rhs_ -> - {-# LINE 1174 "./src-ag/Transform.ag" #-} + {-# LINE 1174 "src-ag/Transform.ag" #-} [ (ident_, rhs_) ] {-# LINE 5868 "dist/build/Transform.hs"#-} {-# INLINE rule749 #-} @@ -5923,17 +5923,17 @@ in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule758 #-} - {-# LINE 556 "./src-ag/Transform.ag" #-} + {-# LINE 556 "src-ag/Transform.ag" #-} rule758 = \ ((_lhsIoptions) :: Options) rhs_ -> - {-# LINE 556 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 1177 "src-ag/Transform.ag" #-} rule759 = \ nt_ rhs_ sources_ target_ -> - {-# LINE 1177 "./src-ag/Transform.ag" #-} + {-# LINE 1177 "src-ag/Transform.ag" #-} [ (target_, nt_, sources_, rhs_) ] {-# LINE 5939 "dist/build/Transform.hs"#-} {-# INLINE rule760 #-} @@ -5991,9 +5991,9 @@ in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule768 #-} - {-# LINE 898 "./src-ag/Transform.ag" #-} + {-# LINE 898 "src-ag/Transform.ag" #-} rule768 = \ names_ -> - {-# LINE 898 "./src-ag/Transform.ag" #-} + {-# LINE 898 "src-ag/Transform.ag" #-} names_ {-# LINE 5999 "dist/build/Transform.hs"#-} {-# INLINE rule769 #-} @@ -6055,15 +6055,15 @@ in __result_ ) in C_SemDef_s44 v43 {-# INLINE rule778 #-} - {-# LINE 929 "./src-ag/Transform.ag" #-} + {-# LINE 929 "src-ag/Transform.ag" #-} rule778 = \ after_ before_ -> - {-# LINE 929 "./src-ag/Transform.ag" #-} + {-# 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" #-} + {-# LINE 930 "src-ag/Transform.ag" #-} rule779 = \ _dependency -> - {-# LINE 930 "./src-ag/Transform.ag" #-} + {-# LINE 930 "src-ag/Transform.ag" #-} Set.fromList _dependency {-# LINE 6069 "dist/build/Transform.hs"#-} {-# INLINE rule780 #-} @@ -6103,8 +6103,8 @@ wrap_SemDefs (T_SemDefs act) (Inh_SemDefs _lhsIoptions) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_SemDefs_vIn46 _lhsIoptions - (T_SemDefs_vOut46 _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos) <- return (inv_SemDefs_s47 sem arg) + 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) ) diff --git a/src-generated/Visage.hs b/src-generated/Visage.hs --- a/src-generated/Visage.hs +++ b/src-generated/Visage.hs @@ -2,19 +2,19 @@ {-# LANGUAGE ScopedTypeVariables #-} module Visage where -{-# LINE 2 "./src-ag/Expression.ag" #-} +{-# 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" #-} +{-# 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" #-} +{-# LINE 2 "src-ag/VisageSyntax.ag" #-} import CommonTypes import UU.Pretty @@ -23,7 +23,7 @@ import Expression {-# LINE 25 "dist/build/Visage.hs" #-} -{-# LINE 6 "./src-ag/Visage.ag" #-} +{-# LINE 6 "src-ag/Visage.ag" #-} import UU.Scanner.Position(Pos(..)) import CommonTypes @@ -38,7 +38,7 @@ {-# LINE 39 "dist/build/Visage.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity -{-# LINE 19 "./src-ag/Visage.ag" #-} +{-# LINE 19 "src-ag/Visage.ag" #-} convert :: String -> String convert [] = [] @@ -73,8 +73,8 @@ wrap_Expression (T_Expression act) (Inh_Expression ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_Expression_vIn1 - (T_Expression_vOut1 _lhsOaterm) <- return (inv_Expression_s2 sem arg) + let arg1 = T_Expression_vIn1 + (T_Expression_vOut1 _lhsOaterm) <- return (inv_Expression_s2 sem arg1) return (Syn_Expression _lhsOaterm) ) @@ -107,9 +107,9 @@ in __result_ ) in C_Expression_s2 v1 {-# INLINE rule0 #-} - {-# LINE 103 "./src-ag/Visage.ag" #-} + {-# LINE 103 "src-ag/Visage.ag" #-} rule0 = \ pos_ tks_ -> - {-# LINE 103 "./src-ag/Visage.ag" #-} + {-# LINE 103 "src-ag/Visage.ag" #-} AAppl "Expression" [AString (sQ (showAGPos pos_)), AString (sQ (unlines . showTokens . tokensToStrings $ tks_))] {-# LINE 115 "dist/build/Visage.hs"#-} @@ -122,8 +122,8 @@ wrap_VisageChild (T_VisageChild act) (Inh_VisageChild ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_VisageChild_vIn4 - (T_VisageChild_vOut4 _lhsOaterm) <- return (inv_VisageChild_s5 sem arg) + let arg4 = T_VisageChild_vIn4 + (T_VisageChild_vOut4 _lhsOaterm) <- return (inv_VisageChild_s5 sem arg4) return (Syn_VisageChild _lhsOaterm) ) @@ -159,18 +159,18 @@ in __result_ ) in C_VisageChild_s5 v4 {-# INLINE rule1 #-} - {-# LINE 85 "./src-ag/Visage.ag" #-} + {-# LINE 85 "src-ag/Visage.ag" #-} rule1 = \ ((_rulesIaterms) :: [ATerm]) inh_ name_ syn_ tp_ -> - {-# LINE 85 "./src-ag/Visage.ag" #-} + {-# 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" #-} + {-# LINE 89 "src-ag/Visage.ag" #-} rule2 = \ (_ :: ()) -> - {-# LINE 89 "./src-ag/Visage.ag" #-} + {-# LINE 89 "src-ag/Visage.ag" #-} False {-# LINE 176 "dist/build/Visage.hs"#-} @@ -183,8 +183,8 @@ wrap_VisageChildren (T_VisageChildren act) (Inh_VisageChildren ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_VisageChildren_vIn7 - (T_VisageChildren_vOut7 _lhsOaterms) <- return (inv_VisageChildren_s8 sem arg) + let arg7 = T_VisageChildren_vIn7 + (T_VisageChildren_vOut7 _lhsOaterms) <- return (inv_VisageChildren_s8 sem arg7) return (Syn_VisageChildren _lhsOaterms) ) @@ -221,9 +221,9 @@ in __result_ ) in C_VisageChildren_s8 v7 {-# INLINE rule3 #-} - {-# LINE 80 "./src-ag/Visage.ag" #-} + {-# LINE 80 "src-ag/Visage.ag" #-} rule3 = \ ((_hdIaterm) :: ATerm) ((_tlIaterms) :: [ATerm]) -> - {-# LINE 80 "./src-ag/Visage.ag" #-} + {-# LINE 80 "src-ag/Visage.ag" #-} _hdIaterm : _tlIaterms {-# LINE 229 "dist/build/Visage.hs"#-} {-# NOINLINE sem_VisageChildren_Nil #-} @@ -239,9 +239,9 @@ in __result_ ) in C_VisageChildren_s8 v7 {-# INLINE rule4 #-} - {-# LINE 81 "./src-ag/Visage.ag" #-} + {-# LINE 81 "src-ag/Visage.ag" #-} rule4 = \ (_ :: ()) -> - {-# LINE 81 "./src-ag/Visage.ag" #-} + {-# LINE 81 "src-ag/Visage.ag" #-} [] {-# LINE 247 "dist/build/Visage.hs"#-} @@ -254,8 +254,8 @@ wrap_VisageGrammar (T_VisageGrammar act) (Inh_VisageGrammar ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_VisageGrammar_vIn10 - (T_VisageGrammar_vOut10 _lhsOaterm) <- return (inv_VisageGrammar_s11 sem arg) + let arg10 = T_VisageGrammar_vIn10 + (T_VisageGrammar_vOut10 _lhsOaterm) <- return (inv_VisageGrammar_s11 sem arg10) return (Syn_VisageGrammar _lhsOaterm) ) @@ -290,9 +290,9 @@ in __result_ ) in C_VisageGrammar_s11 v10 {-# INLINE rule5 #-} - {-# LINE 54 "./src-ag/Visage.ag" #-} + {-# LINE 54 "src-ag/Visage.ag" #-} rule5 = \ ((_nontsIaterms) :: [ATerm]) -> - {-# LINE 54 "./src-ag/Visage.ag" #-} + {-# LINE 54 "src-ag/Visage.ag" #-} AAppl "Productions" _nontsIaterms {-# LINE 298 "dist/build/Visage.hs"#-} @@ -305,8 +305,8 @@ wrap_VisageNonterminal (T_VisageNonterminal act) (Inh_VisageNonterminal ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_VisageNonterminal_vIn13 - (T_VisageNonterminal_vOut13 _lhsOaterm) <- return (inv_VisageNonterminal_s14 sem arg) + let arg13 = T_VisageNonterminal_vIn13 + (T_VisageNonterminal_vOut13 _lhsOaterm) <- return (inv_VisageNonterminal_s14 sem arg13) return (Syn_VisageNonterminal _lhsOaterm) ) @@ -341,9 +341,9 @@ in __result_ ) in C_VisageNonterminal_s14 v13 {-# INLINE rule6 #-} - {-# LINE 63 "./src-ag/Visage.ag" #-} + {-# LINE 63 "src-ag/Visage.ag" #-} rule6 = \ ((_altsIaterms) :: [ATerm]) inh_ nt_ syn_ -> - {-# LINE 63 "./src-ag/Visage.ag" #-} + {-# 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"#-} @@ -357,8 +357,8 @@ wrap_VisageNonterminals (T_VisageNonterminals act) (Inh_VisageNonterminals ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_VisageNonterminals_vIn16 - (T_VisageNonterminals_vOut16 _lhsOaterms) <- return (inv_VisageNonterminals_s17 sem arg) + let arg16 = T_VisageNonterminals_vIn16 + (T_VisageNonterminals_vOut16 _lhsOaterms) <- return (inv_VisageNonterminals_s17 sem arg16) return (Syn_VisageNonterminals _lhsOaterms) ) @@ -395,9 +395,9 @@ in __result_ ) in C_VisageNonterminals_s17 v16 {-# INLINE rule7 #-} - {-# LINE 58 "./src-ag/Visage.ag" #-} + {-# LINE 58 "src-ag/Visage.ag" #-} rule7 = \ ((_hdIaterm) :: ATerm) ((_tlIaterms) :: [ATerm]) -> - {-# LINE 58 "./src-ag/Visage.ag" #-} + {-# LINE 58 "src-ag/Visage.ag" #-} _hdIaterm : _tlIaterms {-# LINE 403 "dist/build/Visage.hs"#-} {-# NOINLINE sem_VisageNonterminals_Nil #-} @@ -413,9 +413,9 @@ in __result_ ) in C_VisageNonterminals_s17 v16 {-# INLINE rule8 #-} - {-# LINE 59 "./src-ag/Visage.ag" #-} + {-# LINE 59 "src-ag/Visage.ag" #-} rule8 = \ (_ :: ()) -> - {-# LINE 59 "./src-ag/Visage.ag" #-} + {-# LINE 59 "src-ag/Visage.ag" #-} [] {-# LINE 421 "dist/build/Visage.hs"#-} @@ -428,8 +428,8 @@ wrap_VisagePattern (T_VisagePattern act) (Inh_VisagePattern ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_VisagePattern_vIn19 - (T_VisagePattern_vOut19 _lhsOaterm) <- return (inv_VisagePattern_s20 sem arg) + let arg19 = T_VisagePattern_vIn19 + (T_VisagePattern_vOut19 _lhsOaterm) <- return (inv_VisagePattern_s20 sem arg19) return (Syn_VisagePattern _lhsOaterm) ) @@ -468,9 +468,9 @@ in __result_ ) in C_VisagePattern_s20 v19 {-# INLINE rule9 #-} - {-# LINE 112 "./src-ag/Visage.ag" #-} + {-# LINE 112 "src-ag/Visage.ag" #-} rule9 = \ ((_patsIaterms) :: [ATerm]) name_ -> - {-# LINE 112 "./src-ag/Visage.ag" #-} + {-# LINE 112 "src-ag/Visage.ag" #-} AAppl "Pattern" [AAppl "Constr" [AString (sQ (showAGPos (getPos name_))), AString (sQ (getName name_)), AAppl "Patterns" _patsIaterms]] @@ -490,9 +490,9 @@ in __result_ ) in C_VisagePattern_s20 v19 {-# INLINE rule10 #-} - {-# LINE 115 "./src-ag/Visage.ag" #-} + {-# LINE 115 "src-ag/Visage.ag" #-} rule10 = \ ((_patsIaterms) :: [ATerm]) pos_ -> - {-# LINE 115 "./src-ag/Visage.ag" #-} + {-# LINE 115 "src-ag/Visage.ag" #-} AAppl "Pattern" [AAppl "Product" [AString (sQ (showAGPos pos_)), AAppl "Patterns" _patsIaterms]] {-# LINE 499 "dist/build/Visage.hs"#-} @@ -509,9 +509,9 @@ in __result_ ) in C_VisagePattern_s20 v19 {-# INLINE rule11 #-} - {-# LINE 117 "./src-ag/Visage.ag" #-} + {-# LINE 117 "src-ag/Visage.ag" #-} rule11 = \ attr_ field_ -> - {-# LINE 117 "./src-ag/Visage.ag" #-} + {-# 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"#-} @@ -530,9 +530,9 @@ in __result_ ) in C_VisagePattern_s20 v19 {-# INLINE rule12 #-} - {-# LINE 119 "./src-ag/Visage.ag" #-} + {-# LINE 119 "src-ag/Visage.ag" #-} rule12 = \ ((_patIaterm) :: ATerm) attr_ field_ -> - {-# LINE 119 "./src-ag/Visage.ag" #-} + {-# 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"#-} @@ -549,9 +549,9 @@ in __result_ ) in C_VisagePattern_s20 v19 {-# INLINE rule13 #-} - {-# LINE 121 "./src-ag/Visage.ag" #-} + {-# LINE 121 "src-ag/Visage.ag" #-} rule13 = \ pos_ -> - {-# LINE 121 "./src-ag/Visage.ag" #-} + {-# LINE 121 "src-ag/Visage.ag" #-} AAppl "Pattern" [AAppl "Underscore" [AString (sQ (showAGPos pos_))]] {-# LINE 557 "dist/build/Visage.hs"#-} @@ -564,8 +564,8 @@ wrap_VisagePatterns (T_VisagePatterns act) (Inh_VisagePatterns ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_VisagePatterns_vIn22 - (T_VisagePatterns_vOut22 _lhsOaterms) <- return (inv_VisagePatterns_s23 sem arg) + let arg22 = T_VisagePatterns_vIn22 + (T_VisagePatterns_vOut22 _lhsOaterms) <- return (inv_VisagePatterns_s23 sem arg22) return (Syn_VisagePatterns _lhsOaterms) ) @@ -602,9 +602,9 @@ in __result_ ) in C_VisagePatterns_s23 v22 {-# INLINE rule14 #-} - {-# LINE 107 "./src-ag/Visage.ag" #-} + {-# LINE 107 "src-ag/Visage.ag" #-} rule14 = \ ((_hdIaterm) :: ATerm) ((_tlIaterms) :: [ATerm]) -> - {-# LINE 107 "./src-ag/Visage.ag" #-} + {-# LINE 107 "src-ag/Visage.ag" #-} _hdIaterm : _tlIaterms {-# LINE 610 "dist/build/Visage.hs"#-} {-# NOINLINE sem_VisagePatterns_Nil #-} @@ -620,9 +620,9 @@ in __result_ ) in C_VisagePatterns_s23 v22 {-# INLINE rule15 #-} - {-# LINE 108 "./src-ag/Visage.ag" #-} + {-# LINE 108 "src-ag/Visage.ag" #-} rule15 = \ (_ :: ()) -> - {-# LINE 108 "./src-ag/Visage.ag" #-} + {-# LINE 108 "src-ag/Visage.ag" #-} [] {-# LINE 628 "dist/build/Visage.hs"#-} @@ -635,8 +635,8 @@ wrap_VisageProduction (T_VisageProduction act) (Inh_VisageProduction ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_VisageProduction_vIn25 - (T_VisageProduction_vOut25 _lhsOaterm) <- return (inv_VisageProduction_s26 sem arg) + let arg25 = T_VisageProduction_vIn25 + (T_VisageProduction_vOut25 _lhsOaterm) <- return (inv_VisageProduction_s26 sem arg25) return (Syn_VisageProduction _lhsOaterm) ) @@ -677,23 +677,23 @@ in __result_ ) in C_VisageProduction_s26 v25 {-# INLINE rule16 #-} - {-# LINE 73 "./src-ag/Visage.ag" #-} + {-# LINE 73 "src-ag/Visage.ag" #-} rule16 = \ ((_childrenIaterms) :: [ATerm]) ((_locrulesIaterms) :: [ATerm]) ((_rulesIaterms) :: [ATerm]) con_ -> - {-# LINE 73 "./src-ag/Visage.ag" #-} + {-# 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" #-} + {-# LINE 76 "src-ag/Visage.ag" #-} rule17 = \ (_ :: ()) -> - {-# LINE 76 "./src-ag/Visage.ag" #-} + {-# LINE 76 "src-ag/Visage.ag" #-} True {-# LINE 693 "dist/build/Visage.hs"#-} {-# INLINE rule18 #-} - {-# LINE 77 "./src-ag/Visage.ag" #-} + {-# LINE 77 "src-ag/Visage.ag" #-} rule18 = \ (_ :: ()) -> - {-# LINE 77 "./src-ag/Visage.ag" #-} + {-# LINE 77 "src-ag/Visage.ag" #-} False {-# LINE 699 "dist/build/Visage.hs"#-} @@ -706,8 +706,8 @@ wrap_VisageProductions (T_VisageProductions act) (Inh_VisageProductions ) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_VisageProductions_vIn28 - (T_VisageProductions_vOut28 _lhsOaterms) <- return (inv_VisageProductions_s29 sem arg) + let arg28 = T_VisageProductions_vIn28 + (T_VisageProductions_vOut28 _lhsOaterms) <- return (inv_VisageProductions_s29 sem arg28) return (Syn_VisageProductions _lhsOaterms) ) @@ -744,9 +744,9 @@ in __result_ ) in C_VisageProductions_s29 v28 {-# INLINE rule19 #-} - {-# LINE 68 "./src-ag/Visage.ag" #-} + {-# LINE 68 "src-ag/Visage.ag" #-} rule19 = \ ((_hdIaterm) :: ATerm) ((_tlIaterms) :: [ATerm]) -> - {-# LINE 68 "./src-ag/Visage.ag" #-} + {-# LINE 68 "src-ag/Visage.ag" #-} _hdIaterm : _tlIaterms {-# LINE 752 "dist/build/Visage.hs"#-} {-# NOINLINE sem_VisageProductions_Nil #-} @@ -762,9 +762,9 @@ in __result_ ) in C_VisageProductions_s29 v28 {-# INLINE rule20 #-} - {-# LINE 69 "./src-ag/Visage.ag" #-} + {-# LINE 69 "src-ag/Visage.ag" #-} rule20 = \ (_ :: ()) -> - {-# LINE 69 "./src-ag/Visage.ag" #-} + {-# LINE 69 "src-ag/Visage.ag" #-} [] {-# LINE 770 "dist/build/Visage.hs"#-} @@ -777,8 +777,8 @@ wrap_VisageRule (T_VisageRule act) (Inh_VisageRule _lhsIisLoc) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_VisageRule_vIn31 _lhsIisLoc - (T_VisageRule_vOut31 _lhsOaterm) <- return (inv_VisageRule_s32 sem arg) + let arg31 = T_VisageRule_vIn31 _lhsIisLoc + (T_VisageRule_vOut31 _lhsOaterm) <- return (inv_VisageRule_s32 sem arg31) return (Syn_VisageRule _lhsOaterm) ) @@ -815,9 +815,9 @@ in __result_ ) in C_VisageRule_s32 v31 {-# INLINE rule21 #-} - {-# LINE 97 "./src-ag/Visage.ag" #-} + {-# LINE 97 "src-ag/Visage.ag" #-} rule21 = \ ((_lhsIisLoc) :: Bool) ((_patIaterm) :: ATerm) ((_rhsIaterm) :: ATerm) attr_ owrt_ -> - {-# LINE 97 "./src-ag/Visage.ag" #-} + {-# 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"#-} @@ -831,8 +831,8 @@ wrap_VisageRules (T_VisageRules act) (Inh_VisageRules _lhsIisLoc) = Control.Monad.Identity.runIdentity ( do sem <- act - let arg = T_VisageRules_vIn34 _lhsIisLoc - (T_VisageRules_vOut34 _lhsOaterms) <- return (inv_VisageRules_s35 sem arg) + let arg34 = T_VisageRules_vIn34 _lhsIisLoc + (T_VisageRules_vOut34 _lhsOaterms) <- return (inv_VisageRules_s35 sem arg34) return (Syn_VisageRules _lhsOaterms) ) @@ -871,9 +871,9 @@ in __result_ ) in C_VisageRules_s35 v34 {-# INLINE rule22 #-} - {-# LINE 92 "./src-ag/Visage.ag" #-} + {-# LINE 92 "src-ag/Visage.ag" #-} rule22 = \ ((_hdIaterm) :: ATerm) ((_tlIaterms) :: [ATerm]) -> - {-# LINE 92 "./src-ag/Visage.ag" #-} + {-# LINE 92 "src-ag/Visage.ag" #-} _hdIaterm : _tlIaterms {-# LINE 879 "dist/build/Visage.hs"#-} {-# INLINE rule23 #-} @@ -895,8 +895,8 @@ in __result_ ) in C_VisageRules_s35 v34 {-# INLINE rule25 #-} - {-# LINE 93 "./src-ag/Visage.ag" #-} + {-# LINE 93 "src-ag/Visage.ag" #-} rule25 = \ (_ :: ()) -> - {-# LINE 93 "./src-ag/Visage.ag" #-} + {-# LINE 93 "src-ag/Visage.ag" #-} [] {-# LINE 903 "dist/build/Visage.hs"#-} diff --git a/src-generated/VisagePatterns.hs b/src-generated/VisagePatterns.hs --- a/src-generated/VisagePatterns.hs +++ b/src-generated/VisagePatterns.hs @@ -1,8 +1,8 @@ --- UUAGC 0.9.50 (src-ag/VisagePatterns.ag) +-- UUAGC 0.9.51 (src-ag/VisagePatterns.ag) module VisagePatterns where -{-# LINE 2 "./src-ag/VisagePatterns.ag" #-} +{-# LINE 2 "src-ag/VisagePatterns.ag" #-} import UU.Scanner.Position(Pos) import CommonTypes diff --git a/src-generated/VisageSyntax.hs b/src-generated/VisageSyntax.hs --- a/src-generated/VisageSyntax.hs +++ b/src-generated/VisageSyntax.hs @@ -1,8 +1,8 @@ --- UUAGC 0.9.50 (src-ag/VisageSyntax.ag) +-- UUAGC 0.9.51 (src-ag/VisageSyntax.ag) module VisageSyntax where -{-# LINE 2 "./src-ag/VisageSyntax.ag" #-} +{-# LINE 2 "src-ag/VisageSyntax.ag" #-} import CommonTypes import UU.Pretty diff --git a/src-options/Options.hs b/src-options/Options.hs --- a/src-options/Options.hs +++ b/src-options/Options.hs @@ -86,6 +86,8 @@ , MyOpt [] ["version"] (NoArg versionOpt) (boolOpt showVersion) "get version information" , MyOpt ['O'] ["optimize"] (NoArg optimizeOpt) noOpt "optimize generated code (--visit --case)" , MyOpt [] ["visit"] (NoArg visitOpt) (boolOpt visit) "try generating visit functions" + , MyOpt [] ["loag"] (OptArg loagOpt "Bool") (boolOpt loag) "recognises all linear ordered attribute grammars by generting a SAT problem, uses --verbose to print out numbers of clauses and variables" + , MyOpt [] ["aoag"] (NoArg aoagOpt) (boolOpt aoag) "recognises all linear ordered attribute grammars by finding fake dependencies, uses --verbose to print out the selected fake dependencies" , MyOpt [] ["seq"] (NoArg seqOpt) (boolOpt withSeq) "force evaluation using function seq (visit functions only)" , MyOpt [] ["unbox"] (NoArg unboxOpt) (boolOpt unbox) "use unboxed tuples" , MyOpt [] ["bangpats"] (NoArg bangpatsOpt) (boolOpt bangpats) "use bang patterns (visit functions only)" @@ -185,6 +187,9 @@ , showHelp :: Bool , showVersion :: Bool , visit :: Bool + , loag :: Bool + , minvisits :: Bool + , aoag :: Bool , withSeq :: Bool , unbox :: Bool , bangpats :: Bool @@ -281,6 +286,9 @@ , withSelf = False , withCycle = False , visit = False + , loag = False + , minvisits = False + , aoag = False , withSeq = False , unbox = False , bangpats = False @@ -351,6 +359,19 @@ , noInlinePragmas = False , aggressiveInlinePragmas = False } + +loagOpt :: (Maybe String) -> Options -> Options +loagOpt mstr opts = + case mstr of + Nothing -> opts' + Just "0" -> opts' + Just _ -> opts' {minvisits = True} + + where opts'=opts{loag = True, visit = True} + +aoagOpt :: Options -> Options +aoagOpt opts = + opts{loag = True, visit = True, aoag = True} --Options -> String -> [String] moduleOpt :: Maybe String -> Options -> Options diff --git a/src/Ag.hs b/src/Ag.hs --- a/src/Ag.hs +++ b/src/Ag.hs @@ -4,7 +4,7 @@ import System.Environment (getArgs, getProgName) import System.Console.GetOpt (usageInfo) import Data.List (partition) -import Control.Monad (zipWithM_) +import Control.Monad (zipWithM_,when) import Data.Maybe import System.FilePath import System.IO @@ -25,6 +25,7 @@ import qualified DefaultRules as Pass2 (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) import qualified ResolveLocals as Pass2a (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) import qualified Order as Pass3 (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) +import qualified LOAG.Order as Pass3b (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) import qualified KWOrder as Pass3a (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) import qualified GenerateCode as Pass4 (sem_CGrammar, wrap_CGrammar, Syn_CGrammar(..), Inh_CGrammar(..)) import qualified PrintVisitCode as Pass4a (sem_CGrammar, wrap_CGrammar, Syn_CGrammar(..), Inh_CGrammar(..)) @@ -110,7 +111,9 @@ output3 = Pass3.wrap_Grammar (Pass3.sem_Grammar grammar2a ) Pass3.Inh_Grammar {Pass3.options_Inh_Grammar = flags'} grammar3 = Pass3.output_Syn_Grammar output3 output3a = Pass3a.wrap_Grammar (Pass3a.sem_Grammar grammar2a ) Pass3a.Inh_Grammar {Pass3a.options_Inh_Grammar = flags'} - grammar3a = Pass3a.output_Syn_Grammar output3a + output3b = Pass3b.wrap_Grammar (Pass3b.sem_Grammar grammar2a ) Pass3b.Inh_Grammar {Pass3b.options_Inh_Grammar = flags'} + grammar3a | loag flags' = Pass3b.output_Syn_Grammar output3b + | otherwise = Pass3a.output_Syn_Grammar output3a output4 = Pass4.wrap_CGrammar (Pass4.sem_CGrammar(Pass3.output_Syn_Grammar output3)) Pass4.Inh_CGrammar {Pass4.options_Inh_CGrammar = flags'} output4a = Pass4a.wrap_CGrammar (Pass4a.sem_CGrammar(Pass3.output_Syn_Grammar output3)) Pass4a.Inh_CGrammar {Pass4a.options_Inh_CGrammar = flags'} output4b = Pass4b.wrap_ExecutionPlan (Pass4b.sem_ExecutionPlan grammar3a) Pass4b.Inh_ExecutionPlan {Pass4b.options_Inh_ExecutionPlan = flags', Pass4b.inhmap_Inh_ExecutionPlan = Pass3a.inhmap_Syn_Grammar output3a, Pass4b.synmap_Inh_ExecutionPlan = Pass3a.synmap_Syn_Grammar output3a, Pass4b.pragmaBlocks_Inh_ExecutionPlan = pragmaBlocksTxt, Pass4b.importBlocks_Inh_ExecutionPlan = importBlocksTxt, Pass4b.textBlocks_Inh_ExecutionPlan = textBlocksDoc, Pass4b.moduleHeader_Inh_ExecutionPlan = mkModuleHeader $ Pass1.moduleDecl_Syn_AG output1, Pass4b.mainName_Inh_ExecutionPlan = mkMainName mainName $ Pass1.moduleDecl_Syn_AG output1, Pass4b.mainFile_Inh_ExecutionPlan = mainFile, Pass4b.textBlockMap_Inh_ExecutionPlan = textBlockMap, Pass4b.mainBlocksDoc_Inh_ExecutionPlan = mainBlocksDoc,Pass4b.localAttrTypes_Inh_ExecutionPlan = Pass3a.localSigMap_Syn_Grammar output3a} @@ -134,17 +137,19 @@ Seq.>< Pass1a.errors_Syn_Grammar output1a Seq.>< Pass2.errors_Syn_Grammar output2 Seq.>< Pass2a.errors_Syn_Grammar output2a) - furtherErrors = if kennedyWarren flags' - then let errs3a = Pass3a.errors_Syn_Grammar output3a - in if Seq.null errs3a - then if ocaml flags' - then toList ( Pass4c.errors_Syn_ExecutionPlan output4c ) - else if clean flags' - then toList ( Pass4d.errors_Syn_ExecutionPlan output4d ) - else toList ( Pass4b.errors_Syn_ExecutionPlan output4b ) - else toList errs3a - else toList ( Pass3.errors_Syn_Grammar output3 - Seq.>< Pass4.errors_Syn_CGrammar output4) + furtherErrors = if loag flags' + then toList (Pass3b.errors_Syn_Grammar output3b) + else if kennedyWarren flags' + then let errs3a = Pass3a.errors_Syn_Grammar output3a + in if Seq.null errs3a + then if ocaml flags' + then toList ( Pass4c.errors_Syn_ExecutionPlan output4c ) + else if clean flags' + then toList ( Pass4d.errors_Syn_ExecutionPlan output4d ) + else toList ( Pass4b.errors_Syn_ExecutionPlan output4b ) + else toList errs3a + else toList ( Pass3.errors_Syn_Grammar output3 + Seq.>< Pass4.errors_Syn_CGrammar output4) errorList = if null parseErrorList then mainErrors @@ -226,6 +231,11 @@ then printStr $ "\nPlus " ++ show additionalWarnings ++ " more warning" ++ pluralS additionalWarnings ++ ".\n" else return () + -- show fake dependencies when found with --aoag + when (aoag flags' && verbose flags' && + isJust (Pass3b.ads_Syn_Grammar output3b)) $ + putStrLn (show $ fromJust $ Pass3b.ads_Syn_Grammar output3b) + if not (null errorsToStopOn) -- note: this may already run quite a part of the compilation... then failWith 1 else @@ -240,7 +250,7 @@ if sepSemMods flags' then do -- alternative module gen - if kennedyWarren flags' + if loag flags || kennedyWarren flags' then if ocaml flags' then error "sepsemmods is not implemented for the ocaml output generation" else Pass4b.genIO_Syn_ExecutionPlan output4b @@ -278,7 +288,7 @@ , pp "-}" ] else empty] - | kennedyWarren flags' + | loag flags' || kennedyWarren flags' = if ocaml flags' then vlist [ text "(* generated by UUAG from" >#< mainFile >#< "*)" diff --git a/src/KennedyWarren.hs b/src/KennedyWarren.hs --- a/src/KennedyWarren.hs +++ b/src/KennedyWarren.hs @@ -40,7 +40,7 @@ (ndiParams ndi) (ndiClassCtxs ndi) initst - (Just initv) + [initv] nextMap prevMap prods @@ -581,7 +581,7 @@ repeatM :: VG s () -> VG s () -} -kennedyWarrenVisitM :: Set NontermIdent -> [NontDependencyInformationM s] -> VG s [Maybe Int] +kennedyWarrenVisitM :: Set NontermIdent -> [NontDependencyInformationM s] -> VG s [[VisitIdentifier]] kennedyWarrenVisitM wr ndis = do -- Create initial nodes and edges (edges only for wrapper nodes) initvs <- forM ndis $ \ndi -> do @@ -591,8 +591,8 @@ if (Set.member (ndiNonterminal $ ndimOrig $ ndi) wr) && (not (Set.null inh) || not (Set.null syn)) then do VGEdge initv <- createPending nd inh syn - return $ Just initv - else return Nothing + return [initv] + else return [] -- Handle all pending edges while there are any repeatM $ do pend <- selectPending @@ -742,7 +742,7 @@ ------------------------------------------------------------ --- Construction of the execution plan --- ------------------------------------------------------------ -kennedyWarrenExecutionPlan :: Options -> [NontDependencyInformationM s] -> [Maybe Int] -> +kennedyWarrenExecutionPlan :: Options -> [NontDependencyInformationM s] -> [[VisitIdentifier]] -> Set NontermIdent -> TypeSyns -> Derivings -> VG s ExecutionPlan kennedyWarrenExecutionPlan opts ndis initvs wr typesyns derivings = do -- Loop over all nonterminals diff --git a/src/LOAG/AOAG.hs b/src/LOAG/AOAG.hs new file mode 100644 --- /dev/null +++ b/src/LOAG/AOAG.hs @@ -0,0 +1,289 @@ +{-# LANGUAGE Rank2Types #-} + +module LOAG.AOAG where + +import LOAG.Common +import LOAG.Graphs +import LOAG.Rep +import LOAG.Result + +import AbstractSyntax +import CommonTypes +import Control.Arrow ((&&&), (***)) +import Control.Monad (forM, forM_, MonadPlus(..), when, unless) +import Control.Monad.ST +import Control.Monad.Error (ErrorT(..)) +import Control.Monad.Trans (lift, MonadTrans(..)) +import Control.Monad.State (MonadState(..)) +import Data.Maybe (fromMaybe, catMaybes, fromJust, isNothing) +import Data.List (elemIndex, foldl', delete, (\\), insert, nub) +import Data.STRef +import Data.Tuple (swap) +import qualified Data.Set as S +import qualified Data.IntSet as IS +import qualified Data.IntMap as IM +import qualified Data.Map as M +import Data.Array.MArray +import qualified Data.Array as A +import Data.Array.ST +import ErrorMessages as Err +import Pretty +import UU.Scanner.Position + +data Settings = Settings + { -- current minimum ads size + prune_val :: Int + -- whether to minimize the number of fake dependencies + -- could be very costly + , min_ads :: Bool + } +default_settings = Settings 999 False + +type AOAG s a = ResultT (ST s) a +runAOAG :: (forall s. AOAG s a) -> Either Err.Error a +runAOAG l = + case runST (runResult l) of + Give res -> Right res + Cycle e c T1 -> Left $ t1err + Cycle e c T2 -> Left $ t2err + Cycle e c (T3 _) -> Left $ t3err + Limit -> Left $ lerr + NotLOAG -> Left $ naoag + where t1err = Err.CustomError False noPos $ text "Type 1 cycle" + t2err = Err.CustomError False noPos $ text "Type 2 cycle" + t3err = Err.CustomError False noPos $ text "Type 3 cycle" + lerr = Err.CustomError False noPos $ text "Limit reached!" + naoag = Err.CustomError False noPos $ text "Not arranged orderly..." +-- | Catch a type 3 cycle-error made by a given constructor +-- | two alternatives are given to proceed +catchType3 :: (Monad m) => + ResultT m a -- The monad to catch from + -- If the catch is made + -> (Edge -> Cycle -> [Edge] -> ResultT m a) + -> ResultT m a +catchType3 mt3 alt = Result $ do + let runM = runResult mt3 + mt3a <- runM + case mt3a of + Cycle e c (T3 comp) -> runResult (alt e c comp) + otherwise -> runM + +type ADS = [Edge] +type AOAGRes = LOAGRes +-- | Calculate a total order if the semantics given +-- originate from a linearly-ordered AG +schedule :: LOAGRep -> Grammar -> Ag -> [Edge] -> Either Error AOAGRes +schedule sem gram@(Grammar _ _ _ _ dats _ _ _ _ _ _ _ _ _) + ag@(Ag bounds_s bounds_p de nts) ads + = runAOAG $ aoag default_settings ads + where + -- get the maps from semantics and translate them to functions + nmp = (nmp_LOAGRep_LOAGRep sem) + ofld = (ofld_LOAGRep_LOAGRep sem) + genA = gen_LOAGRep_LOAGRep sem + inss = inss_LOAGRep_LOAGRep sem + + -- select candidates, using the edge that caused the cycle + -- from the list of intra-thread dependencies + -- (intra-visit dependencies without edges in ids) + candidates :: Edge -> Cycle -> [Edge] -> [Edge] + candidates _ c = foldr (\(f,t) acc -> + if f `IS.member` c &&t `IS.member` c + then (t,f):acc else acc) [] + -- | Move occurrence to its corresponding attribute + gen :: Vertex -> Vertex + gen v = genA A.! v + + genEdge :: Edge -> Edge + genEdge (f,t) = (gen f, gen t) + + -- | Decide for a given production edge whether the vertices + -- belong to the same field + siblings :: Edge -> Bool + siblings (f, t) = ofld A.! f == ofld A.! t + + -- | Given an nonterminal-edge, instantiate it + -- assumes that the occurrences of fields are added in the same order + instEdge :: Edge -> [Edge] + instEdge (f, t) = zip (inss A.! f) (inss A.! t) + + aoag :: Settings -> [Edge] -> AOAG s AOAGRes + aoag cfg init_ads = run + where + run :: AOAG s AOAGRes + run = induced ads >>= detect + + detect (dp,idp,ids@(idsf,idst)) = do + -- Attribute -> TimeSlot + schedA <- lift (mapArray (const Nothing) idsf) + -- map TimeSlot -> [Attribute] + schedS <- lift (newSTRef $ + foldr (\(Nonterminal nt _ _ _ _) -> M.insert (getName nt) + (IM.singleton 1 [])) M.empty dats) + fr_ids <- freeze_graph ids + threads <- lift (completing fr_ids (schedA, schedS) nts) + let (ivd, comp) = fetchEdges fr_ids threads nts + m_edp dp init_ads ivd comp (schedA, schedS) `catchType3` + find_ads dp idp ids (schedA, schedS) + + find_ads :: Graph s -> Graph s -> Graph s -> SchedRef s -> + Edge -> Cycle -> [Edge] -> AOAG s AOAGRes + find_ads dp idp ids sched e cycle comp = do + pruner <- lift (newSTRef 999) + explore dp idp ids sched init_ads pruner e cycle comp + + explore :: Graph s -> Graph s -> Graph s -> SchedRef s -> + [Edge] -> STRef s Int -> Edge -> Cycle -> [Edge] -> + AOAG s AOAGRes + explore dp idp ids sched@(schedA, schedS) ads pruner e c comp = + explore' dp idp ids sched ads (candidates e c comp) pruner + where + explore' :: Graph s -> Graph s -> Graph s -> SchedRef s -> + [Edge] -> [Edge] -> STRef s Int -> + AOAG s AOAGRes + explore' _ _ _ _ _ [] _ = Result $ return NotLOAG + explore' dp idp ids sched@(schedA,schedS) ads (fd:cs) pruner + = Result $ do + p_val <- readSTRef pruner + if length ads >= p_val -1 + then return Limit + else do + idpf_clone <- mapArray id (fst idp) + idpt_clone <- mapArray id (snd idp) + let idp_c = (idpf_clone, idpt_clone) + idsf_clone <- mapArray id (fst ids) + idst_clone <- mapArray id (snd ids) + let ids_c = (idsf_clone, idst_clone) + schedA_c <- mapArray id schedA + schedS_v <- readSTRef schedS + schedS_c <- newSTRef schedS_v + let sched_c = (schedA_c, schedS_c) + + let runM = runResult $ reschedule dp idp ids sched + (fd:ads) fd pruner + let backtrack = explore' dp idp_c ids_c sched_c ads cs + pruner + maoag <- runM + case maoag of + Cycle e c T2 -> runResult backtrack + NotLOAG -> runResult backtrack + Limit -> runResult backtrack + Cycle e c (T3 comp) -> error "Uncaught type 3" + Cycle e c T1 -> error "Type 1 error" + Give (tdp1,inf1,ads1) -> + if LOAG.AOAG.min_ads cfg + then do + writeSTRef pruner (length ads1) + maoag' <- runResult backtrack + case maoag' of + Give (tdp2,inf2,ads2) + -> return $ Give (tdp2,inf2,ads2) + otherwise -> return $ Give (tdp1,inf1,ads1) + else return $ Give (tdp1,inf1,ads1) + + -- step 1, 2 and 3 + induced :: [Edge] -> AOAG s (Graph s, Graph s, Graph s) + induced ads = do + dpf <- lift (newArray bounds_p IS.empty) + dpt <- lift (newArray bounds_p IS.empty) + idpf <- lift (newArray bounds_p IS.empty) + idpt <- lift (newArray bounds_p IS.empty) + idsf <- lift (newArray bounds_s IS.empty) + idst <- lift (newArray bounds_s IS.empty) + let ids = (idsf,idst) + let idp = (idpf,idpt) + let dp = (dpf ,dpt) + inducing dp idp ids (de ++ ads) + + inducing :: Graph s -> Graph s -> Graph s -> [Edge] + -> AOAG s (Graph s, Graph s, Graph s) + inducing dp idp ids es = do + mapM_ (addD dp idp ids) es + return (dp, idp, ids) + addD :: Graph s -> Graph s -> Graph s -> Edge -> AOAG s [Edge] + addD dp' idp' ids' e = do + resd <- e `insErt` dp' + resdp <- e `inserT` idp' + case resdp of + Right es -> do + addedExtras <- mapM (addN idp' ids') (e:es) + return $ concat addedExtras + Left c -> throwCycle e c T2 + + addI :: Graph s -> Graph s -> Edge -> AOAG s [Edge] + addI idp' ids' e = do + exists <- member e idp' + if not exists then do + res <- e `inserT` idp' + case res of + Right es -> do + addedExtras <- mapM (addN idp' ids') es + return (concat addedExtras) + Left c -> throwCycle e c T2 + else return [] + addN :: Graph s -> Graph s -> Edge -> AOAG s [Edge] + addN idp' ids' e = do + if (siblings e) then do + let s_edge = genEdge e + exists <- member s_edge ids' + if not exists then do + _ <- inserT s_edge ids' + addedEx <- mapM (addI idp' ids') (instEdge s_edge) + return (s_edge : concat addedEx) + else return [] + else return [] + + + -- step 6, 7 + m_edp :: Graph s -> [Edge] -> [Edge] -> [Edge] -> SchedRef s -> + AOAG s AOAGRes + m_edp (dpf, dpt) ads ivd comp sched = do + edpf <- lift (mapArray id dpf) + edpt <- lift (mapArray id dpt) + mc <- addEDs (edpf,edpt) (concatMap instEdge ivd) + case mc of + Just (e, c) -> throwCycle e c (T3 $ concatMap instEdge comp) + Nothing -> do + tdp <- lift (freeze edpt) + infs <- lift (readSTRef (snd sched)) + return $ (Just tdp,infs,ads) + + reschedule :: Graph s -> Graph s -> Graph s -> SchedRef s -> + [Edge] -> Edge -> STRef s Int + -> AOAG s AOAGRes + reschedule dp idp ids sched@(_,threadRef) ads e pruner = do + extra <- addN idp ids e + forM_ extra $ swap_ivd ids sched + fr_ids <- freeze_graph ids + threads <- lift (readSTRef threadRef) + let (ivd, comp) = fetchEdges fr_ids threads nts + m_edp dp ads ivd comp sched `catchType3` + explore dp idp ids sched ads pruner + where + swap_ivd :: Graph s -> SchedRef s -> Edge -> AOAG s () + swap_ivd ids@(idsf, idst) sr@(schedA, schedS) (f,t) = do + --the edge should point from higher to lower timeslot + assigned <- lift (freeze schedA) + let oldf = maybe (error "unassigned f") id $ assigned A.! f + oldt = maybe (error "unassigned t") id $ assigned A.! t + dirf = snd $ alab $ nmp M.! f + dirt = snd $ alab $ nmp M.! t + newf | oldf < oldt = oldt + (if dirf /= dirt then 1 else 0) + | otherwise = oldf + nt = show $ typeOf $ findWithErr nmp "m_edp" f + + -- the edge was pointing in wrong direction so we moved + -- the attribute to a new interaction, now some of its + -- predecessors/ancestors might need to be moved too + unless (oldf == newf) $ do + lift (writeArray schedA f (Just newf)) + lift (modifySTRef schedS + (M.adjust (IM.update (Just . delete f) oldf) nt)) + lift (modifySTRef schedS + (M.adjust(IM.alter(Just. maybe [f] (insert f))newf)nt)) + predsf <- lift (readArray idst f) + succsf <- lift (readArray idsf f) + mapM_ (swap_ivd ids sr) ( + (map (flip (,) f) $ IS.toList predsf) ++ + (map ((,) f) $ IS.toList succsf)) + diff --git a/src/LOAG/Chordal.hs b/src/LOAG/Chordal.hs new file mode 100644 --- /dev/null +++ b/src/LOAG/Chordal.hs @@ -0,0 +1,262 @@ +{-# LANGUAGE CPP #-} + +module LOAG.Chordal where + +#ifdef WITH_LOAG + +import LOAG.Common +import LOAG.Graphs +import LOAG.Optimise +import LOAG.Solver.MiniSat +import Options + +import Control.Monad (unless, forM, when, foldM) +import Control.Monad.ST +import qualified Data.Array as A +import Data.Array.IO +import Data.Array.ST as ST +import qualified Data.IntMap as IM +import qualified Data.IntSet as IS +import qualified Data.Map as M +import Data.Maybe (isNothing, catMaybes) +import qualified Data.Set as S +import Data.STRef + +type Neigh = (Vertex, EdgeType) +data EdgeType = Sib MyVar -- Edge between siblings + | Any MyVar -- Unknown + | NSib MyVar -- Edge between non-siblings + deriving (Show) + +extract (Sib l) = l +extract (Any l) = l +extract (NSib l)= l + +neg :: EdgeType -> EdgeType +neg (Sib p) = Sib $ varnot p +neg (NSib p) = NSib $ varnot p +neg (Any p) = Any $ varnot p + + +type NtGraph = IM.IntMap [(Vertex,MyVar)] +type ToChordal = IM.IntMap [Neigh] +type SatEdge = (Vertex, Neigh) + +addClauses :: Sat -> [[EdgeType]] -> IO () +addClauses sat = mapM_ (addClause sat . map extract) + +toChordal :: [(Edge,EdgeType)] -> IO ToChordal +toChordal es = + let edges = concatMap (\((a,b),c) -> [(a,[(b,c)]),(b,[(a,neg c)])]) es + in return $ IM.fromListWith (++) edges + +toNtGraph :: [(Edge,MyVar)] -> IO NtGraph +toNtGraph es = + let edges = concatMap (\((a,b),c) -> [(a,[(b,c)]),(b,[(a,varnot c)])]) es + in return $ IM.fromListWith (++) edges + + +remove :: Vertex -> [Neigh] -> ToChordal -> ToChordal +remove v ns g = foldr (IM.adjust remN . fst) (IM.delete v g) ns + where remN ns = filter ((/= v).fst) ns + +adds :: ToChordal -> [SatEdge] -> ToChordal +adds g = foldl add g + +add :: ToChordal -> SatEdge -> ToChordal +add g (v,n@(v2,c)) = IM.adjust (n:) v + $ IM.adjust ((v,neg c):) v2 g + +removeNt :: Vertex -> [(Vertex,MyVar)] -> NtGraph -> NtGraph +removeNt v ns g = foldr (IM.adjust remN . fst) (IM.delete v g) ns + where remN ns = filter ((/= v).fst) ns + +addsNt g = foldl addNt g + +addNt g (v,n@(v2,c)) = IM.adjust (n:) v + $ IM.adjust ((v,varnot c):) v2 g + +scheduleLOAG :: Ag -> (String -> IO ()) -> Options -> IO LOAGRes +scheduleLOAG ag@(Ag nbounds pbounds dps nts) putStrLn opts = do + let optim | minvisits opts = [MinVisits] -- todo: allow specification of more optimisations + | otherwise = [] + putStrLn "--- Starting ---" + sat <- newSolvable + varMap <- noNtCycles sat nts putStrLn + noPrCycles sat prs varMap putStrLn + (v,p) <- satValues sat + putStrLn $ "nr. of variables: " ++ show v + putStrLn $ "nr. of clauses: " ++ show p + putStrLn "--- Solving ---" + b <- satsolve sat [] + if not b then error "Not LOAG" + else do putStrLn "--- Constructing Interfaces ---" + (ids,edp,interfaces) <- loagRes sat varMap dps + let oldct = getVisCount nts interfaces + when (minvisits opts) $ + putStrLn "--- Minimising #Visit" + optimise sat varMap optim nbounds nts interfaces + (ids',edp',interfaces') <- loagRes sat varMap dps + let visC@newct = getVisCount nts interfaces' + when (minvisits opts) $ do + putStrLn ("--- #Visits (max,sum,avg) " ++(show oldct) + ++" --> " ++(show newct)) + putStrLn "--- Code Generation ---" + return (Just edp',interfaces',[]) + where loagRes sat varMap dps = do + (ids,edp) <- mkGraphs sat varMap dps + interfaces <- mkInterfaces ids + return (ids,edp,interfaces) + prs = [ p | (Nt _ _ _ _ _ ps) <- nts, p <- ps] + mkInterfaces ids = return $ runST $ do + schedA <- newArray nbounds Nothing + schedS <- newSTRef $ foldr (\(Nt nt _ _ _ _ _) -> + M.insert nt (IM.singleton 1 [])) + M.empty nts + completing ids (schedA, schedS) nts + + mkGraphs :: Sat -> M.Map Edge MyVar -> [Edge] -> + IO (FrGraph,TDPRes) + mkGraphs sat varMap dps = do + idsf <- newArray nbounds IS.empty :: IO (IOArray Vertex Vertices) + idst <- newArray nbounds IS.empty :: IO (IOArray Vertex Vertices) + edp <- newArray pbounds IS.empty :: IO (IOArray Vertex Vertices) + let (ids) = (idsf,idst) + sequence_ [ do v <- value sat pred + case v of + Nothing -> error "no val" + Just True -> addEdges (i,s) (zip ios sos) ids edp + Just False-> addEdges (s,i) (zip sos ios) ids edp + | Nt _ _ _ inhs outs _ <- nts + , (i,ios,_) <- inhs + , (s,sos,_) <- outs + , let pred = varMap M.! (i,s) + ] + forM dps $ \(f,t) -> do + modifyArray edp t (f `IS.insert`) + f_idsf <- freeze idsf + f_idst <- freeze idst + f_edp <- freeze edp + return ((f_idsf,f_idst),f_edp) + where addEdges (f,t) es (idsf,idst) edp = do + modifyArray idsf f (t `IS.insert`) + modifyArray idst t (f `IS.insert`) + forM es $ \(f,t) -> do --edp does not reflect flow + modifyArray edp t (f `IS.insert`) + +noCyclesNt :: Sat -> NtGraph -> IO () +noCyclesNt sat g | IM.null g = return () + | otherwise = do + news <- sequence [ noTriangleNt sat g p q | (p,q) <- pairs neighs] + let g' = addsNt (removeNt node neighs g) (concat news) + noCyclesNt sat g' + where + node = snd $ minimum [ (length xs, a) | (a,xs) <- IM.toList g ] + Just neighs = IM.lookup node g + +noTriangleNt :: Sat -> NtGraph -> (Vertex, MyVar) -> + (Vertex, MyVar) -> IO [(Vertex,(Vertex,MyVar))] +noTriangleNt sat g e1@(t1,c1) e2@(t2,c2) = + case IM.lookup t1 g of + Just ns -> + case [ c | (t2',c) <- ns, t2' == t2 ] of + [] -> do c3 <- newLit sat + ruleOut c1 c2 c3 + return [(t1,(t2,c3))] + [c3] -> ruleOut c1 c2 c3 >> return [] + _ -> error "multiple edges between two nodes" + Nothing -> error "pointer outside of graph" + where + ruleOut ea eb ab= do addClause sat [ea, ab, varnot eb] + addClause sat [varnot ea,varnot ab,eb] + +noCyclesPr :: Sat -> ToChordal -> IO () +noCyclesPr sat g | IM.null g = return () + | otherwise = do + news <- sequence [ noTriangle sat g p q | (p,q) <- validPairs neighs] + let g' = adds (remove node neighs g) (concat news) + noCyclesPr sat g' + where + node = snd $ minimum [ (weight xs, a) + | (a,xs) <- IM.toList g ] + Just neighs = IM.lookup node g + validPairs ns = [ (p,q) | p <- sibs, q <- nsibs ] ++ + [ (p,q) | p <- nsibs, q <- anys ] ++ + [ (p,q) | p <- sibs, q <- anys ] + ++ (pairs anys) + where sibs = [ n | n@(_,Sib _) <- ns ] + nsibs= [ n | n@(_,NSib _) <- ns ] + anys = [ n | n@(_,Any _) <- ns ] + weight :: [Neigh] -> Int + weight xs = ss*3 * (ds + cs) + (ds + cs)^2 + where + ss = length [ x | x@(_,Sib _) <- xs ] + ds = length [ x | x@(_,NSib _) <- xs ] + cs = length [ x | x@(_,Any _) <- xs ] + +noTriangle :: Sat -> ToChordal -> Neigh -> Neigh -> IO [SatEdge] +noTriangle sat g e1@(t1,c1) e2@(t2,c2) = + case IM.lookup t1 g of + Just ns -> + case [ c | (t2',c) <- ns, t2' == t2 ] of + [] -> do p <- newLit sat + ruleOut c1 c2 (Any p) + return [(t1,(t2,(Any p)))] + [c3] -> ruleOut c1 c2 c3 >> return [] + _ -> error "multiple edges between two nodes" + Nothing -> error "pointer outside of graph" + where ruleOut ea eb ab= addClauses sat [[ea, ab, neg eb],[neg ea,neg ab,eb]] +noNtCycles :: Sat -> [Nt] -> (String -> IO ()) -> IO VarMap +noNtCycles sat tps putStrLn = do + putStrLn "--- Non-Terminals ---" + maps <- mapM forNt tps + return $ M.unions maps + where -- at non-terminal level, all cycles are between siblings + -- that is why we force all the edges to be the same + -- (not filtered by validPairs) + forNt tp@(Nt tid dpf dpt inhs syns _) = do + vars <- satValues sat + putStrLn ("nt : " ++ tid ++ " ... " ++ + show vars ++ " ...") + ass <- sequence $ + [ return ((i,s),VarTrue) | ((i,s)) <- dpf ]++ + [ return ((i,s),VarFalse)| ((s,i)) <- dpt ] + let assM = M.fromList ass + mvars<- sequence + [ if new then do + p <- newLit sat + return $ Just ((i,s),p) else return Nothing + | (i,_,_) <- inhs + , (s,_,_) <- syns + , let mmv = maybe (M.lookup (s,i) assM) Just + (M.lookup (i,s) assM) + new = isNothing mmv ] + let vars = ass ++ catMaybes mvars + g <- toNtGraph vars + noCyclesNt sat g + return $ M.fromList vars + + +noPrCycles :: Sat -> [Pr] -> VarMap -> (String -> IO ()) -> IO () +noPrCycles sat prods varMap putStrLn = do + putStrLn "--- Productions ---" + mapM_ forProd prods + where forProd (Pr prod es ses fs) | length fs ==1 = return () --taken care of + | otherwise = do + vars <- satValues sat + putStrLn ("prod: " ++ show prod ++ " ... " ++ + show vars ++ " ...") + g <- toChordal (sibs ++ dps) + noCyclesPr sat g + where sibs= [ ((f,t),Sib c) | (e@(f,t),ge,_) <- ses + , let c = case M.lookup ge varMap of + Just p -> p + Nothing -> error "no var found"] + dps = [ (e,NSib VarTrue) | e <- es ] + + +#else + +scheduleLOAG = error "You need to install uuagc with the -fwith-loag flag in order to use the --loag option." + +#endif diff --git a/src/LOAG/Common.hs b/src/LOAG/Common.hs new file mode 100644 --- /dev/null +++ b/src/LOAG/Common.hs @@ -0,0 +1,295 @@ + +module LOAG.Common where + +import qualified Data.Array as A +import qualified Data.Map as M +import qualified Data.IntMap as IM +import qualified Data.IntSet as IS +import qualified Data.Set as S +import qualified Data.Sequence as Seq +import Data.Maybe (isNothing) +import Data.STRef +import Data.Array.ST +import Data.List (intercalate, foldl', nub) +import CommonTypes +import Control.Arrow +import Control.Monad.ST +import Control.Monad (forM, when, forM_, forM_, foldM) + +import LOAG.Graphs + +data Ag = Ag (Int,Int) -- attribute range + (Int,Int) -- occurrence range + [Edge] -- direct dependencies + [Nt] -- non-terminals +data Nt = Nt String + [Edge] -- direct dps from inh -> syn + [Edge] -- direct dps from syn -> inh + -- inh attributes with direction and instances + [(Vertex,[Vertex],Direction)] + -- syn attributes with direction and instances + [(Vertex,[Vertex],Direction)] + [Pr] -- productions of this Nt + deriving (Show) +data Pr = Pr PLabel + [Edge] -- direct dependencies between fields + [(Edge,Edge,Bool)] -- all siblings pairs, with generalised version, and boolean that denotes whether if it is an edge of LHS + [Fd] -- the fields of this production, including lhs + deriving (Show) +data Fd = Fd String -- field name + String -- type of the field + [(Vertex,Vertex)] -- inherited atts (gen, inst) + [(Vertex,Vertex)] -- synthesized atts (gen, inst) + deriving (Show) + +type Attrs = [Attr] +data Attr = Attr String Direction MyType + deriving (Show, Eq, Ord) +data Direction = Inh | AnyDir | Syn + deriving (Show, Ord, Enum) + + +foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a +foldM' _ a [] = return a +foldM' f a (x:xs) = f a x >>= \fax -> fax `seq` foldM f fax xs + +modifyArray r k f = do + v <- readArray r k + writeArray r k (f v) + +setConcatMap f = S.foldr (S.union . f) S.empty +isLoc (MyOccurrence (_,f) _) = f == "loc" || f == "inst" -- transparent occr ? + +instance Eq Direction where + Inh == Syn = False + Syn == Inh = False + _ == _ = True + +data MyType = TyInt + | TyBool + | TyString + | TyData String + | TyLit String + | TyArr MyType MyType + | NoType -- the empty set of values (no members) + | AnyType -- the set of all values (union of all types) + +type SchedRef s = (STArray s Vertex (Maybe Int),ThreadRef s) +type AttrAssRef s = STArray s Vertex (Maybe Int) +type ThreadRef s = STRef s InterfaceRes +-- production is identified by its name and its parent non-terminal +type PLabel = (MyType,String) +type FLabel = String -- field label +-- attribute is identified by its name and its direction +type ALabel = (String, Direction) +type AI_N = M.Map MyType MyAttributes +type AS_N = M.Map MyType MyAttributes +type A_N = M.Map MyType MyAttributes +type A_P = M.Map PLabel MyOccurrences +-- Get the (data)type of a certain child at a certain production +type FTY = M.Map (PLabel, FLabel) MyType +-- Get the fields corresponding to a certain type +type TYFS = M.Map MyType [(PLabel, FLabel)] +-- the definition of given occ uses these occs +type SF_P = M.Map MyOccurrence (S.Set MyOccurrence) +type PMP = M.Map Int MyOccurrence +type PMP_R = M.Map MyOccurrence Int +type NMP = M.Map Int MyAttribute +type NMP_R = M.Map MyAttribute Int +type FMap = M.Map (PLabel,FLabel) (S.Set MyOccurrence, S.Set MyOccurrence) +type FsInP = M.Map PLabel [(PLabel, FLabel)] +type LOAGRes = ( Maybe TDPRes + , InterfaceRes + , ADSRes) +type VisCount= (Int, Int, Float) +type ADSRes = [Edge] +type TDPRes = A.Array Vertex Vertices --M.Map PLabel TDPGraph +type TDPGraph = (IM.IntMap Vertices, IM.IntMap Vertices) +type InterfaceRes = M.Map String (IM.IntMap [Vertex]) +type HOMap = M.Map PLabel (S.Set FLabel) + +findWithErr :: (Ord k, Show k, Show a) => M.Map k a -> String -> k -> a +findWithErr m err k = maybe (error err) id $ M.lookup k m +findWithErr' m err k= maybe (error err) id $ IM.lookup k m + +-- Defining the MyAttribute (attribute at non-terimal +-- and the MyOccurrences (attribute at a production) +type MyAttributes = [MyAttribute] +data MyAttribute = MyAttribute {typeOf :: MyType, alab :: ALabel} + deriving (Ord, Eq) +(<.>) = MyAttribute +infixl 7 <.> +instance Show MyAttribute where + show (MyAttribute t a) = show t ++ "<.>" ++ show a + +type MyOccurrences = [MyOccurrence] +data MyOccurrence = MyOccurrence {argsOf :: (PLabel, FLabel), attr :: ALabel} + deriving (Ord, Eq) +(>.<) = MyOccurrence +infixl 8 >.< +instance Show MyOccurrence where + show (MyOccurrence ((t,p),f) a) = + intercalate "." [show t,p,f] ++ "."++ show a + +dirOfOcc :: MyOccurrence -> Direction +dirOfOcc = snd . attr + +handOut :: (PLabel, FLabel) -> MyAttribute -> MyOccurrence +handOut p = (p >.<) . alab + +handAllOut :: (PLabel, FLabel) -> MyAttributes -> MyOccurrences +handAllOut p os = map (handOut p) os + +map2F :: (Ord a) => M.Map a [b] -> a -> [b] +map2F m a = case M.lookup a m of + Nothing -> [] + Just bs -> bs + +map2F' :: (Ord a) => M.Map a (S.Set b) -> a -> (S.Set b) +map2F' m a = case M.lookup a m of + Nothing -> S.empty + Just bs -> bs + +flipDir :: Direction -> Direction +flipDir Syn = Inh +flipDir Inh = Syn + +-- creates all pairs of elements such that no equal elements end up in a pair +-- and considering only one direction +pairs :: [a] -> [(a,a)] +pairs [] = [] +pairs (x:xs) = map ((,) x) xs ++ pairs xs + +toMyTy :: Type -> MyType +toMyTy (Haskell str) = TyLit str +toMyTy (NT id _ _ ) = TyData $ getName id +toMyTy Self = error "Type Self in phase 3" + +fromMyTy :: MyType -> Type +fromMyTy (TyLit str) = (Haskell str) +fromMyTy (TyData id) = NT (identifier id) [] False + +toMyAttr :: Direction -> MyType -> Attributes -> MyAttributes +toMyAttr d dty = M.foldrWithKey + (\ident ty as -> dty <.> (getName ident,d):as) [] + +completing :: FrGraph -> SchedRef s -> [Nt] -> ST s InterfaceRes +completing ids sched nts = do + ims <- forM nts $ completingN ids (fst sched) + let threads = (M.fromList ims) + writeSTRef (snd sched) threads + return $ threads + +completingN :: FrGraph -> AttrAssRef s -> Nt -> + ST s ((String, IM.IntMap [Vertex])) +completingN ids@(idsf, idst) schedA + (Nt nt_id _ _ inhs syns _) = do + schedS <- newSTRef IM.empty + let attrs = inhs ++ syns + dty = TyData nt_id + assign (attr,_,dAttr) = do + let succs = idsf A.! attr + assigned <- freeze schedA + when (isNothing $ assigned A.! attr) $ do + case IS.toList succs of + [] ->wrap_up attr(if Syn==dAttr then 1 else 2) + ss ->case selMax $ map (id&&&(assigned A.!)) ss of + Nothing -> return () + Just (a,mx) -> do + let dA | even mx = Inh + | otherwise = Syn + wrap_up attr (if dA == dAttr + then mx else mx+1) + wrap_up attr k = do + modifySTRef schedS (IM.insertWith (++) k [attr]) + writeArray schedA attr (Just k) + forM_ attrs assign + selMax :: [(Vertex, Maybe Int)] -> Maybe (Vertex, Int) + selMax [(v,mi)] = fmap ((,) v) mi + selMax (x:xs) = case x of + (a', Nothing) -> Nothing + (a', Just i') -> + case selMax xs of + Nothing -> Nothing + Just (a,i) -> + case compare i i' of + LT -> Just (a',i') + _ -> Just (a,i) + --make sure all are assigned + case attrs of + [] -> return (nt_id, IM.fromList [(1,[]),(2,[])]) + as -> forM_ as assign >> readSTRef schedS >>= return . ((,) nt_id) + +fetchEdges :: FrGraph -> InterfaceRes -> [Nt] -> ([Edge],[Edge]) +fetchEdges ids threads nts = + let ivdNs = map (fetchEdgesN ids threads) nts + in (concat *** concat) $ unzip ivdNs + +fetchEdgesN :: FrGraph -> InterfaceRes -> Nt + -> ([Edge],[Edge]) +fetchEdgesN (idsf, idst) threads + (Nt nt_id _ _ _ _ _) = + let sched = findWithErr threads "schedule err" nt_id + mx = if IM.null sched then 0 else fst $ IM.findMax sched + findK 0 = [] + findK k = (maybe [] id $ IM.lookup k sched) ++ findK (k-1) + ivd = [ (f,t) | k <- [2..mx] + , f <- maybe [] id $ IM.lookup k sched + , t <- findK (k-1)] + in (ivd, [ (f, t) | (f, t) <- ivd + , not $ IS.member t (idsf A.! f) ]) + +instance Show MyType where + show TyInt = "Int" + show TyBool = "Bool" + show TyString = "String" + show (TyData t) = t + show (TyLit t) = show t + show (TyArr a b) = show a ++ " -> (" ++ show b ++ ")" + show NoType = error "Trying to show NoType" + show AnyType = "AnyType" + +-- | Instance for Eq and Ord are required to make sure that AnyType +-- | Equals every other type in every other situation +instance Eq MyType where + TyInt == TyInt = True + TyBool == TyBool = True + TyString == TyString = True + TyData n == TyData n' = n == n' + TyLit ty == TyLit ty' = ty == ty' + TyArr l r == TyArr l' r' = l == l' && r == r' + NoType == _ = False + _ == NoType = False + AnyType == _ = True + _ == AnyType = True + _ == _ = False + +instance Ord MyType where + NoType `compare` _ = LT + _ `compare` NoType = GT + AnyType `compare` _ = EQ + _ `compare` AnyType = EQ + TyInt `compare` TyInt = EQ + TyInt `compare` _ = LT + TyBool `compare` TyInt = GT + TyBool `compare` TyBool = EQ + TyBool `compare` _ = LT + TyString `compare` TyInt = GT + TyString `compare` TyBool = GT + TyString `compare` TyString = EQ + TyString `compare` _ = LT + TyData _ `compare` TyInt = GT + TyData _ `compare` TyBool = GT + TyData _ `compare` TyString = GT + TyData a `compare` TyData b = compare a b + TyData _ `compare` _ = LT + TyLit a `compare` TyLit b = compare a b + TyLit _ `compare` TyArr _ _= LT + TyLit _ `compare` _ = GT + TyArr a a' `compare` TyArr b b' = + case compare a b of + LT -> LT + GT -> GT + EQ -> compare a' b' + TyArr _ _ `compare` _ = GT + diff --git a/src/LOAG/Graphs.hs b/src/LOAG/Graphs.hs new file mode 100644 --- /dev/null +++ b/src/LOAG/Graphs.hs @@ -0,0 +1,161 @@ +module LOAG.Graphs where + +import Control.Monad.Trans (lift, MonadTrans(..)) +import Control.Monad (forM, forM_) +import Control.Monad.ST +import Control.Monad.State +import CommonTypes +import Data.STRef +import Data.Maybe (catMaybes, isNothing, fromJust) +import Data.Tuple (swap) +import qualified Data.Array as A +import Data.Array.IArray (amap) +import qualified Data.IntMap as IM +import qualified Data.IntSet as IS +import qualified Data.Map as M +import qualified Data.Set as S +import Data.Array.MArray (mapArray) +import Data.Array.ST + +type Schedule = (A.Array Vertex (Maybe Int), A.Array Int [Vertex]) +type Vertex = Int +type Cycle = IS.IntSet +type Vertices = IS.IntSet +type Edge = (Vertex, Vertex) +type Edges = S.Set Edge +-- Maps that are suitable for Graphs (from 1 node to a set of nodes) +type Graph s = (DirGraphRef s, DirGraphRef s) +-- | Frozen version of a graph +type FrGraph = (DirGraph, DirGraph) +type DirGraph = A.Array Vertex Vertices +type DirGraphRef s = STArray s Vertex Vertices + +-- |---------------------------------------------------------------------- +-- | Functions for changing the state within AOAG +-- | possibly catching errors from creating cycles + +addEDs :: (MonadTrans m, MonadState s (m (ST s))) => Graph s -> + [Edge] -> (m (ST s)) (Maybe (Edge, Cycle)) +addEDs _ [] = return Nothing +addEDs edp (e:es) = do + res <- e `inserT` edp + case res of + Right _ -> addEDs edp es + Left c -> return $ Just (e,c) + +-- | Draws an edge from one node to another, by adding the latter to the +-- node set of the first +insErt :: (MonadTrans m, MonadState s (m (ST s))) => Edge -> Graph s -> + (m (ST s)) () +insErt (f, t) g@(ft,tf) = do + ts <- lift (readArray ft f) + fs <- lift (readArray tf t) + lift (writeArray ft f (t `IS.insert` ts)) + lift (writeArray tf t (f `IS.insert` fs)) + +removE :: (MonadTrans m, MonadState s (m (ST s))) => Edge -> Graph s -> + (m (ST s)) () +removE e@(f,t) g@(ft,tf) = do + ts <- lift (readArray ft f) + fs <- lift (readArray tf t) + lift (writeArray ft f (t `IS.delete` ts)) + lift (writeArray tf t (f `IS.delete` fs)) + + +-- | Revert an edge in the graph +revErt :: (MonadTrans m, MonadState s (m (ST s))) => Edge -> Graph s -> + (m (ST s)) () +revErt e g = do + present <- member e g + when present $ removE e g >> insErt (swap e) g + +-- | Assuming the given graph is already transitively closed, and +-- | not cyclic, insert an +-- | edge such that the graph maintains transitively closed. +-- | returns the cycle if this results in a cycle or returns a pair +-- | (graph, edges) if not. Where graph is the new Graph and +-- | edges represent the edges that were required for transitively +-- | closing the graph. +inserT :: (MonadTrans m, MonadState s (m (ST s))) => Edge -> Graph s -> + (m (ST s)) (Either Cycle [Edge]) +inserT e@(f, t) g@(gft,gtf) + | f == t = return $ Left $ IS.singleton f + | otherwise = do + present <- member e g + if present + then (return $ Right []) + else do + pointsToF <- lift (readArray gtf f) + pointsToT <- lift (readArray gtf t) + tPointsTo <- lift (readArray gft t) + let new2t = pointsToF IS.\\ pointsToT + -- extras from f connects all new nodes pointing to f with t + let extraF = IS.foldl' (\acc tf -> (tf,t) : acc) [] new2t + -- extras of t connects all nodes that will be pointing to t + -- in the new graph, with all the nodes t points to in the + -- current graph + all2tPointsTo <- lift (newSTRef []) + forM_ (IS.toList tPointsTo) $ \ft -> do + current <- lift (readSTRef all2tPointsTo) + existing <- lift (readArray gtf ft) + let new4ft = map (flip (,) ft) $ IS.toList $ + (f `IS.insert` pointsToF) IS.\\ existing + lift (writeSTRef all2tPointsTo $ current ++ new4ft) + + extraT <- lift (readSTRef all2tPointsTo) + -- the extras consists of extras from f and extras from t + -- both these extra sets dont contain edges if they are already + -- present in the old graph + let extra = extraF ++ extraT + mapM_ (`insErt` g) (e : extra) + -- the new graph contains a cycle if there is a self-edge + -- this cycle will contain both f and t + cyclic <- member (f,f) g + if cyclic + then do + cycle <- getCycle gft + return $ Left cycle + else return $ Right extra + + where + -- given that there is a cycle,all elements of this cycle are being + -- pointed at by f. However, not all elements that f points to are + -- part of the cycle. Only those that point back to f. + getCycle :: (MonadTrans m, MonadState s (m (ST s))) => + STArray s Vertex Vertices -> (m (ST s)) Cycle + getCycle gft = do + ts <- lift (readArray gft f) + mnodes <- forM (IS.toList ts) $ \t' -> do + fs' <- lift (readArray gft t') + if f `IS.member` fs' + then return $ Just t' + else return $ Nothing + return $ IS.fromList $ catMaybes mnodes + +-- | Check if a certain edge is part of a graph which means that, +-- | the receiving node must be in the node set of the sending +member :: (MonadTrans m, MonadState s (m (ST s))) => Edge -> Graph s -> + (m (ST s)) Bool +member (f, t) (ft, tf) = do + ts <- lift (readArray ft f) + return $ IS.member t ts + +-- | Check whether an edge is part of a frozen graph +fr_member :: FrGraph -> Edge -> Bool +fr_member (ft, tf) (f, t) = IS.member t (ft A.! f) + +-- | Flatten a graph, meaning that we transform this graph to +-- | a set of Edges by combining a sending node with all the +-- | receiving nodes in its node set +flatten :: (MonadTrans m, MonadState s (m (ST s))) => Graph s -> (m (ST s)) Edges +flatten (gft, _) = do + list <- lift (getAssocs gft) + return $ S.fromList $ concatMap + (\(f, ts) -> map ((,) f) $ IS.toList ts) list + +freeze_graph :: (MonadTrans m, MonadState s (m (ST s))) => + Graph s -> (m (ST s)) FrGraph +freeze_graph (mf, mt) = do + fr_f <- lift (freeze mf) + fr_t <- lift (freeze mt) + return (fr_f, fr_t) diff --git a/src/LOAG/Optimise.hs b/src/LOAG/Optimise.hs new file mode 100644 --- /dev/null +++ b/src/LOAG/Optimise.hs @@ -0,0 +1,300 @@ + +module LOAG.Optimise where + +import LOAG.Common +import LOAG.Graphs +import LOAG.Solver.MiniSat + +import Control.Arrow ((&&&)) +import Control.Monad (forM, forM_, when, foldM) +import Control.Monad.ST +import Data.Array.MArray +import Data.Array.IO +import Data.Function (on) +import qualified Data.IntMap as IM +import qualified Data.IntSet as IS +import qualified Data.Map as M +import Data.Maybe (fromJust, isJust) +import Data.List (intercalate, sort, sortBy) + +type Opts = [Opt] +data Opt= Smaller (Vertex) (Vertex) -- x < y + | Greater (Vertex) (Vertex) -- x > y + | AllSmaller (Vertex) Direction -- _ < x + | AllGreater (Vertex) Direction -- _ > x + | MinVisits + deriving (Ord, Eq) + +instance Show Opt where + show (Smaller f t) = show f ++ " --> " ++ show t + show (Greater f t) = show f ++ " <-- " ++ show t + show (AllSmaller f _) = " _ --> " ++ show f + show (AllGreater f _) = " _ <-- " ++ show f + show MinVisits = " Minimising #visits " + + +optimise :: Sat -> VarMap -> Opts -> (Int,Int) -> [Nt] -> InterfaceRes -> IO () +optimise sat varMap opts nbounds nts interfaces = do + let scheduler = newSchedule sat varMap nbounds + mapM_ (singleOpt sat varMap scheduler nts interfaces) (sort opts) + b <- satsolve sat [] + return () + +-- | Given a non-terminal and a current best schedule +-- return a new best schedule and whether the new schedule is truely new +type SchedulerNt = Nt -> IM.IntMap [Vertex] -> IO (Bool, IM.IntMap [Vertex]) +type Scheduler = IM.IntMap [Vertex] -> IO (Bool, IM.IntMap [Vertex]) + +singleOpt :: Sat -> VarMap -> SchedulerNt -> [Nt] -> InterfaceRes -> Opt -> + IO () +singleOpt sat varMap scheduler nts interfaces opt = do + success <- + case opt of + Smaller f t -> tryPair sat $ varOf f t + Greater f t -> tryPair sat $ varOf t f + AllSmaller f d -> trySingle sat False f d varMap + AllGreater f d -> trySingle sat True f d varMap + MinVisits -> do mapM_ (minPaths sat varMap scheduler interfaces) $ + sortNfilter weigh nts + return True + return () + where weigh (Nt _ _ _ is ss _) = size + where size = length is + length ss + varOf f t = case M.lookup (f,t) varMap of + Just v -> v + Nothing -> case M.lookup (t,f) varMap of + Just v -> varnot v + Nothing -> error "invalid optimisation.." + +sortNfilter :: (a -> Int) -> [a] -> [a] +sortNfilter f = + map fst . sortBy (on compare snd) . + filter (((/=) 0) . snd) . map (id &&& f) + +minPaths :: Sat -> VarMap -> SchedulerNt -> InterfaceRes -> Nt -> IO Bool +minPaths sat varMap scheduler interfaces tp@(Nt nt _ _ is ss _) = do + forM_ neckCs $ attemptGroup sat (scheduler tp) mym . map varnot + return True + where neckCs= map (\(_,es,b) -> map (uncurry (mvar b)) es) $ + bottlenecks mx mym + mvar b f t | b = varMap M.! (f,t) + | not b = varnot $ varMap M.! (t,f) + mym = interfaces M.! nt + mx | IM.null mym = 0 + | otherwise = fst $ IM.findMax mym + +bottlenecks :: Int -> IM.IntMap [Vertex] -> + [(((Int,[Vertex]),(Int,[Vertex])),[Edge],Bool)] +bottlenecks x shd = + sortNfilter cost $ pairs x + where pairs x | x <= 1 = [] + | x > 1 = let pair = ((x,maybe [] id $ IM.lookup x shd) + ,(x-1,maybe [] id$IM.lookup (x-1) shd)) + in (pair,edges pair,even x) : pairs (x-1) + cost (((p1,p1s),(p2,p2s)),es,_) = size + where size = length es + edges ((p1,p1s),(p2,p2s)) = [ (f,t) | f <- p1s, t <- p2s ] + +-- | get all combinations of partitions from different `directions' +-- ordered by distance (shortest paths first) +edgeCombs :: Int -> IM.IntMap [Vertex] -> [(Int,Int)] +edgeCombs x shd = + sortBy (on compare cost) $ + concat $ + takeWhile (not . null) $ + map (\(n,es) -> filter ((>0) . snd) + (map (\(f,t) -> (f+n,t+n)) es)) $ + zip [-0,-1..] $ + repeat (map ((,) x) [x-1,x-3..1]) + where cost (x1,x2) = length $ findK (x1 -1) + where findK n | n < x2 = [] + | n >= x2 = (shd IM.! n) ++ findK (n-2) + +tryPair :: Sat -> MyVar -> IO Bool +tryPair sat p = do + b <- satsolve sat [p] + if b then addClause sat [p] + else return False + +attemptGroup :: Sat -> Scheduler -> IM.IntMap [Vertex] -> [MyVar] -> + IO (IM.IntMap [Vertex]) +attemptGroup sat scheduler interfaces = + tryGroup sat scheduler interfaces . filter notSet + where notSet (Var _) = True + notSet (VarNot v) = notSet v + notSet _ = False + +tryGroup :: Sat -> Scheduler -> IM.IntMap [Vertex] -> [MyVar] -> + IO (IM.IntMap [Vertex]) +tryGroup _ _ interfaces [] = return interfaces +tryGroup sat scheduler interfaces ps = do + xs <- mapM (const (newLit sat)) ps + mapM (\(a,r) -> addClause sat [varnot a, r]) $ zip xs ps + b <- satsolve sat xs + let success = assertVars sat xs + fail = assertVars sat (map varnot (xs++ps)) >> satsolve sat [] + if b then do (improved, sched) <- scheduler interfaces + if improved + then success >> return sched + else fail >> return interfaces + else fail >> return interfaces + +assertVars :: Sat -> [MyVar] -> IO () +assertVars sat vars = do bs <- mapM (addClause sat . (:[])) vars + return () + +trySingle :: Sat -> Bool -> Vertex -> Direction -> VarMap -> IO Bool +trySingle sat des f dir varMap = do + vars <- tryExtreme sat des literals + assertVars sat vars + return True + where literals = M.foldWithKey select [] varMap + select k a b | fst k == f = a : b --inh + | snd k == f = varnot a : b --syn + | otherwise = b + +tryExtreme :: Sat -> Bool -> [MyVar] -> IO [MyVar] +tryExtreme sat des xs = + do a <- newLit sat + switch <- newLit sat + let try xs = + do --putStrLn ("currently, " ++ show (length xs) ++ " literals") + let assertOne | des = map varnot (a : xs) + | otherwise = varnot a : xs + addClause sat assertOne --"if a, then one of xs must be ~des" + b <- satsolve sat [a] + if b then + do xbs <- sequence [ do v <- value sat x + return (x,v) + | x <- xs + ] + sequence_ [ do let desx | des = x + | otherwise = varnot x + addClause sat [varnot a, desx] + addClause sat [varnot switch, desx] + | (x,b) <- xbs, b /= Just des ] + try [ x | (x,Just des) <- xbs ] + else do addClause sat [varnot a] + return [switch] + in try xs + +-- | Recalculate interface based on SAT and compare with a given one +newSchedule :: Sat -> VarMap -> (Int,Int) -> Nt -> IM.IntMap [Vertex] -> + IO (Bool, IM.IntMap [Vertex]) +newSchedule sat varMap nbounds tp@(Nt nt _ _ inhs outs _ ) sched = do + idsf <- newArray nbounds IS.empty :: IO (IOArray Vertex Vertices) + idst <- newArray nbounds IS.empty :: IO (IOArray Vertex Vertices) + let ids = (idsf,idst) + sequence_ [ do v <- value sat pred + case v of + Nothing -> error "no val" + Just True -> addEdges (i,s) ids + Just False-> addEdges (s,i) ids + | (i,ios,_) <- inhs + , (s,sos,_) <- outs + , let pred = varMap M.! (i,s) + ] + f_idsf <- freeze idsf + f_idst <- freeze idst + let (_,newinterface) = runST $ do schedA <- newArray nbounds Nothing + completingN (f_idsf,f_idst) schedA tp + newmx | IM.null newinterface = 0 + | otherwise = fst $ IM.findMax newinterface + oldmx | IM.null sched = 0 + | otherwise = fst $ IM.findMax sched + newsched | newmx < oldmx = newinterface + | otherwise = sched + return $ (newmx < oldmx, newsched) + where addEdges (f,t) (idsf,idst) = do + modifyArray idsf f (t `IS.insert`) + modifyArray idst t (f `IS.insert`) + +-- | count the (max, avg, total) number of visits +getVisCount :: [Nt] -> InterfaceRes -> VisCount +getVisCount nts interfaces = + (mx, tot, (fromIntegral tot) / (fromIntegral $ length nts)) + where count (mx,tot) (Nt nt _ _ _ _ _) = (max mx k,tot + k) + where m = interfaces M.! nt + k | IM.null m = 0 + | otherwise = ((fst $ IM.findMax m) + 1) `div` 2 + (mx, tot) = foldl count (0,0) nts +--- minimisation functions +------------------------------------------------------------------------------- + +globalMinimum :: Sat -> Bool -> [MyVar] -> IO [MyVar] +globalMinimum sat des xs = + do ys <- sort sat xs + let mini (i,j) | i >= j = return [] + mini (i,j) = do putStrLn ("trying " ++ show (i,j)) + b <- satsolve sat [varnot (ys !! k)] + if b then mini (k+1,j) + else mini (i,k) + where + k = (i+j) `div` 2 + in mini (0,length ys) + xbs <- sequence [ do v <- value sat x + return (x,v) + | x <- xs + ] + return [ x | (x,Just True) <- xbs ] + where + sort sat [] = do return [] + sort sat [x] = do return [x] + sort sat xs = do as <- sort sat (take k xs) + bs <- sort sat (drop k xs) + map fromJust `fmap` merge (map Just as) (map Just bs) + where + k = length xs `div` 2 + + merge2 Nothing b = return (b, Nothing) + merge2 a Nothing = return (a, Nothing) + merge2 (Just x) (Just y) = + do a <- newLit sat + b <- newLit sat + addClause sat [varnot x, b] -- x => b + addClause sat [varnot y, b] -- y => b + addClause sat [varnot x, varnot y, a] -- x => ~y || a + addClause sat [x, varnot a] -- ~x => ~a + addClause sat [y, varnot a] -- ~y => ~a + addClause sat [x, y, varnot b] -- ~x => y || ~b + return (Just a,Just b) + + merge [] bs = return bs + merge as [] = return as + merge [a] [b] = (\(a,b) -> [a,b]) `fmap` merge2 a b + merge as bs = take (a+b) `fmap` merge' (as ++ xas) (bs ++ xbs) + where + a = length as + b = length bs + m = a `max` b + n = if even m then m else m+1 + xas = replicate (n-a) Nothing + xbs = replicate (n-b) Nothing + + -- pre: as and bs have the same, even length + merge' as bs = + do xs <- merge eas ebs + ys <- merge oas obs + let x:xys = weave xs ys + xys' <- sequence [ merge2 a b | (a,b) <- pairs xys ] + return (x : unpairs xys' ++ [last xys]) + where + (eas,oas) = evenOdds as + (ebs,obs) = evenOdds bs + + evenOdds [] = ([], []) + evenOdds [x] = ([x], []) + evenOdds (x:y:xs) = (x:es,y:os) + where + (es,os) = evenOdds xs + + pairs (x:y:xs) = (x,y) : pairs xs + pairs _ = [] + + unpairs ((x,y):xys) = x : y : unpairs xys + unpairs [] = [] + + weave (x:xs) (y:ys) = x : y : weave xs ys + weave xs ys = xs ++ ys + +------------------------------------------------------------------------------ diff --git a/src/LOAG/Result.hs b/src/LOAG/Result.hs new file mode 100644 --- /dev/null +++ b/src/LOAG/Result.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE FlexibleInstances #-} + +-- Module for containing results in LOAG tests +module LOAG.Result where + +import Control.Applicative +import Control.Monad (liftM, ap, MonadPlus(..)) +import Control.Monad.Trans (lift, MonadTrans(..)) +import Control.Monad.State (MonadState(..)) +import Control.Monad.ST +import ErrorMessages as Err + +import LOAG.Graphs + +type LOAG s a = ResultT (ST s) a + +data Result a = Give a + -- the edge that caused the cyclep of ctype + | Cycle Edge Cycle CType + | Limit + | NotLOAG + deriving (Show) + +fromGive :: Result a -> a +fromGive (Give a) = a +fromGive _ = error "fromGive" + +data CType = T1 | T2 + | T3 [Edge] -- completing edges from which to select candidates + deriving (Show) +-- | Inspired by ErrorT +newtype ResultT m a = Result { runResult :: m (Result a) } + +instance Monad m => Functor (ResultT m) where + fmap = liftM + +instance Monad m => Applicative (ResultT m) where + pure = return + (<*>) = ap + +instance (Monad m) => Monad (ResultT m) where + return = Result . return . Give + (>>=) rt f = Result $ do + ma <- runResult rt + case ma of + Give a -> runResult (f a) + Cycle e c t -> return $ Cycle e c t + Limit -> return $ Limit + NotLOAG -> return $ NotLOAG + +instance MonadTrans ResultT where + lift m = Result $ m >>= return . Give +instance MonadState s (ResultT (ST s)) where + get = get + put = put + +instance Monad m => Alternative (ResultT m) where + (<|>) = mplus + empty = mzero + +instance (Monad m) => MonadPlus (ResultT m) where + mzero = Result $ return NotLOAG + mplus a b = Result $ do + ma <- runResult a + case ma of + Give a -> return $ Give a + f -> do mb <- runResult b + case mb of + Give b -> return $ Give b + _ -> return f + +-- | Return an error (from detecting a cycle) in the ResultT monad +throwCycle :: (Monad m) => Edge -> Cycle -> CType -> ResultT m a +throwCycle e c t = Result $ return $ Cycle e c t + +throwNotLOAG :: (Monad m) => ResultT m a +throwNotLOAG = Result $ return NotLOAG diff --git a/src/LOAG/Solver/MiniSat.hs b/src/LOAG/Solver/MiniSat.hs new file mode 100644 --- /dev/null +++ b/src/LOAG/Solver/MiniSat.hs @@ -0,0 +1,94 @@ + +module LOAG.Solver.MiniSat ( + newSolvable,-- IO SatContainer + newLit, -- Sat -> IO MyVar + satValues, -- Sat -> IO (Int, Int) + addClause, -- Sat -> [MyVar] -> IO () + satsolve, -- Sat -> IO Bool + value, -- Sat -> IO (Maybe Bool) + fixed, -- Sat -> IO Bool + MyVar(..), + Sat, + varnot, + VarMap, + Mini.conflict + ) where + +import LOAG.Graphs +import Control.Monad +import Data.Maybe +import qualified Data.Map as M +import qualified MiniSat as Mini + +type Sat = Mini.Solver +type VarMap = M.Map Edge MyVar + +data MyVar = Var Mini.Lit + | VarTrue + | VarFalse + | VarNot MyVar + deriving (Show, Eq) + +varnot :: MyVar -> MyVar +varnot v@(Var i) = Var (Mini.neg i) +varnot (VarNot v)= v +varnot VarFalse = VarTrue +varnot VarTrue = VarFalse + + +newSolvable :: IO Mini.Solver +newSolvable = do sat <- Mini.newSolver + Mini.eliminate sat True + return sat + +newLit :: Sat -> IO MyVar +newLit sat = + do p <- Mini.newLit sat + return (Var (Mini.neg p)) + +satValues :: Sat -> IO (Int,Int) +satValues sat = + do v <- Mini.minisat_num_vars sat + p <- Mini.minisat_num_clauses sat + return (v,p) + +addClause :: Sat -> [MyVar] -> IO Bool +addClause sat [] = return True +addClause sat es = do + if satisfied + then return True + else case fes of + [] -> error "unsatisfiable" + fes -> Mini.addClause sat $ map toMini fes + where + satisfied = any (True ==?) es + fes = filter (not . (False ==?)) es + b ==? v = case v of + VarTrue -> b + VarFalse -> not b + _ -> False + toMini :: MyVar -> Mini.Lit + toMini (Var v) = v + toMini (VarNot v) = Mini.neg (toMini v) + _ = error "incorrect clause filtering" + +satsolve :: Sat -> [MyVar] -> IO Bool +satsolve sat = Mini.solve sat . map extract + +extract :: MyVar -> Mini.Lit +extract VarTrue = error "cannot extract True" +extract VarFalse = error "cannot extract False" +extract (VarNot v) = Mini.neg (extract v) +extract (Var l) = l + +value :: Sat -> MyVar -> IO (Maybe Bool) +value _ VarTrue = return $ Just True +value _ VarFalse = return $ Just False +value sat (VarNot v) = value sat v >>= return . fmap not +value sat (Var v) = Mini.modelValue sat v + +fixed :: Sat -> MyVar -> IO Bool +fixed _ VarTrue = return $ True +fixed _ VarFalse = return $ True +fixed sat (VarNot v)= fixed sat v +fixed sat (Var l) = Mini.value sat l >>= return . isJust diff --git a/uuagc.cabal b/uuagc.cabal --- a/uuagc.cabal +++ b/uuagc.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.8 build-type: Custom name: uuagc -version: 0.9.50.2 +version: 0.9.51 license: BSD3 license-file: LICENSE maintainer: Jeroen Bransen @@ -25,17 +25,26 @@ default: False manual: True +flag with-loag + description: Use MiniSat as external SAT-solver to schedule all Linear Ordered AGs + default: False + manual: True + + executable uuagc build-depends: uuagc-cabal >= 1.0.2.0 build-depends: base >= 4, base < 5 -- Self dependency, depend on library below - build-depends: uuagc == 0.9.50.2 + build-depends: uuagc == 0.9.51 main-is: Main.hs hs-source-dirs: src-main library build-depends: uuagc-cabal >= 1.0.2.0 build-depends: base >= 4, base < 5, ghc-prim >= 0.2.0.0 + if flag(with-loag) + build-depends: minisat + cpp-options: -DWITH_LOAG build-depends: containers >= 0.3, directory >= 1.0.1.1, array >= 0.3.0.1 build-depends: uulib >= 0.9.14, mtl >= 1.1.1.1 build-depends: haskell-src-exts >= 1.11.1 @@ -100,3 +109,12 @@ , ExecutionPlan2Hs , ExecutionPlan2Clean , ExecutionPlan2Caml + , LOAG.AOAG + , LOAG.Chordal + , LOAG.Common + , LOAG.Graphs + , LOAG.Order + , LOAG.Rep + , LOAG.Result + if flag(with-loag) + other-modules: LOAG.Solver.MiniSat, LOAG.Optimise diff --git a/uuagc_options b/uuagc_options --- a/uuagc_options +++ b/uuagc_options @@ -37,6 +37,14 @@ file: "src-ag/ExecutionPlan.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell +file: "src-ag/LOAG/Order.ag" +options: module, pretty, checkParseHaskell, self, wrappers, signatures, catas, semfuns, genlinepragmas, kennedywarren + +file: "src-ag/LOAG/Prepare.ag" +options: module, pretty, checkParseHaskell, self, wrappers, signatures, catas, semfuns, genlinepragmas, kennedywarren + +file: "src-ag/LOAG/Rep.ag" +options: module, pretty, checkParseHaskell, self, datarecords, data, optimize file: "src-ag/Macro.ag" options: module, pretty, data, genlinepragmas, checkParseHaskell