X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAlloc%2FGraph%2FSpillCost.hs;fp=compiler%2FnativeGen%2FRegAlloc%2FGraph%2FSpillCost.hs;h=152d70b966fbd5fda95906e5f6046ab19f0379dc;hb=76349636abcb764e8ed3b9ae548730ad2d85abb2;hp=97995871af92d005492783d681585a42b49fb5a6;hpb=528db2ad98caf5067ebdadf424c6c816c3927dd4;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index 9799587..152d70b 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -79,11 +79,8 @@ slurpSpillCostInfo cmm
 	--	the info table from the CmmProc
  	countBlock info (BasicBlock blockId instrs)
 		| LiveInfo _ _ (Just blockLive)	<- info
-		, Just rsLiveEntry		<- lookupBlockEnv blockLive blockId
-
-		, rsLiveEntry_virt	<- mapUniqSet (\(RegVirtual vr) -> vr) 
-					$  filterUniqSet isVirtualReg rsLiveEntry
-						
+		, Just rsLiveEntry  <- lookupBlockEnv blockLive blockId
+		, rsLiveEntry_virt  <- takeVirtuals rsLiveEntry
 		= countLIs rsLiveEntry_virt instrs
 
 		| otherwise
@@ -112,10 +109,6 @@ slurpSpillCostInfo cmm
 		mapM_ incDefs 	$ catMaybes $ map takeVirtualReg $ nub written
 
 		-- compute liveness for entry to next instruction.
-		let takeVirtuals set
-			= mapUniqSet (\(RegVirtual vr) -> vr)
-			$ filterUniqSet isVirtualReg set
-
 		let liveDieRead_virt	= takeVirtuals (liveDieRead  live)
 		let liveDieWrite_virt	= takeVirtuals (liveDieWrite live)
 		let liveBorn_virt	= takeVirtuals (liveBorn     live)
@@ -134,6 +127,13 @@ slurpSpillCostInfo cmm
 	incLifetime reg	= modify $ \s -> addToUFM_C plusSpillCostRecord s reg (reg, 0, 0, 1)
 
 
+takeVirtuals :: UniqSet Reg -> UniqSet VirtualReg
+takeVirtuals set = mapUniqSet get_virtual
+		$ filterUniqSet isVirtualReg set
+  where
+   get_virtual (RegVirtual vr) = vr 
+   get_virtual _ = panic "getVirt" 
+
 -- | Choose a node to spill from this graph
 
 chooseSpill