{-# LANGUAGE ScopedTypeVariables #-}
module RegAlloc.Graph.SpillCost (
        SpillCostRecord,
        plusSpillCostRecord,
        pprSpillCostRecord,

        SpillCostInfo,
        zeroSpillCostInfo,
        plusSpillCostInfo,

        slurpSpillCostInfo,
        chooseSpill,

        lifeMapFromSpillCostInfo
) where
import GhcPrelude

import RegAlloc.Liveness
import Instruction
import RegClass
import Reg

import GraphBase

import Hoopl.Collections (mapLookup)
import Cmm
import UniqFM
import UniqSet
import Digraph          (flattenSCCs)
import Outputable
import Platform
import State
import CFG

import Data.List        (nub, minimumBy)
import Data.Maybe
import Control.Monad (join)


-- | Records the expected cost to spill some regster.
type SpillCostRecord
 =      ( VirtualReg    -- register name
        , Int           -- number of writes to this reg
        , Int           -- number of reads from this reg
        , Int)          -- number of instrs this reg was live on entry to


-- | Map of `SpillCostRecord`
type SpillCostInfo
        = UniqFM SpillCostRecord

-- | Block membership in a loop
type LoopMember = Bool

type SpillCostState = State (UniqFM SpillCostRecord) ()

-- | An empty map of spill costs.
zeroSpillCostInfo :: SpillCostInfo
zeroSpillCostInfo :: SpillCostInfo
zeroSpillCostInfo       = SpillCostInfo
forall elt. UniqFM elt
emptyUFM


-- | Add two spill cost infos.
plusSpillCostInfo :: SpillCostInfo -> SpillCostInfo -> SpillCostInfo
plusSpillCostInfo :: SpillCostInfo -> SpillCostInfo -> SpillCostInfo
plusSpillCostInfo sc1 :: SpillCostInfo
sc1 sc2 :: SpillCostInfo
sc2
        = (SpillCostRecord -> SpillCostRecord -> SpillCostRecord)
-> SpillCostInfo -> SpillCostInfo -> SpillCostInfo
forall elt.
(elt -> elt -> elt) -> UniqFM elt -> UniqFM elt -> UniqFM elt
plusUFM_C SpillCostRecord -> SpillCostRecord -> SpillCostRecord
plusSpillCostRecord SpillCostInfo
sc1 SpillCostInfo
sc2


-- | Add two spill cost records.
plusSpillCostRecord :: SpillCostRecord -> SpillCostRecord -> SpillCostRecord
plusSpillCostRecord :: SpillCostRecord -> SpillCostRecord -> SpillCostRecord
plusSpillCostRecord (r1 :: VirtualReg
r1, a1 :: Int
a1, b1 :: Int
b1, c1 :: Int
c1) (r2 :: VirtualReg
r2, a2 :: Int
a2, b2 :: Int
b2, c2 :: Int
c2)
        | VirtualReg
r1 VirtualReg -> VirtualReg -> Bool
forall a. Eq a => a -> a -> Bool
== VirtualReg
r2      = (VirtualReg
r1, Int
a1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
a2, Int
b1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b2, Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c2)
        | Bool
otherwise     = [Char] -> SpillCostRecord
forall a. HasCallStack => [Char] -> a
error "RegSpillCost.plusRegInt: regs don't match"


-- | Slurp out information used for determining spill costs.
--
--   For each vreg, the number of times it was written to, read from,
--   and the number of instructions it was live on entry to (lifetime)
--
slurpSpillCostInfo :: forall instr statics. (Outputable instr, Instruction instr)
                   => Platform
                   -> Maybe CFG
                   -> LiveCmmDecl statics instr
                   -> SpillCostInfo

slurpSpillCostInfo :: Platform -> Maybe CFG -> LiveCmmDecl statics instr -> SpillCostInfo
slurpSpillCostInfo platform :: Platform
platform cfg :: Maybe CFG
cfg cmm :: LiveCmmDecl statics instr
cmm
        = State SpillCostInfo () -> SpillCostInfo -> SpillCostInfo
forall s a. State s a -> s -> s
execState (LiveCmmDecl statics instr -> State SpillCostInfo ()
forall d.
GenCmmDecl d LiveInfo [SCC (GenBasicBlock (LiveInstr instr))]
-> State SpillCostInfo ()
countCmm LiveCmmDecl statics instr
cmm) SpillCostInfo
zeroSpillCostInfo
 where
        countCmm :: GenCmmDecl d LiveInfo [SCC (GenBasicBlock (LiveInstr instr))]
-> State SpillCostInfo ()
countCmm CmmData{}              = () -> State SpillCostInfo ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        countCmm (CmmProc info :: LiveInfo
info _ _ sccs :: [SCC (GenBasicBlock (LiveInstr instr))]
sccs)
                = (GenBasicBlock (LiveInstr instr) -> State SpillCostInfo ())
-> [GenBasicBlock (LiveInstr instr)] -> State SpillCostInfo ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LiveInfo
-> GenBasicBlock (LiveInstr instr) -> State SpillCostInfo ()
countBlock LiveInfo
info)
                ([GenBasicBlock (LiveInstr instr)] -> State SpillCostInfo ())
