Remove PlatformOutputable

We can now get the Platform from the DynFlags inside an SDoc, so we
no longer need to pass the Platform in.

33 files changed, 285 insertions, 328 deletions

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 717a38a6db..20cd584065 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -253,22 +253,21 @@ data ForeignLabelSource
 --      The regular Outputable instance only shows the label name, and not its other info.
 --
 pprDebugCLabel :: Platform -> CLabel -> SDoc
-pprDebugCLabel platform lbl
+pprDebugCLabel _ lbl
  = case lbl of
-        IdLabel{}       -> pprPlatform platform lbl <> (parens $ text "IdLabel")
+        IdLabel{}       -> ppr lbl <> (parens $ text "IdLabel")
         CmmLabel pkg _name _info
-         -> pprPlatform platform lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
+         -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
 
-        RtsLabel{}      -> pprPlatform platform lbl <> (parens $ text "RtsLabel")
+        RtsLabel{}      -> ppr lbl <> (parens $ text "RtsLabel")
 
         ForeignLabel _name mSuffix src funOrData
-         -> pprPlatform platform lbl <> (parens
-                                $ text "ForeignLabel"
+            -> ppr lbl <> (parens $ text "ForeignLabel"
                                 <+> ppr mSuffix
                                 <+> ppr src
                                 <+> ppr funOrData)
 
-        _               -> pprPlatform platform lbl <> (parens $ text "other CLabel)")
+        _               -> ppr lbl <> (parens $ text "other CLabel)")
 
 
 data IdLabelInfo
@@ -922,8 +921,8 @@ Not exporting these Just_info labels reduces the number of symbols
 somewhat.
 -}
 
-instance PlatformOutputable CLabel where
-  pprPlatform = pprCLabel
+instance Outputable CLabel where
+  ppr c = sdocWithPlatform $ \platform -> pprCLabel platform c
 
 pprCLabel :: Platform -> CLabel -> SDoc
 
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index b39a59134c..81d82d0b8a 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -228,12 +228,12 @@ data TopSRT = TopSRT { lbl      :: CLabel
                      , rev_elts :: [CLabel]
                      , elt_map  :: Map CLabel Int }
                         -- map: CLabel -> its last entry in the table
-instance PlatformOutputable TopSRT where
-  pprPlatform platform (TopSRT lbl next elts eltmap) =
-    text "TopSRT:" <+> pprPlatform platform lbl
+instance Outputable TopSRT where
+  ppr (TopSRT lbl next elts eltmap) =
+    text "TopSRT:" <+> ppr lbl
                    <+> ppr next
-                   <+> pprPlatform platform elts
-                   <+> pprPlatform platform eltmap
+                   <+> ppr elts
+                   <+> ppr eltmap
 
 emptySRT :: MonadUnique m => m TopSRT
 emptySRT =
diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index 98e6eb286d..01ebac6254 100644
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -31,22 +31,22 @@ import Data.Maybe
 -- -----------------------------------------------------------------------------
 -- Exported entry points:
 
-cmmLint :: (PlatformOutputable d, PlatformOutputable h)
+cmmLint :: (Outputable d, Outputable h)
         => Platform -> GenCmmGroup d h (ListGraph CmmStmt) -> Maybe SDoc
 cmmLint platform tops = runCmmLint platform (mapM_ (lintCmmDecl platform)) tops
 
-cmmLintTop :: (PlatformOutputable d, PlatformOutputable h)
+cmmLintTop :: (Outputable d, Outputable h)
            => Platform -> GenCmmDecl d h (ListGraph CmmStmt) -> Maybe SDoc
 cmmLintTop platform top = runCmmLint platform (lintCmmDecl platform) top
 
-runCmmLint :: PlatformOutputable a
+runCmmLint :: Outputable a
            => Platform -> (a -> CmmLint b) -> a -> Maybe SDoc
-runCmmLint platform l p =
+runCmmLint _ 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 (pprPlatform platform p)])
+                           nest 2 (ppr p)])
    Right _  -> Nothing
 
 lintCmmDecl :: Platform -> (GenCmmDecl h i (ListGraph CmmStmt)) -> CmmLint ()
@@ -81,7 +81,7 @@ lintCmmExpr platform expr@(CmmMachOp op args) = do
   tys <- mapM (lintCmmExpr platform) args
   if map (typeWidth . cmmExprType) args == machOpArgReps op
   	then cmmCheckMachOp op args tys
-	else cmmLintMachOpErr platform expr (map cmmExprType args) (machOpArgReps op)
+	else cmmLintMachOpErr expr (map cmmExprType args) (machOpArgReps op)
 lintCmmExpr platform (CmmRegOff reg offset)
   = lintCmmExpr platform (CmmMachOp (MO_Add rep)
 		[CmmReg reg, CmmLit (CmmInt (fromIntegral offset) rep)])
@@ -103,14 +103,14 @@ isOffsetOp _ = False
 
 -- This expression should be an address from which a word can be loaded:
 -- check for funny-looking sub-word offsets.
-_cmmCheckWordAddress :: Platform -> CmmExpr -> CmmLint ()
-_cmmCheckWordAddress platform e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
+_cmmCheckWordAddress :: CmmExpr -> CmmLint ()
+_cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
   | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
-  = cmmLintDubiousWordOffset platform e
-_cmmCheckWordAddress platform e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
+  = cmmLintDubiousWordOffset e
+_cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
   | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
-  = cmmLintDubiousWordOffset platform e
-_cmmCheckWordAddress _ _
+  = cmmLintDubiousWordOffset e
+_cmmCheckWordAddress _
   = return ()
 
 -- No warnings for unaligned arithmetic with the node register,
@@ -128,7 +128,7 @@ lintCmmStmt platform labels = lint
 	    let reg_ty = cmmRegType reg
             if (erep `cmmEqType_ignoring_ptrhood` reg_ty)
                 then return ()
-                else cmmLintAssignErr platform stmt erep reg_ty
+                else cmmLintAssignErr stmt erep reg_ty
           lint (CmmStore l r) = do
             _ <- lintCmmExpr platform l
             _ <- lintCmmExpr platform r
@@ -136,13 +136,13 @@ lintCmmStmt platform labels = lint
           lint (CmmCall target _res args _) =
               do lintTarget platform labels target
                  mapM_ (lintCmmExpr platform . hintlessCmm) args
-          lint (CmmCondBranch e id) = checkTarget id >> lintCmmExpr platform e >> checkCond platform e
+          lint (CmmCondBranch e id) = checkTarget id >> lintCmmExpr platform e >> checkCond e
           lint (CmmSwitch e branches) = do
             mapM_ checkTarget $ catMaybes branches
             erep <- lintCmmExpr platform e
             if (erep `cmmEqType_ignoring_ptrhood` bWord)
               then return ()
