X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAlloc%2FGraph%2FSpill.hs;h=4eabb3b0b479e6a2bafe97d191855843626ca9a2;hp=2ce028f185c73699711ba4bbdf9979e85c1aa9c0;hb=889c084e943779e76d19f2ef5e970ff655f511eb;hpb=00a05a5c09b097e3afa8d21058a3a4d8ed410ad4

diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
index 2ce028f..4eabb3b 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
@@ -12,7 +12,7 @@ where
 import RegAlloc.Liveness
 import Instruction
 import Reg
-import Cmm	hiding (RegSet)
+import OldCmm hiding (RegSet)
 import BlockId
 
 import State
@@ -89,12 +89,12 @@ regSpill_top regSlotMap cmm
 	CmmData{}				
 	 -> return cmm
 
-	CmmProc info label params sccs
+	CmmProc info label sccs
 	 |  LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
 	 -> do	
 		-- We should only passed Cmms with the liveness maps filled in,  but we'll
 		-- create empty ones if they're not there just in case.
-		let liveVRegsOnEntry	= fromMaybe emptyBlockEnv mLiveVRegsOnEntry
+		let liveVRegsOnEntry	= fromMaybe mapEmpty mLiveVRegsOnEntry
 		
 		-- The liveVRegsOnEntry contains the set of vregs that are live on entry to
 		-- each basic block. If we spill one of those vregs we remove it from that
@@ -103,7 +103,7 @@ regSpill_top regSlotMap cmm
 		-- reload instructions after we've done a successful allocation.
 		let liveSlotsOnEntry' :: Map BlockId (Set Int)
 		    liveSlotsOnEntry'
-			= foldBlockEnv patchLiveSlot liveSlotsOnEntry liveVRegsOnEntry
+			= mapFoldWithKey patchLiveSlot liveSlotsOnEntry liveVRegsOnEntry
 
 		let info'
 			= LiveInfo static firstId
@@ -113,7 +113,7 @@ regSpill_top regSlotMap cmm
 		-- Apply the spiller to all the basic blocks in the CmmProc.
 		sccs'		<- mapM (mapSCCM (regSpill_block regSlotMap)) sccs
 
-		return	$ CmmProc info' label params sccs'
+		return	$ CmmProc info' label sccs'
 
  where	-- | Given a BlockId and the set of registers live in it, 
 	--   if registers in this block are being spilled to stack slots, 
@@ -293,10 +293,9 @@ type SpillM a	= State SpillS a
 newUnique :: SpillM Unique
 newUnique
  = do   us      <- gets stateUS
-        case splitUniqSupply us of
-         (us1, us2)
-          -> do let uniq = uniqFromSupply us1
-                modify $ \s -> s { stateUS = us2 }
+        case takeUniqFromSupply us of
+         (uniq, us')
+          -> do modify $ \s -> s { stateUS = us' }
                 return uniq
 
 accSpillSL (r1, s1, l1) (_, s2, l2)