-> [GenBasicBlock (LiveInstr instr)] -> State SpillCostInfo ()
forall a b. (a -> b) -> a -> b
$ [SCC (GenBasicBlock (LiveInstr instr))]
-> [GenBasicBlock (LiveInstr instr)]
forall a. [SCC a] -> [a]
flattenSCCs [SCC (GenBasicBlock (LiveInstr instr))]
sccs

        -- Lookup the regs that are live on entry to this block in
        --      the info table from the CmmProc.
        countBlock :: LiveInfo
-> GenBasicBlock (LiveInstr instr) -> State SpillCostInfo ()
countBlock info :: LiveInfo
info (BasicBlock blockId :: BlockId
blockId instrs :: [LiveInstr instr]
instrs)
                | LiveInfo _ _ (Just blockLive :: BlockMap RegSet
blockLive) _ <- LiveInfo
info
                , Just rsLiveEntry :: RegSet
rsLiveEntry  <- KeyOf LabelMap -> BlockMap RegSet -> Maybe RegSet
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup KeyOf LabelMap
BlockId
blockId BlockMap RegSet
blockLive
                , UniqSet VirtualReg
rsLiveEntry_virt  <- RegSet -> UniqSet VirtualReg
takeVirtuals RegSet
rsLiveEntry
                = Bool
-> UniqSet VirtualReg
-> [LiveInstr instr]
-> State SpillCostInfo ()
countLIs (BlockId -> Bool
loopMember BlockId
blockId) UniqSet VirtualReg
rsLiveEntry_virt [LiveInstr instr]
instrs

                | Bool
otherwise
                = [Char] -> State SpillCostInfo ()
forall a. HasCallStack => [Char] -> a
error "RegAlloc.SpillCost.slurpSpillCostInfo: bad block"

        countLIs :: LoopMember -> UniqSet VirtualReg -> [LiveInstr instr] -> SpillCostState
        countLIs :: Bool
-> UniqSet VirtualReg
-> [LiveInstr instr]
-> State SpillCostInfo ()
countLIs _      _      []
                = () -> State SpillCostInfo ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        -- Skip over comment and delta pseudo instrs.
        countLIs inLoop :: Bool
inLoop rsLive :: UniqSet VirtualReg
rsLive (LiveInstr instr :: InstrSR instr
instr Nothing : lis :: [LiveInstr instr]
lis)
                | InstrSR instr -> Bool
forall instr. Instruction instr => instr -> Bool
isMetaInstr InstrSR instr
instr
                = Bool
-> UniqSet VirtualReg
-> [LiveInstr instr]
-> State SpillCostInfo ()
countLIs Bool
inLoop UniqSet VirtualReg
rsLive [LiveInstr instr]
lis

                | Bool
otherwise
                = [Char] -> SDoc -> State SpillCostInfo ()
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic "RegSpillCost.slurpSpillCostInfo"
                (SDoc -> State SpillCostInfo ()) -> SDoc -> State SpillCostInfo ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
text "no liveness information on instruction " SDoc -> SDoc -> SDoc
<> InstrSR instr -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstrSR instr
instr

        countLIs inLoop :: Bool
inLoop rsLiveEntry :: UniqSet VirtualReg
rsLiveEntry (LiveInstr instr :: InstrSR instr
instr (Just live :: Liveness
live) : lis :: [LiveInstr instr]
lis)
         = do
                -- Increment the lifetime counts for regs live on entry to this instr.
                (VirtualReg -> State SpillCostInfo ())
