    {-# LANGUAGE GADTs #-}

    module GHC.Cmm.Dominators
      (
      -- * Dominator analysis and representation of results
        DominatorSet(..)
      , GraphWithDominators(..)
      , RPNum
      , graphWithDominators

      -- * Utility functions on graphs or graphs-with-dominators
      , graphMap
      , gwdRPNumber
      , gwdDominatorsOf
      , gwdDominatorTree

      -- * Utility functions on dominator sets
      , dominatorsMember
      , intersectDominators
      )
    where

    import GHC.Prelude

    import Data.Array.IArray
    import Data.Foldable()
    import qualified Data.Tree as Tree

    import Data.Word

    import qualified GHC.CmmToAsm.CFG.Dominators as LT

    import GHC.Cmm.Dataflow
    import GHC.Cmm.Dataflow.Block
    import GHC.Cmm.Dataflow.Graph
    import GHC.Cmm.Dataflow.Label
    import GHC.Cmm

    import GHC.Utils.Outputable( Outputable(..), text, int, hcat, (<+>))
    import GHC.Utils.Misc
    import GHC.Utils.Panic
    import GHC.Utils.Word64 (intToWord64)
    import qualified GHC.Data.Word64Map as WM
    import qualified GHC.Data.Word64Set as WS

    -- | =Dominator sets
    --
    -- Node X dominates node Y if and only if every path from the entry to
    -- Y includes X.  Node Y technically dominates itself, but it is
    -- never included in the *representation* of its dominator set.
    --
    -- A dominator set is represented as a linked list in which each node
    -- points to its *immediate* dominator, which is its parent in the
    -- dominator tree.  In many circumstances the immediate dominator
    -- will be the only dominator of interest.

    data DominatorSet = ImmediateDominator { DominatorSet -> Label
    ds_label  :: Label -- ^ Label of the immediate dominator.
                                           , DominatorSet -> DominatorSet
    ds_parent :: DominatorSet -- ^ Set of nodes dominating the immediate dominator.
                                           }
                      | EntryNode
      deriving (DominatorSet -> DominatorSet -> Bool
    (DominatorSet -> DominatorSet -> Bool)
    -> (DominatorSet -> DominatorSet -> Bool) -> Eq DominatorSet
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DominatorSet -> DominatorSet -> Bool
    == :: DominatorSet -> DominatorSet -> Bool
    $c/= :: DominatorSet -> DominatorSet -> Bool
    /= :: DominatorSet -> DominatorSet -> Bool
    Eq)

    instance Outputable DominatorSet where
      ppr :: DominatorSet -> SDoc
    ppr DominatorSet
    EntryNode = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "entry"
      ppr (ImmediateDominator Label
    l DominatorSet
    parent) = Label -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Label
    l SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "->" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> DominatorSet -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DominatorSet
    parent

    -- | Reverse postorder number of a node in a CFG
    newtype RPNum = RPNum Int
      deriving (RPNum -> RPNum -> Bool
    (RPNum -> RPNum -> Bool) -> (RPNum -> RPNum -> Bool) -> Eq RPNum
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: RPNum -> RPNum -> Bool
    == :: RPNum -> RPNum -> Bool
    $c/= :: RPNum -> RPNum -> Bool
    /= :: RPNum -> RPNum -> Bool
    Eq, Eq RPNum
    Eq RPNum =>
    (RPNum -> RPNum -> Ordering)
    -> (RPNum -> RPNum -> Bool)
    -> (RPNum -> RPNum -> Bool)
    -> (RPNum -> RPNum -> Bool)
    -> (RPNum -> RPNum -> Bool)
    -> (RPNum -> RPNum -> RPNum)
    -> (RPNum -> RPNum -> RPNum)
    -> Ord RPNum
    RPNum -> RPNum -> Bool
    RPNum -> RPNum -> Ordering
    RPNum -> RPNum -> RPNum
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: RPNum -> RPNum -> Ordering
    compare :: RPNum -> RPNum -> Ordering
    $c< :: RPNum -> RPNum -> Bool
    < :: RPNum -> RPNum -> Bool
    $c<= :: RPNum -> RPNum -> Bool
    <= :: RPNum -> RPNum -> Bool
    $c> :: RPNum -> RPNum -> Bool
    > :: RPNum -> RPNum -> Bool
    $c>= :: RPNum -> RPNum -> Bool
    >= :: RPNum -> RPNum -> Bool
    $cmax :: RPNum -> RPNum -> RPNum
    max :: RPNum -> RPNum -> RPNum
    $cmin :: RPNum -> RPNum -> RPNum
    min :: RPNum -> RPNum -> RPNum
    Ord)
    -- in reverse postorder, nodes closer to the entry have smaller numbers

    instance Show RPNum where
      show :: RPNum -> String
    show (RPNum Int
    i) = String
    "RP" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    i

    instance Outputable RPNum where
      ppr :: RPNum -> SDoc
    ppr (RPNum Int
    i) = [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "RP", Int -> SDoc
    forall doc. IsLine doc => Int -> doc
    int Int
    i]
       -- using `(<>)` would conflict with Semigroup

    dominatorsMember :: Label -> DominatorSet -> Bool
    -- ^ Use to tell if the given label is in the given
    -- dominator set.  Which is to say, does the bloc
    -- with with given label _properly_ and _non-vacuously_
    -- dominate the node whose dominator set this is?
    --
    -- Takes linear time in the height of the dominator tree,
    -- but uses space efficiently.
    dominatorsMember :: Label -> DominatorSet -> Bool
    dominatorsMember Label
    lbl (ImmediateDominator Label
    l DominatorSet
    p) = Label
    l Label -> Label -> Bool
    forall a. Eq a => a -> a -> Bool
    == Label
    lbl Bool -> Bool -> Bool
    || Label -> DominatorSet -> Bool
    dominatorsMember Label
    lbl DominatorSet
    p
    dominatorsMember Label
    _   DominatorSet
    EntryNode = Bool
    False

    -- | Intersect two dominator sets to produce a third dominator set.
    -- This function takes time linear in the size of the sets.
    -- As such it is inefficient and should be used only for things
    -- like visualizations or linters.
    intersectDominators :: DominatorSet -> DominatorSet -> DominatorSet
    intersectDominators :: DominatorSet -> DominatorSet -> DominatorSet
    intersectDominators DominatorSet
    ds DominatorSet
    ds' = [Label] -> [Label] -> DominatorSet -> DominatorSet
    commonPrefix (DominatorSet -> [Label] -> [Label]
    revDoms DominatorSet
    ds []) (DominatorSet -> [Label] -> [Label]
    revDoms DominatorSet
    ds' []) DominatorSet
    EntryNode
      where revDoms :: DominatorSet -> [Label] -> [Label]
    revDoms DominatorSet
    EntryNode [Label]
    prev = [Label]
    prev
            revDoms (ImmediateDominator Label
    lbl DominatorSet
    doms) [Label]
    prev = DominatorSet -> [Label] -> [Label]
    revDoms DominatorSet
    doms (Label
    lblLabel -> [Label] -> [Label]
    forall a. a -> [a] -> [a]
    :[Label]
    prev)
            commonPrefix :: [Label] -> [Label] -> DominatorSet -> DominatorSet
    commonPrefix (Label
    a:[Label]
    as) (Label
    b:[Label]
    bs) DominatorSet
    doms
                | Label
    a Label -> Label -> Bool
    forall a. Eq a => a -> a -> Bool
    == Label
    b = [Label] -> [Label] -> DominatorSet -> DominatorSet
    commonPrefix [Label]
    as [Label]
    bs (Label -> DominatorSet -> DominatorSet
    ImmediateDominator Label
    a DominatorSet
    doms)
            commonPrefix [Label]
    _ [Label]
    _ DominatorSet
    doms = DominatorSet
    doms

    -- | The result of dominator analysis.  Also includes a reverse
    -- postorder numbering, which is needed for dominator analysis
    -- and for other (downstream) analyses.
    --
    -- Invariant: Dominators, graph, and RP numberings include only *reachable* blocks.
    data GraphWithDominators node =
        GraphWithDominators { forall (node :: Extensibility -> Extensibility -> *).
    GraphWithDominators node -> GenCmmGraph node
    gwd_graph :: GenCmmGraph node
                            , forall (node :: Extensibility -> Extensibility -> *).
    GraphWithDominators node -> LabelMap DominatorSet
    gwd_dominators :: LabelMap DominatorSet
                            , forall (node :: Extensibility -> Extensibility -> *).
    GraphWithDominators node -> LabelMap RPNum
    gwd_rpnumbering :: LabelMap RPNum
                            }

    -- | Call this function with a `CmmGraph` to get back the results of a
    -- dominator analysis of that graph (as well as a reverse postorder
    -- numbering).  The result also includes the subgraph of the original
    -- graph that contains only the reachable blocks.
    graphWithDominators :: forall node .
           (NonLocal node, HasDebugCallStack)
           => GenCmmGraph node
           -> GraphWithDominators node

    -- The implementation uses the Lengauer-Tarjan algorithm from the x86
    -- back end.

    -- Technically, we do not need Word64 here, however the dominators code
    -- has to accomodate Word64 for other uses.

    graphWithDominators :: forall (node :: Extensibility -> Extensibility -> *).
    (NonLocal node, HasDebugCallStack) =>
    GenCmmGraph node -> GraphWithDominators node
    graphWithDominators GenCmmGraph node
    g = GenCmmGraph node
    -> LabelMap DominatorSet
    -> LabelMap RPNum
    -> GraphWithDominators node
    forall (node :: Extensibility -> Extensibility -> *).
    GenCmmGraph node
    -> LabelMap DominatorSet
    -> LabelMap RPNum
    -> GraphWithDominators node
    GraphWithDominators ([Block node C C] -> GenCmmGraph node -> GenCmmGraph node
    forall (node :: Extensibility -> Extensibility -> *).
    NonLocal node =>
    [Block node C C] -> GenCmmGraph node -> GenCmmGraph node
    reachable [Block node C C]
    rpblocks GenCmmGraph node
    g) LabelMap DominatorSet
    dmap LabelMap RPNum
    rpmap
          where rpblocks :: [Block node C C]
    rpblocks = LabelMap (Block node C C) -> Label -> [Block node C C]
    forall (block :: Extensibility -> Extensibility -> *).
    NonLocal block =>
    LabelMap (block C C) -> Label -> [block C C]
    revPostorderFrom (GenCmmGraph node -> LabelMap (Block node C C)
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> LabelMap (Block n C C)
    graphMap GenCmmGraph node
    g) (GenCmmGraph node -> Label
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> Label
    g_entry GenCmmGraph node
    g)
                rplabels' :: [Label]
    rplabels' = (Block node C C -> Label) -> [Block node C C] -> [Label]
    forall a b. (a -> b) -> [a] -> [b]
    map Block node C C -> Label
    forall (x :: Extensibility). Block node C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel [Block node C C]
    rpblocks
                rplabels :: Array Word64 Label
                rplabels :: Array Word64 Label
    rplabels = (Word64, Word64) -> [Label] -> Array Word64 Label
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    (i, i) -> [e] -> a i e
    listArray (Word64, Word64)
    bounds [Label]
    rplabels'

                rpmap :: LabelMap RPNum
                rpmap :: LabelMap RPNum
    rpmap = [(Label, RPNum)] -> LabelMap RPNum
    forall v. [(Label, v)] -> LabelMap v
    mapFromList ([(Label, RPNum)] -> LabelMap RPNum)
    -> [(Label, RPNum)] -> LabelMap RPNum
    forall a b. (a -> b) -> a -> b
    $ (Block node C C -> Int -> (Label, RPNum))
    -> [Block node C C] -> [Int] -> [(Label, RPNum)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Block node C C -> Int -> (Label, RPNum)
    forall {thing :: Extensibility -> Extensibility -> *}
           {x :: Extensibility}.
    NonLocal thing =>
    thing C x -> Int -> (Label, RPNum)
    kvpair [Block node C C]
    rpblocks [Int
    0..]
                  where kvpair :: thing C x -> Int -> (Label, RPNum)
    kvpair thing C x
    block Int
    i = (thing C x -> Label
    forall (x :: Extensibility). thing C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel thing C x
    block, Int -> RPNum
    RPNum Int
    i)

                labelIndex :: Label -> Word64
                labelIndex :: Label -> Word64
    labelIndex = (Label -> LabelMap Word64 -> Word64)
    -> LabelMap Word64 -> Label -> Word64
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Label -> LabelMap Word64 -> Word64
    forall a. HasDebugCallStack => Label -> LabelMap a -> a
    findLabelIn LabelMap Word64
    imap
                  where imap :: LabelMap Word64
                        imap :: LabelMap Word64
    imap = [(Label, Word64)] -> LabelMap Word64
    forall v. [(Label, v)] -> LabelMap v
    mapFromList ([(Label, Word64)] -> LabelMap Word64)
    -> [(Label, Word64)] -> LabelMap Word64
    forall a b. (a -> b) -> a -> b
    $ [Label] -> [Word64] -> [(Label, Word64)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Label]
    rplabels' [Word64
    0..]
                blockIndex :: Block node C x -> Word64
    blockIndex = Label -> Word64
    labelIndex (Label -> Word64)
    -> (Block node C x -> Label) -> Block node C x -> Word64
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Block node C x -> Label
    forall (x :: Extensibility). Block node C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel

                bounds :: (Word64, Word64)
                bounds :: (Word64, Word64)
    bounds = (Word64
    0, HasCallStack => Int -> Word64
    Int -> Word64
    intToWord64 ([Block node C C] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Block node C C]
    rpblocks Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))

                ltGraph :: [Block node C C] -> LT.Graph
                ltGraph :: [Block node C C] -> Graph
    ltGraph [] = Graph
    forall a. Word64Map a
    WM.empty
                ltGraph (Block node C C
    block:[Block node C C]
    blocks) =
                    Word64 -> Word64Set -> Graph -> Graph
    forall a. Word64 -> a -> Word64Map a -> Word64Map a
    WM.insert
                          (Block node C C -> Word64
    forall {x :: Extensibility}. Block node C x -> Word64
    blockIndex Block node C C
    block)
                          ([Word64] -> Word64Set
    WS.fromList ([Word64] -> Word64Set) -> [Word64] -> Word64Set
    forall a b. (a -> b) -> a -> b
    $ (Label -> Word64) -> [Label] -> [Word64]
    forall a b. (a -> b) -> [a] -> [b]
    map Label -> Word64
    labelIndex ([Label] -> [Word64]) -> [Label] -> [Word64]
    forall a b. (a -> b) -> a -> b
    $ Block node C C -> [Label]
    forall (e :: Extensibility). Block node e C -> [Label]
    forall (thing :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    NonLocal thing =>
    thing e C -> [Label]
    successors Block node C C
    block)
                          ([Block node C C] -> Graph
    ltGraph [Block node C C]
    blocks)

                idom_array :: Array Word64 LT.Node
                idom_array :: Array Word64 Word64
    idom_array = (Word64, Word64) -> [(Word64, Word64)] -> Array Word64 Word64
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    (i, i) -> [(i, e)] -> a i e
    array (Word64, Word64)
    bounds ([(Word64, Word64)] -> Array Word64 Word64)
    -> [(Word64, Word64)] -> Array Word64 Word64
    forall a b. (a -> b) -> a -> b
    $ Rooted -> [(Word64, Word64)]
    LT.idom (Word64
    0, [Block node C C] -> Graph
    ltGraph [Block node C C]
    rpblocks)

                domSet :: Word64 -> DominatorSet
    domSet Word64
    0 = DominatorSet
    EntryNode
                domSet Word64
    i = Label -> DominatorSet -> DominatorSet
    ImmediateDominator (Array Word64 Label
    rplabels Array Word64 Label -> Word64 -> Label
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    ! Word64
    d) (Array Word64 DominatorSet
    doms Array Word64 DominatorSet -> Word64 -> DominatorSet
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    ! Word64
    d)
                    where d :: Word64
    d = Array Word64 Word64
    idom_array Array Word64 Word64 -> Word64 -> Word64
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    ! Word64
    i
                doms :: Array Word64 DominatorSet
    doms = (Word64, Word64)
    -> (Word64 -> DominatorSet) -> Array Word64 DominatorSet
    forall i e. Ix i => (i, i) -> (i -> e) -> Array i e
    tabulate (Word64, Word64)
    bounds Word64 -> DominatorSet
    domSet

                dmap :: LabelMap DominatorSet
    dmap = [(Label, DominatorSet)] -> LabelMap DominatorSet
    forall v. [(Label, v)] -> LabelMap v
    mapFromList ([(Label, DominatorSet)] -> LabelMap DominatorSet)
    -> [(Label, DominatorSet)] -> LabelMap DominatorSet
    forall a b. (a -> b) -> a -> b
    $ (Label -> Word64 -> (Label, DominatorSet))
    -> [Label] -> [Word64] -> [(Label, DominatorSet)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Label
    lbl Word64
    i -> (Label
    lbl, Word64 -> DominatorSet
    domSet Word64
    i)) [Label]
    rplabels' [Word64
    0..]

    reachable :: NonLocal node => [Block node C C] -> GenCmmGraph node -> GenCmmGraph node
    reachable :: forall (node :: Extensibility -> Extensibility -> *).
    NonLocal node =>
    [Block node C C] -> GenCmmGraph node -> GenCmmGraph node
    reachable [Block node C C]
    blocks GenCmmGraph node
    g = GenCmmGraph node
    g { g_graph = GMany NothingO blockmap NothingO }
      where blockmap :: Body' Block node
    blockmap = [(Label, Block node C C)] -> Body' Block node
    forall v. [(Label, v)] -> LabelMap v
    mapFromList [(Block node C C -> Label
    forall (x :: Extensibility). Block node C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel Block node C C
    b, Block node C C
    b) | Block node C C
    b <- [Block node C C]
    blocks]

    -- | =Utility functions

    -- | Call `graphMap` to get the mapping from `Label` to `Block` that
    -- is embedded in every `CmmGraph`.
    graphMap :: GenCmmGraph n -> LabelMap (Block n C C)
    graphMap :: forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> LabelMap (Block n C C)
    graphMap (CmmGraph { g_graph :: forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> Graph n C C
    g_graph = GMany MaybeO C (Block n O C)
    NothingO Body' Block n
    blockmap MaybeO C (Block n C O)
    NothingO }) = Body' Block n
    blockmap

    -- | Use `gwdRPNumber` on the result of the dominator analysis to get
    -- a mapping from the `Label` of each reachable block to the reverse
    -- postorder number of that block.
    gwdRPNumber :: HasDebugCallStack => GraphWithDominators node -> Label -> RPNum
    gwdRPNumber :: forall (node :: Extensibility -> Extensibility -> *).
    HasDebugCallStack =>
    GraphWithDominators node -> Label -> RPNum
    gwdRPNumber GraphWithDominators node
    g Label
    l = Label -> LabelMap RPNum -> RPNum
    forall a. HasDebugCallStack => Label -> LabelMap a -> a
    findLabelIn Label
    l (GraphWithDominators node -> LabelMap RPNum
    forall (node :: Extensibility -> Extensibility -> *).
    GraphWithDominators node -> LabelMap RPNum
    gwd_rpnumbering GraphWithDominators node
    g)

    findLabelIn :: HasDebugCallStack => Label -> LabelMap a -> a
    findLabelIn :: forall a. HasDebugCallStack => Label -> LabelMap a -> a
    findLabelIn Label
    lbl = a -> Label -> LabelMap a -> a
    forall a. a -> Label -> LabelMap a -> a
    mapFindWithDefault a
    failed Label
    lbl
      where failed :: a
    failed =
                String -> SDoc -> a
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "label not found in result of analysis" (Label -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Label
    lbl)

    -- | Use `gwdDominatorsOf` on the result of the dominator analysis to get
    -- a mapping from the `Label` of each reachable block to the dominator
    -- set (and the immediate dominator) of that block.  The
    -- implementation is space-efficient: intersecting dominator
    -- sets share the representation of their intersection.

    gwdDominatorsOf :: HasDebugCallStack => GraphWithDominators node -> Label -> DominatorSet
    gwdDominatorsOf :: forall (node :: Extensibility -> Extensibility -> *).
    HasDebugCallStack =>
    GraphWithDominators node -> Label -> DominatorSet
    gwdDominatorsOf GraphWithDominators node
    g Label
    lbl = Label -> LabelMap DominatorSet -> DominatorSet
    forall a. HasDebugCallStack => Label -> LabelMap a -> a
    findLabelIn Label
    lbl (GraphWithDominators node -> LabelMap DominatorSet
    forall (node :: Extensibility -> Extensibility -> *).
    GraphWithDominators node -> LabelMap DominatorSet
    gwd_dominators GraphWithDominators node
    g)

    gwdDominatorTree :: GraphWithDominators node -> Tree.Tree Label
    gwdDominatorTree :: forall (node :: Extensibility -> Extensibility -> *).
    GraphWithDominators node -> Tree Label
    gwdDominatorTree GraphWithDominators node
    gwd = Label -> Tree Label
    subtreeAt (GenCmmGraph node -> Label
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> Label
    g_entry (GraphWithDominators node -> GenCmmGraph node
    forall (node :: Extensibility -> Extensibility -> *).
    GraphWithDominators node -> GenCmmGraph node
    gwd_graph GraphWithDominators node
    gwd))
      where subtreeAt :: Label -> Tree Label
    subtreeAt Label
    label = Label -> [Tree Label] -> Tree Label
    forall a. a -> [Tree a] -> Tree a
    Tree.Node Label
    label ([Tree Label] -> Tree Label) -> [Tree Label] -> Tree Label
    forall a b. (a -> b) -> a -> b
    $ (Label -> Tree Label) -> [Label] -> [Tree Label]
    forall a b. (a -> b) -> [a] -> [b]
    map Label -> Tree Label
    subtreeAt ([Label] -> [Tree Label]) -> [Label] -> [Tree Label]
    forall a b. (a -> b) -> a -> b
    $ Label -> [Label]
    children Label
    label
            children :: Label -> [Label]
    children Label
    l = [Label] -> Label -> LabelMap [Label] -> [Label]
    forall a. a -> Label -> LabelMap a -> a
    mapFindWithDefault [] Label
    l LabelMap [Label]
    child_map
            child_map :: LabelMap [Label]
            child_map :: LabelMap [Label]
    child_map = (LabelMap [Label] -> Label -> DominatorSet -> LabelMap [Label])
    -> LabelMap [Label] -> LabelMap DominatorSet -> LabelMap [Label]
    forall t b. (t -> Label -> b -> t) -> t -> LabelMap b -> t
    mapFoldlWithKey LabelMap [Label] -> Label -> DominatorSet -> LabelMap [Label]
    forall {a}. LabelMap [a] -> a -> DominatorSet -> LabelMap [a]
    addParent LabelMap [Label]
    forall v. LabelMap v
    mapEmpty (LabelMap DominatorSet -> LabelMap [Label])
    -> LabelMap DominatorSet -> LabelMap [Label]
    forall a b. (a -> b) -> a -> b
    $ GraphWithDominators node -> LabelMap DominatorSet
    forall (node :: Extensibility -> Extensibility -> *).
    GraphWithDominators node -> LabelMap DominatorSet
    gwd_dominators GraphWithDominators node
    gwd
              where addParent :: LabelMap [a] -> a -> DominatorSet -> LabelMap [a]
    addParent LabelMap [a]
    cm a
    _ DominatorSet
    EntryNode = LabelMap [a]
    cm
                    addParent LabelMap [a]
    cm a
    lbl (ImmediateDominator Label
    p DominatorSet
    _) =
                        ([a] -> [a] -> [a]) -> Label -> [a] -> LabelMap [a] -> LabelMap [a]
    forall v. (v -> v -> v) -> Label -> v -> LabelMap v -> LabelMap v
    mapInsertWith [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++) Label
    p [a
    lbl] LabelMap [a]
    cm

    -- | Turn a function into an array.  Inspired by SML's `Array.tabulate`
    tabulate :: (Ix i) => (i, i) -> (i -> e) -> Array i e
    tabulate :: forall i e. Ix i => (i, i) -> (i -> e) -> Array i e
    tabulate (i, i)
    b i -> e
    f = (i, i) -> [e] -> Array i e
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    (i, i) -> [e] -> a i e
    listArray (i, i)
    b ([e] -> Array i e) -> [e] -> Array i e
    forall a b. (a -> b) -> a -> b
    $ (i -> e) -> [i] -> [e]
    forall a b. (a -> b) -> [a] -> [b]
    map i -> e
    f ([i] -> [e]) -> [i] -> [e]
    forall a b. (a -> b) -> a -> b
    $ (i, i) -> [i]
    forall a. Ix a => (a, a) -> [a]
    range (i, i)
    b