    -- Find Dominators of a graph.
    --
    -- Author: Bertram Felgenhauer <int-e@gmx.de>
    --
    -- Implementation based on
    -- Keith D. Cooper, Timothy J. Harvey, Ken Kennedy,
    -- "A Simple, Fast Dominance Algorithm",
    -- (http://citeseer.ist.psu.edu/cooper01simple.html)

    module Data.Graph.Inductive.Query.Dominators (
        dom,
        iDom
    ) where

    import           Data.Array
    import           Data.Graph.Inductive.Graph
    import           Data.Graph.Inductive.Query.DFS
    import           Data.IntMap                    (IntMap)
    import qualified Data.IntMap                    as I
    import           Data.Tree                      (Tree (..))
    import qualified Data.Tree                      as T

    {-# ANN iDom "HLint: ignore Use ***" #-}
    -- | return immediate dominators for each node of a graph, given a root
    iDom :: (Graph gr) => gr a b -> Node -> [(Node,Node)]
    iDom :: gr a b -> Node -> [(Node, Node)]
    iDom g :: gr a b
    g root :: Node
    root = let (result :: IDom
    result, toNode :: IDom
    toNode, _) = gr a b -> Node -> (IDom, IDom, FromNode)
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    gr a b -> Node -> (IDom, IDom, FromNode)
    idomWork gr a b
    g Node
    root
                  in  ((Node, Node) -> (Node, Node)) -> [(Node, Node)] -> [(Node, Node)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(a :: Node
    a, b :: Node
    b) -> (IDom
    toNode IDom -> Node -> Node
    forall i e. Ix i => Array i e -> i -> e
    ! Node
    a, IDom
    toNode IDom -> Node -> Node
    forall i e. Ix i => Array i e -> i -> e
    ! Node
    b)) (IDom -> [(Node, Node)]
    forall i e. Ix i => Array i e -> [(i, e)]
    assocs IDom
    result)

    -- | return the set of dominators of the nodes of a graph, given a root
    dom :: (Graph gr) => gr a b -> Node -> [(Node,[Node])]
    dom :: gr a b -> Node -> [(Node, [Node])]
    dom g :: gr a b
    g root :: Node
    root = let
        (iD :: IDom
    iD, toNode :: IDom
    toNode, fromNode :: FromNode
    fromNode) = gr a b -> Node -> (IDom, IDom, FromNode)
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    gr a b -> Node -> (IDom, IDom, FromNode)
    idomWork gr a b
    g Node
    root
        dom' :: Array Node [Node]
    dom' = IDom -> IDom -> Array Node [Node]
    getDom IDom
    toNode IDom
    iD
        nodes' :: [Node]
    nodes' = gr a b -> [Node]
    forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
    nodes gr a b
    g
        rest :: [Node]
    rest = FromNode -> [Node]
    forall a. IntMap a -> [Node]
    I.keys ((Node -> Bool) -> FromNode -> FromNode
    forall a. (a -> Bool) -> IntMap a -> IntMap a
    I.filter (-1 Node -> Node -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) FromNode
    fromNode)
      in
        [(IDom
    toNode IDom -> Node -> Node
    forall i e. Ix i => Array i e -> i -> e
    ! Node
    i, Array Node [Node]
    dom' Array Node [Node] -> Node -> [Node]
    forall i e. Ix i => Array i e -> i -> e
    ! Node
    i) | Node
    i <- (Node, Node) -> [Node]
    forall a. Ix a => (a, a) -> [a]
    range (Array Node [Node] -> (Node, Node)
    forall i e. Array i e -> (i, i)
    bounds Array Node [Node]
    dom')] [(Node, [Node])] -> [(Node, [Node])] -> [(Node, [Node])]
    forall a. [a] -> [a] -> [a]
    ++
        [(Node
    n, [Node]
    nodes') | Node
    n <- [Node]
    rest]

    -- internal node type
    type Node' = Int
    -- array containing the immediate dominator of each node, or an approximation
    -- thereof. the dominance set of a node can be found by taking the union of
    -- {node} and the dominance set of its immediate dominator.
    type IDom = Array Node' Node'
    -- array containing the list of predecessors of each node
    type Preds = Array Node' [Node']
    -- arrays for translating internal nodes back to graph nodes and back
    type ToNode = Array Node' Node
    type FromNode = IntMap Node'

    idomWork :: (Graph gr) => gr a b -> Node -> (IDom, ToNode, FromNode)
    idomWork :: gr a b -> Node -> (IDom, IDom, FromNode)
    idomWork g :: gr a b
    g root :: Node
    root = let
        -- use depth first tree from root do build the first approximation
        trees :: [Tree Node]
    trees@(~[tree :: Tree Node
    tree]) = [Node] -> gr a b -> [Tree Node]
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    [Node] -> gr a b -> [Tree Node]
    dff [Node
    root] gr a b
    g
        -- relabel the tree so that paths from the root have increasing nodes
        (s :: Node
    s, ntree :: Tree Node
    ntree) = Node -> Tree Node -> (Node, Tree Node)
    forall a. Node -> Tree a -> (Node, Tree Node)
    numberTree 0 Tree Node
    tree
        -- the approximation iDom0 just maps each node to its parent
        iD0 :: IDom
    iD0 = (Node, Node) -> [(Node, Node)] -> IDom
    forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    array (1, Node
    sNode -> Node -> Node
    forall a. Num a => a -> a -> a
    -1) ([(Node, Node)] -> [(Node, Node)]
    forall a. [a] -> [a]
    tail ([(Node, Node)] -> [(Node, Node)])
    -> [(Node, Node)] -> [(Node, Node)]
    forall a b. (a -> b) -> a -> b
    $ Node -> Tree Node -> [(Node, Node)]
    forall a. a -> Tree a -> [(a, a)]
    treeEdges (-1) Tree Node
    ntree)
        -- fromNode translates graph nodes to relabeled (internal) nodes
        fromNode :: FromNode
    fromNode = (Node -> Node -> Node) -> FromNode -> FromNode -> FromNode
    forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
    I.unionWith Node -> Node -> Node
    forall a b. a -> b -> a
    const ([(Node, Node)] -> FromNode
    forall a. [(Node, a)] -> IntMap a
    I.fromList ([Node] -> [Node] -> [(Node, Node)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (Tree Node -> [Node]
    forall a. Tree a -> [a]
    T.flatten Tree Node
    tree) (Tree Node -> [Node]
    forall a. Tree a -> [a]
    T.flatten Tree Node
    ntree))) ([(Node, Node)] -> FromNode
    forall a. [(Node, a)] -> IntMap a
    I.fromList ([Node] -> [Node] -> [(Node, Node)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (gr a b -> [Node]
    forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
    nodes gr a b
    g) (Node -> [Node]
    forall a. a -> [a]
    repeat (-1))))
        -- toNode translates internal nodes to graph nodes
        toNode :: IDom
    toNode = (Node, Node) -> [(Node, Node)] -> IDom
    forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    array (0, Node
    sNode -> Node -> Node
    forall a. Num a => a -> a -> a
    -1) ([Node] -> [Node] -> [(Node, Node)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (Tree Node -> [Node]
    forall a. Tree a -> [a]
    T.flatten Tree Node
    ntree) (Tree Node -> [Node]
    forall a. Tree a -> [a]
    T.flatten Tree Node
    tree))
        preds :: Array Node [Node]
    preds = (Node, Node) -> [(Node, [Node])] -> Array Node [Node]
    forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    array (1, Node
    sNode -> Node -> Node
    forall a. Num a => a -> a -> a
    -1) [(Node
    i, (Node -> Bool) -> [Node] -> [Node]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Node -> Node -> Bool
    forall a. Eq a => a -> a -> Bool
    /= -1) ((Node -> Node) -> [Node] -> [Node]
    forall a b. (a -> b) -> [a] -> [b]
    map (FromNode
    fromNode FromNode -> Node -> Node
    forall a. IntMap a -> Node -> a
    I.!)
                                (gr a b -> Node -> [Node]
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    gr a b -> Node -> [Node]
    pre gr a b
    g (IDom
    toNode IDom -> Node -> Node
    forall i e. Ix i => Array i e -> i -> e
    ! Node
    i)))) | Node
    i <- [1..Node
    sNode -> Node -> Node
    forall a. Num a => a -> a -> a
    -1]]
        -- iteratively improve the approximation to find iDom.
        iD :: IDom
    iD = (IDom -> IDom) -> IDom -> IDom
    forall a. Eq a => (a -> a) -> a -> a
    fixEq (Array Node [Node] -> IDom -> IDom
    refineIDom Array Node [Node]
    preds) IDom
    iD0
      in
        if [Tree Node] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Tree Node]
    trees then [Char] -> (IDom, IDom, FromNode)
    forall a. HasCallStack => [Char] -> a
    error "Dominators.idomWork: root not in graph"
                      else (IDom
    iD, IDom
    toNode, FromNode
    fromNode)

    -- for each node in iDom, find the intersection of all its predecessor's
    -- dominating sets, and update iDom accordingly.
    refineIDom :: Preds -> IDom -> IDom
    refineIDom :: Array Node [Node] -> IDom -> IDom
    refineIDom preds :: Array Node [Node]
    preds iD :: IDom
    iD = ([Node] -> Node) -> Array Node [Node] -> IDom
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Node -> Node -> Node) -> [Node] -> Node
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 (IDom -> Node -> Node -> Node
    intersect IDom
    iD)) Array Node [Node]
    preds

    -- find the intersection of the two given dominance sets.
    intersect :: IDom -> Node' -> Node' -> Node'
    intersect :: IDom -> Node -> Node -> Node
    intersect iD :: IDom
    iD a :: Node
    a b :: Node
    b = case Node
    a Node -> Node -> Ordering
    forall a. Ord a => a -> a -> Ordering
    `compare` Node
    b of
        LT -> IDom -> Node -> Node -> Node
    intersect IDom
    iD Node
    a (IDom
    iD IDom -> Node -> Node
    forall i e. Ix i => Array i e -> i -> e
    ! Node
    b)
        EQ -> Node
    a
        GT -> IDom -> Node -> Node -> Node
    intersect IDom
    iD (IDom
    iD IDom -> Node -> Node
    forall i e. Ix i => Array i e -> i -> e
    ! Node
    a) Node
    b

    -- convert an IDom to dominance sets. we translate to graph nodes here
    -- because mapping later would be more expensive and lose sharing.
    getDom :: ToNode -> IDom -> Array Node' [Node]
    getDom :: IDom -> IDom -> Array Node [Node]
    getDom toNode :: IDom
    toNode iD :: IDom
    iD = let
        res :: Array Node [Node]
    res = (Node, Node) -> [(Node, [Node])] -> Array Node [Node]
    forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
    array (0, (Node, Node) -> Node
    forall a b. (a, b) -> b
    snd (IDom -> (Node, Node)
    forall i e. Array i e -> (i, i)
    bounds IDom
    iD)) ((0, [IDom
    toNode IDom -> Node -> Node
    forall i e. Ix i => Array i e -> i -> e
    ! 0]) (Node, [Node]) -> [(Node, [Node])] -> [(Node, [Node])]
    forall a. a -> [a] -> [a]
    :
              [(Node
    i, IDom
    toNode IDom -> Node -> Node
    forall i e. Ix i => Array i e -> i -> e
    ! Node
    i Node -> [Node] -> [Node]
    forall a. a -> [a] -> [a]
    : Array Node [Node]
    res Array Node [Node] -> Node -> [Node]
    forall i e. Ix i => Array i e -> i -> e
    ! (IDom
    iD IDom -> Node -> Node
    forall i e. Ix i => Array i e -> i -> e
    ! Node
    i)) | Node
    i <- (Node, Node) -> [Node]
    forall a. Ix a => (a, a) -> [a]
    range (IDom -> (Node, Node)
    forall i e. Array i e -> (i, i)
    bounds IDom
    iD)])
      in
        Array Node [Node]
    res

    -- relabel tree, labeling vertices with consecutive numbers in depth first order
    numberTree :: Node' -> Tree a -> (Node', Tree Node')
    numberTree :: Node -> Tree a -> (Node, Tree Node)
    numberTree n :: Node
    n (Node _ ts :: Forest a
    ts) = let (n' :: Node
    n', ts' :: [Tree Node]
    ts') = Node -> Forest a -> (Node, [Tree Node])
    forall a. Node -> [Tree a] -> (Node, [Tree Node])
    numberForest (Node
    nNode -> Node -> Node
    forall a. Num a => a -> a -> a
    +1) Forest a
    ts
                               in  (Node
    n', Node -> [Tree Node] -> Tree Node
    forall a. a -> Forest a -> Tree a
    Node Node
    n [Tree Node]
    ts')

    -- same as numberTree, for forests.
    numberForest :: Node' -> [Tree a] -> (Node', [Tree Node'])
    numberForest :: Node -> [Tree a] -> (Node, [Tree Node])
    numberForest n :: Node
    n []     = (Node
    n, [])
    numberForest n :: Node
    n (t :: Tree a
    t:ts :: [Tree a]
    ts) = let (n' :: Node
    n', t' :: Tree Node
    t')   = Node -> Tree a -> (Node, Tree Node)
    forall a. Node -> Tree a -> (Node, Tree Node)
    numberTree Node
    n Tree a
    t
                                (n'' :: Node
    n'', ts' :: [Tree Node]
    ts') = Node -> [Tree a] -> (Node, [Tree Node])
    forall a. Node -> [Tree a] -> (Node, [Tree Node])
    numberForest Node
    n' [Tree a]
    ts
                            in  (Node
    n'', Tree Node
    t'Tree Node -> [Tree Node] -> [Tree Node]
    forall a. a -> [a] -> [a]
    :[Tree Node]
    ts')

    -- return the edges of the tree, with an added dummy root node.
    treeEdges :: a -> Tree a -> [(a,a)]
    treeEdges :: a -> Tree a -> [(a, a)]
    treeEdges a :: a
    a (Node b :: a
    b ts :: Forest a
    ts) = (a
    b,a
    a) (a, a) -> [(a, a)] -> [(a, a)]
    forall a. a -> [a] -> [a]
    : (Tree a -> [(a, a)]) -> Forest a -> [(a, a)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (a -> Tree a -> [(a, a)]
    forall a. a -> Tree a -> [(a, a)]
    treeEdges a
    b) Forest a
    ts

    -- find a fixed point of f, iteratively
    fixEq :: (Eq a) => (a -> a) -> a -> a
    fixEq :: (a -> a) -> a -> a
    fixEq f :: a -> a
    f v :: a
    v | a
    v' a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    v   = a
    v
              | Bool
    otherwise = (a -> a) -> a -> a
    forall a. Eq a => (a -> a) -> a -> a
    fixEq a -> a
    f a
    v'
        where v' :: a
    v' = a -> a
    f a
    v

    {-
    :m +Data.Graph.Inductive
    let g0 = mkGraph [(i,()) | i <- [0..4]] [(a,b,()) | (a,b) <- [(0,1),(1,2),(0,3),(3,2),(4,0)]] :: Gr () ()
    let g1 = mkGraph [(i,()) | i <- [0..4]] [(a,b,()) | (a,b) <- [(0,1),(1,2),(2,3),(1,3),(3,4)]] :: Gr () ()
    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]])
    :m -Data.Graph.Inductive
    -}