uuagc-0.9.5: src-derived/InterfacesRules.hs
-- 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))) )