X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAlloc%2FLiveness.hs;h=0efc6f55f300bf9e36b454097fb1204f0d512760;hp=d7659b5c86a9f110f657f893ab24230dff6f4d22;hb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516;hpb=0084ab49ab3c0123c4b7f9523d092af45bccfd41

diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index d7659b5..0efc6f5 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -356,21 +356,30 @@ slurpConflicts live
 --
 --
 slurpReloadCoalesce 
-	:: Instruction instr
+	:: forall instr. Instruction instr
 	=> LiveCmmTop instr
 	-> Bag (Reg, Reg)
 
 slurpReloadCoalesce live
 	= slurpCmm emptyBag live
 
- where	slurpCmm cs CmmData{}	= cs
+ where	
+        slurpCmm :: Bag (Reg, Reg)
+                 -> GenCmmTop t t1 [SCC (LiveBasicBlock instr)]
+                 -> Bag (Reg, Reg)
+        slurpCmm cs CmmData{}	= cs
  	slurpCmm cs (CmmProc _ _ _ sccs)
 		= slurpComp cs (flattenSCCs sccs)
 
+        slurpComp :: Bag (Reg, Reg)
+                     -> [LiveBasicBlock instr]
+                     -> Bag (Reg, Reg)
 	slurpComp  cs blocks
 	 = let	(moveBags, _)	= runState (slurpCompM blocks) emptyUFM
 	   in	unionManyBags (cs : moveBags)
 
+        slurpCompM :: [LiveBasicBlock instr]
+                   -> State (UniqFM [UniqFM Reg]) [Bag (Reg, Reg)]
 	slurpCompM blocks
 	 = do	-- run the analysis once to record the mapping across jumps.
 	 	mapM_	(slurpBlock False) blocks
@@ -381,6 +390,8 @@ slurpReloadCoalesce live
 		--	not worth the trouble.
 		mapM	(slurpBlock True) blocks
 
+        slurpBlock :: Bool -> LiveBasicBlock instr
+                   -> State (UniqFM [UniqFM Reg]) (Bag (Reg, Reg))
 	slurpBlock propagate (BasicBlock blockId instrs)
 	 = do	-- grab the slot map for entry to this block
 	 	slotMap		<- if propagate
@@ -390,8 +401,7 @@ slurpReloadCoalesce live
 	 	(_, mMoves)	<- mapAccumLM slurpLI slotMap instrs
 	   	return $ listToBag $ catMaybes mMoves
 
-	slurpLI :: Instruction instr
-		=> UniqFM Reg 				-- current slotMap
+	slurpLI :: UniqFM Reg 				-- current slotMap
 		-> LiveInstr instr
 		-> State (UniqFM [UniqFM Reg]) 		-- blockId -> [slot -> reg]
 							-- 	for tracking slotMaps across jumps