    {-# LANGUAGE TypeFamilies #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

    -----------------------------------------------------------------------------
    --
    -- The register liveness determinator
    --
    -- (c) The University of Glasgow 2004-2013
    --
    -----------------------------------------------------------------------------

    module GHC.CmmToAsm.Reg.Liveness (
            RegSet,
            RegMap, emptyRegMap,
            BlockMap, mapEmpty,
            LiveCmmDecl,
            InstrSR   (..),
            LiveInstr (..),
            Liveness (..),
            LiveInfo (..),
            LiveBasicBlock,

            mapBlockTop,    mapBlockTopM,   mapSCCM,
            mapGenBlockTop, mapGenBlockTopM,
            mapLiveCmmDecl, pprLiveCmmDecl,
            stripLive,
            stripLiveBlock,
            slurpConflicts,
            slurpReloadCoalesce,
            eraseDeltasLive,
            patchEraseLive,
            patchRegsLiveInstr,
            reverseBlocksInTops,
            regLiveness,
            cmmTopLiveness
      ) where
    import GHC.Prelude

    import GHC.Platform.Reg
    import GHC.CmmToAsm.Instr
    import GHC.CmmToAsm.CFG
    import GHC.CmmToAsm.Config
    import GHC.CmmToAsm.Types
    import GHC.CmmToAsm.Utils

    import GHC.Cmm.BlockId
    import GHC.Cmm.Dataflow.Label
    import GHC.Cmm hiding (RegSet, emptyRegSet)

    import GHC.Data.Graph.Directed
    import GHC.Utils.Monad
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Platform
    import GHC.Types.Unique.Set
    import GHC.Types.Unique.FM
    import GHC.Types.Unique.Supply
    import GHC.Data.Bag
    import GHC.Utils.Monad.State.Strict

    import Data.List (mapAccumL, partition)
    import Data.Maybe
    import Data.IntSet              (IntSet)

    -----------------------------------------------------------------------------
    type RegSet = UniqSet Reg

    -- | Map from some kind of register to a.
    --
    -- While we give the type for keys as Reg which is the common case
    -- sometimes we end up using VirtualReq or naked Uniques.
    -- See Note [UniqFM and the register allocator]
    type RegMap a = UniqFM Reg a

    emptyRegMap :: RegMap a
    emptyRegMap :: forall a. RegMap a
    emptyRegMap = UniqFM Reg a
    forall {k} (key :: k) elt. UniqFM key elt
    emptyUFM

    emptyRegSet :: RegSet
    emptyRegSet :: RegSet
    emptyRegSet = RegSet
    forall a. UniqSet a
    emptyUniqSet

    type BlockMap a = LabelMap a

    type SlotMap a = UniqFM Slot a

    type Slot = Int

    -- | A top level thing which carries liveness information.
    type LiveCmmDecl statics instr
            = GenCmmDecl
                    statics
                    LiveInfo
                    [SCC (LiveBasicBlock instr)]

    -- | The register allocator also wants to use SPILL/RELOAD meta instructions,
    --   so we'll keep those here.
    data InstrSR instr
            -- | A real machine instruction
            = Instr  instr

            -- | spill this reg to a stack slot
            | SPILL  Reg Int

            -- | reload this reg from a stack slot
            | RELOAD Int Reg

            deriving ((forall a b. (a -> b) -> InstrSR a -> InstrSR b)
    -> (forall a b. a -> InstrSR b -> InstrSR a) -> Functor InstrSR
    forall a b. a -> InstrSR b -> InstrSR a
    forall a b. (a -> b) -> InstrSR a -> InstrSR b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> InstrSR a -> InstrSR b
    fmap :: forall a b. (a -> b) -> InstrSR a -> InstrSR b
    $c<$ :: forall a b. a -> InstrSR b -> InstrSR a
    <$ :: forall a b. a -> InstrSR b -> InstrSR a
    Functor)

    instance Instruction instr => Instruction (InstrSR instr) where
            regUsageOfInstr :: Platform -> InstrSR instr -> RegUsage
    regUsageOfInstr Platform
    platform InstrSR instr
    i
             = case InstrSR instr
    i of
                    Instr  instr
    instr    -> Platform -> instr -> RegUsage
    forall instr. Instruction instr => Platform -> instr -> RegUsage
    regUsageOfInstr Platform
    platform instr
    instr
                    SPILL  Reg
    reg Int
    _    -> [Reg] -> [Reg] -> RegUsage
    RU [Reg
    reg] []
                    RELOAD Int
    _ Reg
    reg    -> [Reg] -> [Reg] -> RegUsage
    RU [] [Reg
    reg]

            patchRegsOfInstr :: InstrSR instr -> (Reg -> Reg) -> InstrSR instr
    patchRegsOfInstr InstrSR instr
    i Reg -> Reg
    f
             = case InstrSR instr
    i of
                    Instr instr
    instr     -> instr -> InstrSR instr
    forall instr. instr -> InstrSR instr
    Instr (instr -> (Reg -> Reg) -> instr
    forall instr. Instruction instr => instr -> (Reg -> Reg) -> instr
    patchRegsOfInstr instr
    instr Reg -> Reg
    f)
                    SPILL  Reg
    reg Int
    slot -> Reg -> Int -> InstrSR instr
    forall instr. Reg -> Int -> InstrSR instr
    SPILL (Reg -> Reg
    f Reg
    reg) Int
    slot
                    RELOAD Int
    slot Reg
    reg -> Int -> Reg -> InstrSR instr
    forall instr. Int -> Reg -> InstrSR instr
    RELOAD Int
    slot (Reg -> Reg
    f Reg
    reg)

            isJumpishInstr :: InstrSR instr -> Bool
    isJumpishInstr InstrSR instr
    i
             = case InstrSR instr
    i of
                    Instr instr
    instr     -> instr -> Bool
    forall instr. Instruction instr => instr -> Bool
    isJumpishInstr instr
    instr
                    InstrSR instr
    _               -> Bool
    False

            jumpDestsOfInstr :: InstrSR instr -> [BlockId]
    jumpDestsOfInstr InstrSR instr
    i
             = case InstrSR instr
    i of
                    Instr instr
    instr     -> instr -> [BlockId]
    forall instr. Instruction instr => instr -> [BlockId]
    jumpDestsOfInstr instr
    instr
                    InstrSR instr
    _               -> []

            patchJumpInstr :: InstrSR instr -> (BlockId -> BlockId) -> InstrSR instr
    patchJumpInstr InstrSR instr
    i BlockId -> BlockId
    f
             = case InstrSR instr
    i of
                    Instr instr
    instr     -> instr -> InstrSR instr
    forall instr. instr -> InstrSR instr
    Instr (instr -> (BlockId -> BlockId) -> instr
    forall instr.
    Instruction instr =>
    instr -> (BlockId -> BlockId) -> instr
    patchJumpInstr instr
    instr BlockId -> BlockId
    f)
                    InstrSR instr
    _               -> InstrSR instr
    i

            mkSpillInstr :: NCGConfig -> Reg -> Int -> Int -> [InstrSR instr]
    mkSpillInstr            = [Char] -> NCGConfig -> Reg -> Int -> Int -> [InstrSR instr]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "mkSpillInstr[InstrSR]: Not making SPILL meta-instr"
            mkLoadInstr :: NCGConfig -> Reg -> Int -> Int -> [InstrSR instr]
    mkLoadInstr             = [Char] -> NCGConfig -> Reg -> Int -> Int -> [InstrSR instr]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "mkLoadInstr[InstrSR]: Not making LOAD meta-instr"

            takeDeltaInstr :: InstrSR instr -> Maybe Int
    takeDeltaInstr InstrSR instr
    i
             = case InstrSR instr
    i of
                    Instr instr
    instr     -> instr -> Maybe Int
    forall instr. Instruction instr => instr -> Maybe Int
    takeDeltaInstr instr
    instr
                    InstrSR instr
    _               -> Maybe Int
    forall a. Maybe a
    Nothing

            isMetaInstr :: InstrSR instr -> Bool
    isMetaInstr InstrSR instr
    i
             = case InstrSR instr
    i of
                    Instr instr
    instr     -> instr -> Bool
    forall instr. Instruction instr => instr -> Bool
    isMetaInstr instr
    instr
                    InstrSR instr
    _               -> Bool
    False

            mkRegRegMoveInstr :: Platform -> Reg -> Reg -> InstrSR instr
    mkRegRegMoveInstr Platform
    platform Reg
    r1 Reg
    r2
                = instr -> InstrSR instr
    forall instr. instr -> InstrSR instr
    Instr (Platform -> Reg -> Reg -> instr
    forall instr. Instruction instr => Platform -> Reg -> Reg -> instr
    mkRegRegMoveInstr Platform
    platform Reg
    r1 Reg
    r2)

            takeRegRegMoveInstr :: InstrSR instr -> Maybe (Reg, Reg)
    takeRegRegMoveInstr InstrSR instr
    i
             = case InstrSR instr
    i of
                    Instr instr
    instr     -> instr -> Maybe (Reg, Reg)
    forall instr. Instruction instr => instr -> Maybe (Reg, Reg)
    takeRegRegMoveInstr instr
    instr
                    InstrSR instr
    _               -> Maybe (Reg, Reg)
    forall a. Maybe a
    Nothing

            mkJumpInstr :: BlockId -> [InstrSR instr]
    mkJumpInstr BlockId
    target      = (instr -> InstrSR instr) -> [instr] -> [InstrSR instr]
    forall a b. (a -> b) -> [a] -> [b]
    map instr -> InstrSR instr
    forall instr. instr -> InstrSR instr
    Instr (BlockId -> [instr]
    forall instr. Instruction instr => BlockId -> [instr]
    mkJumpInstr BlockId
    target)

            mkStackAllocInstr :: Platform -> Int -> [InstrSR instr]
    mkStackAllocInstr Platform
    platform Int
    amount =
                 instr -> InstrSR instr
    forall instr. instr -> InstrSR instr
    Instr (instr -> InstrSR instr) -> [instr] -> [InstrSR instr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Platform -> Int -> [instr]
    forall instr. Instruction instr => Platform -> Int -> [instr]
    mkStackAllocInstr Platform
    platform Int
    amount

            mkStackDeallocInstr :: Platform -> Int -> [InstrSR instr]
    mkStackDeallocInstr Platform
    platform Int
    amount =
                 instr -> InstrSR instr
    forall instr. instr -> InstrSR instr
    Instr (instr -> InstrSR instr) -> [instr] -> [InstrSR instr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Platform -> Int -> [instr]
    forall instr. Instruction instr => Platform -> Int -> [instr]
    mkStackDeallocInstr Platform
    platform Int
    amount

            pprInstr :: Platform -> InstrSR instr -> SDoc
    pprInstr Platform
    platform InstrSR instr
    i = InstrSR SDoc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ((instr -> SDoc) -> InstrSR instr -> InstrSR SDoc
    forall a b. (a -> b) -> InstrSR a -> InstrSR b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Platform -> instr -> SDoc
    forall instr. Instruction instr => Platform -> instr -> SDoc
    pprInstr Platform
    platform) InstrSR instr
    i)

            mkComment :: FastString -> [InstrSR instr]
    mkComment               = (instr -> InstrSR instr) -> [instr] -> [InstrSR instr]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap instr -> InstrSR instr
    forall instr. instr -> InstrSR instr
    Instr ([instr] -> [InstrSR instr])
    -> (FastString -> [instr]) -> FastString -> [InstrSR instr]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FastString -> [instr]
    forall instr. Instruction instr => FastString -> [instr]
    mkComment

    -- | An instruction with liveness information.
    data LiveInstr instr
            = LiveInstr (InstrSR instr) (Maybe Liveness)
            deriving ((forall a b. (a -> b) -> LiveInstr a -> LiveInstr b)
    -> (forall a b. a -> LiveInstr b -> LiveInstr a)
    -> Functor LiveInstr
    forall a b. a -> LiveInstr b -> LiveInstr a
    forall a b. (a -> b) -> LiveInstr a -> LiveInstr b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> LiveInstr a -> LiveInstr b
    fmap :: forall a b. (a -> b) -> LiveInstr a -> LiveInstr b
    $c<$ :: forall a b. a -> LiveInstr b -> LiveInstr a
    <$ :: forall a b. a -> LiveInstr b -> LiveInstr a
    Functor)

    -- | Liveness information.
    --   The regs which die are ones which are no longer live in the *next* instruction
    --   in this sequence.
    --   (NB. if the instruction is a jump, these registers might still be live
    --   at the jump target(s) - you have to check the liveness at the destination
    --   block to find out).

    data Liveness
            = Liveness
            { Liveness -> RegSet
    liveBorn      :: RegSet       -- ^ registers born in this instruction (written to for first time).
            , Liveness -> RegSet
    liveDieRead   :: RegSet       -- ^ registers that died because they were read for the last time.
            , Liveness -> RegSet
    liveDieWrite  :: RegSet }     -- ^ registers that died because they were clobbered by something.

    -- | Stash regs live on entry to each basic block in the info part of the cmm code.
    data LiveInfo
            = LiveInfo
                    (LabelMap RawCmmStatics)  -- cmm info table static stuff
                    [BlockId]                 -- entry points (first one is the
                                              -- entry point for the proc).
                    (BlockMap RegSet)         -- argument locals live on entry to this block
                    (BlockMap IntSet)         -- stack slots live on entry to this block

    -- | A basic block with liveness information.
    type LiveBasicBlock instr
            = GenBasicBlock (LiveInstr instr)

    instance Outputable instr
          => Outputable (InstrSR instr) where

            ppr :: InstrSR instr -> SDoc
    ppr (Instr instr
    realInstr)
               = instr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr instr
    realInstr

            ppr (SPILL Reg
    reg Int
    slot)
               = [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat [
                    [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "\tSPILL",
                    Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    ' ',
                    Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    reg,
                    SDoc
    forall doc. IsLine doc => doc
    comma,
                    [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "SLOT" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (Int -> SDoc
    forall doc. IsLine doc => Int -> doc
    int Int
    slot)]

            ppr (RELOAD Int
    slot Reg
    reg)
               = [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat [
                    [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "\tRELOAD",
                    Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    ' ',
                    [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "SLOT" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (Int -> SDoc
    forall doc. IsLine doc => Int -> doc
    int Int
    slot),
                    SDoc
    forall doc. IsLine doc => doc
    comma,
                    Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    reg]

    instance Outputable instr
          => Outputable (LiveInstr instr) where

            ppr :: LiveInstr instr -> SDoc
    ppr (LiveInstr InstrSR instr
    instr Maybe Liveness
    Nothing)
             = InstrSR instr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr InstrSR instr
    instr

            ppr (LiveInstr InstrSR instr
    instr (Just Liveness
    live))
             =  InstrSR instr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr InstrSR instr
    instr
                    SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ (Int -> SDoc -> SDoc
    nest Int
    8
                            (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat
                            [ SDoc -> RegSet -> SDoc
    pprRegs ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "# born:    ") (Liveness -> RegSet
    liveBorn Liveness
    live)
                            , SDoc -> RegSet -> SDoc
    pprRegs ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "# r_dying: ") (Liveness -> RegSet
    liveDieRead Liveness
    live)
                            , SDoc -> RegSet -> SDoc
    pprRegs ([Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "# w_dying: ") (Liveness -> RegSet
    liveDieWrite Liveness
    live) ]
                        SDoc -> SDoc -> SDoc
    $+$ SDoc
    forall doc. IsLine doc => doc
    space)

             where  pprRegs :: SDoc -> RegSet -> SDoc
                    pprRegs :: SDoc -> RegSet -> SDoc
    pprRegs SDoc
    name RegSet
    regs
                     | RegSet -> Bool
    forall a. UniqSet a -> Bool
    isEmptyUniqSet RegSet
    regs  = SDoc
    forall doc. IsOutput doc => doc
    empty
                     | Bool
    otherwise            = SDoc
    name SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <>
                         (UniqFM Reg Reg -> ([Reg] -> SDoc) -> SDoc
    forall {k} (key :: k) a. UniqFM key a -> ([a] -> SDoc) -> SDoc
    pprUFM (RegSet -> UniqFM Reg Reg
    forall a. UniqSet a -> UniqFM a a
    getUniqSet RegSet
    regs) ([SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hcat ([SDoc] -> SDoc) -> ([Reg] -> [SDoc]) -> [Reg] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> [SDoc] -> [SDoc]
    forall doc. IsLine doc => doc -> [doc] -> [doc]
    punctuate SDoc
    forall doc. IsLine doc => doc
    space ([SDoc] -> [SDoc]) -> ([Reg] -> [SDoc]) -> [Reg] -> [SDoc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Reg -> SDoc) -> [Reg] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr))

    instance OutputableP env instr => OutputableP env (LiveInstr instr) where
       pdoc :: env -> LiveInstr instr -> SDoc
    pdoc env
    env LiveInstr instr
    i = LiveInstr SDoc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ((instr -> SDoc) -> LiveInstr instr -> LiveInstr SDoc
    forall a b. (a -> b) -> LiveInstr a -> LiveInstr b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (env -> instr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc env
    env) LiveInstr instr
    i)

    instance OutputableP Platform LiveInfo where
        pdoc :: Platform -> LiveInfo -> SDoc
    pdoc Platform
    env (LiveInfo LabelMap RawCmmStatics
    mb_static [BlockId]
    entryIds BlockMap RegSet
    liveVRegsOnEntry BlockMap IntSet
    liveSlotsOnEntry)
            =  (Platform -> LabelMap RawCmmStatics -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    env LabelMap RawCmmStatics
    mb_static)
            SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "# entryIds         = " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [BlockId] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [BlockId]
    entryIds
            SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "# liveVRegsOnEntry = " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> BlockMap RegSet -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr BlockMap RegSet
    liveVRegsOnEntry
            SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "# liveSlotsOnEntry = " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text (BlockMap IntSet -> [Char]
    forall a. Show a => a -> [Char]
    show BlockMap IntSet
    liveSlotsOnEntry)

    -- | map a function across all the basic blocks in this code
    --
    mapBlockTop
            :: (LiveBasicBlock instr -> LiveBasicBlock instr)
            -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr

    mapBlockTop :: forall instr statics.
    (LiveBasicBlock instr -> LiveBasicBlock instr)
    -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
    mapBlockTop LiveBasicBlock instr -> LiveBasicBlock instr
    f LiveCmmDecl statics instr
    cmm
            = State () (LiveCmmDecl statics instr)
    -> () -> LiveCmmDecl statics instr
    forall s a. State s a -> s -> a
    evalState ((LiveBasicBlock instr -> State () (LiveBasicBlock instr))
    -> LiveCmmDecl statics instr
    -> State () (LiveCmmDecl statics instr)
    forall (m :: * -> *) instr statics.
    Monad m =>
    (LiveBasicBlock instr -> m (LiveBasicBlock instr))
    -> LiveCmmDecl statics instr -> m (LiveCmmDecl statics instr)
    mapBlockTopM (\LiveBasicBlock instr
    x -> LiveBasicBlock instr -> State () (LiveBasicBlock instr)
    forall a. a -> State () a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LiveBasicBlock instr -> State () (LiveBasicBlock instr))
    -> LiveBasicBlock instr -> State () (LiveBasicBlock instr)
    forall a b. (a -> b) -> a -> b
    $ LiveBasicBlock instr -> LiveBasicBlock instr
    f LiveBasicBlock instr
    x) LiveCmmDecl statics instr
    cmm) ()

    -- | map a function across all the basic blocks in this code (monadic version)
    --
    mapBlockTopM
            :: Monad m
            => (LiveBasicBlock instr -> m (LiveBasicBlock instr))
            -> LiveCmmDecl statics instr -> m (LiveCmmDecl statics instr)

    mapBlockTopM :: forall (m :: * -> *) instr statics.
    Monad m =>
    (LiveBasicBlock instr -> m (LiveBasicBlock instr))
    -> LiveCmmDecl statics instr -> m (LiveCmmDecl statics instr)
    mapBlockTopM LiveBasicBlock instr -> m (LiveBasicBlock instr)
    _ cmm :: LiveCmmDecl statics instr
    cmm@(CmmData{})
            = LiveCmmDecl statics instr -> m (LiveCmmDecl statics instr)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return LiveCmmDecl statics instr
    cmm

    mapBlockTopM LiveBasicBlock instr -> m (LiveBasicBlock instr)
    f (CmmProc LiveInfo
    header CLabel
    label [GlobalReg]
    live [SCC (LiveBasicBlock instr)]
    sccs)
     = do   sccs'   <- (SCC (LiveBasicBlock instr) -> m (SCC (LiveBasicBlock instr)))
    -> [SCC (LiveBasicBlock instr)] -> m [SCC (LiveBasicBlock instr)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((LiveBasicBlock instr -> m (LiveBasicBlock instr))
    -> SCC (LiveBasicBlock instr) -> m (SCC (LiveBasicBlock instr))
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SCC a -> m (SCC b)
    mapSCCM LiveBasicBlock instr -> m (LiveBasicBlock instr)
    f) [SCC (LiveBasicBlock instr)]
    sccs
            return  $ CmmProc header label live sccs'

    mapSCCM :: Monad m => (a -> m b) -> SCC a -> m (SCC b)
    mapSCCM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SCC a -> m (SCC b)
    mapSCCM a -> m b
    f (AcyclicSCC a
    x)
     = do   x'      <- a -> m b
    f a
    x
            return  $ AcyclicSCC x'

    mapSCCM a -> m b
    f (CyclicSCC [a]
    xs)
     = do   xs'     <- (a -> m b) -> [a] -> m [b]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM a -> m b
    f [a]
    xs
            return  $ CyclicSCC xs'

    -- map a function across all the basic blocks in this code
    mapGenBlockTop
            :: (GenBasicBlock             i -> GenBasicBlock            i)
            -> (GenCmmDecl d h (ListGraph i) -> GenCmmDecl d h (ListGraph i))

    mapGenBlockTop :: forall i d h.
    (GenBasicBlock i -> GenBasicBlock i)
    -> GenCmmDecl d h (ListGraph i) -> GenCmmDecl d h (ListGraph i)
    mapGenBlockTop GenBasicBlock i -> GenBasicBlock i
    f GenCmmDecl d h (ListGraph i)
    cmm
            = State () (GenCmmDecl d h (ListGraph i))
    -> () -> GenCmmDecl d h (ListGraph i)
    forall s a. State s a -> s -> a
    evalState ((GenBasicBlock i -> State () (GenBasicBlock i))
    -> GenCmmDecl d h (ListGraph i)
    -> State () (GenCmmDecl d h (ListGraph i))
    forall (m :: * -> *) i d h.
    Monad m =>
    (GenBasicBlock i -> m (GenBasicBlock i))
    -> GenCmmDecl d h (ListGraph i) -> m (GenCmmDecl d h (ListGraph i))
    mapGenBlockTopM (\GenBasicBlock i
    x -> GenBasicBlock i -> State () (GenBasicBlock i)
    forall a. a -> State () a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenBasicBlock i -> State () (GenBasicBlock i))
    -> GenBasicBlock i -> State () (GenBasicBlock i)
    forall a b. (a -> b) -> a -> b
    $ GenBasicBlock i -> GenBasicBlock i
    f GenBasicBlock i
    x) GenCmmDecl d h (ListGraph i)
    cmm) ()

    -- | map a function across all the basic blocks in this code (monadic version)
    mapGenBlockTopM
            :: Monad m
            => (GenBasicBlock            i  -> m (GenBasicBlock            i))
            -> (GenCmmDecl d h (ListGraph i) -> m (GenCmmDecl d h (ListGraph i)))

    mapGenBlockTopM :: forall (m :: * -> *) i d h.
    Monad m =>
    (GenBasicBlock i -> m (GenBasicBlock i))
    -> GenCmmDecl d h (ListGraph i) -> m (GenCmmDecl d h (ListGraph i))
    mapGenBlockTopM GenBasicBlock i -> m (GenBasicBlock i)
    _ cmm :: GenCmmDecl d h (ListGraph i)
    cmm@(CmmData{})
            = GenCmmDecl d h (ListGraph i) -> m (GenCmmDecl d h (ListGraph i))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return GenCmmDecl d h (ListGraph i)
    cmm

    mapGenBlockTopM GenBasicBlock i -> m (GenBasicBlock i)
    f (CmmProc h
    header CLabel
    label [GlobalReg]
    live (ListGraph [GenBasicBlock i]
    blocks))
     = do   blocks' <- (GenBasicBlock i -> m (GenBasicBlock i))
    -> [GenBasicBlock i] -> m [GenBasicBlock i]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM GenBasicBlock i -> m (GenBasicBlock i)
    f [GenBasicBlock i]
    blocks
            return  $ CmmProc header label live (ListGraph blocks')

    -- | Slurp out the list of register conflicts and reg-reg moves from this top level thing.
    --   Slurping of conflicts and moves is wrapped up together so we don't have
    --   to make two passes over the same code when we want to build the graph.
    --
    slurpConflicts
            :: Instruction instr
            => LiveCmmDecl statics instr
            -> (Bag (UniqSet Reg), Bag (Reg, Reg))

    slurpConflicts :: forall instr statics.
    Instruction instr =>
    LiveCmmDecl statics instr -> (Bag RegSet, Bag (Reg, Reg))
    slurpConflicts LiveCmmDecl statics instr
    live
            = (Bag RegSet, Bag (Reg, Reg))
    -> LiveCmmDecl statics instr -> (Bag RegSet, Bag (Reg, Reg))
    forall {t :: * -> *} {instr} {d}.
    (Foldable t, Instruction instr) =>
    (Bag RegSet, Bag (Reg, Reg))
    -> GenCmmDecl
         d LiveInfo (t (SCC (GenBasicBlock (LiveInstr instr))))
    -> (Bag RegSet, Bag (Reg, Reg))
    slurpCmm (Bag RegSet
    forall a. Bag a
    emptyBag, Bag (Reg, Reg)
    forall a. Bag a
    emptyBag) LiveCmmDecl statics instr
    live

     where  slurpCmm :: (Bag RegSet, Bag (Reg, Reg))
    -> GenCmmDecl
         d LiveInfo (t (SCC (GenBasicBlock (LiveInstr instr))))
    -> (Bag RegSet, Bag (Reg, Reg))
    slurpCmm   (Bag RegSet, Bag (Reg, Reg))
    rs  CmmData{}                = (Bag RegSet, Bag (Reg, Reg))
    rs
            slurpCmm   (Bag RegSet, Bag (Reg, Reg))
    rs (CmmProc LiveInfo
    info CLabel
    _ [GlobalReg]
    _ t (SCC (GenBasicBlock (LiveInstr instr)))
    sccs)
                    = ((Bag RegSet, Bag (Reg, Reg))
     -> SCC (GenBasicBlock (LiveInstr instr))
     -> (Bag RegSet, Bag (Reg, Reg)))
    -> (Bag RegSet, Bag (Reg, Reg))
    -> t (SCC (GenBasicBlock (LiveInstr instr)))
    -> (Bag RegSet, Bag (Reg, Reg))
    forall b a. (b -> a -> b) -> b -> t a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (LiveInfo
    -> (Bag RegSet, Bag (Reg, Reg))
    -> SCC (GenBasicBlock (LiveInstr instr))
    -> (Bag RegSet, Bag (Reg, Reg))
    forall {instr}.
    Instruction instr =>
    LiveInfo
    -> (Bag RegSet, Bag (Reg, Reg))
    -> SCC (GenBasicBlock (LiveInstr instr))
    -> (Bag RegSet, Bag (Reg, Reg))
    slurpSCC LiveInfo
    info) (Bag RegSet, Bag (Reg, Reg))
    rs t (SCC (GenBasicBlock (LiveInstr instr)))
    sccs

            slurpSCC :: LiveInfo
    -> (Bag RegSet, Bag (Reg, Reg))
    -> SCC (GenBasicBlock (LiveInstr instr))
    -> (Bag RegSet, Bag (Reg, Reg))
    slurpSCC  LiveInfo
    info (Bag RegSet, Bag (Reg, Reg))
    rs (AcyclicSCC GenBasicBlock (LiveInstr instr)
    b)
                    = LiveInfo
    -> (Bag RegSet, Bag (Reg, Reg))
    -> GenBasicBlock (LiveInstr instr)
    -> (Bag RegSet, Bag (Reg, Reg))
    forall {instr}.
    Instruction instr =>
    LiveInfo
    -> (Bag RegSet, Bag (Reg, Reg))
    -> GenBasicBlock (LiveInstr instr)
    -> (Bag RegSet, Bag (Reg, Reg))
    slurpBlock LiveInfo
    info (Bag RegSet, Bag (Reg, Reg))
    rs GenBasicBlock (LiveInstr instr)
    b

            slurpSCC  LiveInfo
    info (Bag RegSet, Bag (Reg, Reg))
    rs (CyclicSCC [GenBasicBlock (LiveInstr instr)]
    bs)
                    = ((Bag RegSet, Bag (Reg, Reg))
     -> GenBasicBlock (LiveInstr instr) -> (Bag RegSet, Bag (Reg, Reg)))
    -> (Bag RegSet, Bag (Reg, Reg))
    -> [GenBasicBlock (LiveInstr instr)]
    -> (Bag RegSet, Bag (Reg, Reg))
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl'  (LiveInfo
    -> (Bag RegSet, Bag (Reg, Reg))
    -> GenBasicBlock (LiveInstr instr)
    -> (Bag RegSet, Bag (Reg, Reg))
    forall {instr}.
    Instruction instr =>
    LiveInfo
    -> (Bag RegSet, Bag (Reg, Reg))
    -> GenBasicBlock (LiveInstr instr)
    -> (Bag RegSet, Bag (Reg, Reg))
    slurpBlock LiveInfo
    info) (Bag RegSet, Bag (Reg, Reg))
    rs [GenBasicBlock (LiveInstr instr)]
    bs

            slurpBlock :: LiveInfo
    -> (Bag RegSet, Bag (Reg, Reg))
    -> GenBasicBlock (LiveInstr instr)
    -> (Bag RegSet, Bag (Reg, Reg))
    slurpBlock LiveInfo
    info (Bag RegSet, Bag (Reg, Reg))
    rs (BasicBlock BlockId
    blockId [LiveInstr instr]
    instrs)
                    | LiveInfo LabelMap RawCmmStatics
    _ [BlockId]
    _ BlockMap RegSet
    blockLive BlockMap IntSet
    _        <- LiveInfo
    info
                    , Just RegSet
    rsLiveEntry                <- BlockId -> BlockMap RegSet -> Maybe RegSet
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    blockId BlockMap RegSet
    blockLive
                    , (Bag RegSet
    conflicts, Bag (Reg, Reg)
    moves)              <- RegSet
    -> (Bag RegSet, Bag (Reg, Reg))
    -> [LiveInstr instr]
    -> (Bag RegSet, Bag (Reg, Reg))
    forall {instr}.
    Instruction instr =>
    RegSet
    -> (Bag RegSet, Bag (Reg, Reg))
    -> [LiveInstr instr]
    -> (Bag RegSet, Bag (Reg, Reg))
    slurpLIs RegSet
    rsLiveEntry (Bag RegSet, Bag (Reg, Reg))
    rs [LiveInstr instr]
    instrs
                    = (RegSet -> Bag RegSet -> Bag RegSet
    forall a. a -> Bag a -> Bag a
    consBag RegSet
    rsLiveEntry Bag RegSet
    conflicts, Bag (Reg, Reg)
    moves)

                    | Bool
    otherwise
                    = [Char] -> (Bag RegSet, Bag (Reg, Reg))
    forall a. HasCallStack => [Char] -> a
    panic [Char]
    "Liveness.slurpConflicts: bad block"

            slurpLIs :: RegSet
    -> (Bag RegSet, Bag (Reg, Reg))
    -> [LiveInstr instr]
    -> (Bag RegSet, Bag (Reg, Reg))
    slurpLIs RegSet
    rsLive (Bag RegSet
    conflicts, Bag (Reg, Reg)
    moves) []
                    = (RegSet -> Bag RegSet -> Bag RegSet
    forall a. a -> Bag a -> Bag a
    consBag RegSet
    rsLive Bag RegSet
    conflicts, Bag (Reg, Reg)
    moves)

            slurpLIs RegSet
    rsLive (Bag RegSet, Bag (Reg, Reg))
    rs (LiveInstr InstrSR instr
    _ Maybe Liveness
    Nothing     : [LiveInstr instr]
    lis)
                    = RegSet
    -> (Bag RegSet, Bag (Reg, Reg))
    -> [LiveInstr instr]
    -> (Bag RegSet, Bag (Reg, Reg))
    slurpLIs RegSet
    rsLive (Bag RegSet, Bag (Reg, Reg))
    rs [LiveInstr instr]
    lis

            slurpLIs RegSet
    rsLiveEntry (Bag RegSet
    conflicts, Bag (Reg, Reg)
    moves) (LiveInstr InstrSR instr
    instr (Just Liveness
    live) : [LiveInstr instr]
    lis)
             = let
                    -- regs that die because they are read for the last time at the start of an instruction
                    --      are not live across it.
                    rsLiveAcross :: RegSet
    rsLiveAcross    = RegSet
    rsLiveEntry RegSet -> RegSet -> RegSet
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    `minusUniqSet` (Liveness -> RegSet
    liveDieRead Liveness
    live)

                    -- regs live on entry to the next instruction.
                    --      be careful of orphans, make sure to delete dying regs _after_ unioning
                    --      in the ones that are born here.
                    rsLiveNext :: RegSet
    rsLiveNext      = (RegSet
    rsLiveAcross RegSet -> RegSet -> RegSet
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    `unionUniqSets` (Liveness -> RegSet
    liveBorn     Liveness
    live))
                                                    RegSet -> RegSet -> RegSet
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    `minusUniqSet`  (Liveness -> RegSet
    liveDieWrite Liveness
    live)

                    -- orphan vregs are the ones that die in the same instruction they are born in.
                    --      these are likely to be results that are never used, but we still
                    --      need to assign a hreg to them..
                    rsOrphans :: RegSet
    rsOrphans       = RegSet -> RegSet -> RegSet
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    intersectUniqSets
                                            (Liveness -> RegSet
    liveBorn Liveness
    live)
                                            (RegSet -> RegSet -> RegSet
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    unionUniqSets (Liveness -> RegSet
    liveDieWrite Liveness
    live) (Liveness -> RegSet
    liveDieRead Liveness
    live))

                    --
                    rsConflicts :: RegSet
    rsConflicts     = RegSet -> RegSet -> RegSet
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    unionUniqSets RegSet
    rsLiveNext RegSet
    rsOrphans

              in    case InstrSR instr -> Maybe (Reg, Reg)
    forall instr. Instruction instr => instr -> Maybe (Reg, Reg)
    takeRegRegMoveInstr InstrSR instr
    instr of
                     Just (Reg, Reg)
    rr        -> RegSet
    -> (Bag RegSet, Bag (Reg, Reg))
    -> [LiveInstr instr]
    -> (Bag RegSet, Bag (Reg, Reg))
    slurpLIs RegSet
    rsLiveNext
                                            ( RegSet -> Bag RegSet -> Bag RegSet
    forall a. a -> Bag a -> Bag a
    consBag RegSet
    rsConflicts Bag RegSet
    conflicts
                                            , (Reg, Reg) -> Bag (Reg, Reg) -> Bag (Reg, Reg)
    forall a. a -> Bag a -> Bag a
    consBag (Reg, Reg)
    rr Bag (Reg, Reg)
    moves) [LiveInstr instr]
    lis

                     Maybe (Reg, Reg)
    Nothing        -> RegSet
    -> (Bag RegSet, Bag (Reg, Reg))
    -> [LiveInstr instr]
    -> (Bag RegSet, Bag (Reg, Reg))
    slurpLIs RegSet
    rsLiveNext
                                            ( RegSet -> Bag RegSet -> Bag RegSet
    forall a. a -> Bag a -> Bag a
    consBag RegSet
    rsConflicts Bag RegSet
    conflicts
                                            , Bag (Reg, Reg)
    moves) [LiveInstr instr]
    lis

    -- | For spill\/reloads
    --
    --   SPILL  v1, slot1
    --   ...
    --   RELOAD slot1, v2
    --
    --   If we can arrange that v1 and v2 are allocated to the same hreg it's more likely
    --   the spill\/reload instrs can be cleaned and replaced by a nop reg-reg move.
    --
    --
    slurpReloadCoalesce
            :: forall statics instr. Instruction instr
            => LiveCmmDecl statics instr
            -> Bag (Reg, Reg)

    slurpReloadCoalesce :: forall statics instr.
    Instruction instr =>
    LiveCmmDecl statics instr -> Bag (Reg, Reg)
    slurpReloadCoalesce LiveCmmDecl statics instr
    live
            = Bag (Reg, Reg) -> LiveCmmDecl statics instr -> Bag (Reg, Reg)
    forall t t1.
    Bag (Reg, Reg)
    -> GenCmmDecl t t1 [SCC (LiveBasicBlock instr)] -> Bag (Reg, Reg)
    slurpCmm Bag (Reg, Reg)
    forall a. Bag a
    emptyBag LiveCmmDecl statics instr
    live

     where
            slurpCmm :: Bag (Reg, Reg)
                     -> GenCmmDecl t t1 [SCC (LiveBasicBlock instr)]
                     -> Bag (Reg, Reg)
            slurpCmm :: forall t t1.
    Bag (Reg, Reg)
    -> GenCmmDecl t t1 [SCC (LiveBasicBlock instr)] -> Bag (Reg, Reg)
    slurpCmm Bag (Reg, Reg)
    cs CmmData{}   = Bag (Reg, Reg)
    cs
            slurpCmm Bag (Reg, Reg)
    cs (CmmProc t1
    _ CLabel
    _ [GlobalReg]
    _ [SCC (LiveBasicBlock instr)]
    sccs)
                    = Bag (Reg, Reg) -> [LiveBasicBlock instr] -> Bag (Reg, Reg)
    slurpComp Bag (Reg, Reg)
    cs ([SCC (LiveBasicBlock instr)] -> [LiveBasicBlock instr]
    forall a. [SCC a] -> [a]
    flattenSCCs [SCC (LiveBasicBlock instr)]
    sccs)

            slurpComp :: Bag (Reg, Reg)
                         -> [LiveBasicBlock instr]
                         -> Bag (Reg, Reg)
            slurpComp :: Bag (Reg, Reg) -> [LiveBasicBlock instr] -> Bag (Reg, Reg)
    slurpComp  Bag (Reg, Reg)
    cs [LiveBasicBlock instr]
    blocks
             = let  ([Bag (Reg, Reg)]
    moveBags, UniqFM BlockId [SlotMap Reg]
    _)   = State (UniqFM BlockId [SlotMap Reg]) [Bag (Reg, Reg)]
    -> UniqFM BlockId [SlotMap Reg]
    -> ([Bag (Reg, Reg)], UniqFM BlockId [SlotMap Reg])
    forall s a. State s a -> s -> (a, s)
    runState ([LiveBasicBlock instr]
    -> State (UniqFM BlockId [SlotMap Reg]) [Bag (Reg, Reg)]
    slurpCompM [LiveBasicBlock instr]
    blocks) UniqFM BlockId [SlotMap Reg]
    forall {k} (key :: k) elt. UniqFM key elt
    emptyUFM
               in   [Bag (Reg, Reg)] -> Bag (Reg, Reg)
    forall a. [Bag a] -> Bag a
    unionManyBags (Bag (Reg, Reg)
    cs Bag (Reg, Reg) -> [Bag (Reg, Reg)] -> [Bag (Reg, Reg)]
    forall a. a -> [a] -> [a]
    : [Bag (Reg, Reg)]
    moveBags)

            slurpCompM :: [LiveBasicBlock instr]
                       -> State (UniqFM BlockId [UniqFM Slot Reg]) [Bag (Reg, Reg)]
            slurpCompM :: [LiveBasicBlock instr]
    -> State (UniqFM BlockId [SlotMap Reg]) [Bag (Reg, Reg)]
    slurpCompM [LiveBasicBlock instr]
    blocks
             = do   -- run the analysis once to record the mapping across jumps.
                    (LiveBasicBlock instr
     -> State (UniqFM BlockId [SlotMap Reg]) (Bag (Reg, Reg)))
    -> [LiveBasicBlock instr]
    -> State (UniqFM BlockId [SlotMap Reg]) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_   (Bool
    -> LiveBasicBlock instr
    -> State (UniqFM BlockId [SlotMap Reg]) (Bag (Reg, Reg))
    slurpBlock Bool
    False) [LiveBasicBlock instr]
    blocks

                    -- run it a second time while using the information from the last pass.
                    --      We /could/ run this many more times to deal with graphical control
                    --      flow and propagating info across multiple jumps, but it's probably
                    --      not worth the trouble.
                    (LiveBasicBlock instr
     -> State (UniqFM BlockId [SlotMap Reg]) (Bag (Reg, Reg)))
    -> [LiveBasicBlock instr]
    -> State (UniqFM BlockId [SlotMap Reg]) [Bag (Reg, Reg)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM    (Bool
    -> LiveBasicBlock instr
    -> State (UniqFM BlockId [SlotMap Reg]) (Bag (Reg, Reg))
    slurpBlock Bool
    True) [LiveBasicBlock instr]
    blocks

            slurpBlock :: Bool -> LiveBasicBlock instr
                       -> State (UniqFM BlockId [UniqFM Slot Reg]) (Bag (Reg, Reg))
            slurpBlock :: Bool
    -> LiveBasicBlock instr
    -> State (UniqFM BlockId [SlotMap Reg]) (Bag (Reg, Reg))
    slurpBlock Bool
    propagate (BasicBlock BlockId
    blockId [LiveInstr instr]
    instrs)
             = do   -- grab the slot map for entry to this block
                    slotMap         <- if Bool
    propagate
                                            then BlockId -> State (UniqFM BlockId [SlotMap Reg]) (SlotMap Reg)
    forall {key}.
    Uniquable key =>
    key -> State (UniqFM key [SlotMap Reg]) (SlotMap Reg)
    getSlotMap BlockId
    blockId
                                            else SlotMap Reg -> State (UniqFM BlockId [SlotMap Reg]) (SlotMap Reg)
    forall a. a -> State (UniqFM BlockId [SlotMap Reg]) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return SlotMap Reg
    forall {k} (key :: k) elt. UniqFM key elt
    emptyUFM

                    (_, mMoves)     <- mapAccumLM slurpLI slotMap instrs
                    return $ listToBag $ catMaybes mMoves

            slurpLI :: SlotMap Reg                           -- current slotMap
                    -> LiveInstr instr
                    -> State (UniqFM BlockId [SlotMap Reg])  -- blockId -> [slot -> reg]
                                                            --      for tracking slotMaps across jumps

                             ( SlotMap Reg           -- new slotMap
                             , Maybe (Reg, Reg))            -- maybe a new coalesce edge

            slurpLI :: SlotMap Reg
    -> LiveInstr instr
    -> State
         (UniqFM BlockId [SlotMap Reg]) (SlotMap Reg, Maybe (Reg, Reg))
    slurpLI SlotMap Reg
    slotMap LiveInstr instr
    li

                    -- remember what reg was stored into the slot
                    | LiveInstr (SPILL Reg
    reg Int
    slot) Maybe Liveness
    _  <- LiveInstr instr
    li
                    , SlotMap Reg
    slotMap'                      <- SlotMap Reg -> Int -> Reg -> SlotMap Reg
    forall key elt.
    Uniquable key =>
    UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM SlotMap Reg
    slotMap Int
    slot Reg
    reg
                    = (SlotMap Reg, Maybe (Reg, Reg))
    -> State
         (UniqFM BlockId [SlotMap Reg]) (SlotMap Reg, Maybe (Reg, Reg))
    forall a. a -> State (UniqFM BlockId [SlotMap Reg]) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SlotMap Reg
    slotMap', Maybe (Reg, Reg)
    forall a. Maybe a
    Nothing)

                    -- add an edge between the this reg and the last one stored into the slot
                    | LiveInstr (RELOAD Int
    slot Reg
    reg) Maybe Liveness
    _ <- LiveInstr instr
    li
                    = case SlotMap Reg -> Int -> Maybe Reg
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM SlotMap Reg
    slotMap Int
    slot of
                            Just Reg
    reg2
                             | Reg
    reg Reg -> Reg -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Reg
    reg2  -> (SlotMap Reg, Maybe (Reg, Reg))
    -> State
         (UniqFM BlockId [SlotMap Reg]) (SlotMap Reg, Maybe (Reg, Reg))
    forall a. a -> State (UniqFM BlockId [SlotMap Reg]) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SlotMap Reg
    slotMap, (Reg, Reg) -> Maybe (Reg, Reg)
    forall a. a -> Maybe a
    Just (Reg
    reg, Reg
    reg2))
                             | Bool
    otherwise    -> (SlotMap Reg, Maybe (Reg, Reg))
    -> State
         (UniqFM BlockId [SlotMap Reg]) (SlotMap Reg, Maybe (Reg, Reg))
    forall a. a -> State (UniqFM BlockId [SlotMap Reg]) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SlotMap Reg
    slotMap, Maybe (Reg, Reg)
    forall a. Maybe a
    Nothing)

                            Maybe Reg
    Nothing         -> (SlotMap Reg, Maybe (Reg, Reg))
    -> State
         (UniqFM BlockId [SlotMap Reg]) (SlotMap Reg, Maybe (Reg, Reg))
    forall a. a -> State (UniqFM BlockId [SlotMap Reg]) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SlotMap Reg
    slotMap, Maybe (Reg, Reg)
    forall a. Maybe a
    Nothing)

                    -- if we hit a jump, remember the current slotMap
                    | LiveInstr (Instr instr
    instr) Maybe Liveness
    _     <- LiveInstr instr
    li
                    , [BlockId]
    targets                       <- instr -> [BlockId]
    forall instr. Instruction instr => instr -> [BlockId]
    jumpDestsOfInstr instr
    instr
                    , Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [BlockId] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [BlockId]
    targets
                    = do    (BlockId -> State (UniqFM BlockId [SlotMap Reg]) ())
    -> [BlockId] -> State (UniqFM BlockId [SlotMap Reg]) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_   (SlotMap Reg -> BlockId -> State (UniqFM BlockId [SlotMap Reg]) ()
    forall {key} {a}.
    Uniquable key =>
    a -> key -> State (UniqFM key [a]) ()
    accSlotMap SlotMap Reg
    slotMap) [BlockId]
    targets
                            (SlotMap Reg, Maybe (Reg, Reg))
    -> State
         (UniqFM BlockId [SlotMap Reg]) (SlotMap Reg, Maybe (Reg, Reg))
    forall a. a -> State (UniqFM BlockId [SlotMap Reg]) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return  (SlotMap Reg
    slotMap, Maybe (Reg, Reg)
    forall a. Maybe a
    Nothing)

                    | Bool
    otherwise
                    = (SlotMap Reg, Maybe (Reg, Reg))
    -> State
         (UniqFM BlockId [SlotMap Reg]) (SlotMap Reg, Maybe (Reg, Reg))
    forall a. a -> State (UniqFM BlockId [SlotMap Reg]) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SlotMap Reg
    slotMap, Maybe (Reg, Reg)
    forall a. Maybe a
    Nothing)

            -- record a slotmap for an in edge to this block
            accSlotMap :: a -> key -> State (UniqFM key [a]) ()
    accSlotMap a
    slotMap key
    blockId
                    = (UniqFM key [a] -> UniqFM key [a]) -> State (UniqFM key [a]) ()
    forall s. (s -> s) -> State s ()
    modify (\UniqFM key [a]
    s -> ([a] -> [a] -> [a])
    -> UniqFM key [a] -> key -> [a] -> UniqFM key [a]
    forall key elt.
    Uniquable key =>
    (elt -> elt -> elt)
    -> UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM_C [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++) UniqFM key [a]
    s key
    blockId [a
    slotMap])

            -- work out the slot map on entry to this block
            --      if we have slot maps for multiple in-edges then we need to merge them.
            getSlotMap :: key -> State (UniqFM key [SlotMap Reg]) (SlotMap Reg)
    getSlotMap key
    blockId
             = do   map             <- State (UniqFM key [SlotMap Reg]) (UniqFM key [SlotMap Reg])
    forall s. State s s
    get
                    let slotMaps    = [SlotMap Reg] -> Maybe [SlotMap Reg] -> [SlotMap Reg]
    forall a. a -> Maybe a -> a
    fromMaybe [] (UniqFM key [SlotMap Reg] -> key -> Maybe [SlotMap Reg]
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM key [SlotMap Reg]
    map key
    blockId)
                    return          $ foldr mergeSlotMaps emptyUFM slotMaps

            mergeSlotMaps :: SlotMap Reg -> SlotMap Reg -> SlotMap Reg
            mergeSlotMaps :: SlotMap Reg -> SlotMap Reg -> SlotMap Reg
    mergeSlotMaps SlotMap Reg
    map1 SlotMap Reg
    map2
                    -- toList sadly means we have to use the _Directly style
                    -- functions.
                    -- TODO: We shouldn't need to go through a list here.
                    = [(Unique, Reg)] -> SlotMap Reg
    forall {k} elt (key :: k). [(Unique, elt)] -> UniqFM key elt
    listToUFM_Directly
                    ([(Unique, Reg)] -> SlotMap Reg) -> [(Unique, Reg)] -> SlotMap Reg
    forall a b. (a -> b) -> a -> b
    $ [ (Unique
    k, Reg
    r1)
                      | (Unique
    k, Reg
    r1) <- SlotMap Reg -> [(Unique, Reg)]
    forall {k} (key :: k) elt. UniqFM key elt -> [(Unique, elt)]
    nonDetUFMToList SlotMap Reg
    map1
                      -- This is non-deterministic but we do not
                      -- currently support deterministic code-generation.
                      -- See Note [Unique Determinism and code generation]
                      , case SlotMap Reg -> Unique -> Maybe Reg
    forall {k} (key :: k) elt. UniqFM key elt -> Unique -> Maybe elt
    lookupUFM_Directly SlotMap Reg
    map2 Unique
    k of
                              Maybe Reg
    Nothing -> Bool
    False
                              Just Reg
    r2 -> Reg
    r1 Reg -> Reg -> Bool
    forall a. Eq a => a -> a -> Bool
    == Reg
    r2 ]

    -- | Strip away liveness information, yielding NatCmmDecl
    stripLive
            :: (OutputableP Platform statics, Instruction instr)
            => NCGConfig
            -> LiveCmmDecl statics instr
            -> NatCmmDecl statics instr

    stripLive :: forall statics instr.
    (OutputableP Platform statics, Instruction instr) =>
    NCGConfig -> LiveCmmDecl statics instr -> NatCmmDecl statics instr
    stripLive NCGConfig
    config LiveCmmDecl statics instr
    live
            = LiveCmmDecl statics instr -> NatCmmDecl statics instr
    forall statics instr.
    (OutputableP Platform statics, Instruction instr) =>
    LiveCmmDecl statics instr -> NatCmmDecl statics instr
    stripCmm LiveCmmDecl statics instr
    live

     where  stripCmm :: (OutputableP Platform statics, Instruction instr)
                     => LiveCmmDecl statics instr -> NatCmmDecl statics instr
            stripCmm :: forall statics instr.
    (OutputableP Platform statics, Instruction instr) =>
    LiveCmmDecl statics instr -> NatCmmDecl statics instr
    stripCmm (CmmData Section
    sec statics
    ds)       = Section
    -> statics
    -> GenCmmDecl statics (LabelMap RawCmmStatics) (ListGraph instr)
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData Section
    sec statics
    ds
            stripCmm (CmmProc (LiveInfo LabelMap RawCmmStatics
    info (BlockId
    first_id:[BlockId]
    _) BlockMap RegSet
    _ BlockMap IntSet
    _) CLabel
    label [GlobalReg]
    live [SCC (LiveBasicBlock instr)]
    sccs)
             = let  final_blocks :: [LiveBasicBlock instr]
    final_blocks    = [SCC (LiveBasicBlock instr)] -> [LiveBasicBlock instr]
    forall a. [SCC a] -> [a]
    flattenSCCs [SCC (LiveBasicBlock instr)]
    sccs

                    -- make sure the block that was first in the input list
                    --      stays at the front of the output. This is the entry point
                    --      of the proc, and it needs to come first.
                    ((LiveBasicBlock instr
    first':[LiveBasicBlock instr]
    _), [LiveBasicBlock instr]
    rest')
                                    = (LiveBasicBlock instr -> Bool)
    -> [LiveBasicBlock instr]
    -> ([LiveBasicBlock instr], [LiveBasicBlock instr])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition ((BlockId -> BlockId -> Bool
    forall a. Eq a => a -> a -> Bool
    == BlockId
    first_id) (BlockId -> Bool)
    -> (LiveBasicBlock instr -> BlockId)
    -> LiveBasicBlock instr
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LiveBasicBlock instr -> BlockId
    forall i. GenBasicBlock i -> BlockId
    blockId) [LiveBasicBlock instr]
    final_blocks

               in   LabelMap RawCmmStatics
    -> CLabel
    -> [GlobalReg]
    -> ListGraph instr
    -> GenCmmDecl statics (LabelMap RawCmmStatics) (ListGraph instr)
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc LabelMap RawCmmStatics
    info CLabel
    label [GlobalReg]
    live
                              ([GenBasicBlock instr] -> ListGraph instr
    forall i. [GenBasicBlock i] -> ListGraph i
    ListGraph ([GenBasicBlock instr] -> ListGraph instr)
    -> [GenBasicBlock instr] -> ListGraph instr
    forall a b. (a -> b) -> a -> b
    $ (LiveBasicBlock instr -> GenBasicBlock instr)
    -> [LiveBasicBlock instr] -> [GenBasicBlock instr]
    forall a b. (a -> b) -> [a] -> [b]
    map (NCGConfig -> LiveBasicBlock instr -> GenBasicBlock instr
    forall instr.
    Instruction instr =>
    NCGConfig -> LiveBasicBlock instr -> NatBasicBlock instr
    stripLiveBlock NCGConfig
    config) ([LiveBasicBlock instr] -> [GenBasicBlock instr])
    -> [LiveBasicBlock instr] -> [GenBasicBlock instr]
    forall a b. (a -> b) -> a -> b
    $ LiveBasicBlock instr
    first' LiveBasicBlock instr
    -> [LiveBasicBlock instr] -> [LiveBasicBlock instr]
    forall a. a -> [a] -> [a]
    : [LiveBasicBlock instr]
    rest')

            -- If the proc has blocks but we don't know what the first one was, then we're dead.
            stripCmm GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
    proc
                     = [Char]
    -> SDoc
    -> GenCmmDecl statics (LabelMap RawCmmStatics) (ListGraph instr)
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "RegAlloc.Liveness.stripLive: no first_id on proc" (Platform
    -> GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)] -> SDoc
    forall statics instr.
    (OutputableP Platform statics, Instruction instr) =>
    Platform -> LiveCmmDecl statics instr -> SDoc
    pprLiveCmmDecl (NCGConfig -> Platform
    ncgPlatform NCGConfig
    config) GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
    proc)

    -- | Pretty-print a `LiveCmmDecl`
    pprLiveCmmDecl :: (OutputableP Platform statics, Instruction instr) => Platform -> LiveCmmDecl statics instr -> SDoc
    pprLiveCmmDecl :: forall statics instr.
    (OutputableP Platform statics, Instruction instr) =>
    Platform -> LiveCmmDecl statics instr -> SDoc
    pprLiveCmmDecl Platform
    platform LiveCmmDecl statics instr
    d = Platform -> LiveCmmDecl statics SDoc -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform ((instr -> SDoc)
    -> LiveCmmDecl statics instr -> LiveCmmDecl statics SDoc
    forall instr b statics.
    (instr -> b) -> LiveCmmDecl statics instr -> LiveCmmDecl statics b
    mapLiveCmmDecl (Platform -> instr -> SDoc
    forall instr. Instruction instr => Platform -> instr -> SDoc
    pprInstr Platform
    platform) LiveCmmDecl statics instr
    d)

    -- | Map over instruction type in `LiveCmmDecl`
    mapLiveCmmDecl
       :: (instr -> b)
       -> LiveCmmDecl statics instr
       -> LiveCmmDecl statics b
    mapLiveCmmDecl :: forall instr b statics.
    (instr -> b) -> LiveCmmDecl statics instr -> LiveCmmDecl statics b
    mapLiveCmmDecl instr -> b
    f LiveCmmDecl statics instr
    proc = ([SCC (GenBasicBlock (LiveInstr instr))]
     -> [SCC (LiveBasicBlock b)])
    -> LiveCmmDecl statics instr
    -> GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock b)]
    forall a b.
    (a -> b)
    -> GenCmmDecl statics LiveInfo a -> GenCmmDecl statics LiveInfo b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((SCC (GenBasicBlock (LiveInstr instr)) -> SCC (LiveBasicBlock b))
    -> [SCC (GenBasicBlock (LiveInstr instr))]
    -> [SCC (LiveBasicBlock b)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((GenBasicBlock (LiveInstr instr) -> LiveBasicBlock b)
    -> SCC (GenBasicBlock (LiveInstr instr)) -> SCC (LiveBasicBlock b)
    forall a b. (a -> b) -> SCC a -> SCC b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((LiveInstr instr -> LiveInstr b)
    -> GenBasicBlock (LiveInstr instr) -> LiveBasicBlock b
    forall a b. (a -> b) -> GenBasicBlock a -> GenBasicBlock b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((instr -> b) -> LiveInstr instr -> LiveInstr b
    forall a b. (a -> b) -> LiveInstr a -> LiveInstr b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap instr -> b
    f)))) LiveCmmDecl statics instr
    proc

    -- | Strip away liveness information from a basic block,
    --   and make real spill instructions out of SPILL, RELOAD pseudos along the way.

    stripLiveBlock
            :: Instruction instr
            => NCGConfig
            -> LiveBasicBlock instr
            -> NatBasicBlock instr

    stripLiveBlock :: forall instr.
    Instruction instr =>
    NCGConfig -> LiveBasicBlock instr -> NatBasicBlock instr
    stripLiveBlock NCGConfig
    config (BasicBlock BlockId
    i [LiveInstr instr]
    lis)
     =      BlockId -> [instr] -> GenBasicBlock instr
    forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    i [instr]
    instrs'

     where  ([instr]
    instrs', Int
    _)
                    = State Int [instr] -> Int -> ([instr], Int)
    forall s a. State s a -> s -> (a, s)
    runState ([instr] -> [LiveInstr instr] -> State Int [instr]
    forall instr.
    Instruction instr =>
    [instr] -> [LiveInstr instr] -> State Int [instr]
    spillNat [] [LiveInstr instr]
    lis) Int
    0

            -- spillNat :: [instr] -> [LiveInstr instr] -> State Int [instr]
            spillNat :: Instruction instr => [instr] -> [LiveInstr instr] -> State Int [instr]
            spillNat :: forall instr.
    Instruction instr =>
    [instr] -> [LiveInstr instr] -> State Int [instr]
    spillNat [instr]
    acc []
             =      [instr] -> State Int [instr]
    forall a. a -> State Int a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([instr] -> [instr]
    forall a. [a] -> [a]
    reverse [instr]
    acc)

            -- The SPILL/RELOAD cases do not appear to be exercised by our codegens
            --
            spillNat [instr]
    acc (LiveInstr (SPILL Reg
    reg Int
    slot) Maybe Liveness
    _ : [LiveInstr instr]
    instrs)
             = do   delta   <- State Int Int
    forall s. State s s
    get
                    spillNat (mkSpillInstr config reg delta slot ++ acc) instrs

            spillNat [instr]
    acc (LiveInstr (RELOAD Int
    slot Reg
    reg) Maybe Liveness
    _ : [LiveInstr instr]
    instrs)
             = do   delta   <- State Int Int
    forall s. State s s
    get
                    spillNat (mkLoadInstr config reg delta slot ++ acc) instrs

            spillNat [instr]
    acc (LiveInstr (Instr instr
    instr) Maybe Liveness
    _ : [LiveInstr instr]
    instrs)
             | Just Int
    i <- instr -> Maybe Int
    forall instr. Instruction instr => instr -> Maybe Int
    takeDeltaInstr instr
    instr
             = do   Int -> State Int ()
    forall s. s -> State s ()
    put Int
    i
                    [instr] -> [LiveInstr instr] -> State Int [instr]
    forall instr.
    Instruction instr =>
    [instr] -> [LiveInstr instr] -> State Int [instr]
    spillNat [instr]
    acc [LiveInstr instr]
    instrs

            spillNat [instr]
    acc (LiveInstr (Instr instr
    instr) Maybe Liveness
    _ : [LiveInstr instr]
    instrs)
             =      [instr] -> [LiveInstr instr] -> State Int [instr]
    forall instr.
    Instruction instr =>
    [instr] -> [LiveInstr instr] -> State Int [instr]
    spillNat (instr
    instr instr -> [instr] -> [instr]
    forall a. a -> [a] -> [a]
    : [instr]
    acc) [LiveInstr instr]
    instrs

    -- | Erase Delta instructions.

    eraseDeltasLive
            :: Instruction instr
            => LiveCmmDecl statics instr
            -> LiveCmmDecl statics instr

    eraseDeltasLive :: forall instr statics.
    Instruction instr =>
    LiveCmmDecl statics instr -> LiveCmmDecl statics instr
    eraseDeltasLive LiveCmmDecl statics instr
    cmm
            = (LiveBasicBlock instr -> LiveBasicBlock instr)
    -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
    forall instr statics.
    (LiveBasicBlock instr -> LiveBasicBlock instr)
    -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
    mapBlockTop LiveBasicBlock instr -> LiveBasicBlock instr
    forall {instr}.
    Instruction instr =>
    GenBasicBlock (LiveInstr instr) -> GenBasicBlock (LiveInstr instr)
    eraseBlock LiveCmmDecl statics instr
    cmm
     where
            eraseBlock :: GenBasicBlock (LiveInstr instr) -> GenBasicBlock (LiveInstr instr)
    eraseBlock (BasicBlock BlockId
    id [LiveInstr instr]
    lis)
                    = BlockId -> [LiveInstr instr] -> GenBasicBlock (LiveInstr instr)
    forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    id
                    ([LiveInstr instr] -> GenBasicBlock (LiveInstr instr))
    -> [LiveInstr instr] -> GenBasicBlock (LiveInstr instr)
    forall a b. (a -> b) -> a -> b
    $ (LiveInstr instr -> Bool) -> [LiveInstr instr] -> [LiveInstr instr]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(LiveInstr InstrSR instr
    i Maybe Liveness
    _) -> Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
    forall a b. (a -> b) -> a -> b
    $ InstrSR instr -> Maybe Int
    forall instr. Instruction instr => instr -> Maybe Int
    takeDeltaInstr InstrSR instr
    i)
                    ([LiveInstr instr] -> [LiveInstr instr])
    -> [LiveInstr instr] -> [LiveInstr instr]
    forall a b. (a -> b) -> a -> b
    $ [LiveInstr instr]
    lis

    -- | Patch the registers in this code according to this register mapping.
    --   also erase reg -> reg moves when the reg is the same.
    --   also erase reg -> reg moves when the destination dies in this instr.
    patchEraseLive
            :: Instruction instr
            => (Reg -> Reg)
            -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr

    patchEraseLive :: forall instr statics.
    Instruction instr =>
    (Reg -> Reg)
    -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
    patchEraseLive Reg -> Reg
    patchF LiveCmmDecl statics instr
    cmm
            = LiveCmmDecl statics instr -> LiveCmmDecl statics instr
    patchCmm LiveCmmDecl statics instr
    cmm
     where
            patchCmm :: LiveCmmDecl statics instr -> LiveCmmDecl statics instr
    patchCmm cmm :: LiveCmmDecl statics instr
    cmm@CmmData{}  = LiveCmmDecl statics instr
    cmm

            patchCmm (CmmProc LiveInfo
    info CLabel
    label [GlobalReg]
    live [SCC (GenBasicBlock (LiveInstr instr))]
    sccs)
             | LiveInfo LabelMap RawCmmStatics
    static [BlockId]
    id BlockMap RegSet
    blockMap BlockMap IntSet
    mLiveSlots <- LiveInfo
    info
             = let
                    patchRegSet :: UniqFM Reg Reg -> RegSet
    patchRegSet UniqFM Reg Reg
    set = [Reg] -> RegSet
    forall a. Uniquable a => [a] -> UniqSet a
    mkUniqSet ([Reg] -> RegSet) -> [Reg] -> RegSet
    forall a b. (a -> b) -> a -> b
    $ (Reg -> Reg) -> [Reg] -> [Reg]
    forall a b. (a -> b) -> [a] -> [b]
    map Reg -> Reg
    patchF ([Reg] -> [Reg]) -> [Reg] -> [Reg]
    forall a b. (a -> b) -> a -> b
    $ UniqFM Reg Reg -> [Reg]
    forall {k} (key :: k) elt. UniqFM key elt -> [elt]
    nonDetEltsUFM UniqFM Reg Reg
    set
                      -- See Note [Unique Determinism and code generation]
                    blockMap' :: BlockMap RegSet
    blockMap'       = (RegSet -> RegSet) -> BlockMap RegSet -> BlockMap RegSet
    forall a v. (a -> v) -> LabelMap a -> LabelMap v
    mapMap (UniqFM Reg Reg -> RegSet
    patchRegSet (UniqFM Reg Reg -> RegSet)
    -> (RegSet -> UniqFM Reg Reg) -> RegSet -> RegSet
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RegSet -> UniqFM Reg Reg
    forall a. UniqSet a -> UniqFM a a
    getUniqSet) BlockMap RegSet
    blockMap

                    info' :: LiveInfo
    info'           = LabelMap RawCmmStatics
    -> [BlockId] -> BlockMap RegSet -> BlockMap IntSet -> LiveInfo
    LiveInfo LabelMap RawCmmStatics
    static [BlockId]
    id BlockMap RegSet
    blockMap' BlockMap IntSet
    mLiveSlots
               in   LiveInfo
    -> CLabel
    -> [GlobalReg]
    -> [SCC (GenBasicBlock (LiveInstr instr))]
    -> LiveCmmDecl statics instr
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc LiveInfo
    info' CLabel
    label [GlobalReg]
    live ([SCC (GenBasicBlock (LiveInstr instr))]
     -> LiveCmmDecl statics instr)
    -> [SCC (GenBasicBlock (LiveInstr instr))]
    -> LiveCmmDecl statics instr
    forall a b. (a -> b) -> a -> b
    $ (SCC (GenBasicBlock (LiveInstr instr))
     -> SCC (GenBasicBlock (LiveInstr instr)))
    -> [SCC (GenBasicBlock (LiveInstr instr))]
    -> [SCC (GenBasicBlock (LiveInstr instr))]
    forall a b. (a -> b) -> [a] -> [b]
    map SCC (GenBasicBlock (LiveInstr instr))
    -> SCC (GenBasicBlock (LiveInstr instr))
    patchSCC [SCC (GenBasicBlock (LiveInstr instr))]
    sccs

            patchSCC :: SCC (GenBasicBlock (LiveInstr instr))
    -> SCC (GenBasicBlock (LiveInstr instr))
    patchSCC (AcyclicSCC GenBasicBlock (LiveInstr instr)
    b)  = GenBasicBlock (LiveInstr instr)
    -> SCC (GenBasicBlock (LiveInstr instr))
    forall vertex. vertex -> SCC vertex
    AcyclicSCC (GenBasicBlock (LiveInstr instr) -> GenBasicBlock (LiveInstr instr)
    patchBlock GenBasicBlock (LiveInstr instr)
    b)
            patchSCC (CyclicSCC  [GenBasicBlock (LiveInstr instr)]
    bs) = [GenBasicBlock (LiveInstr instr)]
    -> SCC (GenBasicBlock (LiveInstr instr))
    forall vertex. [vertex] -> SCC vertex
    CyclicSCC  ((GenBasicBlock (LiveInstr instr)
     -> GenBasicBlock (LiveInstr instr))
    -> [GenBasicBlock (LiveInstr instr)]
    -> [GenBasicBlock (LiveInstr instr)]
    forall a b. (a -> b) -> [a] -> [b]
    map GenBasicBlock (LiveInstr instr) -> GenBasicBlock (LiveInstr instr)
    patchBlock [GenBasicBlock (LiveInstr instr)]
    bs)

            patchBlock :: GenBasicBlock (LiveInstr instr) -> GenBasicBlock (LiveInstr instr)
    patchBlock (BasicBlock BlockId
    id [LiveInstr instr]
    lis)
                    = BlockId -> [LiveInstr instr] -> GenBasicBlock (LiveInstr instr)
    forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    id ([LiveInstr instr] -> GenBasicBlock (LiveInstr instr))
    -> [LiveInstr instr] -> GenBasicBlock (LiveInstr instr)
    forall a b. (a -> b) -> a -> b
    $ [LiveInstr instr] -> [LiveInstr instr]
    patchInstrs [LiveInstr instr]
    lis

            patchInstrs :: [LiveInstr instr] -> [LiveInstr instr]
    patchInstrs []          = []
            patchInstrs (LiveInstr instr
    li : [LiveInstr instr]
    lis)

                    | LiveInstr InstrSR instr
    i (Just Liveness
    live)       <- LiveInstr instr
    li'
                    , Just (Reg
    r1, Reg
    r2) <- InstrSR instr -> Maybe (Reg, Reg)
    forall instr. Instruction instr => instr -> Maybe (Reg, Reg)
    takeRegRegMoveInstr InstrSR instr
    i
                    , Reg -> Reg -> Liveness -> Bool
    eatMe Reg
    r1 Reg
    r2 Liveness
    live
                    = [LiveInstr instr] -> [LiveInstr instr]
    patchInstrs [LiveInstr instr]
    lis

                    | Bool
    otherwise
                    = LiveInstr instr
    li' LiveInstr instr -> [LiveInstr instr] -> [LiveInstr instr]
    forall a. a -> [a] -> [a]
    : [LiveInstr instr] -> [LiveInstr instr]
    patchInstrs [LiveInstr instr]
    lis

                    where   li' :: LiveInstr instr
    li'     = (Reg -> Reg) -> LiveInstr instr -> LiveInstr instr
    forall instr.
    Instruction instr =>
    (Reg -> Reg) -> LiveInstr instr -> LiveInstr instr
    patchRegsLiveInstr Reg -> Reg
    patchF LiveInstr instr
    li

            eatMe :: Reg -> Reg -> Liveness -> Bool
    eatMe   Reg
    r1 Reg
    r2 Liveness
    live
                    -- source and destination regs are the same
                    | Reg
    r1 Reg -> Reg -> Bool
    forall a. Eq a => a -> a -> Bool
    == Reg
    r2      = Bool
    True

                    -- destination reg is never used
                    | Reg -> RegSet -> Bool
    forall a. Uniquable a => a -> UniqSet a -> Bool
    elementOfUniqSet Reg
    r2 (Liveness -> RegSet
    liveBorn Liveness
    live)
                    , Reg -> RegSet -> Bool
    forall a. Uniquable a => a -> UniqSet a -> Bool
    elementOfUniqSet Reg
    r2 (Liveness -> RegSet
    liveDieRead Liveness
    live) Bool -> Bool -> Bool
    || Reg -> RegSet -> Bool
    forall a. Uniquable a => a -> UniqSet a -> Bool
    elementOfUniqSet Reg
    r2 (Liveness -> RegSet
    liveDieWrite Liveness
    live)
                    = Bool
    True

                    | Bool
    otherwise     = Bool
    False

    -- | Patch registers in this LiveInstr, including the liveness information.
    --
    patchRegsLiveInstr
            :: Instruction instr
            => (Reg -> Reg)
            -> LiveInstr instr -> LiveInstr instr

    patchRegsLiveInstr :: forall instr.
    Instruction instr =>
    (Reg -> Reg) -> LiveInstr instr -> LiveInstr instr
    patchRegsLiveInstr Reg -> Reg
    patchF LiveInstr instr
    li
     = case LiveInstr instr
    li of
            LiveInstr InstrSR instr
    instr Maybe Liveness
    Nothing
             -> InstrSR instr -> Maybe Liveness -> LiveInstr instr
    forall instr. InstrSR instr -> Maybe Liveness -> LiveInstr instr
    LiveInstr (InstrSR instr -> (Reg -> Reg) -> InstrSR instr
    forall instr. Instruction instr => instr -> (Reg -> Reg) -> instr
    patchRegsOfInstr InstrSR instr
    instr Reg -> Reg
    patchF) Maybe Liveness
    forall a. Maybe a
    Nothing

            LiveInstr InstrSR instr
    instr (Just Liveness
    live)
             -> InstrSR instr -> Maybe Liveness -> LiveInstr instr
    forall instr. InstrSR instr -> Maybe Liveness -> LiveInstr instr
    LiveInstr
                    (InstrSR instr -> (Reg -> Reg) -> InstrSR instr
    forall instr. Instruction instr => instr -> (Reg -> Reg) -> instr
    patchRegsOfInstr InstrSR instr
    instr Reg -> Reg
    patchF)
                    (Liveness -> Maybe Liveness
    forall a. a -> Maybe a
    Just Liveness
    live
                            { -- WARNING: have to go via lists here because patchF changes the uniq in the Reg
                              liveBorn      = mapUniqSet patchF $ liveBorn live
                            , liveDieRead   = mapUniqSet patchF $ liveDieRead live
                            , liveDieWrite  = mapUniqSet patchF $ liveDieWrite live })
                              -- See Note [Unique Determinism and code generation]

    --------------------------------------------------------------------------------
    -- | Convert a NatCmmDecl to a LiveCmmDecl, with liveness information

    cmmTopLiveness
            :: Instruction instr
            => Maybe CFG
            -> Platform
            -> NatCmmDecl statics instr
            -> UniqSM (LiveCmmDecl statics instr)
    cmmTopLiveness :: forall instr statics.
    Instruction instr =>
    Maybe CFG
    -> Platform
    -> NatCmmDecl statics instr
    -> UniqSM (LiveCmmDecl statics instr)
    cmmTopLiveness Maybe CFG
    cfg Platform
    platform NatCmmDecl statics instr
    cmm
            = Platform
    -> LiveCmmDecl statics instr -> UniqSM (LiveCmmDecl statics instr)
    forall instr statics.
    Instruction instr =>
    Platform
    -> LiveCmmDecl statics instr -> UniqSM (LiveCmmDecl statics instr)
    regLiveness Platform
    platform (LiveCmmDecl statics instr -> UniqSM (LiveCmmDecl statics instr))
    -> LiveCmmDecl statics instr -> UniqSM (LiveCmmDecl statics instr)
    forall a b. (a -> b) -> a -> b
    $ Maybe CFG -> NatCmmDecl statics instr -> LiveCmmDecl statics instr
    forall instr statics.
    Instruction instr =>
    Maybe CFG -> NatCmmDecl statics instr -> LiveCmmDecl statics instr
    natCmmTopToLive Maybe CFG
    cfg NatCmmDecl statics instr
    cmm

    natCmmTopToLive
            :: Instruction instr
            => Maybe CFG -> NatCmmDecl statics instr
            -> LiveCmmDecl statics instr

    natCmmTopToLive :: forall instr statics.
    Instruction instr =>
    Maybe CFG -> NatCmmDecl statics instr -> LiveCmmDecl statics instr
    natCmmTopToLive Maybe CFG
    _ (CmmData Section
    i statics
    d)
            = Section
    -> statics
    -> GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData Section
    i statics
    d

    natCmmTopToLive Maybe CFG
    _ (CmmProc LabelMap RawCmmStatics
    info CLabel
    lbl [GlobalReg]
    live (ListGraph []))
            = LiveInfo
    -> CLabel
    -> [GlobalReg]
    -> [SCC (LiveBasicBlock instr)]
    -> GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc (LabelMap RawCmmStatics
    -> [BlockId] -> BlockMap RegSet -> BlockMap IntSet -> LiveInfo
    LiveInfo LabelMap RawCmmStatics
    info [] BlockMap RegSet
    forall v. LabelMap v
    mapEmpty BlockMap IntSet
    forall v. LabelMap v
    mapEmpty) CLabel
    lbl [GlobalReg]
    live []

    natCmmTopToLive Maybe CFG
    mCfg proc :: GenCmmDecl statics (LabelMap RawCmmStatics) (ListGraph instr)
    proc@(CmmProc LabelMap RawCmmStatics
    info CLabel
    lbl [GlobalReg]
    live (ListGraph blocks :: [GenBasicBlock instr]
    blocks@(GenBasicBlock instr
    first : [GenBasicBlock instr]
    _)))
            = LiveInfo
    -> CLabel
    -> [GlobalReg]
    -> [SCC (LiveBasicBlock instr)]
    -> GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc (LabelMap RawCmmStatics
    -> [BlockId] -> BlockMap RegSet -> BlockMap IntSet -> LiveInfo
    LiveInfo LabelMap RawCmmStatics
    info' (BlockId
    first_id BlockId -> [BlockId] -> [BlockId]
    forall a. a -> [a] -> [a]
    : [BlockId]
    entry_ids) BlockMap RegSet
    forall v. LabelMap v
    mapEmpty BlockMap IntSet
    forall v. LabelMap v
    mapEmpty)
                    CLabel
    lbl [GlobalReg]
    live [SCC (LiveBasicBlock instr)]
    sccsLive
       where
            first_id :: BlockId
    first_id        = GenBasicBlock instr -> BlockId
    forall i. GenBasicBlock i -> BlockId
    blockId GenBasicBlock instr
    first
            all_entry_ids :: [BlockId]
    all_entry_ids   = GenCmmDecl statics (LabelMap RawCmmStatics) (ListGraph instr)
    -> [BlockId]
    forall a i b. GenCmmDecl a (LabelMap i) (ListGraph b) -> [BlockId]
    entryBlocks GenCmmDecl statics (LabelMap RawCmmStatics) (ListGraph instr)
    proc
            sccs :: [SCC (GenBasicBlock instr)]
    sccs            = [GenBasicBlock instr]
    -> [BlockId] -> Maybe CFG -> [SCC (GenBasicBlock instr)]
    forall instr.
    Instruction instr =>
    [NatBasicBlock instr]
    -> [BlockId] -> Maybe CFG -> [SCC (NatBasicBlock instr)]
    sccBlocks [GenBasicBlock instr]
    blocks [BlockId]
    all_entry_ids Maybe CFG
    mCfg
            sccsLive :: [SCC (LiveBasicBlock instr)]
    sccsLive        = (SCC (GenBasicBlock instr) -> SCC (LiveBasicBlock instr))
    -> [SCC (GenBasicBlock instr)] -> [SCC (LiveBasicBlock instr)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((GenBasicBlock instr -> LiveBasicBlock instr)
    -> SCC (GenBasicBlock instr) -> SCC (LiveBasicBlock instr)
    forall a b. (a -> b) -> SCC a -> SCC b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(BasicBlock BlockId
    l [instr]
    instrs) ->
                                           BlockId -> [LiveInstr instr] -> LiveBasicBlock instr
    forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    l ((instr -> LiveInstr instr) -> [instr] -> [LiveInstr instr]
    forall a b. (a -> b) -> [a] -> [b]
    map (\instr
    i -> InstrSR instr -> Maybe Liveness -> LiveInstr instr
    forall instr. InstrSR instr -> Maybe Liveness -> LiveInstr instr
    LiveInstr (instr -> InstrSR instr
    forall instr. instr -> InstrSR instr
    Instr instr
    i) Maybe Liveness
    forall a. Maybe a
    Nothing) [instr]
    instrs)))
                            ([SCC (GenBasicBlock instr)] -> [SCC (LiveBasicBlock instr)])
    -> [SCC (GenBasicBlock instr)] -> [SCC (LiveBasicBlock instr)]
    forall a b. (a -> b) -> a -> b
    $ [SCC (GenBasicBlock instr)]
    sccs

            entry_ids :: [BlockId]
    entry_ids       = (BlockId -> Bool) -> [BlockId] -> [BlockId]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (BlockId -> Bool
    reachable_node) ([BlockId] -> [BlockId])
    -> ([BlockId] -> [BlockId]) -> [BlockId] -> [BlockId]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                              (BlockId -> Bool) -> [BlockId] -> [BlockId]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (BlockId -> BlockId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= BlockId
    first_id) ([BlockId] -> [BlockId]) -> [BlockId] -> [BlockId]
    forall a b. (a -> b) -> a -> b
    $ [BlockId]
    all_entry_ids
            info' :: LabelMap RawCmmStatics
    info'           = (BlockId -> RawCmmStatics -> Bool)
    -> LabelMap RawCmmStatics -> LabelMap RawCmmStatics
    forall v. (BlockId -> v -> Bool) -> LabelMap v -> LabelMap v
    mapFilterWithKey (\BlockId
    node RawCmmStatics
    _ -> BlockId -> Bool
    reachable_node BlockId
    node) LabelMap RawCmmStatics
    info
            reachable_node :: BlockId -> Bool
    reachable_node
              | Just CFG
    cfg <- Maybe CFG
    mCfg
              = CFG -> BlockId -> Bool
    hasNode CFG
    cfg
              | Bool
    otherwise
              = Bool -> BlockId -> Bool
    forall a b. a -> b -> a
    const Bool
    True

    --
    -- Compute the liveness graph of the set of basic blocks.  Important:
    -- we also discard any unreachable code here, starting from the entry
    -- points (the first block in the list, and any blocks with info
    -- tables).  Unreachable code arises when code blocks are orphaned in
    -- earlier optimisation passes, and may confuse the register allocator
    -- by referring to registers that are not initialised.  It's easy to
    -- discard the unreachable code as part of the SCC pass, so that's
    -- exactly what we do. (#7574)
    --
    sccBlocks
            :: forall instr . Instruction instr
            => [NatBasicBlock instr]
            -> [BlockId]
            -> Maybe CFG
            -> [SCC (NatBasicBlock instr)]

    sccBlocks :: forall instr.
    Instruction instr =>
    [NatBasicBlock instr]
    -> [BlockId] -> Maybe CFG -> [SCC (NatBasicBlock instr)]
    sccBlocks [NatBasicBlock instr]
    blocks [BlockId]
    entries Maybe CFG
    mcfg = (SCC (Node BlockId (NatBasicBlock instr))
     -> SCC (NatBasicBlock instr))
    -> [SCC (Node BlockId (NatBasicBlock instr))]
    -> [SCC (NatBasicBlock instr)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Node BlockId (NatBasicBlock instr) -> NatBasicBlock instr)
    -> SCC (Node BlockId (NatBasicBlock instr))
    -> SCC (NatBasicBlock instr)
    forall a b. (a -> b) -> SCC a -> SCC b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Node BlockId (NatBasicBlock instr) -> NatBasicBlock instr
    forall key payload. Node key payload -> payload
    node_payload) [SCC (Node BlockId (NatBasicBlock instr))]
    sccs
      where
            nodes :: [ Node BlockId (NatBasicBlock instr) ]
            nodes :: [Node BlockId (NatBasicBlock instr)]
    nodes = [ NatBasicBlock instr
    -> BlockId -> [BlockId] -> Node BlockId (NatBasicBlock instr)
    forall key payload. payload -> key -> [key] -> Node key payload
    DigraphNode NatBasicBlock instr
    block BlockId
    id ([instr] -> [BlockId]
    Instruction instr => [instr] -> [BlockId]
    getOutEdges [instr]
    instrs)
                    | block :: NatBasicBlock instr
    block@(BasicBlock BlockId
    id [instr]
    instrs) <- [NatBasicBlock instr]
    blocks ]

            g1 :: Graph (Node BlockId (NatBasicBlock instr))
    g1 = [Node BlockId (NatBasicBlock instr)]
    -> Graph (Node BlockId (NatBasicBlock instr))
    forall key payload.
    Uniquable key =>
    [Node key payload] -> Graph (Node key payload)
    graphFromEdgedVerticesUniq [Node BlockId (NatBasicBlock instr)]
    nodes

            reachable :: LabelSet
            reachable :: LabelSet
    reachable
                | Just CFG
    cfg <- Maybe CFG
    mcfg
                -- Our CFG only contains reachable nodes by construction at this point.
                = [BlockId] -> LabelSet
    setFromList ([BlockId] -> LabelSet) -> [BlockId] -> LabelSet
    forall a b. (a -> b) -> a -> b
    $ CFG -> [BlockId]
    getCfgNodes CFG
    cfg
                | Bool
    otherwise
                = [BlockId] -> LabelSet
    setFromList ([BlockId] -> LabelSet) -> [BlockId] -> LabelSet
    forall a b. (a -> b) -> a -> b
    $ [ Node BlockId (NatBasicBlock instr) -> BlockId
    forall key payload. Node key payload -> key
    node_key Node BlockId (NatBasicBlock instr)
    node | Node BlockId (NatBasicBlock instr)
    node <- Graph (Node BlockId (NatBasicBlock instr))
    -> [Node BlockId (NatBasicBlock instr)]
    -> [Node BlockId (NatBasicBlock instr)]
    forall node. Graph node -> [node] -> [node]
    reachablesG Graph (Node BlockId (NatBasicBlock instr))
    g1 [Node BlockId (NatBasicBlock instr)]
    roots ]

            g2 :: Graph (Node BlockId (NatBasicBlock instr))
    g2 = [Node BlockId (NatBasicBlock instr)]
    -> Graph (Node BlockId (NatBasicBlock instr))
    forall key payload.
    Uniquable key =>
    [Node key payload] -> Graph (Node key payload)
    graphFromEdgedVerticesUniq [ Node BlockId (NatBasicBlock instr)
    node | Node BlockId (NatBasicBlock instr)
    node <- [Node BlockId (NatBasicBlock instr)]
    nodes
                                                   , Node BlockId (NatBasicBlock instr) -> BlockId
    forall key payload. Node key payload -> key
    node_key Node BlockId (NatBasicBlock instr)
    node
                                                      BlockId -> LabelSet -> Bool
    `setMember` LabelSet
    reachable ]

            sccs :: [SCC (Node BlockId (NatBasicBlock instr))]
    sccs = Graph (Node BlockId (NatBasicBlock instr))
    -> [SCC (Node BlockId (NatBasicBlock instr))]
    forall node. Graph node -> [SCC node]
    stronglyConnCompG Graph (Node BlockId (NatBasicBlock instr))
    g2

            getOutEdges :: Instruction instr => [instr] -> [BlockId]
            getOutEdges :: Instruction instr => [instr] -> [BlockId]
    getOutEdges [instr]
    instrs = (instr -> [BlockId]) -> [instr] -> [BlockId]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap instr -> [BlockId]
    forall instr. Instruction instr => instr -> [BlockId]
    jumpDestsOfInstr [instr]
    instrs

            -- This is truly ugly, but I don't see a good alternative.
            -- Digraph just has the wrong API.  We want to identify nodes
            -- by their keys (BlockId), but Digraph requires the whole
            -- node: (NatBasicBlock, BlockId, [BlockId]).  This takes
            -- advantage of the fact that Digraph only looks at the key,
            -- even though it asks for the whole triple.
            roots :: [Node BlockId (NatBasicBlock instr)]
    roots = [NatBasicBlock instr
    -> BlockId -> [BlockId] -> Node BlockId (NatBasicBlock instr)
    forall key payload. payload -> key -> [key] -> Node key payload
    DigraphNode ([Char] -> NatBasicBlock instr
    forall a. HasCallStack => [Char] -> a
    panic [Char]
    "sccBlocks") BlockId
    b ([Char] -> [BlockId]
    forall a. HasCallStack => [Char] -> a
    panic [Char]
    "sccBlocks")
                    | BlockId
    b <- [BlockId]
    entries ]

    --------------------------------------------------------------------------------
    -- Annotate code with register liveness information
    --

    regLiveness
            :: Instruction instr
            => Platform
            -> LiveCmmDecl statics instr
            -> UniqSM (LiveCmmDecl statics instr)

    regLiveness :: forall instr statics.
    Instruction instr =>
    Platform
    -> LiveCmmDecl statics instr -> UniqSM (LiveCmmDecl statics instr)
    regLiveness Platform
    _ (CmmData Section
    i statics
    d)
            = GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
    -> UniqSM
         (GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)])
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
     -> UniqSM
          (GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]))
    -> GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
    -> UniqSM
         (GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)])
    forall a b. (a -> b) -> a -> b
    $ Section
    -> statics
    -> GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData Section
    i statics
    d

    regLiveness Platform
    _ (CmmProc LiveInfo
    info CLabel
    lbl [GlobalReg]
    live [])
            | LiveInfo LabelMap RawCmmStatics
    static [BlockId]
    mFirst BlockMap RegSet
    _ BlockMap IntSet
    _    <- LiveInfo
    info
            = GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
    -> UniqSM
         (GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)])
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
     -> UniqSM
          (GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]))
    -> GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
    -> UniqSM
         (GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)])
    forall a b. (a -> b) -> a -> b
    $ LiveInfo
    -> CLabel
    -> [GlobalReg]
    -> [SCC (LiveBasicBlock instr)]
    -> GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc
                            (LabelMap RawCmmStatics
    -> [BlockId] -> BlockMap RegSet -> BlockMap IntSet -> LiveInfo
    LiveInfo LabelMap RawCmmStatics
    static [BlockId]
    mFirst BlockMap RegSet
    forall v. LabelMap v
    mapEmpty BlockMap IntSet
    forall v. LabelMap v
    mapEmpty)
                            CLabel
    lbl [GlobalReg]
    live []

    regLiveness Platform
    platform (CmmProc LiveInfo
    info CLabel
    lbl [GlobalReg]
    live [SCC (LiveBasicBlock instr)]
    sccs)
            | LiveInfo LabelMap RawCmmStatics
    static [BlockId]
    mFirst BlockMap RegSet
    _ BlockMap IntSet
    liveSlotsOnEntry     <- LiveInfo
    info
            = let   ([SCC (LiveBasicBlock instr)]
    ann_sccs, BlockMap RegSet
    block_live)  = Platform
    -> [SCC (LiveBasicBlock instr)]
    -> ([SCC (LiveBasicBlock instr)], BlockMap RegSet)
    forall instr.
    Instruction instr =>
    Platform
    -> [SCC (LiveBasicBlock instr)]
    -> ([SCC (LiveBasicBlock instr)], BlockMap RegSet)
    computeLiveness Platform
    platform [SCC (LiveBasicBlock instr)]
    sccs

              in    GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
    -> UniqSM
         (GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)])
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
     -> UniqSM
          (GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]))
    -> GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
    -> UniqSM
         (GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)])
    forall a b. (a -> b) -> a -> b
    $ LiveInfo
    -> CLabel
    -> [GlobalReg]
    -> [SCC (LiveBasicBlock instr)]
    -> GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)]
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc (LabelMap RawCmmStatics
    -> [BlockId] -> BlockMap RegSet -> BlockMap IntSet -> LiveInfo
    LiveInfo LabelMap RawCmmStatics
    static [BlockId]
    mFirst BlockMap RegSet
    block_live BlockMap IntSet
    liveSlotsOnEntry)
                               CLabel
    lbl [GlobalReg]
    live [SCC (LiveBasicBlock instr)]
    ann_sccs

    -- -----------------------------------------------------------------------------
    -- | Check ordering of Blocks
    --   The computeLiveness function requires SCCs to be in reverse
    --   dependent order.  If they're not the liveness information will be
    --   wrong, and we'll get a bad allocation.  Better to check for this
    --   precondition explicitly or some other poor sucker will waste a
    --   day staring at bad assembly code..
    --
    checkIsReverseDependent
            :: Instruction instr
            => [SCC (LiveBasicBlock instr)]         -- ^ SCCs of blocks that we're about to run the liveness determinator on.
            -> Maybe BlockId                        -- ^ BlockIds that fail the test (if any)

    checkIsReverseDependent :: forall instr.
    Instruction instr =>
    [SCC (LiveBasicBlock instr)] -> Maybe BlockId
    checkIsReverseDependent [SCC (LiveBasicBlock instr)]
    sccs'
     = UniqSet BlockId -> [SCC (LiveBasicBlock instr)] -> Maybe BlockId
    forall {instr}.
    Instruction instr =>
    UniqSet BlockId
    -> [SCC (GenBasicBlock (LiveInstr instr))] -> Maybe BlockId
    go UniqSet BlockId
    forall a. UniqSet a
    emptyUniqSet [SCC (LiveBasicBlock instr)]
    sccs'

     where  go :: UniqSet BlockId
    -> [SCC (GenBasicBlock (LiveInstr instr))] -> Maybe BlockId
    go UniqSet BlockId
    _ []
             = Maybe BlockId
    forall a. Maybe a
    Nothing

            go UniqSet BlockId
    blocksSeen (AcyclicSCC GenBasicBlock (LiveInstr instr)
    block : [SCC (GenBasicBlock (LiveInstr instr))]
    sccs)
             = let  dests :: UniqSet BlockId
    dests           = GenBasicBlock (LiveInstr instr) -> UniqSet BlockId
    forall {instr}.
    Instruction instr =>
    GenBasicBlock (LiveInstr instr) -> UniqSet BlockId
    slurpJumpDestsOfBlock GenBasicBlock (LiveInstr instr)
    block
                    blocksSeen' :: UniqSet BlockId
    blocksSeen'     = UniqSet BlockId -> UniqSet BlockId -> UniqSet BlockId
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    unionUniqSets UniqSet BlockId
    blocksSeen (UniqSet BlockId -> UniqSet BlockId)
    -> UniqSet BlockId -> UniqSet BlockId
    forall a b. (a -> b) -> a -> b
    $ [BlockId] -> UniqSet BlockId
    forall a. Uniquable a => [a] -> UniqSet a
    mkUniqSet [GenBasicBlock (LiveInstr instr) -> BlockId
    forall i. GenBasicBlock i -> BlockId
    blockId GenBasicBlock (LiveInstr instr)
    block]
                    badDests :: UniqSet BlockId
    badDests        = UniqSet BlockId
    dests UniqSet BlockId -> UniqSet BlockId -> UniqSet BlockId
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    `minusUniqSet` UniqSet BlockId
    blocksSeen'
               in   case UniqSet BlockId -> [BlockId]
    forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet UniqSet BlockId
    badDests of
                     -- See Note [Unique Determinism and code generation]
                     []             -> UniqSet BlockId
    -> [SCC (GenBasicBlock (LiveInstr instr))] -> Maybe BlockId
    go UniqSet BlockId
    blocksSeen' [SCC (GenBasicBlock (LiveInstr instr))]
    sccs
                     BlockId
    bad : [BlockId]
    _        -> BlockId -> Maybe BlockId
    forall a. a -> Maybe a
    Just BlockId
    bad

            go UniqSet BlockId
    blocksSeen (CyclicSCC [GenBasicBlock (LiveInstr instr)]
    blocks : [SCC (GenBasicBlock (LiveInstr instr))]
    sccs)
             = let  dests :: UniqSet BlockId
    dests           = [UniqSet BlockId] -> UniqSet BlockId
    forall a. [UniqSet a] -> UniqSet a
    unionManyUniqSets ([UniqSet BlockId] -> UniqSet BlockId)
    -> [UniqSet BlockId] -> UniqSet BlockId
    forall a b. (a -> b) -> a -> b
    $ (GenBasicBlock (LiveInstr instr) -> UniqSet BlockId)
    -> [GenBasicBlock (LiveInstr instr)] -> [UniqSet BlockId]
    forall a b. (a -> b) -> [a] -> [b]
    map GenBasicBlock (LiveInstr instr) -> UniqSet BlockId
    forall {instr}.
    Instruction instr =>
    GenBasicBlock (LiveInstr instr) -> UniqSet BlockId
    slurpJumpDestsOfBlock [GenBasicBlock (LiveInstr instr)]
    blocks
                    blocksSeen' :: UniqSet BlockId
    blocksSeen'     = UniqSet BlockId -> UniqSet BlockId -> UniqSet BlockId
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    unionUniqSets UniqSet BlockId
    blocksSeen (UniqSet BlockId -> UniqSet BlockId)
    -> UniqSet BlockId -> UniqSet BlockId
    forall a b. (a -> b) -> a -> b
    $ [BlockId] -> UniqSet BlockId
    forall a. Uniquable a => [a] -> UniqSet a
    mkUniqSet ([BlockId] -> UniqSet BlockId) -> [BlockId] -> UniqSet BlockId
    forall a b. (a -> b) -> a -> b
    $ (GenBasicBlock (LiveInstr instr) -> BlockId)
    -> [GenBasicBlock (LiveInstr instr)] -> [BlockId]
    forall a b. (a -> b) -> [a] -> [b]
    map GenBasicBlock (LiveInstr instr) -> BlockId
    forall i. GenBasicBlock i -> BlockId
    blockId [GenBasicBlock (LiveInstr instr)]
    blocks
                    badDests :: UniqSet BlockId
    badDests        = UniqSet BlockId
    dests UniqSet BlockId -> UniqSet BlockId -> UniqSet BlockId
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    `minusUniqSet` UniqSet BlockId
    blocksSeen'
               in   case UniqSet BlockId -> [BlockId]
    forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet UniqSet BlockId
    badDests of
                     -- See Note [Unique Determinism and code generation]
                     []             -> UniqSet BlockId
    -> [SCC (GenBasicBlock (LiveInstr instr))] -> Maybe BlockId
    go UniqSet BlockId
    blocksSeen' [SCC (GenBasicBlock (LiveInstr instr))]
    sccs
                     BlockId
    bad : [BlockId]
    _        -> BlockId -> Maybe BlockId
    forall a. a -> Maybe a
    Just BlockId
    bad

            slurpJumpDestsOfBlock :: GenBasicBlock (LiveInstr instr) -> UniqSet BlockId
    slurpJumpDestsOfBlock (BasicBlock BlockId
    _ [LiveInstr instr]
    instrs)
                    = [UniqSet BlockId] -> UniqSet BlockId
    forall a. [UniqSet a] -> UniqSet a
    unionManyUniqSets
                    ([UniqSet BlockId] -> UniqSet BlockId)
    -> [UniqSet BlockId] -> UniqSet BlockId
    forall a b. (a -> b) -> a -> b
    $ (InstrSR instr -> UniqSet BlockId)
    -> [InstrSR instr] -> [UniqSet BlockId]
    forall a b. (a -> b) -> [a] -> [b]
    map ([BlockId] -> UniqSet BlockId
    forall a. Uniquable a => [a] -> UniqSet a
    mkUniqSet ([BlockId] -> UniqSet BlockId)
    -> (InstrSR instr -> [BlockId]) -> InstrSR instr -> UniqSet BlockId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . InstrSR instr -> [BlockId]
    forall instr. Instruction instr => instr -> [BlockId]
    jumpDestsOfInstr)
                            [ InstrSR instr
    i | LiveInstr InstrSR instr
    i Maybe Liveness
    _ <- [LiveInstr instr]
    instrs]

    -- | If we've compute liveness info for this code already we have to reverse
    --   the SCCs in each top to get them back to the right order so we can do it again.
    reverseBlocksInTops :: LiveCmmDecl statics instr -> LiveCmmDecl statics instr
    reverseBlocksInTops :: forall statics instr.
    LiveCmmDecl statics instr -> LiveCmmDecl statics instr
    reverseBlocksInTops LiveCmmDecl statics instr
    top
     = case LiveCmmDecl statics instr
    top of
            CmmData{}                       -> LiveCmmDecl statics instr
    top
            CmmProc LiveInfo
    info CLabel
    lbl [GlobalReg]
    live [SCC (LiveBasicBlock instr)]
    sccs      -> LiveInfo
    -> CLabel
    -> [GlobalReg]
    -> [SCC (LiveBasicBlock instr)]
    -> LiveCmmDecl statics instr
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc LiveInfo
    info CLabel
    lbl [GlobalReg]
    live ([SCC (LiveBasicBlock instr)] -> [SCC (LiveBasicBlock instr)]
    forall a. [a] -> [a]
    reverse [SCC (LiveBasicBlock instr)]
    sccs)

    -- | Computing liveness
    --
    --  On entry, the SCCs must be in "reverse" order: later blocks may transfer
    --  control to earlier ones only, else `panic`.
    --
    --  The SCCs returned are in the *opposite* order, which is exactly what we
    --  want for the next pass.
    --
    computeLiveness
            :: Instruction instr
            => Platform
            -> [SCC (LiveBasicBlock instr)]
            -> ([SCC (LiveBasicBlock instr)],       -- instructions annotated with list of registers
                                                    -- which are "dead after this instruction".
                   BlockMap RegSet)                 -- blocks annotated with set of live registers
                                                    -- on entry to the block.

    computeLiveness :: forall instr.
    Instruction instr =>
    Platform
    -> [SCC (LiveBasicBlock instr)]
    -> ([SCC (LiveBasicBlock instr)], BlockMap RegSet)
    computeLiveness Platform
    platform [SCC (LiveBasicBlock instr)]
    sccs
     = case [SCC (LiveBasicBlock instr)] -> Maybe BlockId
    forall instr.
    Instruction instr =>
    [SCC (LiveBasicBlock instr)] -> Maybe BlockId
    checkIsReverseDependent [SCC (LiveBasicBlock instr)]
    sccs of
            Maybe BlockId
    Nothing         -> Platform
    -> BlockMap RegSet
    -> [SCC (LiveBasicBlock instr)]
    -> [SCC (LiveBasicBlock instr)]
    -> ([SCC (LiveBasicBlock instr)], BlockMap RegSet)
    forall instr.
    Instruction instr =>
    Platform
    -> BlockMap RegSet
    -> [SCC (LiveBasicBlock instr)]
    -> [SCC (LiveBasicBlock instr)]
    -> ([SCC (LiveBasicBlock instr)], BlockMap RegSet)
    livenessSCCs Platform
    platform BlockMap RegSet
    forall v. LabelMap v
    mapEmpty [] [SCC (LiveBasicBlock instr)]
    sccs
            Just BlockId
    bad        -> let sccs' :: [SCC (LiveBasicBlock SDoc)]
    sccs' = (SCC (LiveBasicBlock instr) -> SCC (LiveBasicBlock SDoc))
    -> [SCC (LiveBasicBlock instr)] -> [SCC (LiveBasicBlock SDoc)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((LiveBasicBlock instr -> LiveBasicBlock SDoc)
    -> SCC (LiveBasicBlock instr) -> SCC (LiveBasicBlock SDoc)
    forall a b. (a -> b) -> SCC a -> SCC b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((LiveInstr instr -> LiveInstr SDoc)
    -> LiveBasicBlock instr -> LiveBasicBlock SDoc
    forall a b. (a -> b) -> GenBasicBlock a -> GenBasicBlock b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((instr -> SDoc) -> LiveInstr instr -> LiveInstr SDoc
    forall a b. (a -> b) -> LiveInstr a -> LiveInstr b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Platform -> instr -> SDoc
    forall instr. Instruction instr => Platform -> instr -> SDoc
    pprInstr Platform
    platform)))) [SCC (LiveBasicBlock instr)]
    sccs
                               in [Char] -> SDoc -> ([SCC (LiveBasicBlock instr)], BlockMap RegSet)
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "RegAlloc.Liveness.computeLiveness"
                                    ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat   [ [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "SCCs aren't in reverse dependent order"
                                            , [Char] -> SDoc
    forall doc. IsLine doc => [Char] -> doc
    text [Char]
    "bad blockId" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> BlockId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr BlockId
    bad
                                            , [SCC (LiveBasicBlock SDoc)] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [SCC (LiveBasicBlock SDoc)]
    sccs'])

    livenessSCCs
           :: Instruction instr
           => Platform
           -> BlockMap RegSet
           -> [SCC (LiveBasicBlock instr)]          -- accum
           -> [SCC (LiveBasicBlock instr)]
           -> ( [SCC (LiveBasicBlock instr)]
              , BlockMap RegSet)

    livenessSCCs :: forall instr.
    Instruction instr =>
    Platform
    -> BlockMap RegSet
    -> [SCC (LiveBasicBlock instr)]
    -> [SCC (LiveBasicBlock instr)]
    -> ([SCC (LiveBasicBlock instr)], BlockMap RegSet)
    livenessSCCs Platform
    _ BlockMap RegSet
    blockmap [SCC (LiveBasicBlock instr)]
    done []
            = ([SCC (LiveBasicBlock instr)]
    done, BlockMap RegSet
    blockmap)

    livenessSCCs Platform
    platform BlockMap RegSet
    blockmap [SCC (LiveBasicBlock instr)]
    done (AcyclicSCC LiveBasicBlock instr
    block : [SCC (LiveBasicBlock instr)]
    sccs)
     = let  (BlockMap RegSet
    blockmap', LiveBasicBlock instr
    block')     = Platform
    -> BlockMap RegSet
    -> LiveBasicBlock instr
    -> (BlockMap RegSet, LiveBasicBlock instr)
    forall instr.
    Instruction instr =>
    Platform
    -> BlockMap RegSet
    -> LiveBasicBlock instr
    -> (BlockMap RegSet, LiveBasicBlock instr)
    livenessBlock Platform
    platform BlockMap RegSet
    blockmap LiveBasicBlock instr
    block
       in   Platform
    -> BlockMap RegSet
    -> [SCC (LiveBasicBlock instr)]
    -> [SCC (LiveBasicBlock instr)]
    -> ([SCC (LiveBasicBlock instr)], BlockMap RegSet)
    forall instr.
    Instruction instr =>
    Platform
    -> BlockMap RegSet
    -> [SCC (LiveBasicBlock instr)]
    -> [SCC (LiveBasicBlock instr)]
    -> ([SCC (LiveBasicBlock instr)], BlockMap RegSet)
    livenessSCCs Platform
    platform BlockMap RegSet
    blockmap' (LiveBasicBlock instr -> SCC (LiveBasicBlock instr)
    forall vertex. vertex -> SCC vertex
    AcyclicSCC LiveBasicBlock instr
    block' SCC (LiveBasicBlock instr)
    -> [SCC (LiveBasicBlock instr)] -> [SCC (LiveBasicBlock instr)]
    forall a. a -> [a] -> [a]
    : [SCC (LiveBasicBlock instr)]
    done) [SCC (LiveBasicBlock instr)]
    sccs

    livenessSCCs Platform
    platform BlockMap RegSet
    blockmap [SCC (LiveBasicBlock instr)]
    done
            (CyclicSCC [LiveBasicBlock instr]
    blocks : [SCC (LiveBasicBlock instr)]
    sccs) =
            Platform
    -> BlockMap RegSet
    -> [SCC (LiveBasicBlock instr)]
    -> [SCC (LiveBasicBlock instr)]
    -> ([SCC (LiveBasicBlock instr)], BlockMap RegSet)
    forall instr.
    Instruction instr =>
    Platform
    -> BlockMap RegSet
    -> [SCC (LiveBasicBlock instr)]
    -> [SCC (LiveBasicBlock instr)]
    -> ([SCC (LiveBasicBlock instr)], BlockMap RegSet)
    livenessSCCs Platform
    platform BlockMap RegSet
    blockmap' ([LiveBasicBlock instr] -> SCC (LiveBasicBlock instr)
    forall vertex. [vertex] -> SCC vertex
    CyclicSCC [LiveBasicBlock instr]
    blocks'SCC (LiveBasicBlock instr)
    -> [SCC (LiveBasicBlock instr)] -> [SCC (LiveBasicBlock instr)]
    forall a. a -> [a] -> [a]
    :[SCC (LiveBasicBlock instr)]
    done) [SCC (LiveBasicBlock instr)]
    sccs
     where      (BlockMap RegSet
    blockmap', [LiveBasicBlock instr]
    blocks')
                    = (BlockMap RegSet
     -> [LiveBasicBlock instr]
     -> (BlockMap RegSet, [LiveBasicBlock instr]))
    -> (BlockMap RegSet -> BlockMap RegSet -> Bool)
    -> BlockMap RegSet
    -> [LiveBasicBlock instr]
    -> (BlockMap RegSet, [LiveBasicBlock instr])
    forall a b c.
    (a -> b -> (a, c)) -> (a -> a -> Bool) -> a -> b -> (a, c)
    iterateUntilUnchanged BlockMap RegSet
    -> [LiveBasicBlock instr]
    -> (BlockMap RegSet, [LiveBasicBlock instr])
    forall instr.
    Instruction instr =>
    BlockMap RegSet
    -> [LiveBasicBlock instr]
    -> (BlockMap RegSet, [LiveBasicBlock instr])
    linearLiveness BlockMap RegSet -> BlockMap RegSet -> Bool
    forall {elt}.
    Eq elt =>
    LabelMap (UniqSet elt) -> LabelMap (UniqSet elt) -> Bool
    equalBlockMaps
                                          BlockMap RegSet
    blockmap [LiveBasicBlock instr]
    blocks

                iterateUntilUnchanged
                    :: (a -> b -> (a,c)) -> (a -> a -> Bool)
                    -> a -> b
                    -> (a,c)

                iterateUntilUnchanged :: forall a b c.
    (a -> b -> (a, c)) -> (a -> a -> Bool) -> a -> b -> (a, c)
    iterateUntilUnchanged a -> b -> (a, c)
    f a -> a -> Bool
    eq a
    aa b
    b = a -> (a, c)
    go a
    aa
                  where
                    go :: a -> (a, c)
    go a
    a = if a -> a -> Bool
    eq a
    a a
    a' then (a, c)
    ac else a -> (a, c)
    go a
    a'
                      where
                        ac :: (a, c)
    ac@(a
    a', c
    _) = a -> b -> (a, c)
    f a
    a b
    b

                linearLiveness
                    :: Instruction instr
                    => BlockMap RegSet -> [LiveBasicBlock instr]
                    -> (BlockMap RegSet, [LiveBasicBlock instr])

                linearLiveness :: forall instr.
    Instruction instr =>
    BlockMap RegSet
    -> [LiveBasicBlock instr]
    -> (BlockMap RegSet, [LiveBasicBlock instr])
    linearLiveness = (BlockMap RegSet
     -> LiveBasicBlock instr -> (BlockMap RegSet, LiveBasicBlock instr))
    -> BlockMap RegSet
    -> [LiveBasicBlock instr]
    -> (BlockMap RegSet, [LiveBasicBlock instr])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL (Platform
    -> BlockMap RegSet
    -> LiveBasicBlock instr
    -> (BlockMap RegSet, LiveBasicBlock instr)
    forall instr.
    Instruction instr =>
    Platform
    -> BlockMap RegSet
    -> LiveBasicBlock instr
    -> (BlockMap RegSet, LiveBasicBlock instr)
    livenessBlock Platform
    platform)

                    -- probably the least efficient way to compare two
                    -- BlockMaps for equality.
                equalBlockMaps :: LabelMap (UniqSet elt) -> LabelMap (UniqSet elt) -> Bool
    equalBlockMaps LabelMap (UniqSet elt)
    a LabelMap (UniqSet elt)
    b
                    = [(BlockId, [elt])]
    a' [(BlockId, [elt])] -> [(BlockId, [elt])] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [(BlockId, [elt])]
    b'
                  where a' :: [(BlockId, [elt])]
    a' = ((BlockId, UniqSet elt) -> (BlockId, [elt]))
    -> [(BlockId, UniqSet elt)] -> [(BlockId, [elt])]
    forall a b. (a -> b) -> [a] -> [b]
    map (BlockId, UniqSet elt) -> (BlockId, [elt])
    forall {a} {elt}. (a, UniqSet elt) -> (a, [elt])
    f ([(BlockId, UniqSet elt)] -> [(BlockId, [elt])])
    -> [(BlockId, UniqSet elt)] -> [(BlockId, [elt])]
    forall a b. (a -> b) -> a -> b
    $ LabelMap (UniqSet elt) -> [(BlockId, UniqSet elt)]
    forall b. LabelMap b -> [(BlockId, b)]
    mapToList LabelMap (UniqSet elt)
    a
                        b' :: [(BlockId, [elt])]
    b' = ((BlockId, UniqSet elt) -> (BlockId, [elt]))
    -> [(BlockId, UniqSet elt)] -> [(BlockId, [elt])]
    forall a b. (a -> b) -> [a] -> [b]
    map (BlockId, UniqSet elt) -> (BlockId, [elt])
    forall {a} {elt}. (a, UniqSet elt) -> (a, [elt])
    f ([(BlockId, UniqSet elt)] -> [(BlockId, [elt])])
    -> [(BlockId, UniqSet elt)] -> [(BlockId, [elt])]
    forall a b. (a -> b) -> a -> b
    $ LabelMap (UniqSet elt) -> [(BlockId, UniqSet elt)]
    forall b. LabelMap b -> [(BlockId, b)]
    mapToList LabelMap (UniqSet elt)
    b
                        f :: (a, UniqSet elt) -> (a, [elt])
    f (a
    key,UniqSet elt
    elt) = (a
    key, UniqSet elt -> [elt]
    forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet UniqSet elt
    elt)
                        -- See Note [Unique Determinism and code generation]

    -- | Annotate a basic block with register liveness information.
    --
    livenessBlock
            :: Instruction instr
            => Platform
            -> BlockMap RegSet
            -> LiveBasicBlock instr
            -> (BlockMap RegSet, LiveBasicBlock instr)

    livenessBlock :: forall instr.
    Instruction instr =>
    Platform
    -> BlockMap RegSet
    -> LiveBasicBlock instr
    -> (BlockMap RegSet, LiveBasicBlock instr)
    livenessBlock Platform
    platform BlockMap RegSet
    blockmap (BasicBlock BlockId
    block_id [LiveInstr instr]
    instrs)
     = let
            (RegSet
    regsLiveOnEntry, [LiveInstr instr]
    instrs1)
                = Platform
    -> RegSet
    -> BlockMap RegSet
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> (RegSet, [LiveInstr instr])
    forall instr.
    Instruction instr =>
    Platform
    -> RegSet
    -> BlockMap RegSet
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> (RegSet, [LiveInstr instr])
    livenessBack Platform
    platform RegSet
    forall a. UniqSet a
    emptyUniqSet BlockMap RegSet
    blockmap [] ([LiveInstr instr] -> [LiveInstr instr]
    forall a. [a] -> [a]
    reverse [LiveInstr instr]
    instrs)
            blockmap' :: BlockMap RegSet
    blockmap'       = BlockId -> RegSet -> BlockMap RegSet -> BlockMap RegSet
    forall v. BlockId -> v -> LabelMap v -> LabelMap v
    mapInsert BlockId
    block_id RegSet
    regsLiveOnEntry BlockMap RegSet
    blockmap

            instrs2 :: [LiveInstr instr]
    instrs2         = Platform -> RegSet -> [LiveInstr instr] -> [LiveInstr instr]
    forall instr.
    Instruction instr =>
    Platform -> RegSet -> [LiveInstr instr] -> [LiveInstr instr]
    livenessForward Platform
    platform RegSet
    regsLiveOnEntry [LiveInstr instr]
    instrs1

            output :: GenBasicBlock (LiveInstr instr)
    output          = BlockId -> [LiveInstr instr] -> GenBasicBlock (LiveInstr instr)
    forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    block_id [LiveInstr instr]
    instrs2

       in   ( BlockMap RegSet
    blockmap', GenBasicBlock (LiveInstr instr)
    output)

    -- | Calculate liveness going forwards,
    --   filling in when regs are born

    livenessForward
            :: Instruction instr
            => Platform
            -> RegSet                       -- regs live on this instr
            -> [LiveInstr instr] -> [LiveInstr instr]

    livenessForward :: forall instr.
    Instruction instr =>
    Platform -> RegSet -> [LiveInstr instr] -> [LiveInstr instr]
    livenessForward Platform
    _        RegSet
    _           []  = []
    livenessForward Platform
    platform RegSet
    rsLiveEntry (li :: LiveInstr instr
    li@(LiveInstr InstrSR instr
    instr Maybe Liveness
    mLive) : [LiveInstr instr]
    lis)
            | Just Liveness
    live <- Maybe Liveness
    mLive
            = let
                    RU [Reg]
    _ [Reg]
    written  = Platform -> InstrSR instr -> RegUsage
    forall instr. Instruction instr => Platform -> instr -> RegUsage
    regUsageOfInstr Platform
    platform InstrSR instr
    instr
                    -- Regs that are written to but weren't live on entry to this instruction
                    --      are recorded as being born here.
                    rsBorn :: RegSet
    rsBorn          = [Reg] -> RegSet
    forall a. Uniquable a => [a] -> UniqSet a
    mkUniqSet
                                    ([Reg] -> RegSet) -> [Reg] -> RegSet
    forall a b. (a -> b) -> a -> b
    $ (Reg -> Bool) -> [Reg] -> [Reg]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\Reg
    r -> Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Reg -> RegSet -> Bool
    forall a. Uniquable a => a -> UniqSet a -> Bool
    elementOfUniqSet Reg
    r RegSet
    rsLiveEntry) [Reg]
    written

                    rsLiveNext :: RegSet
    rsLiveNext      = (RegSet
    rsLiveEntry RegSet -> RegSet -> RegSet
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    `unionUniqSets` RegSet
    rsBorn)
                                            RegSet -> RegSet -> RegSet
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    `minusUniqSet` (Liveness -> RegSet
    liveDieRead Liveness
    live)
                                            RegSet -> RegSet -> RegSet
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    `minusUniqSet` (Liveness -> RegSet
    liveDieWrite Liveness
    live)

            in InstrSR instr -> Maybe Liveness -> LiveInstr instr
    forall instr. InstrSR instr -> Maybe Liveness -> LiveInstr instr
    LiveInstr InstrSR instr
    instr (Liveness -> Maybe Liveness
    forall a. a -> Maybe a
    Just Liveness
    live { liveBorn = rsBorn })
                    LiveInstr instr -> [LiveInstr instr] -> [LiveInstr instr]
    forall a. a -> [a] -> [a]
    : Platform -> RegSet -> [LiveInstr instr] -> [LiveInstr instr]
    forall instr.
    Instruction instr =>
    Platform -> RegSet -> [LiveInstr instr] -> [LiveInstr instr]
    livenessForward Platform
    platform RegSet
    rsLiveNext [LiveInstr instr]
    lis

            | Bool
    otherwise
            = LiveInstr instr
    li LiveInstr instr -> [LiveInstr instr] -> [LiveInstr instr]
    forall a. a -> [a] -> [a]
    : Platform -> RegSet -> [LiveInstr instr] -> [LiveInstr instr]
    forall instr.
    Instruction instr =>
    Platform -> RegSet -> [LiveInstr instr] -> [LiveInstr instr]
    livenessForward Platform
    platform RegSet
    rsLiveEntry [LiveInstr instr]
    lis

    -- | Calculate liveness going backwards,
    --   filling in when regs die, and what regs are live across each instruction

    livenessBack
            :: Instruction instr
            => Platform
            -> RegSet                       -- regs live on this instr
            -> BlockMap RegSet              -- regs live on entry to other BBs
            -> [LiveInstr instr]            -- instructions (accum)
            -> [LiveInstr instr]            -- instructions
            -> (RegSet, [LiveInstr instr])

    livenessBack :: forall instr.
    Instruction instr =>
    Platform
    -> RegSet
    -> BlockMap RegSet
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> (RegSet, [LiveInstr instr])
    livenessBack Platform
    _        RegSet
    liveregs BlockMap RegSet
    _        [LiveInstr instr]
    done []  = (RegSet
    liveregs, [LiveInstr instr]
    done)

    livenessBack Platform
    platform RegSet
    liveregs BlockMap RegSet
    blockmap [LiveInstr instr]
    acc (LiveInstr instr
    instr : [LiveInstr instr]
    instrs)
     = let  !(!RegSet
    liveregs', LiveInstr instr
    instr')     = Platform
    -> RegSet
    -> BlockMap RegSet
    -> LiveInstr instr
    -> (RegSet, LiveInstr instr)
    forall instr.
    Instruction instr =>
    Platform
    -> RegSet
    -> BlockMap RegSet
    -> LiveInstr instr
    -> (RegSet, LiveInstr instr)
    liveness1 Platform
    platform RegSet
    liveregs BlockMap RegSet
    blockmap LiveInstr instr
    instr
       in   Platform
    -> RegSet
    -> BlockMap RegSet
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> (RegSet, [LiveInstr instr])
    forall instr.
    Instruction instr =>
    Platform
    -> RegSet
    -> BlockMap RegSet
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> (RegSet, [LiveInstr instr])
    livenessBack Platform
    platform RegSet
    liveregs' BlockMap RegSet
    blockmap (LiveInstr instr
    instr' LiveInstr instr -> [LiveInstr instr] -> [LiveInstr instr]
    forall a. a -> [a] -> [a]
    : [LiveInstr instr]
    acc) [LiveInstr instr]
    instrs

    -- don't bother tagging comments or deltas with liveness
    liveness1
            :: Instruction instr
            => Platform
            -> RegSet
            -> BlockMap RegSet
            -> LiveInstr instr
            -> (RegSet, LiveInstr instr)

    liveness1 :: forall instr.
    Instruction instr =>
    Platform
    -> RegSet
    -> BlockMap RegSet
    -> LiveInstr instr
    -> (RegSet, LiveInstr instr)
    liveness1 Platform
    _ RegSet
    liveregs BlockMap RegSet
    _ (LiveInstr InstrSR instr
    instr Maybe Liveness
    _)
            | InstrSR instr -> Bool
    forall instr. Instruction instr => instr -> Bool
    isMetaInstr InstrSR instr
    instr
            = (RegSet
    liveregs, InstrSR instr -> Maybe Liveness -> LiveInstr instr
    forall instr. InstrSR instr -> Maybe Liveness -> LiveInstr instr
    LiveInstr InstrSR instr
    instr Maybe Liveness
    forall a. Maybe a
    Nothing)

    liveness1 Platform
    platform RegSet
    liveregs BlockMap RegSet
    blockmap (LiveInstr InstrSR instr
    instr Maybe Liveness
    _)

            | Bool
    not_a_branch
            = (RegSet
    liveregs1, InstrSR instr -> Maybe Liveness -> LiveInstr instr
    forall instr. InstrSR instr -> Maybe Liveness -> LiveInstr instr
    LiveInstr InstrSR instr
    instr
                            (Liveness -> Maybe Liveness
    forall a. a -> Maybe a
    Just (Liveness -> Maybe Liveness) -> Liveness -> Maybe Liveness
    forall a b. (a -> b) -> a -> b
    $ Liveness
                            { liveBorn :: RegSet
    liveBorn      = RegSet
    forall a. UniqSet a
    emptyUniqSet
                            , liveDieRead :: RegSet
    liveDieRead   = RegSet
    r_dying
                            , liveDieWrite :: RegSet
    liveDieWrite  = RegSet
    w_dying }))

            | Bool
    otherwise
            = (RegSet
    liveregs_br, InstrSR instr -> Maybe Liveness -> LiveInstr instr
    forall instr. InstrSR instr -> Maybe Liveness -> LiveInstr instr
    LiveInstr InstrSR instr
    instr
                            (Liveness -> Maybe Liveness
    forall a. a -> Maybe a
    Just (Liveness -> Maybe Liveness) -> Liveness -> Maybe Liveness
    forall a b. (a -> b) -> a -> b
    $ Liveness
                            { liveBorn :: RegSet
    liveBorn      = RegSet
    forall a. UniqSet a
    emptyUniqSet
                            , liveDieRead :: RegSet
    liveDieRead   = [Reg] -> RegSet
    forall a. Uniquable a => [a] -> UniqSet a
    mkUniqSet [Reg]
    r_dying_br
                            , liveDieWrite :: RegSet
    liveDieWrite  = RegSet
    w_dying }))

            where
                !(RU [Reg]
    read [Reg]
    written) = Platform -> InstrSR instr -> RegUsage
    forall instr. Instruction instr => Platform -> instr -> RegUsage
    regUsageOfInstr Platform
    platform InstrSR instr
    instr

                -- registers that were written here are dead going backwards.
                -- registers that were read here are live going backwards.
                liveregs1 :: RegSet
    liveregs1   = (RegSet
    liveregs RegSet -> [Reg] -> RegSet
    forall a. Uniquable a => UniqSet a -> [a] -> UniqSet a
    `delListFromUniqSet` [Reg]
    written)
                                        RegSet -> [Reg] -> RegSet
    forall a. Uniquable a => UniqSet a -> [a] -> UniqSet a
    `addListToUniqSet` [Reg]
    read

                -- registers that are not live beyond this point, are recorded
                --  as dying here.
                r_dying :: RegSet
    r_dying     = [Reg] -> RegSet
    forall a. Uniquable a => [a] -> UniqSet a
    mkUniqSet
                              [ Reg
    reg | Reg
    reg <- [Reg]
    read, Reg
    reg Reg -> [Reg] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Reg]
    written,
                                  Bool -> Bool
    not (Reg -> RegSet -> Bool
    forall a. Uniquable a => a -> UniqSet a -> Bool
    elementOfUniqSet Reg
    reg RegSet
    liveregs) ]

                w_dying :: RegSet
    w_dying     = [Reg] -> RegSet
    forall a. Uniquable a => [a] -> UniqSet a
    mkUniqSet
                              [ Reg
    reg | Reg
    reg <- [Reg]
    written,
                                 Bool -> Bool
    not (Reg -> RegSet -> Bool
    forall a. Uniquable a => a -> UniqSet a -> Bool
    elementOfUniqSet Reg
    reg RegSet
    liveregs) ]

                -- union in the live regs from all the jump destinations of this
                -- instruction.
                targets :: [BlockId]
    targets      = InstrSR instr -> [BlockId]
    forall instr. Instruction instr => instr -> [BlockId]
    jumpDestsOfInstr InstrSR instr
    instr -- where we go from here
                not_a_branch :: Bool
    not_a_branch = [BlockId] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [BlockId]
    targets

                targetLiveRegs :: BlockId -> RegSet
    targetLiveRegs BlockId
    target
                      = case BlockId -> BlockMap RegSet -> Maybe RegSet
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    target BlockMap RegSet
    blockmap of
                                    Just RegSet
    ra -> RegSet
    ra
                                    Maybe RegSet
    Nothing -> RegSet
    emptyRegSet

                live_from_branch :: RegSet
    live_from_branch = [RegSet] -> RegSet
    forall a. [UniqSet a] -> UniqSet a
    unionManyUniqSets ((BlockId -> RegSet) -> [BlockId] -> [RegSet]
    forall a b. (a -> b) -> [a] -> [b]
    map BlockId -> RegSet
    targetLiveRegs [BlockId]
    targets)

                liveregs_br :: RegSet
    liveregs_br = RegSet
    liveregs1 RegSet -> RegSet -> RegSet
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    `unionUniqSets` RegSet
    live_from_branch

                -- registers that are live only in the branch targets should
                -- be listed as dying here.
                live_branch_only :: RegSet
    live_branch_only = RegSet
    live_from_branch RegSet -> RegSet -> RegSet
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    `minusUniqSet` RegSet
    liveregs
                r_dying_br :: [Reg]
    r_dying_br  = RegSet -> [Reg]
    forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet (RegSet
    r_dying RegSet -> RegSet -> RegSet
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    `unionUniqSets`
                                                 RegSet
    live_branch_only)
                              -- See Note [Unique Determinism and code generation]