Introduce OutputableP

Some types need a Platform value to be pretty-printed: CLabel, Cmm
types, instructions, etc.

Before this patch they had an Outputable instance and the Platform value
was obtained via sdocWithDynFlags. It meant that the *renderer* of the
SDoc was responsible of passing the appropriate Platform value (e.g. via
the DynFlags given to showSDoc).  It put the burden of passing the
Platform value on the renderer while the generator of the SDoc knows the
Platform it is generating the SDoc for and there is no point passing a
different Platform at rendering time.

With this patch, we introduce a new OutputableP class:

   class OutputableP a where
      pdoc :: Platform -> a -> SDoc

With this class we still have some polymorphism as we have with `ppr`
(i.e. we can use `pdoc` on a variety of types instead of having a
dedicated `pprXXX` function for each XXX type).

One step closer removing `sdocWithDynFlags` (#10143) and supporting
several platforms (#14335).

1 files changed, 9 insertions, 6 deletions

diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index b2c107d429..3771a0e82c 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -442,8 +442,9 @@ cmmproc :: { CmmParse () }
                        getCodeScoped $ loopDecls $ do {
                          (entry_ret_label, info, stk_formals) <- $1;
                          dflags <- getDynFlags;
+                         platform <- getPlatform;
                          formals <- sequence (fromMaybe [] $3);
-                         withName (showSDoc dflags (ppr entry_ret_label))
+                         withName (showSDoc dflags (pdoc platform entry_ret_label))
                            $4;
                          return (entry_ret_label, info, stk_formals, formals) }
                      let do_layout = isJust $3
@@ -996,8 +997,8 @@ machOps = listToUFM $
         ( "i2f64",    flip MO_SF_Conv W64 )
         ]
 
-callishMachOps :: UniqFM FastString ([CmmExpr] -> (CallishMachOp, [CmmExpr]))
-callishMachOps = listToUFM $
+callishMachOps :: Platform -> UniqFM FastString ([CmmExpr] -> (CallishMachOp, [CmmExpr]))
+callishMachOps platform = listToUFM $
         map (\(x, y) -> (mkFastString x, y)) [
         ( "read_barrier", (MO_ReadBarrier,)),
         ( "write_barrier", (MO_WriteBarrier,)),
@@ -1049,7 +1050,7 @@ callishMachOps = listToUFM $
         args' = init args
         align = case last args of
           CmmLit (CmmInt alignInteger _) -> fromInteger alignInteger
-          e -> pgmErrorDoc "Non-constant alignment in memcpy-like function:" (ppr e)
+          e -> pgmErrorDoc "Non-constant alignment in memcpy-like function:" (pdoc platform e)
         -- The alignment of memcpy-ish operations must be a
         -- compile-time constant. We verify this here, passing it around
         -- in the MO_* constructor. In order to do this, however, we
@@ -1166,7 +1167,7 @@ reserveStackFrame psize preg body = do
   let size = case constantFoldExpr platform esize of
                CmmLit (CmmInt n _) -> n
                _other -> pprPanic "CmmParse: not a compile-time integer: "
-                            (ppr esize)
+                            (pdoc platform esize)
   let frame = old_updfr_off + platformWordSizeInBytes platform * fromIntegral size
   emitAssign reg (CmmStackSlot Old frame)
   withUpdFrameOff frame body
@@ -1269,7 +1270,9 @@ primCall
         -> [CmmParse CmmExpr]
         -> PD (CmmParse ())
 primCall results_code name args_code
-  = case lookupUFM callishMachOps name of
+  = do
+    platform <- PD.getPlatform
+    case lookupUFM (callishMachOps platform) name of
         Nothing -> failMsgPD ("unknown primitive " ++ unpackFS name)
         Just f  -> return $ do
                 results <- sequence results_code