-              else cmmLintErr (text "switch scrutinee is not a word: " <> pprPlatform platform e <>
+              else cmmLintErr (text "switch scrutinee is not a word: " <> ppr e <>
                                text " :: " <> ppr erep)
           lint (CmmJump e _) = lintCmmExpr platform e >> return ()
           lint (CmmReturn) = return ()
@@ -158,12 +158,12 @@ lintTarget platform labels (CmmPrim _ (Just stmts))
     = mapM_ (lintCmmStmt platform labels) stmts
 
 
-checkCond :: Platform -> CmmExpr -> CmmLint ()
-checkCond _ (CmmMachOp mop _) | isComparisonMachOp mop = return ()
-checkCond _ (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth = return () -- constant values
-checkCond platform expr
+checkCond :: CmmExpr -> CmmLint ()
+checkCond (CmmMachOp mop _) | isComparisonMachOp mop = return ()
+checkCond (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth = return () -- constant values
+checkCond expr
     = cmmLintErr (hang (text "expression is not a conditional:") 2
-                       (pprPlatform platform expr))
+                       (ppr expr))
 
 -- -----------------------------------------------------------------------------
 -- CmmLint monad
@@ -187,23 +187,23 @@ addLintInfo info thing = CmmLint $
 	Left err -> Left (hang info 2 err)
 	Right a  -> Right a
 
-cmmLintMachOpErr :: Platform -> CmmExpr -> [CmmType] -> [Width] -> CmmLint a
-cmmLintMachOpErr platform expr argsRep opExpectsRep
+cmmLintMachOpErr :: CmmExpr -> [CmmType] -> [Width] -> CmmLint a
+cmmLintMachOpErr expr argsRep opExpectsRep
      = cmmLintErr (text "in MachOp application: " $$ 
-					nest 2 (pprPlatform platform expr) $$
+					nest 2 (ppr expr) $$
 				        (text "op is expecting: " <+> ppr opExpectsRep) $$
 					(text "arguments provide: " <+> ppr argsRep))
 
-cmmLintAssignErr :: Platform -> CmmStmt -> CmmType -> CmmType -> CmmLint a
-cmmLintAssignErr platform stmt e_ty r_ty
+cmmLintAssignErr :: CmmStmt -> CmmType -> CmmType -> CmmLint a
+cmmLintAssignErr stmt e_ty r_ty
   = cmmLintErr (text "in assignment: " $$ 
-		nest 2 (vcat [pprPlatform platform stmt, 
+		nest 2 (vcat [ppr stmt, 
 			      text "Reg ty:" <+> ppr r_ty,
 			      text "Rhs ty:" <+> ppr e_ty]))
 			 
 					
 
-cmmLintDubiousWordOffset :: Platform -> CmmExpr -> CmmLint a
-cmmLintDubiousWordOffset platform expr
+cmmLintDubiousWordOffset :: CmmExpr -> CmmLint a
+cmmLintDubiousWordOffset expr
    = cmmLintErr (text "offset is not a multiple of words: " $$
-			nest 2 (pprPlatform platform expr))
+			nest 2 (ppr expr))
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 9d831b7fc2..075ed22ea9 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -1078,7 +1078,7 @@ parseCmmFile dflags filename = do
         if (errorsFound dflags ms)
          then return (ms, Nothing)
          else do
-           dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprPlatform (targetPlatform dflags) cmm)
+           dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (ppr 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 73e8b338f5..409623d58f 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -73,7 +73,7 @@ cmmPipeline hsc_env (topSRT, rst) prog =
      let cmms :: CmmGroup
          cmms = reverse (concat tops)
 
-     dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (pprPlatform (targetPlatform dflags) cmms)
+     dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (ppr cmms)
 
      -- SRT is not affected by control flow optimization pass
      let prog' = runCmmContFlowOpts cmms
@@ -100,33 +100,33 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
 
        ----------- Eliminate common blocks -------------------
        g <- return $ elimCommonBlocks g
-       dumpPlatform platform Opt_D_dump_cmmz_cbe "Post common block elimination" g
+       dump 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 (targetPlatform dflags) callPPs g
        g <- run $ addProcPointProtocols callPPs procPoints g
-       dumpPlatform platform Opt_D_dump_cmmz_proc "Post Proc Points Added" g
+       dump Opt_D_dump_cmmz_proc "Post Proc Points Added" g
 
        ----------- Spills and reloads -------------------
        g <- run $ dualLivenessWithInsertion procPoints g
-       dumpPlatform platform Opt_D_dump_cmmz_spills "Post spills and reloads" g
+       dump Opt_D_dump_cmmz_spills "Post spills and reloads" g
 
        ----------- Sink and inline assignments -------------------
        g <- runOptimization $ rewriteAssignments platform g
-       dumpPlatform platform Opt_D_dump_cmmz_rewrite "Post rewrite assignments" g
+       dump Opt_D_dump_cmmz_rewrite "Post rewrite assignments" g
 
        ----------- Eliminate dead assignments -------------------
        g <- runOptimization $ removeDeadAssignments g
-       dumpPlatform platform Opt_D_dump_cmmz_dead "Post remove dead assignments" g
+       dump 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
-       dumpPlatform platform Opt_D_dump_cmmz_stub "Post stub dead stack slots" g
+       dump Opt_D_dump_cmmz_stub "Post stub dead stack slots" g
 
        --------------- Stack layout ----------------
        slotEnv <- run $ liveSlotAnal g
@@ -137,7 +137,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
-       dumpPlatform platform Opt_D_dump_cmmz_sp "Post manifestSP" g
+       dump 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...
 
@@ -146,21 +146,21 @@ 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_ (dumpPlatform platform Opt_D_dump_cmmz_split "Post splitting") gs
+       mapM_ (dump Opt_D_dump_cmmz_split "Post splitting") gs
 
        ------------- More CAFs and foreign calls ------------
        cafEnv <- run $ cafAnal platform g
        let localCAFs = catMaybes $ map (localCAFInfo platform cafEnv) gs
-       mbpprTrace "localCAFs" (pprPlatform platform localCAFs) $ return ()
+       mbpprTrace "localCAFs" (ppr localCAFs) $ return ()
 
        gs <- run $ mapM (lowerSafeForeignCalls areaMap) gs
-       mapM_ (dumpPlatform platform Opt_D_dump_cmmz_lower "Post lowerSafeForeignCalls") gs
+       mapM_ (dump 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_ (dumpPlatform platform Opt_D_dump_cmmz_info "after setInfoTableStackMap") gs
+       mapM_ (dump Opt_D_dump_cmmz_info "after setInfoTableStackMap") gs
        gs <- return $ map (bundleCAFs cafEnv) gs
-       mapM_ (dumpPlatform platform Opt_D_dump_cmmz_cafs "after bundleCAFs") gs
+       mapM_ (dump Opt_D_dump_cmmz_cafs "after bundleCAFs") gs
        return (localCAFs, gs)
 
               -- gs        :: [ (CAFSet, CmmDecl) ]
@@ -170,7 +170,6 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
         platform = targetPlatform dflags
         mbpprTrace x y z = if dopt Opt_D_dump_cmmz dflags then pprTrace x y z else z
         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
diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs
index b7945429ea..f50d850b3a 100644
--- a/compiler/cmm/CmmProcPoint.hs
+++ b/compiler/cmm/CmmProcPoint.hs
@@ -163,7 +163,7 @@ extendPPSet platform g blocks procPoints =
            newPoint  = listToMaybe newPoints
            ppSuccessor b =
                let nreached id = case mapLookup id env `orElse`
-                                       pprPanic "no ppt" (ppr id <+> pprPlatform platform b) of
+                                       pprPanic "no ppt" (ppr id <+> ppr b) of
                                    ProcPoint -> 1
                                    ReachedBy ps -> setSize ps
                    block_procpoints = nreached (entryLabel b)
diff --git a/compiler/cmm/OldPprCmm.hs b/compiler/cmm/OldPprCmm.hs
index 24821b61af..19b913853c 100644
--- a/compiler/cmm/OldPprCmm.hs
+++ b/compiler/cmm/OldPprCmm.hs
@@ -55,24 +55,24 @@ import Data.List
 
 -----------------------------------------------------------------------------
 
-instance PlatformOutputable instr => PlatformOutputable (ListGraph instr) where
-    pprPlatform platform (ListGraph blocks) = vcat (map (pprPlatform platform) blocks)
+instance Outputable instr => Outputable (ListGraph instr) where
+    ppr (ListGraph blocks) = vcat (map ppr blocks)
 
-instance PlatformOutputable instr => PlatformOutputable (GenBasicBlock instr) where
-    pprPlatform platform b = pprBBlock platform b
+instance Outputable instr => Outputable (GenBasicBlock instr) where
+    ppr = pprBBlock
 
-instance PlatformOutputable CmmStmt where
-    pprPlatform = pprStmt
+instance Outputable CmmStmt where
+    ppr s = sdocWithPlatform $ \platform -> pprStmt platform s
 
-instance PlatformOutputable CmmInfo where
-    pprPlatform = pprInfo
+instance Outputable CmmInfo where
+    ppr i = sdocWithPlatform $ \platform -> pprInfo platform i
 
 
 -- --------------------------------------------------------------------------
-instance PlatformOutputable CmmSafety where
-  pprPlatform _ CmmUnsafe = ptext (sLit "_unsafe_call_")
-  pprPlatform _ CmmInterruptible = ptext (sLit "_interruptible_call_")
-  pprPlatform platform (CmmSafe srt) = pprPlatform platform srt
+instance Outputable CmmSafety where
+  ppr CmmUnsafe = ptext (sLit "_unsafe_call_")
+  ppr CmmInterruptible = ptext (sLit "_interruptible_call_")
+  ppr (CmmSafe srt) = ppr srt
 
 -- --------------------------------------------------------------------------
 -- Info tables. The current pretty printer needs refinement
@@ -89,14 +89,14 @@ pprInfo platform (CmmInfo _gc_target update_frame info_table) =
                 maybe (ptext (sLit "<none>"))
                       (pprUpdateFrame platform)
                       update_frame,
-          pprPlatform platform info_table]
+          ppr info_table]
 
 -- --------------------------------------------------------------------------
 -- Basic blocks look like assembly blocks.
 --      lbl: stmt ; stmt ; ..
-pprBBlock :: PlatformOutputable stmt => Platform -> GenBasicBlock stmt -> SDoc
-pprBBlock platform (BasicBlock ident stmts) =
-    hang (ppr ident <> colon) 4 (vcat (map (pprPlatform platform) stmts))
+pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
+pprBBlock (BasicBlock ident stmts) =
+    hang (ppr ident <> colon) 4 (vcat (map ppr stmts))
 
 -- --------------------------------------------------------------------------
 -- Statements. C-- usually, exceptions to this should be obvious.
@@ -111,10 +111,10 @@ pprStmt platform stmt = case stmt of
     CmmComment s -> text "//" <+> ftext s
 
     -- reg = expr;
-    CmmAssign reg expr -> ppr reg <+> equals <+> pprPlatform platform expr <> semi
+    CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
 
     -- rep[lv] = expr;
-    CmmStore lv expr -> rep <> brackets(pprPlatform platform lv) <+> equals <+> pprPlatform platform expr <> semi
+    CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
         where
           rep = ppr ( cmmExprType expr )
 
@@ -132,8 +132,8 @@ pprStmt platform stmt = case stmt of
                  | otherwise    = commafy (map ppr_ar results) <+> equals
                 -- Don't print the hints on a native C-- call
           ppr_ar (CmmHinted ar k) = case cconv of
-                            CmmCallConv -> pprPlatform platform ar
-                            _           -> pprPlatform platform (ar,k)
+                            CmmCallConv -> ppr ar
+                            _           -> ppr (ar,k)
           pp_conv = case cconv of
                       CmmCallConv -> empty
                       _           -> ptext (sLit("foreign")) <+> doubleQuotes (ppr cconv)
@@ -150,7 +150,7 @@ pprStmt platform stmt = case stmt of
                                 Nothing ForeignLabelInThisPackage IsFunction)
 
     CmmBranch ident          -> genBranch ident
-    CmmCondBranch expr ident -> genCondBranch platform expr ident
+    CmmCondBranch expr ident -> genCondBranch expr ident
     CmmJump expr live        -> genJump platform expr live
     CmmReturn                -> genReturn platform
     CmmSwitch arg ids        -> genSwitch platform arg ids
@@ -159,8 +159,6 @@ pprStmt platform stmt = case stmt of
 -- ... is that a good idea? --Isaac Dupree
 instance (Outputable a) => Outputable (CmmHinted a) where
   ppr (CmmHinted a k) = ppr (a, k)
-instance (PlatformOutputable a) => PlatformOutputable (CmmHinted a) where
-  pprPlatform platform (CmmHinted a k) = pprPlatform platform (a, k)
 
 pprUpdateFrame :: Platform -> UpdateFrame -> SDoc
 pprUpdateFrame platform (UpdateFrame expr args) =
@@ -172,7 +170,7 @@ pprUpdateFrame platform (UpdateFrame expr args) =
                     CmmLoad (CmmReg _) _ -> pprExpr platform expr
                     _ -> parens (pprExpr platform expr)
          , space
-         , parens  ( commafy $ map (pprPlatform platform) args ) ]
+         , parens  ( commafy $ map ppr args ) ]
 
 -- --------------------------------------------------------------------------
 -- goto local label. [1], section 6.6
