X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FGraphOps.hs;h=92058e93f8f37c14ba63011a7fa701ca3a76bc1b;hp=86bf6bd78901ea45366ea745069497d48084b657;hb=44da8b0ac437e0cd6d85a63a389ca15735f153c0;hpb=0f7d268d00795a58a06ae3c92ebbd14571295b84

diff --git a/compiler/nativeGen/GraphOps.hs b/compiler/nativeGen/GraphOps.hs
index 86bf6bd..92058e93 100644
--- a/compiler/nativeGen/GraphOps.hs
+++ b/compiler/nativeGen/GraphOps.hs
@@ -10,7 +10,8 @@ module GraphOps (
 	addExclusion,	
 	addPreference,
 	setColor,
-	verify
+	verify,
+	slurpNodeConflictCount
 )
 where
 
@@ -275,6 +276,24 @@ verify graph
 	 else	False
 
 
+-- | Slurp out a map of how many nodes had a certain number of conflict neighbours
+
+slurpNodeConflictCount
+	:: Uniquable k
+	=> Graph k cls color
+	-> UniqFM (Int, Int)	-- ^ (conflict neighbours, num nodes with that many conflicts)
+
+slurpNodeConflictCount graph
+	= addListToUFM_C
+		(\(c1, n1) (c2, n2) -> (c1, n1 + n2))
+		emptyUFM
+	$ map 	(\node
+	 	  -> let count	= sizeUniqSet $ nodeConflicts node
+		     in  (count, (count, 1)))
+	$ eltsUFM
+	$ graphMap graph
+
+
 -- | Set the color of a certain node
 setColor 
 	:: Uniquable k