    -- 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.Maybe (mapMaybe)
    import           Data.Tree                      (Tree (..))
    import qualified Data.Tree                      as T

    {-# ANN iDom "HLint: ignore Use ***" #-}
    -- | return immediate dominators for each reachable node of a graph, given a root
    iDom :: (Graph gr) => gr a b -> Node -> [(Node,Node)]
    iDom :: forall (gr :: * -> * -> *) a b.
    Graph gr =>
    gr a b -> Node' -> [(Node', Node')]
    iDom gr a b
    g Node'
    root = let (IDom
    result, IDom
    toNode, 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
                  in  ((Node', Node') -> (Node', Node'))
    -> [(Node', Node')] -> [(Node', Node')]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Node'
    a, 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 reachable nodes of a graph, given a root
    dom :: (Graph gr) => gr a b -> Node -> [(Node,[Node])]
    dom :: forall (gr :: * -> * -> *) a b.
    Graph gr =>
    gr a b -> Node' -> [(Node', [Node'])]
    dom gr a b
    g Node'
    root = let
        (IDom
    iD, IDom
    toNode, 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 (-Node'
    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 :: forall (gr :: * -> * -> *) a b.
    Graph gr =>
    gr a b -> Node' -> (IDom, IDom, FromNode)
    idomWork gr a b
    g Node'
    root =
      case [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 of
        [] -> [Char] -> (IDom, IDom, FromNode)
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Dominators.idomWork: root not in graph"
        Tree Node'
    tree : [Tree Node']
    _ ->
          let
            nds :: [Node']
    nds = Node' -> gr a b -> [Node']
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    Node' -> gr a b -> [Node']
    reachable Node'
    root gr a b
    g
            -- use depth first tree from root do build the first approximation
            -- relabel the tree so that paths from the root have increasing nodes
            (Node'
    s, Tree Node'
    ntree) = Node' -> Tree Node' -> (Node', Tree Node')
    forall a. Node' -> Tree a -> (Node', Tree Node')
    numberTree Node'
    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 (Node'
    1, Node'
    sNode' -> Node' -> Node'
    forall a. Num a => a -> a -> a
    -Node'
    1) ([(Node', Node')] -> [(Node', Node')]
    forall a. HasCallStack => [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 (-Node'
    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 [Node']
    nds (Node' -> [Node']
    forall a. a -> [a]
    repeat (-Node'
    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 (Node'
    0, Node'
    sNode' -> Node' -> Node'
    forall a. Num a => a -> a -> a
    -Node'
    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 (Node'
    1, Node'
    sNode' -> Node' -> Node'
    forall a. Num a => a -> a -> a
    -Node'
    1) [(Node'
    i, (Node' -> Bool) -> [Node'] -> [Node']
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Node' -> Node' -> Bool
    forall a. Eq a => a -> a -> Bool
    /= -Node'
    1) ((Node' -> Maybe Node') -> [Node'] -> [Node']
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Node' -> FromNode -> Maybe Node'
    forall a. Node' -> IntMap a -> Maybe a
    `I.lookup` FromNode
    fromNode)
                                    (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 <- [Node'
    1..Node'
    sNode' -> Node' -> Node'
    forall a. Num a => a -> a -> a
    -Node'
    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 (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 Array Node' [Node']
    preds IDom
    iD = ([Node'] -> Node') -> Array Node' [Node'] -> IDom
    forall a b. (a -> b) -> Array Node' a -> Array Node' b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Node' -> Node' -> Node') -> [Node'] -> Node'
    forall a. (a -> a -> a) -> [a] -> a
    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 IDom
    iD Node'
    a Node'
    b = case Node'
    a Node' -> Node' -> Ordering
    forall a. Ord a => a -> a -> Ordering
    `compare` Node'
    b of
        Ordering
    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)
        Ordering
    EQ -> Node'
    a
        Ordering
    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 IDom
    toNode 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 (Node'
    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)) ((Node'
    0, [IDom
    toNode IDom -> Node' -> Node'
    forall i e. Ix i => Array i e -> i -> e
    ! Node'
    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 :: forall a. Node' -> Tree a -> (Node', Tree Node')
    numberTree Node'
    n (Node a
    _ [Tree a]
    ts) = let (Node'
    n', [Tree Node']
    ts') = Node' -> [Tree a] -> (Node', [Tree Node'])
    forall a. Node' -> [Tree a] -> (Node', [Tree Node'])
    numberForest (Node'
    nNode' -> Node' -> Node'
    forall a. Num a => a -> a -> a
    +Node'
    1) [Tree a]
    ts
                               in  (Node'
    n', Node' -> [Tree Node'] -> Tree Node'
    forall a. a -> [Tree a] -> Tree a
    Node Node'
    n [Tree Node']
    ts')

    -- same as numberTree, for forests.
    numberForest :: Node' -> [Tree a] -> (Node', [Tree Node'])
    numberForest :: forall a. Node' -> [Tree a] -> (Node', [Tree Node'])
    numberForest Node'
    n []     = (Node'
    n, [])
    numberForest Node'
    n (Tree a
    t:[Tree a]
    ts) = let (Node'
    n', Tree Node'
    t')   = Node' -> Tree a -> (Node', Tree Node')
    forall a. Node' -> Tree a -> (Node', Tree Node')
    numberTree Node'
    n Tree a
    t
                                (Node'
    n'', [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 :: forall a. a -> Tree a -> [(a, a)]
    treeEdges a
    a (Node a
    b [Tree a]
    ts) = (a
    b,a
    a) (a, a) -> [(a, a)] -> [(a, a)]
    forall a. a -> [a] -> [a]
    : (Tree a -> [(a, a)]) -> [Tree 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) [Tree a]
    ts

    -- find a fixed point of f, iteratively
    fixEq :: (Eq a) => (a -> a) -> a -> a
    fixEq :: forall a. Eq a => (a -> a) -> a -> a
    fixEq a -> a
    f 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
    -}