@@ -188,10 +186,10 @@ genBranch ident =
 --
 --     if (expr) { goto lbl; }
 --
-genCondBranch :: Platform -> CmmExpr -> BlockId -> SDoc
-genCondBranch platform expr ident =
+genCondBranch :: CmmExpr -> BlockId -> SDoc
+genCondBranch expr ident =
     hsep [ ptext (sLit "if")
-         , parens(pprPlatform platform expr)
+         , parens (ppr expr)
          , ptext (sLit "goto")
          , ppr ident <> semi ]
 
diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index d32f129247..fd2efdf011 100644
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -59,12 +59,12 @@ import Prelude hiding (succ)
 instance Outputable CmmStackInfo where
     ppr = pprStackInfo
 
-instance PlatformOutputable CmmTopInfo where
-    pprPlatform = pprTopInfo
+instance Outputable CmmTopInfo where
+    ppr x = sdocWithPlatform $ \platform -> pprTopInfo platform x
 
 
-instance PlatformOutputable (CmmNode e x) where
-    pprPlatform = pprNode
+instance Outputable (CmmNode e x) where
+    ppr x = sdocWithPlatform $ \platform -> pprNode platform x
 
 instance Outputable Convention where
     ppr = pprConvention
@@ -72,24 +72,24 @@ instance Outputable Convention where
 instance Outputable ForeignConvention where
     ppr = pprForeignConvention
 
-instance PlatformOutputable ForeignTarget where
-    pprPlatform = pprForeignTarget
+instance Outputable ForeignTarget where
+    ppr x = sdocWithPlatform $ \platform -> pprForeignTarget platform x
 
 
-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 (Block CmmNode C C) where
+    ppr x = sdocWithPlatform $ \platform -> pprBlock platform x
+instance Outputable (Block CmmNode C O) where
+    ppr x = sdocWithPlatform $ \platform -> pprBlock platform x
+instance Outputable (Block CmmNode O C) where
+    ppr x = sdocWithPlatform $ \platform -> pprBlock platform x
+instance Outputable (Block CmmNode O O) where
+    ppr x = sdocWithPlatform $ \platform -> pprBlock platform x
 
-instance PlatformOutputable (Graph CmmNode e x) where
-    pprPlatform = pprGraph
+instance Outputable (Graph CmmNode e x) where
+    ppr x = sdocWithPlatform $ \platform -> pprGraph platform x
 
-instance PlatformOutputable CmmGraph where
-    pprPlatform platform = pprCmmGraph platform
+instance Outputable CmmGraph where
+    ppr g = sdocWithPlatform $ \platform -> pprCmmGraph platform g
 
 ----------------------------------------------------------
 -- Outputting types Cmm contains
@@ -100,8 +100,8 @@ pprStackInfo (StackInfo {arg_space=arg_space, updfr_space=updfr_space}) =
   ptext (sLit "updfr_space: ") <> ppr updfr_space
 
 pprTopInfo :: Platform -> CmmTopInfo -> SDoc
-pprTopInfo platform (TopInfo {info_tbl=info_tbl, stack_info=stack_info}) =
-  vcat [ptext (sLit "info_tbl: ") <> pprPlatform platform info_tbl,
+pprTopInfo _ (TopInfo {info_tbl=info_tbl, stack_info=stack_info}) =
+  vcat [ptext (sLit "info_tbl: ") <> ppr info_tbl,
         ptext (sLit "stack_info: ") <> ppr stack_info]
 
 ----------------------------------------------------------
@@ -109,30 +109,30 @@ pprTopInfo platform (TopInfo {info_tbl=info_tbl, stack_info=stack_info}) =
 
 pprBlock :: IndexedCO x SDoc SDoc ~ SDoc
          => Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
-pprBlock platform block
-    = foldBlockNodesB3 ( ($$) . pprPlatform platform
-                       , ($$) . (nest 4) . pprPlatform platform
-                       , ($$) . (nest 4) . pprPlatform platform
+pprBlock _ block
+    = foldBlockNodesB3 ( ($$) . ppr
+                       , ($$) . (nest 4) . ppr
+                       , ($$) . (nest 4) . ppr
                        )
                        block
                        empty
 
 pprGraph :: Platform -> Graph CmmNode e x -> SDoc
 pprGraph _ GNil = empty
-pprGraph platform (GUnit block) = pprPlatform platform block
-pprGraph platform (GMany entry body exit)
+pprGraph _ (GUnit block) = ppr block
+pprGraph _ (GMany entry body exit)
    = text "{"
-  $$ nest 2 (pprMaybeO entry $$ (vcat $ map (pprPlatform platform) $ bodyToBlockList body) $$ pprMaybeO exit)
+  $$ nest 2 (pprMaybeO entry $$ (vcat $ map ppr $ bodyToBlockList body) $$ pprMaybeO exit)
   $$ text "}"
-  where pprMaybeO :: PlatformOutputable (Block CmmNode e x)
+  where pprMaybeO :: Outputable (Block CmmNode e x)
                   => MaybeO ex (Block CmmNode e x) -> SDoc
         pprMaybeO NothingO = empty
-        pprMaybeO (JustO block) = pprPlatform platform block
+        pprMaybeO (JustO block) = ppr block
 
 pprCmmGraph :: Platform -> CmmGraph -> SDoc
-pprCmmGraph platform g
+pprCmmGraph _ g
    = text "{" <> text "offset"
-  $$ nest 2 (vcat $ map (pprPlatform platform) blocks)
+  $$ nest 2 (vcat $ map ppr blocks)
   $$ text "}"
   where blocks = postorderDfs g
 
@@ -154,24 +154,24 @@ pprForeignConvention :: ForeignConvention -> SDoc
 pprForeignConvention (ForeignConvention c as rs) = ppr c <> ppr as <> ppr rs
 
 pprForeignTarget :: Platform -> ForeignTarget -> SDoc
-pprForeignTarget platform (ForeignTarget fn c) = ppr_fc c <+> ppr_target fn
+pprForeignTarget _ (ForeignTarget fn c) = ppr_fc c <+> ppr_target fn
   where ppr_fc :: ForeignConvention -> SDoc
         ppr_fc (ForeignConvention c args res) =
           doubleQuotes (ppr c) <+> text "arg hints: " <+> ppr args <+> text " result hints: " <+> ppr res
         ppr_target :: CmmExpr -> SDoc
-        ppr_target t@(CmmLit _) = pprPlatform platform t
-        ppr_target fn'          = parens (pprPlatform platform fn')
+        ppr_target t@(CmmLit _) = ppr t
+        ppr_target fn'          = parens (ppr fn')
 
-pprForeignTarget platform (PrimTarget op)
+pprForeignTarget _ (PrimTarget op)
  -- HACK: We're just using a ForeignLabel to get this printed, the label
  --       might not really be foreign.
- = pprPlatform platform
+ = ppr
                (CmmLabel (mkForeignLabel
                          (mkFastString (show op))
                          Nothing ForeignLabelInThisPackage IsFunction))
 
 pprNode :: Platform -> CmmNode e x -> SDoc
-pprNode platform node = pp_node <+> pp_debug
+pprNode _ node = pp_node <+> pp_debug
   where
     pp_node :: SDoc
     pp_node = case node of
@@ -182,10 +182,10 @@ pprNode platform node = pp_node <+> pp_debug
       CmmComment s -> text "//" <+> ftext s
 
       -- reg = expr;
-      CmmAssign reg expr -> ppr reg <+> equals <+> pprPlatform platform expr <> semi
+      CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
 
       -- rep[lv] = expr;
-      CmmStore lv expr -> rep <> brackets(pprPlatform platform lv) <+> equals <+> pprPlatform platform expr <> semi
+      CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
           where
             rep = ppr ( cmmExprType expr )
 
@@ -195,7 +195,7 @@ pprNode platform node = pp_node <+> pp_debug
           hsep [ ppUnless (null results) $
                     parens (commafy $ map ppr results) <+> equals,
                  ptext $ sLit "call",
-                 pprPlatform platform target <> parens (commafy $ map (pprPlatform platform) args) <> semi]
+                 ppr target <> parens (commafy $ map ppr args) <> semi]
 
       -- goto label;
       CmmBranch ident -> ptext (sLit "goto") <+> ppr ident <> semi
