Generalize OutputableP

Add a type parameter for the environment required by OutputableP. It
avoids tying Platform with OutputableP.

19 files changed, 182 insertions, 111 deletions

diff --git a/compiler/GHC/Cmm.hs b/compiler/GHC/Cmm.hs
index a5b3b35b8b..5c4c619b69 100644
--- a/compiler/GHC/Cmm.hs
+++ b/compiler/GHC/Cmm.hs
@@ -4,6 +4,9 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE ExplicitNamespaces #-}
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+
 
 module GHC.Cmm (
      -- * Cmm top-level datatypes
@@ -266,15 +269,15 @@ newtype ListGraph i
 instance Outputable instr => Outputable (ListGraph instr) where
     ppr (ListGraph blocks) = vcat (map ppr blocks)
 
-instance OutputableP instr => OutputableP (ListGraph instr) where
-    pdoc platform g = ppr (fmap (pdoc platform) g)
+instance OutputableP env instr => OutputableP env (ListGraph instr) where
+    pdoc env g = ppr (fmap (pdoc env) g)
 
 
 instance Outputable instr => Outputable (GenBasicBlock instr) where
     ppr = pprBBlock
 
-instance OutputableP instr => OutputableP (GenBasicBlock instr) where
-    pdoc platform block = ppr (fmap (pdoc platform) block)
+instance OutputableP env instr => OutputableP env (GenBasicBlock instr) where
+    pdoc env block = ppr (fmap (pdoc env) block)
 
 pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
 pprBBlock (BasicBlock ident stmts) =
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index 924991794f..370e727930 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -9,6 +9,9 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+
 
 module GHC.Cmm.CLabel (
         CLabel, -- abstract type
@@ -1210,7 +1213,7 @@ The info table label and the local block label are both local labels
 and are not externally visible.
 -}
 
-instance OutputableP CLabel where
+instance OutputableP Platform CLabel where
   pdoc platform lbl = sdocWithDynFlags (\dflags -> pprCLabel (backend dflags) platform lbl)
 
 pprCLabel :: Backend -> Platform -> CLabel -> SDoc
diff --git a/compiler/GHC/Cmm/Dataflow/Label.hs b/compiler/GHC/Cmm/Dataflow/Label.hs
index e01f301627..148fc15ede 100644
--- a/compiler/GHC/Cmm/Dataflow/Label.hs
+++ b/compiler/GHC/Cmm/Dataflow/Label.hs
@@ -3,6 +3,9 @@
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+
 
 module GHC.Cmm.Dataflow.Label
     ( Label
@@ -43,7 +46,7 @@ instance Uniquable Label where
 instance Outputable Label where
   ppr label = ppr (getUnique label)
 
-instance OutputableP Label where
+instance OutputableP env Label where
   pdoc _ l = ppr l
 
 -----------------------------------------------------------------------------
@@ -131,8 +134,8 @@ instance Outputable LabelSet where
 instance Outputable a => Outputable (LabelMap a) where
   ppr = ppr . mapToList
 
-instance OutputableP a => OutputableP (LabelMap a) where
-  pdoc platform = pdoc platform . mapToList
+instance OutputableP env a => OutputableP env (LabelMap a) where
+  pdoc env = pdoc env . mapToList
 
 instance TrieMap LabelMap where
   type Key LabelMap = Label
diff --git a/compiler/GHC/Cmm/DebugBlock.hs b/compiler/GHC/Cmm/DebugBlock.hs
index 927003b16f..d5410b9b6a 100644
--- a/compiler/GHC/Cmm/DebugBlock.hs
+++ b/compiler/GHC/Cmm/DebugBlock.hs
@@ -1,6 +1,11 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
+
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
@@ -72,20 +77,20 @@ data DebugBlock =
   , dblBlocks     :: ![DebugBlock] -- ^ Nested blocks
   }
 
-instance OutputableP DebugBlock where
-  pdoc platform blk =
+instance OutputableP env CLabel => OutputableP env DebugBlock where
+  pdoc env blk =
             (if | dblProcedure blk == dblLabel blk
                 -> text "proc"
                 | dblHasInfoTbl blk
                 -> text "pp-blk"
                 | otherwise
                 -> text "blk") <+>
-            ppr (dblLabel blk) <+> parens (pdoc platform (dblCLabel blk)) <+>
+            ppr (dblLabel blk) <+> parens (pdoc env (dblCLabel blk)) <+>
             (maybe empty ppr (dblSourceTick blk)) <+>
             (maybe (text "removed") ((text "pos " <>) . ppr)
                    (dblPosition blk)) <+>
-            (pdoc platform (dblUnwind blk)) $+$
-            (if null (dblBlocks blk) then empty else nest 4 (pdoc platform (dblBlocks blk)))
+            (pdoc env (dblUnwind blk)) $+$
+            (if null (dblBlocks blk) then empty else nest 4 (pdoc env (dblBlocks blk)))
 
 -- | Intermediate data structure holding debug-relevant context information
 -- about a block.
@@ -490,12 +495,12 @@ LOC this information will end up in is Y.
 -- | A label associated with an 'UnwindTable'
 data UnwindPoint = UnwindPoint !CLabel !UnwindTable
 
-instance OutputableP UnwindPoint where
-  pdoc platform (UnwindPoint lbl uws) =
-      braces $ pdoc platform lbl <> colon
+instance OutputableP env CLabel => OutputableP env UnwindPoint where
+  pdoc env (UnwindPoint lbl uws) =
+      braces $ pdoc env lbl <> colon
       <+> hsep (punctuate comma $ map pprUw $ Map.toList uws)
     where
-      pprUw (g, expr) = ppr g <> char '=' <> pdoc platform expr
+      pprUw (g, expr) = ppr g <> char '=' <> pdoc env expr
 
 -- | Maps registers to expressions that yield their "old" values
 -- further up the stack. Most interesting for the stack pointer @Sp@,
@@ -514,19 +519,19 @@ data UnwindExpr = UwConst !Int                  -- ^ literal value
                 | UwTimes UnwindExpr UnwindExpr
                 deriving (Eq)
 
-instance OutputableP UnwindExpr where
-  pdocPrec _ _        (UwConst i)     = ppr i
-  pdocPrec _ _        (UwReg g 0)     = ppr g
-  pdocPrec p platform (UwReg g x)     = pdocPrec p platform (UwPlus (UwReg g 0) (UwConst x))
-  pdocPrec _ platform (UwDeref e)     = char '*' <> pdocPrec 3 platform e
-  pdocPrec _ platform (UwLabel l)     = pdocPrec 3 platform l
-  pdocPrec p platform (UwPlus e0 e1)  | p <= 0
-                                      = pdocPrec 0 platform e0 <> char '+' <> pdocPrec 0 platform e1
-  pdocPrec p platform (UwMinus e0 e1) | p <= 0
-                                      = pdocPrec 1 platform e0 <> char '-' <> pdocPrec 1 platform e1
-  pdocPrec p platform (UwTimes e0 e1) | p <= 1
-                                      = pdocPrec 2 platform e0 <> char '*' <> pdocPrec 2 platform e1
-  pdocPrec _ platform other           = parens (pdocPrec 0 platform other)
+instance OutputableP env CLabel => OutputableP env UnwindExpr where
+  pdocPrec _ _   (UwConst i)     = ppr i
+  pdocPrec _ _   (UwReg g 0)     = ppr g
+  pdocPrec p env (UwReg g x)     = pdocPrec p env (UwPlus (UwReg g 0) (UwConst x))
+  pdocPrec _ env (UwDeref e)     = char '*' <> pdocPrec 3 env e
+  pdocPrec _ env (UwLabel l)     = pdocPrec 3 env l
+  pdocPrec p env (UwPlus e0 e1)  | p <= 0
+                                      = pdocPrec 0 env e0 <> char '+' <> pdocPrec 0 env e1
+  pdocPrec p env (UwMinus e0 e1) | p <= 0
+                                      = pdocPrec 1 env e0 <> char '-' <> pdocPrec 1 env e1
+  pdocPrec p env (UwTimes e0 e1) | p <= 1
+                                      = pdocPrec 2 env e0 <> char '*' <> pdocPrec 2 env e1
+  pdocPrec _ env other           = parens (pdocPrec 0 env other)
 
 -- | Conversion of Cmm expressions to unwind expressions. We check for
 -- unsupported operator usages and simplify the expression as far as
diff --git a/compiler/GHC/Cmm/Info/Build.hs b/compiler/GHC/Cmm/Info/Build.hs
index 0497f18937..b2078ae462 100644
--- a/compiler/GHC/Cmm/Info/Build.hs
+++ b/compiler/GHC/Cmm/Info/Build.hs
@@ -1,6 +1,13 @@
 {-# LANGUAGE GADTs, BangPatterns, RecordWildCards,
     GeneralizedNewtypeDeriving, NondecreasingIndentation, TupleSections,
     ScopedTypeVariables, OverloadedStrings, LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
+
 
 module GHC.Cmm.Info.Build
   ( CAFSet, CAFEnv, cafAnal, cafAnalData
@@ -455,7 +462,9 @@ non-CAFFY.
 -- map them to SRTEntry later, which ranges over labels that do exist.
 --
 newtype CAFLabel = CAFLabel CLabel
-  deriving (Eq,Ord,OutputableP)
+  deriving (Eq,Ord)
+
+deriving newtype instance OutputableP env CLabel => OutputableP env CAFLabel
 
 type CAFSet = Set CAFLabel
 type CAFEnv = LabelMap CAFSet
@@ -466,7 +475,10 @@ mkCAFLabel platform lbl = CAFLabel (toClosureLbl platform lbl)
 -- This is a label that we can put in an SRT.  It *must* be a closure label,
 -- pointing to either a FUN_STATIC, THUNK_STATIC, or CONSTR.
 newtype SRTEntry = SRTEntry CLabel
-  deriving (Eq, Ord, OutputableP)
+  deriving (Eq, Ord)
+
+deriving newtype instance OutputableP env CLabel => OutputableP env SRTEntry
+
 
 -- ---------------------------------------------------------------------
 -- CAF analysis
@@ -597,12 +609,12 @@ data ModuleSRTInfo = ModuleSRTInfo
   , moduleSRTMap :: SRTMap
   }
 
-instance OutputableP ModuleSRTInfo where
-  pdoc platform ModuleSRTInfo{..} =
+instance OutputableP env CLabel => OutputableP env ModuleSRTInfo where
+  pdoc env ModuleSRTInfo{..} =
     text "ModuleSRTInfo {" $$
-      (nest 4 $ text "dedupSRTs ="    <+> pdoc platform dedupSRTs $$
-                text "flatSRTs ="     <+> pdoc platform flatSRTs $$
-                text "moduleSRTMap =" <+> pdoc platform moduleSRTMap) $$ char '}'
+      (nest 4 $ text "dedupSRTs ="    <+> pdoc env dedupSRTs $$
+                text "flatSRTs ="     <+> pdoc env flatSRTs $$
+                text "moduleSRTMap =" <+> pdoc env moduleSRTMap) $$ char '}'
 
 emptySRT :: Module -> ModuleSRTInfo
 emptySRT mod =
@@ -635,10 +647,10 @@ data SomeLabel
   | DeclLabel CLabel
   deriving (Eq, Ord)
 
-instance OutputableP SomeLabel where
-   pdoc platform = \case
-      BlockLabel l -> text "b:" <+> pdoc platform l
-      DeclLabel l  -> text "s:" <+> pdoc platform l
+instance OutputableP env CLabel => OutputableP env SomeLabel where
+   pdoc env = \case
+      BlockLabel l -> text "b:" <+> pdoc env l
+      DeclLabel l  -> text "s:" <+> pdoc env l
 
 getBlockLabel :: SomeLabel -> Maybe Label
 getBlockLabel (BlockLabel l) = Just l
diff --git a/compiler/GHC/Cmm/Lint.hs b/compiler/GHC/Cmm/Lint.hs
index da9ff30d85..2fd19ec507 100644
--- a/compiler/GHC/Cmm/Lint.hs
+++ b/compiler/GHC/Cmm/Lint.hs
@@ -37,14 +37,14 @@ import Control.Monad (ap, unless)
 -- -----------------------------------------------------------------------------
 -- Exported entry points:
 
-cmmLint :: (OutputableP d, OutputableP h)
+cmmLint :: (OutputableP Platform d, OutputableP Platform h)
         => Platform -> GenCmmGroup d h CmmGraph -> Maybe SDoc
 cmmLint platform tops = runCmmLint platform (mapM_ lintCmmDecl) tops
 
 cmmLintGraph :: Platform -> CmmGraph -> Maybe SDoc
 cmmLintGraph platform g = runCmmLint platform lintCmmGraph g
 
-runCmmLint :: OutputableP a => Platform -> (a -> CmmLint b) -> a -> Maybe SDoc
+runCmmLint :: OutputableP Platform a => Platform -> (a -> CmmLint b) -> a -> Maybe SDoc
 runCmmLint platform l p =
    case unCL (l p) platform of
      Left err -> Just (vcat [text "Cmm lint error:",
@@ -224,7 +224,7 @@ lintTarget (PrimTarget {})     = return ()
 -- | As noted in Note [Register parameter passing], the arguments and
 -- 'ForeignTarget' of a foreign call mustn't mention
 -- caller-saved registers.
-mayNotMentionCallerSavedRegs :: (UserOfRegs GlobalReg a, OutputableP a)
+mayNotMentionCallerSavedRegs :: (UserOfRegs GlobalReg a, OutputableP Platform a)
                              => SDoc -> a -> CmmLint ()
 mayNotMentionCallerSavedRegs what thing = do
     platform <- getPlatform
diff --git a/compiler/GHC/Cmm/Ppr.hs b/compiler/GHC/Cmm/Ppr.hs
index b791b78d70..479dee7430 100644
--- a/compiler/GHC/Cmm/Ppr.hs
+++ b/compiler/GHC/Cmm/Ppr.hs
@@ -1,5 +1,10 @@
-{-# LANGUAGE GADTs, TypeFamilies, FlexibleContexts, FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
+
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 ----------------------------------------------------------------------------
@@ -63,11 +68,11 @@ import GHC.Cmm.Dataflow.Graph
 instance Outputable CmmStackInfo where
     ppr = pprStackInfo
 
-instance OutputableP CmmTopInfo where
+instance OutputableP Platform CmmTopInfo where
     pdoc = pprTopInfo
 
 
-instance OutputableP (CmmNode e x) where
+instance OutputableP Platform (CmmNode e x) where
     pdoc = pprNode
 
 instance Outputable Convention where
@@ -76,25 +81,25 @@ instance Outputable Convention where
 instance Outputable ForeignConvention where
     ppr = pprForeignConvention
 
-instance OutputableP ForeignTarget where
+instance OutputableP Platform ForeignTarget where
     pdoc = pprForeignTarget
 
 instance Outputable CmmReturnInfo where
     ppr = pprReturnInfo
 
-instance OutputableP (Block CmmNode C C) where
+instance OutputableP Platform (Block CmmNode C C) where
     pdoc = pprBlock
-instance OutputableP (Block CmmNode C O) where
+instance OutputableP Platform (Block CmmNode C O) where
     pdoc = pprBlock
-instance OutputableP (Block CmmNode O C) where
+instance OutputableP Platform (Block CmmNode O C) where
     pdoc = pprBlock
-instance OutputableP (Block CmmNode O O) where
+instance OutputableP Platform (Block CmmNode O O) where
     pdoc = pprBlock
 
-instance OutputableP (Graph CmmNode e x) where
+instance OutputableP Platform (Graph CmmNode e x) where
     pdoc = pprGraph
 
-instance OutputableP CmmGraph where
+instance OutputableP Platform CmmGraph where
     pdoc = pprCmmGraph
 
 ----------------------------------------------------------
@@ -130,7 +135,7 @@ pprGraph platform = \case
          text "{"
       $$ nest 2 (pprMaybeO entry $$ (vcat $ map (pdoc platform) $ bodyToBlockList body) $$ pprMaybeO exit)
       $$ text "}"
-      where pprMaybeO :: OutputableP (Block CmmNode e x)
+      where pprMaybeO :: OutputableP Platform (Block CmmNode e x)
                       => MaybeO ex (Block CmmNode e x) -> SDoc
             pprMaybeO NothingO = empty
             pprMaybeO (JustO block) = pdoc platform block
diff --git a/compiler/GHC/Cmm/Ppr/Decl.hs b/compiler/GHC/Cmm/Ppr/Decl.hs
index b65cb9bd0b..c2e46c6e16 100644
--- a/compiler/GHC/Cmm/Ppr/Decl.hs
+++ b/compiler/GHC/Cmm/Ppr/Decl.hs
@@ -1,4 +1,8 @@
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+
 
 ----------------------------------------------------------------------------
 --
@@ -54,7 +58,7 @@ import Data.List
 import qualified Data.ByteString as BS
 
 
-pprCmms :: (OutputableP info, OutputableP g)
+pprCmms :: (OutputableP Platform info, OutputableP Platform g)
         => Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc
 pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pdoc platform) cmms))
         where
@@ -62,23 +66,23 @@ pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pdoc
 
 -----------------------------------------------------------------------------
 
-instance (OutputableP d, OutputableP info, OutputableP i)
-      => OutputableP (GenCmmDecl d info i) where
+instance (OutputableP Platform d, OutputableP Platform info, OutputableP Platform i)
+      => OutputableP Platform (GenCmmDecl d info i) where
     pdoc = pprTop
 
-instance OutputableP (GenCmmStatics a) where
+instance OutputableP Platform (GenCmmStatics a) where
     pdoc = pprStatics
 
-instance OutputableP CmmStatic where
+instance OutputableP Platform CmmStatic where
     pdoc = pprStatic
 
-instance OutputableP CmmInfoTable where
+instance OutputableP Platform CmmInfoTable where
     pdoc = pprInfoTable
 
 
 -----------------------------------------------------------------------------
 
-pprCmmGroup :: (OutputableP d, OutputableP info, OutputableP g)
+pprCmmGroup :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform g)
             => Platform -> GenCmmGroup d info g -> SDoc
 pprCmmGroup platform tops
     = vcat $ intersperse blankLine $ map (pprTop platform) tops
@@ -86,7 +90,7 @@ pprCmmGroup platform tops
 -- --------------------------------------------------------------------------
 -- Top level `procedure' blocks.
 --
-pprTop :: (OutputableP d, OutputableP info, OutputableP i)
+pprTop :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform i)
        => Platform -> GenCmmDecl d info i -> SDoc
 
 pprTop platform (CmmProc info lbl live graph)
diff --git a/compiler/GHC/Cmm/Ppr/Expr.hs b/compiler/GHC/Cmm/Ppr/Expr.hs
index 5b1d01b00a..c656c98522 100644
--- a/compiler/GHC/Cmm/Ppr/Expr.hs
+++ b/compiler/GHC/Cmm/Ppr/Expr.hs
@@ -32,6 +32,9 @@
 -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
 --
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module GHC.Cmm.Ppr.Expr
@@ -53,13 +56,13 @@ import Numeric ( fromRat )
 
 -----------------------------------------------------------------------------
 
-instance OutputableP CmmExpr where
+instance OutputableP Platform CmmExpr where
     pdoc = pprExpr
 
 instance Outputable CmmReg where
     ppr e = pprReg e
 
-instance OutputableP CmmLit where
+instance OutputableP Platform CmmLit where
     pdoc = pprLit
 
 instance Outputable LocalReg where
@@ -71,7 +74,7 @@ instance Outputable Area where
 instance Outputable GlobalReg where
     ppr e = pprGlobalReg e
 
-instance OutputableP GlobalReg where
+instance OutputableP env GlobalReg where
     pdoc _ = ppr
 
 -- --------------------------------------------------------------------------
diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index 108df2b600..6c142ed9d8 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -7,6 +7,10 @@
 
 {-# LANGUAGE BangPatterns, CPP, GADTs, ScopedTypeVariables, PatternSynonyms,
     DeriveFunctor #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+
 
 #if !defined(GHC_LOADED_INTO_GHCI)
 {-# LANGUAGE UnboxedTuples #-}
@@ -150,7 +154,7 @@ nativeCodeGen :: forall a . DynFlags -> Module -> ModLocation -> Handle -> UniqS
 nativeCodeGen dflags this_mod modLoc h us cmms
  = let config   = initNCGConfig dflags
        platform = ncgPlatform config
-       nCG' :: ( OutputableP statics, Outputable jumpDest, Instruction instr)
+       nCG' :: ( OutputableP Platform statics, Outputable jumpDest, Instruction instr)
             => NcgImpl statics instr jumpDest -> IO a
        nCG' ncgImpl = nativeCodeGen' dflags config this_mod modLoc ncgImpl h us cmms
    in case platformArch platform of
@@ -214,7 +218,7 @@ unwinding table).
 See also Note [What is this unwinding business?] in "GHC.Cmm.DebugBlock".
 -}
 
-nativeCodeGen' :: (OutputableP statics, Outputable jumpDest, Instruction instr)
+nativeCodeGen' :: (OutputableP Platform statics, Outputable jumpDest, Instruction instr)
                => DynFlags
                -> NCGConfig
                -> Module -> ModLocation
@@ -293,7 +297,7 @@ finishNativeGen dflags config modLoc bufh@(BufHandle _ _ h) us ngs
                    (dumpOptionsFromFlag Opt_D_dump_asm_stats) "NCG stats"
                    FormatText
 
-cmmNativeGenStream :: (OutputableP statics, Outputable jumpDest, Instruction instr)
+cmmNativeGenStream :: (OutputableP Platform statics, Outputable jumpDest, Instruction instr)
               => DynFlags
               -> NCGConfig
               -> Module -> ModLocation
@@ -349,7 +353,7 @@ cmmNativeGenStream dflags config this_mod modLoc ncgImpl h us cmm_stream ngs
 -- | Do native code generation on all these cmms.
 --
 cmmNativeGens :: forall statics instr jumpDest.
-                 (OutputableP statics, Outputable jumpDest, Instruction instr)
+                 (OutputableP Platform statics, Outputable jumpDest, Instruction instr)
               => DynFlags
               -> NCGConfig
               -> Module -> ModLocation
@@ -427,7 +431,7 @@ emitNativeCode dflags config h sdoc = do
 --      Dumping the output of each stage along the way.
 --      Global conflict graph and NGC stats
 cmmNativeGen
-    :: forall statics instr jumpDest. (Instruction instr, OutputableP statics, Outputable jumpDest)
+    :: forall statics instr jumpDest. (Instruction instr, OutputableP Platform statics, Outputable jumpDest)
     => DynFlags
     -> Module -> ModLocation
     -> NcgImpl statics instr jumpDest
diff --git a/compiler/GHC/CmmToAsm/Dwarf/Types.hs b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
index e0d2549dc9..c4748b00cd 100644
--- a/compiler/GHC/CmmToAsm/Dwarf/Types.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
@@ -1,3 +1,8 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
+
 module GHC.CmmToAsm.Dwarf.Types
   ( -- * Dwarf information
     DwarfInfo(..)
@@ -286,8 +291,8 @@ data DwarfFrameBlock
       -- in the block
     }
 
-instance OutputableP DwarfFrameBlock where
-  pdoc platform (DwarfFrameBlock hasInfo unwinds) = braces $ ppr hasInfo <+> pdoc platform unwinds
+instance OutputableP env CLabel => OutputableP env DwarfFrameBlock where
+  pdoc env (DwarfFrameBlock hasInfo unwinds) = braces $ ppr hasInfo <+> pdoc env unwinds
 
 -- | Header for the @.debug_frame@ section. Here we emit the "Common
 -- Information Entry" record that establishes general call frame
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph.hs b/compiler/GHC/CmmToAsm/Reg/Graph.hs
index 0207487f20..b8b1e48efb 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph.hs
@@ -1,5 +1,9 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+
 
 -- | Graph coloring register allocator.
 module GHC.CmmToAsm.Reg.Graph (
@@ -46,7 +50,7 @@ maxSpinCount    = 10
 
 -- | The top level of the graph coloring register allocator.
 regAlloc
-        :: (OutputableP statics, Instruction instr)
+        :: (OutputableP Platform statics, Instruction instr)
         => NCGConfig
         -> UniqFM RegClass (UniqSet RealReg)     -- ^ registers we can use for allocation
         -> UniqSet Int                  -- ^ set of available spill slots.
@@ -91,7 +95,7 @@ regAlloc config regsFree slotsFree slotsCount code cfg
 regAlloc_spin
         :: forall instr statics.
            (Instruction instr,
-            OutputableP statics)
+            OutputableP Platform statics)
         => NCGConfig
         -> Int  -- ^ Number of solver iterations we've already performed.
         -> Color.Triv VirtualReg RegClass RealReg
@@ -388,7 +392,7 @@ graphAddCoalesce (r1, r2) graph
 
 -- | Patch registers in code using the reg -> reg mapping in this graph.
 patchRegsFromGraph
-        :: (OutputableP statics, Instruction instr)
+        :: (OutputableP Platform statics, Instruction instr)
         => Platform -> Color.Graph VirtualReg RegClass RealReg
         -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr
 
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
index 0bfba3dbc7..534c6f0bbb 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
@@ -1,4 +1,8 @@
 {-# LANGUAGE BangPatterns, CPP, DeriveFunctor #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
@@ -113,7 +117,7 @@ data RegAllocStats statics instr
         deriving (Functor)
 
 
-instance (OutputableP statics, OutputableP instr)
+instance (OutputableP Platform statics, OutputableP Platform instr)
        => Outputable (RegAllocStats statics instr) where
 
  ppr (s@RegAllocStatsStart{})
diff --git a/compiler/GHC/CmmToAsm/Reg/Liveness.hs b/compiler/GHC/CmmToAsm/Reg/Liveness.hs
index 3c2603b507..c19a8085a8 100644
--- a/compiler/GHC/CmmToAsm/Reg/Liveness.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Liveness.hs
@@ -3,6 +3,9 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
@@ -249,12 +252,12 @@ instance Outputable instr
                  | otherwise            = name <>
                      (pprUFM (getUniqSet regs) (hcat . punctuate space . map ppr))
 
-instance OutputableP instr => OutputableP (LiveInstr instr) where
-   pdoc platform i = ppr (fmap (pdoc platform) i)
+instance OutputableP env instr => OutputableP env (LiveInstr instr) where
+   pdoc env i = ppr (fmap (pdoc env) i)
 
-instance OutputableP LiveInfo where
-    pdoc platform (LiveInfo mb_static entryIds liveVRegsOnEntry liveSlotsOnEntry)
-        =  (pdoc platform mb_static)
+instance OutputableP Platform LiveInfo where
+    pdoc env (LiveInfo mb_static entryIds liveVRegsOnEntry liveSlotsOnEntry)
+        =  (pdoc env mb_static)
         $$ text "# entryIds         = " <> ppr entryIds
         $$ text "# liveVRegsOnEntry = " <> ppr liveVRegsOnEntry
         $$ text "# liveSlotsOnEntry = " <> text (show liveSlotsOnEntry)
@@ -507,7 +510,7 @@ slurpReloadCoalesce live
 
 -- | Strip away liveness information, yielding NatCmmDecl
 stripLive
-        :: (OutputableP statics, Instruction instr)
+        :: (OutputableP Platform statics, Instruction instr)
         => NCGConfig
         -> LiveCmmDecl statics instr
         -> NatCmmDecl statics instr
@@ -515,7 +518,7 @@ stripLive
 stripLive config live
         = stripCmm live
 
- where  stripCmm :: (OutputableP statics, Instruction instr)
+ where  stripCmm :: (OutputableP Platform statics, Instruction instr)
                  => LiveCmmDecl statics instr -> NatCmmDecl statics instr
         stripCmm (CmmData sec ds)       = CmmData sec ds
         stripCmm (CmmProc (LiveInfo info (first_id:_) _ _) label live sccs)
@@ -536,7 +539,7 @@ stripLive config live
 
 
 -- | Pretty-print a `LiveCmmDecl`
-pprLiveCmmDecl :: (OutputableP statics, Instruction instr) => Platform -> LiveCmmDecl statics instr -> SDoc
+pprLiveCmmDecl :: (OutputableP Platform statics, Instruction instr) => Platform -> LiveCmmDecl statics instr -> SDoc
 pprLiveCmmDecl platform d = pdoc platform (mapLiveCmmDecl (pprInstr platform) d)
 
 
diff --git a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
index 88444cce89..20b3beea35 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+
 
 -----------------------------------------------------------------------------
 --
@@ -150,7 +153,7 @@ pprLabel platform lbl =
 -- -----------------------------------------------------------------------------
 -- pprInstr: print an 'Instr'
 
-instance OutputableP Instr where
+instance OutputableP Platform Instr where
     pdoc = pprInstr
 
 
diff --git a/compiler/GHC/StgToCmm/Closure.hs b/compiler/GHC/StgToCmm/Closure.hs
index 9fec3472e0..cacb783a16 100644
--- a/compiler/GHC/StgToCmm/Closure.hs
+++ b/compiler/GHC/StgToCmm/Closure.hs
@@ -1,6 +1,9 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+
 
 -----------------------------------------------------------------------------
 --
@@ -116,7 +119,7 @@ data CgLoc
         -- To tail-call it, assign to these locals,
         -- and branch to the block id
 
-instance OutputableP CgLoc where
+instance OutputableP Platform CgLoc where
    pdoc = pprCgLoc
 
 pprCgLoc :: Platform -> CgLoc -> SDoc
diff --git a/compiler/GHC/StgToCmm/Monad.hs b/compiler/GHC/StgToCmm/Monad.hs
index 059fc19ff7..556c1c6ffd 100644
--- a/compiler/GHC/StgToCmm/Monad.hs
+++ b/compiler/GHC/StgToCmm/Monad.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+
 
 -----------------------------------------------------------------------------
 --
@@ -182,9 +185,9 @@ data CgIdInfo
         , cg_loc :: CgLoc                     -- CmmExpr for the *tagged* value
         }
 
-instance OutputableP CgIdInfo where
-  pdoc platform (CgIdInfo { cg_id = id, cg_loc = loc })
-    = ppr id <+> text "-->" <+> pdoc platform loc
+instance OutputableP Platform CgIdInfo where
+  pdoc env (CgIdInfo { cg_id = id, cg_loc = loc })
+    = ppr id <+> text "-->" <+> pdoc env loc
 
 -- Sequel tells what to do with the result of this expression
 data Sequel
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
index e4408a3084..34ac178efc 100644
--- a/compiler/GHC/Types/Basic.hs
+++ b/compiler/GHC/Types/Basic.hs
@@ -15,6 +15,9 @@ types that
 -}
 
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 
 module GHC.Types.Basic (
@@ -235,7 +238,7 @@ alignmentOf x = case x .&. 7 of
 instance Outputable Alignment where
   ppr (Alignment m) = ppr m
 
-instance OutputableP Alignment where
+instance OutputableP env Alignment where
   pdoc _ = ppr
 
 {-
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index cca43cbbab..736711ccb4 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -3,6 +3,8 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 {-
 (c) The University of Glasgow 2006-2012
@@ -95,7 +97,6 @@ import {-# SOURCE #-}   GHC.Unit.Types ( Unit, Module, moduleName )
 import {-# SOURCE #-}   GHC.Unit.Module.Name( ModuleName )
 import {-# SOURCE #-}   GHC.Types.Name.Occurrence( OccName )
 
-import GHC.Platform
 import GHC.Utils.BufHandle (BufHandle)
 import GHC.Data.FastString
 import qualified GHC.Utils.Ppr as Pretty
@@ -953,9 +954,9 @@ instance Outputable Extension where
     ppr = text . show
 
 -- | Outputable class with an additional Platform value
-class OutputableP a where
-   pdoc :: Platform -> a -> SDoc
-   pdocPrec :: Rational -> Platform -> a -> SDoc
+class OutputableP env a where
+   pdoc :: env -> a -> SDoc
+   pdocPrec :: Rational -> env -> a -> SDoc
                 -- 0 binds least tightly
                 -- We use Rational because there is always a
                 -- Rational between any other two Rationals
@@ -966,33 +967,33 @@ class OutputableP a where
 -- is required.
 newtype PDoc a = PDoc a
 
-instance Outputable a => OutputableP (PDoc a) where
+instance Outputable a => OutputableP env (PDoc a) where
    pdoc _ (PDoc a) = ppr a
 
-instance OutputableP a => OutputableP [a] where
-   pdoc platform xs = ppr (fmap (pdoc platform) xs)
+instance OutputableP env a => OutputableP env [a] where
+   pdoc env xs = ppr (fmap (pdoc env) xs)
 
-instance OutputableP a => OutputableP (Maybe a) where
-   pdoc platform xs = ppr (fmap (pdoc platform) xs)
+instance OutputableP env a => OutputableP env (Maybe a) where
+   pdoc env xs = ppr (fmap (pdoc env) xs)
 
-instance (OutputableP a, OutputableP b) => OutputableP (a, b) where
-    pdoc platform (a,b) = ppr (pdoc platform a, pdoc platform b)
+instance (OutputableP env a, OutputableP env b) => OutputableP env (a, b) where
+    pdoc env (a,b) = ppr (pdoc env a, pdoc env b)
 
-instance (OutputableP a, OutputableP b, OutputableP c) => OutputableP (a, b, c) where
-    pdoc platform (a,b,c) = ppr (pdoc platform a, pdoc platform b, pdoc platform c)
+instance (OutputableP env a, OutputableP env b, OutputableP env c) => OutputableP env (a, b, c) where
+    pdoc env (a,b,c) = ppr (pdoc env a, pdoc env b, pdoc env c)
 
 
-instance (OutputableP key, OutputableP elt) => OutputableP (M.Map key elt) where
-    pdoc platform m = ppr $ fmap (\(x,y) -> (pdoc platform x, pdoc platform y)) $ M.toList m
+instance (OutputableP env key, OutputableP env elt) => OutputableP env (M.Map key elt) where
+    pdoc env m = ppr $ fmap (\(x,y) -> (pdoc env x, pdoc env y)) $ M.toList m
 
-instance OutputableP a => OutputableP (SCC a) where
-   pdoc platform scc = ppr (fmap (pdoc platform) scc)
+instance OutputableP env a => OutputableP env (SCC a) where
+   pdoc env scc = ppr (fmap (pdoc env) scc)
 
-instance OutputableP SDoc where
+instance OutputableP env SDoc where
    pdoc _ x = x
 
-instance (OutputableP a) => OutputableP (Set a) where
-    pdoc platform s = braces (fsep (punctuate comma (map (pdoc platform) (Set.toList s))))
+instance (OutputableP env a) => OutputableP env (Set a) where
+    pdoc env s = braces (fsep (punctuate comma (map (pdoc env) (Set.toList s))))
 
 
 {-