\begin{code} module SequentialComputation (computeSequential,Vertex,Edge,Table) where import SequentialTypes import InterfacesRules import CodeSyntax import GrammarInfo import Control.Monad(when,unless) import Control.Monad.ST(ST, runST) import Data.Array(Array,(!),bounds) import Data.Array.ST(STArray, newArray, readArray, writeArray, freeze) import Data.Maybe(isJust,fromJust) import Data.List(partition,(\\)) import qualified Data.Set as Set import qualified Data.Map as Map \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Collecting information} In the Data.Graph library, a graph is represented as |Array Vertex [Vertex]|, mapping each vertex to a list of adjacent vertices. A |Vertex| is simply encoded by an |Int|. So to test whether an edge |(x,y)| belongs to |g| we can evaluate |y elem g!x| For more efficiency, we use Maps instead of lists. Sets would also have done, but we also want to each edge to have a path as a witness. Moreover, as we will mostly be adding edges to the graph, we use a mutable array. If we want to use any of the library functions, we can convert our representation by |fmap Map.keys . freeze|. \begin{code} type Graph = Array Vertex [Vertex] type MGraph = Array Vertex (Map.Map Vertex Path) type MMGraph s = STArray s Vertex (Map.Map Vertex Path) singleStep :: (Vertex->Vertex->PathStep) -> Edge -> EdgePath singleStep f e@(s,t) = (e, [f s t]) \end{code} We can add an edge to a graph, or remove it. These functions return whether they did something (resp. addition or removal) or not. hasEdge only checks whether a graph contains an edge or not. \begin{code} addEdge :: MMGraph s -> EdgePath -> ST s Bool addEdge graph ((s,t),p) = do m <- readArray graph s let b = not (Map.member t m) when b (writeArray graph s (Map.insert t p m)) return b hasEdge :: MMGraph s -> EdgePath -> ST s Bool hasEdge graph ((s,t),_) = do m <- readArray graph s return (Map.member t m) \end{code} The first step is to assign a number to all attributes, and a different one to all attribute occurrences. We create an array mapping the numbers to the information about the attribute occurrences (|ruleTable|), so we can look up this information in $O(1)$ time. We also build mappings from attributes to their occurrences (|tdsToTdp|) and vice versa (|tdpToTds|). |LMH| indicates the division of the attributes - an element |(l,m,h) elem LMH| means that vertices |i, l <= i <= h| are attributes of the same nonterminal, with vertices |j, l <= j < m| being inherited and |k, m <= k <= h| being synthesized attributes. See the |SequentialTypes.Info| and |SequentialTypes.LMH| Then we collect the direct dependencies, using the integer representations. This list of tuples (edges in the dependency graph) all information that is collected is passed to a function that will compute the interfaces and visit sub-sequences. We cannot do this computation in AG, because mutable arrays require the ST monad, which cannot be used inside AG. Now we can build a graph for attributes, and a graph for ao's, and add the direct dependencies to the ao graph. Like Pennings we will call the attribte graph Tds (transitive dependencies of symbols), and the ao-graph Tdp (transitive dependencies of productions). Unlike him, we will have only one Tds and one Tdp graph. In |STGraph|, we can lookup outgoing edges in |O(1)| time, but looking up incoming edges will take |O(e)| time, where |e| is the number of edges in the graph. As we will be doing this quite often it is worthwhile to keep both Tdp and its transposed version. The computation will involve both Tds and Tdp. It treats specially. TODO elaborate on that. \begin{code} type Tdp s = (MMGraph s, MMGraph s) type Tds s = MMGraph s type Comp s = (Tds s, Tdp s) \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Generating IDS} As we insert edges into Tdp we keep it transitively closed, so every time we add the edge $(s,t)$ to V, we also add the edges $\{ (r,t) || (r,s) \in V \}$ and $\{ (s,u) || (t,u) \in V \}$. \begin{code} insertTdp :: Info -> Comp s -> EdgePath -> ST s () insertTdp info comp@(_,(tdpN,tdpT)) e@((s,t),ee) -- how to insert an edge (s,t): = do b <- hasEdge tdpN e -- if it's not yet present unless b (do rs <- readArray tdpT s -- find all sources r for an edge to s us <- readArray tdpN t -- find all targets u for an edge from t let edges = e :[ ((r,t),er++ee ) | (r,er) <- Map.toList rs ] ++ [ ((s,u), ee++eu) | (u,eu) <- Map.toList us ] ++ [ ((r,u),er++ee++eu) | (r,er) <- Map.toList rs, (u,eu) <- Map.toList us ] mapM_ (addTdpEdge info comp) edges -- and add all of them, without having to bother about transitive closure anymore ) \end{code} Edges in |Tdp| can induce edges in |Tds|, so whenever we add an edge, we also add the induced edge if necessary \begin{code} addTdpEdge :: Info -> Comp s -> EdgePath -> ST s () -- how to add an edge (s,t) when not having to bother about the transitive closure: addTdpEdge info comp@(_,(tdpN,tdpT)) e@((s,t),ee) = do b <- addEdge tdpN e -- add it to the normal graph when b -- if it was a new edge (do addEdge tdpT ((t,s),ee) -- also add it to the transposed graph let u = tdpToTds info ! s -- find the corresponding attributes... v = tdpToTds info ! t nonlocal = u /= -1 && v /= -1 equalfield = isEqualField (ruleTable info ! s) (ruleTable info ! t) when (nonlocal && equalfield) -- ...and when necessary... (insertTds info comp ((u,v),ee)) -- ...insert it to the Tds graph ) \end{code} Inserting edges into |Tds| will insert edges between the occurrences of the attributes into |Tdp|. \begin{code} insertTds :: Info -> Comp s -> EdgePath -> ST s () insertTds info comp@(tds,_) e@((u,v),ee) = do b <- addEdge tds e when b (mapM_ (insertTdp info comp) [ ( (s,t), [AttrStep u v] ) | s <- tdsToTdp info ! u , not (getIsIn (ruleTable info ! s)) -- inherited at LHS, or synthesized at RHS , t <- tdsToTdp info ! v , getIsIn (ruleTable info ! t) -- synthesized at LHS, or inherited at RHS , isEqualField (ruleTable info ! s) (ruleTable info ! t) ] ) \end{code} If we add the direct dependencies to the Tdp graph in the way above, the Tds graph is filled with IDS. Below is a way to only build up the Tdp graph, without reflect the changes in the Tds graph. \begin{code} simpleInsert :: Tdp s -> EdgePath -> ST s () simpleInsert tdp@(tdpN,tdpT) e@((s,t),ee) = do b <- hasEdge tdpT ((t,s),undefined) unless b (do rs <- readArray tdpT s us <- readArray tdpN t let edges = e :[ ((r,t),er++ee ) | (r,er) <- Map.toList rs ] ++ [ ((s,u), ee++eu) | (u,eu) <- Map.toList us ] ++ [ ((r,u),er++ee++eu) | (r,er) <- Map.toList rs, (u,eu) <- Map.toList us ] mapM_ (addSimpleEdge tdp) edges ) addSimpleEdge :: Tdp s -> EdgePath -> ST s () addSimpleEdge (tdpN,tdpT) e@((s,t),ee) = do b <- addEdge tdpN e when b (do addEdge tdpT ((t,s),ee) return () ) \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Interfaces} In absence of cycles we can find the interfaces. We only take attributes that are used. When an attribute has no incoming edges it can be computed. As the emphasis is on incoming edges, we will work with the transposed Tds graph. The funtion |used| indicates which vertices are included in the interfaces. See modules Interfaces and InterfacesRules for more information. %format sem_IRoot_IRoot = "sem_{IRoot}" %format sem_Interface_Interface = "sem_{Interface}" %format sem_Interfaces_Cons = ":_{Interfaces}" %format sem_Interfaces_Nil = "[]_{Interfaces}" %format sem_Segments_Cons = ":_{Segments}" %format sem_Segments_Nil = "[]_{Segments}" \begin{code} makeInterfaces :: Info -> Graph -> T_IRoot makeInterfaces info tds = let interslist = reverse . makeInterface tds [] mkSegments = foldr (sem_Segments_Cons . uncurry sem_Segment_Segment) sem_Segments_Nil . interslist mkInter ((nt,cons),lmh) = sem_Interface_Interface nt cons (mkSegments lmh) inters = foldr (sem_Interfaces_Cons . mkInter) sem_Interfaces_Nil (zip (nonts info) (lmh info)) in sem_IRoot_IRoot inters \end{code} The sinks of a graph are those vertices that have no outgoing edges. We define a function that determines whether a vertex is a sink if a set |del| of vertices had been removed from the graph. This means that the attribute can be computed if all attributes in |del| have been computed. \begin{code} isSink :: Graph -> [Vertex] -> Vertex -> Bool isSink graph del v = null (graph ! v \\ del) \end{code} Now we can make interfaces by taking inherited sinks and synthesized sinks alternatively. If there are no synthesized attributes at all, generate an interface with one visit computing nothing. \begin{code} makeInterface :: Graph -> [Vertex] -> LMH -> [([Vertex],[Vertex])] makeInterface tds del (l,m,h) | m > h = [([],[])] | otherwise = let syn = filter (isSink tds del) ([m..h] \\ del) del' = del ++ syn inh = filter (isSink tds del') ([l..(m-1)] \\ del') del'' = del' ++ inh rest = makeInterface tds del'' (l,m,h) in if null inh && null syn then [] else (inh,syn) : rest \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Detecting of cycles} We only want to return s2i edges. \begin{code} findCycles :: Info -> MGraph -> [EdgePaths] findCycles info tds = [ ((u,v),p1,p2) | (l,m,h) <- lmh info -- for every nonterminal: [l..m-1] are inherited, [m..h] are synthesized , v <- [m..h] -- for every synthesized attribute , (u,p1) <- Map.toList (tds ! v) -- find dependent attributes... , l <= u, u < m -- ...that are inherited... , let mbp2 = Map.lookup v (tds ! u) -- ...and have a cycle back , isJust mbp2 , let p2 = fromJust mbp2 ] findLocCycles :: MGraph -> [EdgePath] findLocCycles tdp = let (low, high) = bounds tdp in [ ((u,u),p) | u <- [low..high] , (v,p) <- Map.toList (tdp ! u) , v==u ] findInstCycles :: [Edge] -> MGraph -> [EdgePath] findInstCycles instToSynEdges tdp = [ ((i,s), fromJust mbp) | (i, s) <- instToSynEdges , let mbp = Map.lookup i (tdp ! s) , isJust mbp ] \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Tying it together} \begin{code} generateVisits :: Info -> MGraph -> MGraph -> [Edge] -> (CInterfaceMap, CVisitsMap, [Edge]) generateVisits info tds tdp dpr = let inters = makeInterfaces info (fmap Map.keys tds) inhs = Inh_IRoot{ info_Inh_IRoot = info , tdp_Inh_IRoot = fmap Map.keys tdp , dpr_Inh_IRoot = dpr } iroot = wrap_IRoot inters inhs in (inters_Syn_IRoot iroot, visits_Syn_IRoot iroot, edp_Syn_IRoot iroot) reportLocalCycle :: MGraph -> [EdgePath] -> [[Vertex]] reportLocalCycle tds cyc = fst (foldr f ([],Set.empty) (map (edgePathToEdgeRoute tds) cyc)) where f ((x,_),p) res@(paths,syms) | Set.member x syms = res -- don't report a cyclic vertex if it appears on a path of an earlier reported one | otherwise = (p:paths, Set.union syms (Set.fromList p)) reportCycle :: Info -> MGraph -> [EdgePaths] -> [EdgeRoutes] reportCycle info tds cyc = fst (foldr f ([],Set.empty) (map (edgePathsToEdgeRoutes tds) cyc)) where f epp@((x,y),p1,p2) res@(paths,syms) | Set.member x syms && Set.member y syms = res -- don't report mutually dependent vertices if both appear on paths reported earlier | otherwise = (epp:paths, Set.union syms (Set.fromList (map tdp2tds (p1++p2)))) tdp2tds (-2) = -2 tdp2tds v = tdpToTds info ! v edgePathsToEdgeRoutes :: MGraph -> EdgePaths -> EdgeRoutes edgePathsToEdgeRoutes tds (e,p1,p2) = ( e, pathToRoute tds p1, pathToRoute tds p2 ) edgePathToEdgeRoute :: MGraph -> EdgePath -> EdgeRoute edgePathToEdgeRoute tds (e,p) = ( e, pathToRoute tds p ) pathToRoute :: MGraph -> Path -> Route pathToRoute tds p = convertPath (expandAll p) where expandAll :: Path -> Path expandAll p | hasAttrStep p = expandAll (expandOne p) | otherwise = p expandOne :: Path -> Path expandOne p = shortcut (concatMap expandStep p) expandStep :: PathStep -> Path expandStep (AttrStep u v) = fromJust (Map.lookup v (tds!u)) expandStep x = [x] convertPath :: Path -> Route convertPath p = concatMap convertStep p convertStep :: PathStep -> Route convertStep (AtOcStep s t) = [s,t] convertStep (AttrIndu s t) = [-2,-2] hasAttrStep :: Path -> Bool hasAttrStep [] = False hasAttrStep (AttrStep _ _ : _ ) = True hasAttrStep (_ : xs) = hasAttrStep xs shortcut :: Eq a => [a] -> [a] shortcut [] = [] shortcut (x:xs) = x : shortcut (removeBefore x xs) removeBefore :: Eq a => a -> [a] -> [a] removeBefore x ys = reverse (takeWhile (/=x) (reverse ys)) isLocLoc :: Table CRule -> EdgePath -> Bool isLocLoc rt ((s,t),_) = isLocal (rt ! s) && isLocal (rt ! t) -- || (isInst (rt ! s) && isInst (rt ! t)) computeSequential :: Info -> [Edge] -> [Edge] -> CycleStatus computeSequential info dpr instToSynEdges = runST (do let bigBounds = bounds (tdpToTds info) smallBounds = bounds (tdsToTdp info) (ll,es) = partition (isLocLoc (ruleTable info)) (map (singleStep AtOcStep) (dpr ++ instToSynEdges)) tds <- newArray smallBounds Map.empty tdpN <- newArray bigBounds Map.empty tdpT <- newArray bigBounds Map.empty let tdp = (tdpN,tdpT) comp = (tds,tdp) mapM_ (simpleInsert tdp) ll -- insert the local dependencies tdp1 <- freeze tdpN let cyc1 = findLocCycles tdp1 if not (null cyc1) -- are they cyclic? then do return (LocalCycle (reportLocalCycle undefined cyc1)) -- then report an error. else do mapM_ (insertTdp info comp) es -- insert the other dependencies tds2 <- freeze tds let cyc2 = findCycles info tds2 if not (null cyc2) -- are they cyclic? then do return (DirectCycle (reportCycle info tds2 cyc2)) -- then report an error. else do tdp2 <- freeze tdpN let cyc4 = findInstCycles instToSynEdges tdp2 if not (null cyc4) then do return (InstCycle (reportLocalCycle tds2 cyc4)) -- then report an error. else do let (cim,cvm,edp) = generateVisits info tds2 tdp2 dpr mapM_ (insertTds info comp) (map (singleStep AttrIndu) edp) -- insert dependencies induced by visit scheduling tds3 <- freeze tds let cyc3 = findCycles info tds3 if not (null cyc3) -- are they cyclic? then return (InducedCycle cim (reportCycle info tds3 cyc3)) -- then report an error. else do tdp3 <- freeze tdpN let cyc5 = findInstCycles instToSynEdges tdp3 if not (null cyc5) then do return (InstCycle (reportLocalCycle tds3 cyc5)) -- then report an error. else do return (CycleFree cim cvm) -- otherwise we succeed. ) \end{code} \end{document}