@@ -203,7 +203,7 @@ pprNode platform node = pp_node <+> pp_debug
       -- if (expr) goto t; else goto f;
       CmmCondBranch expr t f ->
           hsep [ ptext (sLit "if")
-               , parens(pprPlatform platform expr)
+               , parens(ppr expr)
                , ptext (sLit "goto")
                , ppr t <> semi
                , ptext (sLit "else goto")
@@ -215,8 +215,8 @@ pprNode platform node = pp_node <+> pp_debug
                      , int (length maybe_ids - 1)
                      , ptext (sLit "] ")
                      , if isTrivialCmmExpr expr
-                       then pprPlatform platform expr
-                       else parens (pprPlatform platform expr)
+                       then ppr expr
+                       else parens (ppr expr)
                      , ptext (sLit " {")
                      ])
              4 (vcat ( map caseify pairs )) $$ rbrace
@@ -237,15 +237,15 @@ pprNode platform node = pp_node <+> pp_debug
                                                      <+> parens (ppr res)
                , ptext (sLit " with update frame") <+> ppr updfr_off
                , semi ]
-          where pprFun f@(CmmLit _) = pprPlatform platform f
-                pprFun f = parens (pprPlatform platform f)
+          where pprFun f@(CmmLit _) = ppr f
+                pprFun f = parens (ppr f)
 
       CmmForeignCall {tgt=t, res=rs, args=as, succ=s, updfr=u, intrbl=i} ->
           hcat $ if i then [ptext (sLit "interruptible"), space] else [] ++
                [ ptext (sLit "foreign call"), space
-               , pprPlatform platform t, ptext (sLit "(...)"), space
+               , ppr t, ptext (sLit "(...)"), space
                , ptext (sLit "returns to") <+> ppr s
-                    <+> ptext (sLit "args:") <+> parens (pprPlatform platform as)
+                    <+> ptext (sLit "args:") <+> parens (ppr as)
                     <+> ptext (sLit "ress:") <+> parens (ppr rs)
                , ptext (sLit " with update frame") <+> ppr u
                , semi ]
diff --git a/compiler/cmm/PprCmmDecl.hs b/compiler/cmm/PprCmmDecl.hs
index 5c1c6f0b6a..80c5b813ce 100644
--- a/compiler/cmm/PprCmmDecl.hs
+++ b/compiler/cmm/PprCmmDecl.hs
@@ -61,38 +61,36 @@ import SMRep
 #include "../includes/rts/storage/FunTypes.h"
 
 
-pprCmms :: (PlatformOutputable info, PlatformOutputable g)
+pprCmms :: (Outputable info, Outputable g)
         => Platform -> [GenCmmGroup CmmStatics info g] -> SDoc
-pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pprPlatform platform) cmms))
+pprCmms _ cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
         where
           separator = space $$ ptext (sLit "-------------------") $$ space
 
-writeCmms :: (PlatformOutputable info, PlatformOutputable g)
+writeCmms :: (Outputable info, Outputable g)
           => DynFlags -> Handle -> [GenCmmGroup CmmStatics info g] -> IO ()
 writeCmms dflags handle cmms = printForC dflags handle (pprCmms platform cmms)
     where platform = targetPlatform dflags
 
 -----------------------------------------------------------------------------
 
-instance (PlatformOutputable d, PlatformOutputable info, PlatformOutputable i)
-      => PlatformOutputable (GenCmmDecl d info i) where
-    pprPlatform platform t = pprTop platform t
+instance (Outputable d, Outputable info, Outputable i)
+      => Outputable (GenCmmDecl d info i) where
+    ppr t = sdocWithPlatform $ \platform -> pprTop platform t
 
-instance PlatformOutputable CmmStatics where
-    pprPlatform = pprStatics
+instance Outputable CmmStatics where
+    ppr x = sdocWithPlatform $ \platform -> pprStatics platform x
 
-instance PlatformOutputable CmmStatic where
-    pprPlatform = pprStatic
+instance Outputable CmmStatic where
+    ppr x = sdocWithPlatform $ \platform -> pprStatic platform x
 
-instance PlatformOutputable CmmInfoTable where
-    pprPlatform = pprInfoTable
+instance Outputable CmmInfoTable where
+    ppr x = sdocWithPlatform $ \platform -> pprInfoTable platform x
 
 
 -----------------------------------------------------------------------------
 
-pprCmmGroup :: (PlatformOutputable d,
-                PlatformOutputable info,
-                PlatformOutputable g)
+pprCmmGroup :: (Outputable d, Outputable info, Outputable g)
             => Platform -> GenCmmGroup d info g -> SDoc
 pprCmmGroup platform tops
     = vcat $ intersperse blankLine $ map (pprTop platform) tops
