1-- Find Dominators of a graph. 2-- 3-- Author: Bertram Felgenhauer <int-e@gmx.de> 4-- 5-- Implementation based on 6-- Keith D. Cooper, Timothy J. Harvey, Ken Kennedy, 7-- "A Simple, Fast Dominance Algorithm", 8-- (http://citeseer.ist.psu.edu/cooper01simple.html) 9 10module Data.Graph.Inductive.Query.Dominators ( 11 dom, 12 iDom 13) where 14 15import Data.Array 16import Data.Graph.Inductive.Graph 17import Data.Graph.Inductive.Query.DFS 18import Data.IntMap (IntMap) 19import qualified Data.IntMap as I 20import Data.Tree (Tree (..)) 21import qualified Data.Tree as T 22 23{-# ANN iDom "HLint: ignore Use ***" #-} 24-- | return immediate dominators for each node of a graph, given a root 25iDom :: (Graph gr) => gr a b -> Node -> [(Node,Node)] 26iDom g root = let (result, toNode, _) = idomWork g root 27 in map (\(a, b) -> (toNode ! a, toNode ! b)) (assocs result) 28 29-- | return the set of dominators of the nodes of a graph, given a root 30dom :: (Graph gr) => gr a b -> Node -> [(Node,[Node])] 31dom g root = let 32 (iD, toNode, fromNode) = idomWork g root 33 dom' = getDom toNode iD 34 nodes' = nodes g 35 rest = I.keys (I.filter (-1 ==) fromNode) 36 in 37 [(toNode ! i, dom' ! i) | i <- range (bounds dom')] ++ 38 [(n, nodes') | n <- rest] 39 40-- internal node type 41type Node' = Int 42-- array containing the immediate dominator of each node, or an approximation 43-- thereof. the dominance set of a node can be found by taking the union of 44-- {node} and the dominance set of its immediate dominator. 45type IDom = Array Node' Node' 46-- array containing the list of predecessors of each node 47type Preds = Array Node' [Node'] 48-- arrays for translating internal nodes back to graph nodes and back 49type ToNode = Array Node' Node 50type FromNode = IntMap Node' 51 52idomWork :: (Graph gr) => gr a b -> Node -> (IDom, ToNode, FromNode) 53idomWork g root = let 54 -- use depth first tree from root do build the first approximation 55 trees@(~[tree]) = dff [root] g 56 -- relabel the tree so that paths from the root have increasing nodes 57 (s, ntree) = numberTree 0 tree 58 -- the approximation iDom0 just maps each node to its parent 59 iD0 = array (1, s-1) (tail $ treeEdges (-1) ntree) 60 -- fromNode translates graph nodes to relabeled (internal) nodes 61 fromNode = I.unionWith const (I.fromList (zip (T.flatten tree) (T.flatten ntree))) (I.fromList (zip (nodes g) (repeat (-1)))) 62 -- toNode translates internal nodes to graph nodes 63 toNode = array (0, s-1) (zip (T.flatten ntree) (T.flatten tree)) 64 preds = array (1, s-1) [(i, filter (/= -1) (map (fromNode I.!) 65 (pre g (toNode ! i)))) | i <- [1..s-1]] 66 -- iteratively improve the approximation to find iDom. 67 iD = fixEq (refineIDom preds) iD0 68 in 69 if null trees then error "Dominators.idomWork: root not in graph" 70 else (iD, toNode, fromNode) 71 72-- for each node in iDom, find the intersection of all its predecessor's 73-- dominating sets, and update iDom accordingly. 74refineIDom :: Preds -> IDom -> IDom 75refineIDom preds iD = fmap (foldl1 (intersect iD)) preds 76 77-- find the intersection of the two given dominance sets. 78intersect :: IDom -> Node' -> Node' -> Node' 79intersect iD a b = case a `compare` b of 80 LT -> intersect iD a (iD ! b) 81 EQ -> a 82 GT -> intersect iD (iD ! a) b 83 84-- convert an IDom to dominance sets. we translate to graph nodes here 85-- because mapping later would be more expensive and lose sharing. 86getDom :: ToNode -> IDom -> Array Node' [Node] 87getDom toNode iD = let 88 res = array (0, snd (bounds iD)) ((0, [toNode ! 0]) : 89 [(i, toNode ! i : res ! (iD ! i)) | i <- range (bounds iD)]) 90 in 91 res 92 93-- relabel tree, labeling vertices with consecutive numbers in depth first order 94numberTree :: Node' -> Tree a -> (Node', Tree Node') 95numberTree n (Node _ ts) = let (n', ts') = numberForest (n+1) ts 96 in (n', Node n ts') 97 98-- same as numberTree, for forests. 99numberForest :: Node' -> [Tree a] -> (Node', [Tree Node']) 100numberForest n [] = (n, []) 101numberForest n (t:ts) = let (n', t') = numberTree n t 102 (n'', ts') = numberForest n' ts 103 in (n'', t':ts') 104 105-- return the edges of the tree, with an added dummy root node. 106treeEdges :: a -> Tree a -> [(a,a)] 107treeEdges a (Node b ts) = (b,a) : concatMap (treeEdges b) ts 108 109-- find a fixed point of f, iteratively 110fixEq :: (Eq a) => (a -> a) -> a -> a 111fixEq f v | v' == v = v 112 | otherwise = fixEq f v' 113 where v' = f v 114 115{- 116:m +Data.Graph.Inductive 117let g0 = mkGraph [(i,()) | i <- [0..4]] [(a,b,()) | (a,b) <- [(0,1),(1,2),(0,3),(3,2),(4,0)]] :: Gr () () 118let g1 = mkGraph [(i,()) | i <- [0..4]] [(a,b,()) | (a,b) <- [(0,1),(1,2),(2,3),(1,3),(3,4)]] :: Gr () () 119let 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]]) 120:m -Data.Graph.Inductive 121-} 122