{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}

module GHC.CmmToAsm.Reg.Graph.SpillCost (
        SpillCostRecord,
        plusSpillCostRecord,
        pprSpillCostRecord,

        SpillCostInfo,
        zeroSpillCostInfo,
        plusSpillCostInfo,

        slurpSpillCostInfo,
        chooseSpill,

        lifeMapFromSpillCostInfo
) where
import GHC.Prelude

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

import GHC.Data.Graph.Base

import GHC.Cmm.Dataflow.Collections (mapLookup)
import GHC.Cmm.Dataflow.Label
import GHC.Cmm
import GHC.Types.Unique.FM
import GHC.Types.Unique.Set
import GHC.Data.Graph.Directed          (flattenSCCs)
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Platform
import GHC.Utils.Monad.State
import GHC.CmmToAsm.CFG

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


-- | Records the expected cost to spill some register.
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 VirtualReg SpillCostRecord

type SpillCostState = State SpillCostInfo ()

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


-- | Add two spill cost infos.
plusSpillCostInfo :: SpillCostInfo -> SpillCostInfo -> SpillCostInfo
plusSpillCostInfo :: SpillCostInfo -> SpillCostInfo -> SpillCostInfo
plusSpillCostInfo SpillCostInfo
sc1 SpillCostInfo
sc2
        = forall elt key.
(elt -> elt -> elt)
-> UniqFM key elt -> UniqFM key elt -> UniqFM key 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 (VirtualReg
r1, Int
a1, Int
b1, Int
c1) (VirtualReg
r2, Int
a2, Int
b2, Int
c2)
        | VirtualReg
r1 forall a. Eq a => a -> a -> Bool
== VirtualReg
r2      = (VirtualReg
r1, Int
a1 forall a. Num a => a -> a -> a
+ Int
a2, Int
b1 forall a. Num a => a -> a -> a
+ Int
b2, Int
c1 forall a. Num a => a -> a -> a
+ Int
c2)
        | Bool
otherwise     = forall a. HasCallStack => [Char] -> a
error [Char]
"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. Instruction instr
                   => Platform
                   -> Maybe CFG
                   -> LiveCmmDecl statics instr
                   -> SpillCostInfo

slurpSpillCostInfo :: forall instr statics.
Instruction instr =>
Platform -> Maybe CFG -> LiveCmmDecl statics instr -> SpillCostInfo
slurpSpillCostInfo Platform
platform Maybe CFG
cfg LiveCmmDecl statics instr
cmm
        = forall s a. State s a -> s -> s
execState (LiveCmmDecl statics instr -> State SpillCostInfo ()
countCmm LiveCmmDecl statics instr
cmm) SpillCostInfo
zeroSpillCostInfo
 where
        countCmm :: LiveCmmDecl statics instr -> State SpillCostInfo ()
countCmm CmmData{}              = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        countCmm (CmmProc LiveInfo
info CLabel
_ [GlobalReg]
_ [SCC (GenBasicBlock (LiveInstr instr))]
sccs)
                = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LiveInfo
-> Maybe (LabelMap Double)
-> GenBasicBlock (LiveInstr instr)
-> State SpillCostInfo ()
countBlock LiveInfo
info Maybe (LabelMap Double)
freqMap)
                forall a b. (a -> b) -> a -> b
$ forall a. [SCC a] -> [a]
flattenSCCs [SCC (GenBasicBlock (LiveInstr instr))]
sccs
            where
                LiveInfo LabelMap RawCmmStatics
_ [BlockId]
entries BlockMap RegSet
_ BlockMap IntSet
_ = LiveInfo
info
                freqMap :: Maybe (LabelMap Double)
freqMap = (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack =>
BlockId -> CFG -> (LabelMap Double, LabelMap (LabelMap Double))
mkGlobalWeights (forall a. [a] -> a
head [BlockId]
entries)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CFG
cfg

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

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


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

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

                | Bool
otherwise
                = forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"RegSpillCost.slurpSpillCostInfo"
                forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
text [Char]
"no liveness information on instruction " SDoc -> SDoc -> SDoc
<> forall instr. Instruction instr => Platform -> instr -> SDoc
pprInstr Platform
platform InstrSR instr
instr

        countLIs Int
scale UniqSet VirtualReg
rsLiveEntry (LiveInstr InstrSR instr
instr (Just Liveness
live) : [LiveInstr instr]
lis)
         = do
                -- Increment the lifetime counts for regs live on entry to this instr.
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ VirtualReg -> State SpillCostInfo ()
incLifetime forall a b. (a -> b) -> a -> b
$ 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 [Reg]
read [Reg]
written)   = forall instr. Instruction instr => Platform -> instr -> RegUsage
regUsageOfInstr Platform
platform InstrSR instr
instr
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int -> VirtualReg -> State SpillCostInfo ()
incUses Int
scale) forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Reg -> Maybe VirtualReg
takeVirtualReg forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub [Reg]
read
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int -> VirtualReg -> State SpillCostInfo ()
incDefs Int
scale) forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Reg -> Maybe VirtualReg
takeVirtualReg forall a b. (a -> b) -> a -> b
$ 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 forall a. UniqSet a -> UniqSet a -> UniqSet a
`minusUniqSet` UniqSet VirtualReg
liveDieRead_virt

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

                Int
