module GHC.CmmToAsm.Reg.Graph.Spill (
regSpill,
SpillStats(..),
accSpillSL
) where
import GHC.Prelude
import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Reg.Utils
import GHC.CmmToAsm.Instr
import GHC.Platform.Reg
import GHC.Cmm hiding (RegSet)
import GHC.Cmm.BlockId
import GHC.Cmm.Dataflow.Collections
import GHC.Utils.Monad
import GHC.Utils.Monad.State
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.Unique.Set
import GHC.Types.Unique.Supply
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Platform
import Data.List (nub, (\\), intersect)
import Data.Maybe
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
regSpill
:: Instruction instr
=> Platform
-> [LiveCmmDecl statics instr]
-> UniqSet Int
-> Int
-> UniqSet VirtualReg
-> UniqSM
([LiveCmmDecl statics instr]
, UniqSet Int
, Int
, SpillStats )
regSpill :: forall instr statics.
Instruction instr =>
Platform
-> [LiveCmmDecl statics instr]
-> UniqSet Int
-> Int
-> UniqSet VirtualReg
-> UniqSM
([LiveCmmDecl statics instr], UniqSet Int, Int, SpillStats)
regSpill Platform
platform [LiveCmmDecl statics instr]
code UniqSet Int
slotsFree Int
slotCount UniqSet VirtualReg
regs
| forall a. UniqSet a -> Int
sizeUniqSet UniqSet Int
slotsFree forall a. Ord a => a -> a -> Bool
< forall a. UniqSet a -> Int
sizeUniqSet UniqSet VirtualReg
regs
=
let slotsFree' :: UniqSet Int
slotsFree' = (forall a. Uniquable a => UniqSet a -> [a] -> UniqSet a
addListToUniqSet UniqSet Int
slotsFree [Int
slotCountforall a. Num a => a -> a -> a
+Int
1 .. Int
slotCountforall a. Num a => a -> a -> a
+Int
512])
in forall instr statics.
Instruction instr =>
Platform
-> [LiveCmmDecl statics instr]
-> UniqSet Int
-> Int
-> UniqSet VirtualReg
-> UniqSM
([LiveCmmDecl statics instr], UniqSet Int, Int, SpillStats)
regSpill Platform
platform [LiveCmmDecl statics instr]
code UniqSet Int
slotsFree' (Int
slotCountforall a. Num a => a -> a -> a
+Int
512) UniqSet VirtualReg
regs
| Bool
otherwise
= do
let slots :: [Int]
slots = forall a. Int -> [a] -> [a]
take (forall a. UniqSet a -> Int
sizeUniqSet UniqSet VirtualReg
regs) forall a b. (a -> b) -> a -> b
$ forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet UniqSet Int
slotsFree
let
regSlotMap :: UniqFM Reg Int
regSlotMap = forall elt. UniqFM VirtualReg elt -> UniqFM Reg elt
toRegMap
forall a b. (a -> b) -> a -> b
$ 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)]
zip (forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet UniqSet VirtualReg
regs) [Int]
slots :: UniqFM Reg Int
UniqSupply
us <- forall (m :: * -> *). MonadUnique m => m UniqSupply
getUniqueSupplyM
let ([LiveCmmDecl statics instr]
code', SpillS
state') =
forall s a. State s a -> s -> (a, s)
runState (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall instr statics.
Instruction instr =>
Platform
-> UniqFM Reg Int
-> LiveCmmDecl statics instr
-> SpillM (LiveCmmDecl statics instr)
regSpill_top Platform
platform UniqFM Reg Int
regSlotMap) [LiveCmmDecl statics instr]
code)
(UniqSupply -> SpillS
initSpillS UniqSupply
us)
forall (m :: * -> *) a. Monad m => a -> m a
return ( [LiveCmmDecl statics instr]
code'
, forall a. UniqSet a -> UniqSet a -> UniqSet a
minusUniqSet UniqSet Int
slotsFree (forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet [Int]
slots)
, Int
slotCount
, SpillS -> SpillStats
makeSpillStats SpillS
state')
regSpill_top
:: Instruction instr
=> Platform
-> RegMap Int
-> LiveCmmDecl statics instr
-> SpillM (LiveCmmDecl statics instr)
regSpill_top :: forall instr statics.
Instruction instr =>
Platform
-> UniqFM Reg Int
-> LiveCmmDecl statics instr
-> SpillM (LiveCmmDecl statics instr)
regSpill_top Platform
platform UniqFM Reg Int
regSlotMap LiveCmmDecl statics instr
cmm
= case LiveCmmDecl statics instr
cmm of
CmmData{}
-> 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
static [BlockId]
firstId BlockMap RegSet
liveVRegsOnEntry BlockMap IntSet
liveSlotsOnEntry <- LiveInfo
info
-> do
let liveSlotsOnEntry' :: BlockMap IntSet
liveSlotsOnEntry' :: BlockMap IntSet
liveSlotsOnEntry'
= forall (map :: * -> *) b a.
IsMap map =>
(b -> KeyOf map -> a -> b) -> b -> map a -> b
mapFoldlWithKey BlockMap IntSet -> BlockId -> RegSet -> BlockMap IntSet
patchLiveSlot
BlockMap IntSet
liveSlotsOnEntry BlockMap RegSet
liveVRegsOnEntry
let info' :: LiveInfo
info'
= LabelMap RawCmmStatics
-> [BlockId] -> BlockMap RegSet -> BlockMap IntSet -> LiveInfo
LiveInfo LabelMap RawCmmStatics
static [BlockId]
firstId
BlockMap RegSet
liveVRegsOnEntry
BlockMap IntSet
liveSlotsOnEntry'
[SCC (LiveBasicBlock instr)]
sccs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SCC a -> m (SCC b)
mapSCCM (forall instr.
Instruction instr =>
Platform
-> UniqFM Reg Int
-> LiveBasicBlock instr
-> SpillM (LiveBasicBlock instr)
regSpill_block Platform
platform UniqFM Reg Int
regSlotMap)) [SCC (LiveBasicBlock instr)]
sccs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LiveInfo
info' CLabel
label [GlobalReg]
live [SCC (LiveBasicBlock instr)]
sccs'
where
patchLiveSlot
:: BlockMap IntSet -> BlockId -> RegSet -> BlockMap IntSet
patchLiveSlot :: BlockMap IntSet -> BlockId -> RegSet -> BlockMap IntSet
patchLiveSlot BlockMap IntSet
slotMap BlockId
blockId RegSet
regsLive
= let
curSlotsLive :: IntSet
curSlotsLive = forall a. a -> Maybe a -> a
fromMaybe IntSet
IntSet.empty
forall a b. (a -> b) -> a -> b
$ forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup BlockId
blockId BlockMap IntSet
slotMap
moreSlotsLive :: IntSet
moreSlotsLive = [Int] -> IntSet
IntSet.fromList
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 (forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM Reg Int
regSlotMap)
forall a b. (a -> b) -> a -> b
$ forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet RegSet
regsLive
slotMap' :: BlockMap IntSet
slotMap'
= forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> a -> map a -> map a
mapInsert BlockId
blockId (IntSet -> IntSet -> IntSet
IntSet.union IntSet
curSlotsLive IntSet
moreSlotsLive)
BlockMap IntSet
slotMap
in BlockMap IntSet
slotMap'
regSpill_block
:: Instruction instr
=> Platform
-> UniqFM Reg Int
-> LiveBasicBlock instr
-> SpillM (LiveBasicBlock instr)
regSpill_block :: forall instr.
Instruction instr =>
Platform
-> UniqFM Reg Int
-> LiveBasicBlock instr
-> SpillM (LiveBasicBlock instr)
regSpill_block Platform
platform UniqFM Reg Int
regSlotMap (BasicBlock BlockId
i [LiveInstr instr]
instrs)
= do [[LiveInstr instr]]
instrss' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall instr.
Instruction instr =>
Platform
-> UniqFM Reg Int -> LiveInstr instr -> SpillM [LiveInstr instr]
regSpill_instr Platform
platform UniqFM Reg Int
regSlotMap) [LiveInstr instr]
instrs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
i (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[LiveInstr instr]]
instrss')
regSpill_instr
:: Instruction instr
=> Platform
-> UniqFM Reg Int
-> LiveInstr instr
-> SpillM [LiveInstr instr]
regSpill_instr :: forall instr.
Instruction instr =>
Platform
-> UniqFM Reg Int -> LiveInstr instr -> SpillM [LiveInstr instr]
regSpill_instr Platform
_ UniqFM Reg Int
_ li :: LiveInstr instr
li@(LiveInstr InstrSR instr
_ Maybe Liveness
Nothing) = forall (m :: * -> *) a. Monad m => a -> m a
return [LiveInstr instr
li]
regSpill_instr Platform
platform UniqFM Reg Int
regSlotMap (LiveInstr InstrSR instr
instr (Just Liveness
_)) = do
let RU [Reg]
rlRead [Reg]
rlWritten = forall instr. Instruction instr => Platform -> instr -> RegUsage
regUsageOfInstr Platform
platform InstrSR instr
instr
let rsRead_ :: [Reg]
rsRead_ = forall a. Eq a => [a] -> [a]
nub [Reg]
rlRead
let rsWritten_ :: [Reg]
rsWritten_ = forall a. Eq a => [a] -> [a]
nub [Reg]
rlWritten
let rsRead :: [Reg]
rsRead = [Reg]
rsRead_ forall a. Eq a => [a] -> [a] -> [a]
\\ [Reg]
rsWritten_
let rsWritten :: [Reg]
rsWritten = [Reg]
rsWritten_ forall a. Eq a => [a] -> [a] -> [a]
\\ [Reg]
rsRead_
let rsModify :: [Reg]
rsModify = forall a. Eq a => [a] -> [a] -> [a]
intersect [Reg]
rsRead_ [Reg]
rsWritten_
let rsSpillRead :: [Reg]
rsSpillRead = forall a. (a -> Bool) -> [a] -> [a]
filter (\Reg
r -> forall key elt. Uniquable key => key -> UniqFM key elt -> Bool
elemUFM Reg
r UniqFM Reg Int
regSlotMap) [Reg]
rsRead
let rsSpillWritten :: [Reg]
rsSpillWritten = forall a. (a -> Bool) -> [a] -> [a]
filter (\Reg
r -> forall key elt. Uniquable key => key -> UniqFM key elt -> Bool
elemUFM Reg
r UniqFM Reg Int
regSlotMap) [Reg]
rsWritten
let rsSpillModify :: [Reg]
rsSpillModify = forall a. (a -> Bool) -> [a] -> [a]
filter (\Reg
r -> forall key elt. Uniquable key => key -> UniqFM key elt -> Bool
elemUFM Reg
r UniqFM Reg Int
regSlotMap) [Reg]
rsModify
(InstrSR instr
instr1, [([LiveInstr instr], [LiveInstr instr])]
prepost1) <- forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM (forall instr instr'.
Instruction instr =>
UniqFM Reg Int
-> instr
-> Reg
-> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
spillRead UniqFM Reg Int
regSlotMap) InstrSR instr
instr [Reg]
rsSpillRead
(InstrSR instr
instr2, [([LiveInstr instr], [LiveInstr instr])]
prepost2) <- forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM (forall instr instr'.
Instruction instr =>
UniqFM Reg Int
-> instr
-> Reg
-> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
spillWrite UniqFM Reg Int
regSlotMap) InstrSR instr
instr1 [Reg]
rsSpillWritten
(InstrSR instr
instr3, [([LiveInstr instr], [LiveInstr instr])]
prepost3) <- forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM (forall instr instr'.
Instruction instr =>
UniqFM Reg Int
-> instr
-> Reg
-> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
spillModify UniqFM Reg Int
regSlotMap) InstrSR instr
instr2 [Reg]
rsSpillModify
let ([[LiveInstr instr]]
mPrefixes, [[LiveInstr instr]]
mPostfixes) = forall a b. [(a, b)] -> ([a], [b])
unzip ([([LiveInstr instr], [LiveInstr instr])]
prepost1 forall a. [a] -> [a] -> [a]
++ [([LiveInstr instr], [LiveInstr instr])]
prepost2 forall a. [a] -> [a] -> [a]
++ [([LiveInstr instr], [LiveInstr instr])]
prepost3)
let prefixes :: [LiveInstr instr]
prefixes = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[LiveInstr instr]]
mPrefixes
let postfixes :: [LiveInstr instr]
postfixes = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[LiveInstr instr]]
mPostfixes
let instrs' :: [LiveInstr instr]
instrs' = [LiveInstr instr]
prefixes
forall a. [a] -> [a] -> [a]
++ [forall instr. InstrSR instr -> Maybe Liveness -> LiveInstr instr
LiveInstr InstrSR instr
instr3 forall a. Maybe a
Nothing]
forall a. [a] -> [a] -> [a]
++ [LiveInstr instr]
postfixes
forall (m :: * -> *) a. Monad m => a -> m a
return [LiveInstr instr]
instrs'
spillRead
:: Instruction instr
=> UniqFM Reg Int
-> instr
-> Reg
-> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
spillRead :: forall instr instr'.
Instruction instr =>
UniqFM Reg Int
-> instr
-> Reg
-> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
spillRead UniqFM Reg Int
regSlotMap instr
instr Reg
reg
| Just Int
slot <- forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM Reg Int
regSlotMap Reg
reg
= do (instr
instr', Reg
nReg) <- forall instr.
Instruction instr =>
Reg -> instr -> SpillM (instr, Reg)
patchInstr Reg
reg instr
instr
forall s. (s -> s) -> State s ()
modify forall a b. (a -> b) -> a -> b
$ \SpillS
s -> SpillS
s
{ stateSpillSL :: UniqFM Reg (Reg, Int, Int)
stateSpillSL = forall key elt.
Uniquable key =>
(elt -> elt -> elt)
-> UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM_C (Reg, Int, Int) -> (Reg, Int, Int) -> (Reg, Int, Int)
accSpillSL (SpillS -> UniqFM Reg (Reg, Int, Int)
stateSpillSL SpillS
s) Reg
reg (Reg
reg, Int
0, Int
1) }
forall (m :: * -> *) a. Monad m => a -> m a
return ( instr
instr'
, ( [forall instr. InstrSR instr -> Maybe Liveness -> LiveInstr instr
LiveInstr (forall instr. Int -> Reg -> InstrSR instr
RELOAD Int
slot Reg
nReg) forall a. Maybe a
Nothing]
, []) )
| Bool
otherwise = forall a. String -> a
panic String
"RegSpill.spillRead: no slot defined for spilled reg"
spillWrite
:: Instruction instr
=> UniqFM Reg Int
-> instr
-> Reg
-> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
spillWrite :: forall instr instr'.
Instruction instr =>
UniqFM Reg Int
-> instr
-> Reg
-> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
spillWrite UniqFM Reg Int
regSlotMap instr
instr Reg
reg
| Just Int
slot <- forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM Reg Int
regSlotMap Reg
reg
= do (instr
instr', Reg
nReg) <- forall instr.
Instruction instr =>
Reg -> instr -> SpillM (instr, Reg)
patchInstr Reg
reg instr
instr
forall s. (s -> s) -> State s ()
modify forall a b. (a -> b) -> a -> b
$ \SpillS
s -> SpillS
s
{ stateSpillSL :: UniqFM Reg (Reg, Int, Int)
stateSpillSL = forall key elt.
Uniquable key =>
(elt -> elt -> elt)
-> UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM_C (Reg, Int, Int) -> (Reg, Int, Int) -> (Reg, Int, Int)
accSpillSL (SpillS -> UniqFM Reg (Reg, Int, Int)
stateSpillSL SpillS
s) Reg
reg (Reg
reg, Int
1, Int
0) }
forall (m :: * -> *) a. Monad m => a -> m a
return ( instr
instr'
, ( []
, [forall instr. InstrSR instr -> Maybe Liveness -> LiveInstr instr
LiveInstr (forall instr. Reg -> Int -> InstrSR instr
SPILL Reg
nReg Int
slot) forall a. Maybe a
Nothing]))
| Bool
otherwise = forall a. String -> a
panic String
"RegSpill.spillWrite: no slot defined for spilled reg"
spillModify
:: Instruction instr
=> UniqFM Reg Int
-> instr
-> Reg
-> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
spillModify :: forall instr instr'.
Instruction instr =>
UniqFM Reg Int
-> instr
-> Reg
-> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
spillModify UniqFM Reg Int
regSlotMap instr
instr Reg
reg
| Just Int
slot <- forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM Reg Int
regSlotMap Reg
reg
= do (instr
instr', Reg
nReg) <- forall instr.
Instruction instr =>
Reg -> instr -> SpillM (instr, Reg)
patchInstr Reg
reg instr
instr
forall s. (s -> s) -> State s ()
modify forall a b. (a -> b) -> a -> b
$ \SpillS
s -> SpillS
s
{ stateSpillSL :: UniqFM Reg (Reg, Int, Int)
stateSpillSL = forall key elt.
Uniquable key =>
(elt -> elt -> elt)
-> UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM_C (Reg, Int, Int) -> (Reg, Int, Int) -> (Reg, Int, Int)
accSpillSL (SpillS -> UniqFM Reg (Reg, Int, Int)
stateSpillSL SpillS
s) Reg
reg (Reg
reg, Int
1, Int
1) }
forall (m :: * -> *) a. Monad m => a -> m a
return ( instr
instr'
, ( [forall instr. InstrSR instr -> Maybe Liveness -> LiveInstr instr
LiveInstr (forall instr. Int -> Reg -> InstrSR instr
RELOAD Int
slot Reg
nReg) forall a. Maybe a
Nothing]
, [forall instr. InstrSR instr -> Maybe Liveness -> LiveInstr instr
LiveInstr (forall instr. Reg -> Int -> InstrSR instr
SPILL Reg
nReg Int
slot) forall a. Maybe a
Nothing]))
| Bool
otherwise = forall a. String -> a
panic String
"RegSpill.spillModify: no slot defined for spilled reg"
patchInstr
:: Instruction instr
=> Reg -> instr -> SpillM (instr, Reg)
patchInstr :: forall instr.
Instruction instr =>
Reg -> instr -> SpillM (instr, Reg)
patchInstr Reg
reg instr
instr
= do Unique
nUnique <- SpillM Unique
newUnique
let nReg :: Reg
nReg
= case Reg
reg of
RegVirtual VirtualReg
vr
-> VirtualReg -> Reg
RegVirtual (Unique -> VirtualReg -> VirtualReg
renameVirtualReg Unique
nUnique VirtualReg
vr)
RegReal{}
-> forall a. String -> a
panic String
"RegAlloc.Graph.Spill.patchIntr: not patching real reg"
let instr' :: instr
instr' = forall instr. Instruction instr => Reg -> Reg -> instr -> instr
patchReg1 Reg
reg Reg
nReg instr
instr
forall (m :: * -> *) a. Monad m => a -> m a
return (instr
instr', Reg
nReg)
patchReg1
:: Instruction instr
=> Reg -> Reg -> instr -> instr
patchReg1 :: forall instr. Instruction instr => Reg -> Reg -> instr -> instr
patchReg1 Reg
old Reg
new instr
instr
= let patchF :: Reg -> Reg
patchF Reg
r
| Reg
r forall a. Eq a => a -> a -> Bool
== Reg
old = Reg
new
| Bool
otherwise = Reg
r
in forall instr. Instruction instr => instr -> (Reg -> Reg) -> instr
patchRegsOfInstr instr
instr Reg -> Reg
patchF
type SpillM a
= State SpillS a
data SpillS
= SpillS
{
SpillS -> UniqSupply
stateUS :: UniqSupply
, SpillS -> UniqFM Reg (Reg, Int, Int)
stateSpillSL :: UniqFM Reg (Reg, Int, Int) }
initSpillS :: UniqSupply -> SpillS
initSpillS :: UniqSupply -> SpillS
initSpillS UniqSupply
uniqueSupply
= SpillS
{ stateUS :: UniqSupply
stateUS = UniqSupply
uniqueSupply
, stateSpillSL :: UniqFM Reg (Reg, Int, Int)
stateSpillSL = forall key elt. UniqFM key elt
emptyUFM }
newUnique :: SpillM Unique
newUnique :: SpillM Unique
newUnique
= do UniqSupply
us <- forall s a. (s -> a) -> State s a
gets SpillS -> UniqSupply
stateUS
case UniqSupply -> (Unique, UniqSupply)
takeUniqFromSupply UniqSupply
us of
(Unique
uniq, UniqSupply
us')
-> do forall s. (s -> s) -> State s ()
modify forall a b. (a -> b) -> a -> b
$ \SpillS
s -> SpillS
s { stateUS :: UniqSupply
stateUS = UniqSupply
us' }
forall (m :: * -> *) a. Monad m => a -> m a
return Unique
uniq
accSpillSL :: (Reg, Int, Int) -> (Reg, Int, Int) -> (Reg, Int, Int)
accSpillSL :: (Reg, Int, Int) -> (Reg, Int, Int) -> (Reg, Int, Int)
accSpillSL (Reg
r1, Int
s1, Int
l1) (Reg
_, Int
s2, Int
l2)
= (Reg
r1, Int
s1 forall a. Num a => a -> a -> a
+ Int
s2, Int
l1 forall a. Num a => a -> a -> a
+ Int
l2)
data SpillStats
= SpillStats
{ SpillStats -> UniqFM Reg (Reg, Int, Int)
spillStoreLoad :: UniqFM Reg (Reg, Int, Int) }
makeSpillStats :: SpillS -> SpillStats
makeSpillStats :: SpillS -> SpillStats
makeSpillStats SpillS
s
= SpillStats
{ spillStoreLoad :: UniqFM Reg (Reg, Int, Int)
spillStoreLoad = SpillS -> UniqFM Reg (Reg, Int, Int)
stateSpillSL SpillS
s }
instance Outputable SpillStats where
ppr :: SpillStats -> SDoc
ppr SpillStats
stats
= forall key a. UniqFM key a -> ([a] -> SDoc) -> SDoc
pprUFM (SpillStats -> UniqFM Reg (Reg, Int, Int)
spillStoreLoad SpillStats
stats)
([SDoc] -> SDoc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Reg
r, Int
s, Int
l) -> forall a. Outputable a => a -> SDoc
ppr Reg
r SDoc -> SDoc -> SDoc
<+> Int -> SDoc
int Int
s SDoc -> SDoc -> SDoc
<+> Int -> SDoc
int Int
l))