X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAlloc%2FGraph%2FCoalesce.hs;h=1eaf00f3a2a2f16ee865473ee1d4ab045e0b0045;hb=f537dd87c4a07526e2b1fc1bd1c125d652833641;hp=6cea26a2bd547acb0baf313c80aaf315c450f25d;hpb=a12e845684c10955bc594cdb20d1f13fae14873d;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
index 6cea26a..1eaf00f 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
@@ -8,25 +8,28 @@ module RegAlloc.Graph.Coalesce (
 
 where
 
-import Cmm
-import Regs
-import RegLiveness
-import RegAllocInfo
+import RegAlloc.Liveness
+import Instruction
+import Reg
 
+import OldCmm
 import Bag
+import Digraph
 import UniqFM
 import UniqSet
 import UniqSupply
 
-import Control.Monad
 import Data.List
 
 -- | Do register coalescing on this top level thing
 --	For Reg -> Reg moves, if the first reg dies at the same time the second reg is born
 --	then the mov only serves to join live ranges. The two regs can be renamed to be 
 --	the same and the move instruction safely erased.
+regCoalesce 
+	:: Instruction instr
+	=> [LiveCmmTop instr] 
+	-> UniqSM [LiveCmmTop instr]
 
-regCoalesce :: [LiveCmmTop] -> UniqSM [LiveCmmTop]
 regCoalesce code
  = do	
  	let joins	= foldl' unionBags emptyBag
@@ -56,19 +59,21 @@ sinkReg fm r
 -- | Slurp out mov instructions that only serve to join live ranges.
 --	During a mov, if the source reg dies and the destiation reg is born
 --	then we can rename the two regs to the same thing and eliminate the move.
---
-slurpJoinMovs :: LiveCmmTop -> Bag (Reg, Reg)
+slurpJoinMovs 
+	:: Instruction instr
+	=> LiveCmmTop instr 
+	-> Bag (Reg, Reg)
+
 slurpJoinMovs live
 	= slurpCmm emptyBag live
  where	
-  	slurpCmm   rs  CmmData{}		         = rs
-	slurpCmm   rs (CmmProc _ _ _ (ListGraph blocks)) = foldl' slurpComp  rs blocks
-   	slurpComp  rs (BasicBlock _ blocks)	         = foldl' slurpBlock rs blocks
-        slurpBlock rs (BasicBlock _ instrs)              = foldl' slurpLI    rs instrs
+  	slurpCmm   rs  CmmData{}		    = rs
+	slurpCmm   rs (CmmProc _ _ sccs) 	= foldl' slurpBlock rs (flattenSCCs sccs)
+	slurpBlock rs (BasicBlock _ instrs)	= foldl' slurpLI    rs instrs
                 
-        slurpLI    rs (Instr _	Nothing)	         = rs
-	slurpLI    rs (Instr instr (Just live))
-	 	| Just (r1, r2)	<- isRegRegMove instr
+	slurpLI    rs (LiveInstr _	Nothing)    = rs
+	slurpLI    rs (LiveInstr instr (Just live))
+	 	| Just (r1, r2)	<- takeRegRegMoveInstr instr
 		, elementOfUniqSet r1 $ liveDieRead live
 		, elementOfUniqSet r2 $ liveBorn live
 
@@ -79,5 +84,5 @@ slurpJoinMovs live
 		
 		| otherwise
 		= rs
-	
+