# Ticket #2227: dominators.patch

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

Line | |
---|---|

1 | |

2 | New patches: |

3 | |

4 | [reimplement Data.Graph.Inductive.Query.Dominators |

5 | Bertram Felgenhauer <int-e@gmx.de>**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 | ] { |

11 | hunk ./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 <int-e@gmx.de> |

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 |

26 | hunk ./Data/Graph/Inductive/Query/Dominators.hs 15 |

27 | -import Data.List |

28 | hunk ./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 |

35 | hunk ./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) |

40 | hunk ./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] |

52 | hunk ./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' |

64 | hunk ./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) |

86 | hunk ./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 |

93 | hunk ./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 |

106 | hunk ./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 |

119 | hunk ./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') |

133 | hunk ./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') |

140 | hunk ./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 | |

160 | Context: |

161 | |

162 | [Exported xdf*With functions from DFS.hs |

163 | Martin Erwig <erwig@eecs.oregonstate.edu>**20080207195521] |

164 | [Fixed out' |

165 | Martin Erwig <erwig@eecs.oregonstate.edu>**20080207194410] |

166 | [TAG GHC 6.8.1 release |

167 | Ian Lynagh <igloo@earth.li>**20071110011105] |

168 | Patch bundle hash: |

169 | 2314a03381f96abd203a72e63513ed4d3c14bb79 |