    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    -- | Clean out unneeded spill\/reload instructions.
    --
    --   Handling of join points
    --   ~~~~~~~~~~~~~~~~~~~~~~~
    --
    --   @
    --   B1:                          B2:
    --    ...                          ...
    --       RELOAD SLOT(0), %r1          RELOAD SLOT(0), %r1
    --       ... A ...                    ... B ...
    --       jump B3                      jump B3
    --
    --                B3: ... C ...
    --                    RELOAD SLOT(0), %r1
    --                    ...
    --   @
    --
    --   The Plan
    --   ~~~~~~~~
    --
    --   As long as %r1 hasn't been written to in A, B or C then we don't need
    --   the reload in B3.
    --
    --   What we really care about here is that on the entry to B3, %r1 will
    --   always have the same value that is in SLOT(0) (ie, %r1 is _valid_)
    --
    --   This also works if the reloads in B1\/B2 were spills instead, because
    --   spilling %r1 to a slot makes that slot have the same value as %r1.
    --
    module GHC.CmmToAsm.Reg.Graph.SpillClean (
            cleanSpills
    ) where
    import GHC.Prelude

    import GHC.CmmToAsm.Reg.Liveness
    import GHC.CmmToAsm.Instr
    import GHC.Platform.Reg

    import GHC.Cmm.BlockId
    import GHC.Cmm
    import GHC.Types.Unique.Set
    import GHC.Types.Unique.FM
    import GHC.Types.Unique
    import GHC.Builtin.Uniques
    import GHC.Utils.Monad.State.Strict
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Platform
    import GHC.Cmm.Dataflow.Label

    import Data.List (nub, foldl1', find)
    import Data.Maybe
    import Data.IntSet              (IntSet)
    import qualified Data.IntSet    as IntSet

    -- | The identification number of a spill slot.
    --   A value is stored in a spill slot when we don't have a free
    --   register to hold it.
    type Slot = Int

    -- | Clean out unneeded spill\/reloads from this top level thing.
    cleanSpills
            :: Instruction instr
            => Platform
            -> LiveCmmDecl statics instr
            -> LiveCmmDecl statics instr

    cleanSpills :: forall instr statics.
    Instruction instr =>
    Platform -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
    cleanSpills Platform
    platform LiveCmmDecl statics instr
    cmm
            = State CleanS (LiveCmmDecl statics instr)
    -> CleanS -> LiveCmmDecl statics instr
    forall s a. State s a -> s -> a
    evalState (Platform
    -> Int
    -> LiveCmmDecl statics instr
    -> State CleanS (LiveCmmDecl statics instr)
    forall instr statics.
    Instruction instr =>
    Platform
    -> Int
    -> LiveCmmDecl statics instr
    -> CleanM (LiveCmmDecl statics instr)
    cleanSpin Platform
    platform Int
    0 LiveCmmDecl statics instr
    cmm) CleanS
    initCleanS

    -- | Do one pass of cleaning.
    cleanSpin
            :: Instruction instr
            => Platform
            -> Int                              -- ^ Iteration number for the cleaner.
            -> LiveCmmDecl statics instr        -- ^ Liveness annotated code to clean.
            -> CleanM (LiveCmmDecl statics instr)

    cleanSpin :: forall instr statics.
    Instruction instr =>
    Platform
    -> Int
    -> LiveCmmDecl statics instr
    -> CleanM (LiveCmmDecl statics instr)
    cleanSpin Platform
    platform Int
    spinCount LiveCmmDecl statics instr
    code
     = do
            -- Initialise count of cleaned spill and reload instructions.
            (CleanS -> CleanS) -> State CleanS ()
    forall s. (s -> s) -> State s ()
    modify ((CleanS -> CleanS) -> State CleanS ())
    -> (CleanS -> CleanS) -> State CleanS ()
    forall a b. (a -> b) -> a -> b
    $ \CleanS
    s -> CleanS
    s
                    { sCleanedSpillsAcc     = 0
                    , sCleanedReloadsAcc    = 0
                    , sReloadedBy           = emptyUFM }

            code_forward    <- (LiveBasicBlock instr -> State CleanS (LiveBasicBlock instr))
    -> LiveCmmDecl statics instr
    -> State CleanS (LiveCmmDecl statics instr)
    forall (m :: * -> *) instr statics.
    Monad m =>
    (LiveBasicBlock instr -> m (LiveBasicBlock instr))
    -> LiveCmmDecl statics instr -> m (LiveCmmDecl statics instr)
    mapBlockTopM (Platform
    -> LiveBasicBlock instr -> State CleanS (LiveBasicBlock instr)
    forall instr.
    Instruction instr =>
    Platform -> LiveBasicBlock instr -> CleanM (LiveBasicBlock instr)
    cleanBlockForward Platform
    platform) LiveCmmDecl statics instr
    code
            code_backward   <- cleanTopBackward code_forward

            -- During the cleaning of each block we collected information about
            -- what regs were valid across each jump. Based on this, work out
            -- whether it will be safe to erase reloads after join points for
            -- the next pass.
            collateJoinPoints

            -- Remember how many spill and reload instructions we cleaned in this pass.
            spills          <- gets sCleanedSpillsAcc
            reloads         <- gets sCleanedReloadsAcc
            modify $ \CleanS
    s -> CleanS
    s
                    { sCleanedCount = (spills, reloads) : sCleanedCount s }

            -- If nothing was cleaned in this pass or the last one
            --      then we're done and it's time to bail out.
            cleanedCount    <- gets sCleanedCount
            if take 2 cleanedCount == [(0, 0), (0, 0)]
               then return code

            -- otherwise go around again
               else cleanSpin platform (spinCount + 1) code_backward

    -------------------------------------------------------------------------------
    -- | Clean out unneeded reload instructions,
    --   while walking forward over the code.
    cleanBlockForward
            :: Instruction instr
            => Platform
            -> LiveBasicBlock instr
            -> CleanM (LiveBasicBlock instr)

    cleanBlockForward :: forall instr.
    Instruction instr =>
    Platform -> LiveBasicBlock instr -> CleanM (LiveBasicBlock instr)
    cleanBlockForward Platform
    platform (BasicBlock BlockId
    blockId [LiveInstr instr]
    instrs)
     = do
            -- See if we have a valid association for the entry to this block.
            jumpValid       <- (CleanS -> UniqFM BlockId (Assoc Store))
    -> State CleanS (UniqFM BlockId (Assoc Store))
    forall s a. (s -> a) -> State s a
    gets CleanS -> UniqFM BlockId (Assoc Store)
    sJumpValid
            let assoc       = case UniqFM BlockId (Assoc Store) -> BlockId -> Maybe (Assoc Store)
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM BlockId (Assoc Store)
    jumpValid BlockId
    blockId of
                                    Just Assoc Store
    assoc      -> Assoc Store
    assoc
                                    Maybe (Assoc Store)
    Nothing         -> Assoc Store
    forall a. Assoc a
    emptyAssoc

            instrs_reload   <- cleanForward platform blockId assoc [] instrs
            return  $ BasicBlock blockId instrs_reload

    -- | Clean out unneeded reload instructions.
    --
    --   Walking forwards across the code
    --     On a reload, if we know a reg already has the same value as a slot
    --     then we don't need to do the reload.
    --
    cleanForward
            :: Instruction instr
            => Platform
            -> BlockId                  -- ^ the block that we're currently in
            -> Assoc Store              -- ^ two store locations are associated if
                                        --     they have the same value
            -> [LiveInstr instr]        -- ^ acc
            -> [LiveInstr instr]        -- ^ instrs to clean (in backwards order)
            -> CleanM [LiveInstr instr] -- ^ cleaned instrs  (in forward   order)

    cleanForward :: forall instr.
    Instruction instr =>
    Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanForward Platform
    _ BlockId
    _ Assoc Store
    _ [LiveInstr instr]
    acc []
            = [LiveInstr instr] -> State CleanS [LiveInstr instr]
    forall a. a -> State CleanS a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [LiveInstr instr]
    acc

    -- Rewrite live range joins via spill slots to just a spill and a reg-reg move
    -- hopefully the spill will be also be cleaned in the next pass
    cleanForward Platform
    platform BlockId
    blockId Assoc Store
    assoc [LiveInstr instr]
    acc (LiveInstr instr
    li1 : LiveInstr instr
    li2 : [LiveInstr instr]
    instrs)

            | LiveInstr (SPILL  Reg
    reg1  Int
    slot1) Maybe Liveness
    _      <- LiveInstr instr
    li1
            , LiveInstr (RELOAD Int
    slot2 Reg
    reg2)  Maybe Liveness
    _      <- LiveInstr instr
    li2
            , Int
    slot1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    slot2
            = do
                    (CleanS -> CleanS) -> State CleanS ()
    forall s. (s -> s) -> State s ()
    modify ((CleanS -> CleanS) -> State CleanS ())
    -> (CleanS -> CleanS) -> State CleanS ()
    forall a b. (a -> b) -> a -> b
    $ \CleanS
    s -> CleanS
    s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
                    Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> State CleanS [LiveInstr instr]
    forall instr.
    Instruction instr =>
    Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanForward Platform
    platform BlockId
    blockId Assoc Store
    assoc [LiveInstr instr]
    acc
                     ([LiveInstr instr] -> State CleanS [LiveInstr instr])
    -> [LiveInstr instr] -> State CleanS [LiveInstr instr]
    forall a b. (a -> b) -> a -> b
    $ LiveInstr instr
    li1 LiveInstr instr -> [LiveInstr instr] -> [LiveInstr instr]
    forall a. a -> [a] -> [a]
    : InstrSR instr -> Maybe Liveness -> LiveInstr instr
    forall instr. InstrSR instr -> Maybe Liveness -> LiveInstr instr
    LiveInstr (Platform -> Reg -> Reg -> InstrSR instr
    forall instr. Instruction instr => Platform -> Reg -> Reg -> instr
    mkRegRegMoveInstr Platform
    platform Reg
    reg1 Reg
    reg2) Maybe Liveness
    forall a. Maybe a
    Nothing
                           LiveInstr instr -> [LiveInstr instr] -> [LiveInstr instr]
    forall a. a -> [a] -> [a]
    : [LiveInstr instr]
    instrs

    cleanForward Platform
    platform BlockId
    blockId Assoc Store
    assoc [LiveInstr instr]
    acc (li :: LiveInstr instr
    li@(LiveInstr InstrSR instr
    i1 Maybe Liveness
    _) : [LiveInstr instr]
    instrs)
            | Just (Reg
    r1, Reg
    r2) <- InstrSR instr -> Maybe (Reg, Reg)
    forall instr. Instruction instr => instr -> Maybe (Reg, Reg)
    takeRegRegMoveInstr InstrSR instr
    i1
            = if Reg
    r1 Reg -> Reg -> Bool
    forall a. Eq a => a -> a -> Bool
    == Reg
    r2
                    -- Erase any left over nop reg reg moves while we're here
                    -- this will also catch any nop moves that the previous case
                    -- happens to add.
                    then Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> State CleanS [LiveInstr instr]
    forall instr.
    Instruction instr =>
    Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanForward Platform
    platform BlockId
    blockId Assoc Store
    assoc [LiveInstr instr]
    acc [LiveInstr instr]
    instrs

                    -- If r1 has the same value as some slots and we copy r1 to r2,
                    --      then r2 is now associated with those slots instead
                    else do let assoc' :: Assoc Store
    assoc'      = Store -> Store -> Assoc Store -> Assoc Store
    addAssoc (Reg -> Store
    SReg Reg
    r1) (Reg -> Store
    SReg Reg
    r2)
                                            (Assoc Store -> Assoc Store) -> Assoc Store -> Assoc Store
    forall a b. (a -> b) -> a -> b
    $ Store -> Assoc Store -> Assoc Store
    delAssoc (Reg -> Store
    SReg Reg
    r2)
                                            (Assoc Store -> Assoc Store) -> Assoc Store -> Assoc Store
    forall a b. (a -> b) -> a -> b
    $ Assoc Store
    assoc

                            Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> State CleanS [LiveInstr instr]
    forall instr.
    Instruction instr =>
    Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanForward Platform
    platform BlockId
    blockId Assoc Store
    assoc' (LiveInstr instr
    li LiveInstr instr -> [LiveInstr instr] -> [LiveInstr instr]
    forall a. a -> [a] -> [a]
    : [LiveInstr instr]
    acc) [LiveInstr instr]
    instrs

    cleanForward Platform
    platform BlockId
    blockId Assoc Store
    assoc [LiveInstr instr]
    acc (LiveInstr instr
    li : [LiveInstr instr]
    instrs)

            -- Update association due to the spill.
            | LiveInstr (SPILL Reg
    reg Int
    slot) Maybe Liveness
    _  <- LiveInstr instr
    li
            = let   assoc' :: Assoc Store
    assoc'  = Store -> Store -> Assoc Store -> Assoc Store
    addAssoc (Reg -> Store
    SReg Reg
    reg)  (Int -> Store
    SSlot Int
    slot)
                            (Assoc Store -> Assoc Store) -> Assoc Store -> Assoc Store
    forall a b. (a -> b) -> a -> b
    $ Store -> Assoc Store -> Assoc Store
    delAssoc (Int -> Store
    SSlot Int
    slot)
                            (Assoc Store -> Assoc Store) -> Assoc Store -> Assoc Store
    forall a b. (a -> b) -> a -> b
    $ Assoc Store
    assoc
              in    Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> State CleanS [LiveInstr instr]
    forall instr.
    Instruction instr =>
    Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanForward Platform
    platform BlockId
    blockId Assoc Store
    assoc' (LiveInstr instr
    li LiveInstr instr -> [LiveInstr instr] -> [LiveInstr instr]
    forall a. a -> [a] -> [a]
    : [LiveInstr instr]
    acc) [LiveInstr instr]
    instrs

            -- Clean a reload instr.
            | LiveInstr (RELOAD{}) Maybe Liveness
    _        <- LiveInstr instr
    li
            = do    (assoc', mli)   <- Platform
    -> BlockId
    -> Assoc Store
    -> LiveInstr instr
    -> CleanM (Assoc Store, Maybe (LiveInstr instr))
    forall instr.
    Instruction instr =>
    Platform
    -> BlockId
    -> Assoc Store
    -> LiveInstr instr
    -> CleanM (Assoc Store, Maybe (LiveInstr instr))
    cleanReload Platform
    platform BlockId
    blockId Assoc Store
    assoc LiveInstr instr
    li
                    case mli of
                     Maybe (LiveInstr instr)
    Nothing        -> Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> State CleanS [LiveInstr instr]
    forall instr.
    Instruction instr =>
    Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanForward Platform
    platform BlockId
    blockId Assoc Store
    assoc' [LiveInstr instr]
    acc
                                                    [LiveInstr instr]
    instrs

                     Just LiveInstr instr
    li'       -> Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> State CleanS [LiveInstr instr]
    forall instr.
    Instruction instr =>
    Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanForward Platform
    platform BlockId
    blockId Assoc Store
    assoc' (LiveInstr instr
    li' LiveInstr instr -> [LiveInstr instr] -> [LiveInstr instr]
    forall a. a -> [a] -> [a]
    : [LiveInstr instr]
    acc)
                                                    [LiveInstr instr]
    instrs

            -- Remember the association over a jump.
            | LiveInstr InstrSR instr
    instr Maybe Liveness
    _     <- LiveInstr instr
    li
            , [BlockId]
    targets               <- InstrSR instr -> [BlockId]
    forall instr. Instruction instr => instr -> [BlockId]
    jumpDestsOfInstr InstrSR 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 CleanS ()) -> [BlockId] -> State CleanS ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Assoc Store -> BlockId -> State CleanS ()
    accJumpValid Assoc Store
    assoc) [BlockId]
    targets
                    Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> State CleanS [LiveInstr instr]
    forall instr.
    Instruction instr =>
    Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanForward Platform
    platform BlockId
    blockId Assoc Store
    assoc (LiveInstr instr
    li LiveInstr instr -> [LiveInstr instr] -> [LiveInstr instr]
    forall a. a -> [a] -> [a]
    : [LiveInstr instr]
    acc) [LiveInstr instr]
    instrs

            -- Writing to a reg changes its value.
            | LiveInstr InstrSR instr
    instr Maybe Liveness
    _     <- LiveInstr instr
    li
            , RU [Reg]
    _ [Reg]
    written          <- Platform -> InstrSR instr -> RegUsage
    forall instr. Instruction instr => Platform -> instr -> RegUsage
    regUsageOfInstr Platform
    platform InstrSR instr
    instr
            = let assoc' :: Assoc Store
    assoc'    = (Store -> Assoc Store -> Assoc Store)
    -> Assoc Store -> [Store] -> Assoc Store
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Store -> Assoc Store -> Assoc Store
    delAssoc Assoc Store
    assoc ((Reg -> Store) -> [Reg] -> [Store]
    forall a b. (a -> b) -> [a] -> [b]
    map Reg -> Store
    SReg ([Reg] -> [Store]) -> [Reg] -> [Store]
    forall a b. (a -> b) -> a -> b
    $ [Reg] -> [Reg]
    forall a. Eq a => [a] -> [a]
    nub [Reg]
    written)
              in  Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> State CleanS [LiveInstr instr]
    forall instr.
    Instruction instr =>
    Platform
    -> BlockId
    -> Assoc Store
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanForward Platform
    platform BlockId
    blockId Assoc Store
    assoc' (LiveInstr instr
    li LiveInstr instr -> [LiveInstr instr] -> [LiveInstr instr]
    forall a. a -> [a] -> [a]
    : [LiveInstr instr]
    acc) [LiveInstr instr]
    instrs

    -- | Try and rewrite a reload instruction to something more pleasing
    cleanReload
            :: Instruction instr
            => Platform
            -> BlockId
            -> Assoc Store
            -> LiveInstr instr
            -> CleanM (Assoc Store, Maybe (LiveInstr instr))

    cleanReload :: forall instr.
    Instruction instr =>
    Platform
    -> BlockId
    -> Assoc Store
    -> LiveInstr instr
    -> CleanM (Assoc Store, Maybe (LiveInstr instr))
    cleanReload Platform
    platform BlockId
    blockId Assoc Store
    assoc li :: LiveInstr instr
    li@(LiveInstr (RELOAD Int
    slot Reg
    reg) Maybe Liveness
    _)

            -- If the reg we're reloading already has the same value as the slot
            --      then we can erase the instruction outright.
            | Store -> Store -> Assoc Store -> Bool
    elemAssoc (Int -> Store
    SSlot Int
    slot) (Reg -> Store
    SReg Reg
    reg) Assoc Store
    assoc
            = do    (CleanS -> CleanS) -> State CleanS ()
    forall s. (s -> s) -> State s ()
    modify  ((CleanS -> CleanS) -> State CleanS ())
    -> (CleanS -> CleanS) -> State CleanS ()
    forall a b. (a -> b) -> a -> b
    $ \CleanS
    s -> CleanS
    s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }
                    (Assoc Store, Maybe (LiveInstr instr))
    -> State CleanS (Assoc Store, Maybe (LiveInstr instr))
    forall a. a -> State CleanS a
    forall (m :: * -> *) a. Monad m => a -> m a
    return  (Assoc Store
    assoc, Maybe (LiveInstr instr)
    forall a. Maybe a
    Nothing)

            -- If we can find another reg with the same value as this slot then
            --      do a move instead of a reload.
            | Just Reg
    reg2     <- Assoc Store -> Int -> Maybe Reg
    findRegOfSlot Assoc Store
    assoc Int
    slot
            = do    (CleanS -> CleanS) -> State CleanS ()
    forall s. (s -> s) -> State s ()
    modify ((CleanS -> CleanS) -> State CleanS ())
    -> (CleanS -> CleanS) -> State CleanS ()
    forall a b. (a -> b) -> a -> b
    $ \CleanS
    s -> CleanS
    s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 }

                    let assoc' :: Assoc Store
    assoc'      = Store -> Store -> Assoc Store -> Assoc Store
    addAssoc (Reg -> Store
    SReg Reg
    reg) (Reg -> Store
    SReg Reg
    reg2)
                                    (Assoc Store -> Assoc Store) -> Assoc Store -> Assoc Store
    forall a b. (a -> b) -> a -> b
    $ Store -> Assoc Store -> Assoc Store
    delAssoc (Reg -> Store
    SReg Reg
    reg)
                                    (Assoc Store -> Assoc Store) -> Assoc Store -> Assoc Store
    forall a b. (a -> b) -> a -> b
    $ Assoc Store
    assoc

                    (Assoc Store, Maybe (LiveInstr instr))
    -> State CleanS (Assoc Store, Maybe (LiveInstr instr))
    forall a. a -> State CleanS a
    forall (m :: * -> *) a. Monad m => a -> m a
    return  ( Assoc Store
    assoc'
                            , LiveInstr instr -> Maybe (LiveInstr instr)
    forall a. a -> Maybe a
    Just (LiveInstr instr -> Maybe (LiveInstr instr))
    -> LiveInstr instr -> Maybe (LiveInstr instr)
    forall a b. (a -> b) -> a -> b
    $ InstrSR instr -> Maybe Liveness -> LiveInstr instr
    forall instr. InstrSR instr -> Maybe Liveness -> LiveInstr instr
    LiveInstr (Platform -> Reg -> Reg -> InstrSR instr
    forall instr. Instruction instr => Platform -> Reg -> Reg -> instr
    mkRegRegMoveInstr Platform
    platform Reg
    reg2 Reg
    reg) Maybe Liveness
    forall a. Maybe a
    Nothing)

            -- Gotta keep this instr.
            | Bool
    otherwise
            = do    -- Update the association.
                    let assoc' :: Assoc Store
    assoc'
                            = Store -> Store -> Assoc Store -> Assoc Store
    addAssoc (Reg -> Store
    SReg Reg
    reg)  (Int -> Store
    SSlot Int
    slot)
                                    -- doing the reload makes reg and slot the same value
                            (Assoc Store -> Assoc Store) -> Assoc Store -> Assoc Store
    forall a b. (a -> b) -> a -> b
    $ Store -> Assoc Store -> Assoc Store
    delAssoc (Reg -> Store
    SReg Reg
    reg)
                                    -- reg value changes on reload
                            (Assoc Store -> Assoc Store) -> Assoc Store -> Assoc Store
    forall a b. (a -> b) -> a -> b
    $ Assoc Store
    assoc

                    -- Remember that this block reloads from this slot.
                    BlockId -> Int -> State CleanS ()
    accBlockReloadsSlot BlockId
    blockId Int
    slot

                    (Assoc Store, Maybe (LiveInstr instr))
    -> State CleanS (Assoc Store, Maybe (LiveInstr instr))
    forall a. a -> State CleanS a
    forall (m :: * -> *) a. Monad m => a -> m a
    return  (Assoc Store
    assoc', LiveInstr instr -> Maybe (LiveInstr instr)
    forall a. a -> Maybe a
    Just LiveInstr instr
    li)

    cleanReload Platform
    _ BlockId
    _ Assoc Store
    _ LiveInstr instr
    _
            = String -> State CleanS (Assoc Store, Maybe (LiveInstr instr))
    forall a. HasCallStack => String -> a
    panic String
    "RegSpillClean.cleanReload: unhandled instr"

    -------------------------------------------------------------------------------
    -- | Clean out unneeded spill instructions,
    --   while walking backwards over the code.
    --
    --      If there were no reloads from a slot between a spill and the last one
    --      then the slot was never read and we don't need the spill.
    --
    --      SPILL   r0 -> s1
    --      RELOAD  s1 -> r2
    --      SPILL   r3 -> s1        <--- don't need this spill
    --      SPILL   r4 -> s1
    --      RELOAD  s1 -> r5
    --
    --      Maintain a set of
    --              "slots which were spilled to but not reloaded from yet"
    --
    --      Walking backwards across the code:
    --       a) On a reload from a slot, remove it from the set.
    --
    --       a) On a spill from a slot
    --              If the slot is in set then we can erase the spill,
    --               because it won't be reloaded from until after the next spill.
    --
    --              otherwise
    --               keep the spill and add the slot to the set
    --
    -- TODO: This is mostly inter-block
    --       we should really be updating the noReloads set as we cross jumps also.
    --
    -- TODO: generate noReloads from liveSlotsOnEntry
    --
    cleanTopBackward
            :: Instruction instr
            => LiveCmmDecl statics instr
            -> CleanM (LiveCmmDecl statics instr)

    cleanTopBackward :: forall instr statics.
    Instruction instr =>
    LiveCmmDecl statics instr -> CleanM (LiveCmmDecl statics instr)
    cleanTopBackward LiveCmmDecl statics instr
    cmm
     = case LiveCmmDecl statics instr
    cmm of
            CmmData{}
             -> LiveCmmDecl statics instr -> CleanM (LiveCmmDecl statics instr)
    forall a. a -> State CleanS a
    forall (m :: * -> *) a. Monad m => a -> m a
    return LiveCmmDecl statics instr
    cmm

            CmmProc LiveInfo
    info CLabel
    label [GlobalReg]
    live [SCC (LiveBasicBlock instr)]
    sccs
             | LiveInfo LabelMap RawCmmStatics
    _ [BlockId]
    _ BlockMap RegSet
    _ BlockMap IntSet
    liveSlotsOnEntry <- LiveInfo
    info
             -> do  sccs'   <- (SCC (LiveBasicBlock instr)
     -> State CleanS (SCC (LiveBasicBlock instr)))
    -> [SCC (LiveBasicBlock instr)]
    -> State CleanS [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 -> State CleanS (LiveBasicBlock instr))
    -> SCC (LiveBasicBlock instr)
    -> State CleanS (SCC (LiveBasicBlock instr))
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SCC a -> m (SCC b)
    mapSCCM (BlockMap IntSet
    -> LiveBasicBlock instr -> State CleanS (LiveBasicBlock instr)
    forall instr.
    Instruction instr =>
    BlockMap IntSet
    -> LiveBasicBlock instr -> CleanM (LiveBasicBlock instr)
    cleanBlockBackward BlockMap IntSet
    liveSlotsOnEntry)) [SCC (LiveBasicBlock instr)]
    sccs
                    return  $ CmmProc info label live sccs'

    cleanBlockBackward
            :: Instruction instr
            => BlockMap IntSet
            -> LiveBasicBlock instr
            -> CleanM (LiveBasicBlock instr)

    cleanBlockBackward :: forall instr.
    Instruction instr =>
    BlockMap IntSet
    -> LiveBasicBlock instr -> CleanM (LiveBasicBlock instr)
    cleanBlockBackward BlockMap IntSet
    liveSlotsOnEntry (BasicBlock BlockId
    blockId [LiveInstr instr]
    instrs)
     = do   instrs_spill    <- BlockMap IntSet
    -> UniqSet Int
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    forall instr.
    Instruction instr =>
    BlockMap IntSet
    -> UniqSet Int
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanBackward BlockMap IntSet
    liveSlotsOnEntry  UniqSet Int
    forall a. UniqSet a
    emptyUniqSet  [] [LiveInstr instr]
    instrs
            return  $ BasicBlock blockId instrs_spill

    cleanBackward
            :: Instruction instr
            => BlockMap IntSet          -- ^ Slots live on entry to each block
            -> UniqSet Int              -- ^ Slots that have been spilled, but not reloaded from
            -> [LiveInstr instr]        -- ^ acc
            -> [LiveInstr instr]        -- ^ Instrs to clean (in forwards order)
            -> CleanM [LiveInstr instr] -- ^ Cleaned instrs  (in backwards order)

    cleanBackward :: forall instr.
    Instruction instr =>
    BlockMap IntSet
    -> UniqSet Int
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanBackward BlockMap IntSet
    liveSlotsOnEntry UniqSet Int
    noReloads [LiveInstr instr]
    acc [LiveInstr instr]
    lis
     = do   reloadedBy      <- (CleanS -> UniqFM Store [BlockId])
    -> State CleanS (UniqFM Store [BlockId])
    forall s a. (s -> a) -> State s a
    gets CleanS -> UniqFM Store [BlockId]
    sReloadedBy
            cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc lis

    cleanBackward'
            :: Instruction instr
            => BlockMap IntSet
            -> UniqFM Store [BlockId]
            -> UniqSet Int
            -> [LiveInstr instr]
            -> [LiveInstr instr]
            -> State CleanS [LiveInstr instr]

    cleanBackward' :: forall instr.
    Instruction instr =>
    BlockMap IntSet
    -> UniqFM Store [BlockId]
    -> UniqSet Int
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> State CleanS [LiveInstr instr]
    cleanBackward' BlockMap IntSet
    _ UniqFM Store [BlockId]
    _ UniqSet Int
    _      [LiveInstr instr]
    acc []
            = [LiveInstr instr] -> State CleanS [LiveInstr instr]
    forall a. a -> State CleanS a
    forall (m :: * -> *) a. Monad m => a -> m a
    return  [LiveInstr instr]
    acc

    cleanBackward' BlockMap IntSet
    liveSlotsOnEntry UniqFM Store [BlockId]
    reloadedBy UniqSet Int
    noReloads [LiveInstr instr]
    acc (LiveInstr instr
    li : [LiveInstr instr]
    instrs)

            -- If nothing ever reloads from this slot then we don't need the spill.
            | LiveInstr (SPILL Reg
    _ Int
    slot) Maybe Liveness
    _    <- LiveInstr instr
    li
            , Maybe [BlockId]
    Nothing       <- UniqFM Store [BlockId] -> Store -> Maybe [BlockId]
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM Store [BlockId]
    reloadedBy (Int -> Store
    SSlot Int
    slot)
            = do    (CleanS -> CleanS) -> State CleanS ()
    forall s. (s -> s) -> State s ()
    modify ((CleanS -> CleanS) -> State CleanS ())
    -> (CleanS -> CleanS) -> State CleanS ()
    forall a b. (a -> b) -> a -> b
    $ \CleanS
    s -> CleanS
    s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
                    BlockMap IntSet
    -> UniqSet Int
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> State CleanS [LiveInstr instr]
    forall instr.
    Instruction instr =>
    BlockMap IntSet
    -> UniqSet Int
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanBackward BlockMap IntSet
    liveSlotsOnEntry UniqSet Int
    noReloads [LiveInstr instr]
    acc [LiveInstr instr]
    instrs

            | LiveInstr (SPILL Reg
    _ Int
    slot) Maybe Liveness
    _    <- LiveInstr instr
    li
            = if Int -> UniqSet Int -> Bool
    forall a. Uniquable a => a -> UniqSet a -> Bool
    elementOfUniqSet Int
    slot UniqSet Int
    noReloads

               -- We can erase this spill because the slot won't be read until
               -- after the next one
               then do
                    (CleanS -> CleanS) -> State CleanS ()
    forall s. (s -> s) -> State s ()
    modify ((CleanS -> CleanS) -> State CleanS ())
    -> (CleanS -> CleanS) -> State CleanS ()
    forall a b. (a -> b) -> a -> b
    $ \CleanS
    s -> CleanS
    s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 }
                    BlockMap IntSet
    -> UniqSet Int
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> State CleanS [LiveInstr instr]
    forall instr.
    Instruction instr =>
    BlockMap IntSet
    -> UniqSet Int
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanBackward BlockMap IntSet
    liveSlotsOnEntry UniqSet Int
    noReloads [LiveInstr instr]
    acc [LiveInstr instr]
    instrs

               else do
                    -- This slot is being spilled to, but we haven't seen any reloads yet.
                    let noReloads' :: UniqSet Int
    noReloads'  = UniqSet Int -> Int -> UniqSet Int
    forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    addOneToUniqSet UniqSet Int
    noReloads Int
    slot
                    BlockMap IntSet
    -> UniqSet Int
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> State CleanS [LiveInstr instr]
    forall instr.
    Instruction instr =>
    BlockMap IntSet
    -> UniqSet Int
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanBackward BlockMap IntSet
    liveSlotsOnEntry UniqSet Int
    noReloads' (LiveInstr instr
    li LiveInstr instr -> [LiveInstr instr] -> [LiveInstr instr]
    forall a. a -> [a] -> [a]
    : [LiveInstr instr]
    acc) [LiveInstr instr]
    instrs

            -- if we reload from a slot then it's no longer unused
            | LiveInstr (RELOAD Int
    slot Reg
    _) Maybe Liveness
    _   <- LiveInstr instr
    li
            , UniqSet Int
    noReloads'            <- UniqSet Int -> Int -> UniqSet Int
    forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    delOneFromUniqSet UniqSet Int
    noReloads Int
    slot
            = BlockMap IntSet
    -> UniqSet Int
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> State CleanS [LiveInstr instr]
    forall instr.
    Instruction instr =>
    BlockMap IntSet
    -> UniqSet Int
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanBackward BlockMap IntSet
    liveSlotsOnEntry UniqSet Int
    noReloads' (LiveInstr instr
    li LiveInstr instr -> [LiveInstr instr] -> [LiveInstr instr]
    forall a. a -> [a] -> [a]
    : [LiveInstr instr]
    acc) [LiveInstr instr]
    instrs

            -- If a slot is live in a jump target then assume it's reloaded there.
            --
            -- TODO: A real dataflow analysis would do a better job here.
            --       If the target block _ever_ used the slot then we assume
            --       it always does, but if those reloads are cleaned the slot
            --       liveness map doesn't get updated.
            | LiveInstr InstrSR instr
    instr Maybe Liveness
    _     <- LiveInstr instr
    li
            , [BlockId]
    targets               <- InstrSR instr -> [BlockId]
    forall instr. Instruction instr => instr -> [BlockId]
    jumpDestsOfInstr InstrSR instr
    instr
            = do
                    let slotsReloadedByTargets :: IntSet
    slotsReloadedByTargets
                            = [IntSet] -> IntSet
    forall (f :: * -> *). Foldable f => f IntSet -> IntSet
    IntSet.unions
                            ([IntSet] -> IntSet) -> [IntSet] -> IntSet
    forall a b. (a -> b) -> a -> b
    $ (BlockId -> Maybe IntSet) -> [BlockId] -> [IntSet]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ((BlockId -> BlockMap IntSet -> Maybe IntSet)
    -> BlockMap IntSet -> BlockId -> Maybe IntSet
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip BlockId -> BlockMap IntSet -> Maybe IntSet
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockMap IntSet
    liveSlotsOnEntry)
                            ([BlockId] -> [IntSet]) -> [BlockId] -> [IntSet]
    forall a b. (a -> b) -> a -> b
    $ [BlockId]
    targets

                    let noReloads' :: UniqSet Int
    noReloads'
                            = (UniqSet Int -> Int -> UniqSet Int)
    -> UniqSet Int -> [Int] -> UniqSet Int
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' UniqSet Int -> Int -> UniqSet Int
    forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    delOneFromUniqSet UniqSet Int
    noReloads
                            ([Int] -> UniqSet Int) -> [Int] -> UniqSet Int
    forall a b. (a -> b) -> a -> b
    $ IntSet -> [Int]
    IntSet.toList IntSet
    slotsReloadedByTargets

                    BlockMap IntSet
    -> UniqSet Int
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> State CleanS [LiveInstr instr]
    forall instr.
    Instruction instr =>
    BlockMap IntSet
    -> UniqSet Int
    -> [LiveInstr instr]
    -> [LiveInstr instr]
    -> CleanM [LiveInstr instr]
    cleanBackward BlockMap IntSet
    liveSlotsOnEntry UniqSet Int
    noReloads' (LiveInstr instr
    li LiveInstr instr -> [LiveInstr instr] -> [LiveInstr instr]
    forall a. a -> [a] -> [a]
    : [LiveInstr instr]
    acc) [LiveInstr instr]
    instrs

    -- | Combine the associations from all the inward control flow edges.
    --
    collateJoinPoints :: CleanM ()
    collateJoinPoints :: State CleanS ()
    collateJoinPoints
     = (CleanS -> CleanS) -> State CleanS ()
    forall s. (s -> s) -> State s ()
    modify ((CleanS -> CleanS) -> State CleanS ())
    -> (CleanS -> CleanS) -> State CleanS ()
    forall a b. (a -> b) -> a -> b
    $ \CleanS
    s -> CleanS
    s
            { sJumpValid    = mapUFM intersects (sJumpValidAcc s)
            , sJumpValidAcc = emptyUFM }

    intersects :: [Assoc Store]     -> Assoc Store
    intersects :: [Assoc Store] -> Assoc Store
    intersects []           = Assoc Store
    forall a. Assoc a
    emptyAssoc
    intersects [Assoc Store]
    assocs       = (Assoc Store -> Assoc Store -> Assoc Store)
    -> [Assoc Store] -> Assoc Store
    forall a. HasCallStack => (a -> a -> a) -> [a] -> a
    foldl1' Assoc Store -> Assoc Store -> Assoc Store
    intersectAssoc [Assoc Store]
    assocs

    -- | See if we have a reg with the same value as this slot in the association table.
    findRegOfSlot :: Assoc Store -> Int -> Maybe Reg
    findRegOfSlot :: Assoc Store -> Int -> Maybe Reg
    findRegOfSlot Assoc Store
    assoc Int
    slot
            | UniqSet Store
    close                 <- Store -> Assoc Store -> UniqSet Store
    closeAssoc (Int -> Store
    SSlot Int
    slot) Assoc Store
    assoc
            , Just (SReg Reg
    reg)       <- (Store -> Bool) -> [Store] -> Maybe Store
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find Store -> Bool
    isStoreReg ([Store] -> Maybe Store) -> [Store] -> Maybe Store
    forall a b. (a -> b) -> a -> b
    $ UniqSet Store -> [Store]
    forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet UniqSet Store
    close
               -- See Note [Unique Determinism and code generation]
            = Reg -> Maybe Reg
    forall a. a -> Maybe a
    Just Reg
    reg

            | Bool
    otherwise
            = Maybe Reg
    forall a. Maybe a
    Nothing

    -------------------------------------------------------------------------------
    -- | Cleaner monad.
    type CleanM
            = State CleanS

    -- | Cleaner state.
    data CleanS
            = CleanS
            { -- | Regs which are valid at the start of each block.
              CleanS -> UniqFM BlockId (Assoc Store)
    sJumpValid            :: UniqFM BlockId (Assoc Store)

              -- | Collecting up what regs were valid across each jump.
              --    in the next pass we can collate these and write the results
              --    to sJumpValid.
            , CleanS -> UniqFM BlockId [Assoc Store]
    sJumpValidAcc         :: UniqFM BlockId [Assoc Store]

              -- | Map of (slot -> blocks which reload from this slot)
              --    used to decide if whether slot spilled to will ever be
              --    reloaded from on this path.
            , CleanS -> UniqFM Store [BlockId]
    sReloadedBy           :: UniqFM Store [BlockId]

              -- | Spills and reloads cleaned each pass (latest at front)
            , CleanS -> [(Int, Int)]
    sCleanedCount         :: [(Int, Int)]

              -- | Spills and reloads that have been cleaned in this pass so far.
            , CleanS -> Int
    sCleanedSpillsAcc     :: Int
            , CleanS -> Int
    sCleanedReloadsAcc    :: Int }

    -- | Construct the initial cleaner state.
    initCleanS :: CleanS
    initCleanS :: CleanS
    initCleanS
            = CleanS
            { sJumpValid :: UniqFM BlockId (Assoc Store)
    sJumpValid            = UniqFM BlockId (Assoc Store)
    forall {k} (key :: k) elt. UniqFM key elt
    emptyUFM
            , sJumpValidAcc :: UniqFM BlockId [Assoc Store]
    sJumpValidAcc         = UniqFM BlockId [Assoc Store]
    forall {k} (key :: k) elt. UniqFM key elt
    emptyUFM

            , sReloadedBy :: UniqFM Store [BlockId]
    sReloadedBy           = UniqFM Store [BlockId]
    forall {k} (key :: k) elt. UniqFM key elt
    emptyUFM

            , sCleanedCount :: [(Int, Int)]
    sCleanedCount         = []

            , sCleanedSpillsAcc :: Int
    sCleanedSpillsAcc     = Int
    0
            , sCleanedReloadsAcc :: Int
    sCleanedReloadsAcc    = Int
    0 }

    -- | Remember the associations before a jump.
    accJumpValid :: Assoc Store -> BlockId -> CleanM ()
    accJumpValid :: Assoc Store -> BlockId -> State CleanS ()
    accJumpValid Assoc Store
    assocs BlockId
    target
     = (CleanS -> CleanS) -> State CleanS ()
    forall s. (s -> s) -> State s ()
    modify ((CleanS -> CleanS) -> State CleanS ())
    -> (CleanS -> CleanS) -> State CleanS ()
    forall a b. (a -> b) -> a -> b
    $ \CleanS
    s -> CleanS
    s {
            sJumpValidAcc = addToUFM_C (++)
                                    (sJumpValidAcc s)
                                    target
                                    [assocs] }

    accBlockReloadsSlot :: BlockId -> Slot -> CleanM ()
    accBlockReloadsSlot :: BlockId -> Int -> State CleanS ()
    accBlockReloadsSlot BlockId
    blockId Int
    slot
     = (CleanS -> CleanS) -> State CleanS ()
    forall s. (s -> s) -> State s ()
    modify ((CleanS -> CleanS) -> State CleanS ())
    -> (CleanS -> CleanS) -> State CleanS ()
    forall a b. (a -> b) -> a -> b
    $ \CleanS
    s -> CleanS
    s {
            sReloadedBy = addToUFM_C (++)
                                    (sReloadedBy s)
                                    (SSlot slot)
                                    [blockId] }

    -------------------------------------------------------------------------------
    -- A store location can be a stack slot or a register
    data Store
            = SSlot Int
            | SReg  Reg

    -- | Check if this is a reg store.
    isStoreReg :: Store -> Bool
    isStoreReg :: Store -> Bool
    isStoreReg Store
    ss
     = case Store
    ss of
            SSlot Int
    _ -> Bool
    False
            SReg  Reg
    _ -> Bool
    True

    -- Spill cleaning is only done once all virtuals have been allocated to realRegs
    instance Uniquable Store where
        getUnique :: Store -> Unique
    getUnique (SReg  Reg
    r)
            | RegReal (RealRegSingle Int
    i)     <- Reg
    r
            = Int -> Unique
    mkRegSingleUnique Int
    i

            | Bool
    otherwise
            = String -> Unique
    forall a. HasCallStack => String -> a
    error (String -> Unique) -> String -> Unique
    forall a b. (a -> b) -> a -> b
    $ String
    "RegSpillClean.getUnique: found virtual reg during spill clean,"
                    String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "only real regs expected."

        getUnique (SSlot Int
    i) = Int -> Unique
    mkRegSubUnique Int
    i    -- [SLPJ] I hope "SubUnique" is ok

    instance Outputable Store where
            ppr :: Store -> SDoc
    ppr (SSlot Int
    i)   = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "slot" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Int -> SDoc
    forall doc. IsLine doc => Int -> doc
    int Int
    i
            ppr (SReg  Reg
    r)   = Reg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Reg
    r

    -------------------------------------------------------------------------------
    -- Association graphs.
    -- In the spill cleaner, two store locations are associated if they are known
    -- to hold the same value.
    --
    -- TODO: Monomorphize: I think we only ever use this with a ~ Store
    type Assoc a    = UniqFM a (UniqSet a)

    -- | An empty association
    emptyAssoc :: Assoc a
    emptyAssoc :: forall a. Assoc a
    emptyAssoc      = UniqFM a (UniqSet a)
    forall {k} (key :: k) elt. UniqFM key elt
    emptyUFM

    -- | Add an association between these two things.
    -- addAssoc :: Uniquable a
    --          => a -> a -> Assoc a -> Assoc a
    addAssoc :: Store -> Store -> Assoc Store -> Assoc Store

    addAssoc :: Store -> Store -> Assoc Store -> Assoc Store
    addAssoc Store
    a Store
    b Assoc Store
    m
     = let  m1 :: Assoc Store
    m1      = (UniqSet Store -> UniqSet Store -> UniqSet Store)
    -> Assoc Store -> Store -> UniqSet Store -> Assoc Store
    forall key elt.
    Uniquable key =>
    (elt -> elt -> elt)
    -> UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM_C UniqSet Store -> UniqSet Store -> UniqSet Store
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    unionUniqSets Assoc Store
    m  Store
    a (Store -> UniqSet Store
    forall a. Uniquable a => a -> UniqSet a
    unitUniqSet Store
    b)
            m2 :: Assoc Store
    m2      = (UniqSet Store -> UniqSet Store -> UniqSet Store)
    -> Assoc Store -> Store -> UniqSet Store -> Assoc Store
    forall key elt.
    Uniquable key =>
    (elt -> elt -> elt)
    -> UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM_C UniqSet Store -> UniqSet Store -> UniqSet Store
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    unionUniqSets Assoc Store
    m1 Store
    b (Store -> UniqSet Store
    forall a. Uniquable a => a -> UniqSet a
    unitUniqSet Store
    a)
       in   Assoc Store
    m2

    -- | Delete all associations to a node.
    delAssoc :: Store -> Assoc Store -> Assoc Store
    delAssoc :: Store -> Assoc Store -> Assoc Store
    delAssoc Store
    a Assoc Store
    m
            | Just UniqSet Store
    aSet     <- Assoc Store -> Store -> Maybe (UniqSet Store)
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM  Assoc Store
    m Store
    a
            , Assoc Store
    m1            <- Assoc Store -> Store -> Assoc Store
    forall key elt.
    Uniquable key =>
    UniqFM key elt -> key -> UniqFM key elt
    delFromUFM Assoc Store
    m Store
    a
            = (Store -> Assoc Store -> Assoc Store)
    -> Assoc Store -> UniqSet Store -> Assoc Store
    forall elt a. (elt -> a -> a) -> a -> UniqSet elt -> a
    nonDetStrictFoldUniqSet (\Store
    x Assoc Store
    m -> Store -> Store -> Assoc Store -> Assoc Store
    delAssoc1 Store
    x Store
    a Assoc Store
    m) Assoc Store
    m1 UniqSet Store
    aSet
              -- It's OK to use a non-deterministic fold here because deletion is
              -- commutative

            | Bool
    otherwise     = Assoc Store
    m

    -- | Delete a single association edge (a -> b).
    delAssoc1 :: Store -> Store -> Assoc Store -> Assoc Store
    delAssoc1 :: Store -> Store -> Assoc Store -> Assoc Store
    delAssoc1 Store
    a Store
    b Assoc Store
    m
            | Just UniqSet Store
    aSet     <- Assoc Store -> Store -> Maybe (UniqSet Store)
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM Assoc Store
    m Store
    a
            = Assoc Store -> Store -> UniqSet Store -> Assoc Store
    forall key elt.
    Uniquable key =>
    UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM Assoc Store
    m Store
    a (UniqSet Store -> Store -> UniqSet Store
    forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    delOneFromUniqSet UniqSet Store
    aSet Store
    b)

            | Bool
    otherwise     = Assoc Store
    m

    -- | Check if these two things are associated.
    elemAssoc :: Store -> Store -> Assoc Store -> Bool

    elemAssoc :: Store -> Store -> Assoc Store -> Bool
    elemAssoc Store
    a Store
    b Assoc Store
    m
            = Store -> UniqSet Store -> Bool
    forall a. Uniquable a => a -> UniqSet a -> Bool
    elementOfUniqSet Store
    b (Store -> Assoc Store -> UniqSet Store
    closeAssoc Store
    a Assoc Store
    m)

    -- | Find the refl. trans. closure of the association from this point.
    closeAssoc :: Store -> Assoc Store -> UniqSet Store
    closeAssoc :: Store -> Assoc Store -> UniqSet Store
    closeAssoc Store
    a Assoc Store
    assoc
     =      Assoc Store -> UniqSet Store -> UniqSet Store -> UniqSet Store
    forall {key}.
    Uniquable key =>
    UniqFM key (UniqSet key)
    -> UniqSet key -> UniqSet key -> UniqSet key
    closeAssoc' Assoc Store
    assoc UniqSet Store
    forall a. UniqSet a
    emptyUniqSet (Store -> UniqSet Store
    forall a. Uniquable a => a -> UniqSet a
    unitUniqSet Store
    a)
     where
            closeAssoc' :: UniqFM key (UniqSet key)
    -> UniqSet key -> UniqSet key -> UniqSet key
    closeAssoc' UniqFM key (UniqSet key)
    assoc UniqSet key
    visited UniqSet key
    toVisit
             = case UniqSet key -> [key]
    forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet UniqSet key
    toVisit of
                 -- See Note [Unique Determinism and code generation]

                    -- nothing else to visit, we're done
                    []      -> UniqSet key
    visited

                    (key
    x:[key]
    _)
                     -- we've already seen this node
                     |  key -> UniqSet key -> Bool
    forall a. Uniquable a => a -> UniqSet a -> Bool
    elementOfUniqSet key
    x UniqSet key
    visited
                     -> UniqFM key (UniqSet key)
    -> UniqSet key -> UniqSet key -> UniqSet key
    closeAssoc' UniqFM key (UniqSet key)
    assoc UniqSet key
    visited (UniqSet key -> key -> UniqSet key
    forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    delOneFromUniqSet UniqSet key
    toVisit key
    x)

                     -- haven't seen this node before,
                     --     remember to visit all its neighbors
                     |  Bool
    otherwise
                     -> let neighbors :: UniqSet key
    neighbors
                             = case UniqFM key (UniqSet key) -> key -> Maybe (UniqSet key)
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM key (UniqSet key)
    assoc key
    x of
                                    Maybe (UniqSet key)
    Nothing         -> UniqSet key
    forall a. UniqSet a
    emptyUniqSet
                                    Just UniqSet key
    set        -> UniqSet key
    set

                       in UniqFM key (UniqSet key)
    -> UniqSet key -> UniqSet key -> UniqSet key
    closeAssoc' UniqFM key (UniqSet key)
    assoc
                            (UniqSet key -> key -> UniqSet key
    forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    addOneToUniqSet UniqSet key
    visited key
    x)
                            (UniqSet key -> UniqSet key -> UniqSet key
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    unionUniqSets   UniqSet key
    toVisit UniqSet key
    neighbors)

    -- | Intersect two associations.
    intersectAssoc :: Assoc Store -> Assoc Store -> Assoc Store
    intersectAssoc :: Assoc Store -> Assoc Store -> Assoc Store
    intersectAssoc Assoc Store
    a Assoc Store
    b
            = (UniqSet Store -> UniqSet Store -> UniqSet Store)
    -> Assoc Store -> Assoc Store -> Assoc Store
    forall {k} elt1 elt2 elt3 (key :: k).
    (elt1 -> elt2 -> elt3)
    -> UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt3
    intersectUFM_C (UniqSet Store -> UniqSet Store -> UniqSet Store
    forall a. UniqSet a -> UniqSet a -> UniqSet a
    intersectUniqSets) Assoc Store
    a Assoc Store
    b