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