@@ -100,14 +98,14 @@ pprCmmGroup platform tops
 -- --------------------------------------------------------------------------
 -- Top level `procedure' blocks.
 --
-pprTop :: (PlatformOutputable d, PlatformOutputable info, PlatformOutputable i)
+pprTop :: (Outputable d, Outputable info, Outputable i)
        => Platform -> GenCmmDecl d info i -> SDoc
 
 pprTop platform (CmmProc info lbl graph)
 
   = vcat [ pprCLabel platform lbl <> lparen <> rparen
-         , nest 8 $ lbrace <+> pprPlatform platform info $$ rbrace
-         , nest 4 $ pprPlatform platform graph
+         , nest 8 $ lbrace <+> ppr info $$ rbrace
+         , nest 4 $ ppr graph
          , rbrace ]
 
 -- --------------------------------------------------------------------------
@@ -115,8 +113,8 @@ pprTop platform (CmmProc info lbl graph)
 --
 --      section "data" { ... }
 --
-pprTop platform (CmmData section ds) =
-    (hang (pprSection section <+> lbrace) 4 (pprPlatform platform ds))
+pprTop _ (CmmData section ds) =
+    (hang (pprSection section <+> lbrace) 4 (ppr ds))
     $$ rbrace
 
 -- --------------------------------------------------------------------------
@@ -125,22 +123,21 @@ pprTop platform (CmmData section ds) =
 pprInfoTable :: Platform -> CmmInfoTable -> SDoc
 pprInfoTable _ CmmNonInfoTable
   = empty
-pprInfoTable platform
+pprInfoTable _
              (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
                            , cit_prof = prof_info
                            , cit_srt = _srt })  
-  = vcat [ ptext (sLit "label:") <+> pprPlatform platform lbl
+  = vcat [ ptext (sLit "label:") <+> ppr lbl
          , ptext (sLit "rep:") <> ppr rep
          , case prof_info of
 	     NoProfilingInfo -> empty
              ProfilingInfo ct cd -> vcat [ ptext (sLit "type:") <+> pprWord8String ct
                                          , ptext (sLit "desc: ") <> pprWord8String cd ] ]
 
-instance PlatformOutputable C_SRT where
-  pprPlatform _ (NoC_SRT) = ptext (sLit "_no_srt_")
-  pprPlatform platform (C_SRT label off bitmap)
-      = parens (pprPlatform platform label <> comma <> ppr off
-                                           <> comma <> text (show bitmap))
+instance Outputable C_SRT where
+  ppr NoC_SRT = ptext (sLit "_no_srt_")
+  ppr (C_SRT label off bitmap)
+      = parens (ppr label <> comma <> ppr off <> comma <> text (show bitmap))
 
 instance Outputable ForeignHint where
   ppr NoHint     = empty
@@ -148,8 +145,6 @@ instance Outputable ForeignHint where
 --  ppr AddrHint   = quotes(text "address")
 -- Temp Jan08
   ppr AddrHint   = (text "PtrHint")
-instance PlatformOutputable ForeignHint where
-    pprPlatform _ = ppr
 
 -- --------------------------------------------------------------------------
 -- Static data.
@@ -157,7 +152,8 @@ instance PlatformOutputable ForeignHint where
 --      following C--
 --
 pprStatics :: Platform -> CmmStatics -> SDoc
-pprStatics platform (Statics lbl ds) = vcat ((pprCLabel platform lbl <> colon) : map (pprPlatform platform) ds)
+pprStatics platform (Statics lbl ds)
+    = vcat ((pprCLabel platform lbl <> colon) : map ppr ds)
 
 pprStatic :: Platform -> CmmStatic -> SDoc
 pprStatic platform s = case s of
diff --git a/compiler/cmm/PprCmmExpr.hs b/compiler/cmm/PprCmmExpr.hs
index 81ce84c264..37d6be97af 100644
--- a/compiler/cmm/PprCmmExpr.hs
+++ b/compiler/cmm/PprCmmExpr.hs
@@ -57,19 +57,17 @@ import Numeric ( fromRat )
 
 -----------------------------------------------------------------------------
 
-instance PlatformOutputable CmmExpr where
-    pprPlatform = pprExpr
+instance Outputable CmmExpr where
+    ppr e = sdocWithPlatform $ \platform -> pprExpr platform e
 
 instance Outputable CmmReg where
     ppr e = pprReg e
 
-instance PlatformOutputable CmmLit where
-    pprPlatform = pprLit
+instance Outputable CmmLit where
+    ppr l = sdocWithPlatform $ \platform -> pprLit platform l
 
 instance Outputable LocalReg where
     ppr e = pprLocalReg e
-instance PlatformOutputable LocalReg where
-    pprPlatform _ = ppr
 
 instance Outputable Area where
     ppr e = pprArea e
@@ -147,7 +145,7 @@ pprExpr9 :: Platform -> CmmExpr -> SDoc
 pprExpr9 platform e =
    case e of
         CmmLit    lit       -> pprLit1 platform lit
-        CmmLoad   expr rep  -> ppr rep <> brackets (pprPlatform platform expr)
+        CmmLoad   expr rep  -> ppr rep <> brackets (ppr expr)
         CmmReg    reg       -> ppr reg
         CmmRegOff  reg off  -> parens (ppr reg <+> char '+' <+> int off)
         CmmStackSlot a off  -> parens (ppr a   <+> char '+' <+> int off)
diff --git a/compiler/codeGen/CgBindery.lhs b/compiler/codeGen/CgBindery.lhs
index 06442dc004..0efc99d370 100644
--- a/compiler/codeGen/CgBindery.lhs
+++ b/compiler/codeGen/CgBindery.lhs
@@ -146,10 +146,10 @@ data StableLoc
                 -- be saved, so it makes sense to treat treat them as
                 -- having a stable location
 
-instance PlatformOutputable CgIdInfo where
-  pprPlatform platform (CgIdInfo id _ vol stb _ _)
+instance Outputable CgIdInfo where
+  ppr (CgIdInfo id _ vol stb _ _)
     -- TODO, pretty pring the tag info
-    = ppr id <+> ptext (sLit "-->") <+> vcat [ppr vol, pprPlatform platform stb]
+    = ppr id <+> ptext (sLit "-->") <+> vcat [ppr vol, ppr stb]
 
 instance Outputable VolatileLoc where
   ppr NoVolatileLoc = empty
@@ -157,12 +157,12 @@ instance Outputable VolatileLoc where
   ppr (VirHpLoc v)   = ptext (sLit "vh")  <+> ppr v
   ppr (VirNodeLoc v) = ptext (sLit "vn")  <+> ppr v
 
-instance PlatformOutputable StableLoc where
-  pprPlatform _        NoStableLoc   = empty
-  pprPlatform _        VoidLoc       = ptext (sLit "void")
-  pprPlatform _        (VirStkLoc v) = ptext (sLit "vs")    <+> ppr v
-  pprPlatform _        (VirStkLNE v) = ptext (sLit "lne")   <+> ppr v
-  pprPlatform platform (StableLoc a) = ptext (sLit "amode") <+> pprPlatform platform a
+instance Outputable StableLoc where
+  ppr NoStableLoc   = empty
+  ppr VoidLoc       = ptext (sLit "void")
+  ppr (VirStkLoc v) = ptext (sLit "vs")    <+> ppr v
+  ppr (VirStkLNE v) = ptext (sLit "lne")   <+> ppr v
+  ppr (StableLoc a) = ptext (sLit "amode") <+> ppr a
 \end{code}
 
 %************************************************************************
diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs
index 9ad8d13b5f..aff5e468ca 100644
--- a/compiler/codeGen/CgCon.lhs
+++ b/compiler/codeGen/CgCon.lhs
@@ -78,7 +78,6 @@ cgTopRhsCon id con args
         ; amodes <- getArgAmodes args
 
         ; let
-            platform = targetPlatform dflags
             name          = idName id
             lf_info       = mkConLFInfo con
             closure_label = mkClosureLabel name $ idCafInfo id
@@ -92,7 +91,7 @@ cgTopRhsCon id con args
 
             payload = map get_lit amodes_w_offsets
             get_lit (CmmLit lit, _offset) = lit
-            get_lit other = pprPanic "CgCon.get_lit" (pprPlatform platform other)
+            get_lit other = pprPanic "CgCon.get_lit" (ppr other)
                 -- NB1: amodes_w_offsets is sorted into ptrs first, then non-ptrs
                 -- NB2: all the amodes should be Lits!
 
diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index 1e80616887..6c77255a62 100644
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -45,7 +45,6 @@ import Unique
 import StaticFlags
 
 import Constants
-import DynFlags
 import Util
 import Outputable
 
@@ -168,8 +167,6 @@ is not present in the list (it is always assumed).
 -}
 mkStackLayout :: FCode [Maybe LocalReg]
 mkStackLayout = do
-  dflags <- getDynFlags
-  let platform = targetPlatform dflags
   StackUsage { realSp = real_sp,
                frameSp = frame_sp } <- getStkUsage
   binds <- getLiveStackBindings
@@ -179,7 +176,7 @@ mkStackLayout = do
                     | (offset, b) <- binds]
 
   WARN( not (all (\bind -> fst bind >= 0) rel_binds),
-        pprPlatform platform binds $$ pprPlatform platform rel_binds $$
+        ppr binds $$ ppr rel_binds $$
         ppr frame_size $$ ppr real_sp $$ ppr frame_sp )
     return $ stack_layout rel_binds frame_size
 
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index c97c3d47cd..87e6d9f9dd 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -151,11 +151,9 @@ direct_call :: String -> CLabel -> RepArity -> [CmmExpr] -> [ArgRep] -> FCode ()
 direct_call caller lbl arity args reps
   | debugIsOn && arity > length reps	-- Too few args
   = do -- Caller should ensure that there enough args!
-       dflags <- getDynFlags
-       let platform = targetPlatform dflags
        pprPanic "direct_call" (text caller <+> ppr arity
-                           <+> pprPlatform platform lbl <+> ppr (length reps)
-                           <+> pprPlatform platform args <+> ppr reps )
+                           <+> ppr lbl <+> ppr (length reps)
+                           <+> ppr args <+> ppr reps )
 
   | null rest_reps     -- Precisely the right number of arguments
   = emitCall (NativeDirectCall, NativeReturn) target args
@@ -177,9 +175,8 @@ direct_call caller lbl arity args reps
 slow_call :: CmmExpr -> [CmmExpr] -> [ArgRep] -> FCode ()
 slow_call fun args reps
   = do dflags <- getDynFlags
-       let platform = targetPlatform dflags
        call <- getCode $ direct_call "slow_call" (mkRtsApFastLabel rts_fun) arity args reps
-       emit $ mkComment $ mkFastString ("slow_call for " ++ showSDoc dflags (pprPlatform platform fun) ++
+       emit $ mkComment $ mkFastString ("slow_call for " ++ showSDoc dflags (ppr fun) ++
                                         " with pat " ++ unpackFS rts_fun)
        emit (mkAssign nodeReg fun <*> call)
   where
diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
index 71457c530c..4eea38e22c 100644
--- a/compiler/codeGen/StgCmmMonad.hs
+++ b/compiler/codeGen/StgCmmMonad.hs
@@ -197,13 +197,13 @@ data CgLoc
 	-- To tail-call it, assign to these locals, 
 	-- and branch to the block id
 
-instance PlatformOutputable CgIdInfo where
-  pprPlatform platform (CgIdInfo { cg_id = id, cg_loc = loc })
-    = ppr id <+> ptext (sLit "-->") <+> pprPlatform platform loc
+instance Outputable CgIdInfo where
+  ppr (CgIdInfo { cg_id = id, cg_loc = loc })
+    = ppr id <+> ptext (sLit "-->") <+> ppr loc
 
-instance PlatformOutputable CgLoc where
-  pprPlatform platform (CmmLoc e)    = ptext (sLit "cmm") <+> pprPlatform platform e
-  pprPlatform _        (LneLoc b rs) = ptext (sLit "lne") <+> ppr b <+> ppr rs
+instance Outputable CgLoc where
+  ppr (CmmLoc e)    = ptext (sLit "cmm") <+> ppr e
+  ppr (LneLoc b rs) = ptext (sLit "lne") <+> ppr b <+> ppr rs
 
 
 -- Sequel tells what to do with the result of this expression
diff --git a/compiler/main/DynFlags.hs-boot b/compiler/main/DynFlags.hs-boot
index 7530192e1a..906e522479 100644
--- a/compiler/main/DynFlags.hs-boot
+++ b/compiler/main/DynFlags.hs-boot
@@ -1,6 +1,11 @@
 
 module DynFlags where
 
+import Platform
+
 data DynFlags
+
 tracingDynFlags :: DynFlags
 
+targetPlatform :: DynFlags -> Platform
+
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 3941588714..5a90f2acdd 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -1284,7 +1284,7 @@ hscGenHardCode cgguts mod_summary = do
         ------------------  Code output -----------------------
         rawcmms <- {-# SCC "cmmToRawCmm" #-}
                    cmmToRawCmm platform cmms
-        dumpIfSet_dyn dflags Opt_D_dump_raw_cmm "Raw Cmm" (pprPlatform platform rawcmms)
+        dumpIfSet_dyn dflags Opt_D_dump_raw_cmm "Raw Cmm" (ppr rawcmms)
         (_stub_h_exists, stub_c_exists)
             <- {-# SCC "codeOutput" #-}
                codeOutput dflags this_mod location foreign_stubs
@@ -1368,7 +1368,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" (pprPlatform platform prog')
+    dumpIfSet_dyn dflags Opt_D_dump_cmmz "Output Cmm" (ppr prog')
     return prog'
 
 myCoreToStg :: DynFlags -> Module -> CoreProgram
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 45d0af0ab9..0574e9246c 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -150,7 +150,7 @@ data NcgImpl statics instr jumpDest = NcgImpl {
 nativeCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmmGroup] -> IO ()
 nativeCodeGen dflags h us cmms
  = let platform = targetPlatform dflags
-       nCG' :: (PlatformOutputable statics, PlatformOutputable instr, Instruction instr) => NcgImpl statics instr jumpDest -> IO ()
+       nCG' :: (Outputable statics, Outputable 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' :: (PlatformOutputable statics, PlatformOutputable instr, Instruction instr)
+nativeCodeGen' :: (Outputable statics, Outputable instr, Instruction instr)
                => DynFlags
                -> NcgImpl statics instr jumpDest
                -> Handle -> UniqSupply -> [RawCmmGroup] -> IO ()
@@ -274,7 +274,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
 
 -- | Do native code generation on all these cmms.
 --
-cmmNativeGens :: (PlatformOutputable statics, PlatformOutputable instr, Instruction instr)
+cmmNativeGens :: (Outputable statics, Outputable instr, Instruction instr)
               => DynFlags
               -> NcgImpl statics instr jumpDest
               -> BufHandle
@@ -316,7 +316,7 @@ cmmNativeGens dflags ncgImpl h us (cmm : cmms) impAcc profAcc count
         count' <- return $! count + 1;
 
         -- force evaulation all this stuff to avoid space leaks
-        {-# SCC "seqString" #-} seqString (showSDoc dflags $ vcat $ map (pprPlatform platform) imports) `seq` return ()
+        {-# SCC "seqString" #-} seqString (showSDoc dflags $ vcat $ map ppr imports) `seq` return ()
 
         cmmNativeGens dflags ncgImpl
             h us' cmms
@@ -332,7 +332,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
-        :: (PlatformOutputable statics, PlatformOutputable instr, Instruction instr)
+        :: (Outputable statics, Outputable instr, Instruction instr)
     => DynFlags
     -> NcgImpl statics instr jumpDest
         -> UniqSupply
@@ -380,7 +380,7 @@ cmmNativeGen dflags ncgImpl us cmm count
 
         dumpIfSet_dyn dflags
                 Opt_D_dump_asm_liveness "Liveness annotations added"
-                (vcat $ map (pprPlatform platform) withLiveness)
+                (vcat $ map ppr withLiveness)
 
         -- allocate registers
         (alloced, usAlloc, ppr_raStatsColor, ppr_raStatsLinear) <-
@@ -414,7 +414,7 @@ cmmNativeGen dflags ncgImpl us cmm count
                         (vcat   $ map (\(stage, stats)
                                         -> text "# --------------------------"
                                         $$ text "#  cmm " <> int count <> text " Stage " <> int stage
-                                        $$ pprPlatform platform stats)
+                                        $$ ppr stats)
                                 $ zip [0..] regAllocStats)
 
                 let mPprStats =
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index 6026abcd5e..9f366b9945 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -134,8 +134,8 @@ pprASCII str
 -- -----------------------------------------------------------------------------
 -- pprInstr: print an 'Instr'
 
-instance PlatformOutputable Instr where
-    pprPlatform platform instr = pprInstr platform instr
+instance Outputable Instr where
+    ppr instr = sdocWithPlatform $ \platform -> pprInstr platform instr
 
 
 pprReg :: Platform -> Reg -> SDoc
diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs
index 0a4dc49881..4e359a1c79 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs
@@ -45,7 +45,7 @@ maxSpinCount    = 10
 
 -- | The top level of the graph coloring register allocator.
 regAlloc
-        :: (PlatformOutputable statics, PlatformOutputable instr, Instruction instr)
+        :: (Outputable statics, Outputable instr, Instruction instr)
         => DynFlags
         -> UniqFM (UniqSet RealReg)     -- ^ the registers we can use for allocation
         -> UniqSet Int                  -- ^ the set of available spill slots.
@@ -73,8 +73,8 @@ regAlloc dflags regsFree slotsFree code
                 , reverse debug_codeGraphs )
 
 regAlloc_spin :: (Instruction instr,
-                  PlatformOutputable instr,
-                  PlatformOutputable statics)
+                  Outputable instr,
+                  Outputable statics)
               => DynFlags
               -> Int
               -> Color.Triv VirtualReg RegClass RealReg
@@ -329,7 +329,7 @@ graphAddCoalesce _ _
 
 -- | Patch registers in code using the reg -> reg mapping in this graph.
 patchRegsFromGraph
-        :: (PlatformOutputable statics, PlatformOutputable instr, Instruction instr)
+        :: (Outputable statics, Outputable instr, Instruction instr)
         => Platform -> Color.Graph VirtualReg RegClass RealReg
         -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
 
@@ -352,7 +352,7 @@ patchRegsFromGraph platform graph code
                 | otherwise
                 = pprPanic "patchRegsFromGraph: register mapping failed."
                         (  text "There is no node in the graph for register " <> ppr reg
-                        $$ pprPlatform platform code
+                        $$ ppr code
                         $$ Color.dotGraph
                                 (\_ -> text "white")
                                 (trivColorable platform
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index 222e222c75..c7b41de912 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -70,12 +70,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 :: (PlatformOutputable instr, Instruction instr)
+slurpSpillCostInfo :: (Outputable instr, Instruction instr)
                    => Platform
                    -> LiveCmmDecl statics instr
                    -> SpillCostInfo
 
-slurpSpillCostInfo platform cmm
+slurpSpillCostInfo _ cmm
 	= execState (countCmm cmm) zeroSpillCostInfo
  where
 	countCmm CmmData{}		= return ()
@@ -104,7 +104,7 @@ slurpSpillCostInfo platform cmm
 
 		| otherwise
 		= pprPanic "RegSpillCost.slurpSpillCostInfo"
-			(text "no liveness information on instruction " <> pprPlatform platform instr)
+			(text "no liveness information on instruction " <> ppr 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 69be2f0ed6..32970336ad 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
@@ -72,12 +72,12 @@ data RegAllocStats statics instr
 	, raFinal	  :: [NatCmmDecl statics instr] 			-- ^ final code
 	, raSRMs	  :: (Int, Int, Int) }				-- ^ spill\/reload\/reg-reg moves present in this code
 
-instance (PlatformOutputable statics, PlatformOutputable instr) => PlatformOutputable (RegAllocStats statics instr) where
+instance (Outputable statics, Outputable instr) => Outputable (RegAllocStats statics instr) where
 
- pprPlatform platform (s@RegAllocStatsStart{})
- 	=  text "#  Start"
+ ppr (s@RegAllocStatsStart{}) = sdocWithPlatform $ \platform ->
+ 	   text "#  Start"
 	$$ text "#  Native code with liveness information."
-	$$ pprPlatform platform (raLiveCmm s)
+	$$ ppr (raLiveCmm s)
 	$$ text ""
 	$$ text "#  Initial register conflict graph."
 	$$ Color.dotGraph 
@@ -88,11 +88,11 @@ instance (PlatformOutputable statics, PlatformOutputable instr) => PlatformOutpu
 		(raGraph s)
 
 
- pprPlatform platform (s@RegAllocStatsSpill{})
- 	=  text "#  Spill"
+ ppr (s@RegAllocStatsSpill{}) =
+ 	   text "#  Spill"
 
 	$$ text "#  Code with liveness information."
-	$$ pprPlatform platform (raCode s)
+	$$ ppr (raCode s)
 	$$ text ""
 
 	$$ (if (not $ isNullUFM $ raCoalesced s)
@@ -106,14 +106,14 @@ instance (PlatformOutputable statics, PlatformOutputable instr) => PlatformOutpu
 	$$ text ""
 
 	$$ text "#  Code with spills inserted."
-	$$ pprPlatform platform (raSpilled s)
+	$$ ppr (raSpilled s)
 
 
- pprPlatform platform (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
- 	=  text "#  Colored"
+ ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) }) = sdocWithPlatform $ \platform ->
+ 	   text "#  Colored"
 
 	$$ text "#  Code with liveness information."
-	$$ pprPlatform platform (raCode s)
+	$$ ppr (raCode s)
 	$$ text ""
 
 	$$ text "#  Register conflict graph (colored)."
@@ -132,19 +132,19 @@ instance (PlatformOutputable statics, PlatformOutputable instr) => PlatformOutpu
 		else empty)
 
 	$$ text "#  Native code after coalescings applied."
-	$$ pprPlatform platform (raCodeCoalesced s)
+	$$ ppr (raCodeCoalesced s)
 	$$ text ""
 
 	$$ text "#  Native code after register allocation."
-	$$ pprPlatform platform (raPatched s)
+	$$ ppr (raPatched s)
 	$$ text ""
 
 	$$ text "#  Clean out unneeded spill/reloads."
-	$$ pprPlatform platform (raSpillClean s)
+	$$ ppr (raSpillClean s)
 	$$ text ""
 
 	$$ text "#  Final code, after rewriting spill/rewrite pseudo instrs."
-	$$ pprPlatform platform (raFinal s)
+	$$ ppr (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 64b0f68eda..8c38fd1de6 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
-        :: (PlatformOutputable instr, Instruction instr)
+        :: (Outputable instr, Instruction instr)
         => DynFlags
         -> LiveCmmDecl statics instr
         -> UniqSM (NatCmmDecl statics instr, Maybe RegAllocStats)
@@ -170,7 +170,7 @@ regAlloc _ (CmmProc _ _ _)
 --   an entry in the block map or it is the first block.
 --
 linearRegAlloc
-        :: (PlatformOutputable instr, Instruction instr)
+        :: (Outputable instr, Instruction instr)
         => DynFlags
         -> BlockId                      -- ^ the first block
         -> BlockMap RegSet              -- ^ live regs on entry to each basic block
@@ -189,7 +189,7 @@ linearRegAlloc dflags first_id block_live sccs
       ArchUnknown   -> panic "linearRegAlloc ArchUnknown"
 
 linearRegAlloc'
-        :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
+        :: (FR freeRegs, Outputable instr, Instruction instr)
         => Platform
         -> freeRegs
         -> BlockId                      -- ^ the first block
@@ -205,7 +205,7 @@ linearRegAlloc' platform initFreeRegs first_id block_live sccs
         return  (blocks, stats)
 
 
-linearRA_SCCs :: (FR freeRegs, Instruction instr, PlatformOutputable instr)
+linearRA_SCCs :: (FR freeRegs, Instruction instr, Outputable instr)
               => Platform
               -> BlockId
               -> BlockMap RegSet
@@ -241,7 +241,7 @@ linearRA_SCCs platform first_id block_live blocksAcc (CyclicSCC blocks : sccs)
    more sanity checking to guard against this eventuality.
 -}
 
-process :: (FR freeRegs, Instruction instr, PlatformOutputable instr)
+process :: (FR freeRegs, Instruction instr, Outputable instr)
         => Platform
         -> BlockId
         -> BlockMap RegSet
@@ -286,7 +286,7 @@ process platform first_id block_live (b@(BasicBlock id _) : blocks)
 -- | Do register allocation on this basic block
 --
 processBlock
-        :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
+        :: (FR freeRegs, Outputable instr, Instruction instr)
         => Platform
         -> BlockMap RegSet              -- ^ live regs on entry to each basic block
         -> LiveBasicBlock instr         -- ^ block to do register allocation on
@@ -321,7 +321,7 @@ initBlock id
 
 -- | Do allocation for a sequence of instructions.
 linearRA
-        :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
+        :: (FR freeRegs, Outputable instr, Instruction instr)
         => Platform
         -> BlockMap RegSet                      -- ^ map of what vregs are live on entry to each block.
         -> [instr]                              -- ^ accumulator for instructions already processed.
@@ -350,7 +350,7 @@ linearRA platform block_live accInstr accFixups id (instr:instrs)
 
 -- | Do allocation for a single instruction.
 raInsn
-        :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
+        :: (FR freeRegs, Outputable instr, Instruction instr)
         => Platform
         -> BlockMap RegSet                      -- ^ map of what vregs are love on entry to each block.
         -> [instr]                              -- ^ accumulator for instructions already processed.
@@ -410,11 +410,11 @@ raInsn platform block_live new_instrs id (LiveInstr (Instr instr) (Just live))
                         (uniqSetToList $ liveDieWrite live)
 
 
-raInsn platform _ _ _ instr
-        = pprPanic "raInsn" (text "no match for:" <> pprPlatform platform instr)
+raInsn _ _ _ _ instr
+        = pprPanic "raInsn" (text "no match for:" <> ppr instr)
 
 
-genRaInsn :: (FR freeRegs, Instruction instr, PlatformOutputable instr)
+genRaInsn :: (FR freeRegs, Instruction instr, Outputable instr)
           => Platform
           -> BlockMap RegSet
           -> [instr]
@@ -554,7 +554,7 @@ releaseRegs regs = do
 
 
 saveClobberedTemps
-        :: (PlatformOutputable instr, Instruction instr)
+        :: (Outputable instr, Instruction instr)
         => Platform
         -> [RealReg]            -- real registers clobbered by this instruction
         -> [Reg]                -- registers which are no longer live after this insn
@@ -647,7 +647,7 @@ data SpillLoc = ReadMem StackSlot  -- reading from register only in memory
 --   the list of free registers and free stack slots.
 
 allocateRegsAndSpill
-        :: (FR freeRegs, PlatformOutputable instr, Instruction instr)
+        :: (FR freeRegs, Outputable instr, Instruction instr)
         => Platform
         -> Bool                 -- True <=> reading (load up spilled regs)
         -> [VirtualReg]         -- don't push these out
@@ -692,7 +692,7 @@ allocateRegsAndSpill platform 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, PlatformOutputable instr)
+allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, Outputable instr)
                         => Platform
                         -> Bool
                         -> [VirtualReg]
@@ -798,7 +798,7 @@ newLocation _ my_reg = InReg my_reg
 
 -- | Load up a spilled temporary if we need to (read from memory).
 loadTemp
-        :: (PlatformOutputable instr, Instruction instr)
+        :: (Outputable instr, Instruction instr)
         => Platform
         -> VirtualReg   -- the temp being loaded
         -> SpillLoc     -- the current location of this temp
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index 0212e8cb16..5ff89e811f 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -171,13 +171,13 @@ type LiveBasicBlock instr
         = GenBasicBlock (LiveInstr instr)
 
 
-instance PlatformOutputable instr
-      => PlatformOutputable (InstrSR instr) where
+instance Outputable instr
+      => Outputable (InstrSR instr) where
 
-        pprPlatform platform (Instr realInstr)
-           = pprPlatform platform realInstr
+        ppr (Instr realInstr)
+           = ppr realInstr
 
-        pprPlatform _ (SPILL reg slot)
+        ppr (SPILL reg slot)
            = hcat [
                 ptext (sLit "\tSPILL"),
                 char ' ',
@@ -185,7 +185,7 @@ instance PlatformOutputable instr
                 comma,
                 ptext (sLit "SLOT") <> parens (int slot)]
 
-        pprPlatform _ (RELOAD slot reg)
+        ppr (RELOAD slot reg)
            = hcat [
                 ptext (sLit "\tRELOAD"),
                 char ' ',
@@ -193,14 +193,14 @@ instance PlatformOutputable instr
                 comma,
                 ppr reg]
 
-instance PlatformOutputable instr
-      => PlatformOutputable (LiveInstr instr) where
+instance Outputable instr
+      => Outputable (LiveInstr instr) where
 
-        pprPlatform platform (LiveInstr instr Nothing)
-         = pprPlatform platform instr
+        ppr (LiveInstr instr Nothing)
+         = ppr instr
 
-        pprPlatform platform (LiveInstr instr (Just live))
-         =  pprPlatform platform instr
+        ppr (LiveInstr instr (Just live))
+         =  ppr instr
                 $$ (nest 8
                         $ vcat
                         [ pprRegs (ptext (sLit "# born:    ")) (liveBorn live)
@@ -213,9 +213,9 @@ instance PlatformOutputable instr
                  | isEmptyUniqSet regs  = empty
                  | otherwise            = name <> (hcat $ punctuate space $ map ppr $ uniqSetToList regs)
 
-instance PlatformOutputable LiveInfo where
-    pprPlatform platform (LiveInfo mb_static firstId liveVRegsOnEntry liveSlotsOnEntry)
-        =  (maybe empty (pprPlatform platform) mb_static)
+instance Outputable LiveInfo where
+    ppr (LiveInfo mb_static firstId liveVRegsOnEntry liveSlotsOnEntry)
+        =  (maybe empty (ppr) mb_static)
         $$ text "# firstId          = " <> ppr firstId
         $$ text "# liveVRegsOnEntry = " <> ppr liveVRegsOnEntry
         $$ text "# liveSlotsOnEntry = " <> text (show liveSlotsOnEntry)
@@ -460,9 +460,7 @@ slurpReloadCoalesce live
 
 -- | Strip away liveness information, yielding NatCmmDecl
 stripLive
-        :: (PlatformOutputable statics,
-            PlatformOutputable instr,
-            Instruction instr)
+        :: (Outputable statics, Outputable instr, Instruction instr)
         => Platform
         -> LiveCmmDecl statics instr
         -> NatCmmDecl statics instr
@@ -470,9 +468,7 @@ stripLive
 stripLive platform live
         = stripCmm live
 
- where  stripCmm :: (PlatformOutputable statics,
-                     PlatformOutputable instr,
-                     Instruction instr)
+ where  stripCmm :: (Outputable statics, Outputable instr, Instruction instr)
                  => LiveCmmDecl statics instr -> NatCmmDecl statics instr
         stripCmm (CmmData sec ds)       = CmmData sec ds
         stripCmm (CmmProc (LiveInfo info (Just first_id) _ _) label sccs)
@@ -493,7 +489,7 @@ stripLive platform 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" (pprPlatform platform proc)
+                 = pprPanic "RegAlloc.Liveness.stripLive: no first_id on proc" (ppr proc)
 
 -- | Strip away liveness information from a basic block,
 --   and make real spill instructions out of SPILL, RELOAD pseudos along the way.
@@ -666,7 +662,7 @@ sccBlocks blocks = stronglyConnCompFromEdgedVertices graph
 -- Annotate code with register liveness information
 --
 regLiveness
-        :: (PlatformOutputable instr, Instruction instr)
+        :: (Outputable instr, Instruction instr)
         => Platform
         -> LiveCmmDecl statics instr
         -> UniqSM (LiveCmmDecl statics instr)
@@ -680,9 +676,9 @@ regLiveness _ (CmmProc info lbl [])
                         (LiveInfo static mFirst (Just mapEmpty) Map.empty)
                         lbl []
 
-regLiveness platform (CmmProc info lbl sccs)
+regLiveness _ (CmmProc info lbl sccs)
         | LiveInfo static mFirst _ liveSlotsOnEntry     <- info
-        = let   (ann_sccs, block_live)  = computeLiveness platform sccs
+        = let   (ann_sccs, block_live)  = computeLiveness sccs
 
           in    returnUs $ CmmProc (LiveInfo static mFirst (Just block_live) liveSlotsOnEntry)
                            lbl ann_sccs
@@ -746,21 +742,20 @@ reverseBlocksInTops top
 --  want for the next pass.
 --
 computeLiveness
-        :: (PlatformOutputable instr, Instruction instr)
-        => Platform
-        -> [SCC (LiveBasicBlock instr)]
+        :: (Outputable instr, Instruction instr)
+        => [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 platform sccs
+computeLiveness 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
-                                        , pprPlatform platform sccs])
+                                        , ppr sccs])
 
 livenessSCCs
        :: Instruction instr
diff --git a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
index f02b7a45a8..74f20196df 100644
--- a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
@@ -26,7 +26,6 @@ import Size
 
 import OldCmm
 
-import DynFlags
 import OrdList
 import Outputable
 
@@ -62,11 +61,9 @@ getCondCode (CmmMachOp mop [x, y])
       MO_U_Lt _   -> condIntCode LU   x y
       MO_U_Le _   -> condIntCode LEU  x y
 
-      _           -> do dflags <- getDynFlags
-                        pprPanic "SPARC.CodeGen.CondCode.getCondCode" (pprPlatform (targetPlatform dflags) (CmmMachOp mop [x,y]))
+      _           -> pprPanic "SPARC.CodeGen.CondCode.getCondCode" (ppr (CmmMachOp mop [x,y]))
 
-getCondCode other = do dflags <- getDynFlags
-                       pprPanic "SPARC.CodeGen.CondCode.getCondCode" (pprPlatform (targetPlatform dflags) other)
+getCondCode other = pprPanic "SPARC.CodeGen.CondCode.getCondCode" (ppr other)
 
 
 
diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
index 5352281296..654875c497 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs
@@ -201,8 +201,7 @@ iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr])
 
 
 iselExpr64 expr
-   = do dflags <- getDynFlags
-        pprPanic "iselExpr64(sparc)" (pprPlatform (targetPlatform dflags) expr)
+   = pprPanic "iselExpr64(sparc)" (ppr expr)
 
 
 
diff --git a/compiler/nativeGen/SPARC/CodeGen/Sanity.hs b/compiler/nativeGen/SPARC/CodeGen/Sanity.hs
index 78dbb1b493..3eea016124 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Sanity.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Sanity.hs
@@ -32,7 +32,7 @@ checkBlock :: Platform
            -> NatBasicBlock Instr
            -> NatBasicBlock Instr
 
-checkBlock platform cmm block@(BasicBlock _ instrs)
+checkBlock _ cmm block@(BasicBlock _ instrs)
 	| checkBlockInstrs instrs
 	= block
 	
@@ -40,9 +40,9 @@ checkBlock platform cmm block@(BasicBlock _ instrs)
 	= pprPanic 
 		("SPARC.CodeGen: bad block\n")
 		( vcat	[ text " -- cmm -----------------\n"
-			, pprPlatform platform cmm
+			, ppr cmm
 			, text " -- native code ---------\n"
-			, pprPlatform platform block ])
+			, ppr block ])
 
 
 checkBlockInstrs :: [Instr] -> Bool
diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs
index 4d01b1f48c..7fe1975f9d 100644
--- a/compiler/nativeGen/SPARC/Ppr.hs
+++ b/compiler/nativeGen/SPARC/Ppr.hs
@@ -136,8 +136,8 @@ pprASCII str
 -- -----------------------------------------------------------------------------
 -- pprInstr: print an 'Instr'
 
-instance PlatformOutputable Instr where
-    pprPlatform platform instr = pprInstr platform instr
+instance Outputable Instr where
+    ppr instr = sdocWithPlatform $ \platform -> pprInstr platform instr
 
 
 -- | Pretty print a register.
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 4fa42820ca..68f8adf250 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -401,8 +401,7 @@ iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr]) = do
             )
 
 iselExpr64 expr
-   = do dflags <- getDynFlags
-        pprPanic "iselExpr64(i386)" (pprPlatform (targetPlatform dflags) expr)
+   = pprPanic "iselExpr64(i386)" (ppr expr)
 
 
 --------------------------------------------------------------------------------
@@ -888,8 +887,7 @@ getRegister' _ (CmmLit lit)
     in
         return (Any size code)
 
-getRegister' _ other = do dflags <- getDynFlags
-                          pprPanic "getRegister(x86)" (pprPlatform (targetPlatform dflags) other)
+getRegister' _ other = pprPanic "getRegister(x86)" (ppr other)
 
 
 intLoadCode :: (Operand -> Operand -> Instr) -> CmmExpr
@@ -1229,11 +1227,9 @@ getCondCode (CmmMachOp mop [x, y])
       MO_U_Lt _ -> condIntCode LU  x y
       MO_U_Le _ -> condIntCode LEU x y
 
-      _other -> do dflags <- getDynFlags
-                   pprPanic "getCondCode(x86,x86_64,sparc)" (pprPlatform (targetPlatform dflags) (CmmMachOp mop [x,y]))
+      _other -> pprPanic "getCondCode(x86,x86_64,sparc)" (ppr (CmmMachOp mop [x,y]))
 
-getCondCode other = do dflags <- getDynFlags
-                       pprPanic "getCondCode(2)(x86,sparc)" (pprPlatform (targetPlatform dflags) other)
+getCondCode other = pprPanic "getCondCode(2)(x86,sparc)" (ppr other)
 
 
 
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index 36593b3229..02f8efddae 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -158,8 +158,8 @@ pprAlign platform bytes
 -- -----------------------------------------------------------------------------
 -- pprInstr: print an 'Instr'
 
-instance PlatformOutputable Instr where
-    pprPlatform platform instr = pprInstr platform instr
+instance Outputable Instr where
+    ppr instr = sdocWithPlatform $ \platform -> pprInstr platform instr
 
 
 pprReg :: Platform -> Size -> Reg -> SDoc
diff --git a/compiler/profiling/ProfInit.hs b/compiler/profiling/ProfInit.hs
index fa99a752d1..6934a079b5 100644
--- a/compiler/profiling/ProfInit.hs
+++ b/compiler/profiling/ProfInit.hs
@@ -23,7 +23,7 @@ import Module
 -- module;
 
 profilingInitCode :: Platform -> Module -> CollectedCCs -> SDoc
-profilingInitCode platform this_mod (local_CCs, ___extern_CCs, singleton_CCSs)
+profilingInitCode _ this_mod (local_CCs, ___extern_CCs, singleton_CCSs)
  | not opt_SccProfilingOn = empty
  | otherwise
  = vcat
@@ -39,8 +39,8 @@ profilingInitCode platform this_mod (local_CCs, ___extern_CCs, singleton_CCSs)
    emitRegisterCC cc   =
       ptext (sLit "extern CostCentre ") <> cc_lbl <> ptext (sLit "[];") $$
       ptext (sLit "REGISTER_CC(") <> cc_lbl <> char ')' <> semi
-     where cc_lbl = pprPlatform platform (mkCCLabel cc)
+     where cc_lbl = ppr (mkCCLabel cc)
    emitRegisterCCS ccs =
       ptext (sLit "extern CostCentreStack ") <> ccs_lbl <> ptext (sLit "[];") $$
       ptext (sLit "REGISTER_CCS(") <> ccs_lbl <> char ')' <> semi
-     where ccs_lbl = pprPlatform platform (mkCCSLabel ccs)
+     where ccs_lbl = ppr (mkCCSLabel ccs)
diff --git a/compiler/utils/Digraph.lhs b/compiler/utils/Digraph.lhs
index a2b40152f3..f7bdff2612 100644
--- a/compiler/utils/Digraph.lhs
+++ b/compiler/utils/Digraph.lhs
@@ -240,9 +240,6 @@ 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 696d803208..7774405583 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -13,7 +13,6 @@
 module Outputable (
         -- * Type classes
         Outputable(..), OutputableBndr(..),
-        PlatformOutputable(..),
 
         -- * Pretty printing combinators
         SDoc, runSDoc, initSDocContext,
@@ -57,6 +56,7 @@ module Outputable (
 
         PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify, neverQualify,
         QualifyName(..),
+        sdocWithDynFlags, sdocWithPlatform,
         getPprStyle, withPprStyle, withPprStyleDoc,
         pprDeeper, pprDeeperList, pprSetDepth,
         codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
@@ -71,16 +71,16 @@ module Outputable (
         pprDebugAndThen,
     ) where
 
-import {-# SOURCE #-}   DynFlags( DynFlags, tracingDynFlags )
+import {-# SOURCE #-}   DynFlags( DynFlags, tracingDynFlags, targetPlatform )
 import {-# SOURCE #-}   Module( Module, ModuleName, moduleName )
 import {-# SOURCE #-}   Name( Name, nameModule )
 
 import StaticFlags
 import FastString
 import FastTypes
-import Platform
 import qualified Pretty
 import Util
+import Platform
 import Pretty           ( Doc, Mode(..) )
 import Panic
 
@@ -283,6 +283,12 @@ pprSetDepth depth doc = SDoc $ \ctx ->
 
 getPprStyle :: (PprStyle -> SDoc) -> SDoc
 getPprStyle df = SDoc $ \ctx -> runSDoc (df (sdocStyle ctx)) ctx
+
+sdocWithDynFlags :: (DynFlags -> SDoc) -> SDoc
+sdocWithDynFlags f = SDoc $ \ctx -> runSDoc (f (sdocDynFlags ctx)) ctx
+
+sdocWithPlatform :: (Platform -> SDoc) -> SDoc
+sdocWithPlatform f = sdocWithDynFlags (f . targetPlatform)
 \end{code}
 
 \begin{code}
@@ -599,13 +605,6 @@ 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}
@@ -615,8 +614,6 @@ instance Outputable Bool where
 
 instance Outputable Int where
    ppr n = int n
-instance PlatformOutputable Int where
-   pprPlatform _ = ppr
 
 instance Outputable Word16 where
    ppr n = integer $ fromIntegral n
@@ -629,29 +626,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 (Set a) where
     ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s))))
 
 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")
   ppr (Just x) = ptext (sLit "Just") <+> ppr x
-instance PlatformOutputable a => PlatformOutputable (Maybe a) where
-  pprPlatform _        Nothing  = ptext (sLit "Nothing")
-  pprPlatform platform (Just x) = ptext (sLit "Just") <+> pprPlatform platform x
 
 instance (Outputable a, Outputable b) => Outputable (Either a b) where
   ppr (Left x)  = ptext (sLit "Left")  <+> ppr x
@@ -708,8 +695,6 @@ 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}