Ticket #2227: dominators.patch

File dominators.patch, 7.4 KB (added by int-e, 7 years ago)

proposed patch

Line 
1
2New patches:
3
4[reimplement Data.Graph.Inductive.Query.Dominators
5Bertram Felgenhauer <[email protected]>**20080421205342
6 It was buggy and very slow for large graphs. See
7   http://www.haskell.org/pipermail/haskell-cafe/2008-April/041739.html
8 This patch also adds a new function, iDom, that returns the immediate
9 dominators of the graph nodes.
10] {
11hunk ./Data/Graph/Inductive/Query/Dominators.hs 1
12-module Data.Graph.Inductive.Query.Dominators(
13-    dom
14+-- Find Dominators of a graph.
15+--
16+-- Author: Bertram Felgenhauer <[email protected]>
17+--
18+-- Implementation based on
19+-- Keith D. Cooper, Timothy J. Harvey, Ken Kennedy,
20+-- "A Simple, Fast Dominance Algorithm",
21+-- (http://citeseer.ist.psu.edu/cooper01simple.html)
22+
23+module Data.Graph.Inductive.Query.Dominators (
24+    dom,
25+    iDom
26hunk ./Data/Graph/Inductive/Query/Dominators.hs 15
27-import Data.List
28hunk ./Data/Graph/Inductive/Query/Dominators.hs 16
29+import Data.Graph.Inductive.Query.DFS
30+import Data.Tree (Tree(..))
31+import qualified Data.Tree as T
32+import Data.Array
33+import Data.IntMap (IntMap)
34+import qualified Data.IntMap as I
35hunk ./Data/Graph/Inductive/Query/Dominators.hs 23
36+-- | return immediate dominators for each node of a graph, given a root
37+iDom :: Graph gr => gr a b -> Node -> [(Node,Node)]
38+iDom g root = let (result, toNode, _) = idomWork g root
39+              in  map (\(a, b) -> (toNode ! a, toNode ! b)) (assocs result)
40hunk ./Data/Graph/Inductive/Query/Dominators.hs 28
41-type DomSets = [(Node,[Node],[Node])]
42+-- | return the set of dominators of the nodes of a graph, given a root
43+dom :: Graph gr => gr a b -> Node -> [(Node,[Node])]
44+dom g root = let
45+    (iDom, toNode, fromNode) = idomWork g root
46+    dom' = getDom toNode iDom
47+    nodes' = nodes g
48+    rest = I.keys (I.filter (-1 ==) fromNode)
49+  in
50+    [(toNode ! i, dom' ! i) | i <- range (bounds dom')] ++
51+    [(n, nodes') | n <- rest]
52hunk ./Data/Graph/Inductive/Query/Dominators.hs 39
53+-- internal node type
54+type Node' = Int
55+-- array containing the immediate dominator of each node, or an approximation
56+-- thereof. the dominance set of a node can be found by taking the union of
57+-- {node} and the dominance set of its immediate dominator.
58+type IDom = Array Node' Node'
59+-- array containing the list of predecessors of each node
60+type Preds = Array Node' [Node']
61+-- arrays for translating internal nodes back to graph nodes and back
62+type ToNode = Array Node' Node
63+type FromNode = IntMap Node'
64hunk ./Data/Graph/Inductive/Query/Dominators.hs 51
65-intersection :: [[Node]] -> [Node]
66-intersection cs = foldr intersect (head cs) cs
67+idomWork :: Graph gr => gr a b -> Node -> (IDom, ToNode, FromNode)
68+idomWork g root = let
69+    -- use depth first tree from root do build the first approximation
70+    trees@(~[tree]) = dff [root] g
71+    -- relabel the tree so that paths from the root have increasing nodes
72+    (s, ntree) = numberTree 0 tree
73+    -- the approximation iDom0 just maps each node to its parent
74+    iDom0 = array (1, s-1) (tail $ treeEdges (-1) ntree)
75+    -- fromNode translates graph nodes to relabeled (internal) nodes
76+    fromNode = I.unionWith const (I.fromList (zip (T.flatten tree) (T.flatten ntree))) (I.fromList (zip (nodes g) (repeat (-1))))
77+    -- toNode translates internal nodes to graph nodes
78+    toNode = array (0, s-1) (zip (T.flatten ntree) (T.flatten tree))
79+    preds = array (1, s-1) [(i, filter (/= -1) (map (fromNode I.!)
80+                            (pre g (toNode ! i)))) | i <- [1..s-1]]
81+    -- iteratively improve the approximation to find iDom.
82+    iDom = fixEq (refineIDom preds) iDom0
83+  in
84+    if null trees then error "Dominators.idomWork: root not in graph"
85+                  else (iDom, toNode, fromNode)
86hunk ./Data/Graph/Inductive/Query/Dominators.hs 71
87-getdomv :: [Node] -> DomSets -> [[Node]]
88-getdomv vs  ds = [z|(w,_,z)<-ds,v<-vs,v==w]
89+-- for each node in iDom, find the intersection of all its predecessor's
90+-- dominating sets, and update iDom accordingly.
91+refineIDom :: Preds -> IDom -> IDom
92+refineIDom preds iDom = fmap (foldl1 (intersect iDom)) preds
93hunk ./Data/Graph/Inductive/Query/Dominators.hs 76
94-builddoms :: DomSets -> [Node] -> DomSets
95-builddoms ds []     = ds
96-builddoms ds (v:vs) = builddoms ((fs++[(n,p,sort(n:idv))])++(tail rs)) vs
97-                      where idv     = intersection (getdomv p ds)
98-                            (n,p,_) = head rs
99-                            (fs,rs) = span (\(x,_,_)->x/=v) ds
100+-- find the intersection of the two given dominance sets.
101+intersect :: IDom -> Node' -> Node' -> Node'
102+intersect iDom a b = case a `compare` b of
103+    LT -> intersect iDom a (iDom ! b)
104+    EQ -> a
105+    GT -> intersect iDom (iDom ! a) b
106hunk ./Data/Graph/Inductive/Query/Dominators.hs 83
107-domr :: DomSets -> [Node] -> DomSets
108-domr ds vs|xs == ds  = ds
109-          |otherwise = builddoms xs vs
110-           where xs = (builddoms ds vs)
111+-- convert an IDom to dominance sets. we translate to graph nodes here
112+-- because mapping later would be more expensive and lose sharing.
113+getDom :: ToNode -> IDom -> Array Node' [Node]
114+getDom toNode iDom = let
115+    res = array (0, snd (bounds iDom)) ((0, [toNode ! 0]) :
116+          [(i, toNode ! i : res ! (iDom ! i)) | i <- range (bounds iDom)])
117+  in
118+    res
119hunk ./Data/Graph/Inductive/Query/Dominators.hs 92
120-{-|
121-Finds the dominators relationship for a given graph and an initial
122-node. For each node v, it returns the list of dominators of v.
123--}
124-dom :: Graph gr => gr a b -> Node -> [(Node,[Node])]
125-dom g u = map (\(x,_,z)->(x,z)) (domr ld n')
126-           where ld    = (u,[],[u]):map (\v->(v,pre g v,n)) (n')
127-                 n'    = n\\[u]
128-                 n     = nodes g
129+-- relabel tree, labeling vertices with consecutive numbers in depth first order
130+numberTree :: Node' -> Tree a -> (Node', Tree Node')
131+numberTree n (Node _ ts) = let (n', ts') = numberForest (n+1) ts
132+                           in  (n', Node n ts')
133hunk ./Data/Graph/Inductive/Query/Dominators.hs 97
134+-- same as numberTree, for forests.
135+numberForest :: Node' -> [Tree a] -> (Node', [Tree Node'])
136+numberForest n []     = (n, [])
137+numberForest n (t:ts) = let (n', t')   = numberTree n t
138+                            (n'', ts') = numberForest n' ts
139+                        in  (n'', t':ts')
140hunk ./Data/Graph/Inductive/Query/Dominators.hs 104
141+-- return the edges of the tree, with an added dummy root node.
142+treeEdges :: a -> Tree a -> [(a,a)]
143+treeEdges a (Node b ts) = (b,a) : concatMap (treeEdges b) ts
144+
145+-- find a fixed point of f, iteratively
146+fixEq :: Eq a => (a -> a) -> a -> a
147+fixEq f v | v' == v   = v
148+          | otherwise = fixEq f v'
149+    where v' = f v
150+
151+{-
152+:m +Data.Graph.Inductive
153+let g0 = mkGraph [(i,()) | i <- [0..4]] [(a,b,()) | (a,b) <- [(0,1),(1,2),(0,3),(3,2),(4,0)]] :: Gr () ()
154+let g1 = mkGraph [(i,()) | i <- [0..4]] [(a,b,()) | (a,b) <- [(0,1),(1,2),(2,3),(1,3),(3,4)]] :: Gr () ()
155+let g2,g3,g4 :: Int -> Gr () (); g2 n = mkGraph [(i,()) | i <- [0..n-1]] ([(a,a+1,()) | a <- [0..n-2]] ++ [(a,a+2,()) | a <- [0..n-3]]); g3 n =mkGraph [(i,()) | i <- [0..n-1]] ([(a,a+2,()) | a <- [0..n-3]] ++ [(a,a+1,()) | a <- [0..n-2]]); g4 n =mkGraph [(i,()) | i <- [0..n-1]] ([(a+2,a,()) | a <- [0..n-3]] ++ [(a+1,a,()) | a <- [0..n-2]])
156+:m -Data.Graph.Inductive
157+-}
158}
159
160Context:
161
162[Exported xdf*With functions from DFS.hs
163Martin Erwig <[email protected]>**20080207195521]
164[Fixed out'
165Martin Erwig <[email protected]>**20080207194410]
166[TAG GHC 6.8.1 release
167Ian Lynagh <[email protected]>**20071110011105]
168Patch bundle hash:
1692314a03381f96abd203a72e63513ed4d3c14bb79