{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# 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.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.Strict
import GHC.CmmToAsm.CFG
import GHC.CmmToAsm.Format
import Data.List (nub, minimumBy)
import Data.Maybe
import Control.Monad (join)
type SpillCostRecord
= ( VirtualReg
, Int
, Int
, Int)
type SpillCostInfo
= UniqFM VirtualReg SpillCostRecord
type SpillCostState = State SpillCostInfo ()
zeroSpillCostInfo :: SpillCostInfo
zeroSpillCostInfo :: SpillCostInfo
zeroSpillCostInfo = SpillCostInfo
forall {k} (key :: k) elt. UniqFM key elt
emptyUFM
plusSpillCostInfo :: SpillCostInfo -> SpillCostInfo -> SpillCostInfo
plusSpillCostInfo :: SpillCostInfo -> SpillCostInfo -> SpillCostInfo
plusSpillCostInfo SpillCostInfo
sc1 SpillCostInfo
sc2
= (SpillCostRecord -> SpillCostRecord -> SpillCostRecord)
-> SpillCostInfo -> SpillCostInfo -> SpillCostInfo
forall {k} elt (key :: k).
(elt -> elt -> elt)
-> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusUFM_C SpillCostRecord -> SpillCostRecord -> SpillCostRecord
plusSpillCostRecord SpillCostInfo
sc1 SpillCostInfo
sc2
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 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 [Char]
"RegSpillCost.plusRegInt: regs don't match"
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
= State SpillCostInfo () -> SpillCostInfo -> SpillCostInfo
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{} = () -> State SpillCostInfo ()
forall a. a -> State SpillCostInfo a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
countCmm (CmmProc LiveInfo
info CLabel
_ [GlobalRegUse]
_ [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
-> Maybe (LabelMap Double)
-> GenBasicBlock (LiveInstr instr)
-> State SpillCostInfo ()
countBlock LiveInfo
info Maybe (LabelMap Double)
freqMap)
([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
where
LiveInfo LabelMap RawCmmStatics
_ [BlockId]
entries BlockMap (UniqSet RegWithFormat)
_ BlockMap IntSet
_ = LiveInfo
info
freqMap :: Maybe (LabelMap Double)
freqMap = ((LabelMap Double, LabelMap (LabelMap Double)) -> LabelMap Double
forall a b. (a, b) -> a
fst ((LabelMap Double, LabelMap (LabelMap Double)) -> LabelMap Double)
-> (CFG -> (LabelMap Double, LabelMap (LabelMap Double)))
-> CFG
-> LabelMap Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack =>
BlockId -> CFG -> (LabelMap Double, LabelMap (LabelMap Double))
BlockId -> CFG -> (LabelMap Double, LabelMap (LabelMap Double))
mkGlobalWeights ([BlockId] -> BlockId
forall a. HasCallStack => [a] -> a
head [BlockId]
entries)) (CFG -> LabelMap Double) -> Maybe CFG -> Maybe (LabelMap Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CFG
cfg
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 (UniqSet RegWithFormat)
blockLive BlockMap IntSet
_ <- LiveInfo
info
, Just UniqSet RegWithFormat
rsLiveEntry <- BlockId
-> BlockMap (UniqSet RegWithFormat)
-> Maybe (UniqSet RegWithFormat)
forall a. BlockId -> LabelMap a -> Maybe a
mapLookup BlockId
blockId BlockMap (UniqSet RegWithFormat)
blockLive
, UniqSet VirtualReg
rsLiveEntry_virt <- UniqSet RegWithFormat -> UniqSet VirtualReg
takeVirtualRegs UniqSet RegWithFormat
rsLiveEntry
= Int
-> UniqSet VirtualReg
-> [LiveInstr instr]
-> State SpillCostInfo ()
countLIs (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Int) -> Double -> Int
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
= [Char] -> State SpillCostInfo ()
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
_ []
= () -> State SpillCostInfo ()
forall a. a -> State SpillCostInfo a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
countLIs Int
scale UniqSet VirtualReg
rsLive (LiveInstr InstrSR instr
instr Maybe Liveness
Nothing : [LiveInstr instr]
lis)
| InstrSR instr -> Bool
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
= [Char] -> SDoc -> State SpillCostInfo ()
forall a. HasCallStack => [Char] -> SDoc -> a
pprPanic [Char]
"RegSpillCost.slurpSpillCostInfo"
(SDoc -> State SpillCostInfo ()) -> SDoc -> State SpillCostInfo ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"no liveness information on instruction " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> InstrSR instr -> 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
(VirtualReg -> State SpillCostInfo ())
-> [VirtualReg] -> State SpillCostInfo ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ VirtualReg -> State SpillCostInfo ()
incLifetime ([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
let (RU [RegWithFormat]
read [RegWithFormat]
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 Int
scale) ([VirtualReg] -> State SpillCostInfo ())
-> [VirtualReg] -> State SpillCostInfo ()
forall a b. (a -> b) -> a -> b
$ [VirtualReg] -> [VirtualReg]
forall a. Eq a => [a] -> [a]
nub ([VirtualReg] -> [VirtualReg]) -> [VirtualReg] -> [VirtualReg]
forall a b. (a -> b) -> a -> b
$ (RegWithFormat -> Maybe VirtualReg)
-> [RegWithFormat] -> [VirtualReg]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Reg -> Maybe VirtualReg
takeVirtualReg (Reg -> Maybe VirtualReg)
-> (RegWithFormat -> Reg) -> RegWithFormat -> Maybe VirtualReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegWithFormat -> Reg
regWithFormat_reg) [RegWithFormat]
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 Int
scale) ([VirtualReg] -> State SpillCostInfo ())
-> [VirtualReg] -> State SpillCostInfo ()
forall a b. (a -> b) -> a -> b
$ [VirtualReg] -> [VirtualReg]
forall a. Eq a => [a] -> [a]
nub ([VirtualReg] -> [VirtualReg]) -> [VirtualReg] -> [VirtualReg]
forall a b. (a -> b) -> a -> b
$ (RegWithFormat -> Maybe VirtualReg)
-> [RegWithFormat] -> [VirtualReg]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Reg -> Maybe VirtualReg
takeVirtualReg (Reg -> Maybe VirtualReg)
-> (RegWithFormat -> Reg) -> RegWithFormat -> Maybe VirtualReg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegWithFormat -> Reg
regWithFormat_reg) [RegWithFormat]
written
let liveDieRead_virt :: UniqSet VirtualReg
liveDieRead_virt = UniqSet RegWithFormat -> UniqSet VirtualReg
takeVirtualRegs (Liveness -> UniqSet RegWithFormat
liveDieRead Liveness
live)
let liveDieWrite_virt :: UniqSet VirtualReg
liveDieWrite_virt = UniqSet RegWithFormat -> UniqSet VirtualReg
takeVirtualRegs (Liveness -> UniqSet RegWithFormat
liveDieWrite Liveness
live)
let liveBorn_virt :: UniqSet VirtualReg
liveBorn_virt = UniqSet RegWithFormat -> UniqSet VirtualReg
takeVirtualRegs (Liveness -> UniqSet RegWithFormat
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
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 = (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
$ \SpillCostInfo
s -> (SpillCostRecord -> SpillCostRecord -> SpillCostRecord)
-> SpillCostInfo -> VirtualReg -> SpillCostRecord -> SpillCostInfo
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 = (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
$ \SpillCostInfo
s -> (SpillCostRecord -> SpillCostRecord -> SpillCostRecord)
-> SpillCostInfo -> VirtualReg -> SpillCostRecord -> SpillCostInfo
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 = (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
$ \SpillCostInfo
s -> (SpillCostRecord -> SpillCostRecord -> SpillCostRecord)
-> SpillCostInfo -> VirtualReg -> SpillCostRecord -> SpillCostInfo
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 <- Maybe (Maybe Double) -> Maybe Double
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (BlockId -> LabelMap Double -> Maybe Double
forall a. BlockId -> LabelMap a -> Maybe a
mapLookup BlockId
bid (LabelMap Double -> Maybe Double)
-> Maybe (LabelMap Double) -> Maybe (Maybe Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LabelMap Double)
freqs)
= Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
1.0 (Double
10000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
freq)
| Bool
otherwise
= Double
1.0
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 = (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 (\Node VirtualReg RegClass RealReg
n1 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 VirtualReg (Node VirtualReg RegClass RealReg)
-> [Node VirtualReg RegClass RealReg]
forall {k} (key :: k) elt. UniqFM key elt -> [elt]
nonDetEltsUFM (UniqFM VirtualReg (Node VirtualReg RegClass RealReg)
-> [Node VirtualReg RegClass RealReg])
-> UniqFM VirtualReg (Node VirtualReg RegClass RealReg)
-> [Node VirtualReg RegClass RealReg]
forall a b. (a -> b) -> a -> b
$ Graph VirtualReg RegClass RealReg
-> UniqFM VirtualReg (Node VirtualReg RegClass RealReg)
forall k cls color.
Graph k cls color -> UniqFM k (Node k cls color)
graphMap Graph VirtualReg RegClass RealReg
graph
in Node VirtualReg RegClass RealReg -> VirtualReg
forall k cls color. Node k cls color -> k
nodeId Node VirtualReg RegClass RealReg
node
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0
| Bool
otherwise = Float
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 (VirtualReg
_, Int
_, Int
_, Int
lifetime)
= SpillCostRecord -> Maybe SpillCostRecord -> SpillCostRecord
forall a. a -> Maybe a -> a
fromMaybe (VirtualReg
reg, Int
0, Int
0, Int
0)
(Maybe SpillCostRecord -> SpillCostRecord)
-> Maybe SpillCostRecord -> SpillCostRecord
forall a b. (a -> b) -> a -> b
$ SpillCostInfo -> VirtualReg -> Maybe SpillCostRecord
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM SpillCostInfo
info VirtualReg
reg
lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM VirtualReg (VirtualReg, Int)
lifeMapFromSpillCostInfo :: SpillCostInfo -> UniqFM VirtualReg (VirtualReg, Int)
lifeMapFromSpillCostInfo SpillCostInfo
info
= [(VirtualReg, (VirtualReg, Int))]
-> UniqFM VirtualReg (VirtualReg, Int)
forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
listToUFM
([(VirtualReg, (VirtualReg, Int))]
-> UniqFM VirtualReg (VirtualReg, Int))
-> [(VirtualReg, (VirtualReg, Int))]
-> UniqFM VirtualReg (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 (\(VirtualReg
r, Int
_, Int
_, 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 {k} (key :: k) elt. UniqFM key elt -> [elt]
nonDetEltsUFM SpillCostInfo
info
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 <- UniqFM VirtualReg (Node VirtualReg RegClass RealReg)
-> VirtualReg -> Maybe (Node VirtualReg RegClass RealReg)
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM (Graph VirtualReg RegClass RealReg
-> UniqFM VirtualReg (Node VirtualReg RegClass RealReg)
forall k cls color.
Graph k cls color -> UniqFM k (Node k cls color)
graphMap Graph VirtualReg RegClass RealReg
graph) VirtualReg
reg
, Int
virtConflicts
<- [VirtualReg] -> Int
forall a. [a] -> 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 (\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
(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
= Int
0
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
forall doc. IsLine doc => [doc] -> doc
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
forall doc. IsLine doc => [Char] -> doc
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) ]