X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FGraphOps.hs;h=87e77bfc83b15297de0aaaa007f71194854af07d;hb=a4cb65161fd2c34e4455985490220bdf5d30cbe5;hp=ad5e18f3c07e6f755ad0ff14fa26efed47c7815e;hpb=1116b8749571c660d446258481e4e74798bbb864;p=ghc-hetmet.git

diff --git a/compiler/utils/GraphOps.hs b/compiler/utils/GraphOps.hs
index ad5e18f..87e77bf 100644
--- a/compiler/utils/GraphOps.hs
+++ b/compiler/utils/GraphOps.hs
@@ -1,8 +1,6 @@
+{-# OPTIONS -fno-warn-missing-signatures #-}
 -- | Basic operations on graphs.
 --
---	TODO: refine coalescing crieteria
-
-{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module GraphOps (
 	addNode, 	delNode,	getNode,	lookupNode,	modNode,
@@ -10,7 +8,7 @@ module GraphOps (
 	union,
 	addConflict,	delConflict,	addConflicts,
 	addCoalesce,	delCoalesce,	
-	addExclusion,	
+	addExclusion,	addExclusions,
 	addPreference,
 	coalesceNodes,	coalesceGraph,
 	freezeNode,	freezeOneInGraph, freezeAllInGraph,
@@ -215,6 +213,14 @@ addExclusion u getClass color
 		(newNode u (getClass u))  	{ nodeExclusions = unitUniqSet color }
 		u
 
+addExclusions
+	:: (Uniquable k, Uniquable color)
+	=> k -> (k -> cls) -> [color]
+	-> Graph k cls color -> Graph k cls color
+
+addExclusions u getClass colors graph
+	= foldr (addExclusion u getClass) graph colors
+
 
 -- | Add a coalescence edge to the graph, creating nodes if requried.
 --	It is considered adventageous to assign the same color to nodes in a coalesence.
@@ -273,7 +279,9 @@ coalesceGraph
 				--	less colorable (aggressive coalescing)
 	-> Triv k cls color
 	-> Graph k cls color
-	-> (Graph k cls color, [(k, k)])
+	-> ( Graph k cls color
+	   , [(k, k)])		-- pairs of nodes that were coalesced, in the order that the
+	   			--	coalescing was applied.
 
 coalesceGraph aggressive triv graph
 	= coalesceGraph' aggressive triv graph []
@@ -301,11 +309,11 @@ coalesceGraph' aggressive triv graph kkPairsAcc
 
 	-- keep running until there are no more coalesces can be found
    in	case catMaybes mPairs of
-	 []	-> (graph', kkPairsAcc)
-	 pairs	-> coalesceGraph' aggressive triv graph' (pairs ++ kkPairsAcc)
+	 []	-> (graph', reverse kkPairsAcc)
+	 pairs	-> coalesceGraph' aggressive triv graph' (reverse pairs ++ kkPairsAcc)
 
 
--- | Coalesce this pair of nodes unconditionally / agressively.
+-- | Coalesce this pair of nodes unconditionally \/ agressively.
 --	The resulting node is the one with the least key.
 --
 --	returns: Just 	 the pair of keys if the nodes were coalesced
@@ -335,6 +343,9 @@ coalesceNodes aggressive triv graph (k1, k2)
 	, not $ elementOfUniqSet kMin (nodeConflicts nMax)
 	, not $ elementOfUniqSet kMax (nodeConflicts nMin)
 
+	-- can't coalesce the same node
+	, nodeId nMin /= nodeId nMax
+
 	= coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax
 
 	-- don't do the coalescing after all
@@ -350,9 +361,6 @@ coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax
 	| not (isNothing (nodeColor nMin) && isNothing (nodeColor nMax))
 	= error "GraphOps.coalesceNodes: can't coalesce colored nodes."
 
-	| nodeId nMin == nodeId nMax
-	= error "GraphOps.coalesceNodes: can't coalesce the same node."
-
 	---
 	| otherwise
 	= let
@@ -443,7 +451,7 @@ freezeNode k
 --	classes.. this is just a heuristic, after all.
 --
 --	IDEA:	freezing a node might free it up for Simplify.. would be good to check for triv
---		right here, and add it to a worklist if known triv/non-move nodes.
+--		right here, and add it to a worklist if known triv\/non-move nodes.
 --
 freezeOneInGraph
 	:: (Uniquable k, Outputable k)