Move CLabel assertions into smart constructors (#17957)

It avoids using DynFlags in the Outputable instance of Clabel to check
assertions at pretty-printing time.

2 files changed, 32 insertions, 28 deletions

diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index a0f8c6340d..bc467af0f0 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -567,17 +567,27 @@ mkLocalBlockLabel u = LocalBlockLabel u
 
 -- Constructing RtsLabels
 mkRtsPrimOpLabel :: PrimOp -> CLabel
-mkRtsPrimOpLabel primop         = RtsLabel (RtsPrimOp primop)
+mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
 
-mkSelectorInfoLabel  :: Bool -> Int -> CLabel
-mkSelectorEntryLabel :: Bool -> Int -> CLabel
-mkSelectorInfoLabel  upd off    = RtsLabel (RtsSelectorInfoTable upd off)
-mkSelectorEntryLabel upd off    = RtsLabel (RtsSelectorEntry     upd off)
+mkSelectorInfoLabel :: DynFlags -> Bool -> Int -> CLabel
+mkSelectorInfoLabel dflags upd offset =
+   ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
+   RtsLabel (RtsSelectorInfoTable upd offset)
 
-mkApInfoTableLabel :: Bool -> Int -> CLabel
-mkApEntryLabel     :: Bool -> Int -> CLabel
-mkApInfoTableLabel   upd off    = RtsLabel (RtsApInfoTable       upd off)
-mkApEntryLabel       upd off    = RtsLabel (RtsApEntry           upd off)
+mkSelectorEntryLabel :: DynFlags -> Bool -> Int -> CLabel
+mkSelectorEntryLabel dflags upd offset =
+   ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
+   RtsLabel (RtsSelectorEntry upd offset)
+
+mkApInfoTableLabel :: DynFlags -> Bool -> Int -> CLabel
+mkApInfoTableLabel dflags upd arity =
+   ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
+   RtsLabel (RtsApInfoTable upd arity)
+
+mkApEntryLabel :: DynFlags -> Bool -> Int -> CLabel
+mkApEntryLabel dflags upd arity =
+   ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
+   RtsLabel (RtsApEntry upd arity)
 
 
 -- A call to some primitive hand written Cmm code
@@ -1209,7 +1219,7 @@ pprCLabel dflags = \case
    lbl -> getPprStyle $ \sty ->
             if useNCG && asmStyle sty
             then maybe_underscore $ pprAsmCLbl lbl
-            else pprCLbl dflags lbl
+            else pprCLbl platform lbl
 
   where
     platform = targetPlatform dflags
@@ -1226,10 +1236,10 @@ pprCLabel dflags = \case
         -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
         -- (The C compiler does this itself).
         = ftext fs <> char '@' <> int sz
-    pprAsmCLbl lbl = pprCLbl dflags lbl
+    pprAsmCLbl lbl = pprCLbl platform lbl
 
-pprCLbl :: DynFlags -> CLabel -> SDoc
-pprCLbl dflags = \case
+pprCLbl :: Platform -> CLabel -> SDoc
+pprCLbl platform = \case
    (StringLitLabel u)   -> pprUniqueAlways u <> text "_str"
    (SRTLabel u)         -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt"
    (LargeBitmapLabel u) -> tempLabelPrefixOrUnderscore platform
@@ -1247,7 +1257,6 @@ pprCLbl dflags = \case
    (RtsLabel (RtsApFast str)) -> ftext str <> text "_fast"
 
    (RtsLabel (RtsSelectorInfoTable upd_reqd offset)) ->
-    ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
     hcat [text "stg_sel_", text (show offset),
           ptext (if upd_reqd
                  then (sLit "_upd_info")
@@ -1255,7 +1264,6 @@ pprCLbl dflags = \case
         ]
 
    (RtsLabel (RtsSelectorEntry upd_reqd offset)) ->
-    ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
     hcat [text "stg_sel_", text (show offset),
                 ptext (if upd_reqd
                         then (sLit "_upd_entry")
@@ -1263,7 +1271,6 @@ pprCLbl dflags = \case
         ]
 
    (RtsLabel (RtsApInfoTable upd_reqd arity)) ->
-    ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
     hcat [text "stg_ap_", text (show arity),
                 ptext (if upd_reqd
                         then (sLit "_upd_info")
@@ -1271,7 +1278,6 @@ pprCLbl dflags = \case
         ]
 
    (RtsLabel (RtsApEntry upd_reqd arity)) ->
-    ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
     hcat [text "stg_ap_", text (show arity),
                 ptext (if upd_reqd
                         then (sLit "_upd_entry")
@@ -1301,8 +1307,6 @@ pprCLbl dflags = \case
    (DynamicLinkerLabel {})  -> panic "pprCLbl DynamicLinkerLabel"
    (PicBaseLabel {})        -> panic "pprCLbl PicBaseLabel"
    (DeadStripPreventer {})  -> panic "pprCLbl DeadStripPreventer"
-  where
-   platform = targetPlatform dflags
 
 ppIdFlavor :: IdLabelInfo -> SDoc
 ppIdFlavor x = pp_cSEP <> text
diff --git a/compiler/GHC/StgToCmm/Closure.hs b/compiler/GHC/StgToCmm/Closure.hs
index fc4b79d71f..40ff161819 100644
--- a/compiler/GHC/StgToCmm/Closure.hs
+++ b/compiler/GHC/StgToCmm/Closure.hs
@@ -637,7 +637,7 @@ mkClosureInfo dflags is_static id lf_info tot_wds ptr_wds val_descr
     prof       = mkProfilingInfo dflags id val_descr
     nonptr_wds = tot_wds - ptr_wds
 
-    info_lbl = mkClosureInfoTableLabel id lf_info
+    info_lbl = mkClosureInfoTableLabel dflags id lf_info
 
 --------------------------------------
 --   Other functions over ClosureInfo
@@ -786,14 +786,14 @@ closureLocalEntryLabel dflags
   | tablesNextToCode dflags = toInfoLbl  . closureInfoLabel
   | otherwise               = toEntryLbl . closureInfoLabel
 
-mkClosureInfoTableLabel :: Id -> LambdaFormInfo -> CLabel
-mkClosureInfoTableLabel id lf_info
+mkClosureInfoTableLabel :: DynFlags -> Id -> LambdaFormInfo -> CLabel
+mkClosureInfoTableLabel dflags id lf_info
   = case lf_info of
         LFThunk _ _ upd_flag (SelectorThunk offset) _
-                      -> mkSelectorInfoLabel upd_flag offset
+                      -> mkSelectorInfoLabel dflags upd_flag offset
 
         LFThunk _ _ upd_flag (ApThunk arity) _
-                      -> mkApInfoTableLabel upd_flag arity
+                      -> mkApInfoTableLabel dflags upd_flag arity
 
         LFThunk{}     -> std_mk_lbl name cafs
         LFReEntrant{} -> std_mk_lbl name cafs
@@ -825,13 +825,13 @@ thunkEntryLabel dflags thunk_id c _ _
 
 enterApLabel :: DynFlags -> Bool -> Arity -> CLabel
 enterApLabel dflags is_updatable arity
-  | tablesNextToCode dflags = mkApInfoTableLabel is_updatable arity
-  | otherwise               = mkApEntryLabel is_updatable arity
+  | tablesNextToCode dflags = mkApInfoTableLabel dflags is_updatable arity
+  | otherwise               = mkApEntryLabel     dflags is_updatable arity
 
 enterSelectorLabel :: DynFlags -> Bool -> WordOff -> CLabel
 enterSelectorLabel dflags upd_flag offset
-  | tablesNextToCode dflags = mkSelectorInfoLabel upd_flag offset
-  | otherwise               = mkSelectorEntryLabel upd_flag offset
+  | tablesNextToCode dflags = mkSelectorInfoLabel  dflags upd_flag offset
+  | otherwise               = mkSelectorEntryLabel dflags upd_flag offset
 
 enterIdLabel :: DynFlags -> Name -> CafInfo -> CLabel
 enterIdLabel dflags id c