More work towards cross-compilation

There's now a variant of the Outputable class that knows what
platform we're targetting:

class PlatformOutputable a where
    pprPlatform :: Platform -> a -> SDoc
    pprPlatformPrec :: Platform -> Rational -> a -> SDoc

and various instances have had to be converted to use that class,
and we pass Platform around accordingly.

5 files changed, 121 insertions, 108 deletions

diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs
index 298b5673d4..9e8c25e68d 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs
@@ -28,6 +28,7 @@ import UniqSet
 import UniqFM
 import Bag
 import Outputable
+import Platform
 import DynFlags
 
 import Data.List
@@ -44,7 +45,7 @@ maxSpinCount	= 10
 
 -- | The top level of the graph coloring register allocator.
 regAlloc
-	:: (Outputable statics, Outputable instr, Instruction instr)
+	:: (Outputable statics, PlatformOutputable instr, Instruction instr)
 	=> DynFlags
 	-> UniqFM (UniqSet RealReg)	-- ^ the registers we can use for allocation
 	-> UniqSet Int			-- ^ the set of available spill slots.
@@ -79,6 +80,7 @@ regAlloc_spin
 	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.
@@ -111,7 +113,7 @@ regAlloc_spin
 	-- 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
+			$ map (slurpSpillCostInfo platform) code
 
 	-- the function to choose regs to leave uncolored
 	let spill	= chooseSpill spillCosts
@@ -159,14 +161,14 @@ regAlloc_spin
 				else graph_colored
 
 		-- patch the registers using the info in the graph
-	 	let code_patched	= map (patchRegsFromGraph graph_colored_lint) code_coalesced
+	 	let code_patched	= map (patchRegsFromGraph platform graph_colored_lint) code_coalesced
 
 		-- clean out unneeded SPILL/RELOADs
 		let code_spillclean	= map cleanSpills code_patched
 
 		-- strip off liveness information, 
 		--	and rewrite SPILL/RELOAD pseudos into real instructions along the way
-		let code_final		= map stripLive code_spillclean
+		let code_final		= map (stripLive platform) code_spillclean
 
 		-- record what happened in this stage for debugging
 		let stat		=
@@ -211,7 +213,7 @@ regAlloc_spin
 		-- 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
+		code_relive	<- mapM (regLiveness platform . reverseBlocksInTops) code_spilled
 
 		-- record what happened in this stage for debugging
 		let stat	=
@@ -320,11 +322,11 @@ graphAddCoalesce _ _
 
 -- | Patch registers in code using the reg -> reg mapping in this graph.
 patchRegsFromGraph 
-	:: (Outputable statics, Outputable instr, Instruction instr)
-	=> Color.Graph VirtualReg RegClass RealReg
+	:: (Outputable statics, PlatformOutputable instr, Instruction instr)
+	=> Platform -> Color.Graph VirtualReg RegClass RealReg
 	-> LiveCmmTop statics instr -> LiveCmmTop statics instr
 
-patchRegsFromGraph graph code
+patchRegsFromGraph platform graph code
  = let
  	-- a function to lookup the hardreg for a virtual reg from the graph.
  	patchF reg
@@ -343,7 +345,7 @@ patchRegsFromGraph graph code
 		| otherwise
 		= pprPanic "patchRegsFromGraph: register mapping failed." 
 			(  text "There is no node in the graph for register " <> ppr reg
-			$$ ppr code
+			$$ pprPlatform platform code
 			$$ Color.dotGraph 
 				(\_ -> text "white") 
 				(trivColorable 
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index 8a16b25187..3ea150a3df 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -29,6 +29,7 @@ import UniqFM
 import UniqSet
 import Digraph		(flattenSCCs)
 import Outputable
+import Platform
 import State
 
 import Data.List	(nub, minimumBy)
@@ -62,12 +63,12 @@ plusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2)
 --	for each vreg, the number of times it was written to, read from,
 --	and the number of instructions it was live on entry to (lifetime)
 --
-slurpSpillCostInfo
-	:: (Outputable instr, Instruction instr)
-	=> LiveCmmTop statics instr
-	-> SpillCostInfo
+slurpSpillCostInfo :: (PlatformOutputable instr, Instruction instr)
+                   => Platform
+                   -> LiveCmmTop statics instr
+                   -> SpillCostInfo
 
-slurpSpillCostInfo cmm
+slurpSpillCostInfo platform cmm
 	= execState (countCmm cmm) zeroSpillCostInfo
  where
 	countCmm CmmData{}		= return ()
@@ -96,7 +97,7 @@ slurpSpillCostInfo cmm
 
 		| otherwise
 		= pprPanic "RegSpillCost.slurpSpillCostInfo"
-			(text "no liveness information on instruction " <> ppr instr)
+			(text "no liveness information on instruction " <> pprPlatform platform instr)
 
 	countLIs rsLiveEntry (LiveInstr instr (Just live) : lis)
 	 = do
diff --git a/compiler/nativeGen/RegAlloc/Graph/Stats.hs b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
index f24e876cb2..c4a3c9087d 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
@@ -65,12 +65,12 @@ data RegAllocStats statics instr
 	, raFinal	  :: [NatCmmTop statics instr] 			-- ^ final code
 	, raSRMs	  :: (Int, Int, Int) }				-- ^ spill\/reload\/reg-reg moves present in this code
 