-> [VirtualReg] -> State SpillCostInfo ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int -> VirtualReg -> State SpillCostInfo ()
incLifetime (Bool -> Int
forall p. Num p => Bool -> p
loopCount Bool
inLoop)) ([VirtualReg] -> State SpillCostInfo ())
-> [VirtualReg] -> State SpillCostInfo ()
forall a b. (a -> b) -> a -> b
$ UniqSet VirtualReg -> [VirtualReg]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet UniqSet VirtualReg
rsLiveEntry
                    -- This is non-deterministic but we do not
                    -- currently support deterministic code-generation.
                    -- See Note [Unique Determinism and code generation]

                -- Increment counts for what regs were read/written from.
                let (RU read :: [Reg]
read written :: [Reg]
written)   = Platform -> InstrSR instr -> RegUsage
forall instr. Instruction instr => Platform -> instr -> RegUsage
regUsageOfInstr Platform
platform InstrSR instr
instr
                (VirtualReg -> State SpillCostInfo ())
-> [VirtualReg] -> State SpillCostInfo ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int -> VirtualReg -> State SpillCostInfo ()
incUses (Bool -> Int
forall p. Num p => Bool -> p
loopCount Bool
inLoop)) ([VirtualReg] -> State SpillCostInfo ())
-> [VirtualReg] -> State SpillCostInfo ()
forall a b. (a -> b) -> a -> b
$ [Maybe VirtualReg] -> [VirtualReg]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe VirtualReg] -> [VirtualReg])
-> [Maybe VirtualReg] -> [VirtualReg]
forall a b. (a -> b) -> a -> b
$ (Reg -> Maybe VirtualReg) -> [Reg] -> [Maybe VirtualReg]
forall a b. (a -> b) -> [a] -> [b]
map Reg -> Maybe VirtualReg
takeVirtualReg ([Reg] -> [Maybe VirtualReg]) -> [Reg] -> [Maybe VirtualReg]
forall a b. (a -> b) -> a -> b
$ [Reg] -> [Reg]
forall a. Eq a => [a] -> [a]
nub [Reg]
read
                (VirtualReg -> State SpillCostInfo ())
-> [VirtualReg] -> State SpillCostInfo ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int -> VirtualReg -> State SpillCostInfo ()
incDefs (Bool -> Int
forall p. Num p => Bool -> p
loopCount Bool
inLoop)) ([VirtualReg] -> State SpillCostInfo ())
-> [VirtualReg] -> State SpillCostInfo ()
forall a b. (a -> b) -> a -> b
$ [Maybe VirtualReg] -> [VirtualReg]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe VirtualReg] -> [VirtualReg])
-> [Maybe VirtualReg] -> [VirtualReg]
forall a b. (a -> b) -> a -> b
$ (Reg -> Maybe VirtualReg) -> [Reg] -> [Maybe VirtualReg]
forall a b. (a -> b) -> [a] -> [b]
map Reg -> Maybe VirtualReg
takeVirtualReg ([Reg] -> [Maybe VirtualReg]) -> [Reg] -> [Maybe VirtualReg]
forall a b. (a -> b) -> a -> b
$ [Reg] -> [Reg]
forall a. Eq a => [a] -> [a]
nub [Reg]
written

                -- Compute liveness for entry to next instruction.
                let liveDieRead_virt :: UniqSet VirtualReg
liveDieRead_virt    = RegSet -> UniqSet VirtualReg
takeVirtuals (Liveness -> RegSet
liveDieRead  Liveness
live)
                let liveDieWrite_virt :: UniqSet VirtualReg
liveDieWrite_virt   = RegSet -> UniqSet VirtualReg
takeVirtuals (Liveness -> RegSet
liveDieWrite Liveness
live)
                let liveBorn_virt :: UniqSet VirtualReg
liveBorn_virt       = RegSet -> UniqSet VirtualReg
takeVirtuals (Liveness -> RegSet
liveBorn     Liveness
live)

                let rsLiveAcross :: UniqSet VirtualReg
rsLiveAcross
                        = UniqSet VirtualReg
rsLiveEntry UniqSet VirtualReg -> UniqSet VirtualReg -> UniqSet VirtualReg
forall a. UniqSet a -> UniqSet a -> UniqSet a
`minusUniqSet` UniqSet VirtualReg
liveDieRead_virt

                let rsLiveNext :: UniqSet VirtualReg
