import RegAlloc.Linear.Stats
import RegAlloc.Linear.StackMap
import RegAlloc.Linear.Base
-import RegAlloc.Linear.FreeRegs
-
-
-import MachInstrs
-import MachRegs
-import RegAllocInfo
-import RegLiveness
+import RegAlloc.Liveness
+import Instruction
+import Reg
import Unique
import UniqSupply
-- | The RegM Monad
-instance Monad RegM where
+instance Monad (RegM freeRegs) where
m >>= k = RegM $ \s -> case unReg m s of { (# s, a #) -> unReg (k a) s }
return a = RegM $ \s -> (# s, a #)
-- | Run a computation in the RegM register allocator monad.
-runR :: BlockAssignment
- -> FreeRegs
+runR :: BlockAssignment freeRegs
+ -> freeRegs
-> RegMap Loc
-> StackMap
-> UniqSupply
- -> RegM a
- -> (BlockAssignment, StackMap, RegAllocStats, a)
+ -> RegM freeRegs a
+ -> (BlockAssignment freeRegs, StackMap, RegAllocStats, a)
runR block_assig freeregs assig stack us thing =
case unReg thing
-- | Make register allocator stats from its final state.
-makeRAStats :: RA_State -> RegAllocStats
+makeRAStats :: RA_State freeRegs -> RegAllocStats
makeRAStats state
= RegAllocStats
{ ra_spillInstrs = binSpillReasons (ra_spills state) }
-spillR :: Reg -> Unique -> RegM (Instr, Int)
+spillR :: Instruction instr
+ => Reg -> Unique -> RegM freeRegs (instr, Int)
+
spillR reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} ->
let (stack',slot) = getStackSlotFor stack temp
instr = mkSpillInstr reg delta slot
in
(# s{ra_stack=stack'}, (instr,slot) #)
-loadR :: Reg -> Int -> RegM Instr
+
+loadR :: Instruction instr
+ => Reg -> Int -> RegM freeRegs instr
+
loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta} ->
(# s, mkLoadInstr reg delta slot #)
-getFreeRegsR :: RegM FreeRegs
+getFreeRegsR :: RegM freeRegs freeRegs
getFreeRegsR = RegM $ \ s@RA_State{ra_freeregs = freeregs} ->
(# s, freeregs #)
-setFreeRegsR :: FreeRegs -> RegM ()
+setFreeRegsR :: freeRegs -> RegM freeRegs ()
setFreeRegsR regs = RegM $ \ s ->
(# s{ra_freeregs = regs}, () #)
-getAssigR :: RegM (RegMap Loc)
+getAssigR :: RegM freeRegs (RegMap Loc)
getAssigR = RegM $ \ s@RA_State{ra_assig = assig} ->
(# s, assig #)
-setAssigR :: RegMap Loc -> RegM ()
+setAssigR :: RegMap Loc -> RegM freeRegs ()
setAssigR assig = RegM $ \ s ->
(# s{ra_assig=assig}, () #)
-getBlockAssigR :: RegM BlockAssignment
+getBlockAssigR :: RegM freeRegs (BlockAssignment freeRegs)
getBlockAssigR = RegM $ \ s@RA_State{ra_blockassig = assig} ->
(# s, assig #)
-setBlockAssigR :: BlockAssignment -> RegM ()
+setBlockAssigR :: BlockAssignment freeRegs -> RegM freeRegs ()
setBlockAssigR assig = RegM $ \ s ->
(# s{ra_blockassig = assig}, () #)
-setDeltaR :: Int -> RegM ()
+setDeltaR :: Int -> RegM freeRegs ()
setDeltaR n = RegM $ \ s ->
(# s{ra_delta = n}, () #)
-getDeltaR :: RegM Int
+getDeltaR :: RegM freeRegs Int
getDeltaR = RegM $ \s -> (# s, ra_delta s #)
-getUniqueR :: RegM Unique
+getUniqueR :: RegM freeRegs Unique
getUniqueR = RegM $ \s ->
- case splitUniqSupply (ra_us s) of
- (us1, us2) -> (# s{ra_us = us2}, uniqFromSupply us1 #)
+ case takeUniqFromSupply (ra_us s) of
+ (uniq, us) -> (# s{ra_us = us}, uniq #)
-- | Record that a spill instruction was inserted, for profiling.
-recordSpill :: SpillReason -> RegM ()
+recordSpill :: SpillReason -> RegM freeRegs ()
recordSpill spill
= RegM $ \s -> (# s { ra_spills = spill : ra_spills s}, () #)