X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FGraphColor.hs;h=c60c12dae093b5773b24c2c3657f15871e515145;hb=16dc208aaad7aadaea970e47b8055d7d7f8781e5;hp=bdd708aed708743b829acf7309c7f4b28bddcaab;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/GraphColor.hs b/compiler/nativeGen/GraphColor.hs
index bdd708a..c60c12d 100644
--- a/compiler/nativeGen/GraphColor.hs
+++ b/compiler/nativeGen/GraphColor.hs
@@ -3,13 +3,7 @@
 --	This is a generic graph coloring library, abstracted over the type of
 --	the node keys, nodes and colors.
 --
-
-{-# OPTIONS_GHC -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
--- for details
+{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module GraphColor ( 
 	module GraphBase,
@@ -41,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
@@ -69,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
 
@@ -95,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 
@@ -109,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)
@@ -152,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
@@ -177,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