rsLiveNext
                        = (UniqSet VirtualReg
rsLiveAcross UniqSet VirtualReg -> UniqSet VirtualReg -> UniqSet VirtualReg
forall a. UniqSet a -> UniqSet a -> UniqSet a
`unionUniqSets` UniqSet VirtualReg
liveBorn_virt)
                                        UniqSet VirtualReg -> UniqSet VirtualReg -> UniqSet VirtualReg
forall a. UniqSet a -> UniqSet a -> UniqSet a
`minusUniqSet`  UniqSet VirtualReg
liveDieWrite_virt

                Bool
-> UniqSet VirtualReg
-> [LiveInstr instr]
-> State SpillCostInfo ()
countLIs Bool
inLoop UniqSet VirtualReg
rsLiveNext [LiveInstr instr]
lis

        loopCount :: Bool -> p
loopCount inLoop :: Bool
inLoop
          | Bool
inLoop = 10
          | Bool
otherwise = 1
        incDefs :: Int -> VirtualReg -> State SpillCostInfo ()
incDefs     count :: Int
count reg :: VirtualReg
reg = (SpillCostInfo -> SpillCostInfo) -> State SpillCostInfo ()
forall s. (s -> s) -> State s ()
modify ((SpillCostInfo -> SpillCostInfo) -> State SpillCostInfo ())
-> (SpillCostInfo -> SpillCostInfo) -> State SpillCostInfo ()
forall a b. (a -> b) -> a -> b
$ \s :: SpillCostInfo
s -> (SpillCostRecord -> SpillCostRecord -> SpillCostRecord)
-> SpillCostInfo -> VirtualReg -> SpillCostRecord -> SpillCostInfo
forall key elt.
Uniquable key =>
(elt -> elt -> elt) -> UniqFM elt -> key -> elt -> UniqFM elt
addToUFM_C SpillCostRecord -> SpillCostRecord -> SpillCostRecord
plusSpillCostRecord SpillCostInfo
s VirtualReg
reg (VirtualReg
reg, Int
count, 0, 0)
        incUses :: Int -> VirtualReg -> State SpillCostInfo ()
incUses     count :: Int
count reg :: VirtualReg
reg = (SpillCostInfo -> SpillCostInfo) -> State SpillCostInfo ()
forall s. (s -> s) -> State s ()
modify ((SpillCostInfo -> SpillCostInfo) -> State SpillCostInfo ())
-> (SpillCostInfo -> SpillCostInfo) -> State SpillCostInfo ()
forall a b. (a -> b) -> a -> b
$ \s :: SpillCostInfo
s -> (SpillCostRecord -> SpillCostRecord -> SpillCostRecord)
-> SpillCostInfo -> VirtualReg -> SpillCostRecord -> SpillCostInfo
forall key elt.
Uniquable key =>
(elt -> elt -> elt) -> UniqFM elt -> key -> elt -> UniqFM elt
addToUFM_C SpillCostRecord -> SpillCostRecord -> SpillCostRecord
plusSpillCostRecord SpillCostInfo
s VirtualReg
reg (VirtualReg
reg, 0, Int
count, 0)
        incLifetime :: Int -> VirtualReg -> State SpillCostInfo ()
incLifetime count :: Int
count reg :: VirtualReg
reg = (SpillCostInfo -> SpillCostInfo) -> State SpillCostInfo ()
forall s. (s -> s) -> State s ()
modify ((SpillCostInfo -> SpillCostInfo) -> State SpillCostInfo ())
-> (SpillCostInfo -> SpillCostInfo) -> State SpillCostInfo ()
forall a b. (a -> b) -> a -> b
$ \s :: SpillCostInfo
s -> (SpillCostRecord -> SpillCostRecord -> SpillCostRecord)
-> SpillCostInfo -> VirtualReg -> SpillCostRecord -> SpillCostInfo
forall key elt.
Uniquable key =>
(elt -> elt -> elt) -> UniqFM elt -> key -> elt -> UniqFM elt
addToUFM_C SpillCostRecord -> SpillCostRecord -> SpillCostRecord
plusSpillCostRecord SpillCostInfo
s VirtualReg
reg (VirtualReg
reg, 0, 0, Int
count)

        loopBlocks :: Maybe (LabelMap Bool)
