Merge remote-tracking branch 'origin/master' into newcg

* origin/master: (756 commits)
  don't crash if argv[0] == NULL (#7037)
  -package P was loading all versions of P in GHCi (#7030)
  Add a Note, copying text from #2437
  improve the --help docs a bit (#7008)
  Copy Data.HashTable's hashString into our Util module
  Build fix
  Build fixes
  Parse error: suggest brackets and indentation.
  Don't build the ghc DLL on Windows; works around trac #5987
  On Windows, detect if DLLs have too many symbols; trac #5987
  Add some more Integer rules; fixes #6111
  Fix PA dfun construction with silent superclass args
  Add silent superclass parameters to the vectoriser
  Add silent superclass parameters (again)
  Mention Generic1 in the user's guide
  Make the GHC API a little more powerful.
  tweak llvm version warning message
  New version of the patch for #5461.
  Fix Word64ToInteger conversion rule.
  Implemented feature request on reconfigurable pretty-printing in GHCi (#5461)
  ...

Conflicts:
	compiler/basicTypes/UniqSupply.lhs
	compiler/cmm/CmmBuildInfoTables.hs
	compiler/cmm/CmmLint.hs
	compiler/cmm/CmmOpt.hs
	compiler/cmm/CmmPipeline.hs
	compiler/cmm/CmmStackLayout.hs
	compiler/cmm/MkGraph.hs
	compiler/cmm/OldPprCmm.hs
	compiler/codeGen/CodeGen.lhs
	compiler/codeGen/StgCmm.hs
	compiler/codeGen/StgCmmBind.hs
	compiler/codeGen/StgCmmLayout.hs
	compiler/codeGen/StgCmmUtils.hs
	compiler/main/CodeOutput.lhs
	compiler/main/HscMain.hs
	compiler/nativeGen/AsmCodeGen.lhs
	compiler/simplStg/SimplStg.lhs

1 files changed, 301 insertions, 308 deletions

diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs
index 5b6b3b28a3..bae3de8f16 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs
@@ -4,20 +4,13 @@
 -- TODO: The colors in graphviz graphs for x86_64 and ppc could be nicer.
 --
 
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
-module RegAlloc.Graph.Main ( 
-	regAlloc
-) 
+module RegAlloc.Graph.Main (
+        regAlloc
+)
 
 where
 
-import qualified GraphColor	as Color
+import qualified GraphColor as Color
 import RegAlloc.Liveness
 import RegAlloc.Graph.Spill
 import RegAlloc.Graph.SpillClean
@@ -43,45 +36,45 @@ import Data.Maybe
 import Control.Monad
 
 -- | The maximum number of build\/spill cycles we'll allow.
---	We should only need 3 or 4 cycles tops.
---	If we run for any longer than this we're probably in an infinite loop,
---	It's probably better just to bail out and report a bug at this stage.
-maxSpinCount	:: Int
-maxSpinCount	= 10
+--      We should only need 3 or 4 cycles tops.
+--      If we run for any longer than this we're probably in an infinite loop,
+--      It's probably better just to bail out and report a bug at this stage.
+maxSpinCount    :: Int
+maxSpinCount    = 10
 
 
 -- | The top level of the graph coloring register allocator.
 regAlloc
-	:: (PlatformOutputable statics, PlatformOutputable instr, Instruction instr)
-	=> DynFlags
-	-> UniqFM (UniqSet RealReg)	-- ^ the registers we can use for allocation
-	-> UniqSet Int			-- ^ the set of available spill slots.
-	-> [LiveCmmDecl statics instr]	-- ^ code annotated with liveness information.
-	-> UniqSM ( [NatCmmDecl statics instr], [RegAllocStats statics instr] )
+        :: (Outputable statics, Outputable instr, Instruction instr)
+        => DynFlags
+        -> UniqFM (UniqSet RealReg)     -- ^ the registers we can use for allocation
+        -> UniqSet Int                  -- ^ the set of available spill slots.
+        -> [LiveCmmDecl statics instr]  -- ^ code annotated with liveness information.
+        -> UniqSM ( [NatCmmDecl statics instr], [RegAllocStats statics instr] )
            -- ^ code with registers allocated and stats for each stage of
            -- allocation
-		
+
 regAlloc dflags regsFree slotsFree code
  = do
-	-- TODO: the regClass function is currently hard coded to the default target
-	--	 architecture. Would prefer to determine this from dflags.
-	--	 There are other uses of targetRegClass later in this module.
-	let platform = targetPlatform dflags
-	    triv = trivColorable platform
-			(targetVirtualRegSqueeze platform)
-			(targetRealRegSqueeze platform)
-
- 	(code_final, debug_codeGraphs, _)
-		<- regAlloc_spin dflags 0 
-			triv
-			regsFree slotsFree [] code
-	
-	return	( code_final
-		, reverse debug_codeGraphs )
+        -- TODO: the regClass function is currently hard coded to the default target
+        --       architecture. Would prefer to determine this from dflags.
+        --       There are other uses of targetRegClass later in this module.
+        let platform = targetPlatform dflags
+            triv = trivColorable platform
+                        (targetVirtualRegSqueeze platform)
+                        (targetRealRegSqueeze platform)
+
+        (code_final, debug_codeGraphs, _)
+                <- regAlloc_spin dflags 0
+                        triv
+                        regsFree slotsFree [] code
+
+        return  ( code_final
+                , reverse debug_codeGraphs )
 
 regAlloc_spin :: (Instruction instr,
-                  PlatformOutputable instr,
-                  PlatformOutputable statics)
+                  Outputable instr,
+                  Outputable statics)
               => DynFlags
               -> Int
               -> Color.Triv VirtualReg RegClass RealReg
@@ -95,302 +88,302 @@ regAlloc_spin :: (Instruction instr,
 regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code
  = do
         let platform = targetPlatform dflags
- 	-- if any of these dump flags are turned on we want to hang on to
-	--	intermediate structures in the allocator - otherwise tell the
-	--	allocator to ditch them early so we don't end up creating space leaks.
-	let dump = or
-		[ dopt Opt_D_dump_asm_regalloc_stages dflags
-		, dopt Opt_D_dump_asm_stats dflags
-		, dopt Opt_D_dump_asm_conflicts dflags ]
-
-	-- check that we're not running off down the garden path.
-	when (spinCount > maxSpinCount)
-	 $ pprPanic "regAlloc_spin: max build/spill cycle count exceeded."
-	 	(  text "It looks like the register allocator is stuck in an infinite loop."
-		$$ text "max cycles  = " <> int maxSpinCount
-	 	$$ text "regsFree    = " <> (hcat	$ punctuate space $ map ppr
-						$ uniqSetToList $ unionManyUniqSets $ eltsUFM regsFree)
-		$$ text "slotsFree   = " <> ppr (sizeUniqSet slotsFree))
-
- 	-- build a conflict graph from the code.
-	(graph	:: Color.Graph VirtualReg RegClass RealReg)
-		<- {-# SCC "BuildGraph" #-} buildGraph code
-
-	-- VERY IMPORTANT:
-	--	We really do want the graph to be fully evaluated _before_ we start coloring.
-	--	If we don't do this now then when the call to Color.colorGraph forces bits of it,
-	--	the heap will be filled with half evaluated pieces of graph and zillions of apply thunks.
-	--
-	seqGraph graph `seq` return ()
-
-
-	-- build a map of the cost of spilling each instruction
-	--	this will only actually be computed if we have to spill something.
-	let spillCosts	= foldl' plusSpillCostInfo zeroSpillCostInfo
-			$ map (slurpSpillCostInfo platform) code
-
-	-- the function to choose regs to leave uncolored
-	let spill	= chooseSpill spillCosts
-
-	-- record startup state
-	let stat1	=
-		if spinCount == 0
-		 then	Just $ RegAllocStatsStart
-		 	{ raLiveCmm	= code
-			, raGraph	= graph
-			, raSpillCosts	= spillCosts }
-		 else	Nothing
-	
-	-- try and color the graph 
-	let (graph_colored, rsSpill, rmCoalesce)
-			= {-# SCC "ColorGraph" #-}
-			   Color.colorGraph
-			    	(dopt Opt_RegsIterative dflags)
-				spinCount
-			    	regsFree triv spill graph
-
-	-- rewrite regs in the code that have been coalesced
-	let patchF reg	
-		| RegVirtual vr	<- reg
-		= case lookupUFM rmCoalesce vr of
-			Just vr'	-> patchF (RegVirtual vr')
-			Nothing		-> reg
-			
-		| otherwise
-		= reg
-
-	let code_coalesced
-			= map (patchEraseLive patchF) code
-
-
-	-- see if we've found a coloring
-	if isEmptyUniqSet rsSpill
-	 then do
-		-- if -fasm-lint is turned on then validate the graph
-		let graph_colored_lint	=
-			if dopt Opt_DoAsmLinting dflags
-				then Color.validateGraph (text "")
-					True 	-- require all nodes to be colored
-					graph_colored
-				else graph_colored
-
-		-- patch the registers using the info in the graph
-	 	let code_patched	= map (patchRegsFromGraph platform graph_colored_lint) code_coalesced
-
-		-- clean out unneeded SPILL/RELOADs
-		let code_spillclean	= map (cleanSpills platform) code_patched
-
-		-- strip off liveness information, 
-		--	and rewrite SPILL/RELOAD pseudos into real instructions along the way
-		let code_final		= map (stripLive platform) code_spillclean
-
-		-- record what happened in this stage for debugging
-		let stat		=
-			RegAllocStatsColored
-			{ raCode		= code
-			, raGraph		= graph
-			, raGraphColored	= graph_colored_lint
-			, raCoalesced		= rmCoalesce
-			, raCodeCoalesced	= code_coalesced
-			, raPatched		= code_patched
-			, raSpillClean		= code_spillclean
-			, raFinal		= code_final
-			, raSRMs		= foldl' addSRM (0, 0, 0) $ map countSRMs code_spillclean }
-
-
-		let statList =
-			if dump	then [stat] ++ maybeToList stat1 ++ debug_codeGraphs
-				else []
-
-		-- space leak avoidance
-		seqList statList `seq` return ()
-
-		return	( code_final
-			, statList
-			, graph_colored_lint)
-
-	 -- we couldn't find a coloring, time to spill something
-	 else do
-		-- if -fasm-lint is turned on then validate the graph
-		let graph_colored_lint	=
-			if dopt Opt_DoAsmLinting dflags
-				then Color.validateGraph (text "")
-					False 	-- don't require nodes to be colored
-					graph_colored
-				else graph_colored
-
-	 	-- spill the uncolored regs
-		(code_spilled, slotsFree', spillStats)
-			<- regSpill code_coalesced slotsFree rsSpill
-
-		-- recalculate liveness
-		-- NOTE: we have to reverse the SCCs here to get them back into the reverse-dependency
-		--       order required by computeLiveness. If they're not in the correct order
-		--       that function will panic.
-		code_relive	<- mapM (regLiveness platform . reverseBlocksInTops) code_spilled
-
-		-- record what happened in this stage for debugging
-		let stat	=
-			RegAllocStatsSpill
-			{ raCode	= code
-			, raGraph	= graph_colored_lint
-			, raCoalesced	= rmCoalesce
-			, raSpillStats	= spillStats
-			, raSpillCosts	= spillCosts
-			, raSpilled	= code_spilled }
-			    	
-		let statList =
-			if dump
-				then [stat] ++ maybeToList stat1 ++ debug_codeGraphs
-				else []
-
-		-- space leak avoidance
-		seqList statList `seq` return ()
-
-		regAlloc_spin dflags (spinCount + 1) triv regsFree slotsFree'
-			statList
-			code_relive
+        -- if any of these dump flags are turned on we want to hang on to
+        --      intermediate structures in the allocator - otherwise tell the
+        --      allocator to ditch them early so we don't end up creating space leaks.
+        let dump = or
+                [ dopt Opt_D_dump_asm_regalloc_stages dflags
+                , dopt Opt_D_dump_asm_stats dflags
+                , dopt Opt_D_dump_asm_conflicts dflags ]
+
+        -- check that we're not running off down the garden path.
+        when (spinCount > maxSpinCount)
+         $ pprPanic "regAlloc_spin: max build/spill cycle count exceeded."
+                (  text "It looks like the register allocator is stuck in an infinite loop."
+                $$ text "max cycles  = " <> int maxSpinCount
+                $$ text "regsFree    = " <> (hcat       $ punctuate space $ map ppr
+                                                $ uniqSetToList $ unionManyUniqSets $ eltsUFM regsFree)
+                $$ text "slotsFree   = " <> ppr (sizeUniqSet slotsFree))
+
+        -- build a conflict graph from the code.
+        (graph  :: Color.Graph VirtualReg RegClass RealReg)
+                <- {-# SCC "BuildGraph" #-} buildGraph code
+
+        -- VERY IMPORTANT:
+        --      We really do want the graph to be fully evaluated _before_ we start coloring.
+        --      If we don't do this now then when the call to Color.colorGraph forces bits of it,
+        --      the heap will be filled with half evaluated pieces of graph and zillions of apply thunks.
+        --
+        seqGraph graph `seq` return ()
+
+
+        -- build a map of the cost of spilling each instruction
+        --      this will only actually be computed if we have to spill something.
+        let spillCosts  = foldl' plusSpillCostInfo zeroSpillCostInfo
+                        $ map slurpSpillCostInfo code
+
+        -- the function to choose regs to leave uncolored
+        let spill       = chooseSpill spillCosts
+
+        -- record startup state
+        let stat1       =
+                if spinCount == 0
+                 then   Just $ RegAllocStatsStart
+                        { raLiveCmm     = code
+                        , raGraph       = graph
+                        , raSpillCosts  = spillCosts }
+                 else   Nothing
+
+        -- try and color the graph
+        let (graph_colored, rsSpill, rmCoalesce)
+                        = {-# SCC "ColorGraph" #-}
+                           Color.colorGraph
+                                (dopt Opt_RegsIterative dflags)
+                                spinCount
+                                regsFree triv spill graph
+
+        -- rewrite regs in the code that have been coalesced
+        let patchF reg
+                | RegVirtual vr <- reg
+                = case lookupUFM rmCoalesce vr of
+                        Just vr'        -> patchF (RegVirtual vr')
+                        Nothing         -> reg
+
+                | otherwise
+                = reg
+
+        let code_coalesced
+                        = map (patchEraseLive patchF) code
+
+
+        -- see if we've found a coloring
+        if isEmptyUniqSet rsSpill
+         then do
+                -- if -fasm-lint is turned on then validate the graph
+                let graph_colored_lint  =
+                        if dopt Opt_DoAsmLinting dflags
+                                then Color.validateGraph (text "")
+                                        True    -- require all nodes to be colored
+                                        graph_colored
+                                else graph_colored
+
+                -- patch the registers using the info in the graph
+                let code_patched        = map (patchRegsFromGraph platform graph_colored_lint) code_coalesced
+
+                -- clean out unneeded SPILL/RELOADs
+                let code_spillclean     = map (cleanSpills platform) code_patched
+
+                -- strip off liveness information,
+                --      and rewrite SPILL/RELOAD pseudos into real instructions along the way
+                let code_final          = map (stripLive platform) code_spillclean
+
+                -- record what happened in this stage for debugging
+                let stat                =
+                        RegAllocStatsColored
+                        { raCode                = code
+                        , raGraph               = graph
+                        , raGraphColored        = graph_colored_lint
+                        , raCoalesced           = rmCoalesce
+                        , raCodeCoalesced       = code_coalesced
+                        , raPatched             = code_patched
+                        , raSpillClean          = code_spillclean
+                        , raFinal               = code_final
+                        , raSRMs                = foldl' addSRM (0, 0, 0) $ map countSRMs code_spillclean }
+
+
+                let statList =
+                        if dump then [stat] ++ maybeToList stat1 ++ debug_codeGraphs
+                                else []
+
+                -- space leak avoidance
+                seqList statList `seq` return ()
+
+                return  ( code_final
+                        , statList
+                        , graph_colored_lint)
+
+         -- we couldn't find a coloring, time to spill something
+         else do
+                -- if -fasm-lint is turned on then validate the graph
+                let graph_colored_lint  =
+                        if dopt Opt_DoAsmLinting dflags
+                                then Color.validateGraph (text "")
+                                        False   -- don't require nodes to be colored
+                                        graph_colored
+                                else graph_colored
+
+                -- spill the uncolored regs
+                (code_spilled, slotsFree', spillStats)
+                        <- regSpill code_coalesced slotsFree rsSpill
+
+                -- recalculate liveness
+                -- NOTE: we have to reverse the SCCs here to get them back into the reverse-dependency
+                --       order required by computeLiveness. If they're not in the correct order
+                --       that function will panic.
+                code_relive     <- mapM (regLiveness . reverseBlocksInTops) code_spilled
+
+                -- record what happened in this stage for debugging
+                let stat        =
+                        RegAllocStatsSpill
+                        { raCode        = code
+                        , raGraph       = graph_colored_lint
+                        , raCoalesced   = rmCoalesce
+                        , raSpillStats  = spillStats
+                        , raSpillCosts  = spillCosts
+                        , raSpilled     = code_spilled }
+
+                let statList =
+                        if dump
+                                then [stat] ++ maybeToList stat1 ++ debug_codeGraphs
+                                else []
+
+                -- space leak avoidance
+                seqList statList `seq` return ()
+
+                regAlloc_spin dflags (spinCount + 1) triv regsFree slotsFree'
+                        statList
+                        code_relive
 
 
 -- | Build a graph from the liveness and coalesce information in this code.
-buildGraph 
-	:: Instruction instr
-	=> [LiveCmmDecl statics instr]
-	-> UniqSM (Color.Graph VirtualReg RegClass RealReg)
-	
+buildGraph
+        :: Instruction instr
+        => [LiveCmmDecl statics instr]
+        -> UniqSM (Color.Graph VirtualReg RegClass RealReg)
+
 buildGraph code
  = do
-	-- Slurp out the conflicts and reg->reg moves from this code
-	let (conflictList, moveList) =
-		unzip $ map slurpConflicts code
+        -- Slurp out the conflicts and reg->reg moves from this code
+        let (conflictList, moveList) =
+                unzip $ map slurpConflicts code
+
+        -- Slurp out the spill/reload coalesces
+        let moveList2           = map slurpReloadCoalesce code
 
-	-- Slurp out the spill/reload coalesces
-	let moveList2		= map slurpReloadCoalesce code
+        -- Add the reg-reg conflicts to the graph
+        let conflictBag         = unionManyBags conflictList
+        let graph_conflict      = foldrBag graphAddConflictSet Color.initGraph conflictBag
 
- 	-- Add the reg-reg conflicts to the graph
-	let conflictBag		= unionManyBags conflictList
-	let graph_conflict	= foldrBag graphAddConflictSet Color.initGraph conflictBag
+        -- Add the coalescences edges to the graph.
+        let moveBag             = unionBags (unionManyBags moveList2) (unionManyBags moveList)
+        let graph_coalesce      = foldrBag graphAddCoalesce graph_conflict moveBag
 
-	-- Add the coalescences edges to the graph.
-	let moveBag		= unionBags (unionManyBags moveList2) (unionManyBags moveList)
-	let graph_coalesce	= foldrBag graphAddCoalesce graph_conflict moveBag
-			
-	return	graph_coalesce
+        return  graph_coalesce
 
 
 -- | Add some conflict edges to the graph.
---	Conflicts between virtual and real regs are recorded as exclusions.
-graphAddConflictSet 
-	:: UniqSet Reg
-	-> Color.Graph VirtualReg RegClass RealReg
-	-> Color.Graph VirtualReg RegClass RealReg
-	
+--      Conflicts between virtual and real regs are recorded as exclusions.
+graphAddConflictSet
+        :: UniqSet Reg
+        -> Color.Graph VirtualReg RegClass RealReg
+        -> Color.Graph VirtualReg RegClass RealReg
+
 graphAddConflictSet set graph
- = let	virtuals	= mkUniqSet 
- 			[ vr | RegVirtual vr <- uniqSetToList set ]
- 
-	graph1	= Color.addConflicts virtuals classOfVirtualReg graph
+ = let  virtuals        = mkUniqSet
+                        [ vr | RegVirtual vr <- uniqSetToList set ]
+
+        graph1  = Color.addConflicts virtuals classOfVirtualReg graph
+
+        graph2  = foldr (\(r1, r2) -> Color.addExclusion r1 classOfVirtualReg r2)
+                        graph1
+                        [ (vr, rr)
+                                | RegVirtual vr <- uniqSetToList set
+                                , RegReal    rr <- uniqSetToList set]
 
-	graph2	= foldr (\(r1, r2) -> Color.addExclusion r1 classOfVirtualReg r2)
-			graph1
-			[ (vr, rr) 
-				| RegVirtual vr <- uniqSetToList set
-				, RegReal    rr <- uniqSetToList set]
+   in   graph2
 
-   in	graph2
-	
 
 -- | Add some coalesence edges to the graph
---	Coalesences between virtual and real regs are recorded as preferences.
-graphAddCoalesce 
-	:: (Reg, Reg) 
-	-> Color.Graph VirtualReg RegClass RealReg
-	-> Color.Graph VirtualReg RegClass RealReg
-	
+--      Coalesences between virtual and real regs are recorded as preferences.
+graphAddCoalesce
+        :: (Reg, Reg)
+        -> Color.Graph VirtualReg RegClass RealReg
+        -> Color.Graph VirtualReg RegClass RealReg
+
 graphAddCoalesce (r1, r2) graph
-	| RegReal rr 		<- r1
-	, RegVirtual vr 	<- r2
-	= Color.addPreference (vr, classOfVirtualReg vr) rr graph
-	
-	| RegReal rr 		<- r2
-	, RegVirtual vr		<- r1
-	= Color.addPreference (vr, classOfVirtualReg vr) rr graph
-	
-	| RegVirtual vr1	<- r1
-	, RegVirtual vr2	<- r2
-	= Color.addCoalesce 
-		(vr1, classOfVirtualReg vr1) 
-		(vr2, classOfVirtualReg vr2) 
-		graph
-
-	-- We can't coalesce two real regs, but there could well be existing
-	--	hreg,hreg moves in the input code. We'll just ignore these
-	--	for coalescing purposes.
-	| RegReal _		<- r1
-	, RegReal _	 	<- r2
-	= graph
+        | RegReal rr            <- r1
+        , RegVirtual vr         <- r2
+        = Color.addPreference (vr, classOfVirtualReg vr) rr graph
+
+        | RegReal rr            <- r2
+        , RegVirtual vr         <- r1
+        = Color.addPreference (vr, classOfVirtualReg vr) rr graph
+
+        | RegVirtual vr1        <- r1
+        , RegVirtual vr2        <- r2
+        = Color.addCoalesce
+                (vr1, classOfVirtualReg vr1)
+                (vr2, classOfVirtualReg vr2)
+                graph
+
+        -- We can't coalesce two real regs, but there could well be existing
+        --      hreg,hreg moves in the input code. We'll just ignore these
+        --      for coalescing purposes.
+        | RegReal _             <- r1
+        , RegReal _             <- r2
+        = graph
 
 graphAddCoalesce _ _
-	= panic "graphAddCoalesce: bogus"
-	
+        = panic "graphAddCoalesce: bogus"
+
 
 -- | Patch registers in code using the reg -> reg mapping in this graph.
-patchRegsFromGraph 
-	:: (PlatformOutputable statics, PlatformOutputable instr, Instruction instr)
-	=> Platform -> Color.Graph VirtualReg RegClass RealReg
-	-> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
+patchRegsFromGraph
+        :: (Outputable statics, Outputable instr, Instruction instr)
+        => Platform -> Color.Graph VirtualReg RegClass RealReg
+        -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
 
 patchRegsFromGraph platform graph code
  = let
- 	-- a function to lookup the hardreg for a virtual reg from the graph.
- 	patchF reg
-		-- leave real regs alone.
-		| RegReal{}	<- reg
-		= reg
-
-		-- this virtual has a regular node in the graph.
- 		| RegVirtual vr	<- reg
-		, Just node	<- Color.lookupNode graph vr
-		= case Color.nodeColor node of
-			Just color	-> RegReal    color
-			Nothing		-> RegVirtual vr
-			
-		-- no node in the graph for this virtual, bad news.
-		| otherwise
-		= pprPanic "patchRegsFromGraph: register mapping failed." 
-			(  text "There is no node in the graph for register " <> ppr reg
-			$$ pprPlatform platform code
-			$$ Color.dotGraph 
-				(\_ -> text "white") 
-				(trivColorable platform
-					(targetVirtualRegSqueeze platform)
-					(targetRealRegSqueeze platform))
-				graph)
-
-   in	patchEraseLive patchF code
-   
+        -- a function to lookup the hardreg for a virtual reg from the graph.
+        patchF reg
+                -- leave real regs alone.
+                | RegReal{}     <- reg
+                = reg
+
+                -- this virtual has a regular node in the graph.
+                | RegVirtual vr <- reg
+                , Just node     <- Color.lookupNode graph vr
+                = case Color.nodeColor node of
+                        Just color      -> RegReal    color
+                        Nothing         -> RegVirtual vr
+
+                -- no node in the graph for this virtual, bad news.
+                | otherwise
+                = pprPanic "patchRegsFromGraph: register mapping failed."
+                        (  text "There is no node in the graph for register " <> ppr reg
+                        $$ ppr code
+                        $$ Color.dotGraph
+                                (\_ -> text "white")
+                                (trivColorable platform
+                                        (targetVirtualRegSqueeze platform)
+                                        (targetRealRegSqueeze platform))
+                                graph)
+
+   in   patchEraseLive patchF code
+
 
 -----
 -- for when laziness just isn't what you wanted...
 --
 seqGraph :: Color.Graph VirtualReg RegClass RealReg -> ()
-seqGraph graph		= seqNodes (eltsUFM (Color.graphMap graph))
+seqGraph graph          = seqNodes (eltsUFM (Color.graphMap graph))
 
 seqNodes :: [Color.Node VirtualReg RegClass RealReg] -> ()
 seqNodes ns
  = case ns of
- 	[]		-> ()
-	(n : ns)	-> seqNode n `seq` seqNodes ns
+        []              -> ()
+        (n : ns)        -> seqNode n `seq` seqNodes ns
 
 seqNode :: Color.Node VirtualReg RegClass RealReg -> ()
 seqNode node
-	=     seqVirtualReg	(Color.nodeId node)
-	`seq` seqRegClass 	(Color.nodeClass node)
-	`seq` seqMaybeRealReg 	(Color.nodeColor node)
-	`seq` (seqVirtualRegList (uniqSetToList (Color.nodeConflicts node)))
-	`seq` (seqRealRegList 	 (uniqSetToList (Color.nodeExclusions node)))
-	`seq` (seqRealRegList (Color.nodePreference node))
-	`seq` (seqVirtualRegList (uniqSetToList (Color.nodeCoalesce node)))
+        =     seqVirtualReg     (Color.nodeId node)
+        `seq` seqRegClass       (Color.nodeClass node)
+        `seq` seqMaybeRealReg   (Color.nodeColor node)
+        `seq` (seqVirtualRegList (uniqSetToList (Color.nodeConflicts node)))
+        `seq` (seqRealRegList    (uniqSetToList (Color.nodeExclusions node)))
+        `seq` (seqRealRegList (Color.nodePreference node))
+        `seq` (seqVirtualRegList (uniqSetToList (Color.nodeCoalesce node)))
 
 seqVirtualReg :: VirtualReg -> ()
 seqVirtualReg reg = reg `seq` ()
@@ -404,25 +397,25 @@ seqRegClass c = c `seq` ()
 seqMaybeRealReg :: Maybe RealReg -> ()
 seqMaybeRealReg mr
  = case mr of
- 	Nothing		-> ()
-	Just r		-> seqRealReg r
+        Nothing         -> ()
+        Just r          -> seqRealReg r
 
 seqVirtualRegList :: [VirtualReg] -> ()
 seqVirtualRegList rs
  = case rs of
- 	[]		-> ()
-	(r : rs)	-> seqVirtualReg r `seq` seqVirtualRegList rs
+        []              -> ()
+        (r : rs)        -> seqVirtualReg r `seq` seqVirtualRegList rs
 
 seqRealRegList :: [RealReg] -> ()
 seqRealRegList rs
  = case rs of
- 	[]		-> ()
-	(r : rs)	-> seqRealReg r `seq` seqRealRegList rs
+        []              -> ()
+        (r : rs)        -> seqRealReg r `seq` seqRealRegList rs
 
 seqList :: [a] -> ()
 seqList ls
  = case ls of
- 	[]		-> ()
-	(r : rs)	-> r `seq` seqList rs
+        []              -> ()
+        (r : rs)        -> r `seq` seqList rs