-> UniqSet VirtualReg
-> [LiveInstr instr]
-> State SpillCostInfo ()
countLIs Int
scale UniqSet VirtualReg
rsLiveNext [LiveInstr instr]
lis

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

        blockFreq :: Maybe (LabelMap Double) -> Label -> Double
        blockFreq :: Maybe (LabelMap Double) -> BlockId -> Double
blockFreq Maybe (LabelMap Double)
freqs BlockId
bid
          | Just Double
freq <- forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup BlockId
bid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LabelMap Double)
freqs)
          = forall a. Ord a => a -> a -> a
max Double
1.0 (Double
10000 forall a. Num a => a -> a -> a
* Double
freq)
          | Bool
otherwise
          = Double
1.0 -- Only if no cfg given

-- | Take all the virtual registers from this set.
takeVirtuals :: UniqSet Reg -> UniqSet VirtualReg
takeVirtuals :: RegSet -> UniqSet VirtualReg
takeVirtuals RegSet
set = forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet
  [ VirtualReg
vr | RegVirtual VirtualReg
vr <- 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 SpillCostInfo
info 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    = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (\Node VirtualReg RegClass RealReg
n1 Node VirtualReg RegClass RealReg
n2 -> forall a. Ord a => a -> a -> Ordering
compare (VirtualReg -> Float
cost forall a b. (a -> b) -> a -> b
$ forall k cls color. Node k cls color -> k
nodeId Node VirtualReg RegClass RealReg
n1) (VirtualReg -> Float
cost forall a b. (a -> b) -> a -> b
$ forall k cls color. Node k cls color -> k
nodeId Node VirtualReg RegClass RealReg
n2))
                forall a b. (a -> b) -> a -> b
$ forall key elt. UniqFM key elt -> [elt]
nonDetEltsUFM forall a b. (a -> b) -> a -> b
$ forall k cls color.
Graph k cls color -> UniqFM k (Node k cls color)
graphMap Graph VirtualReg RegClass RealReg
graph
                -- See Note [Unique Determinism and code generation]

   in   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 VirtualReg RegClass RealReg
--         -> VirtualReg
--         -> 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.

--         -- To facility this we scale down the spill cost of long ranges.
--         -- This makes sure long ranges are still spilled first.
--         -- But this way spill cost remains relevant for long live
--         -- ranges.
--         | lifetime >= 128
--         = (spillCost / conflicts) / 10.0


--         -- Otherwise revert to chaitin's regular cost function.
--         | otherwise = (spillCost / conflicts)
--         where
--             !spillCost = fromIntegral (uses + defs) :: Float
--             conflicts = fromIntegral (nodeDegree classOfVirtualReg graph reg)
--             (_, 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 SpillCostInfo
info Graph VirtualReg RegClass RealReg
_ VirtualReg
reg
        | Int
lifetime forall a. Ord a => a -> a -> Bool
<= Int
1         = Float
1forall a. Fractional a => a -> a -> a
/Float
0
        | Bool
otherwise             = Float
1 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lifetime
        where (VirtualReg
_, Int
_, Int
_, Int
lifetime)
                = forall a. a -> Maybe a -> a
fromMaybe (VirtualReg
reg, Int
0, Int
0, Int
0)
                forall a b. (a -> b) -> a -> b
$ forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM SpillCostInfo
info VirtualReg
reg


-- | Extract a map of register lifetimes from a `SpillCostInfo`.
lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM VirtualReg (VirtualReg, Int)
lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM VirtualReg (VirtualReg, Int)
lifeMapFromSpillCostInfo SpillCostInfo
info
        = forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
listToUFM
        forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(VirtualReg
r, Int
_, Int
_, Int
life) -> (VirtualReg
r, (VirtualReg
r, Int
life)))
        forall a b. (a -> b) -> a -> b
$ forall key elt. UniqFM key 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 VirtualReg -> RegClass
classOfVirtualReg Graph VirtualReg RegClass RealReg
graph VirtualReg
reg
        | Just Node VirtualReg RegClass RealReg
node     <- forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM (forall k cls color.
Graph k cls color -> UniqFM k (Node k cls color)
graphMap Graph VirtualReg RegClass RealReg
graph) VirtualReg
reg

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

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

        | Bool
otherwise
        = Int
0


-- | Show a spill cost record, including the degree from the graph
--   and final calculated 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 VirtualReg -> RegClass
regClass Reg -> SDoc
pprReg Graph VirtualReg RegClass RealReg
graph (VirtualReg
reg, Int
uses, Int
defs, Int
life)
        =  [SDoc] -> SDoc
hsep
        [ Reg -> SDoc
pprReg (VirtualReg -> Reg
RegVirtual VirtualReg
reg)
        , forall a. Outputable a => a -> SDoc
ppr Int
uses
        , forall a. Outputable a => a -> SDoc
ppr Int
defs
        , forall a. Outputable a => a -> SDoc
ppr Int
life
        , forall a. Outputable a => a -> SDoc
ppr 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 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
uses forall a. Num a => a -> a -> a
+ Int
defs)
                       forall a. Fractional a => a -> a -> a
/ 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) ]