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.

30 files changed, 320 insertions, 255 deletions

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index ec655e0b2c..8828adb0d0 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -862,6 +862,8 @@ entry.
 
 instance Outputable CLabel where
   ppr = pprCLabel
+instance PlatformOutputable CLabel where
+  pprPlatform _ = pprCLabel
 
 pprCLabel :: CLabel -> SDoc
 
diff --git a/compiler/cmm/CmmCvt.hs b/compiler/cmm/CmmCvt.hs
index 83d72b8f6e..fcb220d74c 100644
--- a/compiler/cmm/CmmCvt.hs
+++ b/compiler/cmm/CmmCvt.hs
@@ -13,6 +13,7 @@ import CmmExpr
 import MkGraph
 import qualified OldCmm as Old
 import OldPprCmm ()
+import Platform
 
 import Compiler.Hoopl hiding ((<*>), mkLabel, mkBranch)
 import Control.Monad
@@ -21,23 +22,23 @@ import Maybes
 import Outputable
 import UniqSupply
 
-cmmToZgraph :: Old.Cmm -> UniqSM Cmm
-cmmOfZgraph :: Cmm     -> Old.Cmm
+cmmToZgraph :: Platform -> Old.Cmm -> UniqSM Cmm
+cmmOfZgraph :: Cmm -> Old.Cmm
 
-cmmToZgraph (Cmm tops) = liftM Cmm $ mapM mapTop tops
+cmmToZgraph platform (Cmm tops) = liftM Cmm $ mapM mapTop tops
   where mapTop (CmmProc (Old.CmmInfo _ _ info_tbl) l g) =
-          do (stack_info, g) <- toZgraph (showSDoc $ ppr l) g
+          do (stack_info, g) <- toZgraph platform (showSDoc $ ppr l) g
              return $ CmmProc (TopInfo {info_tbl=info_tbl, stack_info=stack_info}) l g
         mapTop (CmmData s ds) = return $ CmmData s ds
 cmmOfZgraph (Cmm tops) = Cmm $ map mapTop tops
   where mapTop (CmmProc h l g) = CmmProc (Old.CmmInfo Nothing Nothing (info_tbl h)) l (ofZgraph g)
         mapTop (CmmData s ds) = CmmData s ds
 
-toZgraph :: String -> Old.ListGraph Old.CmmStmt -> UniqSM (CmmStackInfo, CmmGraph)
-toZgraph _ (Old.ListGraph []) =
+toZgraph :: Platform -> String -> Old.ListGraph Old.CmmStmt -> UniqSM (CmmStackInfo, CmmGraph)
+toZgraph _ _ (Old.ListGraph []) =
   do g <- lgraphOfAGraph emptyAGraph
      return (StackInfo {arg_space=0, updfr_space=Nothing}, g)
-toZgraph fun_name g@(Old.ListGraph (Old.BasicBlock id ss : other_blocks)) = 
+toZgraph platform fun_name g@(Old.ListGraph (Old.BasicBlock id ss : other_blocks)) =
            let (offset, entry) = mkCallEntry NativeNodeCall [] in
            do g <- labelAGraph id $
                      entry <*> mkStmts ss <*> foldr addBlock emptyAGraph other_blocks
@@ -64,7 +65,7 @@ toZgraph fun_name g@(Old.ListGraph (Old.BasicBlock id ss : other_blocks)) =
         mkStmts (last : []) = mkLast last
         mkStmts []          = bad "fell off end"
         mkStmts (_ : _ : _) = bad "last node not at end"
-        bad msg = pprPanic (msg ++ " in function " ++ fun_name) (ppr g)
+        bad msg = pprPanic (msg ++ " in function " ++ fun_name) (pprPlatform platform g)
         mkLast (Old.CmmCall (Old.CmmCallee f conv) []     args _ Old.CmmNeverReturns) =
             mkFinalCall f conv (map Old.hintlessCmm args) updfr_sz
         mkLast (Old.CmmCall (Old.CmmPrim {}) _ _ _ Old.CmmNeverReturns) =
diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index 32fead337e..15357ecb94 100644
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -23,6 +23,7 @@ import Outputable
 import OldPprCmm()
 import Constants
 import FastString
+import Platform
 
 import Data.Maybe
 
@@ -30,21 +31,22 @@ import Data.Maybe
 -- Exported entry points:
 
 cmmLint :: (Outputable d, Outputable h)
-	=> GenCmm d h (ListGraph CmmStmt) -> Maybe SDoc
-cmmLint (Cmm tops) = runCmmLint (mapM_ lintCmmTop) tops
+        => Platform -> GenCmm d h (ListGraph CmmStmt) -> Maybe SDoc
+cmmLint platform (Cmm tops) = runCmmLint platform (mapM_ lintCmmTop) tops
 
 cmmLintTop :: (Outputable d, Outputable h)
-	   => GenCmmTop d h (ListGraph CmmStmt) -> Maybe SDoc
-cmmLintTop top = runCmmLint lintCmmTop top
+           => Platform -> GenCmmTop d h (ListGraph CmmStmt) -> Maybe SDoc
+cmmLintTop platform top = runCmmLint platform lintCmmTop top
 
-runCmmLint :: Outputable a => (a -> CmmLint b) -> a -> Maybe SDoc
-runCmmLint l p = 
+runCmmLint :: PlatformOutputable a
+           => Platform -> (a -> CmmLint b) -> a -> Maybe SDoc
+runCmmLint platform l p =
    case unCL (l p) of
-	Left err -> Just (vcat [ptext $ sLit ("Cmm lint error:"),
-				nest 2 err,
-				ptext $ sLit ("Program was:"),
-				nest 2 (ppr p)])
-  	Right _  -> Nothing
+   Left err -> Just (vcat [ptext $ sLit ("Cmm lint error:"),
+                           nest 2 err,
+                           ptext $ sLit ("Program was:"),
+                           nest 2 (pprPlatform platform p)])
+   Right _  -> Nothing
 
 lintCmmTop :: (GenCmmTop h i (ListGraph CmmStmt)) -> CmmLint ()
 lintCmmTop (CmmProc _ lbl (ListGraph blocks))
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 07a8c11df5..2d59fe751e 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -1075,7 +1075,7 @@ parseCmmFile dflags filename = do
         if (errorsFound dflags ms)
          then return (ms, Nothing)
          else do
