Remove CPP from nativeGen/RegAlloc/Linear/FreeRegs.hs

[ghc-hetmet.git] / compiler / nativeGen / RegAlloc / Linear / State.hs

diff --git a/compiler/nativeGen/RegAlloc/Linear/State.hs b/compiler/nativeGen/RegAlloc/Linear/State.hs
index 94a8f7b..05db9de 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Linear/State.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/State.hs
@@ -32,32 +32,28 @@ where
 import RegAlloc.Linear.Stats
 import RegAlloc.Linear.StackMap
 import RegAlloc.Linear.Base
-import RegAlloc.Linear.FreeRegs
 import RegAlloc.Liveness
-
-
-import Instrs
-import Regs
-import RegAllocInfo
+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 
@@ -79,61 +75,66 @@ 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 :: 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}, () #)