-- UUAGC 0.9.5 (InterfacesRules.lag) module InterfacesRules where import Interfaces import SequentialTypes import CodeSyntax import GrammarInfo import UU.DData.Seq as Seq import qualified Data.Map as Map import Data.Map(Map) import qualified Data.Set as Set import Data.Set(Set) import Data.Tree(Tree(Node)) import Data.Graph(Graph, dfs, edges, buildG, transposeG) import Data.Maybe (fromJust) import Data.List (partition,transpose,(\\),nub,intersect) import Data.Array ((!),inRange,bounds,assocs) import Debug.Trace(trace) import CommonTypes import SequentialTypes type VisitSS = [Vertex] gather :: Info -> [Vertex] -> [[Vertex]] gather info = eqClasses comp where comp a b = isEqualField (ruleTable info ! a) (ruleTable info ! b) -- Only non-empty syn will ever be forced, because visits with empty syn are never performed -- Right hand side synthesized attributes always have a field cv :: (Vertex -> CRule) -> Int -> Vertex -> ([Vertex],[Vertex]) -> (Vertex,ChildVisit) cv look n v (inh,syn) = let fld = getField (look (head syn)) rnt = fromJust (getRhsNt (look (head syn))) d = ChildVisit fld rnt n inh syn in (v,d) ed v (inh,syn) = map (\i -> (i,v)) inh ++ map (\s -> (v,s)) syn postorder (Node a ts) = postorderF ts ++ [a] postorderF = concatMap postorder postOrd g = postorderF . dfs g topSort' g = postOrd g type IntraVisit = [Vertex] swap (a,b) = (b,a) ccv :: Name -> Nonterminal -> Int -> CInterfaceMap -> CRule ccv name nt n table = CChildVisit name nt n inh syn last where CInterface segs = Map.findWithDefault (error ("InterfacesRules::ccv::interfaces not in table for nt: " ++ show nt)) nt table (seg:remain) = drop n segs CSegment inh syn = seg last = null remain -- IRoot ------------------------------------------------------- {- visit 0: inherited attributes: dpr : [Edge] info : Info tdp : Graph synthesized attributes: edp : [Edge] inters : CInterfaceMap visits : CVisitsMap alternatives: alternative IRoot: child inters : Interfaces visit 0: local newedges : _ local visitssGraph : _ local descr : _ -} -- cata sem_IRoot :: IRoot -> T_IRoot sem_IRoot (IRoot _inters ) = (sem_IRoot_IRoot (sem_Interfaces _inters ) ) -- semantic domain newtype T_IRoot = T_IRoot (([Edge]) -> Info -> Graph -> ( ([Edge]),CInterfaceMap,CVisitsMap)) data Inh_IRoot = Inh_IRoot {dpr_Inh_IRoot :: [Edge],info_Inh_IRoot :: Info,tdp_Inh_IRoot :: Graph} data Syn_IRoot = Syn_IRoot {edp_Syn_IRoot :: [Edge],inters_Syn_IRoot :: CInterfaceMap,visits_Syn_IRoot :: CVisitsMap} wrap_IRoot (T_IRoot sem ) (Inh_IRoot _lhsIdpr _lhsIinfo _lhsItdp ) = (let ( _lhsOedp,_lhsOinters,_lhsOvisits) = (sem _lhsIdpr _lhsIinfo _lhsItdp ) in (Syn_IRoot _lhsOedp _lhsOinters _lhsOvisits )) sem_IRoot_IRoot :: T_Interfaces -> T_IRoot sem_IRoot_IRoot (T_Interfaces inters_ ) = (T_IRoot (\ _lhsIdpr _lhsIinfo _lhsItdp -> (let _intersOv :: Vertex _intersOvisitDescr :: (Map Vertex ChildVisit) _intersOvssGraph :: Graph _intersOprev :: ([Vertex]) _intersOddp :: Graph _intersOallInters :: CInterfaceMap _lhsOedp :: ([Edge]) _lhsOinters :: CInterfaceMap _lhsOvisits :: CVisitsMap _intersOinfo :: Info _intersIdescr :: (Seq (Vertex,ChildVisit)) _intersIedp :: (Seq Edge) _intersIfirstvisitvertices :: ([Vertex]) _intersIinters :: CInterfaceMap _intersInewedges :: (Seq Edge ) _intersIv :: Vertex _intersIvisits :: CVisitsMap -- "InterfacesRules.lag"(line 64, column 12) _newedges = Seq.toList _intersInewedges -- "InterfacesRules.lag"(line 65, column 12) _visitssGraph = let graph = buildG (0,_intersIv-1) es es = _newedges ++ edges _lhsItdp in transposeG graph -- "InterfacesRules.lag"(line 78, column 12) _intersOv = snd (bounds _lhsItdp) + 1 -- "InterfacesRules.lag"(line 115, column 13) _intersOvisitDescr = Map.fromList _descr -- "InterfacesRules.lag"(line 135, column 12) _descr = Seq.toList _intersIdescr -- "InterfacesRules.lag"(line 204, column 12) _intersOvssGraph = _visitssGraph -- "InterfacesRules.lag"(line 246, column 12) _intersOprev = let terminals = [ v | (v,cr) <- assocs (ruleTable _lhsIinfo), not (getHasCode cr), isLocal cr ] in _intersIfirstvisitvertices ++ terminals -- "InterfacesRules.lag"(line 325, column 12) _intersOddp = buildG (0,_intersIv-1) (map swap (_lhsIdpr ++ _newedges)) -- "InterfacesRules.lag"(line 362, column 13) _intersOallInters = _intersIinters -- "InterfacesRules.lag"(line 422, column 13) _lhsOedp = Seq.toList _intersIedp -- copy rule (up) _lhsOinters = _intersIinters -- copy rule (up) _lhsOvisits = _intersIvisits -- copy rule (down) _intersOinfo = _lhsIinfo ( _intersIdescr,_intersIedp,_intersIfirstvisitvertices,_intersIinters,_intersInewedges,_intersIv,_intersIvisits) = (inters_ _intersOallInters _intersOddp _intersOinfo _intersOprev _intersOv _intersOvisitDescr _intersOvssGraph ) in ( _lhsOedp,_lhsOinters,_lhsOvisits))) ) -- Interface --------------------------------------------------- {- visit 0: inherited attributes: allInters : CInterfaceMap ddp : Graph info : Info prev : [Vertex] visitDescr : Map Vertex ChildVisit vssGraph : Graph chained attribute: v : Vertex synthesized attributes: descr : Seq (Vertex,ChildVisit) edp : Seq Edge firstvisitvertices : [Vertex] inter : CInterface newedges : Seq Edge nt : Nonterminal visits : Map Constructor CVisits alternatives: alternative Interface: child nt : {Nonterminal} child cons : {[Constructor]} child seg : Segments visit 0: local v : _ local firstvisitvertices : _ local newedges : _ local look : _ local descr : _ -} -- cata sem_Interface :: Interface -> T_Interface sem_Interface (Interface _nt _cons _seg ) = (sem_Interface_Interface _nt _cons (sem_Segments _seg ) ) -- semantic domain newtype T_Interface = T_Interface (CInterfaceMap -> Graph -> Info -> ([Vertex]) -> Vertex -> (Map Vertex ChildVisit) -> Graph -> ( (Seq (Vertex,ChildVisit)),(Seq Edge),([Vertex]),CInterface,(Seq Edge ),Nonterminal,Vertex,(Map Constructor CVisits))) data Inh_Interface = Inh_Interface {allInters_Inh_Interface :: CInterfaceMap,ddp_Inh_Interface :: Graph,info_Inh_Interface :: Info,prev_Inh_Interface :: [Vertex],v_Inh_Interface :: Vertex,visitDescr_Inh_Interface :: Map Vertex ChildVisit,vssGraph_Inh_Interface :: Graph} data Syn_Interface = Syn_Interface {descr_Syn_Interface :: Seq (Vertex,ChildVisit),edp_Syn_Interface :: Seq Edge,firstvisitvertices_Syn_Interface :: [Vertex],inter_Syn_Interface :: CInterface,newedges_Syn_Interface :: Seq Edge ,nt_Syn_Interface :: Nonterminal,v_Syn_Interface :: Vertex,visits_Syn_Interface :: Map Constructor CVisits} wrap_Interface (T_Interface sem ) (Inh_Interface _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = (let ( _lhsOdescr,_lhsOedp,_lhsOfirstvisitvertices,_lhsOinter,_lhsOnewedges,_lhsOnt,_lhsOv,_lhsOvisits) = (sem _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) in (Syn_Interface _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinter _lhsOnewedges _lhsOnt _lhsOv _lhsOvisits )) sem_Interface_Interface :: Nonterminal -> ([Constructor]) -> T_Segments -> T_Interface sem_Interface_Interface nt_ cons_ (T_Segments seg_ ) = (T_Interface (\ _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph -> (let _segOv :: Vertex _lhsOv :: Vertex _lhsOnewedges :: (Seq Edge ) _lhsOdescr :: (Seq (Vertex,ChildVisit)) _segOn :: Int _segOcons :: ([Constructor]) _segOisFirst :: Bool _segOfromLhs :: ([Vertex]) _lhsOnt :: Nonterminal _lhsOinter :: CInterface _lhsOvisits :: (Map Constructor CVisits) _lhsOedp :: (Seq Edge) _lhsOfirstvisitvertices :: ([Vertex]) _segOallInters :: CInterfaceMap _segOddp :: Graph _segOinfo :: Info _segOprev :: ([Vertex]) _segOvisitDescr :: (Map Vertex ChildVisit) _segOvssGraph :: Graph _segIcvisits :: ([[CVisit]]) _segIdescr :: (Seq (Vertex,ChildVisit)) _segIedp :: (Seq Edge) _segIfirstInh :: ([Vertex]) _segIgroups :: ([([Vertex],[Vertex])]) _segIhdIntravisits :: ([IntraVisit]) _segInewedges :: (Seq Edge ) _segInewvertices :: ([Vertex]) _segIprev :: ([Vertex]) _segIsegs :: CSegments _segIv :: Vertex -- "InterfacesRules.lag"(line 175, column 17) _segOv = _lhsIv -- "InterfacesRules.lag"(line 176, column 17) _v = _segIv + length _segInewvertices -- "InterfacesRules.lag"(line 177, column 17) _lhsOv = _v -- "InterfacesRules.lag"(line 178, column 17) _firstvisitvertices = [_segIv .. _v-1] -- "InterfacesRules.lag"(line 179, column 17) _newedges = zip _firstvisitvertices _segInewvertices -- "InterfacesRules.lag"(line 180, column 17) _lhsOnewedges = _segInewedges Seq.<> Seq.fromList _newedges -- "InterfacesRules.lag"(line 181, column 17) _look = \a -> ruleTable _lhsIinfo ! a -- "InterfacesRules.lag"(line 182, column 17) _descr = zipWith (cv _look (-1)) _firstvisitvertices _segIgroups -- "InterfacesRules.lag"(line 183, column 17) _lhsOdescr = _segIdescr Seq.<> Seq.fromList _descr -- "InterfacesRules.lag"(line 191, column 16) _segOn = 0 -- "InterfacesRules.lag"(line 223, column 16) _segOcons = cons_ -- "InterfacesRules.lag"(line 296, column 16) _segOisFirst = True -- "InterfacesRules.lag"(line 333, column 16) _segOfromLhs = _lhsIprev -- "InterfacesRules.lag"(line 373, column 16) _lhsOnt = nt_ -- "InterfacesRules.lag"(line 377, column 17) _lhsOinter = CInterface _segIsegs -- "InterfacesRules.lag"(line 378, column 17) _lhsOvisits = Map.fromList (zip cons_ (transpose _segIcvisits)) -- use rule "InterfacesRules.lag"(line 417, column 54) _lhsOedp = _segIedp -- use rule "InterfacesRules.lag"(line 244, column 70) _lhsOfirstvisitvertices = _firstvisitvertices -- copy rule (down) _segOallInters = _lhsIallInters -- copy rule (down) _segOddp = _lhsIddp -- copy rule (down) _segOinfo = _lhsIinfo -- copy rule (down) _segOprev = _lhsIprev -- copy rule (down) _segOvisitDescr = _lhsIvisitDescr -- copy rule (down) _segOvssGraph = _lhsIvssGraph ( _segIcvisits,_segIdescr,_segIedp,_segIfirstInh,_segIgroups,_segIhdIntravisits,_segInewedges,_segInewvertices,_segIprev,_segIsegs,_segIv) = (seg_ _segOallInters _segOcons _segOddp _segOfromLhs _segOinfo _segOisFirst _segOn _segOprev _segOv _segOvisitDescr _segOvssGraph ) in ( _lhsOdescr,_lhsOedp,_lhsOfirstvisitvertices,_lhsOinter,_lhsOnewedges,_lhsOnt,_lhsOv,_lhsOvisits))) ) -- Interfaces -------------------------------------------------- {- visit 0: inherited attributes: allInters : CInterfaceMap ddp : Graph info : Info prev : [Vertex] visitDescr : Map Vertex ChildVisit vssGraph : Graph chained attribute: v : Vertex synthesized attributes: descr : Seq (Vertex,ChildVisit) edp : Seq Edge firstvisitvertices : [Vertex] inters : CInterfaceMap newedges : Seq Edge visits : CVisitsMap alternatives: alternative Cons: child hd : Interface child tl : Interfaces alternative Nil: -} -- cata sem_Interfaces :: Interfaces -> T_Interfaces sem_Interfaces list = (Prelude.foldr sem_Interfaces_Cons sem_Interfaces_Nil (Prelude.map sem_Interface list) ) -- semantic domain newtype T_Interfaces = T_Interfaces (CInterfaceMap -> Graph -> Info -> ([Vertex]) -> Vertex -> (Map Vertex ChildVisit) -> Graph -> ( (Seq (Vertex,ChildVisit)),(Seq Edge),([Vertex]),CInterfaceMap,(Seq Edge ),Vertex,CVisitsMap)) data Inh_Interfaces = Inh_Interfaces {allInters_Inh_Interfaces :: CInterfaceMap,ddp_Inh_Interfaces :: Graph,info_Inh_Interfaces :: Info,prev_Inh_Interfaces :: [Vertex],v_Inh_Interfaces :: Vertex,visitDescr_Inh_Interfaces :: Map Vertex ChildVisit,vssGraph_Inh_Interfaces :: Graph} data Syn_Interfaces = Syn_Interfaces {descr_Syn_Interfaces :: Seq (Vertex,ChildVisit),edp_Syn_Interfaces :: Seq Edge,firstvisitvertices_Syn_Interfaces :: [Vertex],inters_Syn_Interfaces :: CInterfaceMap,newedges_Syn_Interfaces :: Seq Edge ,v_Syn_Interfaces :: Vertex,visits_Syn_Interfaces :: CVisitsMap} wrap_Interfaces (T_Interfaces sem ) (Inh_Interfaces _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = (let ( _lhsOdescr,_lhsOedp,_lhsOfirstvisitvertices,_lhsOinters,_lhsOnewedges,_lhsOv,_lhsOvisits) = (sem _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) in (Syn_Interfaces _lhsOdescr _lhsOedp _lhsOfirstvisitvertices _lhsOinters _lhsOnewedges _lhsOv _lhsOvisits )) sem_Interfaces_Cons :: T_Interface -> T_Interfaces -> T_Interfaces sem_Interfaces_Cons (T_Interface hd_ ) (T_Interfaces tl_ ) = (T_Interfaces (\ _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph -> (let _lhsOinters :: CInterfaceMap _lhsOvisits :: CVisitsMap _lhsOdescr :: (Seq (Vertex,ChildVisit)) _lhsOedp :: (Seq Edge) _lhsOfirstvisitvertices :: ([Vertex]) _lhsOnewedges :: (Seq Edge ) _lhsOv :: Vertex _hdOallInters :: CInterfaceMap _hdOddp :: Graph _hdOinfo :: Info _hdOprev :: ([Vertex]) _hdOv :: Vertex _hdOvisitDescr :: (Map Vertex ChildVisit) _hdOvssGraph :: Graph _tlOallInters :: CInterfaceMap _tlOddp :: Graph _tlOinfo :: Info _tlOprev :: ([Vertex]) _tlOv :: Vertex _tlOvisitDescr :: (Map Vertex ChildVisit) _tlOvssGraph :: Graph _hdIdescr :: (Seq (Vertex,ChildVisit)) _hdIedp :: (Seq Edge) _hdIfirstvisitvertices :: ([Vertex]) _hdIinter :: CInterface _hdInewedges :: (Seq Edge ) _hdInt :: Nonterminal _hdIv :: Vertex _hdIvisits :: (Map Constructor CVisits) _tlIdescr :: (Seq (Vertex,ChildVisit)) _tlIedp :: (Seq Edge) _tlIfirstvisitvertices :: ([Vertex]) _tlIinters :: CInterfaceMap _tlInewedges :: (Seq Edge ) _tlIv :: Vertex _tlIvisits :: CVisitsMap -- "InterfacesRules.lag"(line 367, column 12) _lhsOinters = Map.insert _hdInt _hdIinter _tlIinters -- "InterfacesRules.lag"(line 368, column 12) _lhsOvisits = Map.insert _hdInt _hdIvisits _tlIvisits -- use rule "InterfacesRules.lag"(line 118, column 20) _lhsOdescr = _hdIdescr Seq.<> _tlIdescr -- use rule "InterfacesRules.lag"(line 417, column 54) _lhsOedp = _hdIedp Seq.<> _tlIedp -- use rule "InterfacesRules.lag"(line 244, column 70) _lhsOfirstvisitvertices = _hdIfirstvisitvertices ++ _tlIfirstvisitvertices -- use rule "InterfacesRules.lag"(line 117, column 23) _lhsOnewedges = _hdInewedges Seq.<> _tlInewedges -- copy rule (up) _lhsOv = _tlIv -- copy rule (down) _hdOallInters = _lhsIallInters -- copy rule (down) _hdOddp = _lhsIddp -- copy rule (down) _hdOinfo = _lhsIinfo -- copy rule (down) _hdOprev = _lhsIprev -- copy rule (down) _hdOv = _lhsIv -- copy rule (down) _hdOvisitDescr = _lhsIvisitDescr -- copy rule (down) _hdOvssGraph = _lhsIvssGraph -- copy rule (down) _tlOallInters = _lhsIallInters -- copy rule (down) _tlOddp = _lhsIddp -- copy rule (down) _tlOinfo = _lhsIinfo -- copy rule (down) _tlOprev = _lhsIprev -- copy rule (chain) _tlOv = _hdIv -- copy rule (down) _tlOvisitDescr = _lhsIvisitDescr -- copy rule (down) _tlOvssGraph = _lhsIvssGraph ( _hdIdescr,_hdIedp,_hdIfirstvisitvertices,_hdIinter,_hdInewedges,_hdInt,_hdIv,_hdIvisits) = (hd_ _hdOallInters _hdOddp _hdOinfo _hdOprev _hdOv _hdOvisitDescr _hdOvssGraph ) ( _tlIdescr,_tlIedp,_tlIfirstvisitvertices,_tlIinters,_tlInewedges,_tlIv,_tlIvisits) = (tl_ _tlOallInters _tlOddp _tlOinfo _tlOprev _tlOv _tlOvisitDescr _tlOvssGraph ) in ( _lhsOdescr,_lhsOedp,_lhsOfirstvisitvertices,_lhsOinters,_lhsOnewedges,_lhsOv,_lhsOvisits))) ) sem_Interfaces_Nil :: T_Interfaces sem_Interfaces_Nil = (T_Interfaces (\ _lhsIallInters _lhsIddp _lhsIinfo _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph -> (let _lhsOinters :: CInterfaceMap _lhsOvisits :: CVisitsMap _lhsOdescr :: (Seq (Vertex,ChildVisit)) _lhsOedp :: (Seq Edge) _lhsOfirstvisitvertices :: ([Vertex]) _lhsOnewedges :: (Seq Edge ) _lhsOv :: Vertex -- "InterfacesRules.lag"(line 369, column 12) _lhsOinters = Map.empty -- "InterfacesRules.lag"(line 370, column 12) _lhsOvisits = Map.empty -- use rule "InterfacesRules.lag"(line 118, column 20) _lhsOdescr = Seq.empty -- use rule "InterfacesRules.lag"(line 417, column 54) _lhsOedp = Seq.empty -- use rule "InterfacesRules.lag"(line 244, column 70) _lhsOfirstvisitvertices = [] -- use rule "InterfacesRules.lag"(line 117, column 23) _lhsOnewedges = Seq.empty -- copy rule (chain) _lhsOv = _lhsIv in ( _lhsOdescr,_lhsOedp,_lhsOfirstvisitvertices,_lhsOinters,_lhsOnewedges,_lhsOv,_lhsOvisits))) ) -- Segment ----------------------------------------------------- {- visit 0: inherited attributes: allInters : CInterfaceMap cons : [Constructor] ddp : Graph fromLhs : [Vertex] info : Info isFirst : Bool n : Int nextInh : [Vertex] nextIntravisits : [IntraVisit] nextNewvertices : [Vertex] visitDescr : Map Vertex ChildVisit vssGraph : Graph chained attributes: prev : [Vertex] v : Vertex synthesized attributes: cvisits : [CVisit] descr : Seq (Vertex,ChildVisit) edp : Seq Edge groups : [([Vertex],[Vertex])] inh : [Vertex] intravisits : [IntraVisit] newedges : Seq Edge newvertices : [Vertex] seg : CSegment visitss : [VisitSS] alternatives: alternative Segment: child inh : {[Vertex]} child syn : {[Vertex]} visit 0: local look : _ local occurAs : _ local groups : _ local v : _ local newvertices : _ local attredges : _ local visitedges : _ local synOccur : _ local vss : _ local visitss' : _ local defined : _ local visitss : _ local fromLhs : _ local computed : _ local intravisits : _ local iv : _ local _tup1 : _ local inhmap : _ local synmap : _ -} -- cata sem_Segment :: Segment -> T_Segment sem_Segment (Segment _inh _syn ) = (sem_Segment_Segment _inh _syn ) -- semantic domain newtype T_Segment = T_Segment (CInterfaceMap -> ([Constructor]) -> Graph -> ([Vertex]) -> Info -> Bool -> Int -> ([Vertex]) -> ([IntraVisit]) -> ([Vertex]) -> ([Vertex]) -> Vertex -> (Map Vertex ChildVisit) -> Graph -> ( ([CVisit]),(Seq (Vertex,ChildVisit)),(Seq Edge),([([Vertex],[Vertex])]),([Vertex]),([IntraVisit]),(Seq Edge ),([Vertex]),([Vertex]),CSegment,Vertex,([VisitSS]))) data Inh_Segment = Inh_Segment {allInters_Inh_Segment :: CInterfaceMap,cons_Inh_Segment :: [Constructor],ddp_Inh_Segment :: Graph,fromLhs_Inh_Segment :: [Vertex],info_Inh_Segment :: Info,isFirst_Inh_Segment :: Bool,n_Inh_Segment :: Int,nextInh_Inh_Segment :: [Vertex],nextIntravisits_Inh_Segment :: [IntraVisit],nextNewvertices_Inh_Segment :: [Vertex],prev_Inh_Segment :: [Vertex],v_Inh_Segment :: Vertex,visitDescr_Inh_Segment :: Map Vertex ChildVisit,vssGraph_Inh_Segment :: Graph} data Syn_Segment = Syn_Segment {cvisits_Syn_Segment :: [CVisit],descr_Syn_Segment :: Seq (Vertex,ChildVisit),edp_Syn_Segment :: Seq Edge,groups_Syn_Segment :: [([Vertex],[Vertex])],inh_Syn_Segment :: [Vertex],intravisits_Syn_Segment :: [IntraVisit],newedges_Syn_Segment :: Seq Edge ,newvertices_Syn_Segment :: [Vertex],prev_Syn_Segment :: [Vertex],seg_Syn_Segment :: CSegment,v_Syn_Segment :: Vertex,visitss_Syn_Segment :: [VisitSS]} wrap_Segment (T_Segment sem ) (Inh_Segment _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsInextInh _lhsInextIntravisits _lhsInextNewvertices _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = (let ( _lhsOcvisits,_lhsOdescr,_lhsOedp,_lhsOgroups,_lhsOinh,_lhsOintravisits,_lhsOnewedges,_lhsOnewvertices,_lhsOprev,_lhsOseg,_lhsOv,_lhsOvisitss) = (sem _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsInextInh _lhsInextIntravisits _lhsInextNewvertices _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) in (Syn_Segment _lhsOcvisits _lhsOdescr _lhsOedp _lhsOgroups _lhsOinh _lhsOintravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOseg _lhsOv _lhsOvisitss )) sem_Segment_Segment :: ([Vertex]) -> ([Vertex]) -> T_Segment sem_Segment_Segment inh_ syn_ = (T_Segment (\ _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsInextInh _lhsInextIntravisits _lhsInextNewvertices _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph -> (let _lhsOdescr :: (Seq (Vertex,ChildVisit)) _lhsOnewedges :: (Seq Edge ) _lhsOprev :: ([Vertex]) _lhsOseg :: CSegment _lhsOcvisits :: ([CVisit]) _lhsOedp :: (Seq Edge) _lhsOinh :: ([Vertex]) _lhsOgroups :: ([([Vertex],[Vertex])]) _lhsOintravisits :: ([IntraVisit]) _lhsOnewvertices :: ([Vertex]) _lhsOv :: Vertex _lhsOvisitss :: ([VisitSS]) -- "InterfacesRules.lag"(line 98, column 15) _look = \a -> ruleTable _lhsIinfo ! a -- "InterfacesRules.lag"(line 99, column 15) _occurAs = \p us -> [ a | u <- us , a <- tdsToTdp _lhsIinfo ! u , p (_look a)] -- "InterfacesRules.lag"(line 102, column 15) _groups = let group as = gather _lhsIinfo (_occurAs isRhs as) in map (partition (isInh . _look)) (group (inh_ ++ syn_)) -- "InterfacesRules.lag"(line 104, column 15) _v = _lhsIv + length _groups -- "InterfacesRules.lag"(line 105, column 15) _newvertices = [_lhsIv .. _v -1] -- "InterfacesRules.lag"(line 120, column 14) _lhsOdescr = Seq.fromList $ zipWith (cv _look _lhsIn) _newvertices _groups -- "InterfacesRules.lag"(line 143, column 14) _attredges = concat (zipWith ed _newvertices _groups) -- "InterfacesRules.lag"(line 162, column 15) _visitedges = zip _newvertices _lhsInextNewvertices -- "InterfacesRules.lag"(line 163, column 15) _lhsOnewedges = Seq.fromList _attredges Seq.<> Seq.fromList _visitedges -- "InterfacesRules.lag"(line 215, column 15) _synOccur = gather _lhsIinfo (_occurAs isLhs syn_) -- "InterfacesRules.lag"(line 216, column 15) _vss = let hasCode v | inRange (bounds (ruleTable _lhsIinfo)) v = getHasCode (ruleTable _lhsIinfo ! v) | otherwise = True in if null syn_ then replicate (length _lhsIcons) [] else map (filter hasCode . topSort' _lhsIvssGraph) _synOccur -- "InterfacesRules.lag"(line 256, column 15) _visitss' = map (\\ _lhsIprev) _vss -- "InterfacesRules.lag"(line 257, column 15) _defined = let defines v = case Map.lookup v _lhsIvisitDescr of Nothing -> [v] Just (ChildVisit _ _ _ inh _) -> v:inh in concatMap (concatMap defines) _visitss -- "InterfacesRules.lag"(line 261, column 15) _lhsOprev = _lhsIprev ++ _defined -- "InterfacesRules.lag"(line 269, column 15) _visitss = let rem :: [(Name,Name,Maybe Type)] -> [Vertex] -> [Vertex] rem prev [] = [] rem prev (v:vs) | inRange (bounds table) v = let cr = table ! v addV = if (getField cr,getAttr cr,getType cr) `elem` prev then id else (v:) def = Map.elems (getDefines cr) in addV (rem (def ++ prev) vs) | otherwise = v:rem prev vs table = ruleTable _lhsIinfo in map (rem []) _visitss' -- "InterfacesRules.lag"(line 338, column 15) _fromLhs = _occurAs isLhs inh_ ++ _lhsIfromLhs -- "InterfacesRules.lag"(line 339, column 15) _computed = let computes v = case Map.lookup v _lhsIvisitDescr of Nothing -> Map.keys (getDefines (ruleTable _lhsIinfo ! v)) Just (ChildVisit _ _ _ _ syn) -> v:syn in concatMap (concatMap computes) _visitss -- "InterfacesRules.lag"(line 343, column 15) _intravisits = zipWith _iv _visitss _lhsInextIntravisits -- "InterfacesRules.lag"(line 344, column 15) _iv = \vs next -> let needed = concatMap (_lhsIddp !) vs in nub (needed ++ next) \\ (_fromLhs ++ _computed) -- "InterfacesRules.lag"(line 387, column 15) _lhsOseg = if False then undefined _lhsIvssGraph _lhsIvisitDescr _lhsIprev else CSegment _inhmap _synmap -- "InterfacesRules.lag"(line 389, column 19) __tup1 = let makemap = Map.fromList . map findType findType v = getNtaNameType (attrTable _lhsIinfo ! v) in (makemap inh_,makemap syn_) -- "InterfacesRules.lag"(line 389, column 19) (_inhmap,_) = __tup1 -- "InterfacesRules.lag"(line 389, column 19) (_,_synmap) = __tup1 -- "InterfacesRules.lag"(line 392, column 15) _lhsOcvisits = let mkVisit vss intra = CVisit _inhmap _synmap (mkSequence vss) (mkSequence intra) True mkSequence = map mkRule mkRule v = case Map.lookup v _lhsIvisitDescr of Nothing -> ruleTable _lhsIinfo ! v Just (ChildVisit name nt n _ _) -> ccv name nt n _lhsIallInters in zipWith mkVisit _visitss _intravisits -- "InterfacesRules.lag"(line 419, column 14) _lhsOedp = Seq.fromList [(i,s) | i <- inh_, s <- syn_] Seq.<> Seq.fromList [(s,i) | s <- syn_, i <- _lhsInextInh ] -- "InterfacesRules.lag"(line 424, column 14) _lhsOinh = inh_ -- copy rule (from local) _lhsOgroups = _groups -- copy rule (from local) _lhsOintravisits = _intravisits -- copy rule (from local) _lhsOnewvertices = _newvertices -- copy rule (from local) _lhsOv = _v -- copy rule (from local) _lhsOvisitss = _visitss in ( _lhsOcvisits,_lhsOdescr,_lhsOedp,_lhsOgroups,_lhsOinh,_lhsOintravisits,_lhsOnewedges,_lhsOnewvertices,_lhsOprev,_lhsOseg,_lhsOv,_lhsOvisitss))) ) -- Segments ---------------------------------------------------- {- visit 0: inherited attributes: allInters : CInterfaceMap cons : [Constructor] ddp : Graph fromLhs : [Vertex] info : Info isFirst : Bool n : Int visitDescr : Map Vertex ChildVisit vssGraph : Graph chained attributes: prev : [Vertex] v : Vertex synthesized attributes: cvisits : [[CVisit]] descr : Seq (Vertex,ChildVisit) edp : Seq Edge firstInh : [Vertex] groups : [([Vertex],[Vertex])] hdIntravisits : [IntraVisit] newedges : Seq Edge newvertices : [Vertex] segs : CSegments alternatives: alternative Cons: child hd : Segment child tl : Segments alternative Nil: -} -- cata sem_Segments :: Segments -> T_Segments sem_Segments list = (Prelude.foldr sem_Segments_Cons sem_Segments_Nil (Prelude.map sem_Segment list) ) -- semantic domain newtype T_Segments = T_Segments (CInterfaceMap -> ([Constructor]) -> Graph -> ([Vertex]) -> Info -> Bool -> Int -> ([Vertex]) -> Vertex -> (Map Vertex ChildVisit) -> Graph -> ( ([[CVisit]]),(Seq (Vertex,ChildVisit)),(Seq Edge),([Vertex]),([([Vertex],[Vertex])]),([IntraVisit]),(Seq Edge ),([Vertex]),([Vertex]),CSegments,Vertex)) data Inh_Segments = Inh_Segments {allInters_Inh_Segments :: CInterfaceMap,cons_Inh_Segments :: [Constructor],ddp_Inh_Segments :: Graph,fromLhs_Inh_Segments :: [Vertex],info_Inh_Segments :: Info,isFirst_Inh_Segments :: Bool,n_Inh_Segments :: Int,prev_Inh_Segments :: [Vertex],v_Inh_Segments :: Vertex,visitDescr_Inh_Segments :: Map Vertex ChildVisit,vssGraph_Inh_Segments :: Graph} data Syn_Segments = Syn_Segments {cvisits_Syn_Segments :: [[CVisit]],descr_Syn_Segments :: Seq (Vertex,ChildVisit),edp_Syn_Segments :: Seq Edge,firstInh_Syn_Segments :: [Vertex],groups_Syn_Segments :: [([Vertex],[Vertex])],hdIntravisits_Syn_Segments :: [IntraVisit],newedges_Syn_Segments :: Seq Edge ,newvertices_Syn_Segments :: [Vertex],prev_Syn_Segments :: [Vertex],segs_Syn_Segments :: CSegments,v_Syn_Segments :: Vertex} wrap_Segments (T_Segments sem ) (Inh_Segments _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) = (let ( _lhsOcvisits,_lhsOdescr,_lhsOedp,_lhsOfirstInh,_lhsOgroups,_lhsOhdIntravisits,_lhsOnewedges,_lhsOnewvertices,_lhsOprev,_lhsOsegs,_lhsOv) = (sem _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph ) in (Syn_Segments _lhsOcvisits _lhsOdescr _lhsOedp _lhsOfirstInh _lhsOgroups _lhsOhdIntravisits _lhsOnewedges _lhsOnewvertices _lhsOprev _lhsOsegs _lhsOv )) sem_Segments_Cons :: T_Segment -> T_Segments -> T_Segments sem_Segments_Cons (T_Segment hd_ ) (T_Segments tl_ ) = (T_Segments (\ _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph -> (let _hdOnextNewvertices :: ([Vertex]) _lhsOnewvertices :: ([Vertex]) _lhsOgroups :: ([([Vertex],[Vertex])]) _tlOn :: Int _tlOisFirst :: Bool _hdOnextIntravisits :: ([IntraVisit]) _lhsOhdIntravisits :: ([IntraVisit]) _hdOfromLhs :: ([Vertex]) _tlOfromLhs :: ([Vertex]) _lhsOsegs :: CSegments _hdOnextInh :: ([Vertex]) _lhsOfirstInh :: ([Vertex]) _lhsOcvisits :: ([[CVisit]]) _lhsOdescr :: (Seq (Vertex,ChildVisit)) _lhsOedp :: (Seq Edge) _lhsOnewedges :: (Seq Edge ) _lhsOprev :: ([Vertex]) _lhsOv :: Vertex _hdOallInters :: CInterfaceMap _hdOcons :: ([Constructor]) _hdOddp :: Graph _hdOinfo :: Info _hdOisFirst :: Bool _hdOn :: Int _hdOprev :: ([Vertex]) _hdOv :: Vertex _hdOvisitDescr :: (Map Vertex ChildVisit) _hdOvssGraph :: Graph _tlOallInters :: CInterfaceMap _tlOcons :: ([Constructor]) _tlOddp :: Graph _tlOinfo :: Info _tlOprev :: ([Vertex]) _tlOv :: Vertex _tlOvisitDescr :: (Map Vertex ChildVisit) _tlOvssGraph :: Graph _hdIcvisits :: ([CVisit]) _hdIdescr :: (Seq (Vertex,ChildVisit)) _hdIedp :: (Seq Edge) _hdIgroups :: ([([Vertex],[Vertex])]) _hdIinh :: ([Vertex]) _hdIintravisits :: ([IntraVisit]) _hdInewedges :: (Seq Edge ) _hdInewvertices :: ([Vertex]) _hdIprev :: ([Vertex]) _hdIseg :: CSegment _hdIv :: Vertex _hdIvisitss :: ([VisitSS]) _tlIcvisits :: ([[CVisit]]) _tlIdescr :: (Seq (Vertex,ChildVisit)) _tlIedp :: (Seq Edge) _tlIfirstInh :: ([Vertex]) _tlIgroups :: ([([Vertex],[Vertex])]) _tlIhdIntravisits :: ([IntraVisit]) _tlInewedges :: (Seq Edge ) _tlInewvertices :: ([Vertex]) _tlIprev :: ([Vertex]) _tlIsegs :: CSegments _tlIv :: Vertex -- "InterfacesRules.lag"(line 157, column 12) _hdOnextNewvertices = _tlInewvertices -- "InterfacesRules.lag"(line 158, column 12) _lhsOnewvertices = _hdInewvertices -- "InterfacesRules.lag"(line 172, column 11) _lhsOgroups = _hdIgroups -- "InterfacesRules.lag"(line 193, column 11) _tlOn = _lhsIn + 1 -- "InterfacesRules.lag"(line 298, column 11) _tlOisFirst = False -- "InterfacesRules.lag"(line 311, column 12) _hdOnextIntravisits = _tlIhdIntravisits -- "InterfacesRules.lag"(line 312, column 12) _lhsOhdIntravisits = _hdIintravisits -- "InterfacesRules.lag"(line 335, column 12) _hdOfromLhs = _lhsIfromLhs -- "InterfacesRules.lag"(line 336, column 12) _tlOfromLhs = [] -- "InterfacesRules.lag"(line 382, column 12) _lhsOsegs = _hdIseg : _tlIsegs -- "InterfacesRules.lag"(line 426, column 12) _hdOnextInh = _tlIfirstInh -- "InterfacesRules.lag"(line 427, column 12) _lhsOfirstInh = _hdIinh -- use rule "InterfacesRules.lag"(line 381, column 29) _lhsOcvisits = _hdIcvisits : _tlIcvisits -- use rule "InterfacesRules.lag"(line 118, column 20) _lhsOdescr = _hdIdescr Seq.<> _tlIdescr -- use rule "InterfacesRules.lag"(line 417, column 54) _lhsOedp = _hdIedp Seq.<> _tlIedp -- use rule "InterfacesRules.lag"(line 117, column 23) _lhsOnewedges = _hdInewedges Seq.<> _tlInewedges -- copy rule (up) _lhsOprev = _tlIprev -- copy rule (up) _lhsOv = _tlIv -- copy rule (down) _hdOallInters = _lhsIallInters -- copy rule (down) _hdOcons = _lhsIcons -- copy rule (down) _hdOddp = _lhsIddp -- copy rule (down) _hdOinfo = _lhsIinfo -- copy rule (down) _hdOisFirst = _lhsIisFirst -- copy rule (down) _hdOn = _lhsIn -- copy rule (down) _hdOprev = _lhsIprev -- copy rule (down) _hdOv = _lhsIv -- copy rule (down) _hdOvisitDescr = _lhsIvisitDescr -- copy rule (down) _hdOvssGraph = _lhsIvssGraph -- copy rule (down) _tlOallInters = _lhsIallInters -- copy rule (down) _tlOcons = _lhsIcons -- copy rule (down) _tlOddp = _lhsIddp -- copy rule (down) _tlOinfo = _lhsIinfo -- copy rule (chain) _tlOprev = _hdIprev -- copy rule (chain) _tlOv = _hdIv -- copy rule (down) _tlOvisitDescr = _lhsIvisitDescr -- copy rule (down) _tlOvssGraph = _lhsIvssGraph ( _hdIcvisits,_hdIdescr,_hdIedp,_hdIgroups,_hdIinh,_hdIintravisits,_hdInewedges,_hdInewvertices,_hdIprev,_hdIseg,_hdIv,_hdIvisitss) = (hd_ _hdOallInters _hdOcons _hdOddp _hdOfromLhs _hdOinfo _hdOisFirst _hdOn _hdOnextInh _hdOnextIntravisits _hdOnextNewvertices _hdOprev _hdOv _hdOvisitDescr _hdOvssGraph ) ( _tlIcvisits,_tlIdescr,_tlIedp,_tlIfirstInh,_tlIgroups,_tlIhdIntravisits,_tlInewedges,_tlInewvertices,_tlIprev,_tlIsegs,_tlIv) = (tl_ _tlOallInters _tlOcons _tlOddp _tlOfromLhs _tlOinfo _tlOisFirst _tlOn _tlOprev _tlOv _tlOvisitDescr _tlOvssGraph ) in ( _lhsOcvisits,_lhsOdescr,_lhsOedp,_lhsOfirstInh,_lhsOgroups,_lhsOhdIntravisits,_lhsOnewedges,_lhsOnewvertices,_lhsOprev,_lhsOsegs,_lhsOv))) ) sem_Segments_Nil :: T_Segments sem_Segments_Nil = (T_Segments (\ _lhsIallInters _lhsIcons _lhsIddp _lhsIfromLhs _lhsIinfo _lhsIisFirst _lhsIn _lhsIprev _lhsIv _lhsIvisitDescr _lhsIvssGraph -> (let _lhsOnewvertices :: ([Vertex]) _lhsOgroups :: ([([Vertex],[Vertex])]) _lhsOhdIntravisits :: ([IntraVisit]) _lhsOsegs :: CSegments _lhsOfirstInh :: ([Vertex]) _lhsOcvisits :: ([[CVisit]]) _lhsOdescr :: (Seq (Vertex,ChildVisit)) _lhsOedp :: (Seq Edge) _lhsOnewedges :: (Seq Edge ) _lhsOprev :: ([Vertex]) _lhsOv :: Vertex -- "InterfacesRules.lag"(line 159, column 12) _lhsOnewvertices = [] -- "InterfacesRules.lag"(line 173, column 11) _lhsOgroups = [] -- "InterfacesRules.lag"(line 313, column 10) _lhsOhdIntravisits = repeat [] -- "InterfacesRules.lag"(line 383, column 12) _lhsOsegs = [] -- "InterfacesRules.lag"(line 428, column 11) _lhsOfirstInh = [] -- use rule "InterfacesRules.lag"(line 381, column 29) _lhsOcvisits = [] -- use rule "InterfacesRules.lag"(line 118, column 20) _lhsOdescr = Seq.empty -- use rule "InterfacesRules.lag"(line 417, column 54) _lhsOedp = Seq.empty -- use rule "InterfacesRules.lag"(line 117, column 23) _lhsOnewedges = Seq.empty -- copy rule (chain) _lhsOprev = _lhsIprev -- copy rule (chain) _lhsOv = _lhsIv in ( _lhsOcvisits,_lhsOdescr,_lhsOedp,_lhsOfirstInh,_lhsOgroups,_lhsOhdIntravisits,_lhsOnewedges,_lhsOnewvertices,_lhsOprev,_lhsOsegs,_lhsOv))) )