X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FGraphColor.hs;h=c60c12dae093b5773b24c2c3657f15871e515145;hb=272f0ba89eca1d9fc700cf4c27b9f8c3e23d6fe8;hp=934f2a7dba56b5293fdfd3bd4a72a6dff42e0cf4;hpb=0f7d268d00795a58a06ae3c92ebbd14571295b84;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/GraphColor.hs b/compiler/nativeGen/GraphColor.hs
index 934f2a7..c60c12d 100644
--- a/compiler/nativeGen/GraphColor.hs
+++ b/compiler/nativeGen/GraphColor.hs
@@ -3,6 +3,8 @@
 --	This is a generic graph coloring library, abstracted over the type of
 --	the node keys, nodes and colors.
 --
+{-# OPTIONS -fno-warn-missing-signatures #-}
+
 module GraphColor ( 
 	module GraphBase,
 	module GraphOps,
@@ -33,25 +35,36 @@ import Data.List
 --	the stack (ie in reverse order) and assigning them colors different to their neighbors.
 --
 colorGraph
-	:: ( Uniquable  k, Uniquable cls,  Uniquable  color, Eq color
+	:: ( Uniquable  k, Uniquable cls,  Uniquable  color
+	   , Eq color, Eq cls, Ord k
 	   , Outputable k, Outputable cls, Outputable color)
 	=> UniqFM (UniqSet color)	-- ^ map of (node class -> set of colors available for this class).
 	-> Triv   k cls color 		-- ^ fn to decide whether a node is trivially colorable.
 	-> (Graph k cls color -> k)	-- ^ fn to choose a node to potentially leave uncolored if nothing is trivially colorable.
 	-> Graph  k cls color 		-- ^ the graph to color.
-	-> ( Graph k cls color 		-- ^ the colored graph.
-	   , UniqSet k )		-- ^ the set of nodes that we couldn't find a color for.
+
+	-> ( Graph k cls color 		-- the colored graph.
+	   , UniqSet k			-- the set of nodes that we couldn't find a color for.
+	   , UniqFM  k )		-- map of regs (r1 -> r2) that were coaleced
+	   				--	 r1 should be replaced by r2 in the source
 
 colorGraph colors triv spill graph0
- = let	-- run the scanner to slurp out all the trivially colorable nodes
-  	(ksTriv, ksProblems)	= colorScan colors triv spill [] emptyUniqSet graph0
+ = let
+ 	-- do aggressive coalesing on the graph
+ 	(graph_coalesced, rsCoalesce)
+		= coalesceGraph triv graph0
+
+ 	-- run the scanner to slurp out all the trivially colorable nodes
+  	(ksTriv, ksProblems)
+		= colorScan colors triv spill [] emptyUniqSet graph_coalesced
  
 	-- color the trivially colorable nodes
-	(graph1, ksNoTriv)	= assignColors colors graph0 ksTriv
+	(graph_triv, ksNoTriv)
+		= assignColors colors graph_coalesced ksTriv
 
  	-- try and color the problem nodes
-	(graph2, ksNoColor)	= assignColors colors graph1 (uniqSetToList ksProblems)
-	
+	(graph_prob, ksNoColor)	= assignColors colors graph_triv (uniqSetToList ksProblems)
+
 	-- if the trivially colorable nodes didn't color then something is wrong
 	--	with the provided triv function.
    in	if not $ null ksNoTriv
@@ -61,8 +74,10 @@ colorGraph colors triv spill graph0
 			$$ text "ksNoTriv  = " <> ppr ksNoTriv
 			$$ empty
 			$$ dotGraph (\x -> text "white") triv graph1) -}
-	 else	(graph2, mkUniqSet ksNoColor)
-	
+
+	 else	( graph_prob
+	 	, mkUniqSet ksNoColor
+		, listToUFM rsCoalesce)
 	
 colorScan colors triv spill safe prob graph
 
@@ -87,7 +102,6 @@ colorScan colors triv spill safe prob graph
 		safe (addOneToUniqSet prob k) (delNode k graph)
 		
 
-
 -- | Try to assign a color to all these nodes.
 
 assignColors 
@@ -101,7 +115,7 @@ assignColors
 assignColors colors graph ks 
  	= assignColors' colors graph [] ks
 
- where	assignColors' colors graph prob []
+ where	assignColors' _ graph prob []
 		= (graph, prob)
 
 	assignColors' colors graph prob (k:ks)
@@ -144,7 +158,7 @@ selectColor colors graph u
 	Just colors_avail
 			= lookupUFM colors (nodeClass node)
 
-	-- colors we can't use because they're already being used
+	-- find colors we can't use because they're already being used
 	--	by a node that conflicts with this one.
 	Just nsConflicts 	
 			= sequence
@@ -169,12 +183,12 @@ selectColor colors graph u
 
 		-- we got one of our preferences, score!
 		| not $ isEmptyUniqSet colors_ok_pref	
-		, c : rest	<- uniqSetToList colors_ok_pref
+		, c : _		<- uniqSetToList colors_ok_pref
 		= Just c
 		
 		-- it wasn't a preference, but it was still ok
 		| not $ isEmptyUniqSet colors_ok
-		, c : rest	<- uniqSetToList colors_ok
+		, c : _		<- uniqSetToList colors_ok
 		= Just c
 		
 		-- leave this node uncolored