X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocColor.hs;h=0cd3923cebfdbed6fd5af095d7a8e941fd607593;hb=a8312580d6f089d153d8af668484d4c2eb75e8a8;hp=5b19cc47df0ef16429a2b5ce55ab8728bfe624b9;hpb=92e1151179b419ce5d7a144993053ae982e0df5e;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs
index 5b19cc4..0cd3923 100644
--- a/compiler/nativeGen/RegAllocColor.hs
+++ b/compiler/nativeGen/RegAllocColor.hs
@@ -12,13 +12,7 @@
 --
 --	Colors in graphviz graphs could be nicer.
 --
-
-{-# 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 RegAllocColor ( 
 	regAlloc,
@@ -67,7 +61,7 @@ regAlloc
 		
 regAlloc dump regsFree slotsFree code
  = do
- 	(code_final, debug_codeGraphs, graph_final)
+ 	(code_final, debug_codeGraphs, _)
 		<- regAlloc_spin dump 0 trivColorable regsFree slotsFree [] code
 	
 	return	( code_final
@@ -85,11 +79,12 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
 		$$ text "slotsFree   = " <> ppr (sizeUniqSet slotsFree))
 
  	-- build a conflict graph from the code.
-	graph		<- buildGraph code
+	graph		<- {-# SCC "BuildGraph" #-} buildGraph code
 
 	-- build a map of how many instructions each reg lives for.
 	--	this is lazy, it won't be computed unless we need to spill
-	let fmLife	= plusUFMs_C (\(r1, l1) (r2, l2) -> (r1, l1 + l2))
+
+	let fmLife	= {-# SCC "LifetimeCount" #-} plusUFMs_C (\(r1, l1) (_, l2) -> (r1, l1 + l2))
 			$ map lifetimeCount code
 
 	-- record startup state
@@ -107,7 +102,7 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
 	
 	-- try and color the graph 
 	let (graph_colored, rsSpill, rmCoalesce)
-			= Color.colorGraph regsFree triv spill graph
+			= {-# SCC "ColorGraph" #-} Color.colorGraph regsFree triv spill graph
 
 	-- rewrite regs in the code that have been coalesced
 	let patchF reg	= case lookupUFM rmCoalesce reg of
@@ -153,7 +148,7 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
 	 	-- spill the uncolored regs
 		(code_spilled, slotsFree', spillStats)
 			<- regSpill code_coalesced slotsFree rsSpill
-			
+
 		-- recalculate liveness
 		let code_nat	= map stripLive code_spilled
 		code_relive	<- mapM regLiveness code_nat
@@ -270,10 +265,10 @@ graphAddCoalesce
 	-> Color.Graph Reg RegClass Reg
 	
 graphAddCoalesce (r1, r2) graph
-	| RealReg regno <- r1
+	| RealReg _ <- r1
 	= Color.addPreference (regWithClass r2) r1 graph
 	
-	| RealReg regno <- r2
+	| RealReg _ <- r2
 	= Color.addPreference (regWithClass r1) r2 graph
 	
 	| otherwise
@@ -306,7 +301,7 @@ patchRegsFromGraph graph code
 		= pprPanic "patchRegsFromGraph: register mapping failed." 
 			(  text "There is no node in the graph for register " <> ppr reg
 			$$ ppr code
-			$$ Color.dotGraph (\x -> text "white") trivColorable graph)
+			$$ Color.dotGraph (\_ -> text "white") trivColorable graph)
 	
    in	patchEraseLive patchF code