    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE MultiParamTypeClasses #-}

    {-|
    Module      : GHC.Cmm.Reducibility
    Description : Tell if a `CmmGraph` is reducible, or make it so

    Test a Cmm control-flow graph for reducibility.  And provide a
    function that, when given an arbitrary control-flow graph, returns an
    equivalent, reducible control-flow graph.  The equivalent graph is
    obtained by "splitting" (copying) nodes of the original graph.
    The resulting equivalent graph has the same dynamic behavior as the
    original, but it is larger.

    Documentation uses the language of control-flow analysis, in which a
    basic block is called a "node."  These "nodes" are `CmmBlock`s or
    equivalent; they have nothing to do with a `CmmNode`.

    For more on reducibility and related analyses and algorithms, see
    Note [Reducibility resources]
    -}

    module GHC.Cmm.Reducibility
      ( Reducibility(..)
      , reducibility

      , asReducible
      )
    where

    import GHC.Prelude hiding (splitAt, succ)

    import Control.Monad
    import Data.List (nub)
    import Data.Maybe
    import Data.Semigroup
    import qualified Data.Sequence as Seq

    import GHC.Cmm
    import GHC.Cmm.BlockId
    import GHC.Cmm.Dataflow
    import GHC.Cmm.Dataflow.Block
    import GHC.Cmm.Dominators
    import GHC.Cmm.Dataflow.Graph hiding (addBlock)
    import GHC.Cmm.Dataflow.Label
    import GHC.Data.Graph.Collapse
    import GHC.Data.Graph.Inductive.Graph
    import GHC.Data.Graph.Inductive.PatriciaTree
    import GHC.Types.Unique.Supply
    import GHC.Utils.Panic

    -- | Represents the result of a reducibility analysis.
    data Reducibility = Reducible | Irreducible
      deriving (Reducibility -> Reducibility -> Bool
    (Reducibility -> Reducibility -> Bool)
    -> (Reducibility -> Reducibility -> Bool) -> Eq Reducibility
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Reducibility -> Reducibility -> Bool
    == :: Reducibility -> Reducibility -> Bool
    $c/= :: Reducibility -> Reducibility -> Bool
    /= :: Reducibility -> Reducibility -> Bool
    Eq, Int -> Reducibility -> ShowS
    [Reducibility] -> ShowS
    Reducibility -> String
    (Int -> Reducibility -> ShowS)
    -> (Reducibility -> String)
    -> ([Reducibility] -> ShowS)
    -> Show Reducibility
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Reducibility -> ShowS
    showsPrec :: Int -> Reducibility -> ShowS
    $cshow :: Reducibility -> String
    show :: Reducibility -> String
    $cshowList :: [Reducibility] -> ShowS
    showList :: [Reducibility] -> ShowS
    Show)

    -- | Given a graph, say whether the graph is reducible.  The graph must
    -- be bundled with a dominator analysis and a reverse postorder
    -- numbering, as these results are needed to perform the test.

    reducibility :: NonLocal node
                 => GraphWithDominators node
                 -> Reducibility
    reducibility :: forall (node :: Extensibility -> Extensibility -> *).
    NonLocal node =>
    GraphWithDominators node -> Reducibility
    reducibility GraphWithDominators node
    gwd =
        if (Block node C C -> Bool) -> LabelMap (Block node C C) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Block node C C -> Bool
    goodBlock LabelMap (Block node C C)
    blockmap then Reducibility
    Reducible else Reducibility
    Irreducible
      where goodBlock :: Block node C C -> Bool
    goodBlock Block node C C
    b = (Label -> Bool) -> [Label] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Label -> Label -> Bool
    goodEdge (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 -> [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
    b)
            goodEdge :: Label -> Label -> Bool
    goodEdge Label
    from Label
    to = Label -> RPNum
    rpnum Label
    to RPNum -> RPNum -> Bool
    forall a. Ord a => a -> a -> Bool
    > Label -> RPNum
    rpnum Label
    from Bool -> Bool -> Bool
    || Label
    to Label -> Label -> Bool
    `dominates` Label
    from
            rpnum :: Label -> RPNum
    rpnum = GraphWithDominators node -> Label -> RPNum
    forall (node :: Extensibility -> Extensibility -> *).
    HasDebugCallStack =>
    GraphWithDominators node -> Label -> RPNum
    gwdRPNumber GraphWithDominators node
    gwd
            blockmap :: LabelMap (Block node C C)
    blockmap = GenCmmGraph node -> LabelMap (Block node C C)
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> LabelMap (Block n C C)
    graphMap (GenCmmGraph node -> LabelMap (Block node C C))
    -> GenCmmGraph node -> LabelMap (Block node C C)
    forall a b. (a -> b) -> a -> b
    $ GraphWithDominators node -> GenCmmGraph node
    forall (node :: Extensibility -> Extensibility -> *).
    GraphWithDominators node -> GenCmmGraph node
    gwd_graph GraphWithDominators node
    gwd
            dominators :: Label -> DominatorSet
    dominators = GraphWithDominators node -> Label -> DominatorSet
    forall (node :: Extensibility -> Extensibility -> *).
    HasDebugCallStack =>
    GraphWithDominators node -> Label -> DominatorSet
    gwdDominatorsOf GraphWithDominators node
    gwd
            dominates :: Label -> Label -> Bool
    dominates Label
    lbl Label
    blockname =
                Label
    lbl Label -> Label -> Bool
    forall a. Eq a => a -> a -> Bool
    == Label
    blockname Bool -> Bool -> Bool
    || Label -> DominatorSet -> Bool
    dominatorsMember Label
    lbl (Label -> DominatorSet
    dominators Label
    blockname)

    -- | Given a graph, return an equivalent reducible graph, by
    -- "splitting" (copying) nodes if necessary.  The input
    -- graph must be bundled with a dominator analysis and a reverse
    -- postorder numbering.  The computation is monadic because when a
    -- node is split, the new copy needs a fresh label.
    --
    -- Use this function whenever a downstream algorithm needs a reducible
    -- control-flow graph.

    asReducible :: GraphWithDominators CmmNode
                -> UniqSM (GraphWithDominators CmmNode)
    asReducible :: GraphWithDominators CmmNode -> UniqSM (GraphWithDominators CmmNode)
    asReducible GraphWithDominators CmmNode
    gwd = case GraphWithDominators CmmNode -> Reducibility
    forall (node :: Extensibility -> Extensibility -> *).
    NonLocal node =>
    GraphWithDominators node -> Reducibility
    reducibility GraphWithDominators CmmNode
    gwd of
                        Reducibility
    Reducible -> GraphWithDominators CmmNode -> UniqSM (GraphWithDominators CmmNode)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return GraphWithDominators CmmNode
    gwd
                        Reducibility
    Irreducible -> GraphWithDominators CmmNode -> GraphWithDominators CmmNode
    assertReducible (GraphWithDominators CmmNode -> GraphWithDominators CmmNode)
    -> UniqSM (GraphWithDominators CmmNode)
    -> UniqSM (GraphWithDominators CmmNode)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> GraphWithDominators CmmNode -> UniqSM (GraphWithDominators CmmNode)
    nodeSplit GraphWithDominators CmmNode
    gwd

    assertReducible :: GraphWithDominators CmmNode -> GraphWithDominators CmmNode
    assertReducible :: GraphWithDominators CmmNode -> GraphWithDominators CmmNode
    assertReducible GraphWithDominators CmmNode
    gwd = case GraphWithDominators CmmNode -> Reducibility
    forall (node :: Extensibility -> Extensibility -> *).
    NonLocal node =>
    GraphWithDominators node -> Reducibility
    reducibility GraphWithDominators CmmNode
    gwd of
                            Reducibility
    Reducible -> GraphWithDominators CmmNode
    gwd
                            Reducibility
    Irreducible -> String -> GraphWithDominators CmmNode
    forall a. HasCallStack => String -> a
    panic String
    "result not reducible"

    ----------------------------------------------------------------

    -- | Split one or more nodes of the given graph, which must be
    -- irreducible.

    nodeSplit :: GraphWithDominators CmmNode
              -> UniqSM (GraphWithDominators CmmNode)
    nodeSplit :: GraphWithDominators CmmNode -> UniqSM (GraphWithDominators CmmNode)
    nodeSplit GraphWithDominators CmmNode
    gwd =
        GenCmmGraph CmmNode -> GraphWithDominators CmmNode
    forall (node :: Extensibility -> Extensibility -> *).
    (NonLocal node, HasDebugCallStack) =>
    GenCmmGraph node -> GraphWithDominators node
    graphWithDominators (GenCmmGraph CmmNode -> GraphWithDominators CmmNode)
    -> (Gr CmmSuper () -> GenCmmGraph CmmNode)
    -> Gr CmmSuper ()
    -> GraphWithDominators CmmNode
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Label -> Gr CmmSuper () -> GenCmmGraph CmmNode
    inflate (GenCmmGraph CmmNode -> Label
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> Label
    g_entry GenCmmGraph CmmNode
    g) (Gr CmmSuper () -> GraphWithDominators CmmNode)
    -> UniqSM (Gr CmmSuper ()) -> UniqSM (GraphWithDominators CmmNode)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NullCollapseViz (Gr CmmSuper ()) -> UniqSM (Gr CmmSuper ())
    forall a. NullCollapseViz a -> UniqSM a
    runNullCollapse NullCollapseViz (Gr CmmSuper ())
    collapsed
      where g :: GenCmmGraph CmmNode
    g = GraphWithDominators CmmNode -> GenCmmGraph CmmNode
    forall (node :: Extensibility -> Extensibility -> *).
    GraphWithDominators node -> GenCmmGraph node
    gwd_graph GraphWithDominators CmmNode
    gwd
            collapsed :: NullCollapseViz (Gr CmmSuper ())
            collapsed :: NullCollapseViz (Gr CmmSuper ())
    collapsed = Gr CmmSuper () -> NullCollapseViz (Gr CmmSuper ())
    forall (gr :: * -> * -> *) s (m :: * -> *).
    (DynGraph gr, Supernode s m, VizCollapseMonad m gr s) =>
    gr s () -> m (gr s ())
    collapseInductiveGraph (GenCmmGraph CmmNode -> Gr CmmSuper ()
    cgraphOfCmm GenCmmGraph CmmNode
    g)

    type CGraph = Gr CmmSuper ()

    -- | Turn a collapsed supernode back into a control-flow graph
    inflate :: Label -> CGraph -> CmmGraph
    inflate :: Label -> Gr CmmSuper () -> GenCmmGraph CmmNode
    inflate Label
    entry Gr CmmSuper ()
    cg = Label -> Graph CmmNode C C -> GenCmmGraph CmmNode
    forall (n :: Extensibility -> Extensibility -> *).
    Label -> Graph n C C -> GenCmmGraph n
    CmmGraph Label
    entry Graph CmmNode C C
    graph
      where graph :: Graph CmmNode C C
    graph = MaybeO C (Block CmmNode O C)
    -> Body' Block CmmNode
    -> MaybeO C (Block CmmNode C O)
    -> Graph CmmNode C C
    forall (e :: Extensibility)
           (block :: (Extensibility -> Extensibility -> *)
                     -> Extensibility -> Extensibility -> *)
           (n :: Extensibility -> Extensibility -> *) (x :: Extensibility).
    MaybeO e (block n O C)
    -> Body' block n -> MaybeO x (block n C O) -> Graph' block n e x
    GMany MaybeO C (Block CmmNode O C)
    forall t. MaybeO C t
    NothingO Body' Block CmmNode
    body MaybeO C (Block CmmNode C O)
    forall t. MaybeO C t
    NothingO
            body :: LabelMap CmmBlock
            body :: Body' Block CmmNode
    body = (Body' Block CmmNode -> CmmBlock -> Body' Block CmmNode)
    -> Body' Block CmmNode -> Seq CmmBlock -> Body' Block CmmNode
    forall b a. (b -> a -> b) -> b -> Seq a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\Body' Block CmmNode
    map CmmBlock
    block -> Label -> CmmBlock -> Body' Block CmmNode -> Body' Block CmmNode
    forall v. Label -> v -> LabelMap v -> LabelMap v
    mapInsert (CmmBlock -> Label
    forall (x :: Extensibility). Block CmmNode C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel CmmBlock
    block) CmmBlock
    block Body' Block CmmNode
    map) Body' Block CmmNode
    forall v. LabelMap v
    mapEmpty (Seq CmmBlock -> Body' Block CmmNode)
    -> Seq CmmBlock -> Body' Block CmmNode
    forall a b. (a -> b) -> a -> b
    $
                   CmmSuper -> Seq CmmBlock
    blocks CmmSuper
    super
            super :: CmmSuper
    super = case Gr CmmSuper () -> [LNode CmmSuper]
    forall a b. Gr a b -> [LNode a]
    forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
    labNodes Gr CmmSuper ()
    cg of
                      [(Int
    _, CmmSuper
    s)] -> CmmSuper
    s
                      [LNode CmmSuper]
    _ -> String -> CmmSuper
    forall a. HasCallStack => String -> a
    panic String
    "graph given to `inflate` is not singleton"

    -- | Convert a `CmmGraph` into an inductive graph.
    -- (The function coalesces duplicate edges into a single edge.)
    cgraphOfCmm :: CmmGraph -> CGraph
    cgraphOfCmm :: GenCmmGraph CmmNode -> Gr CmmSuper ()
    cgraphOfCmm GenCmmGraph CmmNode
    g = (Gr CmmSuper () -> (Int, CmmBlock) -> Gr CmmSuper ())
    -> Gr CmmSuper () -> [(Int, CmmBlock)] -> Gr CmmSuper ()
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Gr CmmSuper () -> (Int, CmmBlock) -> Gr CmmSuper ()
    addSuccEdges ([LNode CmmSuper] -> [LEdge ()] -> Gr CmmSuper ()
    forall a b. [LNode a] -> [LEdge b] -> Gr a b
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    [LNode a] -> [LEdge b] -> gr a b
    mkGraph [LNode CmmSuper]
    cnodes []) [(Int, CmmBlock)]
    blocks
       where blocks :: [(Int, CmmBlock)]
    blocks = [Int] -> [CmmBlock] -> [(Int, CmmBlock)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] ([CmmBlock] -> [(Int, CmmBlock)])
    -> [CmmBlock] -> [(Int, CmmBlock)]
    forall a b. (a -> b) -> a -> b
    $ Body' Block CmmNode -> Label -> [CmmBlock]
    forall (block :: Extensibility -> Extensibility -> *).
    NonLocal block =>
    LabelMap (block C C) -> Label -> [block C C]
    revPostorderFrom (GenCmmGraph CmmNode -> Body' Block CmmNode
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> LabelMap (Block n C C)
    graphMap GenCmmGraph CmmNode
    g) (GenCmmGraph CmmNode -> Label
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> Label
    g_entry GenCmmGraph CmmNode
    g)
             cnodes :: [LNode CmmSuper]
    cnodes = [(Int
    k, CmmBlock -> CmmSuper
    super CmmBlock
    block) | (Int
    k, CmmBlock
    block) <- [(Int, CmmBlock)]
    blocks]
              where super :: CmmBlock -> CmmSuper
    super CmmBlock
    block = Label -> Seq CmmBlock -> CmmSuper
    Nodes (CmmBlock -> Label
    forall (x :: Extensibility). Block CmmNode C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel CmmBlock
    block) (CmmBlock -> Seq CmmBlock
    forall a. a -> Seq a
    Seq.singleton CmmBlock
    block)
             labelNumber :: Label -> Int
    labelNumber = \Label
    lbl -> Maybe Int -> Int
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Label -> LabelMap Int -> Maybe Int
    forall a. Label -> LabelMap a -> Maybe a
    mapLookup Label
    lbl LabelMap Int
    numbers
                 where numbers :: LabelMap Int
                       numbers :: LabelMap Int
    numbers = [(Label, Int)] -> LabelMap Int
    forall v. [(Label, v)] -> LabelMap v
    mapFromList ([(Label, Int)] -> LabelMap Int) -> [(Label, Int)] -> LabelMap Int
    forall a b. (a -> b) -> a -> b
    $ ((Int, CmmBlock) -> (Label, Int))
    -> [(Int, CmmBlock)] -> [(Label, Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, CmmBlock) -> (Label, Int)
    forall {thing :: Extensibility -> Extensibility -> *} {b}
           {x :: Extensibility}.
    NonLocal thing =>
    (b, thing C x) -> (Label, b)
    swap [(Int, CmmBlock)]
    blocks
                       swap :: (b, thing C x) -> (Label, b)
    swap (b
    k, thing C x
    block) = (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, b
    k)
             addSuccEdges :: CGraph -> (Node, CmmBlock) -> CGraph
             addSuccEdges :: Gr CmmSuper () -> (Int, CmmBlock) -> Gr CmmSuper ()
    addSuccEdges Gr CmmSuper ()
    graph (Int
    k, CmmBlock
    block) =
                 [LEdge ()] -> Gr CmmSuper () -> Gr CmmSuper ()
    forall (gr :: * -> * -> *) b a.
    DynGraph gr =>
    [LEdge b] -> gr a b -> gr a b
    insEdges [(Int
    k, Label -> Int
    labelNumber Label
    lbl, ()) | Label
    lbl <- [Label] -> [Label]
    forall a. Eq a => [a] -> [a]
    nub ([Label] -> [Label]) -> [Label] -> [Label]
    forall a b. (a -> b) -> a -> b
    $ CmmBlock -> [Label]
    forall (e :: Extensibility). Block CmmNode e C -> [Label]
    forall (thing :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    NonLocal thing =>
    thing e C -> [Label]
    successors CmmBlock
    block] Gr CmmSuper ()
    graph
    {-
    Note [Reducibility resources]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    *Flow Analysis of Computer Programs.* Matthew S. Hecht North Holland, 1977.
    Available to borrow from archive.org.

    Matthew S. Hecht and Jeffrey D. Ullman (1972).
    Flow Graph Reducibility. SIAM J. Comput., 1(2), 188–202.
    https://doi.org/10.1137/0201014

    Johan Janssen and Henk Corporaal. 1997. Making graphs reducible with
    controlled node splitting. ACM TOPLAS 19, 6 (Nov. 1997),
    1031–1052. DOI:https://doi.org/10.1145/267959.269971

    Sebastian Unger and Frank Mueller. 2002. Handling irreducible loops:
    optimized node splitting versus DJ-graphs. ACM TOPLAS 24, 4 (July
    2002), 299–333. https://doi.org/10.1145/567097.567098.  (This one
    contains the most detailed account of how the Hecht/Ullman algorithm
    is used to modify an actual control-flow graph.  But still not much detail.)

    https://rgrig.blogspot.com/2009/10/dtfloatleftclearleft-summary-of-some.html
     (Nice summary of useful facts)

    -}

    type Seq = Seq.Seq

    -- | A "supernode" contains a single-entry, multiple-exit, reducible subgraph.
    -- The entry point is the given label, and the block with that label
    -- dominates all the other blocks in the supernode.  When an entire
    -- graph is collapsed into a single supernode, the graph is reducible.
    -- More detail can be found in "GHC.Data.Graph.Collapse".

    data CmmSuper
        = Nodes { CmmSuper -> Label
    label :: Label
                , CmmSuper -> Seq CmmBlock
    blocks :: Seq CmmBlock
                }

    instance Semigroup CmmSuper where
      CmmSuper
    s <> :: CmmSuper -> CmmSuper -> CmmSuper
    <> CmmSuper
    s' = Label -> Seq CmmBlock -> CmmSuper
    Nodes (CmmSuper -> Label
    label CmmSuper
    s) (CmmSuper -> Seq CmmBlock
    blocks CmmSuper
    s Seq CmmBlock -> Seq CmmBlock -> Seq CmmBlock
    forall a. Semigroup a => a -> a -> a
    <> CmmSuper -> Seq CmmBlock
    blocks CmmSuper
    s')

    instance PureSupernode CmmSuper where
      superLabel :: CmmSuper -> Label
    superLabel = CmmSuper -> Label
    label
      mapLabels :: (Label -> Label) -> CmmSuper -> CmmSuper
    mapLabels = (Label -> Label) -> CmmSuper -> CmmSuper
    changeLabels

    instance Supernode CmmSuper NullCollapseViz where
      freshen :: CmmSuper -> NullCollapseViz CmmSuper
    freshen CmmSuper
    s = UniqSM CmmSuper -> NullCollapseViz CmmSuper
    forall a. UniqSM a -> NullCollapseViz a
    forall (m :: * -> *) a. MonadUniqSM m => UniqSM a -> m a
    liftUniqSM (UniqSM CmmSuper -> NullCollapseViz CmmSuper)
    -> UniqSM CmmSuper -> NullCollapseViz CmmSuper
    forall a b. (a -> b) -> a -> b
    $ CmmSuper -> UniqSM CmmSuper
    relabel CmmSuper
    s

    -- | Return all labels defined within a supernode.
    definedLabels :: CmmSuper -> Seq Label
    definedLabels :: CmmSuper -> Seq Label
    definedLabels = (CmmBlock -> Label) -> Seq CmmBlock -> Seq Label
    forall a b. (a -> b) -> Seq a -> Seq b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap CmmBlock -> Label
    forall (x :: Extensibility). Block CmmNode C x -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel (Seq CmmBlock -> Seq Label)
    -> (CmmSuper -> Seq CmmBlock) -> CmmSuper -> Seq Label
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmSuper -> Seq CmmBlock
    blocks

    -- | Map the given function over every use and definition of a label
    -- in the given supernode.
    changeLabels :: (Label -> Label) -> (CmmSuper -> CmmSuper)
    changeLabels :: (Label -> Label) -> CmmSuper -> CmmSuper
    changeLabels Label -> Label
    f (Nodes Label
    l Seq CmmBlock
    blocks) = Label -> Seq CmmBlock -> CmmSuper
    Nodes (Label -> Label
    f Label
    l) ((CmmBlock -> CmmBlock) -> Seq CmmBlock -> Seq CmmBlock
    forall a b. (a -> b) -> Seq a -> Seq b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Label -> Label) -> CmmBlock -> CmmBlock
    changeBlockLabels Label -> Label
    f) Seq CmmBlock
    blocks)

    -- | Map the given function over every use and definition of a label
    -- in the given block.
    changeBlockLabels :: (Label -> Label) -> CmmBlock -> CmmBlock
    changeBlockLabels :: (Label -> Label) -> CmmBlock -> CmmBlock
    changeBlockLabels Label -> Label
    f CmmBlock
    block = CmmNode C O -> Block CmmNode O O -> CmmNode O C -> CmmBlock
    forall (n :: Extensibility -> Extensibility -> *).
    n C O -> Block n O O -> n O C -> Block n C C
    blockJoin CmmNode C O
    entry' Block CmmNode O O
    middle CmmNode O C
    exit'
      where (CmmNode C O
    entry, Block CmmNode O O
    middle, CmmNode O C
    exit) = CmmBlock -> (CmmNode C O, Block CmmNode O O, CmmNode O C)
    forall (n :: Extensibility -> Extensibility -> *).
    Block n C C -> (n C O, Block n O O, n O C)
    blockSplit CmmBlock
    block
            entry' :: CmmNode C O
    entry' = let CmmEntry Label
    l CmmTickScope
    scope = CmmNode C O
    entry
                     in  Label -> CmmTickScope -> CmmNode C O
    CmmEntry (Label -> Label
    f Label
    l) CmmTickScope
    scope
            exit' :: CmmNode O C
    exit' = case CmmNode O C
    exit of
                      -- unclear why mapSuccessors doesn't touch these
                      CmmCall { cml_cont :: CmmNode O C -> Maybe Label
    cml_cont = Just Label
    l } -> CmmNode O C
    exit { cml_cont = Just (f l) }
                      CmmForeignCall { succ :: CmmNode O C -> Label
    succ = Label
    l } -> CmmNode O C
    exit { succ = f l }
                      CmmNode O C
    _ -> (Label -> Label) -> CmmNode O C -> CmmNode O C
    mapSuccessors Label -> Label
    f CmmNode O C
    exit

    -- | Within the given supernode, replace every defined label (and all
    -- of its uses) with a fresh label.

    relabel :: CmmSuper -> UniqSM CmmSuper
    relabel :: CmmSuper -> UniqSM CmmSuper
    relabel CmmSuper
    node = do
         finite_map <- (LabelMap Label -> Label -> UniqSM (LabelMap Label))
    -> LabelMap Label -> Seq Label -> UniqSM (LabelMap Label)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM LabelMap Label -> Label -> UniqSM (LabelMap Label)
    addPair LabelMap Label
    forall v. LabelMap v
    mapEmpty (Seq Label -> UniqSM (LabelMap Label))
    -> Seq Label -> UniqSM (LabelMap Label)
    forall a b. (a -> b) -> a -> b
    $ CmmSuper -> Seq Label
    definedLabels CmmSuper
    node
         return $ changeLabels (labelChanger finite_map) node
      where addPair :: LabelMap Label -> Label -> UniqSM (LabelMap Label)
            addPair :: LabelMap Label -> Label -> UniqSM (LabelMap Label)
    addPair LabelMap Label
    map Label
    old = do new <- UniqSM Label
    forall (m :: * -> *). MonadUnique m => m Label
    newBlockId
                                 return $ mapInsert old new map
            labelChanger :: LabelMap Label -> (Label -> Label)
            labelChanger :: LabelMap Label -> Label -> Label
    labelChanger LabelMap Label
    mapping = \Label
    lbl -> Label -> Label -> LabelMap Label -> Label
    forall a. a -> Label -> LabelMap a -> a
    mapFindWithDefault Label
    lbl Label
    lbl LabelMap Label
    mapping