Refactor CLabel pretty-printing

Pretty-printing CLabel relies on sdocWithDynFlags that we want to remove
(#10143, #17957). It uses it to query the backend and the platform.

This patch exposes Clabel ppr functions specialised for each backend so
that backend code can directly use them.

4 files changed, 18 insertions, 16 deletions

diff --git a/compiler/GHC/StgToCmm/Bind.hs b/compiler/GHC/StgToCmm/Bind.hs
index 4fbdc4a153..28f2050f35 100644
--- a/compiler/GHC/StgToCmm/Bind.hs
+++ b/compiler/GHC/StgToCmm/Bind.hs
@@ -558,7 +558,7 @@ mkSlowEntryCode bndr cl_info arg_regs -- function closure is already in `Node'
   = do profile <- getProfile
        platform <- getPlatform
        let node = idToReg platform (NonVoid bndr)
-           slow_lbl = closureSlowEntryLabel  cl_info
+           slow_lbl = closureSlowEntryLabel  platform cl_info
            fast_lbl = closureLocalEntryLabel platform cl_info
            -- mkDirectJump does not clobber `Node' containing function closure
            jump = mkJump profile NativeNodeCall
diff --git a/compiler/GHC/StgToCmm/Closure.hs b/compiler/GHC/StgToCmm/Closure.hs
index 98a15f0ef5..4e0e5b8ea3 100644
--- a/compiler/GHC/StgToCmm/Closure.hs
+++ b/compiler/GHC/StgToCmm/Closure.hs
@@ -785,16 +785,16 @@ isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
 --   Label generation
 --------------------------------------
 
-staticClosureLabel :: ClosureInfo -> CLabel
-staticClosureLabel = toClosureLbl .  closureInfoLabel
+staticClosureLabel :: Platform -> ClosureInfo -> CLabel
+staticClosureLabel platform = toClosureLbl platform .  closureInfoLabel
 
-closureSlowEntryLabel :: ClosureInfo -> CLabel
-closureSlowEntryLabel = toSlowEntryLbl . closureInfoLabel
+closureSlowEntryLabel :: Platform -> ClosureInfo -> CLabel
+closureSlowEntryLabel platform = toSlowEntryLbl platform . closureInfoLabel
 
 closureLocalEntryLabel :: Platform -> ClosureInfo -> CLabel
 closureLocalEntryLabel platform
-  | platformTablesNextToCode platform = toInfoLbl  . closureInfoLabel
-  | otherwise                         = toEntryLbl . closureInfoLabel
+  | platformTablesNextToCode platform = toInfoLbl  platform . closureInfoLabel
+  | otherwise                         = toEntryLbl platform . closureInfoLabel
 
 mkClosureInfoTableLabel :: Platform -> Id -> LambdaFormInfo -> CLabel
 mkClosureInfoTableLabel platform id lf_info
diff --git a/compiler/GHC/StgToCmm/Heap.hs b/compiler/GHC/StgToCmm/Heap.hs
index 2edbdbf6c8..6c811ba9cc 100644
--- a/compiler/GHC/StgToCmm/Heap.hs
+++ b/compiler/GHC/StgToCmm/Heap.hs
@@ -333,17 +333,19 @@ entryHeapCheck :: ClosureInfo
                -> FCode ()
                -> FCode ()
 
-entryHeapCheck cl_info nodeSet arity args code
-  = entryHeapCheck' is_fastf node arity args code
-  where
+entryHeapCheck cl_info nodeSet arity args code = do
+  platform <- getPlatform
+  let
     node = case nodeSet of
               Just r  -> CmmReg (CmmLocal r)
-              Nothing -> CmmLit (CmmLabel $ staticClosureLabel cl_info)
+              Nothing -> CmmLit (CmmLabel $ staticClosureLabel platform cl_info)
 
     is_fastf = case closureFunInfo cl_info of
                  Just (_, ArgGen _) -> False
                  _otherwise         -> True
 
+  entryHeapCheck' is_fastf node arity args code
+
 -- | lower-level version for "GHC.Cmm.Parser"
 entryHeapCheck' :: Bool           -- is a known function pattern
                 -> CmmExpr        -- expression for the closure pointer
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs
index 566e6666ad..9ba0b2cb6e 100644
--- a/compiler/GHC/StgToCmm/Layout.hs
+++ b/compiler/GHC/StgToCmm/Layout.hs
@@ -617,15 +617,15 @@ emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args body
               conv  = if nodeMustPointToIt profile lf_info then NativeNodeCall
                                                           else NativeDirectCall
               (offset, _, _) = mkCallEntry profile conv args' []
-        ; emitClosureAndInfoTable info_tbl conv args' $ body (offset, node, arg_regs)
+        ; emitClosureAndInfoTable (profilePlatform profile) info_tbl conv args' $ body (offset, node, arg_regs)
         }
 
 -- Data constructors need closures, but not with all the argument handling
 -- needed for functions. The shared part goes here.
-emitClosureAndInfoTable ::
-  CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()
-emitClosureAndInfoTable info_tbl conv args body
+emitClosureAndInfoTable
+   :: Platform -> CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()
+emitClosureAndInfoTable platform info_tbl conv args body
   = do { (_, blks) <- getCodeScoped body
-       ; let entry_lbl = toEntryLbl (cit_lbl info_tbl)
+       ; let entry_lbl = toEntryLbl platform (cit_lbl info_tbl)
        ; emitProcWithConvention conv (Just info_tbl) entry_lbl args blks
        }