diff --git a/src-derived/ExecutionPlan.hs b/src-derived/ExecutionPlan.hs new file mode 100644 --- /dev/null +++ b/src-derived/ExecutionPlan.hs @@ -0,0 +1,148 @@ + + +-- UUAGC 0.9.38.2 (ExecutionPlan.ag) +module ExecutionPlan where +{-# LINE 2 "ExecutionPlan.ag" #-} + +-- VisitSyntax.ag imports +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes + +import qualified Data.Set as Set +{-# LINE 14 "../src-derived/ExecutionPlan.hs" #-} +-- EChild ------------------------------------------------------ +{- + alternatives: + alternative EChild: + child name : {Identifier} + child tp : {Type} + child virtual : {Maybe (Maybe Type)} +-} +data EChild = EChild (Identifier) (Type) ((Maybe (Maybe Type))) +-- EChildren --------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : EChild + child tl : EChildren + alternative Nil: +-} +type EChildren = [EChild ] +-- ENonterminal ------------------------------------------------ +{- + alternatives: + alternative ENonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child initial : {StateIdentifier} + child initialv : {Maybe VisitIdentifier} + child prods : EProductions +-} +data ENonterminal = ENonterminal (NontermIdent) (([Identifier])) (StateIdentifier) ((Maybe VisitIdentifier)) (EProductions ) +-- ENonterminals ----------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : ENonterminal + child tl : ENonterminals + alternative Nil: +-} +type ENonterminals = [ENonterminal ] +-- EProduction ------------------------------------------------- +{- + alternatives: + alternative EProduction: + child con : {ConstructorIdent} + child rules : ERules + child children : EChildren + child visits : Visits +-} +data EProduction = EProduction (ConstructorIdent) (ERules ) (EChildren ) (Visits ) +-- EProductions ------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : EProduction + child tl : EProductions + alternative Nil: +-} +type EProductions = [EProduction ] +-- ERule ------------------------------------------------------- +{- + alternatives: + alternative ERule: + child name : {Identifier} + child pattern : {Pattern} + child rhs : {Expression} + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} +-} +data ERule = ERule (Identifier) (Pattern) (Expression) (Bool) (String) (Bool) +-- ERules ------------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : ERule + child tl : ERules + alternative Nil: +-} +type ERules = [ERule ] +-- ExecutionPlan ----------------------------------------------- +{- + alternatives: + alternative ExecutionPlan: + child nonts : ENonterminals + child typeSyns : {TypeSyns} + child wrappers : {Set.Set NontermIdent} +-} +data ExecutionPlan = ExecutionPlan (ENonterminals ) (TypeSyns) ((Set.Set NontermIdent)) +-- Visit ------------------------------------------------------- +{- + alternatives: + alternative Visit: + child ident : {VisitIdentifier} + child from : {StateIdentifier} + child to : {StateIdentifier} + child inh : {Set.Set Identifier} + child syn : {Set.Set Identifier} + child steps : VisitSteps +-} +data Visit = Visit (VisitIdentifier) (StateIdentifier) (StateIdentifier) ((Set.Set Identifier)) ((Set.Set Identifier)) (VisitSteps ) +-- VisitStep --------------------------------------------------- +{- + alternatives: + alternative ChildIntro: + child child : {Identifier} + alternative ChildVisit: + child child : {Identifier} + child nonterm : {NontermIdent} + child visit : {VisitIdentifier} + alternative Sem: + child name : {Identifier} + alternative Sim: + child steps : VisitSteps +-} +data VisitStep = ChildIntro (Identifier) + | ChildVisit (Identifier) (NontermIdent) (VisitIdentifier) + | Sem (Identifier) + | Sim (VisitSteps ) +-- VisitSteps -------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : VisitStep + child tl : VisitSteps + alternative Nil: +-} +type VisitSteps = [VisitStep ] +-- Visits ------------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : Visit + child tl : Visits + alternative Nil: +-} +type Visits = [Visit ] diff --git a/src-derived/ExecutionPlan2Hs.hs b/src-derived/ExecutionPlan2Hs.hs new file mode 100644 --- /dev/null +++ b/src-derived/ExecutionPlan2Hs.hs @@ -0,0 +1,3717 @@ + + +-- UUAGC 0.9.38.2 (ExecutionPlan2Hs.ag) +module ExecutionPlan2Hs where +{-# LINE 7 "ExecutionPlan2Hs.ag" #-} + +import ExecutionPlan +import Pretty +import PPUtil +import Options +import Data.Maybe +import Debug.Trace + +import TokenDef +import HsToken + +import qualified Data.Set as Set +import qualified Data.Map as Map +{-# LINE 20 "../src-derived/ExecutionPlan2Hs.hs" #-} + +{-# LINE 2 "./ExecutionPlan.ag" #-} + +-- VisitSyntax.ag imports +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import CommonTypes + +import qualified Data.Set as Set +{-# LINE 30 "../src-derived/ExecutionPlan2Hs.hs" #-} + +{-# LINE 2 "./Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 37 "../src-derived/ExecutionPlan2Hs.hs" #-} + +{-# LINE 2 "./Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 43 "../src-derived/ExecutionPlan2Hs.hs" #-} + +{-# LINE 2 "./HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 49 "../src-derived/ExecutionPlan2Hs.hs" #-} +{-# LINE 393 "ExecutionPlan2Hs.ag" #-} + +uwSetUnion :: (Ord a, Ord b) => Map.Map a (Set.Set b) -> Map.Map a (Set.Set b) -> Map.Map a (Set.Set b) +uwSetUnion = Map.unionWith Set.union +{-# LINE 54 "../src-derived/ExecutionPlan2Hs.hs" #-} +-- EChild ------------------------------------------------------ +{- + visit 0: + inherited attribute: + nt : NontermIdent + synthesized attributes: + argnames : PP_Doc + argnamesw : PP_Doc + argtps : PP_Doc + childintros : Map.Map Identifier PP_Doc + datatype : PP_Doc + terminaldefs : Set.Set String + alternatives: + alternative EChild: + child name : {Identifier} + child tp : {Type} + child virtual : {Maybe (Maybe Type)} + visit 0: + local argnames : _ +-} +-- cata +sem_EChild :: EChild -> + T_EChild +sem_EChild (EChild _name _tp _virtual ) = + (sem_EChild_EChild _name _tp _virtual ) +-- semantic domain +newtype T_EChild = T_EChild (NontermIdent -> + ( ( PP_Doc ),( PP_Doc ),( PP_Doc ),(Map.Map Identifier PP_Doc),PP_Doc,(Set.Set String))) +data Inh_EChild = Inh_EChild {nt_Inh_EChild :: NontermIdent} +data Syn_EChild = Syn_EChild {argnames_Syn_EChild :: ( PP_Doc ),argnamesw_Syn_EChild :: ( PP_Doc ),argtps_Syn_EChild :: ( PP_Doc ),childintros_Syn_EChild :: (Map.Map Identifier PP_Doc),datatype_Syn_EChild :: PP_Doc,terminaldefs_Syn_EChild :: (Set.Set String)} +wrap_EChild :: T_EChild -> + Inh_EChild -> + Syn_EChild +wrap_EChild (T_EChild sem ) (Inh_EChild _lhsInt ) = + (let ( _lhsOargnames,_lhsOargnamesw,_lhsOargtps,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs) = sem _lhsInt + in (Syn_EChild _lhsOargnames _lhsOargnamesw _lhsOargtps _lhsOchildintros _lhsOdatatype _lhsOterminaldefs )) +sem_EChild_EChild :: Identifier -> + Type -> + (Maybe (Maybe Type)) -> + T_EChild +sem_EChild_EChild name_ tp_ virtual_ = + (T_EChild (\ _lhsInt -> + (let _lhsOdatatype :: PP_Doc + _lhsOargnamesw :: ( PP_Doc ) + _lhsOargtps :: ( PP_Doc ) + _lhsOchildintros :: (Map.Map Identifier PP_Doc) + _lhsOterminaldefs :: (Set.Set String) + _lhsOargnames :: ( PP_Doc ) + -- "ExecutionPlan2Hs.ag"(line 90, column 12) + _lhsOdatatype = + ({-# LINE 90 "ExecutionPlan2Hs.ag" #-} + if isJust virtual_ + then empty + else pp $ typeToHaskellString (Just _lhsInt) [] tp_ + {-# LINE 109 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 112, column 12) + _lhsOargnamesw = + ({-# LINE 112 "ExecutionPlan2Hs.ag" #-} + if isJust virtual_ + then empty + else if isNonterminal tp_ + then "(" >#< "sem_" >|< extractNonterminal tp_ >#< "field_" >|< name_ >#< ")" + else text $ locname name_ + {-# LINE 119 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 256, column 12) + _lhsOargtps = + ({-# LINE 256 "ExecutionPlan2Hs.ag" #-} + if isJust virtual_ + then empty + else if isNonterminal tp_ + then ("T_" >|< extractNonterminal tp_) >#< "->" + else (text $ show tp_) >#< "->" + {-# LINE 129 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 261, column 12) + _argnames = + ({-# LINE 261 "ExecutionPlan2Hs.ag" #-} + if isJust virtual_ + then empty + else if isNonterminal tp_ + then "field_" >|< name_ + else text $ locname name_ + {-# LINE 139 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 327, column 12) + _lhsOchildintros = + ({-# LINE 327 "ExecutionPlan2Hs.ag" #-} + Map.singleton name_ $ locname name_ >#< "<-" >#< "return" >#< "$" >#< + if isJust virtual_ + then "sem_" >|< extractNonterminal tp_ >#< instname name_ + else "field_" >|< name_ + {-# LINE 148 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 404, column 12) + _lhsOterminaldefs = + ({-# LINE 404 "ExecutionPlan2Hs.ag" #-} + if isJust virtual_ || isNonterminal tp_ + then Set.empty + else Set.singleton $ locname name_ + {-# LINE 156 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (from local) + _lhsOargnames = + ({-# LINE 251 "ExecutionPlan2Hs.ag" #-} + _argnames + {-# LINE 162 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOargnames,_lhsOargnamesw,_lhsOargtps,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs))) ) +-- EChildren --------------------------------------------------- +{- + visit 0: + inherited attribute: + nt : NontermIdent + synthesized attributes: + argnames : [PP_Doc] + argnamesw : [PP_Doc] + argtps : [PP_Doc] + childintros : Map.Map Identifier PP_Doc + datatype : [PP_Doc] + terminaldefs : Set.Set String + alternatives: + alternative Cons: + child hd : EChild + child tl : EChildren + alternative Nil: +-} +-- cata +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 (NontermIdent -> + ( ( [PP_Doc] ),([PP_Doc]),( [PP_Doc] ),(Map.Map Identifier PP_Doc),([PP_Doc]),(Set.Set String))) +data Inh_EChildren = Inh_EChildren {nt_Inh_EChildren :: NontermIdent} +data Syn_EChildren = Syn_EChildren {argnames_Syn_EChildren :: ( [PP_Doc] ),argnamesw_Syn_EChildren :: ([PP_Doc]),argtps_Syn_EChildren :: ( [PP_Doc] ),childintros_Syn_EChildren :: (Map.Map Identifier PP_Doc),datatype_Syn_EChildren :: ([PP_Doc]),terminaldefs_Syn_EChildren :: (Set.Set String)} +wrap_EChildren :: T_EChildren -> + Inh_EChildren -> + Syn_EChildren +wrap_EChildren (T_EChildren sem ) (Inh_EChildren _lhsInt ) = + (let ( _lhsOargnames,_lhsOargnamesw,_lhsOargtps,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs) = sem _lhsInt + in (Syn_EChildren _lhsOargnames _lhsOargnamesw _lhsOargtps _lhsOchildintros _lhsOdatatype _lhsOterminaldefs )) +sem_EChildren_Cons :: T_EChild -> + T_EChildren -> + T_EChildren +sem_EChildren_Cons (T_EChild hd_ ) (T_EChildren tl_ ) = + (T_EChildren (\ _lhsInt -> + (let _lhsOargnames :: ( [PP_Doc] ) + _lhsOargnamesw :: ([PP_Doc]) + _lhsOargtps :: ( [PP_Doc] ) + _lhsOchildintros :: (Map.Map Identifier PP_Doc) + _lhsOdatatype :: ([PP_Doc]) + _lhsOterminaldefs :: (Set.Set String) + _hdOnt :: NontermIdent + _tlOnt :: NontermIdent + _hdIargnames :: ( PP_Doc ) + _hdIargnamesw :: ( PP_Doc ) + _hdIargtps :: ( PP_Doc ) + _hdIchildintros :: (Map.Map Identifier PP_Doc) + _hdIdatatype :: PP_Doc + _hdIterminaldefs :: (Set.Set String) + _tlIargnames :: ( [PP_Doc] ) + _tlIargnamesw :: ([PP_Doc]) + _tlIargtps :: ( [PP_Doc] ) + _tlIchildintros :: (Map.Map Identifier PP_Doc) + _tlIdatatype :: ([PP_Doc]) + _tlIterminaldefs :: (Set.Set String) + -- use rule "ExecutionPlan2Hs.ag"(line 253, column 31) + _lhsOargnames = + ({-# LINE 253 "ExecutionPlan2Hs.ag" #-} + _hdIargnames : _tlIargnames + {-# LINE 228 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 109, column 32) + _lhsOargnamesw = + ({-# LINE 109 "ExecutionPlan2Hs.ag" #-} + _hdIargnamesw : _tlIargnamesw + {-# LINE 234 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 252, column 31) + _lhsOargtps = + ({-# LINE 252 "ExecutionPlan2Hs.ag" #-} + _hdIargtps : _tlIargtps + {-# LINE 240 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 318, column 41) + _lhsOchildintros = + ({-# LINE 318 "ExecutionPlan2Hs.ag" #-} + _hdIchildintros `Map.union` _tlIchildintros + {-# LINE 246 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 87, column 51) + _lhsOdatatype = + ({-# LINE 87 "ExecutionPlan2Hs.ag" #-} + _hdIdatatype : _tlIdatatype + {-# LINE 252 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 401, column 42) + _lhsOterminaldefs = + ({-# LINE 401 "ExecutionPlan2Hs.ag" #-} + _hdIterminaldefs `Set.union` _tlIterminaldefs + {-# LINE 258 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 86 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 264 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 87 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 270 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdIargnames,_hdIargnamesw,_hdIargtps,_hdIchildintros,_hdIdatatype,_hdIterminaldefs) = + hd_ _hdOnt + ( _tlIargnames,_tlIargnamesw,_tlIargtps,_tlIchildintros,_tlIdatatype,_tlIterminaldefs) = + tl_ _tlOnt + in ( _lhsOargnames,_lhsOargnamesw,_lhsOargtps,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs))) ) +sem_EChildren_Nil :: T_EChildren +sem_EChildren_Nil = + (T_EChildren (\ _lhsInt -> + (let _lhsOargnames :: ( [PP_Doc] ) + _lhsOargnamesw :: ([PP_Doc]) + _lhsOargtps :: ( [PP_Doc] ) + _lhsOchildintros :: (Map.Map Identifier PP_Doc) + _lhsOdatatype :: ([PP_Doc]) + _lhsOterminaldefs :: (Set.Set String) + -- use rule "ExecutionPlan2Hs.ag"(line 253, column 31) + _lhsOargnames = + ({-# LINE 253 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 290 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 109, column 32) + _lhsOargnamesw = + ({-# LINE 109 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 296 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 252, column 31) + _lhsOargtps = + ({-# LINE 252 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 302 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 318, column 41) + _lhsOchildintros = + ({-# LINE 318 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 308 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 87, column 51) + _lhsOdatatype = + ({-# LINE 87 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 314 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 401, column 42) + _lhsOterminaldefs = + ({-# LINE 401 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 320 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOargnames,_lhsOargnamesw,_lhsOargtps,_lhsOchildintros,_lhsOdatatype,_lhsOterminaldefs))) ) +-- ENonterminal ------------------------------------------------ +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + inhmap : Map.Map NontermIdent Attributes + options : Options + synmap : Map.Map NontermIdent Attributes + typeSyns : TypeSyns + wrappers : Set.Set NontermIdent + synthesized attributes: + childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + debugoutput : PP_Doc + visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + visituses : Map.Map VisitIdentifier (Set.Set Identifier) + alternatives: + alternative ENonterminal: + child nt : {NontermIdent} + child params : {[Identifier]} + child initial : {StateIdentifier} + child initialv : {Maybe VisitIdentifier} + child prods : EProductions + visit 0: + local datatype : _ + local sem_nt : _ + local outedges : _ + local inedges : _ + local allstates : _ + local t_init : _ + local t_states : _ + local k_states : _ + local wr_inh : _ + local wr_syn : _ + local genwrap : _ + local wr_inhs : _ + local wr_syns : _ + local inhlist : _ + local synlist : _ + local wrapper : _ +-} +-- cata +sem_ENonterminal :: ENonterminal -> + T_ENonterminal +sem_ENonterminal (ENonterminal _nt _params _initial _initialv _prods ) = + (sem_ENonterminal_ENonterminal _nt _params _initial _initialv (sem_EProductions _prods ) ) +-- semantic domain +newtype T_ENonterminal = T_ENonterminal ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map NontermIdent Attributes) -> + Options -> + (Map.Map NontermIdent Attributes) -> + TypeSyns -> + (Set.Set NontermIdent) -> + ( (Map.Map VisitIdentifier (Identifier -> PP_Doc)),PP_Doc,(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) +data Inh_ENonterminal = Inh_ENonterminal {allchildvisit_Inh_ENonterminal :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),avisitdefs_Inh_ENonterminal :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_ENonterminal :: (Map.Map VisitIdentifier (Set.Set Identifier)),inhmap_Inh_ENonterminal :: (Map.Map NontermIdent Attributes),options_Inh_ENonterminal :: Options,synmap_Inh_ENonterminal :: (Map.Map NontermIdent Attributes),typeSyns_Inh_ENonterminal :: TypeSyns,wrappers_Inh_ENonterminal :: (Set.Set NontermIdent)} +data Syn_ENonterminal = Syn_ENonterminal {childvisit_Syn_ENonterminal :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),debugoutput_Syn_ENonterminal :: PP_Doc,visitdefs_Syn_ENonterminal :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_ENonterminal :: (Map.Map VisitIdentifier (Set.Set Identifier))} +wrap_ENonterminal :: T_ENonterminal -> + Inh_ENonterminal -> + Syn_ENonterminal +wrap_ENonterminal (T_ENonterminal sem ) (Inh_ENonterminal _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers ) = + (let ( _lhsOchildvisit,_lhsOdebugoutput,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers + in (Syn_ENonterminal _lhsOchildvisit _lhsOdebugoutput _lhsOvisitdefs _lhsOvisituses )) +sem_ENonterminal_ENonterminal :: NontermIdent -> + ([Identifier]) -> + StateIdentifier -> + (Maybe VisitIdentifier) -> + T_EProductions -> + T_ENonterminal +sem_ENonterminal_ENonterminal nt_ params_ initial_ initialv_ (T_EProductions prods_ ) = + (T_ENonterminal (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIoptions + _lhsIsynmap + _lhsItypeSyns + _lhsIwrappers -> + (let _prodsOrename :: Bool + _lhsOdebugoutput :: PP_Doc + _prodsOinhmap :: Attributes + _prodsOsynmap :: Attributes + _prodsOnt :: NontermIdent + _prodsOinitial :: StateIdentifier + _prodsOallstates :: (Set.Set StateIdentifier) + _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _prodsOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _prodsOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _prodsOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _prodsIallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _prodsIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _prodsIdatatype :: ([PP_Doc]) + _prodsIsem_nt :: PP_Doc + _prodsIsem_prod :: PP_Doc + _prodsIt_visits :: PP_Doc + _prodsIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _prodsIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- "ExecutionPlan2Hs.ag"(line 34, column 18) + _prodsOrename = + ({-# LINE 34 "ExecutionPlan2Hs.ag" #-} + rename _lhsIoptions + {-# LINE 428 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 54, column 18) + _lhsOdebugoutput = + ({-# LINE 54 "ExecutionPlan2Hs.ag" #-} + (if dataTypes _lhsIoptions then _datatype else empty) + >-< (if nt_ `Set.member` _lhsIwrappers + then _wr_inh + >-< _wr_syn + >-< _wrapper + else empty) + >-< _sem_nt + >-< _t_init + >-< _t_states + >-< _k_states + >-< _prodsIt_visits + >-< _prodsIsem_prod + {-# LINE 445 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 74, column 18) + _datatype = + ({-# LINE 74 "ExecutionPlan2Hs.ag" #-} + case lookup nt_ _lhsItypeSyns of + Nothing -> "data" >#< nt_ >#< (vlist $ ("=" >#< head _prodsIdatatype) + : (map ("|" >#<) $ tail _prodsIdatatype)) + Just (List t) -> "type" >#< nt_ >#< "=" >#< "[" >#< show t >#< "]" + Just x -> error $ "Type " ++ show x ++ " is not supported yet" + {-# LINE 455 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 96, column 18) + _sem_nt = + ({-# LINE 96 "ExecutionPlan2Hs.ag" #-} + "sem_" >|< nt_ >#< "::" >#< nt_ >#< "->" >#< "T_" >|< nt_ + >-< case lookup nt_ _lhsItypeSyns of + Nothing -> _prodsIsem_nt + Just (List t) -> "sem_" >|< nt_ >#< "list" >#< "=" >#< "Prelude.foldr sem_" + >|< nt_ >|< "_Cons" >#< "sem_" >|< nt_ >|< "_Nil" + >#< "(" >#< "Prelude.map sem_" >|< show t >#< "list" >#< ")" + {-# LINE 466 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 132, column 19) + (Just _prodsOinhmap ) = + ({-# LINE 132 "ExecutionPlan2Hs.ag" #-} + Map.lookup nt_ _lhsIinhmap + {-# LINE 472 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 133, column 19) + (Just _prodsOsynmap ) = + ({-# LINE 133 "ExecutionPlan2Hs.ag" #-} + Map.lookup nt_ _lhsIsynmap + {-# LINE 478 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 149, column 18) + _outedges = + ({-# LINE 149 "ExecutionPlan2Hs.ag" #-} + Set.fromList $ map (\(_,f,_) -> f) _prodsIallvisits + {-# LINE 484 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 150, column 18) + _inedges = + ({-# LINE 150 "ExecutionPlan2Hs.ag" #-} + Set.fromList $ map (\(_,_,t) -> t) _prodsIallvisits + {-# LINE 490 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 151, column 18) + _allstates = + ({-# LINE 151 "ExecutionPlan2Hs.ag" #-} + Set.insert initial_ $ _inedges `Set.union` _outedges + {-# LINE 496 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 152, column 18) + _t_init = + ({-# LINE 152 "ExecutionPlan2Hs.ag" #-} + "type" >#< "T_" >|< nt_ >#< "=" >#< "T_" >|< nt_ >|< "_s" >|< initial_ + {-# LINE 502 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 153, column 18) + _t_states = + ({-# LINE 153 "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 + in "data" >#< t_st >#< "where" >#< c_st >#< "::" >#< "{" >#< inv_st >#< "::" + >#< "forall t." >#< k_st >#< "t" >#< "->" >#< "t" >#< "}" + >#< "->" >#< t_st + ) $ Set.toList _allstates + {-# LINE 517 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 166, column 18) + _k_states = + ({-# LINE 166 "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_" >|< nt_ >|< "_v" >|< v >#< "::" >#< k_st >#< "T_" >|< nt_ >|< "_v" >|< v + ) outg + in "data" >#< k_st >#< "k" >#< "where" + >-< indent 3 visitlist) $ Set.toList _allstates + {-# LINE 531 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 194, column 18) + _prodsOnt = + ({-# LINE 194 "ExecutionPlan2Hs.ag" #-} + nt_ + {-# LINE 537 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 210, column 18) + _wr_inh = + ({-# LINE 210 "ExecutionPlan2Hs.ag" #-} + _genwrap "Inh" _wr_inhs + {-# LINE 543 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 211, column 18) + _wr_syn = + ({-# LINE 211 "ExecutionPlan2Hs.ag" #-} + _genwrap "Syn" _wr_syns + {-# LINE 549 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 212, column 18) + _genwrap = + ({-# LINE 212 "ExecutionPlan2Hs.ag" #-} + \nm attr -> "data" >#< nm >|< "_" >|< nt_ >#< "=" >#< nm >|< "_" >|< nt_ >#< "{" + >#< (ppCommas $ map (\(i,t) -> i >|< "_" >|< nm >|< "_" >|< nt_ >#< "::" + >#< typeToHaskellString (Just nt_) [] t) attr) >#< "}" + {-# LINE 557 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 215, column 18) + _wr_inhs = + ({-# LINE 215 "ExecutionPlan2Hs.ag" #-} + Map.toList $ fromJust $ Map.lookup nt_ _lhsIinhmap + {-# LINE 563 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 216, column 18) + _wr_syns = + ({-# LINE 216 "ExecutionPlan2Hs.ag" #-} + Map.toList $ fromJust $ Map.lookup nt_ _lhsIsynmap + {-# LINE 569 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 217, column 18) + _inhlist = + ({-# LINE 217 "ExecutionPlan2Hs.ag" #-} + map (lhsname True . fst) _wr_inhs + {-# LINE 575 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 218, column 18) + _synlist = + ({-# LINE 218 "ExecutionPlan2Hs.ag" #-} + map (lhsname False . fst) _wr_syns + {-# LINE 581 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 219, column 18) + _wrapper = + ({-# LINE 219 "ExecutionPlan2Hs.ag" #-} + ("wrap_" >|< nt_ >#< "::" >#< "T_" >|< nt_ >#< "->" + >#< "Inh_" >|< nt_ >#< "->" >#< "Syn_" >|< nt_) + >-< + (("wrap_" >|< nt_ >#< "sem" >#< "(" >#< "Inh_" >|< nt_ + >#< ppSpaced _inhlist >#< ")" >#< "=") + >-< + indent 3 ("let" >#< "(" >#< ppCommas _synlist >#< "," >#< "_" >#< ")" >#< "=" + >#< "runIdentity" >#< "$" >#< "(" >#< "inv_" >|< nt_ >|< "_s" >|< initial_ + >#< "sem" >#< "K_" >|< nt_ >|< "_v" >|< fromJust initialv_ >#< ")" + >#< ppSpaced _inhlist + >-< + "in " >#< "(" >#< "Syn_" >|< nt_ >#< ppSpaced _synlist >#< ")") + ) + {-# LINE 599 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 247, column 33) + _prodsOinitial = + ({-# LINE 247 "ExecutionPlan2Hs.ag" #-} + initial_ + {-# LINE 605 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 248, column 33) + _prodsOallstates = + ({-# LINE 248 "ExecutionPlan2Hs.ag" #-} + _allstates + {-# LINE 611 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + _prodsIchildvisit + {-# LINE 617 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + _prodsIvisitdefs + {-# LINE 623 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + _prodsIvisituses + {-# LINE 629 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 635 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 641 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _prodsOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 647 "ExecutionPlan2Hs.hs" #-} + ) + ( _prodsIallvisits,_prodsIchildvisit,_prodsIdatatype,_prodsIsem_nt,_prodsIsem_prod,_prodsIt_visits,_prodsIvisitdefs,_prodsIvisituses) = + prods_ _prodsOallchildvisit _prodsOallstates _prodsOavisitdefs _prodsOavisituses _prodsOinhmap _prodsOinitial _prodsOnt _prodsOrename _prodsOsynmap + in ( _lhsOchildvisit,_lhsOdebugoutput,_lhsOvisitdefs,_lhsOvisituses))) ) +-- ENonterminals ----------------------------------------------- +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + inhmap : Map.Map NontermIdent Attributes + options : Options + synmap : Map.Map NontermIdent Attributes + typeSyns : TypeSyns + wrappers : Set.Set NontermIdent + synthesized attributes: + childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + debugoutput : PP_Doc + visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + visituses : Map.Map VisitIdentifier (Set.Set Identifier) + alternatives: + alternative Cons: + child hd : ENonterminal + child tl : ENonterminals + alternative Nil: +-} +-- cata +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 ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map NontermIdent Attributes) -> + Options -> + (Map.Map NontermIdent Attributes) -> + TypeSyns -> + (Set.Set NontermIdent) -> + ( (Map.Map VisitIdentifier (Identifier -> PP_Doc)),PP_Doc,(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) +data Inh_ENonterminals = Inh_ENonterminals {allchildvisit_Inh_ENonterminals :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),avisitdefs_Inh_ENonterminals :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_ENonterminals :: (Map.Map VisitIdentifier (Set.Set Identifier)),inhmap_Inh_ENonterminals :: (Map.Map NontermIdent Attributes),options_Inh_ENonterminals :: Options,synmap_Inh_ENonterminals :: (Map.Map NontermIdent Attributes),typeSyns_Inh_ENonterminals :: TypeSyns,wrappers_Inh_ENonterminals :: (Set.Set NontermIdent)} +data Syn_ENonterminals = Syn_ENonterminals {childvisit_Syn_ENonterminals :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),debugoutput_Syn_ENonterminals :: PP_Doc,visitdefs_Syn_ENonterminals :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_ENonterminals :: (Map.Map VisitIdentifier (Set.Set Identifier))} +wrap_ENonterminals :: T_ENonterminals -> + Inh_ENonterminals -> + Syn_ENonterminals +wrap_ENonterminals (T_ENonterminals sem ) (Inh_ENonterminals _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers ) = + (let ( _lhsOchildvisit,_lhsOdebugoutput,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIoptions _lhsIsynmap _lhsItypeSyns _lhsIwrappers + in (Syn_ENonterminals _lhsOchildvisit _lhsOdebugoutput _lhsOvisitdefs _lhsOvisituses )) +sem_ENonterminals_Cons :: T_ENonterminal -> + T_ENonterminals -> + T_ENonterminals +sem_ENonterminals_Cons (T_ENonterminal hd_ ) (T_ENonterminals tl_ ) = + (T_ENonterminals (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIoptions + _lhsIsynmap + _lhsItypeSyns + _lhsIwrappers -> + (let _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOdebugoutput :: PP_Doc + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _hdOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOinhmap :: (Map.Map NontermIdent Attributes) + _hdOoptions :: Options + _hdOsynmap :: (Map.Map NontermIdent Attributes) + _hdOtypeSyns :: TypeSyns + _hdOwrappers :: (Set.Set NontermIdent) + _tlOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _tlOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOinhmap :: (Map.Map NontermIdent Attributes) + _tlOoptions :: Options + _tlOsynmap :: (Map.Map NontermIdent Attributes) + _tlOtypeSyns :: TypeSyns + _tlOwrappers :: (Set.Set NontermIdent) + _hdIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _hdIdebugoutput :: PP_Doc + _hdIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _tlIdebugoutput :: PP_Doc + _tlIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + _hdIchildvisit `Map.union` _tlIchildvisit + {-# LINE 742 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 48, column 85) + _lhsOdebugoutput = + ({-# LINE 48 "ExecutionPlan2Hs.ag" #-} + _hdIdebugoutput >-< _tlIdebugoutput + {-# LINE 748 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + _hdIvisitdefs `uwSetUnion` _tlIvisitdefs + {-# LINE 754 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + _hdIvisituses `uwSetUnion` _tlIvisituses + {-# LINE 760 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 766 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 772 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 778 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 122 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 784 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOoptions = + ({-# LINE 30 "ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 790 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 123 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 796 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOtypeSyns = + ({-# LINE 68 "ExecutionPlan2Hs.ag" #-} + _lhsItypeSyns + {-# LINE 802 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOwrappers = + ({-# LINE 48 "ExecutionPlan2Hs.ag" #-} + _lhsIwrappers + {-# LINE 808 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 814 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 820 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 826 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 122 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 832 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOoptions = + ({-# LINE 30 "ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 838 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 123 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 844 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOtypeSyns = + ({-# LINE 68 "ExecutionPlan2Hs.ag" #-} + _lhsItypeSyns + {-# LINE 850 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOwrappers = + ({-# LINE 48 "ExecutionPlan2Hs.ag" #-} + _lhsIwrappers + {-# LINE 856 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdIchildvisit,_hdIdebugoutput,_hdIvisitdefs,_hdIvisituses) = + hd_ _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOinhmap _hdOoptions _hdOsynmap _hdOtypeSyns _hdOwrappers + ( _tlIchildvisit,_tlIdebugoutput,_tlIvisitdefs,_tlIvisituses) = + tl_ _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOinhmap _tlOoptions _tlOsynmap _tlOtypeSyns _tlOwrappers + in ( _lhsOchildvisit,_lhsOdebugoutput,_lhsOvisitdefs,_lhsOvisituses))) ) +sem_ENonterminals_Nil :: T_ENonterminals +sem_ENonterminals_Nil = + (T_ENonterminals (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIoptions + _lhsIsynmap + _lhsItypeSyns + _lhsIwrappers -> + (let _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOdebugoutput :: PP_Doc + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 881 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 48, column 85) + _lhsOdebugoutput = + ({-# LINE 48 "ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 887 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 893 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 899 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOchildvisit,_lhsOdebugoutput,_lhsOvisitdefs,_lhsOvisituses))) ) +-- EProduction ------------------------------------------------- +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + allstates : Set.Set StateIdentifier + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + inhmap : Attributes + initial : StateIdentifier + nt : NontermIdent + rename : Bool + synmap : Attributes + synthesized attributes: + allvisits : [(VisitIdentifier,StateIdentifier, StateIdentifier)] + childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + datatype : PP_Doc + sem_nt : PP_Doc + sem_prod : PP_Doc + t_visits : PP_Doc + visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + visituses : Map.Map VisitIdentifier (Set.Set Identifier) + alternatives: + alternative EProduction: + child con : {ConstructorIdent} + child rules : ERules + child children : EChildren + child visits : Visits + visit 0: + local args : _ + local statefns : _ + local stargs : _ + local stks : _ + local stvisits : _ + local stvs : _ +-} +-- cata +sem_EProduction :: EProduction -> + T_EProduction +sem_EProduction (EProduction _con _rules _children _visits ) = + (sem_EProduction_EProduction _con (sem_ERules _rules ) (sem_EChildren _children ) (sem_Visits _visits ) ) +-- semantic domain +newtype T_EProduction = T_EProduction ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Set.Set StateIdentifier) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + Attributes -> + StateIdentifier -> + NontermIdent -> + Bool -> + Attributes -> + ( ([(VisitIdentifier,StateIdentifier, StateIdentifier)]),(Map.Map VisitIdentifier (Identifier -> PP_Doc)),PP_Doc,PP_Doc,PP_Doc,PP_Doc,(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) +data Inh_EProduction = Inh_EProduction {allchildvisit_Inh_EProduction :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),allstates_Inh_EProduction :: (Set.Set StateIdentifier),avisitdefs_Inh_EProduction :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_EProduction :: (Map.Map VisitIdentifier (Set.Set Identifier)),inhmap_Inh_EProduction :: Attributes,initial_Inh_EProduction :: StateIdentifier,nt_Inh_EProduction :: NontermIdent,rename_Inh_EProduction :: Bool,synmap_Inh_EProduction :: Attributes} +data Syn_EProduction = Syn_EProduction {allvisits_Syn_EProduction :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]),childvisit_Syn_EProduction :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),datatype_Syn_EProduction :: PP_Doc,sem_nt_Syn_EProduction :: PP_Doc,sem_prod_Syn_EProduction :: PP_Doc,t_visits_Syn_EProduction :: PP_Doc,visitdefs_Syn_EProduction :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_EProduction :: (Map.Map VisitIdentifier (Set.Set Identifier))} +wrap_EProduction :: T_EProduction -> + Inh_EProduction -> + Syn_EProduction +wrap_EProduction (T_EProduction sem ) (Inh_EProduction _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsInt _lhsIrename _lhsIsynmap ) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOdatatype,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsInt _lhsIrename _lhsIsynmap + in (Syn_EProduction _lhsOallvisits _lhsOchildvisit _lhsOdatatype _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitdefs _lhsOvisituses )) +sem_EProduction_EProduction :: ConstructorIdent -> + T_ERules -> + T_EChildren -> + T_Visits -> + T_EProduction +sem_EProduction_EProduction con_ (T_ERules rules_ ) (T_EChildren children_ ) (T_Visits visits_ ) = + (T_EProduction (\ _lhsIallchildvisit + _lhsIallstates + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIinitial + _lhsInt + _lhsIrename + _lhsIsynmap -> + (let _lhsOdatatype :: PP_Doc + _lhsOsem_nt :: PP_Doc + _rulesOusedrules :: (Set.Set Identifier) + _lhsOsem_prod :: PP_Doc + _visitsOmrules :: (Map.Map Identifier PP_Doc) + _visitsOchildintros :: (Map.Map Identifier PP_Doc) + _visitsOallintramap :: (Map.Map StateIdentifier (Set.Set String)) + _visitsOterminaldefs :: (Set.Set String) + _visitsOruledefs :: (Map.Map Identifier (Set.Set String)) + _visitsOruleuses :: (Map.Map Identifier (Set.Set String)) + _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOt_visits :: PP_Doc + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _childrenOnt :: NontermIdent + _visitsOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _visitsOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _visitsOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _visitsOinhmap :: Attributes + _visitsOnt :: NontermIdent + _visitsOsynmap :: Attributes + _rulesImrules :: (Map.Map Identifier PP_Doc) + _rulesIruledefs :: (Map.Map Identifier (Set.Set String)) + _rulesIruleuses :: (Map.Map Identifier (Set.Set String)) + _rulesIsem_rules :: PP_Doc + _childrenIargnames :: ( [PP_Doc] ) + _childrenIargnamesw :: ([PP_Doc]) + _childrenIargtps :: ( [PP_Doc] ) + _childrenIchildintros :: (Map.Map Identifier PP_Doc) + _childrenIdatatype :: ([PP_Doc]) + _childrenIterminaldefs :: (Set.Set String) + _visitsIallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _visitsIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _visitsIintramap :: (Map.Map StateIdentifier (Set.Set String)) + _visitsIsem_visit :: ( [(StateIdentifier,PP_Doc)] ) + _visitsIt_visits :: PP_Doc + _visitsIusedrules :: (Set.Set Identifier) + _visitsIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _visitsIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- "ExecutionPlan2Hs.ag"(line 84, column 17) + _lhsOdatatype = + ({-# LINE 84 "ExecutionPlan2Hs.ag" #-} + conname _lhsIrename _lhsInt con_ >#< ppSpaced _childrenIdatatype + {-# LINE 1021 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 105, column 17) + _lhsOsem_nt = + ({-# LINE 105 "ExecutionPlan2Hs.ag" #-} + "sem_" >|< _lhsInt >#< "(" >#< conname _lhsIrename _lhsInt con_ >#< ppSpaced _childrenIargnames >#< ")" + >#< "=" >#< "sem_" >|< _lhsInt >|< "_" >|< con_ >#< ppSpaced _childrenIargnamesw + {-# LINE 1028 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 182, column 17) + _rulesOusedrules = + ({-# LINE 182 "ExecutionPlan2Hs.ag" #-} + _visitsIusedrules + {-# LINE 1034 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 268, column 17) + _args = + ({-# LINE 268 "ExecutionPlan2Hs.ag" #-} + _childrenIargnames + {-# LINE 1040 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 269, column 17) + _lhsOsem_prod = + ({-# LINE 269 "ExecutionPlan2Hs.ag" #-} + "sem_" >|< _lhsInt >|< "_" >|< con_ >#< "::" >#< ppSpaced _childrenIargtps >#< "T_" >|< _lhsInt + >-< "sem_" >|< _lhsInt >|< "_" >|< con_ >#< ppSpaced _args >#< "=" + >#< "st" >|< _lhsIinitial >#< "where" + >-< (indent 3 $ vlist _statefns >-< _rulesIsem_rules) + {-# LINE 1049 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 273, column 17) + _statefns = + ({-# LINE 273 "ExecutionPlan2Hs.ag" #-} + map (\st -> "st" >|< st >#< _stargs st >#< "=" >#< + "C_" >|< _lhsInt >|< "_s" >|< st >#< "k" >|< st >#< "where" + >-< indent 3 (_stks st >-< _stvs st) + ) $ Set.toList _lhsIallstates + {-# LINE 1058 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 277, column 17) + _stargs = + ({-# LINE 277 "ExecutionPlan2Hs.ag" #-} + \st -> ppSpaced $ Set.toList $ maybe Set.empty id $ Map.lookup st _visitsIintramap + {-# LINE 1064 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 278, column 17) + _stks = + ({-# LINE 278 "ExecutionPlan2Hs.ag" #-} + \st -> "k" >|< st >#< "::" >#< "K_" >|< _lhsInt >|< "_s" >|< st >#< "t" >#< "->" >#< "t" + >-< vlist (map (\(v,f,t) -> "k" >|< st >#< "K_" >|< _lhsInt >|< "_v" >|< v >#< "=" + >#< "v" >|< v) $ _stvisits st) + >-< if null (_stvisits st) + then "k" >|< st >#< "_" >#< "=" >#< "error \"unreachable\"" + else empty + {-# LINE 1075 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 284, column 17) + _stvisits = + ({-# LINE 284 "ExecutionPlan2Hs.ag" #-} + \st -> filter (\(v,f,t) -> f == st) _visitsIallvisits + {-# LINE 1081 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 285, column 17) + _stvs = + ({-# LINE 285 "ExecutionPlan2Hs.ag" #-} + \st -> vlist $ map snd $ filter (\(f,pp) -> f == st) _visitsIsem_visit + {-# LINE 1087 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 286, column 17) + _visitsOmrules = + ({-# LINE 286 "ExecutionPlan2Hs.ag" #-} + _rulesImrules + {-# LINE 1093 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 324, column 17) + _visitsOchildintros = + ({-# LINE 324 "ExecutionPlan2Hs.ag" #-} + _childrenIchildintros + {-# LINE 1099 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 409, column 17) + _visitsOallintramap = + ({-# LINE 409 "ExecutionPlan2Hs.ag" #-} + _visitsIintramap + {-# LINE 1105 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 410, column 17) + _visitsOterminaldefs = + ({-# LINE 410 "ExecutionPlan2Hs.ag" #-} + _childrenIterminaldefs + {-# LINE 1111 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 429, column 17) + _visitsOruledefs = + ({-# LINE 429 "ExecutionPlan2Hs.ag" #-} + _rulesIruledefs + {-# LINE 1117 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 430, column 17) + _visitsOruleuses = + ({-# LINE 430 "ExecutionPlan2Hs.ag" #-} + _rulesIruleuses + {-# LINE 1123 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + _visitsIchildvisit + {-# LINE 1129 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 188, column 54) + _lhsOt_visits = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + _visitsIt_visits + {-# LINE 1135 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + _visitsIvisitdefs + {-# LINE 1141 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + _visitsIvisituses + {-# LINE 1147 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (up) + _lhsOallvisits = + ({-# LINE 138 "ExecutionPlan2Hs.ag" #-} + _visitsIallvisits + {-# LINE 1153 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _childrenOnt = + ({-# LINE 87 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 1159 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 1165 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 1171 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 1177 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOinhmap = + ({-# LINE 128 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 1183 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOnt = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 1189 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _visitsOsynmap = + ({-# LINE 129 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 1195 "ExecutionPlan2Hs.hs" #-} + ) + ( _rulesImrules,_rulesIruledefs,_rulesIruleuses,_rulesIsem_rules) = + rules_ _rulesOusedrules + ( _childrenIargnames,_childrenIargnamesw,_childrenIargtps,_childrenIchildintros,_childrenIdatatype,_childrenIterminaldefs) = + children_ _childrenOnt + ( _visitsIallvisits,_visitsIchildvisit,_visitsIintramap,_visitsIsem_visit,_visitsIt_visits,_visitsIusedrules,_visitsIvisitdefs,_visitsIvisituses) = + visits_ _visitsOallchildvisit _visitsOallintramap _visitsOavisitdefs _visitsOavisituses _visitsOchildintros _visitsOinhmap _visitsOmrules _visitsOnt _visitsOruledefs _visitsOruleuses _visitsOsynmap _visitsOterminaldefs + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOdatatype,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitdefs,_lhsOvisituses))) ) +-- EProductions ------------------------------------------------ +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + allstates : Set.Set StateIdentifier + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + inhmap : Attributes + initial : StateIdentifier + nt : NontermIdent + rename : Bool + synmap : Attributes + synthesized attributes: + allvisits : [(VisitIdentifier,StateIdentifier, StateIdentifier)] + childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + datatype : [PP_Doc] + sem_nt : PP_Doc + sem_prod : PP_Doc + t_visits : PP_Doc + visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + visituses : Map.Map VisitIdentifier (Set.Set Identifier) + alternatives: + alternative Cons: + child hd : EProduction + child tl : EProductions + alternative Nil: +-} +-- cata +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 ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Set.Set StateIdentifier) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + Attributes -> + StateIdentifier -> + NontermIdent -> + Bool -> + Attributes -> + ( ([(VisitIdentifier,StateIdentifier, StateIdentifier)]),(Map.Map VisitIdentifier (Identifier -> PP_Doc)),([PP_Doc]),PP_Doc,PP_Doc,PP_Doc,(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) +data Inh_EProductions = Inh_EProductions {allchildvisit_Inh_EProductions :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),allstates_Inh_EProductions :: (Set.Set StateIdentifier),avisitdefs_Inh_EProductions :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_EProductions :: (Map.Map VisitIdentifier (Set.Set Identifier)),inhmap_Inh_EProductions :: Attributes,initial_Inh_EProductions :: StateIdentifier,nt_Inh_EProductions :: NontermIdent,rename_Inh_EProductions :: Bool,synmap_Inh_EProductions :: Attributes} +data Syn_EProductions = Syn_EProductions {allvisits_Syn_EProductions :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]),childvisit_Syn_EProductions :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),datatype_Syn_EProductions :: ([PP_Doc]),sem_nt_Syn_EProductions :: PP_Doc,sem_prod_Syn_EProductions :: PP_Doc,t_visits_Syn_EProductions :: PP_Doc,visitdefs_Syn_EProductions :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_EProductions :: (Map.Map VisitIdentifier (Set.Set Identifier))} +wrap_EProductions :: T_EProductions -> + Inh_EProductions -> + Syn_EProductions +wrap_EProductions (T_EProductions sem ) (Inh_EProductions _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsInt _lhsIrename _lhsIsynmap ) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOdatatype,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIallstates _lhsIavisitdefs _lhsIavisituses _lhsIinhmap _lhsIinitial _lhsInt _lhsIrename _lhsIsynmap + in (Syn_EProductions _lhsOallvisits _lhsOchildvisit _lhsOdatatype _lhsOsem_nt _lhsOsem_prod _lhsOt_visits _lhsOvisitdefs _lhsOvisituses )) +sem_EProductions_Cons :: T_EProduction -> + T_EProductions -> + T_EProductions +sem_EProductions_Cons (T_EProduction hd_ ) (T_EProductions tl_ ) = + (T_EProductions (\ _lhsIallchildvisit + _lhsIallstates + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIinitial + _lhsInt + _lhsIrename + _lhsIsynmap -> + (let _lhsOallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _lhsOt_visits :: PP_Doc + _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOdatatype :: ([PP_Doc]) + _lhsOsem_nt :: PP_Doc + _lhsOsem_prod :: PP_Doc + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _hdOallstates :: (Set.Set StateIdentifier) + _hdOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOinhmap :: Attributes + _hdOinitial :: StateIdentifier + _hdOnt :: NontermIdent + _hdOrename :: Bool + _hdOsynmap :: Attributes + _tlOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _tlOallstates :: (Set.Set StateIdentifier) + _tlOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOinhmap :: Attributes + _tlOinitial :: StateIdentifier + _tlOnt :: NontermIdent + _tlOrename :: Bool + _tlOsynmap :: Attributes + _hdIallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _hdIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _hdIdatatype :: PP_Doc + _hdIsem_nt :: PP_Doc + _hdIsem_prod :: PP_Doc + _hdIt_visits :: PP_Doc + _hdIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlIallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _tlIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _tlIdatatype :: ([PP_Doc]) + _tlIsem_nt :: PP_Doc + _tlIsem_prod :: PP_Doc + _tlIt_visits :: PP_Doc + _tlIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- "ExecutionPlan2Hs.ag"(line 144, column 10) + _lhsOallvisits = + ({-# LINE 144 "ExecutionPlan2Hs.ag" #-} + _hdIallvisits + {-# LINE 1315 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 191, column 10) + _lhsOt_visits = + ({-# LINE 191 "ExecutionPlan2Hs.ag" #-} + _hdIt_visits + {-# LINE 1321 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + _hdIchildvisit `Map.union` _tlIchildvisit + {-# LINE 1327 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 81, column 34) + _lhsOdatatype = + ({-# LINE 81 "ExecutionPlan2Hs.ag" #-} + _hdIdatatype : _tlIdatatype + {-# LINE 1333 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 103, column 44) + _lhsOsem_nt = + ({-# LINE 103 "ExecutionPlan2Hs.ag" #-} + _hdIsem_nt >-< _tlIsem_nt + {-# LINE 1339 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 244, column 34) + _lhsOsem_prod = + ({-# LINE 244 "ExecutionPlan2Hs.ag" #-} + _hdIsem_prod >-< _tlIsem_prod + {-# LINE 1345 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + _hdIvisitdefs `uwSetUnion` _tlIvisitdefs + {-# LINE 1351 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + _hdIvisituses `uwSetUnion` _tlIvisituses + {-# LINE 1357 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 1363 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallstates = + ({-# LINE 246 "ExecutionPlan2Hs.ag" #-} + _lhsIallstates + {-# LINE 1369 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 1375 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 1381 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 128 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 1387 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOinitial = + ({-# LINE 246 "ExecutionPlan2Hs.ag" #-} + _lhsIinitial + {-# LINE 1393 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 1399 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOrename = + ({-# LINE 31 "ExecutionPlan2Hs.ag" #-} + _lhsIrename + {-# LINE 1405 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 129 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 1411 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 1417 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallstates = + ({-# LINE 246 "ExecutionPlan2Hs.ag" #-} + _lhsIallstates + {-# LINE 1423 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 1429 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 1435 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 128 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 1441 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOinitial = + ({-# LINE 246 "ExecutionPlan2Hs.ag" #-} + _lhsIinitial + {-# LINE 1447 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 1453 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOrename = + ({-# LINE 31 "ExecutionPlan2Hs.ag" #-} + _lhsIrename + {-# LINE 1459 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 129 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 1465 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdIallvisits,_hdIchildvisit,_hdIdatatype,_hdIsem_nt,_hdIsem_prod,_hdIt_visits,_hdIvisitdefs,_hdIvisituses) = + hd_ _hdOallchildvisit _hdOallstates _hdOavisitdefs _hdOavisituses _hdOinhmap _hdOinitial _hdOnt _hdOrename _hdOsynmap + ( _tlIallvisits,_tlIchildvisit,_tlIdatatype,_tlIsem_nt,_tlIsem_prod,_tlIt_visits,_tlIvisitdefs,_tlIvisituses) = + tl_ _tlOallchildvisit _tlOallstates _tlOavisitdefs _tlOavisituses _tlOinhmap _tlOinitial _tlOnt _tlOrename _tlOsynmap + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOdatatype,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitdefs,_lhsOvisituses))) ) +sem_EProductions_Nil :: T_EProductions +sem_EProductions_Nil = + (T_EProductions (\ _lhsIallchildvisit + _lhsIallstates + _lhsIavisitdefs + _lhsIavisituses + _lhsIinhmap + _lhsIinitial + _lhsInt + _lhsIrename + _lhsIsynmap -> + (let _lhsOallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOdatatype :: ([PP_Doc]) + _lhsOsem_nt :: PP_Doc + _lhsOsem_prod :: PP_Doc + _lhsOt_visits :: PP_Doc + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- "ExecutionPlan2Hs.ag"(line 145, column 10) + _lhsOallvisits = + ({-# LINE 145 "ExecutionPlan2Hs.ag" #-} + error "Every nonterminal should have at least 1 production" + {-# LINE 1495 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 1501 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 81, column 34) + _lhsOdatatype = + ({-# LINE 81 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 1507 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 103, column 44) + _lhsOsem_nt = + ({-# LINE 103 "ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 1513 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 244, column 34) + _lhsOsem_prod = + ({-# LINE 244 "ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 1519 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 188, column 54) + _lhsOt_visits = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 1525 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 1531 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 1537 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOdatatype,_lhsOsem_nt,_lhsOsem_prod,_lhsOt_visits,_lhsOvisitdefs,_lhsOvisituses))) ) +-- ERule ------------------------------------------------------- +{- + visit 0: + inherited attribute: + usedrules : Set.Set Identifier + synthesized attributes: + mrules : Map.Map Identifier PP_Doc + ruledefs : Map.Map Identifier (Set.Set String) + ruleuses : Map.Map Identifier (Set.Set String) + sem_rules : PP_Doc + alternatives: + alternative ERule: + child name : {Identifier} + child pattern : Pattern + child rhs : Expression + child owrt : {Bool} + child origin : {String} + child explicit : {Bool} + visit 0: + local attrlst : _ +-} +-- cata +sem_ERule :: ERule -> + T_ERule +sem_ERule (ERule _name _pattern _rhs _owrt _origin _explicit ) = + (sem_ERule_ERule _name (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) +-- semantic domain +newtype T_ERule = T_ERule ((Set.Set Identifier) -> + ( (Map.Map Identifier PP_Doc),(Map.Map Identifier (Set.Set String)),(Map.Map Identifier (Set.Set String)),PP_Doc)) +data Inh_ERule = Inh_ERule {usedrules_Inh_ERule :: (Set.Set Identifier)} +data Syn_ERule = Syn_ERule {mrules_Syn_ERule :: (Map.Map Identifier PP_Doc),ruledefs_Syn_ERule :: (Map.Map Identifier (Set.Set String)),ruleuses_Syn_ERule :: (Map.Map Identifier (Set.Set String)),sem_rules_Syn_ERule :: PP_Doc} +wrap_ERule :: T_ERule -> + Inh_ERule -> + Syn_ERule +wrap_ERule (T_ERule sem ) (Inh_ERule _lhsIusedrules ) = + (let ( _lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules) = sem _lhsIusedrules + in (Syn_ERule _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules )) +sem_ERule_ERule :: Identifier -> + T_Pattern -> + T_Expression -> + Bool -> + String -> + Bool -> + T_ERule +sem_ERule_ERule name_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ = + (T_ERule (\ _lhsIusedrules -> + (let _lhsOsem_rules :: PP_Doc + _lhsOmrules :: (Map.Map Identifier PP_Doc) + _lhsOruledefs :: (Map.Map Identifier (Set.Set String)) + _lhsOruleuses :: (Map.Map Identifier (Set.Set String)) + _patternIattrs :: (Set.Set String) + _patternIcopy :: Pattern + _patternIsem_lhs :: PP_Doc + _rhsIattrs :: (Set.Set String) + _rhsIsemfunc :: PP_Doc + -- "ExecutionPlan2Hs.ag"(line 337, column 11) + _lhsOsem_rules = + ({-# LINE 337 "ExecutionPlan2Hs.ag" #-} + if Set.member name_ _lhsIusedrules + then (name_ >#< "=" >#< + (if Set.null _rhsIattrs + then empty + else "\\" >|< _attrlst >#< "->") + >#< _rhsIsemfunc) + else empty + {-# LINE 1605 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 344, column 11) + _attrlst = + ({-# LINE 344 "ExecutionPlan2Hs.ag" #-} + ppSpaced $ Set.toList _rhsIattrs + {-# LINE 1611 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 345, column 11) + _lhsOmrules = + ({-# LINE 345 "ExecutionPlan2Hs.ag" #-} + Map.singleton name_ $ _patternIsem_lhs >#< "<-" >#< "return" >#< "$" >#< name_ >#< _attrlst + {-# LINE 1617 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 425, column 11) + _lhsOruledefs = + ({-# LINE 425 "ExecutionPlan2Hs.ag" #-} + Map.singleton name_ _patternIattrs + {-# LINE 1623 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 426, column 11) + _lhsOruleuses = + ({-# LINE 426 "ExecutionPlan2Hs.ag" #-} + Map.singleton name_ _rhsIattrs + {-# LINE 1629 "ExecutionPlan2Hs.hs" #-} + ) + ( _patternIattrs,_patternIcopy,_patternIsem_lhs) = + pattern_ + ( _rhsIattrs,_rhsIsemfunc) = + rhs_ + in ( _lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules))) ) +-- ERules ------------------------------------------------------ +{- + visit 0: + inherited attribute: + usedrules : Set.Set Identifier + synthesized attributes: + mrules : Map.Map Identifier PP_Doc + ruledefs : Map.Map Identifier (Set.Set String) + ruleuses : Map.Map Identifier (Set.Set String) + sem_rules : PP_Doc + alternatives: + alternative Cons: + child hd : ERule + child tl : ERules + alternative Nil: +-} +-- cata +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 ((Set.Set Identifier) -> + ( (Map.Map Identifier PP_Doc),(Map.Map Identifier (Set.Set String)),(Map.Map Identifier (Set.Set String)),PP_Doc)) +data Inh_ERules = Inh_ERules {usedrules_Inh_ERules :: (Set.Set Identifier)} +data Syn_ERules = Syn_ERules {mrules_Syn_ERules :: (Map.Map Identifier PP_Doc),ruledefs_Syn_ERules :: (Map.Map Identifier (Set.Set String)),ruleuses_Syn_ERules :: (Map.Map Identifier (Set.Set String)),sem_rules_Syn_ERules :: PP_Doc} +wrap_ERules :: T_ERules -> + Inh_ERules -> + Syn_ERules +wrap_ERules (T_ERules sem ) (Inh_ERules _lhsIusedrules ) = + (let ( _lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules) = sem _lhsIusedrules + in (Syn_ERules _lhsOmrules _lhsOruledefs _lhsOruleuses _lhsOsem_rules )) +sem_ERules_Cons :: T_ERule -> + T_ERules -> + T_ERules +sem_ERules_Cons (T_ERule hd_ ) (T_ERules tl_ ) = + (T_ERules (\ _lhsIusedrules -> + (let _lhsOmrules :: (Map.Map Identifier PP_Doc) + _lhsOruledefs :: (Map.Map Identifier (Set.Set String)) + _lhsOruleuses :: (Map.Map Identifier (Set.Set String)) + _lhsOsem_rules :: PP_Doc + _hdOusedrules :: (Set.Set Identifier) + _tlOusedrules :: (Set.Set Identifier) + _hdImrules :: (Map.Map Identifier PP_Doc) + _hdIruledefs :: (Map.Map Identifier (Set.Set String)) + _hdIruleuses :: (Map.Map Identifier (Set.Set String)) + _hdIsem_rules :: PP_Doc + _tlImrules :: (Map.Map Identifier PP_Doc) + _tlIruledefs :: (Map.Map Identifier (Set.Set String)) + _tlIruleuses :: (Map.Map Identifier (Set.Set String)) + _tlIsem_rules :: PP_Doc + -- use rule "ExecutionPlan2Hs.ag"(line 334, column 32) + _lhsOmrules = + ({-# LINE 334 "ExecutionPlan2Hs.ag" #-} + _hdImrules `Map.union` _tlImrules + {-# LINE 1691 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 418, column 34) + _lhsOruledefs = + ({-# LINE 418 "ExecutionPlan2Hs.ag" #-} + _hdIruledefs `uwSetUnion` _tlIruledefs + {-# LINE 1697 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 419, column 34) + _lhsOruleuses = + ({-# LINE 419 "ExecutionPlan2Hs.ag" #-} + _hdIruleuses `uwSetUnion` _tlIruleuses + {-# LINE 1703 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 333, column 35) + _lhsOsem_rules = + ({-# LINE 333 "ExecutionPlan2Hs.ag" #-} + _hdIsem_rules >-< _tlIsem_rules + {-# LINE 1709 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOusedrules = + ({-# LINE 176 "ExecutionPlan2Hs.ag" #-} + _lhsIusedrules + {-# LINE 1715 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOusedrules = + ({-# LINE 176 "ExecutionPlan2Hs.ag" #-} + _lhsIusedrules + {-# LINE 1721 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdImrules,_hdIruledefs,_hdIruleuses,_hdIsem_rules) = + hd_ _hdOusedrules + ( _tlImrules,_tlIruledefs,_tlIruleuses,_tlIsem_rules) = + tl_ _tlOusedrules + in ( _lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules))) ) +sem_ERules_Nil :: T_ERules +sem_ERules_Nil = + (T_ERules (\ _lhsIusedrules -> + (let _lhsOmrules :: (Map.Map Identifier PP_Doc) + _lhsOruledefs :: (Map.Map Identifier (Set.Set String)) + _lhsOruleuses :: (Map.Map Identifier (Set.Set String)) + _lhsOsem_rules :: PP_Doc + -- use rule "ExecutionPlan2Hs.ag"(line 334, column 32) + _lhsOmrules = + ({-# LINE 334 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 1739 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 418, column 34) + _lhsOruledefs = + ({-# LINE 418 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 1745 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 419, column 34) + _lhsOruleuses = + ({-# LINE 419 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 1751 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 333, column 35) + _lhsOsem_rules = + ({-# LINE 333 "ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 1757 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOmrules,_lhsOruledefs,_lhsOruleuses,_lhsOsem_rules))) ) +-- ExecutionPlan ----------------------------------------------- +{- + visit 0: + inherited attributes: + importBlocks : PP_Doc + inhmap : Map.Map NontermIdent Attributes + mainName : String + moduleHeader : String -> String -> String -> Bool -> String + options : Options + pragmaBlocks : String + synmap : Map.Map NontermIdent Attributes + textBlocks : PP_Doc + synthesized attribute: + debugoutput : PP_Doc + alternatives: + alternative ExecutionPlan: + child nonts : ENonterminals + child typeSyns : {TypeSyns} + child wrappers : {Set.Set NontermIdent} +-} +-- cata +sem_ExecutionPlan :: ExecutionPlan -> + T_ExecutionPlan +sem_ExecutionPlan (ExecutionPlan _nonts _typeSyns _wrappers ) = + (sem_ExecutionPlan_ExecutionPlan (sem_ENonterminals _nonts ) _typeSyns _wrappers ) +-- semantic domain +newtype T_ExecutionPlan = T_ExecutionPlan (PP_Doc -> + (Map.Map NontermIdent Attributes) -> + String -> + (String -> String -> String -> Bool -> String) -> + Options -> + String -> + (Map.Map NontermIdent Attributes) -> + PP_Doc -> + ( PP_Doc)) +data Inh_ExecutionPlan = Inh_ExecutionPlan {importBlocks_Inh_ExecutionPlan :: PP_Doc,inhmap_Inh_ExecutionPlan :: (Map.Map NontermIdent Attributes),mainName_Inh_ExecutionPlan :: String,moduleHeader_Inh_ExecutionPlan :: (String -> String -> String -> Bool -> String),options_Inh_ExecutionPlan :: Options,pragmaBlocks_Inh_ExecutionPlan :: String,synmap_Inh_ExecutionPlan :: (Map.Map NontermIdent Attributes),textBlocks_Inh_ExecutionPlan :: PP_Doc} +data Syn_ExecutionPlan = Syn_ExecutionPlan {debugoutput_Syn_ExecutionPlan :: PP_Doc} +wrap_ExecutionPlan :: T_ExecutionPlan -> + Inh_ExecutionPlan -> + Syn_ExecutionPlan +wrap_ExecutionPlan (T_ExecutionPlan sem ) (Inh_ExecutionPlan _lhsIimportBlocks _lhsIinhmap _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks ) = + (let ( _lhsOdebugoutput) = sem _lhsIimportBlocks _lhsIinhmap _lhsImainName _lhsImoduleHeader _lhsIoptions _lhsIpragmaBlocks _lhsIsynmap _lhsItextBlocks + in (Syn_ExecutionPlan _lhsOdebugoutput )) +sem_ExecutionPlan_ExecutionPlan :: T_ENonterminals -> + TypeSyns -> + (Set.Set NontermIdent) -> + T_ExecutionPlan +sem_ExecutionPlan_ExecutionPlan (T_ENonterminals nonts_ ) typeSyns_ wrappers_ = + (T_ExecutionPlan (\ _lhsIimportBlocks + _lhsIinhmap + _lhsImainName + _lhsImoduleHeader + _lhsIoptions + _lhsIpragmaBlocks + _lhsIsynmap + _lhsItextBlocks -> + (let _lhsOdebugoutput :: PP_Doc + _nontsOwrappers :: (Set.Set NontermIdent) + _nontsOtypeSyns :: TypeSyns + _nontsOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _nontsOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _nontsOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _nontsOinhmap :: (Map.Map NontermIdent Attributes) + _nontsOoptions :: Options + _nontsOsynmap :: (Map.Map NontermIdent Attributes) + _nontsIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _nontsIdebugoutput :: PP_Doc + _nontsIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _nontsIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- "ExecutionPlan2Hs.ag"(line 40, column 19) + _lhsOdebugoutput = + ({-# LINE 40 "ExecutionPlan2Hs.ag" #-} + "{-# LANGUAGE Rank2Types, GADTs, EmptyDataDecls #-}" + >-< _lhsIpragmaBlocks + >-< _lhsImoduleHeader _lhsImainName "" "" False + >-< "import Control.Monad.Identity" + >-< _lhsIimportBlocks + >-< _lhsItextBlocks + >-< _nontsIdebugoutput + {-# LINE 1839 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 51, column 19) + _nontsOwrappers = + ({-# LINE 51 "ExecutionPlan2Hs.ag" #-} + wrappers_ + {-# LINE 1845 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 71, column 19) + _nontsOtypeSyns = + ({-# LINE 71 "ExecutionPlan2Hs.ag" #-} + typeSyns_ + {-# LINE 1851 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 384, column 19) + _nontsOallchildvisit = + ({-# LINE 384 "ExecutionPlan2Hs.ag" #-} + _nontsIchildvisit + {-# LINE 1857 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 450, column 19) + _nontsOavisitdefs = + ({-# LINE 450 "ExecutionPlan2Hs.ag" #-} + _nontsIvisitdefs + {-# LINE 1863 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 451, column 19) + _nontsOavisituses = + ({-# LINE 451 "ExecutionPlan2Hs.ag" #-} + _nontsIvisituses + {-# LINE 1869 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOinhmap = + ({-# LINE 122 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 1875 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOoptions = + ({-# LINE 30 "ExecutionPlan2Hs.ag" #-} + _lhsIoptions + {-# LINE 1881 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _nontsOsynmap = + ({-# LINE 123 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 1887 "ExecutionPlan2Hs.hs" #-} + ) + ( _nontsIchildvisit,_nontsIdebugoutput,_nontsIvisitdefs,_nontsIvisituses) = + nonts_ _nontsOallchildvisit _nontsOavisitdefs _nontsOavisituses _nontsOinhmap _nontsOoptions _nontsOsynmap _nontsOtypeSyns _nontsOwrappers + in ( _lhsOdebugoutput))) ) +-- Expression -------------------------------------------------- +{- + visit 0: + synthesized attributes: + attrs : Set.Set String + semfunc : PP_Doc + alternatives: + alternative Expression: + child pos : {Pos} + child tks : {[HsToken]} +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression _pos _tks ) = + (sem_Expression_Expression _pos _tks ) +-- semantic domain +newtype T_Expression = T_Expression (( (Set.Set String),PP_Doc)) +data Inh_Expression = Inh_Expression {} +data Syn_Expression = Syn_Expression {attrs_Syn_Expression :: (Set.Set String),semfunc_Syn_Expression :: PP_Doc} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression (T_Expression sem ) (Inh_Expression ) = + (let ( _lhsOattrs,_lhsOsemfunc) = sem + in (Syn_Expression _lhsOattrs _lhsOsemfunc )) +sem_Expression_Expression :: Pos -> + ([HsToken]) -> + T_Expression +sem_Expression_Expression pos_ tks_ = + (T_Expression (let _lhsOattrs :: (Set.Set String) + _lhsOsemfunc :: PP_Doc + -- "ExecutionPlan2Hs.ag"(line 368, column 16) + _lhsOattrs = + ({-# LINE 368 "ExecutionPlan2Hs.ag" #-} + Set.unions $ map (\tok -> attrs_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_ + {-# LINE 1928 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 369, column 16) + _lhsOsemfunc = + ({-# LINE 369 "ExecutionPlan2Hs.ag" #-} + vlist $ showTokens $ map (\tok -> tok_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_ + {-# LINE 1934 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOsemfunc)) ) +-- HsToken ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + attrs : Set.Set String + tok : (Pos,String) + alternatives: + alternative AGField: + child field : {Identifier} + child attr : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local addTrace : _ + alternative AGLocal: + child var : {Identifier} + child pos : {Pos} + child rdesc : {Maybe String} + visit 0: + local tok : _ + alternative CharToken: + child value : {String} + child pos : {Pos} + alternative Err: + child mesg : {String} + child pos : {Pos} + alternative HsToken: + child value : {String} + child pos : {Pos} + alternative StrToken: + child value : {String} + child pos : {Pos} +-} +-- cata +sem_HsToken :: HsToken -> + T_HsToken +sem_HsToken (AGField _field _attr _pos _rdesc ) = + (sem_HsToken_AGField _field _attr _pos _rdesc ) +sem_HsToken (AGLocal _var _pos _rdesc ) = + (sem_HsToken_AGLocal _var _pos _rdesc ) +sem_HsToken (CharToken _value _pos ) = + (sem_HsToken_CharToken _value _pos ) +sem_HsToken (Err _mesg _pos ) = + (sem_HsToken_Err _mesg _pos ) +sem_HsToken (HsToken _value _pos ) = + (sem_HsToken_HsToken _value _pos ) +sem_HsToken (StrToken _value _pos ) = + (sem_HsToken_StrToken _value _pos ) +-- semantic domain +newtype T_HsToken = T_HsToken (( (Set.Set String),((Pos,String)))) +data Inh_HsToken = Inh_HsToken {} +data Syn_HsToken = Syn_HsToken {attrs_Syn_HsToken :: (Set.Set String),tok_Syn_HsToken :: ((Pos,String))} +wrap_HsToken :: T_HsToken -> + Inh_HsToken -> + Syn_HsToken +wrap_HsToken (T_HsToken sem ) (Inh_HsToken ) = + (let ( _lhsOattrs,_lhsOtok) = sem + in (Syn_HsToken _lhsOattrs _lhsOtok )) +sem_HsToken_AGField :: Identifier -> + Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGField field_ attr_ pos_ rdesc_ = + (T_HsToken (let _lhsOattrs :: (Set.Set String) + _lhsOtok :: ((Pos,String)) + -- "ExecutionPlan2Hs.ag"(line 363, column 15) + _lhsOattrs = + ({-# LINE 363 "ExecutionPlan2Hs.ag" #-} + Set.singleton $ attrname True field_ attr_ + {-# LINE 2007 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 482, column 8) + _addTrace = + ({-# LINE 482 "ExecutionPlan2Hs.ag" #-} + case rdesc_ of + Just d -> \x -> "(trace " ++ show (d ++ " -> " ++ show field_ ++ "." ++ show attr_) ++ " (" ++ x ++ "))" + Nothing -> id + {-# LINE 2015 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 485, column 8) + _lhsOtok = + ({-# LINE 485 "ExecutionPlan2Hs.ag" #-} + (pos_, _addTrace $ attrname True field_ attr_) + {-# LINE 2021 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok)) ) +sem_HsToken_AGLocal :: Identifier -> + Pos -> + (Maybe String) -> + T_HsToken +sem_HsToken_AGLocal var_ pos_ rdesc_ = + (T_HsToken (let _lhsOattrs :: (Set.Set String) + _lhsOtok :: ((Pos,String)) + -- "ExecutionPlan2Hs.ag"(line 362, column 15) + _lhsOattrs = + ({-# LINE 362 "ExecutionPlan2Hs.ag" #-} + Set.singleton $ locname var_ + {-# LINE 2035 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 477, column 15) + _tok = + ({-# LINE 477 "ExecutionPlan2Hs.ag" #-} + (pos_,locname var_) + {-# LINE 2041 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (from local) + _lhsOtok = + ({-# LINE 480 "ExecutionPlan2Hs.ag" #-} + _tok + {-# LINE 2047 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok)) ) +sem_HsToken_CharToken :: String -> + Pos -> + T_HsToken +sem_HsToken_CharToken value_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Set.Set String) + -- "ExecutionPlan2Hs.ag"(line 489, column 16) + _lhsOtok = + ({-# LINE 489 "ExecutionPlan2Hs.ag" #-} + (pos_, if null value_ + then "" + else showCharShort (head value_) + ) + {-# LINE 2063 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 360, column 37) + _lhsOattrs = + ({-# LINE 360 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2069 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok)) ) +sem_HsToken_Err :: String -> + Pos -> + T_HsToken +sem_HsToken_Err mesg_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Set.Set String) + -- "ExecutionPlan2Hs.ag"(line 495, column 16) + _lhsOtok = + ({-# LINE 495 "ExecutionPlan2Hs.ag" #-} + (pos_, "") + {-# LINE 2082 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 360, column 37) + _lhsOattrs = + ({-# LINE 360 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2088 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok)) ) +sem_HsToken_HsToken :: String -> + Pos -> + T_HsToken +sem_HsToken_HsToken value_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Set.Set String) + -- "ExecutionPlan2Hs.ag"(line 487, column 14) + _lhsOtok = + ({-# LINE 487 "ExecutionPlan2Hs.ag" #-} + (pos_, value_) + {-# LINE 2101 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 360, column 37) + _lhsOattrs = + ({-# LINE 360 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2107 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok)) ) +sem_HsToken_StrToken :: String -> + Pos -> + T_HsToken +sem_HsToken_StrToken value_ pos_ = + (T_HsToken (let _lhsOtok :: ((Pos,String)) + _lhsOattrs :: (Set.Set String) + -- "ExecutionPlan2Hs.ag"(line 494, column 16) + _lhsOtok = + ({-# LINE 494 "ExecutionPlan2Hs.ag" #-} + (pos_, showStrShort value_) + {-# LINE 2120 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 360, column 37) + _lhsOattrs = + ({-# LINE 360 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2126 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOtok)) ) +-- HsTokens ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + tks : [(Pos,String)] + alternatives: + alternative Cons: + child hd : HsToken + child tl : HsTokens + alternative Nil: +-} +-- cata +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 (( ([(Pos,String)]))) +data Inh_HsTokens = Inh_HsTokens {} +data Syn_HsTokens = Syn_HsTokens {tks_Syn_HsTokens :: ([(Pos,String)])} +wrap_HsTokens :: T_HsTokens -> + Inh_HsTokens -> + Syn_HsTokens +wrap_HsTokens (T_HsTokens sem ) (Inh_HsTokens ) = + (let ( _lhsOtks) = sem + in (Syn_HsTokens _lhsOtks )) +sem_HsTokens_Cons :: T_HsToken -> + T_HsTokens -> + T_HsTokens +sem_HsTokens_Cons (T_HsToken hd_ ) (T_HsTokens tl_ ) = + (T_HsTokens (let _lhsOtks :: ([(Pos,String)]) + _hdIattrs :: (Set.Set String) + _hdItok :: ((Pos,String)) + _tlItks :: ([(Pos,String)]) + -- "ExecutionPlan2Hs.ag"(line 472, column 10) + _lhsOtks = + ({-# LINE 472 "ExecutionPlan2Hs.ag" #-} + _hdItok : _tlItks + {-# LINE 2167 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdIattrs,_hdItok) = + hd_ + ( _tlItks) = + tl_ + in ( _lhsOtks)) ) +sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil = + (T_HsTokens (let _lhsOtks :: ([(Pos,String)]) + -- "ExecutionPlan2Hs.ag"(line 473, column 10) + _lhsOtks = + ({-# LINE 473 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 2181 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOtks)) ) +-- HsTokensRoot ------------------------------------------------ +{- + alternatives: + alternative HsTokensRoot: + child tokens : HsTokens +-} +-- cata +sem_HsTokensRoot :: HsTokensRoot -> + T_HsTokensRoot +sem_HsTokensRoot (HsTokensRoot _tokens ) = + (sem_HsTokensRoot_HsTokensRoot (sem_HsTokens _tokens ) ) +-- semantic domain +newtype T_HsTokensRoot = T_HsTokensRoot (( )) +data Inh_HsTokensRoot = Inh_HsTokensRoot {} +data Syn_HsTokensRoot = Syn_HsTokensRoot {} +wrap_HsTokensRoot :: T_HsTokensRoot -> + Inh_HsTokensRoot -> + Syn_HsTokensRoot +wrap_HsTokensRoot (T_HsTokensRoot sem ) (Inh_HsTokensRoot ) = + (let ( ) = sem + in (Syn_HsTokensRoot )) +sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> + T_HsTokensRoot +sem_HsTokensRoot_HsTokensRoot (T_HsTokens tokens_ ) = + (T_HsTokensRoot (let _tokensItks :: ([(Pos,String)]) + ( _tokensItks) = + tokens_ + in ( )) ) +-- Pattern ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + attrs : Set.Set String + copy : SELF + sem_lhs : PP_Doc + alternatives: + alternative Alias: + child field : {Identifier} + child attr : {Identifier} + child pat : Pattern + child parts : Patterns + visit 0: + local copy : _ + alternative Constr: + child name : {ConstructorIdent} + child pats : Patterns + visit 0: + local copy : _ + alternative Irrefutable: + child pat : Pattern + visit 0: + local copy : _ + alternative Product: + child pos : {Pos} + child pats : Patterns + visit 0: + local copy : _ + alternative Underscore: + child pos : {Pos} + visit 0: + local copy : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Alias _field _attr _pat _parts ) = + (sem_Pattern_Alias _field _attr (sem_Pattern _pat ) (sem_Patterns _parts ) ) +sem_Pattern (Constr _name _pats ) = + (sem_Pattern_Constr _name (sem_Patterns _pats ) ) +sem_Pattern (Irrefutable _pat ) = + (sem_Pattern_Irrefutable (sem_Pattern _pat ) ) +sem_Pattern (Product _pos _pats ) = + (sem_Pattern_Product _pos (sem_Patterns _pats ) ) +sem_Pattern (Underscore _pos ) = + (sem_Pattern_Underscore _pos ) +-- semantic domain +newtype T_Pattern = T_Pattern (( (Set.Set String),Pattern ,PP_Doc)) +data Inh_Pattern = Inh_Pattern {} +data Syn_Pattern = Syn_Pattern {attrs_Syn_Pattern :: (Set.Set String),copy_Syn_Pattern :: Pattern ,sem_lhs_Syn_Pattern :: PP_Doc} +wrap_Pattern :: T_Pattern -> + Inh_Pattern -> + Syn_Pattern +wrap_Pattern (T_Pattern sem ) (Inh_Pattern ) = + (let ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs) = sem + in (Syn_Pattern _lhsOattrs _lhsOcopy _lhsOsem_lhs )) +sem_Pattern_Alias :: Identifier -> + Identifier -> + T_Pattern -> + T_Patterns -> + T_Pattern +sem_Pattern_Alias field_ attr_ (T_Pattern pat_ ) (T_Patterns parts_ ) = + (T_Pattern (let _lhsOsem_lhs :: PP_Doc + _lhsOattrs :: (Set.Set String) + _lhsOcopy :: Pattern + _patIattrs :: (Set.Set String) + _patIcopy :: Pattern + _patIsem_lhs :: PP_Doc + _partsIattrs :: (Set.Set String) + _partsIcopy :: Patterns + _partsIsem_lhs :: ([PP_Doc]) + -- "ExecutionPlan2Hs.ag"(line 353, column 17) + _lhsOsem_lhs = + ({-# LINE 353 "ExecutionPlan2Hs.ag" #-} + text $ attrname False field_ attr_ + {-# LINE 2288 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 354, column 17) + _lhsOattrs = + ({-# LINE 354 "ExecutionPlan2Hs.ag" #-} + Set.singleton $ attrname False field_ attr_ + {-# LINE 2294 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Alias field_ attr_ _patIcopy _partsIcopy + {-# LINE 2300 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2306 "ExecutionPlan2Hs.hs" #-} + ) + ( _patIattrs,_patIcopy,_patIsem_lhs) = + pat_ + ( _partsIattrs,_partsIcopy,_partsIsem_lhs) = + parts_ + in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs)) ) +sem_Pattern_Constr :: ConstructorIdent -> + T_Patterns -> + T_Pattern +sem_Pattern_Constr name_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOsem_lhs :: PP_Doc + _lhsOattrs :: (Set.Set String) + _lhsOcopy :: Pattern + _patsIattrs :: (Set.Set String) + _patsIcopy :: Patterns + _patsIsem_lhs :: ([PP_Doc]) + -- "ExecutionPlan2Hs.ag"(line 356, column 17) + _lhsOsem_lhs = + ({-# LINE 356 "ExecutionPlan2Hs.ag" #-} + pp_parens $ name_ >#< hv_sp _patsIsem_lhs + {-# LINE 2327 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 347, column 27) + _lhsOattrs = + ({-# LINE 347 "ExecutionPlan2Hs.ag" #-} + _patsIattrs + {-# LINE 2333 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Constr name_ _patsIcopy + {-# LINE 2339 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2345 "ExecutionPlan2Hs.hs" #-} + ) + ( _patsIattrs,_patsIcopy,_patsIsem_lhs) = + pats_ + in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs)) ) +sem_Pattern_Irrefutable :: T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable (T_Pattern pat_ ) = + (T_Pattern (let _lhsOsem_lhs :: PP_Doc + _lhsOattrs :: (Set.Set String) + _lhsOcopy :: Pattern + _patIattrs :: (Set.Set String) + _patIcopy :: Pattern + _patIsem_lhs :: PP_Doc + -- "ExecutionPlan2Hs.ag"(line 358, column 17) + _lhsOsem_lhs = + ({-# LINE 358 "ExecutionPlan2Hs.ag" #-} + text "~" >|< pp_parens _patIsem_lhs + {-# LINE 2363 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 347, column 27) + _lhsOattrs = + ({-# LINE 347 "ExecutionPlan2Hs.ag" #-} + _patIattrs + {-# LINE 2369 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Irrefutable _patIcopy + {-# LINE 2375 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2381 "ExecutionPlan2Hs.hs" #-} + ) + ( _patIattrs,_patIcopy,_patIsem_lhs) = + pat_ + in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs)) ) +sem_Pattern_Product :: Pos -> + T_Patterns -> + T_Pattern +sem_Pattern_Product pos_ (T_Patterns pats_ ) = + (T_Pattern (let _lhsOsem_lhs :: PP_Doc + _lhsOattrs :: (Set.Set String) + _lhsOcopy :: Pattern + _patsIattrs :: (Set.Set String) + _patsIcopy :: Patterns + _patsIsem_lhs :: ([PP_Doc]) + -- "ExecutionPlan2Hs.ag"(line 355, column 17) + _lhsOsem_lhs = + ({-# LINE 355 "ExecutionPlan2Hs.ag" #-} + pp_block "(" ")" "," _patsIsem_lhs + {-# LINE 2400 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 347, column 27) + _lhsOattrs = + ({-# LINE 347 "ExecutionPlan2Hs.ag" #-} + _patsIattrs + {-# LINE 2406 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Product pos_ _patsIcopy + {-# LINE 2412 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2418 "ExecutionPlan2Hs.hs" #-} + ) + ( _patsIattrs,_patsIcopy,_patsIsem_lhs) = + pats_ + in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs)) ) +sem_Pattern_Underscore :: Pos -> + T_Pattern +sem_Pattern_Underscore pos_ = + (T_Pattern (let _lhsOsem_lhs :: PP_Doc + _lhsOattrs :: (Set.Set String) + _lhsOcopy :: Pattern + -- "ExecutionPlan2Hs.ag"(line 357, column 17) + _lhsOsem_lhs = + ({-# LINE 357 "ExecutionPlan2Hs.ag" #-} + text "_" + {-# LINE 2433 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 347, column 27) + _lhsOattrs = + ({-# LINE 347 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2439 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + Underscore pos_ + {-# LINE 2445 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2451 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs)) ) +-- Patterns ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + attrs : Set.Set String + copy : SELF + sem_lhs : [PP_Doc] + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +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 (( (Set.Set String),Patterns ,([PP_Doc]))) +data Inh_Patterns = Inh_Patterns {} +data Syn_Patterns = Syn_Patterns {attrs_Syn_Patterns :: (Set.Set String),copy_Syn_Patterns :: Patterns ,sem_lhs_Syn_Patterns :: ([PP_Doc])} +wrap_Patterns :: T_Patterns -> + Inh_Patterns -> + Syn_Patterns +wrap_Patterns (T_Patterns sem ) (Inh_Patterns ) = + (let ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs) = sem + in (Syn_Patterns _lhsOattrs _lhsOcopy _lhsOsem_lhs )) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons (T_Pattern hd_ ) (T_Patterns tl_ ) = + (T_Patterns (let _lhsOattrs :: (Set.Set String) + _lhsOsem_lhs :: ([PP_Doc]) + _lhsOcopy :: Patterns + _hdIattrs :: (Set.Set String) + _hdIcopy :: Pattern + _hdIsem_lhs :: PP_Doc + _tlIattrs :: (Set.Set String) + _tlIcopy :: Patterns + _tlIsem_lhs :: ([PP_Doc]) + -- use rule "ExecutionPlan2Hs.ag"(line 349, column 27) + _lhsOattrs = + ({-# LINE 349 "ExecutionPlan2Hs.ag" #-} + _hdIattrs `Set.union` _tlIattrs + {-# LINE 2503 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 350, column 29) + _lhsOsem_lhs = + ({-# LINE 350 "ExecutionPlan2Hs.ag" #-} + _hdIsem_lhs : _tlIsem_lhs + {-# LINE 2509 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + (:) _hdIcopy _tlIcopy + {-# LINE 2515 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2521 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdIattrs,_hdIcopy,_hdIsem_lhs) = + hd_ + ( _tlIattrs,_tlIcopy,_tlIsem_lhs) = + tl_ + in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs)) ) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (T_Patterns (let _lhsOattrs :: (Set.Set String) + _lhsOsem_lhs :: ([PP_Doc]) + _lhsOcopy :: Patterns + -- use rule "ExecutionPlan2Hs.ag"(line 349, column 27) + _lhsOattrs = + ({-# LINE 349 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2537 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 350, column 29) + _lhsOsem_lhs = + ({-# LINE 350 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 2543 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _copy = + ({-# LINE 23 "./Patterns.ag" #-} + [] + {-# LINE 2549 "ExecutionPlan2Hs.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 23 "./Patterns.ag" #-} + _copy + {-# LINE 2555 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOattrs,_lhsOcopy,_lhsOsem_lhs)) ) +-- Visit ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + allintramap : Map.Map StateIdentifier (Set.Set String) + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + childintros : Map.Map Identifier PP_Doc + inhmap : Attributes + mrules : Map.Map Identifier PP_Doc + nt : NontermIdent + ruledefs : Map.Map Identifier (Set.Set String) + ruleuses : Map.Map Identifier (Set.Set String) + synmap : Attributes + terminaldefs : Set.Set String + synthesized attributes: + allvisits : (VisitIdentifier,StateIdentifier, StateIdentifier) + childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + intramap : Map.Map StateIdentifier (Set.Set String) + sem_visit : (StateIdentifier,PP_Doc) + t_visits : PP_Doc + usedrules : Set.Set Identifier + visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + visituses : Map.Map VisitIdentifier (Set.Set Identifier) + alternatives: + alternative Visit: + child ident : {VisitIdentifier} + child from : {StateIdentifier} + child to : {StateIdentifier} + child inh : {Set.Set Identifier} + child syn : {Set.Set Identifier} + child steps : VisitSteps + visit 0: + local inhpart : _ + local synpart : _ + local inhargs : _ + local synargs : _ + local nextargs : _ + local sem_steps : _ + local nextintra : _ + local uses : _ + local defs : _ +-} +-- cata +sem_Visit :: Visit -> + T_Visit +sem_Visit (Visit _ident _from _to _inh _syn _steps ) = + (sem_Visit_Visit _ident _from _to _inh _syn (sem_VisitSteps _steps ) ) +-- semantic domain +newtype T_Visit = T_Visit ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Map.Map StateIdentifier (Set.Set String)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map Identifier PP_Doc) -> + Attributes -> + (Map.Map Identifier PP_Doc) -> + NontermIdent -> + (Map.Map Identifier (Set.Set String)) -> + (Map.Map Identifier (Set.Set String)) -> + Attributes -> + (Set.Set String) -> + ( ((VisitIdentifier,StateIdentifier, StateIdentifier)),(Map.Map VisitIdentifier (Identifier -> PP_Doc)),(Map.Map StateIdentifier (Set.Set String)),( (StateIdentifier,PP_Doc) ),PP_Doc,(Set.Set Identifier),(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) +data Inh_Visit = Inh_Visit {allchildvisit_Inh_Visit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),allintramap_Inh_Visit :: (Map.Map StateIdentifier (Set.Set String)),avisitdefs_Inh_Visit :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_Visit :: (Map.Map VisitIdentifier (Set.Set Identifier)),childintros_Inh_Visit :: (Map.Map Identifier PP_Doc),inhmap_Inh_Visit :: Attributes,mrules_Inh_Visit :: (Map.Map Identifier PP_Doc),nt_Inh_Visit :: NontermIdent,ruledefs_Inh_Visit :: (Map.Map Identifier (Set.Set String)),ruleuses_Inh_Visit :: (Map.Map Identifier (Set.Set String)),synmap_Inh_Visit :: Attributes,terminaldefs_Inh_Visit :: (Set.Set String)} +data Syn_Visit = Syn_Visit {allvisits_Syn_Visit :: ((VisitIdentifier,StateIdentifier, StateIdentifier)),childvisit_Syn_Visit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),intramap_Syn_Visit :: (Map.Map StateIdentifier (Set.Set String)),sem_visit_Syn_Visit :: ( (StateIdentifier,PP_Doc) ),t_visits_Syn_Visit :: PP_Doc,usedrules_Syn_Visit :: (Set.Set Identifier),visitdefs_Syn_Visit :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_Visit :: (Map.Map VisitIdentifier (Set.Set Identifier))} +wrap_Visit :: T_Visit -> + Inh_Visit -> + Syn_Visit +wrap_Visit (T_Visit sem ) (Inh_Visit _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsIinhmap _lhsImrules _lhsInt _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs ) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOintramap,_lhsOsem_visit,_lhsOt_visits,_lhsOusedrules,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsIinhmap _lhsImrules _lhsInt _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs + in (Syn_Visit _lhsOallvisits _lhsOchildvisit _lhsOintramap _lhsOsem_visit _lhsOt_visits _lhsOusedrules _lhsOvisitdefs _lhsOvisituses )) +sem_Visit_Visit :: VisitIdentifier -> + StateIdentifier -> + StateIdentifier -> + (Set.Set Identifier) -> + (Set.Set Identifier) -> + T_VisitSteps -> + T_Visit +sem_Visit_Visit ident_ from_ to_ inh_ syn_ (T_VisitSteps steps_ ) = + (T_Visit (\ _lhsIallchildvisit + _lhsIallintramap + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsIinhmap + _lhsImrules + _lhsInt + _lhsIruledefs + _lhsIruleuses + _lhsIsynmap + _lhsIterminaldefs -> + (let _lhsOallvisits :: ((VisitIdentifier,StateIdentifier, StateIdentifier)) + _lhsOt_visits :: PP_Doc + _lhsOsem_visit :: ( (StateIdentifier,PP_Doc) ) + _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOintramap :: (Map.Map StateIdentifier (Set.Set String)) + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOusedrules :: (Set.Set Identifier) + _stepsOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _stepsOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _stepsOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _stepsOchildintros :: (Map.Map Identifier PP_Doc) + _stepsOmrules :: (Map.Map Identifier PP_Doc) + _stepsOruledefs :: (Map.Map Identifier (Set.Set String)) + _stepsOruleuses :: (Map.Map Identifier (Set.Set String)) + _stepsIdefs :: (Set.Set String) + _stepsIsem_steps :: PP_Doc + _stepsIusedrules :: (Set.Set Identifier) + _stepsIuses :: (Set.Set String) + -- "ExecutionPlan2Hs.ag"(line 141, column 11) + _lhsOallvisits = + ({-# LINE 141 "ExecutionPlan2Hs.ag" #-} + (ident_, from_, to_) + {-# LINE 2672 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 197, column 11) + _lhsOt_visits = + ({-# LINE 197 "ExecutionPlan2Hs.ag" #-} + "type" >#< "T_" >|< _lhsInt >|< "_v" >|< ident_ >#< "=" >#< _inhpart >#< + "Identity" >#< "(" >#< _synpart >#< "T_" >|< _lhsInt >|< "_s" >|< to_ >#< ")" + {-# LINE 2679 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 199, column 11) + _inhpart = + ({-# LINE 199 "ExecutionPlan2Hs.ag" #-} + if Set.null inh_ + then empty + else (ppSpaced $ map (\i -> (\x -> x >#< "->") $ typeToHaskellString (Just _lhsInt) [] + $ fromJust $ Map.lookup i _lhsIinhmap) $ Set.toList inh_) + {-# LINE 2688 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 203, column 11) + _synpart = + ({-# LINE 203 "ExecutionPlan2Hs.ag" #-} + if Set.null syn_ + then empty + else (ppCommas $ map (\i -> typeToHaskellString (Just _lhsInt) [] $ fromJust $ Map.lookup i _lhsIsynmap) $ Set.toList syn_) >#< "," + {-# LINE 2696 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 292, column 11) + _lhsOsem_visit = + ({-# LINE 292 "ExecutionPlan2Hs.ag" #-} + (from_, "v" >|< ident_ >#< "::" >#< "T_" >|< _lhsInt >|< "_v" >|< ident_ + >-< "v" >|< ident_ >#< (_inhargs _LHS True) >#< "=" >#< "do" + >-< indent 3 _sem_steps ) + {-# LINE 2704 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 295, column 11) + _inhargs = + ({-# LINE 295 "ExecutionPlan2Hs.ag" #-} + \chn inh -> ppSpaced $ map (\arg -> attrname inh chn arg) $ Set.toList inh_ + {-# LINE 2710 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 296, column 11) + _synargs = + ({-# LINE 296 "ExecutionPlan2Hs.ag" #-} + ppSpaced $ map (\arg -> attrname False _LHS arg >#< ",") $ Set.toList syn_ + {-# LINE 2716 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 297, column 11) + _nextargs = + ({-# LINE 297 "ExecutionPlan2Hs.ag" #-} + ppSpaced $ Set.toList $ maybe Set.empty id $ Map.lookup to_ _lhsIallintramap + {-# LINE 2722 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 298, column 11) + _sem_steps = + ({-# LINE 298 "ExecutionPlan2Hs.ag" #-} + _stepsIsem_steps + >-< "return" >#< "(" >#< _synargs >#< "st" >|< to_ >#< _nextargs >#< ")" + {-# LINE 2729 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 387, column 11) + _lhsOchildvisit = + ({-# LINE 387 "ExecutionPlan2Hs.ag" #-} + Map.singleton ident_ $ \chn -> "(" >#< ppSpaced ( + map (\x -> attrname True chn x >#< ",") $ Set.toList syn_) >#< locname chn + >#< ")" >#< "<-" >#< "inv_" >|< _lhsInt >|< "_s" >|< from_ >#< locname chn + >#< "K_" >|< _lhsInt >|< "_v" >|< ident_ >#< _inhargs chn False + {-# LINE 2738 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 413, column 11) + _lhsOintramap = + ({-# LINE 413 "ExecutionPlan2Hs.ag" #-} + Map.singleton from_ $ (_uses `Set.union` _nextintra ) `Set.difference` _defs + {-# LINE 2744 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 414, column 11) + _nextintra = + ({-# LINE 414 "ExecutionPlan2Hs.ag" #-} + maybe Set.empty id $ Map.lookup to_ _lhsIallintramap + {-# LINE 2750 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 415, column 11) + _uses = + ({-# LINE 415 "ExecutionPlan2Hs.ag" #-} + _stepsIuses + {-# LINE 2756 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 416, column 11) + _defs = + ({-# LINE 416 "ExecutionPlan2Hs.ag" #-} + _stepsIdefs `Set.union` (Set.map (lhsname True) inh_) `Set.union` _lhsIterminaldefs + {-# LINE 2762 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 440, column 11) + _lhsOvisitdefs = + ({-# LINE 440 "ExecutionPlan2Hs.ag" #-} + Map.singleton ident_ syn_ + {-# LINE 2768 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 441, column 11) + _lhsOvisituses = + ({-# LINE 441 "ExecutionPlan2Hs.ag" #-} + Map.singleton ident_ inh_ + {-# LINE 2774 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + _stepsIusedrules + {-# LINE 2780 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallchildvisit = + ({-# LINE 381 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 2786 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 2792 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 2798 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOchildintros = + ({-# LINE 321 "ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 2804 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOmrules = + ({-# LINE 303 "ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 2810 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOruledefs = + ({-# LINE 421 "ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 2816 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOruleuses = + ({-# LINE 422 "ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 2822 "ExecutionPlan2Hs.hs" #-} + ) + ( _stepsIdefs,_stepsIsem_steps,_stepsIusedrules,_stepsIuses) = + steps_ _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildintros _stepsOmrules _stepsOruledefs _stepsOruleuses + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOintramap,_lhsOsem_visit,_lhsOt_visits,_lhsOusedrules,_lhsOvisitdefs,_lhsOvisituses))) ) +-- VisitStep --------------------------------------------------- +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + childintros : Map.Map Identifier PP_Doc + mrules : Map.Map Identifier PP_Doc + ruledefs : Map.Map Identifier (Set.Set String) + ruleuses : Map.Map Identifier (Set.Set String) + synthesized attributes: + defs : Set.Set String + sem_steps : PP_Doc + usedrules : Set.Set Identifier + uses : Set.Set String + alternatives: + alternative ChildIntro: + child child : {Identifier} + alternative ChildVisit: + child child : {Identifier} + child nonterm : {NontermIdent} + child visit : {VisitIdentifier} + alternative Sem: + child name : {Identifier} + alternative Sim: + child steps : VisitSteps +-} +-- cata +sem_VisitStep :: VisitStep -> + T_VisitStep +sem_VisitStep (ChildIntro _child ) = + (sem_VisitStep_ChildIntro _child ) +sem_VisitStep (ChildVisit _child _nonterm _visit ) = + (sem_VisitStep_ChildVisit _child _nonterm _visit ) +sem_VisitStep (Sem _name ) = + (sem_VisitStep_Sem _name ) +sem_VisitStep (Sim _steps ) = + (sem_VisitStep_Sim (sem_VisitSteps _steps ) ) +-- semantic domain +newtype T_VisitStep = T_VisitStep ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map Identifier PP_Doc) -> + (Map.Map Identifier PP_Doc) -> + (Map.Map Identifier (Set.Set String)) -> + (Map.Map Identifier (Set.Set String)) -> + ( (Set.Set String),PP_Doc,(Set.Set Identifier),(Set.Set String))) +data Inh_VisitStep = Inh_VisitStep {allchildvisit_Inh_VisitStep :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),avisitdefs_Inh_VisitStep :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_VisitStep :: (Map.Map VisitIdentifier (Set.Set Identifier)),childintros_Inh_VisitStep :: (Map.Map Identifier PP_Doc),mrules_Inh_VisitStep :: (Map.Map Identifier PP_Doc),ruledefs_Inh_VisitStep :: (Map.Map Identifier (Set.Set String)),ruleuses_Inh_VisitStep :: (Map.Map Identifier (Set.Set String))} +data Syn_VisitStep = Syn_VisitStep {defs_Syn_VisitStep :: (Set.Set String),sem_steps_Syn_VisitStep :: PP_Doc,usedrules_Syn_VisitStep :: (Set.Set Identifier),uses_Syn_VisitStep :: (Set.Set String)} +wrap_VisitStep :: T_VisitStep -> + Inh_VisitStep -> + Syn_VisitStep +wrap_VisitStep (T_VisitStep sem ) (Inh_VisitStep _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsImrules _lhsIruledefs _lhsIruleuses ) = + (let ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses) = sem _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsImrules _lhsIruledefs _lhsIruleuses + in (Syn_VisitStep _lhsOdefs _lhsOsem_steps _lhsOusedrules _lhsOuses )) +sem_VisitStep_ChildIntro :: Identifier -> + T_VisitStep +sem_VisitStep_ChildIntro child_ = + (T_VisitStep (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsImrules + _lhsIruledefs + _lhsIruleuses -> + (let _lhsOsem_steps :: PP_Doc + _lhsOdefs :: (Set.Set String) + _lhsOusedrules :: (Set.Set Identifier) + _lhsOuses :: (Set.Set String) + -- "ExecutionPlan2Hs.ag"(line 307, column 16) + _lhsOsem_steps = + ({-# LINE 307 "ExecutionPlan2Hs.ag" #-} + maybe (error $ "Child " ++ show child_ ++ " not found in: " ++ show _lhsIchildintros) id $ Map.lookup child_ _lhsIchildintros + {-# LINE 2901 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 458, column 16) + _lhsOdefs = + ({-# LINE 458 "ExecutionPlan2Hs.ag" #-} + Set.singleton $ locname child_ + {-# LINE 2907 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2913 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 454, column 38) + _lhsOuses = + ({-# LINE 454 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2919 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) +sem_VisitStep_ChildVisit :: Identifier -> + NontermIdent -> + VisitIdentifier -> + T_VisitStep +sem_VisitStep_ChildVisit child_ nonterm_ visit_ = + (T_VisitStep (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsImrules + _lhsIruledefs + _lhsIruleuses -> + (let _lhsOsem_steps :: PP_Doc + _lhsOdefs :: (Set.Set String) + _lhsOuses :: (Set.Set String) + _lhsOusedrules :: (Set.Set Identifier) + -- "ExecutionPlan2Hs.ag"(line 308, column 16) + _lhsOsem_steps = + ({-# LINE 308 "ExecutionPlan2Hs.ag" #-} + (maybe (error "Visit not found") id $ Map.lookup visit_ _lhsIallchildvisit) $ child_ + {-# LINE 2942 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 459, column 16) + _lhsOdefs = + ({-# LINE 459 "ExecutionPlan2Hs.ag" #-} + maybe (error "Visit not found") (Set.map $ attrname True child_) $ Map.lookup visit_ _lhsIavisitdefs + {-# LINE 2948 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 460, column 16) + _lhsOuses = + ({-# LINE 460 "ExecutionPlan2Hs.ag" #-} + Set.insert (locname child_) $ + maybe (error "Visit not found") (Set.map $ attrname False child_) $ Map.lookup visit_ _lhsIavisituses + {-# LINE 2955 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 2961 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) +sem_VisitStep_Sem :: Identifier -> + T_VisitStep +sem_VisitStep_Sem name_ = + (T_VisitStep (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsImrules + _lhsIruledefs + _lhsIruleuses -> + (let _lhsOusedrules :: (Set.Set Identifier) + _lhsOsem_steps :: PP_Doc + _lhsOdefs :: (Set.Set String) + _lhsOuses :: (Set.Set String) + -- "ExecutionPlan2Hs.ag"(line 179, column 9) + _lhsOusedrules = + ({-# LINE 179 "ExecutionPlan2Hs.ag" #-} + Set.singleton name_ + {-# LINE 2982 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 306, column 16) + _lhsOsem_steps = + ({-# LINE 306 "ExecutionPlan2Hs.ag" #-} + maybe (error "Rule not found") id $ Map.lookup name_ _lhsImrules + {-# LINE 2988 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 456, column 16) + _lhsOdefs = + ({-# LINE 456 "ExecutionPlan2Hs.ag" #-} + maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruledefs + {-# LINE 2994 "ExecutionPlan2Hs.hs" #-} + ) + -- "ExecutionPlan2Hs.ag"(line 457, column 16) + _lhsOuses = + ({-# LINE 457 "ExecutionPlan2Hs.ag" #-} + maybe (error "Rule not found") id $ Map.lookup name_ _lhsIruleuses + {-# LINE 3000 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) +sem_VisitStep_Sim :: T_VisitSteps -> + T_VisitStep +sem_VisitStep_Sim (T_VisitSteps steps_ ) = + (T_VisitStep (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsImrules + _lhsIruledefs + _lhsIruleuses -> + (let _lhsOdefs :: (Set.Set String) + _lhsOsem_steps :: PP_Doc + _lhsOusedrules :: (Set.Set Identifier) + _lhsOuses :: (Set.Set String) + _stepsOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _stepsOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _stepsOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _stepsOchildintros :: (Map.Map Identifier PP_Doc) + _stepsOmrules :: (Map.Map Identifier PP_Doc) + _stepsOruledefs :: (Map.Map Identifier (Set.Set String)) + _stepsOruleuses :: (Map.Map Identifier (Set.Set String)) + _stepsIdefs :: (Set.Set String) + _stepsIsem_steps :: PP_Doc + _stepsIusedrules :: (Set.Set Identifier) + _stepsIuses :: (Set.Set String) + -- use rule "ExecutionPlan2Hs.ag"(line 453, column 38) + _lhsOdefs = + ({-# LINE 453 "ExecutionPlan2Hs.ag" #-} + _stepsIdefs + {-# LINE 3032 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 304, column 43) + _lhsOsem_steps = + ({-# LINE 304 "ExecutionPlan2Hs.ag" #-} + _stepsIsem_steps + {-# LINE 3038 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + _stepsIusedrules + {-# LINE 3044 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 454, column 38) + _lhsOuses = + ({-# LINE 454 "ExecutionPlan2Hs.ag" #-} + _stepsIuses + {-# LINE 3050 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOallchildvisit = + ({-# LINE 381 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 3056 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 3062 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 3068 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOchildintros = + ({-# LINE 321 "ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 3074 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOmrules = + ({-# LINE 303 "ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 3080 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOruledefs = + ({-# LINE 421 "ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 3086 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _stepsOruleuses = + ({-# LINE 422 "ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 3092 "ExecutionPlan2Hs.hs" #-} + ) + ( _stepsIdefs,_stepsIsem_steps,_stepsIusedrules,_stepsIuses) = + steps_ _stepsOallchildvisit _stepsOavisitdefs _stepsOavisituses _stepsOchildintros _stepsOmrules _stepsOruledefs _stepsOruleuses + in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) +-- VisitSteps -------------------------------------------------- +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + childintros : Map.Map Identifier PP_Doc + mrules : Map.Map Identifier PP_Doc + ruledefs : Map.Map Identifier (Set.Set String) + ruleuses : Map.Map Identifier (Set.Set String) + synthesized attributes: + defs : Set.Set String + sem_steps : PP_Doc + usedrules : Set.Set Identifier + uses : Set.Set String + alternatives: + alternative Cons: + child hd : VisitStep + child tl : VisitSteps + alternative Nil: +-} +-- cata +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 ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map Identifier PP_Doc) -> + (Map.Map Identifier PP_Doc) -> + (Map.Map Identifier (Set.Set String)) -> + (Map.Map Identifier (Set.Set String)) -> + ( (Set.Set String),PP_Doc,(Set.Set Identifier),(Set.Set String))) +data Inh_VisitSteps = Inh_VisitSteps {allchildvisit_Inh_VisitSteps :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),avisitdefs_Inh_VisitSteps :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_VisitSteps :: (Map.Map VisitIdentifier (Set.Set Identifier)),childintros_Inh_VisitSteps :: (Map.Map Identifier PP_Doc),mrules_Inh_VisitSteps :: (Map.Map Identifier PP_Doc),ruledefs_Inh_VisitSteps :: (Map.Map Identifier (Set.Set String)),ruleuses_Inh_VisitSteps :: (Map.Map Identifier (Set.Set String))} +data Syn_VisitSteps = Syn_VisitSteps {defs_Syn_VisitSteps :: (Set.Set String),sem_steps_Syn_VisitSteps :: PP_Doc,usedrules_Syn_VisitSteps :: (Set.Set Identifier),uses_Syn_VisitSteps :: (Set.Set String)} +wrap_VisitSteps :: T_VisitSteps -> + Inh_VisitSteps -> + Syn_VisitSteps +wrap_VisitSteps (T_VisitSteps sem ) (Inh_VisitSteps _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsImrules _lhsIruledefs _lhsIruleuses ) = + (let ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses) = sem _lhsIallchildvisit _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsImrules _lhsIruledefs _lhsIruleuses + in (Syn_VisitSteps _lhsOdefs _lhsOsem_steps _lhsOusedrules _lhsOuses )) +sem_VisitSteps_Cons :: T_VisitStep -> + T_VisitSteps -> + T_VisitSteps +sem_VisitSteps_Cons (T_VisitStep hd_ ) (T_VisitSteps tl_ ) = + (T_VisitSteps (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsImrules + _lhsIruledefs + _lhsIruleuses -> + (let _lhsOdefs :: (Set.Set String) + _lhsOsem_steps :: PP_Doc + _lhsOusedrules :: (Set.Set Identifier) + _lhsOuses :: (Set.Set String) + _hdOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _hdOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOchildintros :: (Map.Map Identifier PP_Doc) + _hdOmrules :: (Map.Map Identifier PP_Doc) + _hdOruledefs :: (Map.Map Identifier (Set.Set String)) + _hdOruleuses :: (Map.Map Identifier (Set.Set String)) + _tlOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _tlOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOchildintros :: (Map.Map Identifier PP_Doc) + _tlOmrules :: (Map.Map Identifier PP_Doc) + _tlOruledefs :: (Map.Map Identifier (Set.Set String)) + _tlOruleuses :: (Map.Map Identifier (Set.Set String)) + _hdIdefs :: (Set.Set String) + _hdIsem_steps :: PP_Doc + _hdIusedrules :: (Set.Set Identifier) + _hdIuses :: (Set.Set String) + _tlIdefs :: (Set.Set String) + _tlIsem_steps :: PP_Doc + _tlIusedrules :: (Set.Set Identifier) + _tlIuses :: (Set.Set String) + -- use rule "ExecutionPlan2Hs.ag"(line 453, column 38) + _lhsOdefs = + ({-# LINE 453 "ExecutionPlan2Hs.ag" #-} + _hdIdefs `Set.union` _tlIdefs + {-# LINE 3182 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 304, column 43) + _lhsOsem_steps = + ({-# LINE 304 "ExecutionPlan2Hs.ag" #-} + _hdIsem_steps >-< _tlIsem_steps + {-# LINE 3188 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + _hdIusedrules `Set.union` _tlIusedrules + {-# LINE 3194 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 454, column 38) + _lhsOuses = + ({-# LINE 454 "ExecutionPlan2Hs.ag" #-} + _hdIuses `Set.union` _tlIuses + {-# LINE 3200 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 381 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 3206 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 3212 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 3218 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOchildintros = + ({-# LINE 321 "ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 3224 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmrules = + ({-# LINE 303 "ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 3230 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOruledefs = + ({-# LINE 421 "ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 3236 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOruleuses = + ({-# LINE 422 "ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 3242 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 381 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 3248 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 3254 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 3260 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOchildintros = + ({-# LINE 321 "ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 3266 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmrules = + ({-# LINE 303 "ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 3272 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOruledefs = + ({-# LINE 421 "ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 3278 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOruleuses = + ({-# LINE 422 "ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 3284 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdIdefs,_hdIsem_steps,_hdIusedrules,_hdIuses) = + hd_ _hdOallchildvisit _hdOavisitdefs _hdOavisituses _hdOchildintros _hdOmrules _hdOruledefs _hdOruleuses + ( _tlIdefs,_tlIsem_steps,_tlIusedrules,_tlIuses) = + tl_ _tlOallchildvisit _tlOavisitdefs _tlOavisituses _tlOchildintros _tlOmrules _tlOruledefs _tlOruleuses + in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) +sem_VisitSteps_Nil :: T_VisitSteps +sem_VisitSteps_Nil = + (T_VisitSteps (\ _lhsIallchildvisit + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsImrules + _lhsIruledefs + _lhsIruleuses -> + (let _lhsOdefs :: (Set.Set String) + _lhsOsem_steps :: PP_Doc + _lhsOusedrules :: (Set.Set Identifier) + _lhsOuses :: (Set.Set String) + -- use rule "ExecutionPlan2Hs.ag"(line 453, column 38) + _lhsOdefs = + ({-# LINE 453 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 3308 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 304, column 43) + _lhsOsem_steps = + ({-# LINE 304 "ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 3314 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 3320 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 454, column 38) + _lhsOuses = + ({-# LINE 454 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 3326 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOdefs,_lhsOsem_steps,_lhsOusedrules,_lhsOuses))) ) +-- Visits ------------------------------------------------------ +{- + visit 0: + inherited attributes: + allchildvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + allintramap : Map.Map StateIdentifier (Set.Set String) + avisitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + avisituses : Map.Map VisitIdentifier (Set.Set Identifier) + childintros : Map.Map Identifier PP_Doc + inhmap : Attributes + mrules : Map.Map Identifier PP_Doc + nt : NontermIdent + ruledefs : Map.Map Identifier (Set.Set String) + ruleuses : Map.Map Identifier (Set.Set String) + synmap : Attributes + terminaldefs : Set.Set String + synthesized attributes: + allvisits : [(VisitIdentifier,StateIdentifier, StateIdentifier)] + childvisit : Map.Map VisitIdentifier (Identifier -> PP_Doc) + intramap : Map.Map StateIdentifier (Set.Set String) + sem_visit : [(StateIdentifier,PP_Doc)] + t_visits : PP_Doc + usedrules : Set.Set Identifier + visitdefs : Map.Map VisitIdentifier (Set.Set Identifier) + visituses : Map.Map VisitIdentifier (Set.Set Identifier) + alternatives: + alternative Cons: + child hd : Visit + child tl : Visits + alternative Nil: +-} +-- cata +sem_Visits :: Visits -> + T_Visits +sem_Visits list = + (Prelude.foldr sem_Visits_Cons sem_Visits_Nil (Prelude.map sem_Visit list) ) +-- semantic domain +newtype T_Visits = T_Visits ((Map.Map VisitIdentifier (Identifier -> PP_Doc)) -> + (Map.Map StateIdentifier (Set.Set String)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map VisitIdentifier (Set.Set Identifier)) -> + (Map.Map Identifier PP_Doc) -> + Attributes -> + (Map.Map Identifier PP_Doc) -> + NontermIdent -> + (Map.Map Identifier (Set.Set String)) -> + (Map.Map Identifier (Set.Set String)) -> + Attributes -> + (Set.Set String) -> + ( ([(VisitIdentifier,StateIdentifier, StateIdentifier)]),(Map.Map VisitIdentifier (Identifier -> PP_Doc)),(Map.Map StateIdentifier (Set.Set String)),( [(StateIdentifier,PP_Doc)] ),PP_Doc,(Set.Set Identifier),(Map.Map VisitIdentifier (Set.Set Identifier)),(Map.Map VisitIdentifier (Set.Set Identifier)))) +data Inh_Visits = Inh_Visits {allchildvisit_Inh_Visits :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),allintramap_Inh_Visits :: (Map.Map StateIdentifier (Set.Set String)),avisitdefs_Inh_Visits :: (Map.Map VisitIdentifier (Set.Set Identifier)),avisituses_Inh_Visits :: (Map.Map VisitIdentifier (Set.Set Identifier)),childintros_Inh_Visits :: (Map.Map Identifier PP_Doc),inhmap_Inh_Visits :: Attributes,mrules_Inh_Visits :: (Map.Map Identifier PP_Doc),nt_Inh_Visits :: NontermIdent,ruledefs_Inh_Visits :: (Map.Map Identifier (Set.Set String)),ruleuses_Inh_Visits :: (Map.Map Identifier (Set.Set String)),synmap_Inh_Visits :: Attributes,terminaldefs_Inh_Visits :: (Set.Set String)} +data Syn_Visits = Syn_Visits {allvisits_Syn_Visits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]),childvisit_Syn_Visits :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)),intramap_Syn_Visits :: (Map.Map StateIdentifier (Set.Set String)),sem_visit_Syn_Visits :: ( [(StateIdentifier,PP_Doc)] ),t_visits_Syn_Visits :: PP_Doc,usedrules_Syn_Visits :: (Set.Set Identifier),visitdefs_Syn_Visits :: (Map.Map VisitIdentifier (Set.Set Identifier)),visituses_Syn_Visits :: (Map.Map VisitIdentifier (Set.Set Identifier))} +wrap_Visits :: T_Visits -> + Inh_Visits -> + Syn_Visits +wrap_Visits (T_Visits sem ) (Inh_Visits _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsIinhmap _lhsImrules _lhsInt _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs ) = + (let ( _lhsOallvisits,_lhsOchildvisit,_lhsOintramap,_lhsOsem_visit,_lhsOt_visits,_lhsOusedrules,_lhsOvisitdefs,_lhsOvisituses) = sem _lhsIallchildvisit _lhsIallintramap _lhsIavisitdefs _lhsIavisituses _lhsIchildintros _lhsIinhmap _lhsImrules _lhsInt _lhsIruledefs _lhsIruleuses _lhsIsynmap _lhsIterminaldefs + in (Syn_Visits _lhsOallvisits _lhsOchildvisit _lhsOintramap _lhsOsem_visit _lhsOt_visits _lhsOusedrules _lhsOvisitdefs _lhsOvisituses )) +sem_Visits_Cons :: T_Visit -> + T_Visits -> + T_Visits +sem_Visits_Cons (T_Visit hd_ ) (T_Visits tl_ ) = + (T_Visits (\ _lhsIallchildvisit + _lhsIallintramap + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsIinhmap + _lhsImrules + _lhsInt + _lhsIruledefs + _lhsIruleuses + _lhsIsynmap + _lhsIterminaldefs -> + (let _lhsOallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOintramap :: (Map.Map StateIdentifier (Set.Set String)) + _lhsOsem_visit :: ( [(StateIdentifier,PP_Doc)] ) + _lhsOt_visits :: PP_Doc + _lhsOusedrules :: (Set.Set Identifier) + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _hdOallintramap :: (Map.Map StateIdentifier (Set.Set String)) + _hdOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdOchildintros :: (Map.Map Identifier PP_Doc) + _hdOinhmap :: Attributes + _hdOmrules :: (Map.Map Identifier PP_Doc) + _hdOnt :: NontermIdent + _hdOruledefs :: (Map.Map Identifier (Set.Set String)) + _hdOruleuses :: (Map.Map Identifier (Set.Set String)) + _hdOsynmap :: Attributes + _hdOterminaldefs :: (Set.Set String) + _tlOallchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _tlOallintramap :: (Map.Map StateIdentifier (Set.Set String)) + _tlOavisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOavisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlOchildintros :: (Map.Map Identifier PP_Doc) + _tlOinhmap :: Attributes + _tlOmrules :: (Map.Map Identifier PP_Doc) + _tlOnt :: NontermIdent + _tlOruledefs :: (Map.Map Identifier (Set.Set String)) + _tlOruleuses :: (Map.Map Identifier (Set.Set String)) + _tlOsynmap :: Attributes + _tlOterminaldefs :: (Set.Set String) + _hdIallvisits :: ((VisitIdentifier,StateIdentifier, StateIdentifier)) + _hdIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _hdIintramap :: (Map.Map StateIdentifier (Set.Set String)) + _hdIsem_visit :: ( (StateIdentifier,PP_Doc) ) + _hdIt_visits :: PP_Doc + _hdIusedrules :: (Set.Set Identifier) + _hdIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _hdIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlIallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _tlIchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _tlIintramap :: (Map.Map StateIdentifier (Set.Set String)) + _tlIsem_visit :: ( [(StateIdentifier,PP_Doc)] ) + _tlIt_visits :: PP_Doc + _tlIusedrules :: (Set.Set Identifier) + _tlIvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _tlIvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- use rule "ExecutionPlan2Hs.ag"(line 137, column 29) + _lhsOallvisits = + ({-# LINE 137 "ExecutionPlan2Hs.ag" #-} + _hdIallvisits : _tlIallvisits + {-# LINE 3455 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + _hdIchildvisit `Map.union` _tlIchildvisit + {-# LINE 3461 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 398, column 30) + _lhsOintramap = + ({-# LINE 398 "ExecutionPlan2Hs.ag" #-} + _hdIintramap `uwSetUnion` _tlIintramap + {-# LINE 3467 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 289, column 29) + _lhsOsem_visit = + ({-# LINE 289 "ExecutionPlan2Hs.ag" #-} + _hdIsem_visit : _tlIsem_visit + {-# LINE 3473 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 188, column 54) + _lhsOt_visits = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + _hdIt_visits >-< _tlIt_visits + {-# LINE 3479 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + _hdIusedrules `Set.union` _tlIusedrules + {-# LINE 3485 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + _hdIvisitdefs `uwSetUnion` _tlIvisitdefs + {-# LINE 3491 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + _hdIvisituses `uwSetUnion` _tlIvisituses + {-# LINE 3497 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 3503 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOallintramap = + ({-# LINE 397 "ExecutionPlan2Hs.ag" #-} + _lhsIallintramap + {-# LINE 3509 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 3515 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 3521 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOchildintros = + ({-# LINE 321 "ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 3527 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOinhmap = + ({-# LINE 128 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 3533 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOmrules = + ({-# LINE 303 "ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 3539 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOnt = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 3545 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOruledefs = + ({-# LINE 421 "ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 3551 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOruleuses = + ({-# LINE 422 "ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 3557 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOsynmap = + ({-# LINE 129 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 3563 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _hdOterminaldefs = + ({-# LINE 400 "ExecutionPlan2Hs.ag" #-} + _lhsIterminaldefs + {-# LINE 3569 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallchildvisit = + ({-# LINE 378 "ExecutionPlan2Hs.ag" #-} + _lhsIallchildvisit + {-# LINE 3575 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOallintramap = + ({-# LINE 397 "ExecutionPlan2Hs.ag" #-} + _lhsIallintramap + {-# LINE 3581 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisitdefs = + ({-# LINE 446 "ExecutionPlan2Hs.ag" #-} + _lhsIavisitdefs + {-# LINE 3587 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOavisituses = + ({-# LINE 447 "ExecutionPlan2Hs.ag" #-} + _lhsIavisituses + {-# LINE 3593 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOchildintros = + ({-# LINE 321 "ExecutionPlan2Hs.ag" #-} + _lhsIchildintros + {-# LINE 3599 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOinhmap = + ({-# LINE 128 "ExecutionPlan2Hs.ag" #-} + _lhsIinhmap + {-# LINE 3605 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOmrules = + ({-# LINE 303 "ExecutionPlan2Hs.ag" #-} + _lhsImrules + {-# LINE 3611 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOnt = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + _lhsInt + {-# LINE 3617 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOruledefs = + ({-# LINE 421 "ExecutionPlan2Hs.ag" #-} + _lhsIruledefs + {-# LINE 3623 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOruleuses = + ({-# LINE 422 "ExecutionPlan2Hs.ag" #-} + _lhsIruleuses + {-# LINE 3629 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOsynmap = + ({-# LINE 129 "ExecutionPlan2Hs.ag" #-} + _lhsIsynmap + {-# LINE 3635 "ExecutionPlan2Hs.hs" #-} + ) + -- copy rule (down) + _tlOterminaldefs = + ({-# LINE 400 "ExecutionPlan2Hs.ag" #-} + _lhsIterminaldefs + {-# LINE 3641 "ExecutionPlan2Hs.hs" #-} + ) + ( _hdIallvisits,_hdIchildvisit,_hdIintramap,_hdIsem_visit,_hdIt_visits,_hdIusedrules,_hdIvisitdefs,_hdIvisituses) = + hd_ _hdOallchildvisit _hdOallintramap _hdOavisitdefs _hdOavisituses _hdOchildintros _hdOinhmap _hdOmrules _hdOnt _hdOruledefs _hdOruleuses _hdOsynmap _hdOterminaldefs + ( _tlIallvisits,_tlIchildvisit,_tlIintramap,_tlIsem_visit,_tlIt_visits,_tlIusedrules,_tlIvisitdefs,_tlIvisituses) = + tl_ _tlOallchildvisit _tlOallintramap _tlOavisitdefs _tlOavisituses _tlOchildintros _tlOinhmap _tlOmrules _tlOnt _tlOruledefs _tlOruleuses _tlOsynmap _tlOterminaldefs + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOintramap,_lhsOsem_visit,_lhsOt_visits,_lhsOusedrules,_lhsOvisitdefs,_lhsOvisituses))) ) +sem_Visits_Nil :: T_Visits +sem_Visits_Nil = + (T_Visits (\ _lhsIallchildvisit + _lhsIallintramap + _lhsIavisitdefs + _lhsIavisituses + _lhsIchildintros + _lhsIinhmap + _lhsImrules + _lhsInt + _lhsIruledefs + _lhsIruleuses + _lhsIsynmap + _lhsIterminaldefs -> + (let _lhsOallvisits :: ([(VisitIdentifier,StateIdentifier, StateIdentifier)]) + _lhsOchildvisit :: (Map.Map VisitIdentifier (Identifier -> PP_Doc)) + _lhsOintramap :: (Map.Map StateIdentifier (Set.Set String)) + _lhsOsem_visit :: ( [(StateIdentifier,PP_Doc)] ) + _lhsOt_visits :: PP_Doc + _lhsOusedrules :: (Set.Set Identifier) + _lhsOvisitdefs :: (Map.Map VisitIdentifier (Set.Set Identifier)) + _lhsOvisituses :: (Map.Map VisitIdentifier (Set.Set Identifier)) + -- use rule "ExecutionPlan2Hs.ag"(line 137, column 29) + _lhsOallvisits = + ({-# LINE 137 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 3674 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 379, column 36) + _lhsOchildvisit = + ({-# LINE 379 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 3680 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 398, column 30) + _lhsOintramap = + ({-# LINE 398 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 3686 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 289, column 29) + _lhsOsem_visit = + ({-# LINE 289 "ExecutionPlan2Hs.ag" #-} + [] + {-# LINE 3692 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 188, column 54) + _lhsOt_visits = + ({-# LINE 188 "ExecutionPlan2Hs.ag" #-} + empty + {-# LINE 3698 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 175, column 56) + _lhsOusedrules = + ({-# LINE 175 "ExecutionPlan2Hs.ag" #-} + Set.empty + {-# LINE 3704 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 436, column 36) + _lhsOvisitdefs = + ({-# LINE 436 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 3710 "ExecutionPlan2Hs.hs" #-} + ) + -- use rule "ExecutionPlan2Hs.ag"(line 437, column 36) + _lhsOvisituses = + ({-# LINE 437 "ExecutionPlan2Hs.ag" #-} + Map.empty + {-# LINE 3716 "ExecutionPlan2Hs.hs" #-} + ) + in ( _lhsOallvisits,_lhsOchildvisit,_lhsOintramap,_lhsOsem_visit,_lhsOt_visits,_lhsOusedrules,_lhsOvisitdefs,_lhsOvisituses))) ) diff --git a/src-derived/GenerateCode.hs b/src-derived/GenerateCode.hs --- a/src-derived/GenerateCode.hs +++ b/src-derived/GenerateCode.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.1 (GenerateCode.ag) +-- UUAGC 0.9.38.2 (GenerateCode.ag) module GenerateCode where {-# LINE 9 "GenerateCode.ag" #-} @@ -1241,10 +1241,10 @@ arg = SimpleExpr "m" rarg = case tp of NT t _ -> let t' = maybe t id (deforestedNt t) - in App "Map.map" [SimpleExpr $ cataname _lhsIprefix t', arg] + in App "Data.Map.map" [SimpleExpr $ cataname _lhsIprefix t', arg] _ -> arg lhs = Fun (cataname _lhsIprefix nt_) [arg] - rhs = App "Map.foldWithKey" [entry,nil,rarg] + rhs = App "Data.Map.foldrWithKey" [entry,nil,rarg] in [Decl lhs rhs Set.empty Set.empty] CommonTypes.IntMap tp -> let entry = SimpleExpr (semname _lhsIprefix nt_ (identifier "Entry")) @@ -1252,10 +1252,10 @@ arg = SimpleExpr "m" rarg = case tp of NT t _ -> let t' = maybe t id (deforestedNt t) - in App "IntMap.map" [SimpleExpr $ cataname _lhsIprefix t', arg] + in App "Data.IntMap.map" [SimpleExpr $ cataname _lhsIprefix t', arg] _ -> arg lhs = Fun (cataname _lhsIprefix nt_) [arg] - rhs = App "IntMap.foldWithKey" [entry,nil,rarg] + rhs = App "Data.IntMap.foldWithKey" [entry,nil,rarg] in [Decl lhs rhs Set.empty Set.empty] CommonTypes.Tuple tps -> let con = semname _lhsIprefix nt_ (identifier "Tuple") diff --git a/src-derived/HsToken.hs b/src-derived/HsToken.hs --- a/src-derived/HsToken.hs +++ b/src-derived/HsToken.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.1 (HsToken.ag) +-- UUAGC 0.9.38.2 (HsToken.ag) module HsToken where {-# LINE 2 "HsToken.ag" #-} @@ -38,6 +38,7 @@ | Err (String) (Pos) | HsToken (String) (Pos) | StrToken (String) (Pos) + deriving ( Show) -- HsTokens ---------------------------------------------------- {- alternatives: diff --git a/src-derived/KWOrder.hs b/src-derived/KWOrder.hs --- a/src-derived/KWOrder.hs +++ b/src-derived/KWOrder.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.1 (KWOrder.ag) +-- UUAGC 0.9.38.2 (KWOrder.ag) module KWOrder where {-# LINE 6 "KWOrder.ag" #-} @@ -13,10 +13,12 @@ import Pretty import Knuth1 import KennedyWarren -import Maybe +import ExecutionPlan +import Data.Maybe +import Debug.Trace import qualified Data.Set as Set import qualified Data.Map as Map -{-# LINE 20 "../src-derived/KWOrder.hs" #-} +{-# LINE 22 "../src-derived/KWOrder.hs" #-} {-# LINE 2 "./AbstractSyntax.ag" #-} @@ -26,30 +28,31 @@ import Patterns (Pattern(..),Patterns) import Expression (Expression(..)) import CommonTypes -{-# LINE 30 "../src-derived/KWOrder.hs" #-} +{-# LINE 32 "../src-derived/KWOrder.hs" #-} {-# LINE 2 "./HsToken.ag" #-} import CommonTypes import UU.Scanner.Position(Pos) -{-# LINE 36 "../src-derived/KWOrder.hs" #-} +{-# LINE 38 "../src-derived/KWOrder.hs" #-} {-# LINE 2 "./Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken -{-# LINE 42 "../src-derived/KWOrder.hs" #-} +{-# LINE 44 "../src-derived/KWOrder.hs" #-} {-# LINE 2 "./Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 49 "../src-derived/KWOrder.hs" #-} +{-# LINE 51 "../src-derived/KWOrder.hs" #-} -- Child ------------------------------------------------------- {- visit 0: synthesized attributes: + echilds : EChild edges : Set.Set Edge nontnames : [(Identifier, Identifier)] vertices : Set.Set Vertex @@ -73,15 +76,15 @@ sem_Child (Child _name _tp _inh _syn _virtual ) = (sem_Child_Child _name _tp _inh _syn _virtual ) -- semantic domain -newtype T_Child = T_Child (( (Set.Set Edge),([(Identifier, Identifier)]),(Set.Set Vertex))) +newtype T_Child = T_Child (( EChild,(Set.Set Edge),([(Identifier, Identifier)]),(Set.Set Vertex))) data Inh_Child = Inh_Child {} -data Syn_Child = Syn_Child {edges_Syn_Child :: (Set.Set Edge),nontnames_Syn_Child :: ([(Identifier, Identifier)]),vertices_Syn_Child :: (Set.Set Vertex)} +data Syn_Child = Syn_Child {echilds_Syn_Child :: EChild,edges_Syn_Child :: (Set.Set Edge),nontnames_Syn_Child :: ([(Identifier, Identifier)]),vertices_Syn_Child :: (Set.Set Vertex)} wrap_Child :: T_Child -> Inh_Child -> Syn_Child wrap_Child (T_Child sem ) (Inh_Child ) = - (let ( _lhsOedges,_lhsOnontnames,_lhsOvertices) = sem - in (Syn_Child _lhsOedges _lhsOnontnames _lhsOvertices )) + (let ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOvertices) = sem + in (Syn_Child _lhsOechilds _lhsOedges _lhsOnontnames _lhsOvertices )) sem_Child_Child :: Identifier -> Type -> Attributes -> @@ -89,66 +92,74 @@ (Maybe (Maybe Type)) -> T_Child sem_Child_Child name_ tp_ inh_ syn_ virtual_ = - (T_Child (let _lhsOvertices :: (Set.Set Vertex) + (T_Child (let _lhsOechilds :: EChild + _lhsOvertices :: (Set.Set Vertex) _lhsOedges :: (Set.Set Edge) _lhsOnontnames :: ([(Identifier, Identifier)]) - -- "KWOrder.ag"(line 76, column 12) + -- "KWOrder.ag"(line 67, column 11) + _lhsOechilds = + ({-# LINE 67 "KWOrder.ag" #-} + EChild name_ tp_ virtual_ + {-# LINE 104 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 100, column 12) _vertex = - ({-# LINE 76 "KWOrder.ag" #-} + ({-# LINE 100 "KWOrder.ag" #-} VChild name_ - {-# LINE 100 "KWOrder.hs" #-} + {-# LINE 110 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 77, column 12) + -- "KWOrder.ag"(line 101, column 12) _synvertices = - ({-# LINE 77 "KWOrder.ag" #-} + ({-# LINE 101 "KWOrder.ag" #-} map (VAttr Syn name_) . Map.keys $ syn_ - {-# LINE 106 "KWOrder.hs" #-} + {-# LINE 116 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 78, column 12) + -- "KWOrder.ag"(line 102, column 12) _inhvertices = - ({-# LINE 78 "KWOrder.ag" #-} + ({-# LINE 102 "KWOrder.ag" #-} map (VAttr Inh name_) . Map.keys $ inh_ - {-# LINE 112 "KWOrder.hs" #-} + {-# LINE 122 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 79, column 12) + -- "KWOrder.ag"(line 103, column 12) _lhsOvertices = - ({-# LINE 79 "KWOrder.ag" #-} + ({-# LINE 103 "KWOrder.ag" #-} case tp_ of NT _ _ -> Set.insert _vertex (Set.fromList $ _synvertices ++ _inhvertices ) _ -> Set.empty - {-# LINE 120 "KWOrder.hs" #-} + {-# LINE 130 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 104, column 12) + -- "KWOrder.ag"(line 128, column 12) _edgesout = - ({-# LINE 104 "KWOrder.ag" #-} + ({-# LINE 128 "KWOrder.ag" #-} [] - {-# LINE 126 "KWOrder.hs" #-} + {-# LINE 136 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 105, column 12) + -- "KWOrder.ag"(line 129, column 12) _edgesin = - ({-# LINE 105 "KWOrder.ag" #-} + ({-# LINE 129 "KWOrder.ag" #-} map (flip (,) _vertex ) _synvertices - {-# LINE 132 "KWOrder.hs" #-} + {-# LINE 142 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 106, column 12) + -- "KWOrder.ag"(line 130, column 12) _lhsOedges = - ({-# LINE 106 "KWOrder.ag" #-} + ({-# LINE 130 "KWOrder.ag" #-} Set.fromList $ _edgesout ++ _edgesin - {-# LINE 138 "KWOrder.hs" #-} + {-# LINE 148 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 116, column 12) + -- "KWOrder.ag"(line 140, column 12) _lhsOnontnames = - ({-# LINE 116 "KWOrder.ag" #-} + ({-# LINE 140 "KWOrder.ag" #-} case tp_ of NT nont _ -> [(name_, nont)] _ -> [] - {-# LINE 146 "KWOrder.hs" #-} + {-# LINE 156 "KWOrder.hs" #-} ) - in ( _lhsOedges,_lhsOnontnames,_lhsOvertices)) ) + in ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOvertices)) ) -- Children ---------------------------------------------------- {- visit 0: synthesized attributes: + echilds : EChildren edges : Set.Set Edge nontnames : [(Identifier, Identifier)] vertices : Set.Set Vertex @@ -164,84 +175,103 @@ sem_Children list = (Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) ) -- semantic domain -newtype T_Children = T_Children (( (Set.Set Edge),([(Identifier, Identifier)]),(Set.Set Vertex))) +newtype T_Children = T_Children (( EChildren,(Set.Set Edge),([(Identifier, Identifier)]),(Set.Set Vertex))) data Inh_Children = Inh_Children {} -data Syn_Children = Syn_Children {edges_Syn_Children :: (Set.Set Edge),nontnames_Syn_Children :: ([(Identifier, Identifier)]),vertices_Syn_Children :: (Set.Set Vertex)} +data Syn_Children = Syn_Children {echilds_Syn_Children :: EChildren,edges_Syn_Children :: (Set.Set Edge),nontnames_Syn_Children :: ([(Identifier, Identifier)]),vertices_Syn_Children :: (Set.Set Vertex)} wrap_Children :: T_Children -> Inh_Children -> Syn_Children wrap_Children (T_Children sem ) (Inh_Children ) = - (let ( _lhsOedges,_lhsOnontnames,_lhsOvertices) = sem - in (Syn_Children _lhsOedges _lhsOnontnames _lhsOvertices )) + (let ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOvertices) = sem + in (Syn_Children _lhsOechilds _lhsOedges _lhsOnontnames _lhsOvertices )) sem_Children_Cons :: T_Child -> T_Children -> T_Children sem_Children_Cons (T_Child hd_ ) (T_Children tl_ ) = - (T_Children (let _lhsOedges :: (Set.Set Edge) + (T_Children (let _lhsOechilds :: EChildren + _lhsOedges :: (Set.Set Edge) _lhsOnontnames :: ([(Identifier, Identifier)]) _lhsOvertices :: (Set.Set Vertex) + _hdIechilds :: EChild _hdIedges :: (Set.Set Edge) _hdInontnames :: ([(Identifier, Identifier)]) _hdIvertices :: (Set.Set Vertex) + _tlIechilds :: EChildren _tlIedges :: (Set.Set Edge) _tlInontnames :: ([(Identifier, Identifier)]) _tlIvertices :: (Set.Set Vertex) - -- use rule "KWOrder.ag"(line 94, column 33) + -- use rule "KWOrder.ag"(line 64, column 29) + _lhsOechilds = + ({-# LINE 64 "KWOrder.ag" #-} + _hdIechilds : _tlIechilds + {-# LINE 208 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 118, column 33) _lhsOedges = - ({-# LINE 94 "KWOrder.ag" #-} + ({-# LINE 118 "KWOrder.ag" #-} _hdIedges `Set.union` _tlIedges - {-# LINE 194 "KWOrder.hs" #-} + {-# LINE 214 "KWOrder.hs" #-} ) - -- use rule "KWOrder.ag"(line 113, column 37) + -- use rule "KWOrder.ag"(line 137, column 37) _lhsOnontnames = - ({-# LINE 113 "KWOrder.ag" #-} + ({-# LINE 137 "KWOrder.ag" #-} _hdInontnames ++ _tlInontnames - {-# LINE 200 "KWOrder.hs" #-} + {-# LINE 220 "KWOrder.hs" #-} ) - -- use rule "KWOrder.ag"(line 52, column 36) + -- use rule "KWOrder.ag"(line 76, column 36) _lhsOvertices = - ({-# LINE 52 "KWOrder.ag" #-} + ({-# LINE 76 "KWOrder.ag" #-} _hdIvertices `Set.union` _tlIvertices - {-# LINE 206 "KWOrder.hs" #-} + {-# LINE 226 "KWOrder.hs" #-} ) - ( _hdIedges,_hdInontnames,_hdIvertices) = + ( _hdIechilds,_hdIedges,_hdInontnames,_hdIvertices) = hd_ - ( _tlIedges,_tlInontnames,_tlIvertices) = + ( _tlIechilds,_tlIedges,_tlInontnames,_tlIvertices) = tl_ - in ( _lhsOedges,_lhsOnontnames,_lhsOvertices)) ) + in ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOvertices)) ) sem_Children_Nil :: T_Children sem_Children_Nil = - (T_Children (let _lhsOedges :: (Set.Set Edge) + (T_Children (let _lhsOechilds :: EChildren + _lhsOedges :: (Set.Set Edge) _lhsOnontnames :: ([(Identifier, Identifier)]) _lhsOvertices :: (Set.Set Vertex) - -- use rule "KWOrder.ag"(line 94, column 33) + -- use rule "KWOrder.ag"(line 64, column 29) + _lhsOechilds = + ({-# LINE 64 "KWOrder.ag" #-} + [] + {-# LINE 243 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 118, column 33) _lhsOedges = - ({-# LINE 94 "KWOrder.ag" #-} + ({-# LINE 118 "KWOrder.ag" #-} Set.empty - {-# LINE 222 "KWOrder.hs" #-} + {-# LINE 249 "KWOrder.hs" #-} ) - -- use rule "KWOrder.ag"(line 113, column 37) + -- use rule "KWOrder.ag"(line 137, column 37) _lhsOnontnames = - ({-# LINE 113 "KWOrder.ag" #-} + ({-# LINE 137 "KWOrder.ag" #-} [] - {-# LINE 228 "KWOrder.hs" #-} + {-# LINE 255 "KWOrder.hs" #-} ) - -- use rule "KWOrder.ag"(line 52, column 36) + -- use rule "KWOrder.ag"(line 76, column 36) _lhsOvertices = - ({-# LINE 52 "KWOrder.ag" #-} + ({-# LINE 76 "KWOrder.ag" #-} Set.empty - {-# LINE 234 "KWOrder.hs" #-} + {-# LINE 261 "KWOrder.hs" #-} ) - in ( _lhsOedges,_lhsOnontnames,_lhsOvertices)) ) + in ( _lhsOechilds,_lhsOedges,_lhsOnontnames,_lhsOvertices)) ) -- Expression -------------------------------------------------- {- visit 0: - synthesized attribute: + synthesized attributes: + copy : SELF vertices : Set.Set Vertex alternatives: alternative Expression: child pos : {Pos} child tks : {[HsToken]} + visit 0: + local copy : _ -} -- cata sem_Expression :: Expression -> @@ -249,35 +279,50 @@ sem_Expression (Expression _pos _tks ) = (sem_Expression_Expression _pos _tks ) -- semantic domain -newtype T_Expression = T_Expression (( (Set.Set Vertex))) +newtype T_Expression = T_Expression (( Expression ,(Set.Set Vertex))) data Inh_Expression = Inh_Expression {} -data Syn_Expression = Syn_Expression {vertices_Syn_Expression :: (Set.Set Vertex)} +data Syn_Expression = Syn_Expression {copy_Syn_Expression :: Expression ,vertices_Syn_Expression :: (Set.Set Vertex)} wrap_Expression :: T_Expression -> Inh_Expression -> Syn_Expression wrap_Expression (T_Expression sem ) (Inh_Expression ) = - (let ( _lhsOvertices) = sem - in (Syn_Expression _lhsOvertices )) + (let ( _lhsOcopy,_lhsOvertices) = sem + in (Syn_Expression _lhsOcopy _lhsOvertices )) sem_Expression_Expression :: Pos -> ([HsToken]) -> T_Expression sem_Expression_Expression pos_ tks_ = (T_Expression (let _lhsOvertices :: (Set.Set Vertex) - -- "KWOrder.ag"(line 63, column 17) + _lhsOcopy :: Expression + -- "KWOrder.ag"(line 87, column 17) _lhsOvertices = - ({-# LINE 63 "KWOrder.ag" #-} + ({-# LINE 87 "KWOrder.ag" #-} Set.unions $ map (\tok -> vertices_Syn_HsToken (wrap_HsToken (sem_HsToken tok) Inh_HsToken)) tks_ - {-# LINE 272 "KWOrder.hs" #-} + {-# LINE 303 "KWOrder.hs" #-} ) - in ( _lhsOvertices)) ) + -- self rule + _copy = + ({-# LINE 45 "KWOrder.ag" #-} + Expression pos_ tks_ + {-# LINE 309 "KWOrder.hs" #-} + ) + -- self rule + _lhsOcopy = + ({-# LINE 45 "KWOrder.ag" #-} + _copy + {-# LINE 315 "KWOrder.hs" #-} + ) + in ( _lhsOcopy,_lhsOvertices)) ) -- Grammar ----------------------------------------------------- {- visit 0: inherited attribute: options : Options - synthesized attribute: - debugoutput : PP_Doc + synthesized attributes: + inhmap : Map.Map NontermIdent Attributes + output : ExecutionPlan + synmap : Map.Map NontermIdent Attributes alternatives: alternative Grammar: child typeSyns : {TypeSyns} @@ -302,15 +347,15 @@ (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 (Options -> - ( PP_Doc)) + ( (Map.Map NontermIdent Attributes),ExecutionPlan,(Map.Map NontermIdent Attributes))) data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: Options} -data Syn_Grammar = Syn_Grammar {debugoutput_Syn_Grammar :: PP_Doc} +data Syn_Grammar = Syn_Grammar {inhmap_Syn_Grammar :: (Map.Map NontermIdent Attributes),output_Syn_Grammar :: ExecutionPlan,synmap_Syn_Grammar :: (Map.Map NontermIdent Attributes)} wrap_Grammar :: T_Grammar -> Inh_Grammar -> Syn_Grammar wrap_Grammar (T_Grammar sem ) (Inh_Grammar _lhsIoptions ) = - (let ( _lhsOdebugoutput) = sem _lhsIoptions - in (Syn_Grammar _lhsOdebugoutput )) + (let ( _lhsOinhmap,_lhsOoutput,_lhsOsynmap) = sem _lhsIoptions + in (Syn_Grammar _lhsOinhmap _lhsOoutput _lhsOsynmap )) sem_Grammar_Grammar :: TypeSyns -> UseMap -> Derivings -> @@ -329,24 +374,40 @@ sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ (T_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ = (T_Grammar (\ _lhsIoptions -> (let _nontsOrulenumber :: Int - _lhsOdebugoutput :: PP_Doc + _lhsOoutput :: ExecutionPlan + _lhsOinhmap :: (Map.Map NontermIdent Attributes) + _lhsOsynmap :: (Map.Map NontermIdent Attributes) _nontsIdepinfo :: ([NontDependencyInformation]) + _nontsIinhmap :: (Map.Map NontermIdent Attributes) _nontsIrulenumber :: Int - -- "KWOrder.ag"(line 39, column 14) + _nontsIsynmap :: (Map.Map NontermIdent Attributes) + -- "KWOrder.ag"(line 36, column 14) _nontsOrulenumber = - ({-# LINE 39 "KWOrder.ag" #-} + ({-# LINE 36 "KWOrder.ag" #-} 0 - {-# LINE 340 "KWOrder.hs" #-} + {-# LINE 389 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 160, column 14) - _lhsOdebugoutput = - ({-# LINE 160 "KWOrder.ag" #-} - kennedyWarrenIO _nontsIdepinfo - {-# LINE 346 "KWOrder.hs" #-} + -- "KWOrder.ag"(line 189, column 15) + (Just _lhsOoutput ) = + ({-# LINE 189 "KWOrder.ag" #-} + kennedyWarrenOrder wrappers_ _nontsIdepinfo typeSyns_ + {-# LINE 395 "KWOrder.hs" #-} ) - ( _nontsIdepinfo,_nontsIrulenumber) = + -- use rule "KWOrder.ag"(line 196, column 33) + _lhsOinhmap = + ({-# LINE 196 "KWOrder.ag" #-} + _nontsIinhmap + {-# LINE 401 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 197, column 33) + _lhsOsynmap = + ({-# LINE 197 "KWOrder.ag" #-} + _nontsIsynmap + {-# LINE 407 "KWOrder.hs" #-} + ) + ( _nontsIdepinfo,_nontsIinhmap,_nontsIrulenumber,_nontsIsynmap) = nonts_ _nontsOrulenumber - in ( _lhsOdebugoutput))) ) + in ( _lhsOinhmap,_lhsOoutput,_lhsOsynmap))) ) -- HsToken ----------------------------------------------------- {- visit 0: @@ -407,13 +468,13 @@ T_HsToken sem_HsToken_AGField field_ attr_ pos_ rdesc_ = (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) - -- "KWOrder.ag"(line 57, column 14) + -- "KWOrder.ag"(line 81, column 14) _lhsOvertices = - ({-# LINE 57 "KWOrder.ag" #-} + ({-# LINE 81 "KWOrder.ag" #-} Set.singleton $ VAttr (if field_ == _LHS then Inh else if field_ == _LOC then Loc else Syn) field_ attr_ - {-# LINE 417 "KWOrder.hs" #-} + {-# LINE 478 "KWOrder.hs" #-} ) in ( _lhsOvertices)) ) sem_HsToken_AGLocal :: Identifier -> @@ -422,11 +483,11 @@ T_HsToken sem_HsToken_AGLocal var_ pos_ rdesc_ = (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) - -- "KWOrder.ag"(line 56, column 14) + -- "KWOrder.ag"(line 80, column 14) _lhsOvertices = - ({-# LINE 56 "KWOrder.ag" #-} + ({-# LINE 80 "KWOrder.ag" #-} Set.singleton $ VAttr Loc _LOC var_ - {-# LINE 430 "KWOrder.hs" #-} + {-# LINE 491 "KWOrder.hs" #-} ) in ( _lhsOvertices)) ) sem_HsToken_CharToken :: String -> @@ -434,11 +495,11 @@ T_HsToken sem_HsToken_CharToken value_ pos_ = (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) - -- use rule "KWOrder.ag"(line 52, column 36) + -- use rule "KWOrder.ag"(line 76, column 36) _lhsOvertices = - ({-# LINE 52 "KWOrder.ag" #-} + ({-# LINE 76 "KWOrder.ag" #-} Set.empty - {-# LINE 442 "KWOrder.hs" #-} + {-# LINE 503 "KWOrder.hs" #-} ) in ( _lhsOvertices)) ) sem_HsToken_Err :: String -> @@ -446,11 +507,11 @@ T_HsToken sem_HsToken_Err mesg_ pos_ = (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) - -- use rule "KWOrder.ag"(line 52, column 36) + -- use rule "KWOrder.ag"(line 76, column 36) _lhsOvertices = - ({-# LINE 52 "KWOrder.ag" #-} + ({-# LINE 76 "KWOrder.ag" #-} Set.empty - {-# LINE 454 "KWOrder.hs" #-} + {-# LINE 515 "KWOrder.hs" #-} ) in ( _lhsOvertices)) ) sem_HsToken_HsToken :: String -> @@ -458,11 +519,11 @@ T_HsToken sem_HsToken_HsToken value_ pos_ = (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) - -- use rule "KWOrder.ag"(line 52, column 36) + -- use rule "KWOrder.ag"(line 76, column 36) _lhsOvertices = - ({-# LINE 52 "KWOrder.ag" #-} + ({-# LINE 76 "KWOrder.ag" #-} Set.empty - {-# LINE 466 "KWOrder.hs" #-} + {-# LINE 527 "KWOrder.hs" #-} ) in ( _lhsOvertices)) ) sem_HsToken_StrToken :: String -> @@ -470,11 +531,11 @@ T_HsToken sem_HsToken_StrToken value_ pos_ = (T_HsToken (let _lhsOvertices :: (Set.Set Vertex) - -- use rule "KWOrder.ag"(line 52, column 36) + -- use rule "KWOrder.ag"(line 76, column 36) _lhsOvertices = - ({-# LINE 52 "KWOrder.ag" #-} + ({-# LINE 76 "KWOrder.ag" #-} Set.empty - {-# LINE 478 "KWOrder.hs" #-} + {-# LINE 539 "KWOrder.hs" #-} ) in ( _lhsOvertices)) ) -- HsTokens ---------------------------------------------------- @@ -543,8 +604,10 @@ visit 0: chained attribute: rulenumber : Int - synthesized attribute: + synthesized attributes: depinfo : NontDependencyInformation + inhmap : Map.Map NontermIdent Attributes + synmap : Map.Map NontermIdent Attributes alternatives: alternative Nonterminal: child nt : {NontermIdent} @@ -565,15 +628,15 @@ (sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods ) ) -- semantic domain newtype T_Nonterminal = T_Nonterminal (Int -> - ( NontDependencyInformation,Int)) + ( NontDependencyInformation,(Map.Map NontermIdent Attributes),Int,(Map.Map NontermIdent Attributes))) data Inh_Nonterminal = Inh_Nonterminal {rulenumber_Inh_Nonterminal :: Int} -data Syn_Nonterminal = Syn_Nonterminal {depinfo_Syn_Nonterminal :: NontDependencyInformation,rulenumber_Syn_Nonterminal :: Int} +data Syn_Nonterminal = Syn_Nonterminal {depinfo_Syn_Nonterminal :: NontDependencyInformation,inhmap_Syn_Nonterminal :: (Map.Map NontermIdent Attributes),rulenumber_Syn_Nonterminal :: Int,synmap_Syn_Nonterminal :: (Map.Map NontermIdent Attributes)} wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> Syn_Nonterminal wrap_Nonterminal (T_Nonterminal sem ) (Inh_Nonterminal _lhsIrulenumber ) = - (let ( _lhsOdepinfo,_lhsOrulenumber) = sem _lhsIrulenumber - in (Syn_Nonterminal _lhsOdepinfo _lhsOrulenumber )) + (let ( _lhsOdepinfo,_lhsOinhmap,_lhsOrulenumber,_lhsOsynmap) = sem _lhsIrulenumber + in (Syn_Nonterminal _lhsOdepinfo _lhsOinhmap _lhsOrulenumber _lhsOsynmap )) sem_Nonterminal_Nonterminal :: NontermIdent -> ([Identifier]) -> Attributes -> @@ -583,67 +646,84 @@ sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ (T_Productions prods_ ) = (T_Nonterminal (\ _lhsIrulenumber -> (let _lhsOdepinfo :: NontDependencyInformation + _lhsOinhmap :: (Map.Map NontermIdent Attributes) + _lhsOsynmap :: (Map.Map NontermIdent Attributes) _lhsOrulenumber :: Int _prodsOrulenumber :: Int _prodsIdepgraph :: ([ProdDependencyGraph]) _prodsIrulenumber :: Int - -- "KWOrder.ag"(line 136, column 18) + -- "KWOrder.ag"(line 162, column 18) _synvertices = - ({-# LINE 136 "KWOrder.ag" #-} + ({-# LINE 162 "KWOrder.ag" #-} map (VAttr Syn nt_) . Map.keys $ syn_ - {-# LINE 595 "KWOrder.hs" #-} + {-# LINE 660 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 137, column 18) + -- "KWOrder.ag"(line 163, column 18) _inhvertices = - ({-# LINE 137 "KWOrder.ag" #-} + ({-# LINE 163 "KWOrder.ag" #-} map (VAttr Inh nt_) . Map.keys $ inh_ - {-# LINE 601 "KWOrder.hs" #-} + {-# LINE 666 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 138, column 18) + -- "KWOrder.ag"(line 164, column 18) _vertices = - ({-# LINE 138 "KWOrder.ag" #-} + ({-# LINE 164 "KWOrder.ag" #-} _synvertices ++ _inhvertices - {-# LINE 607 "KWOrder.hs" #-} + {-# LINE 672 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 142, column 18) + -- "KWOrder.ag"(line 168, column 18) _nontgraph = - ({-# LINE 142 "KWOrder.ag" #-} + ({-# LINE 168 "KWOrder.ag" #-} NontDependencyGraph { ndgVertices = _vertices , ndgEdges = [] } - {-# LINE 614 "KWOrder.hs" #-} + {-# LINE 679 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 150, column 18) + -- "KWOrder.ag"(line 176, column 18) _lhsOdepinfo = - ({-# LINE 150 "KWOrder.ag" #-} + ({-# LINE 176 "KWOrder.ag" #-} NontDependencyInformation { ndiNonterminal = nt_ + , ndiParams = params_ , ndiInh = Map.keys inh_ , ndiSyn = Map.keys syn_ , ndiDepGraph = _nontgraph , ndiProds = _prodsIdepgraph } - {-# LINE 624 "KWOrder.hs" #-} + {-# LINE 690 "KWOrder.hs" #-} ) + -- "KWOrder.ag"(line 202, column 17) + _lhsOinhmap = + ({-# LINE 202 "KWOrder.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 696 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 203, column 17) + _lhsOsynmap = + ({-# LINE 203 "KWOrder.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 702 "KWOrder.hs" #-} + ) -- copy rule (up) _lhsOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _prodsIrulenumber - {-# LINE 630 "KWOrder.hs" #-} + {-# LINE 708 "KWOrder.hs" #-} ) -- copy rule (down) _prodsOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _lhsIrulenumber - {-# LINE 636 "KWOrder.hs" #-} + {-# LINE 714 "KWOrder.hs" #-} ) ( _prodsIdepgraph,_prodsIrulenumber) = prods_ _prodsOrulenumber - in ( _lhsOdepinfo,_lhsOrulenumber))) ) + in ( _lhsOdepinfo,_lhsOinhmap,_lhsOrulenumber,_lhsOsynmap))) ) -- Nonterminals ------------------------------------------------ {- visit 0: chained attribute: rulenumber : Int - synthesized attribute: + synthesized attributes: depinfo : [NontDependencyInformation] + inhmap : Map.Map NontermIdent Attributes + synmap : Map.Map NontermIdent Attributes alternatives: alternative Cons: child hd : Nonterminal @@ -657,75 +737,107 @@ (Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) ) -- semantic domain newtype T_Nonterminals = T_Nonterminals (Int -> - ( ([NontDependencyInformation]),Int)) + ( ([NontDependencyInformation]),(Map.Map NontermIdent Attributes),Int,(Map.Map NontermIdent Attributes))) data Inh_Nonterminals = Inh_Nonterminals {rulenumber_Inh_Nonterminals :: Int} -data Syn_Nonterminals = Syn_Nonterminals {depinfo_Syn_Nonterminals :: ([NontDependencyInformation]),rulenumber_Syn_Nonterminals :: Int} +data Syn_Nonterminals = Syn_Nonterminals {depinfo_Syn_Nonterminals :: ([NontDependencyInformation]),inhmap_Syn_Nonterminals :: (Map.Map NontermIdent Attributes),rulenumber_Syn_Nonterminals :: Int,synmap_Syn_Nonterminals :: (Map.Map NontermIdent Attributes)} wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> Syn_Nonterminals wrap_Nonterminals (T_Nonterminals sem ) (Inh_Nonterminals _lhsIrulenumber ) = - (let ( _lhsOdepinfo,_lhsOrulenumber) = sem _lhsIrulenumber - in (Syn_Nonterminals _lhsOdepinfo _lhsOrulenumber )) + (let ( _lhsOdepinfo,_lhsOinhmap,_lhsOrulenumber,_lhsOsynmap) = sem _lhsIrulenumber + in (Syn_Nonterminals _lhsOdepinfo _lhsOinhmap _lhsOrulenumber _lhsOsynmap )) sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals sem_Nonterminals_Cons (T_Nonterminal hd_ ) (T_Nonterminals tl_ ) = (T_Nonterminals (\ _lhsIrulenumber -> (let _lhsOdepinfo :: ([NontDependencyInformation]) + _lhsOinhmap :: (Map.Map NontermIdent Attributes) + _lhsOsynmap :: (Map.Map NontermIdent Attributes) _lhsOrulenumber :: Int _hdOrulenumber :: Int _tlOrulenumber :: Int _hdIdepinfo :: NontDependencyInformation + _hdIinhmap :: (Map.Map NontermIdent Attributes) _hdIrulenumber :: Int + _hdIsynmap :: (Map.Map NontermIdent Attributes) _tlIdepinfo :: ([NontDependencyInformation]) + _tlIinhmap :: (Map.Map NontermIdent Attributes) _tlIrulenumber :: Int - -- use rule "KWOrder.ag"(line 147, column 33) + _tlIsynmap :: (Map.Map NontermIdent Attributes) + -- use rule "KWOrder.ag"(line 173, column 33) _lhsOdepinfo = - ({-# LINE 147 "KWOrder.ag" #-} + ({-# LINE 173 "KWOrder.ag" #-} _hdIdepinfo : _tlIdepinfo - {-# LINE 687 "KWOrder.hs" #-} + {-# LINE 773 "KWOrder.hs" #-} ) + -- use rule "KWOrder.ag"(line 196, column 33) + _lhsOinhmap = + ({-# LINE 196 "KWOrder.ag" #-} + _hdIinhmap `Map.union` _tlIinhmap + {-# LINE 779 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 197, column 33) + _lhsOsynmap = + ({-# LINE 197 "KWOrder.ag" #-} + _hdIsynmap `Map.union` _tlIsynmap + {-# LINE 785 "KWOrder.hs" #-} + ) -- copy rule (up) _lhsOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _tlIrulenumber - {-# LINE 693 "KWOrder.hs" #-} + {-# LINE 791 "KWOrder.hs" #-} ) -- copy rule (down) _hdOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _lhsIrulenumber - {-# LINE 699 "KWOrder.hs" #-} + {-# LINE 797 "KWOrder.hs" #-} ) -- copy rule (chain) _tlOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _hdIrulenumber - {-# LINE 705 "KWOrder.hs" #-} + {-# LINE 803 "KWOrder.hs" #-} ) - ( _hdIdepinfo,_hdIrulenumber) = + ( _hdIdepinfo,_hdIinhmap,_hdIrulenumber,_hdIsynmap) = hd_ _hdOrulenumber - ( _tlIdepinfo,_tlIrulenumber) = + ( _tlIdepinfo,_tlIinhmap,_tlIrulenumber,_tlIsynmap) = tl_ _tlOrulenumber - in ( _lhsOdepinfo,_lhsOrulenumber))) ) + in ( _lhsOdepinfo,_lhsOinhmap,_lhsOrulenumber,_lhsOsynmap))) ) sem_Nonterminals_Nil :: T_Nonterminals sem_Nonterminals_Nil = (T_Nonterminals (\ _lhsIrulenumber -> (let _lhsOdepinfo :: ([NontDependencyInformation]) + _lhsOinhmap :: (Map.Map NontermIdent Attributes) + _lhsOsynmap :: (Map.Map NontermIdent Attributes) _lhsOrulenumber :: Int - -- use rule "KWOrder.ag"(line 147, column 33) + -- use rule "KWOrder.ag"(line 173, column 33) _lhsOdepinfo = - ({-# LINE 147 "KWOrder.ag" #-} + ({-# LINE 173 "KWOrder.ag" #-} [] - {-# LINE 721 "KWOrder.hs" #-} + {-# LINE 821 "KWOrder.hs" #-} ) + -- use rule "KWOrder.ag"(line 196, column 33) + _lhsOinhmap = + ({-# LINE 196 "KWOrder.ag" #-} + Map.empty + {-# LINE 827 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 197, column 33) + _lhsOsynmap = + ({-# LINE 197 "KWOrder.ag" #-} + Map.empty + {-# LINE 833 "KWOrder.hs" #-} + ) -- copy rule (chain) _lhsOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _lhsIrulenumber - {-# LINE 727 "KWOrder.hs" #-} + {-# LINE 839 "KWOrder.hs" #-} ) - in ( _lhsOdepinfo,_lhsOrulenumber))) ) + in ( _lhsOdepinfo,_lhsOinhmap,_lhsOrulenumber,_lhsOsynmap))) ) -- Pattern ----------------------------------------------------- {- visit 0: @@ -795,32 +907,32 @@ _patIvertices :: (Set.Set Vertex) _partsIcopy :: Patterns _partsIvertices :: (Set.Set Vertex) - -- "KWOrder.ag"(line 68, column 12) + -- "KWOrder.ag"(line 92, column 12) _vertex = - ({-# LINE 68 "KWOrder.ag" #-} + ({-# LINE 92 "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 806 "KWOrder.hs" #-} + {-# LINE 918 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 72, column 12) + -- "KWOrder.ag"(line 96, column 12) _lhsOvertices = - ({-# LINE 72 "KWOrder.ag" #-} + ({-# LINE 96 "KWOrder.ag" #-} Set.insert _vertex $ _partsIvertices `Set.union` _patIvertices - {-# LINE 812 "KWOrder.hs" #-} + {-# LINE 924 "KWOrder.hs" #-} ) -- self rule _copy = ({-# LINE 23 "./Patterns.ag" #-} Alias field_ attr_ _patIcopy _partsIcopy - {-# LINE 818 "KWOrder.hs" #-} + {-# LINE 930 "KWOrder.hs" #-} ) -- self rule _lhsOcopy = ({-# LINE 23 "./Patterns.ag" #-} _copy - {-# LINE 824 "KWOrder.hs" #-} + {-# LINE 936 "KWOrder.hs" #-} ) ( _patIcopy,_patIvertices) = pat_ @@ -835,23 +947,23 @@ _lhsOcopy :: Pattern _patsIcopy :: Patterns _patsIvertices :: (Set.Set Vertex) - -- use rule "KWOrder.ag"(line 52, column 36) + -- use rule "KWOrder.ag"(line 76, column 36) _lhsOvertices = - ({-# LINE 52 "KWOrder.ag" #-} + ({-# LINE 76 "KWOrder.ag" #-} _patsIvertices - {-# LINE 843 "KWOrder.hs" #-} + {-# LINE 955 "KWOrder.hs" #-} ) -- self rule _copy = ({-# LINE 23 "./Patterns.ag" #-} Constr name_ _patsIcopy - {-# LINE 849 "KWOrder.hs" #-} + {-# LINE 961 "KWOrder.hs" #-} ) -- self rule _lhsOcopy = ({-# LINE 23 "./Patterns.ag" #-} _copy - {-# LINE 855 "KWOrder.hs" #-} + {-# LINE 967 "KWOrder.hs" #-} ) ( _patsIcopy,_patsIvertices) = pats_ @@ -863,23 +975,23 @@ _lhsOcopy :: Pattern _patIcopy :: Pattern _patIvertices :: (Set.Set Vertex) - -- use rule "KWOrder.ag"(line 52, column 36) + -- use rule "KWOrder.ag"(line 76, column 36) _lhsOvertices = - ({-# LINE 52 "KWOrder.ag" #-} + ({-# LINE 76 "KWOrder.ag" #-} _patIvertices - {-# LINE 871 "KWOrder.hs" #-} + {-# LINE 983 "KWOrder.hs" #-} ) -- self rule _copy = ({-# LINE 23 "./Patterns.ag" #-} Irrefutable _patIcopy - {-# LINE 877 "KWOrder.hs" #-} + {-# LINE 989 "KWOrder.hs" #-} ) -- self rule _lhsOcopy = ({-# LINE 23 "./Patterns.ag" #-} _copy - {-# LINE 883 "KWOrder.hs" #-} + {-# LINE 995 "KWOrder.hs" #-} ) ( _patIcopy,_patIvertices) = pat_ @@ -892,23 +1004,23 @@ _lhsOcopy :: Pattern _patsIcopy :: Patterns _patsIvertices :: (Set.Set Vertex) - -- use rule "KWOrder.ag"(line 52, column 36) + -- use rule "KWOrder.ag"(line 76, column 36) _lhsOvertices = - ({-# LINE 52 "KWOrder.ag" #-} + ({-# LINE 76 "KWOrder.ag" #-} _patsIvertices - {-# LINE 900 "KWOrder.hs" #-} + {-# LINE 1012 "KWOrder.hs" #-} ) -- self rule _copy = ({-# LINE 23 "./Patterns.ag" #-} Product pos_ _patsIcopy - {-# LINE 906 "KWOrder.hs" #-} + {-# LINE 1018 "KWOrder.hs" #-} ) -- self rule _lhsOcopy = ({-# LINE 23 "./Patterns.ag" #-} _copy - {-# LINE 912 "KWOrder.hs" #-} + {-# LINE 1024 "KWOrder.hs" #-} ) ( _patsIcopy,_patsIvertices) = pats_ @@ -918,23 +1030,23 @@ sem_Pattern_Underscore pos_ = (T_Pattern (let _lhsOvertices :: (Set.Set Vertex) _lhsOcopy :: Pattern - -- use rule "KWOrder.ag"(line 52, column 36) + -- use rule "KWOrder.ag"(line 76, column 36) _lhsOvertices = - ({-# LINE 52 "KWOrder.ag" #-} + ({-# LINE 76 "KWOrder.ag" #-} Set.empty - {-# LINE 926 "KWOrder.hs" #-} + {-# LINE 1038 "KWOrder.hs" #-} ) -- self rule _copy = ({-# LINE 23 "./Patterns.ag" #-} Underscore pos_ - {-# LINE 932 "KWOrder.hs" #-} + {-# LINE 1044 "KWOrder.hs" #-} ) -- self rule _lhsOcopy = ({-# LINE 23 "./Patterns.ag" #-} _copy - {-# LINE 938 "KWOrder.hs" #-} + {-# LINE 1050 "KWOrder.hs" #-} ) in ( _lhsOcopy,_lhsOvertices)) ) -- Patterns ---------------------------------------------------- @@ -978,23 +1090,23 @@ _hdIvertices :: (Set.Set Vertex) _tlIcopy :: Patterns _tlIvertices :: (Set.Set Vertex) - -- use rule "KWOrder.ag"(line 52, column 36) + -- use rule "KWOrder.ag"(line 76, column 36) _lhsOvertices = - ({-# LINE 52 "KWOrder.ag" #-} + ({-# LINE 76 "KWOrder.ag" #-} _hdIvertices `Set.union` _tlIvertices - {-# LINE 986 "KWOrder.hs" #-} + {-# LINE 1098 "KWOrder.hs" #-} ) -- self rule _copy = ({-# LINE 23 "./Patterns.ag" #-} (:) _hdIcopy _tlIcopy - {-# LINE 992 "KWOrder.hs" #-} + {-# LINE 1104 "KWOrder.hs" #-} ) -- self rule _lhsOcopy = ({-# LINE 23 "./Patterns.ag" #-} _copy - {-# LINE 998 "KWOrder.hs" #-} + {-# LINE 1110 "KWOrder.hs" #-} ) ( _hdIcopy,_hdIvertices) = hd_ @@ -1005,23 +1117,23 @@ sem_Patterns_Nil = (T_Patterns (let _lhsOvertices :: (Set.Set Vertex) _lhsOcopy :: Patterns - -- use rule "KWOrder.ag"(line 52, column 36) + -- use rule "KWOrder.ag"(line 76, column 36) _lhsOvertices = - ({-# LINE 52 "KWOrder.ag" #-} + ({-# LINE 76 "KWOrder.ag" #-} Set.empty - {-# LINE 1013 "KWOrder.hs" #-} + {-# LINE 1125 "KWOrder.hs" #-} ) -- self rule _copy = ({-# LINE 23 "./Patterns.ag" #-} [] - {-# LINE 1019 "KWOrder.hs" #-} + {-# LINE 1131 "KWOrder.hs" #-} ) -- self rule _lhsOcopy = ({-# LINE 23 "./Patterns.ag" #-} _copy - {-# LINE 1025 "KWOrder.hs" #-} + {-# LINE 1137 "KWOrder.hs" #-} ) in ( _lhsOcopy,_lhsOvertices)) ) -- Production -------------------------------------------------- @@ -1067,48 +1179,52 @@ (let _lhsOdepgraph :: ProdDependencyGraph _lhsOrulenumber :: Int _rulesOrulenumber :: Int + _childrenIechilds :: EChildren _childrenIedges :: (Set.Set Edge) _childrenInontnames :: ([(Identifier, Identifier)]) _childrenIvertices :: (Set.Set Vertex) _rulesIedges :: (Set.Set Edge) + _rulesIerules :: ERules _rulesIrulenumber :: Int _rulesIvertices :: (Set.Set Vertex) - -- "KWOrder.ag"(line 90, column 17) + -- "KWOrder.ag"(line 114, column 17) _vertices = - ({-# LINE 90 "KWOrder.ag" #-} + ({-# LINE 114 "KWOrder.ag" #-} _rulesIvertices `Set.union` _childrenIvertices - {-# LINE 1081 "KWOrder.hs" #-} + {-# LINE 1195 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 110, column 17) + -- "KWOrder.ag"(line 134, column 17) _edges = - ({-# LINE 110 "KWOrder.ag" #-} + ({-# LINE 134 "KWOrder.ag" #-} _rulesIedges `Set.union` _childrenIedges - {-# LINE 1087 "KWOrder.hs" #-} + {-# LINE 1201 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 125, column 17) + -- "KWOrder.ag"(line 149, column 17) _lhsOdepgraph = - ({-# LINE 125 "KWOrder.ag" #-} + ({-# LINE 149 "KWOrder.ag" #-} ProdDependencyGraph { pdgVertices = Set.toList _vertices , pdgEdges = Set.toList _edges + , pdgRules = _rulesIerules + , pdgChilds = _childrenIechilds , pdgProduction = con_ , pdgChildMap = _childrenInontnames } - {-# LINE 1096 "KWOrder.hs" #-} + {-# LINE 1212 "KWOrder.hs" #-} ) -- copy rule (up) _lhsOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _rulesIrulenumber - {-# LINE 1102 "KWOrder.hs" #-} + {-# LINE 1218 "KWOrder.hs" #-} ) -- copy rule (down) _rulesOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _lhsIrulenumber - {-# LINE 1108 "KWOrder.hs" #-} + {-# LINE 1224 "KWOrder.hs" #-} ) - ( _childrenIedges,_childrenInontnames,_childrenIvertices) = + ( _childrenIechilds,_childrenIedges,_childrenInontnames,_childrenIvertices) = children_ - ( _rulesIedges,_rulesIrulenumber,_rulesIvertices) = + ( _rulesIedges,_rulesIerules,_rulesIrulenumber,_rulesIvertices) = rules_ _rulesOrulenumber in ( _lhsOdepgraph,_lhsOrulenumber))) ) -- Productions ------------------------------------------------- @@ -1153,29 +1269,29 @@ _hdIrulenumber :: Int _tlIdepgraph :: ([ProdDependencyGraph]) _tlIrulenumber :: Int - -- use rule "KWOrder.ag"(line 122, column 33) + -- use rule "KWOrder.ag"(line 146, column 33) _lhsOdepgraph = - ({-# LINE 122 "KWOrder.ag" #-} + ({-# LINE 146 "KWOrder.ag" #-} _hdIdepgraph : _tlIdepgraph - {-# LINE 1161 "KWOrder.hs" #-} + {-# LINE 1277 "KWOrder.hs" #-} ) -- copy rule (up) _lhsOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _tlIrulenumber - {-# LINE 1167 "KWOrder.hs" #-} + {-# LINE 1283 "KWOrder.hs" #-} ) -- copy rule (down) _hdOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _lhsIrulenumber - {-# LINE 1173 "KWOrder.hs" #-} + {-# LINE 1289 "KWOrder.hs" #-} ) -- copy rule (chain) _tlOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _hdIrulenumber - {-# LINE 1179 "KWOrder.hs" #-} + {-# LINE 1295 "KWOrder.hs" #-} ) ( _hdIdepgraph,_hdIrulenumber) = hd_ _hdOrulenumber @@ -1187,17 +1303,17 @@ (T_Productions (\ _lhsIrulenumber -> (let _lhsOdepgraph :: ([ProdDependencyGraph]) _lhsOrulenumber :: Int - -- use rule "KWOrder.ag"(line 122, column 33) + -- use rule "KWOrder.ag"(line 146, column 33) _lhsOdepgraph = - ({-# LINE 122 "KWOrder.ag" #-} + ({-# LINE 146 "KWOrder.ag" #-} [] - {-# LINE 1195 "KWOrder.hs" #-} + {-# LINE 1311 "KWOrder.hs" #-} ) -- copy rule (chain) _lhsOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _lhsIrulenumber - {-# LINE 1201 "KWOrder.hs" #-} + {-# LINE 1317 "KWOrder.hs" #-} ) in ( _lhsOdepgraph,_lhsOrulenumber))) ) -- Rule -------------------------------------------------------- @@ -1207,6 +1323,7 @@ rulenumber : Int synthesized attributes: edges : Set.Set Edge + erules : ERule vertices : Set.Set Vertex alternatives: alternative Rule: @@ -1229,15 +1346,15 @@ (sem_Rule_Rule _mbName (sem_Pattern _pattern ) (sem_Expression _rhs ) _owrt _origin _explicit ) -- semantic domain newtype T_Rule = T_Rule (Int -> - ( (Set.Set Edge),Int,(Set.Set Vertex))) + ( (Set.Set Edge),ERule,Int,(Set.Set Vertex))) data Inh_Rule = Inh_Rule {rulenumber_Inh_Rule :: Int} -data Syn_Rule = Syn_Rule {edges_Syn_Rule :: (Set.Set Edge),rulenumber_Syn_Rule :: Int,vertices_Syn_Rule :: (Set.Set Vertex)} +data Syn_Rule = Syn_Rule {edges_Syn_Rule :: (Set.Set Edge),erules_Syn_Rule :: ERule,rulenumber_Syn_Rule :: Int,vertices_Syn_Rule :: (Set.Set Vertex)} wrap_Rule :: T_Rule -> Inh_Rule -> Syn_Rule wrap_Rule (T_Rule sem ) (Inh_Rule _lhsIrulenumber ) = - (let ( _lhsOedges,_lhsOrulenumber,_lhsOvertices) = sem _lhsIrulenumber - in (Syn_Rule _lhsOedges _lhsOrulenumber _lhsOvertices )) + (let ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices) = sem _lhsIrulenumber + in (Syn_Rule _lhsOedges _lhsOerules _lhsOrulenumber _lhsOvertices )) sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> @@ -1248,58 +1365,71 @@ sem_Rule_Rule mbName_ (T_Pattern pattern_ ) (T_Expression rhs_ ) owrt_ origin_ explicit_ = (T_Rule (\ _lhsIrulenumber -> (let _lhsOrulenumber :: Int + _lhsOerules :: ERule _lhsOvertices :: (Set.Set Vertex) _lhsOedges :: (Set.Set Edge) _patternIcopy :: Pattern _patternIvertices :: (Set.Set Vertex) + _rhsIcopy :: Expression _rhsIvertices :: (Set.Set Vertex) - -- "KWOrder.ag"(line 42, column 11) + -- "KWOrder.ag"(line 39, column 11) _lhsOrulenumber = - ({-# LINE 42 "KWOrder.ag" #-} + ({-# LINE 39 "KWOrder.ag" #-} _lhsIrulenumber + 1 - {-# LINE 1261 "KWOrder.hs" #-} + {-# LINE 1380 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 43, column 11) + -- "KWOrder.ag"(line 40, column 11) _rulename = - ({-# LINE 43 "KWOrder.ag" #-} + ({-# LINE 40 "KWOrder.ag" #-} maybe (identifier $ "rule" ++ show _lhsIrulenumber) id mbName_ - {-# LINE 1267 "KWOrder.hs" #-} + {-# LINE 1386 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 85, column 11) + -- "KWOrder.ag"(line 51, column 10) + _lhsOerules = + ({-# LINE 51 "KWOrder.ag" #-} + ERule _rulename + _patternIcopy + _rhsIcopy + owrt_ + origin_ + explicit_ + {-# LINE 1397 "KWOrder.hs" #-} + ) + -- "KWOrder.ag"(line 109, column 11) _vertex = - ({-# LINE 85 "KWOrder.ag" #-} + ({-# LINE 109 "KWOrder.ag" #-} VRule _rulename - {-# LINE 1273 "KWOrder.hs" #-} + {-# LINE 1403 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 86, column 11) + -- "KWOrder.ag"(line 110, column 11) _lhsOvertices = - ({-# LINE 86 "KWOrder.ag" #-} + ({-# LINE 110 "KWOrder.ag" #-} Set.insert _vertex $ _patternIvertices `Set.union` _rhsIvertices - {-# LINE 1279 "KWOrder.hs" #-} + {-# LINE 1409 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 98, column 11) + -- "KWOrder.ag"(line 122, column 11) _edgesout = - ({-# LINE 98 "KWOrder.ag" #-} + ({-# LINE 122 "KWOrder.ag" #-} map ((,) _vertex ) (Set.toList _rhsIvertices) - {-# LINE 1285 "KWOrder.hs" #-} + {-# LINE 1415 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 99, column 11) + -- "KWOrder.ag"(line 123, column 11) _edgesin = - ({-# LINE 99 "KWOrder.ag" #-} + ({-# LINE 123 "KWOrder.ag" #-} map (flip (,) _vertex ) (Set.toList _patternIvertices) - {-# LINE 1291 "KWOrder.hs" #-} + {-# LINE 1421 "KWOrder.hs" #-} ) - -- "KWOrder.ag"(line 100, column 11) + -- "KWOrder.ag"(line 124, column 11) _lhsOedges = - ({-# LINE 100 "KWOrder.ag" #-} + ({-# LINE 124 "KWOrder.ag" #-} Set.fromList $ _edgesout ++ _edgesin - {-# LINE 1297 "KWOrder.hs" #-} + {-# LINE 1427 "KWOrder.hs" #-} ) ( _patternIcopy,_patternIvertices) = pattern_ - ( _rhsIvertices) = + ( _rhsIcopy,_rhsIvertices) = rhs_ - in ( _lhsOedges,_lhsOrulenumber,_lhsOvertices))) ) + in ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices))) ) -- Rules ------------------------------------------------------- {- visit 0: @@ -1307,6 +1437,7 @@ rulenumber : Int synthesized attributes: edges : Set.Set Edge + erules : ERules vertices : Set.Set Vertex alternatives: alternative Cons: @@ -1321,91 +1452,107 @@ (Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) ) -- semantic domain newtype T_Rules = T_Rules (Int -> - ( (Set.Set Edge),Int,(Set.Set Vertex))) + ( (Set.Set Edge),ERules,Int,(Set.Set Vertex))) data Inh_Rules = Inh_Rules {rulenumber_Inh_Rules :: Int} -data Syn_Rules = Syn_Rules {edges_Syn_Rules :: (Set.Set Edge),rulenumber_Syn_Rules :: Int,vertices_Syn_Rules :: (Set.Set Vertex)} +data Syn_Rules = Syn_Rules {edges_Syn_Rules :: (Set.Set Edge),erules_Syn_Rules :: ERules,rulenumber_Syn_Rules :: Int,vertices_Syn_Rules :: (Set.Set Vertex)} wrap_Rules :: T_Rules -> Inh_Rules -> Syn_Rules wrap_Rules (T_Rules sem ) (Inh_Rules _lhsIrulenumber ) = - (let ( _lhsOedges,_lhsOrulenumber,_lhsOvertices) = sem _lhsIrulenumber - in (Syn_Rules _lhsOedges _lhsOrulenumber _lhsOvertices )) + (let ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices) = sem _lhsIrulenumber + in (Syn_Rules _lhsOedges _lhsOerules _lhsOrulenumber _lhsOvertices )) sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules sem_Rules_Cons (T_Rule hd_ ) (T_Rules tl_ ) = (T_Rules (\ _lhsIrulenumber -> (let _lhsOedges :: (Set.Set Edge) + _lhsOerules :: ERules _lhsOvertices :: (Set.Set Vertex) _lhsOrulenumber :: Int _hdOrulenumber :: Int _tlOrulenumber :: Int _hdIedges :: (Set.Set Edge) + _hdIerules :: ERule _hdIrulenumber :: Int _hdIvertices :: (Set.Set Vertex) _tlIedges :: (Set.Set Edge) + _tlIerules :: ERules _tlIrulenumber :: Int _tlIvertices :: (Set.Set Vertex) - -- use rule "KWOrder.ag"(line 94, column 33) + -- use rule "KWOrder.ag"(line 118, column 33) _lhsOedges = - ({-# LINE 94 "KWOrder.ag" #-} + ({-# LINE 118 "KWOrder.ag" #-} _hdIedges `Set.union` _tlIedges - {-# LINE 1354 "KWOrder.hs" #-} + {-# LINE 1488 "KWOrder.hs" #-} ) - -- use rule "KWOrder.ag"(line 52, column 36) + -- use rule "KWOrder.ag"(line 48, column 25) + _lhsOerules = + ({-# LINE 48 "KWOrder.ag" #-} + _hdIerules : _tlIerules + {-# LINE 1494 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 76, column 36) _lhsOvertices = - ({-# LINE 52 "KWOrder.ag" #-} + ({-# LINE 76 "KWOrder.ag" #-} _hdIvertices `Set.union` _tlIvertices - {-# LINE 1360 "KWOrder.hs" #-} + {-# LINE 1500 "KWOrder.hs" #-} ) -- copy rule (up) _lhsOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _tlIrulenumber - {-# LINE 1366 "KWOrder.hs" #-} + {-# LINE 1506 "KWOrder.hs" #-} ) -- copy rule (down) _hdOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _lhsIrulenumber - {-# LINE 1372 "KWOrder.hs" #-} + {-# LINE 1512 "KWOrder.hs" #-} ) -- copy rule (chain) _tlOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _hdIrulenumber - {-# LINE 1378 "KWOrder.hs" #-} + {-# LINE 1518 "KWOrder.hs" #-} ) - ( _hdIedges,_hdIrulenumber,_hdIvertices) = + ( _hdIedges,_hdIerules,_hdIrulenumber,_hdIvertices) = hd_ _hdOrulenumber - ( _tlIedges,_tlIrulenumber,_tlIvertices) = + ( _tlIedges,_tlIerules,_tlIrulenumber,_tlIvertices) = tl_ _tlOrulenumber - in ( _lhsOedges,_lhsOrulenumber,_lhsOvertices))) ) + in ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices))) ) sem_Rules_Nil :: T_Rules sem_Rules_Nil = (T_Rules (\ _lhsIrulenumber -> (let _lhsOedges :: (Set.Set Edge) + _lhsOerules :: ERules _lhsOvertices :: (Set.Set Vertex) _lhsOrulenumber :: Int - -- use rule "KWOrder.ag"(line 94, column 33) + -- use rule "KWOrder.ag"(line 118, column 33) _lhsOedges = - ({-# LINE 94 "KWOrder.ag" #-} + ({-# LINE 118 "KWOrder.ag" #-} Set.empty - {-# LINE 1395 "KWOrder.hs" #-} + {-# LINE 1536 "KWOrder.hs" #-} ) - -- use rule "KWOrder.ag"(line 52, column 36) + -- use rule "KWOrder.ag"(line 48, column 25) + _lhsOerules = + ({-# LINE 48 "KWOrder.ag" #-} + [] + {-# LINE 1542 "KWOrder.hs" #-} + ) + -- use rule "KWOrder.ag"(line 76, column 36) _lhsOvertices = - ({-# LINE 52 "KWOrder.ag" #-} + ({-# LINE 76 "KWOrder.ag" #-} Set.empty - {-# LINE 1401 "KWOrder.hs" #-} + {-# LINE 1548 "KWOrder.hs" #-} ) -- copy rule (chain) _lhsOrulenumber = - ({-# LINE 36 "KWOrder.ag" #-} + ({-# LINE 33 "KWOrder.ag" #-} _lhsIrulenumber - {-# LINE 1407 "KWOrder.hs" #-} + {-# LINE 1554 "KWOrder.hs" #-} ) - in ( _lhsOedges,_lhsOrulenumber,_lhsOvertices))) ) + in ( _lhsOedges,_lhsOerules,_lhsOrulenumber,_lhsOvertices))) ) -- TypeSig ----------------------------------------------------- {- alternatives: diff --git a/src/Ag.hs b/src/Ag.hs --- a/src/Ag.hs +++ b/src/Ag.hs @@ -23,6 +23,7 @@ import qualified KWOrder as Pass3a (sem_Grammar, wrap_Grammar, Syn_Grammar (..), Inh_Grammar (..)) import qualified GenerateCode as Pass4 (sem_CGrammar, wrap_CGrammar, Syn_CGrammar(..), Inh_CGrammar(..)) import qualified PrintVisitCode as Pass4a (sem_CGrammar, wrap_CGrammar, Syn_CGrammar(..), Inh_CGrammar(..)) +import qualified ExecutionPlan2Hs as Pass4b (sem_ExecutionPlan, wrap_ExecutionPlan, Syn_ExecutionPlan(..), Inh_ExecutionPlan(..)) import qualified PrintCode as Pass5 (sem_Program, wrap_Program, Syn_Program (..), Inh_Program (..)) import qualified PrintOcamlCode as Pass5a (sem_Program, wrap_Program, Syn_Program (..), Inh_Program (..)) import qualified PrintErrorMessages as PrErr (sem_Errors , wrap_Errors , Syn_Errors (..), Inh_Errors (..), isError) @@ -75,9 +76,11 @@ output3 = Pass3.wrap_Grammar (Pass3.sem_Grammar grammar2 ) Pass3.Inh_Grammar {Pass3.options_Inh_Grammar = flags'} grammar3 = Pass3.output_Syn_Grammar output3 output3a = Pass3a.wrap_Grammar (Pass3a.sem_Grammar grammar2 ) Pass3a.Inh_Grammar {Pass3a.options_Inh_Grammar = flags'} - debug3a = Pass3a.debugoutput_Syn_Grammar output3a + grammar3a = 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} + debug4b = Pass4b.debugoutput_Syn_ExecutionPlan output4b output5 = Pass5.wrap_Program (Pass5.sem_Program (Pass4.output_Syn_CGrammar output4)) Pass5.Inh_Program {Pass5.options_Inh_Program = flags', Pass5.pragmaBlocks_Inh_Program = pragmaBlocksTxt, Pass5.importBlocks_Inh_Program = importBlocksTxt, Pass5.textBlocks_Inh_Program = textBlocksDoc, Pass5.textBlockMap_Inh_Program = textBlockMap, Pass5.optionsLine_Inh_Program = optionsLine, Pass5.mainFile_Inh_Program = mainFile, Pass5.moduleHeader_Inh_Program = mkModuleHeader $ Pass1.moduleDecl_Syn_AG output1, Pass5.mainName_Inh_Program = mkMainName mainName $ Pass1.moduleDecl_Syn_AG output1} output5a = Pass5a.wrap_Program (Pass5a.sem_Program (Pass4.output_Syn_CGrammar output4)) Pass5a.Inh_Program { Pass5a.options_Inh_Program = flags', Pass5a.textBlockMap_Inh_Program = textBlockMap } output6 = PrErr.wrap_Errors (PrErr.sem_Errors errorsToReport) PrErr.Inh_Errors {PrErr.options_Inh_Errors = flags', PrErr.dups_Inh_Errors = [] } @@ -206,7 +209,7 @@ , AspectAGDump.pp_Syn_Grammar aspectAG ] | kennedyWarren flags' - = vlist [debug3a, + = vlist [debug4b, if dumpgrammar flags' then vlist [ pp "{- Dump of grammar with default rules" , GrammarDump.pp_Syn_Grammar dump2 diff --git a/src/CommonTypes.hs b/src/CommonTypes.hs --- a/src/CommonTypes.hs +++ b/src/CommonTypes.hs @@ -68,6 +68,8 @@ type NontermIdent = Identifier type ConstructorIdent = Identifier type AttrOrderMap = Map NontermIdent (Map ConstructorIdent (Set Dependency)) +type VisitIdentifier = Int +type StateIdentifier = Int data Dependency = Dependency Occurrence Occurrence deriving (Eq,Ord,Show) data Occurrence = OccAttr Identifier Identifier diff --git a/src/KennedyWarren.hs b/src/KennedyWarren.hs --- a/src/KennedyWarren.hs +++ b/src/KennedyWarren.hs @@ -3,6 +3,7 @@ import CommonTypes import Pretty import Knuth1 +import ExecutionPlan import Debug.Trace import Control.Monad.ST import Control.Monad.State @@ -10,34 +11,39 @@ import Data.STRef import Data.Maybe import Data.List +import Data.Ord import qualified Data.Set as Set import qualified Data.Map as Map import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet -kennedyWarrenIO :: [NontDependencyInformation] -> PP_Doc -kennedyWarrenIO ndis = runST $ do +kennedyWarrenOrder :: Set.Set NontermIdent -> [NontDependencyInformation] -> TypeSyns -> Maybe ExecutionPlan +kennedyWarrenOrder wr ndis typesyns = runST $ do indi <- mapM mkNontDependencyInformationM ndis knuth1 indi -- Check all graphs for cyclicity, transitive closure and consistency traceST $ "Checking graphs..." - forM_ indi $ \ndi -> do + allok <- forM indi $ \ndi -> do let nont = ndiNonterminal . ndimOrig $ ndi let g = ndgmDepGraph . ndimDepGraph $ ndi + -- Topological sort + --tsedg <- graphTopSort g -- Cyclicity check c1 <- graphIsCyclic g when c1 $ traceST $ "Nonterminal graph " ++ show nont ++ " is cylic!" -- Transtive closure check - trc <- graphIsTRC g - when (not trc) $ traceST $ "Nonterminal graph " ++ show nont ++ " is not transitively closed!" + --trc <- graphIsTRC g + --when (not trc) $ traceST $ "Nonterminal graph " ++ show nont ++ " is not transitively closed!" -- Consistency check cons <- graphCheckConsistency g when (not cons) $ traceST $ "Nonterminal graph " ++ show nont ++ " is not consistent!" -- Loop trough all productions - forM_ (ndimProds ndi) $ \prod -> do + allok <- forM (ndimProds ndi) $ \prod -> do let pr = pdgProduction $ pdgmOrig prod let g = pdgmDepGraph $ prod + -- Topsort + --addTopSortEdges tsedg prod -- Check for cyclicity c2 <- graphIsCyclic g when c2 $ traceST $ "Production graph " ++ show pr ++ " of nonterminal " @@ -50,13 +56,21 @@ cons <- graphCheckConsistency g when (not cons) $ traceST $ "Production graph " ++ show pr ++ " of nonterminal " ++ show nont ++ " is not consistent!" - -- Recreate non-transitive closed graph for efficiency - indi <- undoTransitiveClosure indi - -- Debug output - traceST $ "Converting to string..." - rtexts <- mapM toGVNontDependencyInfo indi - traceST $ "Done." - return (vlist rtexts) + return $ (not c2) && trc && cons + return $ (and allok) && (not c1) && cons + if (and allok) + then do + -- Create non-transitive closed graph for efficiency + indi <- undoTransitiveClosure indi + -- Doing kennedywarren + ret <- runVG $ do + traceVG $ "Running kennedy-warren..." + initvs <- kennedyWarrenVisitM wr indi + -- Generate execution plan + kennedyWarrenExecutionPlan indi initvs wr typesyns + -- Return the result + return $ Just ret + else return Nothing ------------------------------------------------------------------------------- -- Debugging functionality @@ -115,3 +129,529 @@ text "}" >-< text "") + +------------------------------------------------------------------------------- +-- Kennedy-Warren in monadic style +------------------------------------------------------------------------------- +{- +runVG :: VG s a -> ST s a +insertInitialNode :: NontDependencyInformationM s -> VG s VGNode +createPending :: VGNode -> Set.Set Identifier -> Set.Set Identifier -> VG s VGEdge +selectPending :: VG s VGEdge +getInherited :: VGEdge -> VG s (Set.Set Identifier) +getSynthesized :: VGEdge -> VG s (Set.Set Identifier) +markFinal :: VGEdge -> VG s () +getProductions :: VGEdge -> VG s [VGProd] +onMarkedDepGraph :: (ProdDependencyGraphM s -> ST s a) -> VGProd -> VG s a +isDepGraphVertexFinal :: VGProd -> Vertex -> VG s Bool +setDepGraphVerticesFinal :: VGProd -> [Vertex] -> VG s () +getChildState :: VGProd -> Identifier -> VG s VGNode +addChildVisit :: VGProd -> Identifier -> VGEdge -> VG s VisitStep +addVisitStep :: VGProd -> VisitStep -> VG s () +repeatM :: VG s () -> VG s () +-} + +newtype VGNode = VGNode Int deriving (Show,Eq,Ord) +newtype VGEdge = VGEdge Int deriving (Show,Eq,Ord) +newtype VGProd = VGProd (VGEdge,Int) deriving (Show,Eq,Ord) + +data VGState s = VGState { vgNodeNum :: Int + , vgEdgeNum :: Int + -- Node maps + , vgOutgoing :: IntMap.IntMap (STRef s (Set.Set VGEdge)) + , vgIncoming :: IntMap.IntMap (Maybe VGEdge) + , vgNDI :: IntMap.IntMap (STRef s (NontDependencyInformationM s)) + , vgInhSynNode :: Map.Map (Identifier, Set.Set Identifier, Set.Set Identifier) VGNode + , vgNodeInhSyn :: IntMap.IntMap (Set.Set Identifier, Set.Set Identifier) + , vgInitial :: Map.Map Identifier VGNode + -- Edge maps + , vgEdges :: IntMap.IntMap (VGNode, VGNode) + , vgEdgesR :: Map.Map (VGNode,VGNode) VGEdge + , vgInherited :: IntMap.IntMap (Set.Set Identifier) + , vgSynthesized :: IntMap.IntMap (Set.Set Identifier) + , vgPending :: IntSet.IntSet + , vgChildVisits :: IntMap.IntMap (STRef s (Map.Map (Identifier,Int) [VGNode])) + -- Final vertices in production graphs + , vgFinalVertices :: IntMap.IntMap (STRef s (Set.Set (Vertex,Int))) + -- Construction of execution plan (Nonterminal,Production,Visit) + , vgProdVisits :: Map.Map (Identifier,Identifier,VGEdge) (STRef s [VisitStep]) + } + +type VG s a = ErrorT String (StateT (VGState s) (ST s)) a + +------------------------------------------------------------ +--- Public functions --- +------------------------------------------------------------ +-- | Run the VG monad in the ST monad +runVG :: VG s a -> ST s a +runVG vg = do (Right a,rs) <- runStateT (runErrorT vg) vgEmptyState + return a + +-- | Insert an initial node for this nonterminal into the visit graph +insertInitialNode :: NontDependencyInformationM s -> VG s VGNode +insertInitialNode ndi = do + rndi <- vgInST $ newSTRef ndi + (VGNode node) <- vgCreateNode rndi Set.empty Set.empty + initial <- gets vgInitial + incoming <- gets vgIncoming + modify $ \st -> st { vgInitial = Map.insert (ndiNonterminal $ ndimOrig ndi) (VGNode node) initial + , vgIncoming = IntMap.insert node Nothing incoming } + return (VGNode node) + +-- | Create a pending edge from this node with a set of inherited and synthesized attributes +createPending :: VGNode -> Set.Set Identifier -> Set.Set Identifier -> VG s VGEdge +createPending vgn@(VGNode n) inh syn = do + -- Check if target node already exists + ninhsyn <- gets vgNodeInhSyn + let (pinh,psyn) = imLookup n ninhsyn + let ninh = Set.union pinh inh + let nsyn = Set.union psyn syn + mndi <- gets vgNDI + let rndi = imLookup n mndi + ndi <- vgInST $ readSTRef rndi + inhsynn <- gets vgInhSynNode + case Map.lookup (ndiNonterminal $ ndimOrig ndi, ninh, nsyn) inhsynn of + Just tn -> do + when (tn == vgn) $ do traceVG $ "Source and target nodes are the same!" + traceVG $ "Maybe there is a wrapper with no inherited or synthesized attributes." + traceVG $ "Inh: " ++ show inh + traceVG $ "Syn: " ++ show syn + traceVG $ "PInh: " ++ show pinh + traceVG $ "PSyn: " ++ show psyn + -- tn is target node, now check if edge exists and create if not + edgesr <- gets vgEdgesR + case Map.lookup (vgn,tn) edgesr of + Just e -> return e + Nothing -> vgCreatePendingEdge vgn tn inh syn + Nothing -> do + -- target node does not exist, create it and then create the new edge + tn <- vgCreateNode rndi ninh nsyn + vgCreatePendingEdge vgn tn inh syn + +-- | Return an arbitrary pending edge of which the from node is ready +selectPending :: VG s VGEdge +selectPending = do + pending <- gets vgPending + incoming <- gets vgIncoming + edges <- gets vgEdges + let readyPend = filter (\p -> let (VGNode fr,_) = imLookup p edges + in isJust $ IntMap.lookup fr incoming) $ IntSet.toList pending + guard $ not $ null readyPend + return $ VGEdge $ head $ readyPend + +-- | Get the inherited attributes of an edge +getInherited :: VGEdge -> VG s (Set.Set Identifier) +getInherited (VGEdge edg) = do + inhs <- gets vgInherited + return $ imLookup edg inhs + +-- | Get the synthesized attributes of an edge +getSynthesized :: VGEdge -> VG s (Set.Set Identifier) +getSynthesized (VGEdge edg) = do + syns <- gets vgSynthesized + return $ imLookup edg syns + +-- | Mark an edge as final +markFinal :: VGEdge -> VG s () +markFinal vgedg@(VGEdge edg) = do + incoming <- gets vgIncoming + edges <- gets vgEdges + pending <- gets vgPending + let (VGNode from,VGNode to) = imLookup edg edges + modify $ \st -> st { vgIncoming = IntMap.insert to (Just vgedg) incoming + , vgPending = IntSet.delete edg pending } + +-- | Get all productions for an edge +getProductions :: VGEdge -> VG s [VGProd] +getProductions vedg@(VGEdge edg) = do + edges <- gets vgEdges + let (VGNode fr,_) = imLookup edg edges + ndis <- gets vgNDI + let rndi = imLookup fr ndis + ndi <- vgInST $ readSTRef rndi + return $ map (\x -> VGProd (vedg,x)) [0..(length $ ndimProds ndi)-1] + +-- | Execute a function on the dependency graph for this production +onMarkedDepGraph :: (ProdDependencyGraphM s -> ST s a) -> VGProd -> VG s a +onMarkedDepGraph f (VGProd (VGEdge edg, n)) = do + edges <- gets vgEdges + let (VGNode fr,_) = imLookup edg edges + ndis <- gets vgNDI + let rndi = imLookup fr ndis + ndi <- vgInST $ readSTRef rndi + vgInST $ f $ (ndimProds ndi) !! n -- not efficient, but lists are usually short + +-- | Check whether this vertex has been marked as final +isDepGraphVertexFinal :: VGProd -> Vertex -> VG s Bool +isDepGraphVertexFinal (VGProd (VGEdge edg, p)) v = do + edges <- gets vgEdges + let (from,_) = imLookup edg edges + vgDepGraphVertexFinal from p v + +-- | Mark these vertices final in this production +setDepGraphVerticesFinal :: VGProd -> [Vertex] -> VG s () +setDepGraphVerticesFinal (VGProd (VGEdge edg, p)) vs = do + edges <- gets vgEdges + let (_,VGNode to) = imLookup edg edges + finalv <- gets vgFinalVertices + let rfinalv = imLookup to finalv + vgInST $ modifySTRef rfinalv $ Set.union (Set.fromList $ map (\v -> (v,p)) vs) + +-- | Add a child visit to this production and return the step for the execution plan +addChildVisit :: VGProd -> Identifier -> VGEdge -> VG s VisitStep +addChildVisit vgp@(VGProd (VGEdge edg, p)) id (VGEdge vs) = do + edges <- gets vgEdges + let (VGNode from,vgto@(VGNode to)) = imLookup vs edges -- from must be equal to the current state + childvs <- gets vgChildVisits + let rchildv = imLookup edg childvs + vgInST $ modifySTRef rchildv $ Map.insertWith' (++) (id,p) [vgto] + ndis <- gets vgNDI + let rndi = imLookup from ndis + ndi <- vgInST $ readSTRef rndi + let nt = ndiNonterminal $ ndimOrig ndi + return $ ChildVisit id nt vs + +-- | Add a step to the execution plan of this visit +addVisitStep :: VGProd -> VisitStep -> VG s () +addVisitStep (VGProd (VGEdge edg, p)) st = do + edges <- gets vgEdges + let (VGNode fr,_) = imLookup edg edges + ndis <- gets vgNDI + let rndi = imLookup fr ndis + ndi <- vgInST $ readSTRef rndi + prodvs <- gets vgProdVisits + let nont = ndiNonterminal $ ndimOrig ndi + let prod = pdgProduction $ pdgmOrig $ ndimProds ndi !! p + let Just rprodv = Map.lookup (nont, prod, VGEdge edg) prodvs + vgInST $ modifySTRef rprodv (++ [st]) + +-- | Get the state of a child in a certain production +getChildState :: VGProd -> Identifier -> VG s VGNode +getChildState (VGProd (VGEdge edg,p)) id = do + childvs <- gets vgChildVisits + let rchildv = imLookup edg childvs + childv <- vgInST $ readSTRef rchildv + case Map.lookup (id,p) childv of + Just (n:_) -> return n + Nothing -> do + -- Look for previous edge + edges <- gets vgEdges + let (VGNode from,_) = imLookup edg edges + incoming <- gets vgIncoming + case IntMap.lookup from incoming of + Just (Just iedg) -> getChildState (VGProd (iedg,p)) id + Just Nothing -> do + -- Lookup initial state + ndis <- gets vgNDI + let rndi = imLookup from ndis + ndi <- vgInST $ readSTRef rndi + let Just nt = lookup id $ pdgChildMap $ pdgmOrig $ (ndimProds ndi) !! p + vgFindInitial nt + Nothing -> error "getChildState" + +-- | Repeat action untill mzero is encountered +repeatM :: VG s () -> VG s () +repeatM m = catchError (m >> repeatM m) (const $ return ()) + +------------------------------------------------------------ +--- Internal functions --- +------------------------------------------------------------ +-- | Execute a ST action inside the VG monad +vgInST :: ST s a -> VG s a +vgInST = lift . lift + +vgEmptyState :: VGState s +vgEmptyState = VGState { vgNodeNum = 0 + , vgEdgeNum = 0 + , vgOutgoing = IntMap.empty + , vgIncoming = IntMap.empty + , vgNDI = IntMap.empty + , vgInhSynNode = Map.empty + , vgNodeInhSyn = IntMap.empty + , vgInitial = Map.empty + , vgEdges = IntMap.empty + , vgEdgesR = Map.empty + , vgInherited = IntMap.empty + , vgSynthesized = IntMap.empty + , vgPending = IntSet.empty + , vgChildVisits = IntMap.empty + , vgFinalVertices = IntMap.empty + , vgProdVisits = Map.empty + } +-- | Create a new node +vgCreateNode :: STRef s (NontDependencyInformationM s) -> Set.Set Identifier -> Set.Set Identifier -> VG s VGNode +vgCreateNode rndi inh syn = do + num <- gets vgNodeNum + outgoing <- gets vgOutgoing + inhsyn <- gets vgInhSynNode + ninhsyn <- gets vgNodeInhSyn + ndi <- gets vgNDI + finalv <- gets vgFinalVertices + rout <- vgInST $ newSTRef Set.empty + rfinalv <- vgInST $ newSTRef Set.empty + nndi <- vgInST $ readSTRef rndi + modify $ \st -> st { vgNodeNum = num + 1 + , vgOutgoing = IntMap.insert num rout outgoing + , vgInhSynNode = Map.insert (ndiNonterminal $ ndimOrig nndi,inh,syn) (VGNode num) inhsyn + , vgNodeInhSyn = IntMap.insert num (inh,syn) ninhsyn + , vgNDI = IntMap.insert num rndi ndi + , vgFinalVertices = IntMap.insert num rfinalv finalv } + return $ VGNode num + +-- | Create a new pending edge +vgCreatePendingEdge :: VGNode -> VGNode -> Set.Set Identifier -> Set.Set Identifier -> VG s VGEdge +vgCreatePendingEdge vgn1@(VGNode n1) vgn2@(VGNode n2) inh syn = do + num <- gets vgEdgeNum + edges <- gets vgEdges + edgesr <- gets vgEdgesR + inhs <- gets vgInherited + syns <- gets vgSynthesized + outgoing <- gets vgOutgoing + pend <- gets vgPending + childv <- gets vgChildVisits + rchildv <- vgInST $ newSTRef Map.empty + let outr = imLookup n1 outgoing + let ret = VGEdge num + vgInST $ modifySTRef outr (Set.insert ret) + modify $ \st -> st { vgEdgeNum = num + 1 + , vgEdges = IntMap.insert num (vgn1,vgn2) edges + , vgEdgesR = Map.insert (vgn1,vgn2) ret edgesr + , vgPending = IntSet.insert num pend + , vgInherited = IntMap.insert num inh inhs + , vgSynthesized = IntMap.insert num syn syns + , vgChildVisits = IntMap.insert num rchildv childv } + -- Add prod visits (for constructing an execution plan) + ndis <- gets vgNDI + let rndi = imLookup n1 ndis + ndi <- vgInST $ readSTRef rndi + prodv <- gets vgProdVisits + refs <- forM (ndimProds ndi) $ \prod -> do + rprod <- vgInST $ newSTRef [] + return ((ndiNonterminal $ ndimOrig ndi, pdgProduction $ pdgmOrig prod, ret),rprod) + modify $ \st -> st { vgProdVisits = Map.union (Map.fromList refs) prodv } + return $ ret + +-- | Check whether a vertex is marked final on this node in this production +vgDepGraphVertexFinal :: VGNode -> Int -> Vertex -> VG s Bool +vgDepGraphVertexFinal (VGNode n) p v = do + finalv <- gets vgFinalVertices + let rfinalv = imLookup n finalv + curset <- vgInST $ readSTRef rfinalv + if Set.member (v,p) curset + then return True + else do + incoming <- gets vgIncoming + case IntMap.lookup n incoming of + Just (Just (VGEdge edg)) -> do + edges <- gets vgEdges + let (fr,_) = imLookup edg edges + vgDepGraphVertexFinal fr p v + Just Nothing -> return False + -- Nothing can never happen + +-- | Find the initial node for a nonterminal +vgFindInitial :: Identifier -> VG s VGNode +vgFindInitial nt = do + initial <- gets vgInitial + let Just r = Map.lookup nt initial + return r + +-- | Always succeeding IntMap lookup +imLookup :: Int -> IntMap.IntMap a -> a +imLookup k m = let Just r = IntMap.lookup k m in r + +-- | Trace inside the vg monad +traceVG :: String -> VG s () +traceVG s = trace s (return ()) + +------------------------------------------------------------ +--- The kennedy warren algorithm --- +------------------------------------------------------------ +{- +runVG :: VG s a -> ST s a +insertInitialNode :: NontDependencyInformationM s -> VG s VGNode +createPending :: VGNode -> Set.Set Identifier -> Set.Set Identifier -> VG s VGEdge +selectPending :: VG s VGEdge +getInherited :: VGEdge -> VG s (Set.Set Identifier) +getSynthesized :: VGEdge -> VG s (Set.Set Identifier) +markFinal :: VGEdge -> VG s () +getProductions :: VGEdge -> VG s [VGProd] +onMarkedDepGraph :: (ProdDependencyGraphM s -> ST s a) -> VGProd -> VG s a +isDepGraphVertexFinal :: VGProd -> Vertex -> VG s Bool +setDepGraphVerticesFinal :: VGProd -> [Vertex] -> VG s () +getChildState :: VGProd -> Identifier -> VG s VGNode +addChildVisit :: VGProd -> Identifier -> VGEdge -> VG s VisitStep +addVisitStep :: VGProd -> VisitStep -> VG s () +repeatM :: VG s () -> VG s () +-} + +kennedyWarrenVisitM :: Set.Set NontermIdent -> [NontDependencyInformationM s] -> VG s [Maybe Int] +kennedyWarrenVisitM wr ndis = do + -- Create initial nodes and edges (edges only for wrapper nodes) + initvs <- forM ndis $ \ndi -> do + nd <- insertInitialNode ndi + if (Set.member (ndiNonterminal $ ndimOrig $ ndi) wr) + then do + VGEdge initv <- createPending nd (Set.fromList $ ndiInh $ ndimOrig ndi) (Set.fromList $ ndiSyn $ ndimOrig ndi) + return $ Just initv + else return Nothing + -- Handle all pending edges while there are any + repeatM $ do + pend <- selectPending + prods <- getProductions pend + inhs <- getInherited pend + syns <- getSynthesized pend + -- Handle each production for this edge + forM_ prods $ \prod -> do + -- Find depth of all synthesized child visits + (vis,i) <- foldM (foldChildVisits prod) ([],0) (map (VAttr Syn _LHS) . Set.toList $ syns) + -- Mark them as final + setDepGraphVerticesFinal prod (map fst vis) + -- Change the inherited child visits + vis2 <- forM vis $ \(v,i) -> do + if isChildInh v + then do + preds <- onMarkedDepGraph (liftM Set.toList . flip graphPredecessors v . pdgmDepGraph) prod + let ni = foldl1 min $ map (\x -> case x `lookup` vis of { Just i -> i; Nothing -> 99999999 }) preds + return (v,ni) + else if not $ isChildSyn v + then do + succs <- onMarkedDepGraph (liftM Set.toList . flip graphSuccessors v . pdgmDepGraph) prod + let ni = foldl max 0 $ map (\x -> case x `lookup` vis of { Just i -> i + 1; Nothing -> 0 }) succs + return (v,ni) + else return (v,i) + -- Add all synthesized attributes that are also ready but are not needed + allpreds <- forM vis2 $ \(v,i) -> do + if isChildInh v + then do + preds <- onMarkedDepGraph (liftM Set.toList . flip graphPredecessors v . pdgmDepGraph) prod + return $ Set.fromList $ filter isChildSyn preds + else return Set.empty + lextravis <- mapM (\v -> do ready <- isReadyVertex prod vis2 v + return $ do i <- ready + return (v,i)) $ Set.toList $ Set.unions allpreds + let extravis = catMaybes lextravis + setDepGraphVerticesFinal prod (map fst extravis) + -- Group by visit number and do visit for every num + let gvis = groupSortBy (comparing snd) $ vis2 ++ extravis + forM_ gvis $ \visit -> do + -- Split child visits from rules + let (chattrs, rules) = partition isChildAttr $ map fst visit + -- Evaluate all rules + forM_ (reverse $ rules) $ \rule -> + case rule of + VRule r -> addVisitStep prod $ Sem r + VChild c -> addVisitStep prod $ ChildIntro c + _ -> return () + -- Now group by child, and do a visit for each child + let chs = groupSortBy (comparing getAttrChildName) $ chattrs + chvs <- forM chs $ \childvs -> do -- childs :: [Vertex] + let cinhs = map getAttrName $ filter isChildInh childvs + let csyns = map getAttrName $ filter isChildSyn childvs + let cname = getAttrChildName $ head childvs + -- Insert a new pending edge for this visit + curstate <- getChildState prod cname + target <- createPending curstate (Set.fromList cinhs) (Set.fromList csyns) + addChildVisit prod cname target + -- Add child visits as simultanuous step + when (length chvs > 0) $ do + addVisitStep prod $ Sim chvs + -- Mark this edge as final + markFinal pend + -- We are done + traceVG "Done." + return initvs + +-- | groupBy that groups all equal (according to the function) elements instead of consequtive equal elements +groupSortBy :: (a -> a -> Ordering) -> [a] -> [[a]] +groupSortBy f = groupBy (\x y -> f x y == EQ) . sortBy f + +type ChildVisits = [(Vertex,Int)] + +-- | Helper function for folding over child visits +foldChildVisits :: VGProd -> (ChildVisits, Int) -> Vertex -> VG s (ChildVisits, Int) +foldChildVisits prod (vis,i) v = do + (nvis,ni) <- findChildVisits prod v vis + return (nvis, ni `max` i) + +-- | Recursively find all visits to childs +findChildVisits :: VGProd -> Vertex -> ChildVisits -> VG s (ChildVisits, Int) +findChildVisits prod v vis = do + case lookup v vis of + Just i -> return (vis,i) + Nothing -> do + final <- isDepGraphVertexFinal prod v + if final + then return (vis,0) + else do + successors <- onMarkedDepGraph (liftM Set.toList . flip graphSuccessors v . pdgmDepGraph) prod + (nvis,ni) <- foldM (foldChildVisits prod) (vis,0) successors + if isChildSyn v + then return ((v,ni + 1) : nvis, ni + 1) + else return ((v,ni) : nvis, ni) + +-- | Check if a vertex can be marked final in this step (and is not final yet) and return the visit num +isReadyVertex :: VGProd -> ChildVisits -> Vertex -> VG s (Maybe Int) +isReadyVertex prod vis v = do + final <- isDepGraphVertexFinal prod v + if v `elem` (map fst vis) || final + then return Nothing + else do + succ <- onMarkedDepGraph (flip graphSuccessors v . pdgmDepGraph) prod + rd <- mapM (\x -> do case lookup x vis of + Just i -> return $ Just i + Nothing -> do fin <- isDepGraphVertexFinal prod x + return $ if fin then Just 1 else Nothing) (Set.toList succ) + if all isJust rd + then return $ Just $ foldl1 max $ catMaybes rd + else return $ Nothing + +-- | Check if this vertex is a synthesized attribute of a child +isChildSyn :: Vertex -> Bool +isChildSyn v = isChildAttr v && getAttrType v == Syn + +-- | Check if this vertex is an inherited attribute of a child +isChildInh :: Vertex -> Bool +isChildInh v = isChildAttr v && getAttrType v == Inh + +-- | Check if this vertex is an attribute of a child +isChildAttr :: Vertex -> Bool +isChildAttr v = isVertexAttr v && getAttrChildName v /= _LHS && getAttrType v /= Loc + +------------------------------------------------------------ +--- Construction of the execution plan --- +------------------------------------------------------------ +kennedyWarrenExecutionPlan :: [NontDependencyInformationM s] -> [Maybe Int] -> Set.Set NontermIdent + -> TypeSyns -> VG s ExecutionPlan +kennedyWarrenExecutionPlan ndis initvs wr typesyns = do + -- Loop over all nonterminals + nonts <- forM (zip ndis initvs) $ \(ndi, initv) -> do + -- Loop over all productions of this nonterminal + prods <- forM (ndimProds ndi) $ \prod -> do + -- Construct the visits for this production + let inont = ndiNonterminal $ ndimOrig ndi + let iprod = pdgProduction $ pdgmOrig prod + prodvs <- gets vgProdVisits + let thisvisits = filter (\((int,ipr,_),_) -> int == inont && ipr == iprod) $ Map.toList prodvs + visits <- forM thisvisits $ \((_,_,vgedg@(VGEdge edg)),rprodvs) -> do + edges <- gets vgEdges + let (VGNode fr, VGNode to) = imLookup edg edges + steps <- vgInST $ readSTRef rprodvs + inh <- getInherited vgedg + syn <- getSynthesized vgedg + return $ Visit edg fr to inh syn steps + -- Return execution plan for this production + return $ EProduction (pdgProduction $ pdgmOrig prod) + (pdgRules $ pdgmOrig prod) + (pdgChilds $ pdgmOrig prod) + visits + -- Find initial state for this nonterminal + VGNode init <- vgFindInitial $ ndiNonterminal $ ndimOrig ndi + -- Return execution plan for this nonterminal + return $ ENonterminal (ndiNonterminal $ ndimOrig ndi) + (ndiParams $ ndimOrig ndi) + init + initv + prods + -- Return complete execution plan + return $ ExecutionPlan nonts typesyns wr diff --git a/src/Knuth1.hs b/src/Knuth1.hs --- a/src/Knuth1.hs +++ b/src/Knuth1.hs @@ -1,6 +1,7 @@ module Knuth1 where import Pretty +import ExecutionPlan import CommonTypes import Control.Monad import Control.Monad.ST @@ -93,13 +94,17 @@ -- Insert all initial edges graphInsertEdgesTRC g es return g - -- | Return all successors of a vertex graphSuccessors :: DependencyGraph s -> Vertex -> ST s (Set.Set Vertex) graphSuccessors g v = do sucs <- readSTRef $ (successors g) Array.! (graphGetIVertex g v) return $ Set.map (graphGetVertex g) sucs +-- | Return all predecessors of a vertex +graphPredecessors :: DependencyGraph s -> Vertex -> ST s (Set.Set Vertex) +graphPredecessors g v = do sucs <- readSTRef $ (predecessors g) Array.! (graphGetIVertex g v) + return $ Set.map (graphGetVertex g) sucs + -- | Check if the graph contains an edge graphContainsEdge :: DependencyGraph s -> Edge -> ST s Bool graphContainsEdge g (v1,v2) = do let iv1 = graphGetIVertex g v1 @@ -107,8 +112,7 @@ sucs <- readSTRef $ (successors g) Array.! iv1 return $ iv2 `Set.member` sucs --- | Insert an edge in a transtive closed graph and return all other edges that were --- added due to transtivity +-- | Insert an edge in the graph graphInsert :: DependencyGraph s -> Edge -> ST s () graphInsert g (v1,v2) = do let iv1 = graphGetIVertex g v1 let iv2 = graphGetIVertex g v2 @@ -164,6 +168,10 @@ return $ map ((,) rv . graphGetVertex g) sucl return $ concat perv +-- | Insert a list of edges in the graph +graphInsertEdges :: DependencyGraph s -> [Edge] -> ST s () +graphInsertEdges g ed = mapM_ (graphInsert g) ed + -- | Insert a list of edges in the graph and return all other edges that -- were added due to transitivity graphInsertEdgesTRC :: DependencyGraph s -> [Edge] -> ST s [Edge] @@ -225,6 +233,26 @@ return $ and $ r1 ++ r2 return $ and $ ret +-- | Add edges to the graph so that it is topologically sorted (this will not work if graph is cyclic) +graphTopSort :: DependencyGraph s -> ST s [Edge] +graphTopSort g = do let vs = Array.indices $ vertexOMap g + order <- foldM (graphTopSort' g) [] vs + mb <- forM (zip order (tail order)) $ \(v1,v2) -> do + let edg = graphGetEdge g (v2,v1) -- order is actually reverse order + ce <- graphContainsEdge g edg + if ce + then return Nothing + else do graphInsert g edg + return $ Just edg + return $ catMaybes mb + +-- | Helper function for graphTopSort +graphTopSort' :: DependencyGraph s -> [IVertex] -> IVertex -> ST s [IVertex] +graphTopSort' g prev cur | cur `elem` prev = return prev + | otherwise = do pred <- readSTRef $ (predecessors g) Array.! cur + order <- foldM (graphTopSort' g) prev $ Set.toList pred + return $ cur : order + ------------------------------------------------------------------------------- -- Dependency graph information wrappers ------------------------------------------------------------------------------- @@ -236,12 +264,15 @@ -- | Special wrapper for production dependency graphs, including mapping between child names and nonterminals data ProdDependencyGraph = ProdDependencyGraph { pdgVertices :: [Vertex] , pdgEdges :: [Edge] + , pdgRules :: ERules + , pdgChilds :: EChildren , pdgProduction :: Identifier , pdgChildMap :: [(Identifier, Identifier)] } -- | Represent all information from the dependency graphs for a nonterminal data NontDependencyInformation = NontDependencyInformation { ndiNonterminal :: Identifier + , ndiParams :: [Identifier] , ndiInh :: [Identifier] , ndiSyn :: [Identifier] , ndiDepGraph :: NontDependencyGraph @@ -289,18 +320,32 @@ , ndimDepGraph = dg , ndimProds = prods } --- | Construct the production graphs from the +-- | Construct the production graphs from the transitivelly closed graphs undoTransitiveClosure :: [NontDependencyInformationM s] -> ST s [NontDependencyInformationM s] undoTransitiveClosure ndis = do edgesl <- mapM (\ndi -> graphEdges (ndgmDepGraph $ ndimDepGraph ndi)) ndis let edges = concat edgesl forM ndis $ \ndi -> do prods <- mapM (mkProdDependencyGraphM False) (ndiProds $ ndimOrig ndi) - let ret = NontDependencyInformationM { ndimOrig = ndimOrig ndi - , ndimDepGraph = ndimDepGraph ndi - , ndimProds = prods } - addNontProd False (edges, ret) - return ret + forM_ (zip prods (ndimProds ndi)) $ \(nprod,oprod) -> do + -- All possible edges + let possa = do (v1,v2) <- edges + -- Take a child of this nonterminal type + guard $ isVertexAttr v1 + guard $ isVertexAttr v2 + let tp = getAttrChildName v1 + (ch,chtp) <- pdgChildMap $ pdgmOrig nprod + guard $ tp == chtp + -- Construct edge as it should be in the production graph + let nv1 = setAttrChildName v1 ch + let nv2 = setAttrChildName v2 ch + return (nv1, nv2) + toadd <- filterM (graphContainsEdge (pdgmDepGraph oprod)) possa + graphInsertEdges (pdgmDepGraph nprod) toadd + return $ NontDependencyInformationM { ndimOrig = ndimOrig ndi + , ndimDepGraph = ndimDepGraph ndi + , ndimProds = prods } + ------------------------------------------------------------------------------- -- Knuth-1 algorithm ------------------------------------------------------------------------------- @@ -308,29 +353,33 @@ -- | Combine the dependency and nonterminal graphs using Knuth-1 -- this function assumes that the nonterminal graphs initially contains no edges knuth1 :: [NontDependencyInformationM s] -> ST s () -knuth1 ndis = do -- Create initial list of pending edges for each ndi (just all edges of the production graphs) - let ipending :: NontDependencyInformationM s -> ST s [Edge] - ipending = liftM concat . mapM (graphEdges . pdgmDepGraph) . ndimProds --- pndis :: [([Edge], NontDependencyInformation)] +knuth1 ndis = do -- Create initial list of pending edges for each ndi per production (initially all prod edges) + let ipending :: NontDependencyInformationM s -> ST s [[Edge]] + ipending = mapM (graphEdges . pdgmDepGraph) . ndimProds +-- pndis :: [([[Edge]], NontDependencyInformation)] pndis <- mapM (\ndi -> liftM2 (,) (ipending ndi) (return ndi)) ndis knuth1' pndis -- | Helper function for |knuth1| which repeats the process until we are done -knuth1' :: [([Edge], NontDependencyInformationM s)] -> ST s () +knuth1' :: [([[Edge]], NontDependencyInformationM s)] -> ST s () knuth1' ndis = do -- Add edges from the production graphs to the nonterminal graph -- ndis' :: [Maybe [Edge]] ndis' <- mapM addProdNont ndis -- List of all newly added edges -- ntedge :: [Edge] - let ntedge = concatMap (\x -> maybe [] id x) ndis' + let pntedge = concatMap (\x -> maybe [] id x) ndis' + -- Add backedges + bedges <- addBackEdges ndis + -- All added nonterminal edges + let ntedge = pntedge ++ bedges if null ntedge -- When no new edges have been added we are done then return () else do -- Otherwise, the next step is to add edges from nonterminal to production graphs --- ndis'' :: [Maybe [Edge]] +-- ndis'' :: [Maybe [[Edge]]] ndis'' <- mapM (\(_,x) -> addNontProd True (ntedge, x)) ndis -- List of new states (production edges + dependency graphs) --- nndis' :: [([Edge], NontDependencyInformation)] +-- nndis' :: [([[Edge]], NontDependencyInformation)] nndis' <- zipWithM (\(_,ndi) me -> return (maybe [] id me, ndi)) ndis ndis'' if any isJust ndis'' -- We have added some edges, so continue the process @@ -340,12 +389,12 @@ -- | Add pending edges from the production graphs to the nonterminal graph, return Nothing if none were added -- otherwise, return the list of newly added nonterminal edges -addProdNont :: ([Edge], NontDependencyInformationM s) -> ST s (Maybe [Edge]) +addProdNont :: ([[Edge]], NontDependencyInformationM s) -> ST s (Maybe [Edge]) addProdNont (pending, ndi) = do -- Unwrapping of the records let nontDepGraph = ndimDepGraph ndi let nontGraph = ndgmDepGraph nontDepGraph -- nub the list because multiple productions can result in the same new edges - let possa = nub $ do (v1,v2) <- pending + let possa = nub $ do (v1,v2) <- concat pending -- Take only edges from syn.lhs to inh.lhs guard $ isVertexAttr v1 guard $ getAttrChildName v1 == _LHS @@ -369,13 +418,13 @@ -- | Add edges from the nonterminal graphs to the production graphs, return Nothing if none were added -- otherwise, return the list of newly added production edges and the updated graph -addNontProd :: Bool -> ([Edge], NontDependencyInformationM s) -> ST s (Maybe [Edge]) +addNontProd :: Bool -> ([Edge], NontDependencyInformationM s) -> ST s (Maybe [[Edge]]) addNontProd trc (pending, ndi) = do -- Call the helper function for each nonterminal prods' <- mapM (addNontProd' trc pending) (ndimProds ndi) -- Check if any edges were added if any isJust prods' then -- Return list of newly created edges - return $ Just $ concatMap (maybe [] id) prods' + return $ Just $ map (maybe [] id) prods' else return Nothing -- | Helper function for |addNontProd| for a single production @@ -409,13 +458,12 @@ return $ Just ret -- | Add the "back edges" to the nonterminal graphs for creating a global ordering -addBackEdges :: [NontDependencyInformationM s] -> ST s () -addBackEdges ndis = do -- gather all back edges - lBackEdges <- forM ndis $ \ndi -> do +addBackEdges :: [([[Edge]], NontDependencyInformationM s)] -> ST s [Edge] +addBackEdges ndis = do -- gather all backedges + lBackEdges <- forM ndis $ \(aedg,ndi) -> do -- For every production - bs <- forM (ndimProds ndi) $ \prod -> do - -- Go through all edges - edg <- graphEdges . pdgmDepGraph $ prod + bs <- forM (zip aedg (ndimProds ndi)) $ \(edg,prod) -> do + -- Filter out the backedges return $ do (v1,v2) <- edg -- Backedges are from inh.ch to syn.ch guard $ isVertexAttr v1 @@ -433,13 +481,39 @@ let nv1 = setAttrChildName v1 chtp let nv2 = setAttrChildName v2 chtp return (nv1, nv2) - return $ concat bs + return $ foldl' union [] bs -- Concatenate all lists of backedges - let backedges = concat lBackEdges - -- Now add backedges to every nonterminal graph - forM_ ndis $ \ndi -> do + let backedges = foldl' union [] lBackEdges + -- Add backedges to every nonterminal graph + ret <- forM ndis $ \(_,ndi) -> do -- Find the backedges for this nonterminal let nont = ndiNonterminal . ndimOrig $ ndi let thisbe = filter ((==) nont . getAttrChildName . fst) backedges -- Add them to the graph graphInsertEdgesTRC (ndgmDepGraph . ndimDepGraph $ ndi) thisbe + return $ backedges ++ concat ret + + +-- | Add all resulting edges from a topsort on the nonterminal graph to the production graph +-- this will ignore edges that will make the graph cyclic +addTopSortEdges :: [Edge] -> ProdDependencyGraphM s -> ST s () +addTopSortEdges pend pdg = do -- Unwrapping of the records + prodGraph <- return $ pdgmDepGraph pdg + -- Construct all possible new edges + let possa = do (v1,v2) <- pend + -- Take a child of this nonterminal type + guard $ isVertexAttr v1 + guard $ isVertexAttr v2 + let tp = getAttrChildName v1 + (ch,chtp) <- pdgChildMap $ pdgmOrig pdg + guard $ tp == chtp + -- Construct edge as it should be in the production graph + let nv1 = setAttrChildName v1 ch + let nv2 = setAttrChildName v2 ch + return (nv1, nv2) + -- Edges that are not in the production graph yet + forM_ possa $ \(v1,v2) -> do e1 <- graphContainsEdge prodGraph (v1,v2) + e2 <- graphContainsEdge prodGraph (v2,v1) + when (not $ e1 || e2) $ do + graphInsertTRC prodGraph (v1,v2) + return () diff --git a/src/Version.hs b/src/Version.hs --- a/src/Version.hs +++ b/src/Version.hs @@ -1,4 +1,4 @@ module Version where banner :: String -banner = "Attribute Grammar compiler / HUT project. Version 0.9.38.5" +banner = "Attribute Grammar compiler / HUT project. Version 0.9.38.6" diff --git a/uuagc.cabal b/uuagc.cabal --- a/uuagc.cabal +++ b/uuagc.cabal @@ -1,7 +1,7 @@ cabal-version: >=1.2 build-type: Simple name: uuagc -version: 0.9.38.5 +version: 0.9.38.6 license: GPL license-file: LICENSE maintainer: Arie Middelkoop @@ -80,6 +80,8 @@ , Knuth1 , KennedyWarren , KWOrder + , ExecutionPlan + , ExecutionPlan2Hs extensions: TypeSynonymInstances, MultiParamTypeClasses hs-source-dirs: src, src-derived diff --git a/uuagc.cabal-for-ghc-6.6 b/uuagc.cabal-for-ghc-6.6 --- a/uuagc.cabal-for-ghc-6.6 +++ b/uuagc.cabal-for-ghc-6.6 @@ -1,5 +1,5 @@ name: uuagc -version: 0.9.38.5 +version: 0.9.38.6 license: GPL license-file: LICENSE maintainer: Arie Middelkoop