-           dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (ppr cmm)
+           dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprPlatform (targetPlatform dflags) cmm)
            return (ms, Just cmm)
   where
 	no_module = panic "parseCmmFile: no module"
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index 1e4809d2b2..5effa6ca77 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -65,7 +65,7 @@ cmmPipeline hsc_env (topSRT, rst) prog =
      let topCAFEnv = mkTopCAFInfo (concat cafEnvs)
      (topSRT, tops) <- foldM (toTops hsc_env topCAFEnv) (topSRT, []) tops
      let cmms = Cmm (reverse (concat tops))
-     dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (ppr cmms)
+     dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (pprPlatform (targetPlatform dflags) cmms)
      -- SRT is not affected by control flow optimization pass
      let prog' = map runCmmContFlowOpts (cmms : rst)
      return (topSRT, prog')
@@ -90,33 +90,33 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
 
        ----------- Eliminate common blocks -------------------
        g <- return $ elimCommonBlocks g
-       dump Opt_D_dump_cmmz_cbe "Post common block elimination" g
+       dumpPlatform platform Opt_D_dump_cmmz_cbe "Post common block elimination" g
        -- Any work storing block Labels must be performed _after_ elimCommonBlocks
 
        ----------- Proc points -------------------
        let callPPs = callProcPoints g
-       procPoints <- run $ minimalProcPointSet callPPs g
+       procPoints <- run $ minimalProcPointSet (targetPlatform dflags) callPPs g
        g <- run $ addProcPointProtocols callPPs procPoints g
-       dump Opt_D_dump_cmmz_proc "Post Proc Points Added" g
+       dumpPlatform platform Opt_D_dump_cmmz_proc "Post Proc Points Added" g
 
        ----------- Spills and reloads -------------------
        g <- run $ dualLivenessWithInsertion procPoints g
-       dump Opt_D_dump_cmmz_spills "Post spills and reloads" g
+       dumpPlatform platform Opt_D_dump_cmmz_spills "Post spills and reloads" g
 
        ----------- Sink and inline assignments -------------------
        g <- runOptimization $ rewriteAssignments g
-       dump Opt_D_dump_cmmz_rewrite "Post rewrite assignments" g
+       dumpPlatform platform Opt_D_dump_cmmz_rewrite "Post rewrite assignments" g
 
        ----------- Eliminate dead assignments -------------------
        g <- runOptimization $ removeDeadAssignments g
-       dump Opt_D_dump_cmmz_dead "Post remove dead assignments" g
+       dumpPlatform platform Opt_D_dump_cmmz_dead "Post remove dead assignments" g
 
        ----------- Zero dead stack slots (Debug only) ---------------
        -- Debugging: stubbing slots on death can cause crashes early
        g <- if opt_StubDeadValues
                 then run $ stubSlotsOnDeath g
                 else return g
-       dump Opt_D_dump_cmmz_stub "Post stub dead stack slots" g
+       dumpPlatform platform Opt_D_dump_cmmz_stub "Post stub dead stack slots" g
 
        --------------- Stack layout ----------------
        slotEnv <- run $ liveSlotAnal g
@@ -127,7 +127,7 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
 
        ------------  Manifest the stack pointer --------
        g  <- run $ manifestSP spEntryMap areaMap entry_off g
-       dump Opt_D_dump_cmmz_sp "Post manifestSP" g
+       dumpPlatform platform Opt_D_dump_cmmz_sp "Post manifestSP" g
        -- UGH... manifestSP can require updates to the procPointMap.
        -- We can probably do something quicker here for the update...
 
@@ -136,7 +136,7 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
        dump Opt_D_dump_cmmz_procmap "procpoint map" procPointMap
        gs <- run $ splitAtProcPoints l callPPs procPoints procPointMap
                                        (CmmProc h l g)
-       mapM_ (dump Opt_D_dump_cmmz_split "Post splitting") gs
+       mapM_ (dumpPlatform platform Opt_D_dump_cmmz_split "Post splitting") gs
 
        ------------- More CAFs and foreign calls ------------
        cafEnv <- run $ cafAnal g
@@ -144,23 +144,26 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
        mbpprTrace "localCAFs" (ppr localCAFs) $ return ()
 
        gs <- run $ mapM (lowerSafeForeignCalls areaMap) gs
-       mapM_ (dump Opt_D_dump_cmmz_lower "Post lowerSafeForeignCalls") gs
+       mapM_ (dumpPlatform platform Opt_D_dump_cmmz_lower "Post lowerSafeForeignCalls") gs
 
        -- NO MORE GRAPH TRANSFORMATION AFTER HERE -- JUST MAKING INFOTABLES
        gs <- return $ map (setInfoTableStackMap slotEnv areaMap) gs
-       mapM_ (dump Opt_D_dump_cmmz_info "after setInfoTableStackMap") gs
+       mapM_ (dumpPlatform platform Opt_D_dump_cmmz_info "after setInfoTableStackMap") gs
        gs <- return $ map (bundleCAFs cafEnv) gs
-       mapM_ (dump Opt_D_dump_cmmz_cafs "after bundleCAFs") gs
+       mapM_ (dumpPlatform platform Opt_D_dump_cmmz_cafs "after bundleCAFs") gs
        return (localCAFs, gs)
   where dflags = hsc_dflags hsc_env
+        platform = targetPlatform dflags
         mbpprTrace x y z = if dopt Opt_D_dump_cmmz dflags then pprTrace x y z else z
-        dump f txt g = do
+        dump f = dumpWith ppr f
+        dumpPlatform platform = dumpWith (pprPlatform platform)
+        dumpWith pprFun f txt g = do
             -- ToDo: No easy way of say "dump all the cmmz, *and* split
             -- them into files."  Also, -ddump-cmmz doesn't play nicely
             -- with -ddump-to-file, since the headers get omitted.
-            dumpIfSet_dyn dflags f txt (ppr g)
+            dumpIfSet_dyn dflags f txt (pprFun g)
             when (not (dopt f dflags)) $
-                dumpIfSet_dyn dflags Opt_D_dump_cmmz txt (ppr g)
+                dumpIfSet_dyn dflags Opt_D_dump_cmmz txt (pprFun g)
         -- Runs a required transformation/analysis
         run = runInfiniteFuelIO (hsc_OptFuel hsc_env)
         -- Runs an optional transformation/analysis (and should
diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs
index 0527b6eea0..b608b291d4 100644
--- a/compiler/cmm/CmmProcPoint.hs
+++ b/compiler/cmm/CmmProcPoint.hs
@@ -25,6 +25,7 @@ import MkGraph
 import Control.Monad
 import OptimizationFuel
 import Outputable
+import Platform
 import UniqSet
 import UniqSupply
 
@@ -139,10 +140,10 @@ callProcPoints g = foldGraphBlocks add (setSingleton (g_entry g)) g
                       CmmForeignCall {succ=k}     -> setInsert k set
                       _ -> set
 
-minimalProcPointSet :: ProcPointSet -> CmmGraph -> FuelUniqSM ProcPointSet
+minimalProcPointSet :: Platform -> ProcPointSet -> CmmGraph -> FuelUniqSM ProcPointSet
 -- Given the set of successors of calls (which must be proc-points)
 -- figure out the minimal set of necessary proc-points
-minimalProcPointSet callProcPoints g = extendPPSet g (postorderDfs g) callProcPoints
+minimalProcPointSet platform callProcPoints g = extendPPSet platform g (postorderDfs g) callProcPoints
 
 procPointAnalysis :: ProcPointSet -> CmmGraph -> FuelUniqSM (BlockEnv Status)
 -- Once you know what the proc-points are, figure out
@@ -151,8 +152,8 @@ procPointAnalysis procPoints g =
   liftM snd $ dataflowPassFwd g initProcPoints $ analFwd lattice forward
   where initProcPoints = [(id, ProcPoint) | id <- setElems procPoints]
 
-extendPPSet :: CmmGraph -> [CmmBlock] -> ProcPointSet -> FuelUniqSM ProcPointSet
-extendPPSet g blocks procPoints =
+extendPPSet :: Platform -> CmmGraph -> [CmmBlock] -> ProcPointSet -> FuelUniqSM ProcPointSet
+extendPPSet platform g blocks procPoints =
     do env <- procPointAnalysis procPoints g
        let add block pps = let id = entryLabel block
                            in  case mapLookup id env of
@@ -163,7 +164,7 @@ extendPPSet g blocks procPoints =
            newPoint  = listToMaybe newPoints
            ppSuccessor b =
                let nreached id = case mapLookup id env `orElse`
-                                       pprPanic "no ppt" (ppr id <+> ppr b) of
+                                       pprPanic "no ppt" (ppr id <+> pprPlatform platform b) of
                                    ProcPoint -> 1
                                    ReachedBy ps -> setSize ps
                    block_procpoints = nreached (entryLabel b)
@@ -181,7 +182,7 @@ extendPPSet g blocks procPoints =
 -}
        case newPoint of Just id ->
                           if setMember id procPoints' then panic "added old proc pt"
-                          else extendPPSet g blocks (setInsert id procPoints')
+                          else extendPPSet platform g blocks (setInsert id procPoints')
                         Nothing -> return procPoints'
 
 
diff --git a/compiler/cmm/OldPprCmm.hs b/compiler/cmm/OldPprCmm.hs
index f443ce80d9..4050359710 100644
--- a/compiler/cmm/OldPprCmm.hs
+++ b/compiler/cmm/OldPprCmm.hs
@@ -50,20 +50,23 @@ import PprCmmExpr
 import BasicTypes
 import ForeignCall
 import Outputable
+import Platform
 import FastString
 
 import Data.List
 
 -----------------------------------------------------------------------------
 
-instance (Outputable instr) => Outputable (ListGraph instr) where
-    ppr (ListGraph blocks) = vcat (map ppr blocks)
+instance PlatformOutputable instr => PlatformOutputable (ListGraph instr) where
+    pprPlatform platform (ListGraph blocks) = vcat (map (pprPlatform platform) blocks)
 
-instance (Outputable instr) => Outputable (GenBasicBlock instr) where
-    ppr b = pprBBlock b
+instance PlatformOutputable instr => PlatformOutputable (GenBasicBlock instr) where
+    pprPlatform platform b = pprBBlock platform b
 
 instance Outputable CmmStmt where
     ppr s = pprStmt s
+instance PlatformOutputable CmmStmt where
+    pprPlatform _ = ppr
 
 instance Outputable CmmInfo where
     ppr e = pprInfo e
@@ -99,9 +102,9 @@ pprInfo (CmmInfo _gc_target update_frame info_table@(CmmInfoTable _ _ _ _ _)) =
 -- --------------------------------------------------------------------------
 -- Basic blocks look like assembly blocks.
 --      lbl: stmt ; stmt ; ..
-pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
-pprBBlock (BasicBlock ident stmts) =
-    hang (ppr ident <> colon) 4 (vcat (map ppr stmts))
+pprBBlock :: PlatformOutputable stmt => Platform -> GenBasicBlock stmt -> SDoc
+pprBBlock platform (BasicBlock ident stmts) =
+    hang (ppr ident <> colon) 4 (vcat (map (pprPlatform platform) stmts))
 
 -- --------------------------------------------------------------------------
 -- Statements. C-- usually, exceptions to this should be obvious.
diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index cede69e06f..43e1c5bb2f 100644
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -49,6 +49,7 @@ import PprCmmExpr
 import Util
 
 import BasicTypes
+import Platform
 import Compiler.Hoopl
 import Data.List
 import Prelude hiding (succ)
@@ -76,20 +77,20 @@ instance Outputable ForeignTarget where
     ppr = pprForeignTarget
 
 
-instance Outputable (Block CmmNode C C) where
-    ppr = pprBlock
-instance Outputable (Block CmmNode C O) where
-    ppr = pprBlock
-instance Outputable (Block CmmNode O C) where
-    ppr = pprBlock
-instance Outputable (Block CmmNode O O) where
-    ppr = pprBlock
+instance PlatformOutputable (Block CmmNode C C) where
+    pprPlatform _ = pprBlock
+instance PlatformOutputable (Block CmmNode C O) where
+    pprPlatform _ = pprBlock
+instance PlatformOutputable (Block CmmNode O C) where
+    pprPlatform _ = pprBlock
+instance PlatformOutputable (Block CmmNode O O) where
+    pprPlatform _ = pprBlock
 
-instance Outputable (Graph CmmNode e x) where
-    ppr = pprGraph
+instance PlatformOutputable (Graph CmmNode e x) where
+    pprPlatform = pprGraph
 
-instance Outputable CmmGraph where
-    ppr = pprCmmGraph
+instance PlatformOutputable CmmGraph where
+    pprPlatform platform = pprCmmGraph platform
 
 ----------------------------------------------------------
 -- Outputting types Cmm contains
@@ -107,7 +108,8 @@ pprTopInfo (TopInfo {info_tbl=info_tbl, stack_info=stack_info}) =
 ----------------------------------------------------------
 -- Outputting blocks and graphs
 
-pprBlock :: IndexedCO x SDoc SDoc ~ SDoc => Block CmmNode e x -> IndexedCO e SDoc SDoc
+pprBlock :: IndexedCO x SDoc SDoc ~ SDoc
+         => Block CmmNode e x -> IndexedCO e SDoc SDoc
 pprBlock block = foldBlockNodesB3 ( ($$) . ppr
                                   , ($$) . (nest 4) . ppr
                                   , ($$) . (nest 4) . ppr
@@ -115,21 +117,22 @@ pprBlock block = foldBlockNodesB3 ( ($$) . ppr
                                   block
                                   empty
 
-pprGraph :: Graph CmmNode e x -> SDoc
-pprGraph GNil = empty
-pprGraph (GUnit block) = ppr block
-pprGraph (GMany entry body exit)
+pprGraph :: Platform -> Graph CmmNode e x -> SDoc
+pprGraph _ GNil = empty
+pprGraph platform (GUnit block) = pprPlatform platform block
+pprGraph platform (GMany entry body exit)
    = text "{"
-  $$ nest 2 (pprMaybeO entry $$ (vcat $ map ppr $ bodyToBlockList body) $$ pprMaybeO exit)
+  $$ nest 2 (pprMaybeO entry $$ (vcat $ map (pprPlatform platform) $ bodyToBlockList body) $$ pprMaybeO exit)
   $$ text "}"
-  where pprMaybeO :: Outputable (Block CmmNode e x) => MaybeO ex (Block CmmNode e x) -> SDoc
+  where pprMaybeO :: PlatformOutputable (Block CmmNode e x)
+                  => MaybeO ex (Block CmmNode e x) -> SDoc
         pprMaybeO NothingO = empty
-        pprMaybeO (JustO block) = ppr block
+        pprMaybeO (JustO block) = pprPlatform platform block
 
-pprCmmGraph :: CmmGraph -> SDoc
-pprCmmGraph g
+pprCmmGraph :: Platform -> CmmGraph -> SDoc
+pprCmmGraph platform g
    = text "{" <> text "offset"
-  $$ nest 2 (vcat $ map ppr blocks)
+  $$ nest 2 (vcat $ map (pprPlatform platform) blocks)
   $$ text "}"
   where blocks = postorderDfs g
 
diff --git a/compiler/cmm/PprCmmDecl.hs b/compiler/cmm/PprCmmDecl.hs
index 08fa075d11..f688f211fb 100644
--- a/compiler/cmm/PprCmmDecl.hs
+++ b/compiler/cmm/PprCmmDecl.hs
@@ -43,6 +43,7 @@ import PprCmmExpr
 
 
 import Outputable
+import Platform
 import FastString
 
 import Data.List
@@ -54,23 +55,25 @@ import ClosureInfo
 #include "../includes/rts/storage/FunTypes.h"
 
 
-pprCmms :: (Outputable info, Outputable g) => [GenCmm CmmStatics info g] -> SDoc
-pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
+pprCmms :: (Outputable info, PlatformOutputable g)
+        => Platform -> [GenCmm CmmStatics info g] -> SDoc
+pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pprPlatform platform) cmms))
         where
           separator = space $$ ptext (sLit "-------------------") $$ space
 
-writeCmms :: (Outputable info, Outputable g) => Handle -> [GenCmm CmmStatics info g] -> IO ()
-writeCmms handle cmms = printForC handle (pprCmms cmms)
+writeCmms :: (Outputable info, PlatformOutputable g)
+          => Platform -> Handle -> [GenCmm CmmStatics info g] -> IO ()
+writeCmms platform handle cmms = printForC handle (pprCmms platform cmms)
 
 -----------------------------------------------------------------------------
 
-instance (Outputable d, Outputable info, Outputable g)
-    => Outputable (GenCmm d info g) where
-    ppr c = pprCmm c
+instance (Outputable d, Outputable info, PlatformOutputable g)
+      => PlatformOutputable (GenCmm d info g) where
+    pprPlatform platform c = pprCmm platform c
 
-instance (Outputable d, Outputable info, Outputable i)
-	=> Outputable (GenCmmTop d info i) where
-    ppr t = pprTop t
+instance (Outputable d, Outputable info, PlatformOutputable i)
+      => PlatformOutputable (GenCmmTop d info i) where
+    pprPlatform platform t = pprTop platform t
 
 instance Outputable CmmStatics where
     ppr e = pprStatics e
@@ -84,20 +87,22 @@ instance Outputable CmmInfoTable where
 
 -----------------------------------------------------------------------------
 
-pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc
-pprCmm (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops
+pprCmm :: (Outputable d, Outputable info, PlatformOutputable g)
+       => Platform -> GenCmm d info g -> SDoc
+pprCmm platform (Cmm tops)
+    = vcat $ intersperse blankLine $ map (pprTop platform) tops
 
 -- --------------------------------------------------------------------------
 -- Top level `procedure' blocks.
 --
-pprTop 	:: (Outputable d, Outputable info, Outputable i)
-	=> GenCmmTop d info i -> SDoc
+pprTop :: (Outputable d, Outputable info, PlatformOutputable i)
+       => Platform -> GenCmmTop d info i -> SDoc
 
-pprTop (CmmProc info lbl graph)
+pprTop platform (CmmProc info lbl graph)
 
   = vcat [ pprCLabel lbl <> lparen <> rparen
          , nest 8 $ lbrace <+> ppr info $$ rbrace
-         , nest 4 $ ppr graph
+         , nest 4 $ pprPlatform platform graph
          , rbrace ]
 
 -- --------------------------------------------------------------------------
@@ -105,7 +110,7 @@ pprTop (CmmProc info lbl graph)
 --
 --      section "data" { ... }
 --
-pprTop (CmmData section ds) = 
+pprTop _ (CmmData section ds) = 
     (hang (pprSection section <+> lbrace) 4 (ppr ds))
     $$ rbrace
 
diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs
index 1825c97256..42c4bd24fc 100644
--- a/compiler/codeGen/CodeGen.lhs
+++ b/compiler/codeGen/CodeGen.lhs
@@ -84,7 +84,7 @@ codeGen dflags this_mod data_tycons cost_centre_info stg_binds hpc_info
                 -- initialisation routines; see Note
                 -- [pipeline-split-init].
 
-  ; dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms code_stuff)
+  ; dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms (targetPlatform dflags) code_stuff)
 
   ; return code_stuff }
 
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index 0404258446..29a254fafc 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -81,7 +81,7 @@ codeGen dflags this_mod data_tycons
                 -- initialisation routines; see Note
                 -- [pipeline-split-init].
 
-        ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "New Cmm" (pprCmms code_stuff)
+        ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "New Cmm" (pprCmms (targetPlatform dflags) code_stuff)
 
         ; return code_stuff }
 
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index 340a313561..be5c79cf64 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -115,7 +115,7 @@ cmmLlvmGen dflags us env cmm = do
     let fixed_cmm = fixStgRegisters cmm
 
     dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
-        (pprCmm $ Cmm [fixed_cmm])
+        (pprCmm (targetPlatform dflags) $ Cmm [fixed_cmm])
 
     -- generate llvm code from cmm
     let ((env', llvmBC), usGen) = initUs us $ genLlvmProc env fixed_cmm
diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs
index b58b7cd395..3ff35b6b92 100644
--- a/compiler/main/CodeOutput.lhs
+++ b/compiler/main/CodeOutput.lhs
@@ -61,7 +61,7 @@ codeOutput dflags this_mod location foreign_stubs pkg_deps flat_abstractC
 
     do	{ when (dopt Opt_DoCmmLinting dflags) $ do
 		{ showPass dflags "CmmLint"
-		; let lints = map cmmLint flat_abstractC
+		; let lints = map (cmmLint (targetPlatform dflags)) flat_abstractC
 		; case firstJusts lints of
 			Just err -> do { printDump err
 				       ; ghcExit dflags 1
diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 2836c0d2d1..266395d0b1 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -1054,6 +1054,7 @@ hscGenHardCode cgguts mod_summary
                      cg_dep_pkgs = dependencies,
                      cg_hpc_info = hpc_info } = cgguts
              dflags = hsc_dflags hsc_env
+             platform = targetPlatform dflags
              location = ms_location mod_summary
              data_tycons = filter isDataTyCon tycons
              -- cg_tycons includes newtypes, for the benefit of External Core,
@@ -1089,7 +1090,7 @@ hscGenHardCode cgguts mod_summary
                  -- unless certain dflags are on, the identity function
          ------------------  Code output -----------------------
          rawcmms <- cmmToRawCmm cmms
-         dumpIfSet_dyn dflags Opt_D_dump_raw_cmm "Raw Cmm" (ppr rawcmms)
+         dumpIfSet_dyn dflags Opt_D_dump_raw_cmm "Raw Cmm" (pprPlatform platform rawcmms)
          (_stub_h_exists, stub_c_exists)
              <- codeOutput dflags this_mod location foreign_stubs 
                 dependencies rawcmms
@@ -1160,10 +1161,11 @@ tryNewCodeGen   :: HscEnv -> Module -> [TyCon]
 tryNewCodeGen hsc_env this_mod data_tycons
               cost_centre_info stg_binds hpc_info =
   do    { let dflags = hsc_dflags hsc_env
+              platform = targetPlatform dflags
         ; prog <- StgCmm.codeGen dflags this_mod data_tycons
                          cost_centre_info stg_binds hpc_info
         ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Cmm produced by new codegen" 
-                (pprCmms prog)
+                (pprCmms platform prog)
 
         -- We are building a single SRT for the entire module, so
         -- we must thread it through all the procedures as we cps-convert them.
@@ -1172,7 +1174,7 @@ tryNewCodeGen hsc_env this_mod data_tycons
         ; (topSRT, prog) <- foldM (cmmPipeline hsc_env) (initTopSRT, []) prog
 
         ; let prog' = map cmmOfZgraph (srtToData topSRT : prog)
-        ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Output Cmm" (ppr prog')
+        ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Output Cmm" (pprPlatform platform prog')
         ; return prog' }
 
 
@@ -1189,11 +1191,12 @@ optionallyConvertAndOrCPS hsc_env cmms =
 testCmmConversion :: HscEnv -> Cmm -> IO Cmm
 testCmmConversion hsc_env cmm =
     do let dflags = hsc_dflags hsc_env
+           platform = targetPlatform dflags
        showPass dflags "CmmToCmm"
-       dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- pre-conversion" (ppr cmm)
+       dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- pre-conversion" (pprPlatform platform cmm)
        --continuationC <- cmmCPS dflags abstractC >>= cmmToRawCmm
        us <- mkSplitUniqSupply 'C'
-       let zgraph = initUs_ us (cmmToZgraph cmm)
+       let zgraph = initUs_ us (cmmToZgraph platform cmm)
        chosen_graph <-
         if dopt Opt_RunCPSZ dflags
             then do us <- mkSplitUniqSupply 'S'
@@ -1201,10 +1204,10 @@ testCmmConversion hsc_env cmm =
                     (_, [zgraph]) <- cmmPipeline hsc_env (topSRT, []) zgraph
                     return zgraph
             else return (runCmmContFlowOpts zgraph)
-       dumpIfSet_dyn dflags Opt_D_dump_cmmz "C-- Zipper Graph" (ppr chosen_graph)
+       dumpIfSet_dyn dflags Opt_D_dump_cmmz "C-- Zipper Graph" (pprPlatform platform chosen_graph)
        showPass dflags "Convert from Z back to Cmm"
        let cvt = cmmOfZgraph chosen_graph
-       dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- post-conversion" (ppr cvt)
+       dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- post-conversion" (pprPlatform platform cvt)
        return cvt
 
 myCoreToStg :: DynFlags -> Module -> [CoreBind]
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 7a3bdefeff..0e497fea7e 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -133,7 +133,7 @@ The machine-dependent bits break down as follows:
 -- Top-level of the native codegen
 
 data NcgImpl statics instr jumpDest = NcgImpl {
-    cmmTopCodeGen             :: RawCmmTop -> NatM [NatCmmTop statics instr],
+    cmmTopCodeGen             :: Platform -> RawCmmTop -> NatM [NatCmmTop statics instr],
     generateJumpTableForInstr :: instr -> Maybe (NatCmmTop statics instr),
     getJumpDestBlockId        :: jumpDest -> Maybe BlockId,
     canShortcut               :: instr -> Maybe jumpDest,
@@ -150,7 +150,7 @@ data NcgImpl statics instr jumpDest = NcgImpl {
 --------------------
 nativeCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO ()
 nativeCodeGen dflags h us cmms
- = let nCG' :: (Outputable statics, Outputable instr, Instruction instr) => NcgImpl statics instr jumpDest -> IO ()
+ = let nCG' :: (Outputable statics, PlatformOutputable instr, Instruction instr) => NcgImpl statics instr jumpDest -> IO ()
        nCG' ncgImpl = nativeCodeGen' dflags ncgImpl h us cmms
        x86NcgImpl = NcgImpl {
                          cmmTopCodeGen             = X86.CodeGen.cmmTopCodeGen
@@ -206,7 +206,7 @@ nativeCodeGen dflags h us cmms
                  ArchUnknown ->
                      panic "nativeCodeGen: No NCG for unknown arch"
 
-nativeCodeGen' :: (Outputable statics, Outputable instr, Instruction instr)
+nativeCodeGen' :: (Outputable statics, PlatformOutputable instr, Instruction instr)
                => DynFlags
                -> NcgImpl statics instr jumpDest
                -> Handle -> UniqSupply -> [RawCmm] -> IO ()
@@ -272,7 +272,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
 
 -- | Do native code generation on all these cmms.
 --
-cmmNativeGens :: (Outputable statics, Outputable instr, Instruction instr)
+cmmNativeGens :: (Outputable statics, PlatformOutputable instr, Instruction instr)
               => DynFlags
               -> NcgImpl statics instr jumpDest
               -> BufHandle
@@ -327,7 +327,7 @@ cmmNativeGens dflags ncgImpl h us (cmm : cmms) impAcc profAcc count
 --	Dumping the output of each stage along the way.
 --	Global conflict graph and NGC stats
 cmmNativeGen
-	:: (Outputable statics, Outputable instr, Instruction instr)
+	:: (Outputable statics, PlatformOutputable instr, Instruction instr)
     => DynFlags
     -> NcgImpl statics instr jumpDest
 	-> UniqSupply
@@ -341,6 +341,7 @@ cmmNativeGen
 
 cmmNativeGen dflags ncgImpl us cmm count
  = do
+        let platform = targetPlatform dflags
 
 	-- rewrite assignments to global regs
  	let fixed_cmm =
@@ -354,27 +355,27 @@ cmmNativeGen dflags ncgImpl us cmm count
 
 	dumpIfSet_dyn dflags
 		Opt_D_dump_opt_cmm "Optimised Cmm"
-		(pprCmm $ Cmm [opt_cmm])
+		(pprCmm platform $ Cmm [opt_cmm])
 
 	-- generate native code from cmm
 	let ((native, lastMinuteImports), usGen) =
 		{-# SCC "genMachCode" #-}
-		initUs us $ genMachCode dflags (cmmTopCodeGen ncgImpl) opt_cmm
+		initUs us $ genMachCode dflags (cmmTopCodeGen ncgImpl platform) opt_cmm
 
 	dumpIfSet_dyn dflags
 		Opt_D_dump_asm_native "Native code"
-		(vcat $ map (docToSDoc . pprNatCmmTop ncgImpl (targetPlatform dflags)) native)
+		(vcat $ map (docToSDoc . pprNatCmmTop ncgImpl platform) native)
 
 	-- tag instructions with register liveness information
 	let (withLiveness, usLive) =
 		{-# SCC "regLiveness" #-}
 		initUs usGen 
-			$ mapUs regLiveness 
+			$ mapUs (regLiveness platform)
 			$ map natCmmTopToLive native
 
 	dumpIfSet_dyn dflags
 		Opt_D_dump_asm_liveness "Liveness annotations added"
-		(vcat $ map ppr withLiveness)
+		(vcat $ map (pprPlatform platform) withLiveness)
 		
 	-- allocate registers
 	(alloced, usAlloc, ppr_raStatsColor, ppr_raStatsLinear) <-
@@ -401,14 +402,14 @@ cmmNativeGen dflags ncgImpl us cmm count
 		-- dump out what happened during register allocation
 		dumpIfSet_dyn dflags
 			Opt_D_dump_asm_regalloc "Registers allocated"
-			(vcat $ map (docToSDoc . pprNatCmmTop ncgImpl (targetPlatform dflags)) alloced)
+			(vcat $ map (docToSDoc . pprNatCmmTop ncgImpl platform) alloced)
 
 		dumpIfSet_dyn dflags
 			Opt_D_dump_asm_regalloc_stages "Build/spill stages"
 			(vcat 	$ map (\(stage, stats)
 					-> text "# --------------------------"
 					$$ text "#  cmm " <> int count <> text " Stage " <> int stage
-					$$ ppr stats)
+					$$ pprPlatform platform stats)
 				$ zip [0..] regAllocStats)
 
 		let mPprStats =
@@ -432,7 +433,7 @@ cmmNativeGen dflags ncgImpl us cmm count
 
 		dumpIfSet_dyn dflags
 			Opt_D_dump_asm_regalloc "Registers allocated"
-			(vcat $ map (docToSDoc . pprNatCmmTop ncgImpl (targetPlatform dflags)) alloced)
+			(vcat $ map (docToSDoc . pprNatCmmTop ncgImpl platform) alloced)
 
 		let mPprStats =
 			if dopt Opt_D_dump_asm_stats dflags
@@ -476,7 +477,7 @@ cmmNativeGen dflags ncgImpl us cmm count
 
 	dumpIfSet_dyn dflags
 		Opt_D_dump_asm_expanded "Synthetic instructions expanded"
-		(vcat $ map (docToSDoc . pprNatCmmTop ncgImpl (targetPlatform dflags)) expanded)
+		(vcat $ map (docToSDoc . pprNatCmmTop ncgImpl platform) expanded)
 
 	return 	( usAlloc
 		, expanded
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 89ad516875..71373ee21d 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -66,10 +66,11 @@ import FastString
 -- order.
 
 cmmTopCodeGen
-        :: RawCmmTop
+        :: Platform
+        -> RawCmmTop
         -> NatM [NatCmmTop CmmStatics Instr]
 
-cmmTopCodeGen (CmmProc info lab (ListGraph blocks)) = do
+cmmTopCodeGen _ (CmmProc info lab (ListGraph blocks)) = do
   (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
   picBaseMb <- getPicBaseMaybeNat
   dflags <- getDynFlagsNat
@@ -80,7 +81,7 @@ cmmTopCodeGen (CmmProc info lab (ListGraph blocks)) = do
       Just picBase -> initializePicBase_ppc ArchPPC os picBase tops
       Nothing -> return tops
 
-cmmTopCodeGen (CmmData sec dat) = do
+cmmTopCodeGen _ (CmmData sec dat) = do
   return [CmmData sec dat]  -- no translation, we just use CmmStatic
 
 basicBlockCodeGen
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index 340cf3f8da..de8db68e65 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -41,7 +41,7 @@ import Platform
 import Pretty
 import FastString
 import qualified Outputable
-import Outputable	( Outputable, panic )
+import Outputable ( PlatformOutputable, panic )
 
 import Data.Word
 import Data.Bits
@@ -142,8 +142,8 @@ pprASCII str
 -- -----------------------------------------------------------------------------
 -- pprInstr: print an 'Instr'
 
-instance Outputable Instr where
-    ppr	 instr	= Outputable.docToSDoc $ pprInstr instr
+instance PlatformOutputable Instr where
+    pprPlatform _ instr = Outputable.docToSDoc $ pprInstr instr
 
 
 pprReg :: Reg -> Doc
diff --git a/compiler/nativeGen/PprInstruction.hs b/compiler/nativeGen/PprInstruction.hs
new file mode 100644
index 0000000000..6c19160e35
--- /dev/null
+++ b/compiler/nativeGen/PprInstruction.hs
@@ -0,0 +1,2 @@
+
+        pprInstruction :: Platform -> instr -> SDoc
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
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 72e4649eca..817fa47183 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -44,26 +44,27 @@ import CLabel
 import StaticFlags	( opt_PIC )
 import OrdList
 import Outputable
+import Platform
 import Unique
 
 import Control.Monad	( mapAndUnzipM )
 
 -- | Top level code generation
-cmmTopCodeGen 
-	:: RawCmmTop 
-	-> NatM [NatCmmTop CmmStatics Instr]
+cmmTopCodeGen :: Platform
+              -> RawCmmTop
+              -> NatM [NatCmmTop CmmStatics Instr]
 
-cmmTopCodeGen
+cmmTopCodeGen platform
 	(CmmProc info lab (ListGraph blocks)) 
  = do	
- 	(nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
+ 	(nat_blocks,statics) <- mapAndUnzipM (basicBlockCodeGen platform) blocks
 
 	let proc 	= CmmProc info lab (ListGraph $ concat nat_blocks)
 	let tops 	= proc : concat statics
 
   	return tops
   
-cmmTopCodeGen (CmmData sec dat) = do
+cmmTopCodeGen _ (CmmData sec dat) = do
   return [CmmData sec dat]  -- no translation, we just use CmmStatic
 
 
@@ -72,12 +73,12 @@ cmmTopCodeGen (CmmData sec dat) = do
 -- 	are indicated by the NEWBLOCK instruction.  We must split up the
 -- 	instruction stream into basic blocks again.  Also, we extract
 -- 	LDATAs here too.
-basicBlockCodeGen 
-	:: CmmBasicBlock
-	-> NatM ( [NatBasicBlock Instr]
-		, [NatCmmTop CmmStatics Instr])
+basicBlockCodeGen :: Platform
+                  -> CmmBasicBlock
+                  -> NatM ( [NatBasicBlock Instr]
+                          , [NatCmmTop CmmStatics Instr])
 
-basicBlockCodeGen cmm@(BasicBlock id stmts) = do
+basicBlockCodeGen platform cmm@(BasicBlock id stmts) = do
   instrs <- stmtsToInstrs stmts
   let
 	(top,other_blocks,statics) 
@@ -94,7 +95,7 @@ basicBlockCodeGen cmm@(BasicBlock id stmts) = do
 
 	-- do intra-block sanity checking
 	blocksChecked
-	  	= map (checkBlock cmm)
+	  	= map (checkBlock platform cmm)
 	  	$ BasicBlock id top : other_blocks
 
   return (blocksChecked, statics)
diff --git a/compiler/nativeGen/SPARC/CodeGen/Sanity.hs b/compiler/nativeGen/SPARC/CodeGen/Sanity.hs
index ca4c8e4994..a3053cbae8 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Sanity.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Sanity.hs
@@ -15,15 +15,17 @@ import Instruction
 import OldCmm
 
 import Outputable
+import Platform
 
 
 -- | Enforce intra-block invariants.
 --
-checkBlock
-	:: CmmBasicBlock 
-	-> NatBasicBlock Instr -> NatBasicBlock Instr
+checkBlock :: Platform
+           -> CmmBasicBlock
+           -> NatBasicBlock Instr
+           -> NatBasicBlock Instr
 
-checkBlock cmm block@(BasicBlock _ instrs)
+checkBlock platform cmm block@(BasicBlock _ instrs)
 	| checkBlockInstrs instrs
 	= block
 	
@@ -31,9 +33,9 @@ checkBlock cmm block@(BasicBlock _ instrs)
 	= pprPanic 
 		("SPARC.CodeGen: bad block\n")
 		( vcat	[ text " -- cmm -----------------\n"
-			, ppr cmm
+			, pprPlatform platform cmm
 			, text " -- native code ---------\n"
-			, ppr block ])
+			, pprPlatform platform block ])
 
 
 checkBlockInstrs :: [Instr] -> Bool
diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs
index 2e8bf29a2e..bf3fd3c303 100644
--- a/compiler/nativeGen/SPARC/Ppr.hs
+++ b/compiler/nativeGen/SPARC/Ppr.hs
@@ -39,7 +39,7 @@ import CLabel
 
 import Unique		( Uniquable(..), pprUnique )
 import qualified Outputable
-import Outputable	(Outputable, panic)
+import Outputable (PlatformOutputable, panic)
 import Platform
 import Pretty
 import FastString
@@ -133,8 +133,8 @@ pprASCII str
 -- -----------------------------------------------------------------------------
 -- pprInstr: print an 'Instr'
 
-instance Outputable Instr where
-    ppr	 instr	= Outputable.docToSDoc $ pprInstr instr
+instance PlatformOutputable Instr where
+    pprPlatform _ instr = Outputable.docToSDoc $ pprInstr instr
 
 
 -- | Pretty print a register.
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 49ac543e65..00d9a5bbad 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -79,10 +79,11 @@ if_sse2 sse2 x87 = do
   if b then sse2 else x87
 
 cmmTopCodeGen
-        :: RawCmmTop
+        :: Platform
+        -> RawCmmTop
         -> NatM [NatCmmTop (Alignment, CmmStatics) Instr]
 
-cmmTopCodeGen (CmmProc info lab (ListGraph blocks)) = do
+cmmTopCodeGen _ (CmmProc info lab (ListGraph blocks)) = do
   (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
   picBaseMb <- getPicBaseMaybeNat
   dflags <- getDynFlagsNat
@@ -94,7 +95,7 @@ cmmTopCodeGen (CmmProc info lab (ListGraph blocks)) = do
       Just picBase -> initializePicBase_x86 ArchX86 os picBase tops
       Nothing -> return tops
 
-cmmTopCodeGen (CmmData sec dat) = do
+cmmTopCodeGen _ (CmmData sec dat) = do
   return [CmmData sec (1, dat)]  -- no translation, we just use CmmStatic
 
 
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index 17b169e27a..a755d839fb 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -39,7 +39,7 @@ import Platform
 import Pretty
 import FastString
 import qualified Outputable
-import Outputable       (panic, Outputable)
+import Outputable       (panic, PlatformOutputable)
 
 import Data.Word
 
@@ -162,8 +162,8 @@ pprAlign platform bytes
 -- -----------------------------------------------------------------------------
 -- pprInstr: print an 'Instr'
 
-instance Outputable Instr where
-    ppr instr = Outputable.docToSDoc $ pprInstr defaultTargetPlatform instr
+instance PlatformOutputable Instr where
+    pprPlatform platform instr = Outputable.docToSDoc $ pprInstr platform instr
 
 
 pprReg :: Platform -> Size -> Reg -> Doc
diff --git a/compiler/utils/Digraph.lhs b/compiler/utils/Digraph.lhs
index a341bdecbc..ec65cded94 100644
--- a/compiler/utils/Digraph.lhs
+++ b/compiler/utils/Digraph.lhs
@@ -164,6 +164,9 @@ flattenSCC (CyclicSCC vs) = vs
 instance Outputable a => Outputable (SCC a) where
    ppr (AcyclicSCC v) = text "NONREC" $$ (nest 3 (ppr v))
    ppr (CyclicSCC vs) = text "REC" $$ (nest 3 (vcat (map ppr vs)))
+instance PlatformOutputable a => PlatformOutputable (SCC a) where
+   pprPlatform platform (AcyclicSCC v) = text "NONREC" $$ (nest 3 (pprPlatform platform v))
+   pprPlatform platform (CyclicSCC vs) = text "REC" $$ (nest 3 (vcat (map (pprPlatform platform) vs)))
 \end{code}
 
 %************************************************************************
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index 8a0c62a2ed..7f8a3a67ff 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -13,6 +13,7 @@
 module Outputable (
 	-- * Type classes
 	Outputable(..), OutputableBndr(..),
+	PlatformOutputable(..),
 
         -- * Pretty printing combinators
 	SDoc, runSDoc, initSDocContext,
@@ -74,6 +75,7 @@ import {-# SOURCE #-} 	OccName( OccName )
 import StaticFlags
 import FastString 
 import FastTypes
+import Platform
 import qualified Pretty
 import Pretty		( Doc, Mode(..) )
 import Panic
@@ -600,6 +602,13 @@ class Outputable a where
 	
 	ppr = pprPrec 0
 	pprPrec _ = ppr
+
+class PlatformOutputable a where
+	pprPlatform :: Platform -> a -> SDoc
+	pprPlatformPrec :: Platform -> Rational -> a -> SDoc
+	
+	pprPlatform platform = pprPlatformPrec platform 0
+	pprPlatformPrec platform _ = pprPlatform platform
 \end{code}
 
 \begin{code}
@@ -621,12 +630,19 @@ instance Outputable Word where
 
 instance Outputable () where
    ppr _ = text "()"
+instance PlatformOutputable () where
+   pprPlatform _ _ = text "()"
 
 instance (Outputable a) => Outputable [a] where
     ppr xs = brackets (fsep (punctuate comma (map ppr xs)))
+instance (PlatformOutputable a) => PlatformOutputable [a] where
+    pprPlatform platform xs = brackets (fsep (punctuate comma (map (pprPlatform platform) xs)))
 
 instance (Outputable a, Outputable b) => Outputable (a, b) where
     ppr (x,y) = parens (sep [ppr x <> comma, ppr y])
+instance (PlatformOutputable a, PlatformOutputable b) => PlatformOutputable (a, b) where
+    pprPlatform platform (x,y)
+     = parens (sep [pprPlatform platform x <> comma, pprPlatform platform y])
 
 instance Outputable a => Outputable (Maybe a) where
   ppr Nothing = ptext (sLit "Nothing")
@@ -687,6 +703,8 @@ instance Outputable FastString where
 
 instance (Outputable key, Outputable elt) => Outputable (M.Map key elt) where
     ppr m = ppr (M.toList m)
+instance (PlatformOutputable key, PlatformOutputable elt) => PlatformOutputable (M.Map key elt) where
+    pprPlatform platform m = pprPlatform platform (M.toList m)
 instance (Outputable elt) => Outputable (IM.IntMap elt) where
     ppr m = ppr (IM.toList m)
 \end{code}