X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAlloc%2FLinear%2FState.hs;fp=compiler%2FnativeGen%2FRegAlloc%2FLinear%2FState.hs;h=7793feecef45c4c476cf759a4f42d12c1757e889;hp=234701c60ea6bd496d8d2229174f8f8ae8b9d7be;hb=59244201b672b9d6f728edcf7e2e02a61fbe278f;hpb=6fe4f8d560bedfd21289a1a9f9360a371b3a5246 diff --git a/compiler/nativeGen/RegAlloc/Linear/State.hs b/compiler/nativeGen/RegAlloc/Linear/State.hs index 234701c..7793fee 100644 --- a/compiler/nativeGen/RegAlloc/Linear/State.hs +++ b/compiler/nativeGen/RegAlloc/Linear/State.hs @@ -42,7 +42,7 @@ 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 #) @@ -53,7 +53,7 @@ runR :: BlockAssignment -> RegMap Loc -> StackMap -> UniqSupply - -> RegM a + -> RegM FreeRegs a -> (BlockAssignment, StackMap, RegAllocStats, a) runR block_assig freeregs assig stack us thing = @@ -76,14 +76,14 @@ runR block_assig freeregs assig stack us 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 :: Instruction instr - => Reg -> Unique -> RegM (instr, Int) + => 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 @@ -93,49 +93,49 @@ spillR reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} -> loadR :: Instruction instr - => Reg -> Int -> RegM 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 getBlockAssigR = RegM $ \ s@RA_State{ra_blockassig = assig} -> (# s, assig #) -setBlockAssigR :: BlockAssignment -> RegM () +setBlockAssigR :: BlockAssignment -> 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 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}, () #)