-instance (Outputable statics, Outputable instr) => Outputable (RegAllocStats statics instr) where
+instance (Outputable statics, PlatformOutputable instr) => PlatformOutputable (RegAllocStats statics instr) where
 
- ppr (s@RegAllocStatsStart{})
+ pprPlatform platform (s@RegAllocStatsStart{})
  	=  text "#  Start"
 	$$ text "#  Native code with liveness information."
-	$$ ppr (raLiveCmm s)
+	$$ pprPlatform platform (raLiveCmm s)
 	$$ text ""
 	$$ text "#  Initial register conflict graph."
 	$$ Color.dotGraph 
@@ -81,11 +81,11 @@ instance (Outputable statics, Outputable instr) => Outputable (RegAllocStats sta
 		(raGraph s)
 
 
- ppr (s@RegAllocStatsSpill{})
+ pprPlatform platform (s@RegAllocStatsSpill{})
  	=  text "#  Spill"
 
 	$$ text "#  Code with liveness information."
-	$$ (ppr (raCode s))
+	$$ pprPlatform platform (raCode s)
 	$$ text ""
 
 	$$ (if (not $ isNullUFM $ raCoalesced s)
@@ -99,14 +99,14 @@ instance (Outputable statics, Outputable instr) => Outputable (RegAllocStats sta
 	$$ text ""
 
 	$$ text "#  Code with spills inserted."
-	$$ (ppr (raSpilled s))
+	$$ pprPlatform platform (raSpilled s)
 
 
- ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
+ pprPlatform platform (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
  	=  text "#  Colored"
 
 	$$ text "#  Code with liveness information."
-	$$ (ppr (raCode s))
+	$$ pprPlatform platform (raCode s)
 	$$ text ""
 
 	$$ text "#  Register conflict graph (colored)."
@@ -125,19 +125,19 @@ instance (Outputable statics, Outputable instr) => Outputable (RegAllocStats sta
 		else empty)
 
 	$$ text "#  Native code after coalescings applied."
-	$$ ppr (raCodeCoalesced s)
+	$$ pprPlatform platform (raCodeCoalesced s)
 	$$ text ""
 
 	$$ text "#  Native code after register allocation."
-	$$ ppr (raPatched s)
+	$$ pprPlatform platform (raPatched s)
 	$$ text ""
 
 	$$ text "#  Clean out unneeded spill/reloads."
-	$$ ppr (raSpillClean s)
+	$$ pprPlatform platform (raSpillClean s)
 	$$ text ""
 
 	$$ text "#  Final code, after rewriting spill/rewrite pseudo instrs."
-	$$ ppr (raFinal s)
+	$$ pprPlatform platform (raFinal s)
 	$$ text ""
 	$$  text "#  Score:"
 	$$ (text "#          spills  inserted: " <> int spills)
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 4e54b4744d..f72f644930 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -127,7 +127,7 @@ import Control.Monad
 
 -- Allocate registers
 regAlloc
-        :: (Outputable instr, Instruction instr)
+        :: (PlatformOutputable instr, Instruction instr)
         => DynFlags
         -> LiveCmmTop statics instr
         -> UniqSM (NatCmmTop statics instr, Maybe RegAllocStats)
@@ -170,7 +170,7 @@ regAlloc _ (CmmProc _ _ _)
 --   an entry in the block map or it is the first block.
 --
 linearRegAlloc
-        :: (Outputable instr, Instruction instr)
+        :: (PlatformOutputable instr, Instruction instr)
         => DynFlags
         -> BlockId                      -- ^ the first block
         -> BlockMap RegSet              -- ^ live regs on entry to each basic block
@@ -178,51 +178,54 @@ linearRegAlloc
         -> UniqSM ([NatBasicBlock instr], RegAllocStats)
 
 linearRegAlloc dflags first_id block_live sccs
- = case platformArch $ targetPlatform dflags of
-   ArchX86     -> linearRegAlloc' (frInitFreeRegs :: X86.FreeRegs)   first_id block_live sccs
-   ArchX86_64  -> linearRegAlloc' (frInitFreeRegs :: X86.FreeRegs)   first_id block_live sccs
-   ArchSPARC   -> linearRegAlloc' (frInitFreeRegs :: SPARC.FreeRegs) first_id block_live sccs
-   ArchPPC     -> linearRegAlloc' (frInitFreeRegs :: PPC.FreeRegs)   first_id block_live sccs
-   ArchARM     -> panic "linearRegAlloc ArchARM"
-   ArchPPC_64  -> panic "linearRegAlloc ArchPPC_64"
-   ArchUnknown -> panic "linearRegAlloc ArchUnknown"
+ = let platform = targetPlatform dflags
+   in case platformArch platform of
+      ArchX86     -> linearRegAlloc' platform (frInitFreeRegs :: X86.FreeRegs)   first_id block_live sccs
+      ArchX86_64  -> linearRegAlloc' platform (frInitFreeRegs :: X86.FreeRegs)   first_id block_live sccs
+      ArchSPARC   -> linearRegAlloc' platform (frInitFreeRegs :: SPARC.FreeRegs) first_id block_live sccs
+      ArchPPC     -> linearRegAlloc' platform (frInitFreeRegs :: PPC.FreeRegs)   first_id block_live sccs
+      ArchARM     -> panic "linearRegAlloc ArchARM"
+      ArchPPC_64  -> panic "linearRegAlloc ArchPPC_64"
+      ArchUnknown -> panic "linearRegAlloc ArchUnknown"
 
 linearRegAlloc'
-        :: (FR freeRegs, Outputable instr, Instruction instr)
-        => freeRegs
+        :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
+        => Platform
+        -> freeRegs
         -> BlockId                      -- ^ the first block
         -> BlockMap RegSet              -- ^ live regs on entry to each basic block
         -> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths"
         -> UniqSM ([NatBasicBlock instr], RegAllocStats)
 
-linearRegAlloc' initFreeRegs first_id block_live sccs
+linearRegAlloc' platform initFreeRegs first_id block_live sccs
  = do   us      <- getUs
         let (_, _, stats, blocks) =
                 runR emptyBlockMap initFreeRegs emptyRegMap emptyStackMap us
-                    $ linearRA_SCCs first_id block_live [] sccs
+                    $ linearRA_SCCs platform first_id block_live [] sccs
         return  (blocks, stats)
 
 
-linearRA_SCCs :: (FR freeRegs, Instruction instr, Outputable instr)
-              => BlockId
+linearRA_SCCs :: (FR freeRegs, Instruction instr, PlatformOutputable instr)
+              => Platform
+              -> BlockId
               -> BlockMap RegSet
               -> [NatBasicBlock instr]
               -> [SCC (LiveBasicBlock instr)]
               -> RegM freeRegs [NatBasicBlock instr]
 
-linearRA_SCCs _ _ blocksAcc []
+linearRA_SCCs _ _ _ blocksAcc []
         = return $ reverse blocksAcc
 
-linearRA_SCCs first_id block_live blocksAcc (AcyclicSCC block : sccs)
- = do   blocks' <- processBlock block_live block
-        linearRA_SCCs first_id block_live
+linearRA_SCCs platform first_id block_live blocksAcc (AcyclicSCC block : sccs)
+ = do   blocks' <- processBlock platform block_live block
+        linearRA_SCCs platform first_id block_live
                 ((reverse blocks') ++ blocksAcc)
                 sccs
 
-linearRA_SCCs first_id block_live blocksAcc (CyclicSCC blocks : sccs)
+linearRA_SCCs platform first_id block_live blocksAcc (CyclicSCC blocks : sccs)
  = do
-        blockss' <- process first_id block_live blocks [] (return []) False
-        linearRA_SCCs first_id block_live
+        blockss' <- process platform first_id block_live blocks [] (return []) False
+        linearRA_SCCs platform first_id block_live
                 (reverse (concat blockss') ++ blocksAcc)
                 sccs
 
@@ -238,8 +241,9 @@ linearRA_SCCs first_id block_live blocksAcc (CyclicSCC blocks : sccs)
    more sanity checking to guard against this eventuality.
 -}
 
-process :: (FR freeRegs, Instruction instr, Outputable instr)
-        => BlockId
+process :: (FR freeRegs, Instruction instr, PlatformOutputable instr)
+        => Platform
+        -> BlockId
         -> BlockMap RegSet
         -> [GenBasicBlock (LiveInstr instr)]
         -> [GenBasicBlock (LiveInstr instr)]
@@ -247,10 +251,10 @@ process :: (FR freeRegs, Instruction instr, Outputable instr)
         -> Bool
         -> RegM freeRegs [[NatBasicBlock instr]]
 
-process _ _ [] []         accum _
+process _ _ _ [] []         accum _
         = return $ reverse accum
 
-process first_id block_live [] next_round accum madeProgress
+process platform first_id block_live [] next_round accum madeProgress
         | not madeProgress
 
           {- BUGS: There are so many unreachable blocks in the code the warnings are overwhelming.
@@ -260,10 +264,10 @@ process first_id block_live [] next_round accum madeProgress
         = return $ reverse accum
 
         | otherwise
-        = process first_id block_live
+        = process platform first_id block_live
                   next_round [] accum False
 
-process first_id block_live (b@(BasicBlock id _) : blocks)
+process platform first_id block_live (b@(BasicBlock id _) : blocks)
         next_round accum madeProgress
  = do
         block_assig <- getBlockAssigR
@@ -271,26 +275,27 @@ process first_id block_live (b@(BasicBlock id _) : blocks)
         if isJust (mapLookup id block_assig)
              || id == first_id
          then do
-                b'  <- processBlock block_live b
-                process first_id block_live blocks
+                b'  <- processBlock platform block_live b
+                process platform first_id block_live blocks
                         next_round (b' : accum) True
 
-         else   process first_id block_live blocks
+         else   process platform first_id block_live blocks
                         (b : next_round) accum madeProgress
 
 
 -- | Do register allocation on this basic block
 --
 processBlock
-        :: (FR freeRegs, Outputable instr, Instruction instr)
-        => BlockMap RegSet              -- ^ live regs on entry to each basic block
+        :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
+        => Platform
+        -> BlockMap RegSet              -- ^ live regs on entry to each basic block
         -> LiveBasicBlock instr         -- ^ block to do register allocation on
         -> RegM freeRegs [NatBasicBlock instr]   -- ^ block with registers allocated
 
-processBlock block_live (BasicBlock id instrs)
+processBlock platform block_live (BasicBlock id instrs)
  = do   initBlock id
         (instrs', fixups)
-                <- linearRA block_live [] [] id instrs
+                <- linearRA platform block_live [] [] id instrs
         return  $ BasicBlock id instrs' : fixups
 
 
@@ -316,8 +321,9 @@ initBlock id
 
 -- | Do allocation for a sequence of instructions.
 linearRA
-        :: (FR freeRegs, Outputable instr, Instruction instr)
-        => BlockMap RegSet                      -- ^ map of what vregs are live on entry to each block.
+        :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
+        => Platform
+        -> BlockMap RegSet                      -- ^ map of what vregs are live on entry to each block.
         -> [instr]                              -- ^ accumulator for instructions already processed.
         -> [NatBasicBlock instr]                -- ^ accumulator for blocks of fixup code.
         -> BlockId                              -- ^ id of the current block, for debugging.
@@ -328,24 +334,25 @@ linearRA
                 , [NatBasicBlock instr])        --   fresh blocks of fixup code.
 
 
-linearRA _          accInstr accFixup _ []
+linearRA _        _          accInstr accFixup _ []
         = return
                 ( reverse accInstr              -- instrs need to be returned in the correct order.
                 , accFixup)                     -- it doesn't matter what order the fixup blocks are returned in.
 
 
-linearRA block_live accInstr accFixups id (instr:instrs)
+linearRA platform block_live accInstr accFixups id (instr:instrs)
  = do
         (accInstr', new_fixups)
-                <- raInsn block_live accInstr id instr
+                <- raInsn platform block_live accInstr id instr
 
-        linearRA block_live accInstr' (new_fixups ++ accFixups) id instrs
+        linearRA platform block_live accInstr' (new_fixups ++ accFixups) id instrs
 
 
 -- | Do allocation for a single instruction.
 raInsn
-        :: (FR freeRegs, Outputable instr, Instruction instr)
-        => BlockMap RegSet                      -- ^ map of what vregs are love on entry to each block.
+        :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
+        => Platform
+        -> BlockMap RegSet                      -- ^ map of what vregs are love on entry to each block.
         -> [instr]                              -- ^ accumulator for instructions already processed.
         -> BlockId                              -- ^ the id of the current block, for debugging
         -> LiveInstr instr                      -- ^ the instr to have its regs allocated, with liveness info.
@@ -353,17 +360,17 @@ raInsn
                 ( [instr]                       -- new instructions
                 , [NatBasicBlock instr])        -- extra fixup blocks
 
-raInsn _     new_instrs _ (LiveInstr ii Nothing)
+raInsn _ _     new_instrs _ (LiveInstr ii Nothing)
         | Just n        <- takeDeltaInstr ii
         = do    setDeltaR n
                 return (new_instrs, [])
 
-raInsn _     new_instrs _ (LiveInstr ii Nothing)
+raInsn _ _     new_instrs _ (LiveInstr ii Nothing)
         | isMetaInstr ii
         = return (new_instrs, [])
 
 
-raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
+raInsn _ block_live new_instrs id (LiveInstr (Instr instr) (Just live))
  = do
     assig    <- getAssigR
 
@@ -403,11 +410,11 @@ raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
                         (uniqSetToList $ liveDieWrite live)
 
 
-raInsn _ _ _ instr
-        = pprPanic "raInsn" (text "no match for:" <> ppr instr)
+raInsn platform _ _ _ instr
+        = pprPanic "raInsn" (text "no match for:" <> pprPlatform platform instr)
 
 
-genRaInsn :: (FR freeRegs, Instruction instr, Outputable instr)
+genRaInsn :: (FR freeRegs, Instruction instr, PlatformOutputable instr)
           => BlockMap RegSet
           -> [instr]
           -> BlockId
@@ -546,7 +553,7 @@ releaseRegs regs = do
 
 
 saveClobberedTemps
-        :: (Outputable instr, Instruction instr)
+        :: (PlatformOutputable instr, Instruction instr)
         => [RealReg]            -- real registers clobbered by this instruction
         -> [Reg]                -- registers which are no longer live after this insn
         -> RegM freeRegs [instr]         -- return: instructions to spill any temps that will
@@ -638,7 +645,7 @@ data SpillLoc = ReadMem StackSlot  -- reading from register only in memory
 --   the list of free registers and free stack slots.
 
 allocateRegsAndSpill
-        :: (FR freeRegs, Outputable instr, Instruction instr)
+        :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
         => Bool                 -- True <=> reading (load up spilled regs)
         -> [VirtualReg]         -- don't push these out
         -> [instr]              -- spill insns
@@ -682,7 +689,7 @@ allocateRegsAndSpill reading keep spills alloc (r:rs)
 
 -- reading is redundant with reason, but we keep it around because it's
 -- convenient and it maintains the recursive structure of the allocator. -- EZY
-allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, Outputable instr)
+allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, PlatformOutputable instr)
                         => Bool
                         -> [VirtualReg]
                         -> [instr]
@@ -787,7 +794,7 @@ newLocation _ my_reg = InReg my_reg
 
 -- | Load up a spilled temporary if we need to (read from memory).
 loadTemp
-        :: (Outputable instr, Instruction instr)
+        :: (PlatformOutputable instr, Instruction instr)
         => VirtualReg   -- the temp being loaded
         -> SpillLoc     -- the current location of this temp
         -> RealReg      -- the hreg to load the temp into
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index 7867f8e7c6..01337308b8 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -40,6 +40,7 @@ import OldPprCmm()
 
 import Digraph
 import Outputable
+import Platform
 import Unique
 import UniqSet
 import UniqFM
@@ -169,13 +170,13 @@ type LiveBasicBlock instr
         = GenBasicBlock (LiveInstr instr)
 
 
-instance Outputable instr
-      => Outputable (InstrSR instr) where
+instance PlatformOutputable instr
+      => PlatformOutputable (InstrSR instr) where
 
-        ppr (Instr realInstr)
-           = ppr realInstr
+        pprPlatform platform (Instr realInstr)
+           = pprPlatform platform realInstr
 
-        ppr (SPILL reg slot)
+        pprPlatform _ (SPILL reg slot)
            = hcat [
                 ptext (sLit "\tSPILL"),
                 char ' ',
@@ -183,7 +184,7 @@ instance Outputable instr
                 comma,
                 ptext (sLit "SLOT") <> parens (int slot)]
 
-        ppr (RELOAD slot reg)
+        pprPlatform _ (RELOAD slot reg)
            = hcat [
                 ptext (sLit "\tRELOAD"),
                 char ' ',
@@ -191,14 +192,14 @@ instance Outputable instr
                 comma,
                 ppr reg]
 
-instance Outputable instr
-      => Outputable (LiveInstr instr) where
+instance PlatformOutputable instr
+      => PlatformOutputable (LiveInstr instr) where
 
-        ppr (LiveInstr instr Nothing)
-         = ppr instr
+        pprPlatform platform (LiveInstr instr Nothing)
+         = pprPlatform platform instr
 
-        ppr (LiveInstr instr (Just live))
-         =  ppr instr
+        pprPlatform platform (LiveInstr instr (Just live))
+         =  pprPlatform platform instr
                 $$ (nest 8
                         $ vcat
                         [ pprRegs (ptext (sLit "# born:    ")) (liveBorn live)
@@ -458,11 +459,12 @@ slurpReloadCoalesce live
 
 -- | Strip away liveness information, yielding NatCmmTop
 stripLive
-        :: (Outputable statics, Outputable instr, Instruction instr)
-        => LiveCmmTop statics instr
+        :: (Outputable statics, PlatformOutputable instr, Instruction instr)
+        => Platform
+        -> LiveCmmTop statics instr
         -> NatCmmTop statics instr
 
-stripLive live
+stripLive platform live
         = stripCmm live
 
  where  stripCmm (CmmData sec ds)       = CmmData sec ds
@@ -484,8 +486,7 @@ stripLive live
 
         -- If the proc has blocks but we don't know what the first one was, then we're dead.
         stripCmm proc
-                 = pprPanic "RegAlloc.Liveness.stripLive: no first_id on proc" (ppr proc)
-
+                 = pprPanic "RegAlloc.Liveness.stripLive: no first_id on proc" (pprPlatform platform proc)
 
 -- | Strip away liveness information from a basic block,
 --   and make real spill instructions out of SPILL, RELOAD pseudos along the way.
@@ -657,22 +658,23 @@ sccBlocks blocks = stronglyConnCompFromEdgedVertices graph
 -- Annotate code with register liveness information
 --
 regLiveness
-        :: (Outputable instr, Instruction instr)
-        => LiveCmmTop statics instr
+        :: (PlatformOutputable instr, Instruction instr)
+        => Platform
+        -> LiveCmmTop statics instr
         -> UniqSM (LiveCmmTop statics instr)
 
-regLiveness (CmmData i d)
+regLiveness _ (CmmData i d)
         = returnUs $ CmmData i d
 
-regLiveness (CmmProc info lbl [])
+regLiveness _ (CmmProc info lbl [])
         | LiveInfo static mFirst _ _    <- info
         = returnUs $ CmmProc
                         (LiveInfo static mFirst (Just mapEmpty) Map.empty)
                         lbl []
 
-regLiveness (CmmProc info lbl sccs)
+regLiveness platform (CmmProc info lbl sccs)
         | LiveInfo static mFirst _ liveSlotsOnEntry     <- info
-        = let   (ann_sccs, block_live)  = computeLiveness sccs
+        = let   (ann_sccs, block_live)  = computeLiveness platform sccs
 
           in    returnUs $ CmmProc (LiveInfo static mFirst (Just block_live) liveSlotsOnEntry)
                            lbl ann_sccs
@@ -736,20 +738,21 @@ reverseBlocksInTops top
 --  want for the next pass.
 --
 computeLiveness
-        :: (Outputable instr, Instruction instr)
-        => [SCC (LiveBasicBlock instr)]
+        :: (PlatformOutputable instr, Instruction instr)
+        => Platform
+        -> [SCC (LiveBasicBlock instr)]
         -> ([SCC (LiveBasicBlock instr)],       -- instructions annotated with list of registers
                                                 -- which are "dead after this instruction".
                BlockMap RegSet)                 -- blocks annontated with set of live registers
                                                 -- on entry to the block.
 
-computeLiveness sccs
+computeLiveness platform sccs
  = case checkIsReverseDependent sccs of
         Nothing         -> livenessSCCs emptyBlockMap [] sccs
         Just bad        -> pprPanic "RegAlloc.Liveness.computeLivenss"
                                 (vcat   [ text "SCCs aren't in reverse dependent order"
                                         , text "bad blockId" <+> ppr bad
-                                        , ppr sccs])
+                                        , pprPlatform platform sccs])
 
 livenessSCCs
        :: Instruction instr