loopBlocks = CFG -> LabelMap Bool
CFG.loopMembers (CFG -> LabelMap Bool) -> Maybe CFG -> Maybe (LabelMap Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CFG
cfg
        loopMember :: BlockId -> Bool
loopMember bid :: BlockId
bid
          | Just isMember :: Bool
isMember <- Maybe (Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (KeyOf LabelMap -> LabelMap Bool -> Maybe Bool
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup KeyOf LabelMap
BlockId
bid (LabelMap Bool -> Maybe Bool)
-> Maybe (LabelMap Bool) -> Maybe (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LabelMap Bool)
loopBlocks)
          = Bool
isMember
          | Bool
otherwise
          = Bool
False

-- | Take all the virtual registers from this set.
takeVirtuals :: UniqSet Reg -> UniqSet VirtualReg
takeVirtuals :: RegSet -> UniqSet VirtualReg
takeVirtuals set :: RegSet
set = [VirtualReg] -> UniqSet VirtualReg
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet
  [ VirtualReg
vr | RegVirtual vr :: VirtualReg
vr <- RegSet -> [Reg]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet RegSet
set ]
  -- See Note [Unique Determinism and code generation]


-- | Choose a node to spill from this graph
chooseSpill
        :: SpillCostInfo
        -> Graph VirtualReg RegClass RealReg
        -> VirtualReg

chooseSpill :: SpillCostInfo -> Graph VirtualReg RegClass RealReg -> VirtualReg
chooseSpill info :: SpillCostInfo
info graph :: Graph VirtualReg RegClass RealReg
graph
 = let  cost :: VirtualReg -> Float
cost    = SpillCostInfo
-> Graph VirtualReg RegClass RealReg -> VirtualReg -> Float
spillCost_length SpillCostInfo
info Graph VirtualReg RegClass RealReg
graph
        node :: Node VirtualReg RegClass RealReg
node    = (Node VirtualReg RegClass RealReg
 -> Node VirtualReg RegClass RealReg -> Ordering)
-> [Node VirtualReg RegClass RealReg]
-> Node VirtualReg RegClass RealReg
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (\n1 :: Node VirtualReg RegClass RealReg
n1 n2 :: Node VirtualReg RegClass RealReg
n2 -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (VirtualReg -> Float
cost (VirtualReg -> Float) -> VirtualReg -> Float
forall a b. (a -> b) -> a -> b
$ Node VirtualReg RegClass RealReg -> VirtualReg
forall k cls color. Node k cls color -> k
nodeId Node VirtualReg RegClass RealReg
n1) (VirtualReg -> Float
cost (VirtualReg -> Float) -> VirtualReg -> Float
forall a b. (a -> b) -> a -> b
$ Node VirtualReg RegClass RealReg -> VirtualReg
forall k cls color. Node k cls color -> k
nodeId Node VirtualReg RegClass RealReg
n2))
                ([Node VirtualReg RegClass RealReg]
 -> Node VirtualReg RegClass RealReg)
-> [Node VirtualReg RegClass RealReg]
-> Node VirtualReg RegClass RealReg
forall a b. (a -> b) -> a -> b
$ UniqFM (Node VirtualReg RegClass RealReg)
-> [Node VirtualReg RegClass RealReg]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM (UniqFM (Node VirtualReg RegClass RealReg)
 -> [Node VirtualReg RegClass RealReg])
-> UniqFM (Node VirtualReg RegClass RealReg)
-> [Node VirtualReg RegClass RealReg]
forall a b. (a -> b) -> a -> b
$ Graph VirtualReg RegClass RealReg
-> UniqFM (Node VirtualReg RegClass RealReg)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph VirtualReg RegClass RealReg
graph
                -- See Note [Unique Determinism and code generation]

   in   Node VirtualReg RegClass RealReg -> VirtualReg
forall k cls color. Node k cls color -> k
nodeId Node VirtualReg RegClass RealReg
node


-------------------------------------------------------------------------------
-- | Chaitins spill cost function is:
--
--   cost =     sum         loadCost * freq (u)  +    sum        storeCost * freq (d)
--          u <- uses (v)                         d <- defs (v)
--
--   There are no loops in our code at the moment, so we can set the freq's to 1.
--
--  If we don't have live range splitting then Chaitins function performs badly
--  if we have lots of nested live ranges and very few registers.
--
--               v1 v2 v3
--      def v1   .
--      use v1   .
--      def v2   .  .
--      def v3   .  .  .
--      use v1   .  .  .
--      use v3   .  .  .
--      use v2   .  .
--      use v1   .
--
--           defs uses degree   cost
--      v1:  1     3     3      1.5
--      v2:  1     2     3      1.0
--      v3:  1     1     3      0.666
--
--   v3 has the lowest cost, but if we only have 2 hardregs and we insert
--   spill code for v3 then this isn't going to improve the colorability of
--   the graph.
--
--  When compiling SHA1, which as very long basic blocks and some vregs
--  with very long live ranges the allocator seems to try and spill from
--  the inside out and eventually run out of stack slots.
--
--  Without live range splitting, its's better to spill from the outside
--  in so set the cost of very long live ranges to zero
--
{-
spillCost_chaitin
        :: SpillCostInfo
        -> Graph Reg RegClass Reg
        -> Reg
        -> Float

spillCost_chaitin info graph reg
        -- Spilling a live range that only lives for 1 instruction
        -- isn't going to help us at all - and we definitely want to avoid
        -- trying to re-spill previously inserted spill code.
        | lifetime <= 1         = 1/0

        -- It's unlikely that we'll find a reg for a live range this long
        -- better to spill it straight up and not risk trying to keep it around
        -- and have to go through the build/color cycle again.
        | lifetime > allocatableRegsInClass (regClass reg) * 10
        = 0

        -- Otherwise revert to chaitin's regular cost function.
        | otherwise     = fromIntegral (uses + defs)
                        / fromIntegral (nodeDegree graph reg)
        where (_, defs, uses, lifetime)
                = fromMaybe (reg, 0, 0, 0) $ lookupUFM info reg
-}

-- Just spill the longest live range.
spillCost_length
        :: SpillCostInfo
        -> Graph VirtualReg RegClass RealReg
        -> VirtualReg
        -> Float

spillCost_length :: SpillCostInfo
-> Graph VirtualReg RegClass RealReg -> VirtualReg -> Float
spillCost_length info :: SpillCostInfo
info _ reg :: VirtualReg
reg
        | Int
lifetime Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1         = 1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/0
        | Bool
otherwise             = 1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lifetime
        where (_, _, _, lifetime :: Int
lifetime)
                = SpillCostRecord -> Maybe SpillCostRecord -> SpillCostRecord
forall a. a -> Maybe a -> a
fromMaybe (VirtualReg
reg, 0, 0, 0)
                (Maybe SpillCostRecord -> SpillCostRecord)
-> Maybe SpillCostRecord -> SpillCostRecord
forall a b. (a -> b) -> a -> b
$ SpillCostInfo -> VirtualReg -> Maybe SpillCostRecord
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM SpillCostInfo
info VirtualReg
reg


-- | Extract a map of register lifetimes from a `SpillCostInfo`.
lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM (VirtualReg, Int)
lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM (VirtualReg, Int)
lifeMapFromSpillCostInfo info :: SpillCostInfo
info
        = [(VirtualReg, (VirtualReg, Int))] -> UniqFM (VirtualReg, Int)
forall key elt. Uniquable key => [(key, elt)] -> UniqFM elt
listToUFM
        ([(VirtualReg, (VirtualReg, Int))] -> UniqFM (VirtualReg, Int))
-> [(VirtualReg, (VirtualReg, Int))] -> UniqFM (VirtualReg, Int)
forall a b. (a -> b) -> a -> b
$ (SpillCostRecord -> (VirtualReg, (VirtualReg, Int)))
-> [SpillCostRecord] -> [(VirtualReg, (VirtualReg, Int))]
forall a b. (a -> b) -> [a] -> [b]
map (\(r :: VirtualReg
r, _, _, life :: Int
life) -> (VirtualReg
r, (VirtualReg
r, Int
life)))
        ([SpillCostRecord] -> [(VirtualReg, (VirtualReg, Int))])
-> [SpillCostRecord] -> [(VirtualReg, (VirtualReg, Int))]
forall a b. (a -> b) -> a -> b
$ SpillCostInfo -> [SpillCostRecord]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM SpillCostInfo
info
        -- See Note [Unique Determinism and code generation]


-- | Determine the degree (number of neighbors) of this node which
--   have the same class.
nodeDegree
        :: (VirtualReg -> RegClass)
        -> Graph VirtualReg RegClass RealReg
        -> VirtualReg
        -> Int

nodeDegree :: (VirtualReg -> RegClass)
-> Graph VirtualReg RegClass RealReg -> VirtualReg -> Int
nodeDegree classOfVirtualReg :: VirtualReg -> RegClass
classOfVirtualReg graph :: Graph VirtualReg RegClass RealReg
graph reg :: VirtualReg
reg
        | Just node :: Node VirtualReg RegClass RealReg
node     <- UniqFM (Node VirtualReg RegClass RealReg)
-> VirtualReg -> Maybe (Node VirtualReg RegClass RealReg)
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM (Graph VirtualReg RegClass RealReg
-> UniqFM (Node VirtualReg RegClass RealReg)
forall k cls color. Graph k cls color -> UniqFM (Node k cls color)
graphMap Graph VirtualReg RegClass RealReg
graph) VirtualReg
reg

        , Int
virtConflicts
           <- [VirtualReg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
           ([VirtualReg] -> Int) -> [VirtualReg] -> Int
forall a b. (a -> b) -> a -> b
$ (VirtualReg -> Bool) -> [VirtualReg] -> [VirtualReg]
forall a. (a -> Bool) -> [a] -> [a]
filter (\r :: VirtualReg
r -> VirtualReg -> RegClass
classOfVirtualReg VirtualReg
r RegClass -> RegClass -> Bool
forall a. Eq a => a -> a -> Bool
== VirtualReg -> RegClass
classOfVirtualReg VirtualReg
reg)
           ([VirtualReg] -> [VirtualReg]) -> [VirtualReg] -> [VirtualReg]
forall a b. (a -> b) -> a -> b
$ UniqSet VirtualReg -> [VirtualReg]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet
           -- See Note [Unique Determinism and code generation]
           (UniqSet VirtualReg -> [VirtualReg])
-> UniqSet VirtualReg -> [VirtualReg]
forall a b. (a -> b) -> a -> b
$ Node VirtualReg RegClass RealReg -> UniqSet VirtualReg
forall k cls color. Node k cls color -> UniqSet k
nodeConflicts Node VirtualReg RegClass RealReg
node

        = Int
virtConflicts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ UniqSet RealReg -> Int
forall a. UniqSet a -> Int
sizeUniqSet (Node VirtualReg RegClass RealReg -> UniqSet RealReg
forall k cls color. Node k cls color -> UniqSet color
nodeExclusions Node VirtualReg RegClass RealReg
node)

        | Bool
otherwise
        = 0


-- | Show a spill cost record, including the degree from the graph
--   and final calulated spill cost.
pprSpillCostRecord
        :: (VirtualReg -> RegClass)
        -> (Reg -> SDoc)
        -> Graph VirtualReg RegClass RealReg
        -> SpillCostRecord
        -> SDoc

pprSpillCostRecord :: (VirtualReg -> RegClass)
-> (Reg -> SDoc)
-> Graph VirtualReg RegClass RealReg
-> SpillCostRecord
-> SDoc
pprSpillCostRecord regClass :: VirtualReg -> RegClass
regClass pprReg :: Reg -> SDoc
pprReg graph :: Graph VirtualReg RegClass RealReg
graph (reg :: VirtualReg
reg, uses :: Int
uses, defs :: Int
defs, life :: Int
life)
        =  [SDoc] -> SDoc
hsep
        [ Reg -> SDoc
pprReg (VirtualReg -> Reg
RegVirtual VirtualReg
reg)
        , Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
uses
        , Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
defs
        , Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
life
        , Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Int -> SDoc) -> Int -> SDoc
forall a b. (a -> b) -> a -> b
$ (VirtualReg -> RegClass)
-> Graph VirtualReg RegClass RealReg -> VirtualReg -> Int
nodeDegree VirtualReg -> RegClass
regClass Graph VirtualReg RegClass RealReg
graph VirtualReg
reg
        , [Char] -> SDoc
text ([Char] -> SDoc) -> [Char] -> SDoc
forall a b. (a -> b) -> a -> b
$ Float -> [Char]
forall a. Show a => a -> [Char]
show (Float -> [Char]) -> Float -> [Char]
forall a b. (a -> b) -> a -> b
$ (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
uses Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
defs)
                       Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((VirtualReg -> RegClass)
-> Graph VirtualReg RegClass RealReg -> VirtualReg -> Int
nodeDegree VirtualReg -> RegClass
regClass Graph VirtualReg RegClass RealReg
graph VirtualReg
reg) :: Float) ]