Replace Opt_SccProfilingOn flag with sccProfilingEnabled helper function

SCC profiling was enabled in a convoluted way: if WayProf was enabled,
Opt_SccProfilingOn general flag was set (in
`GHC.Driver.Ways.wayGeneralFlags`), and then this flag was queried in
various places.

There is no need to go via general flags, so this patch defines a
`sccProfilingEnabled :: DynFlags -> Bool` helper function that just
checks whether WayProf is enabled.

19 files changed, 54 insertions, 44 deletions

diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 4cb2977155..d5d15143c2 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -605,10 +605,12 @@ setSessionDynFlags dflags = do
     then do
          let
            prog = pgm_i dflags ++ flavour
+           profiled = ways dflags `hasWay` WayProf
+           dynamic  = ways dflags `hasWay` WayDyn
            flavour
-             | WayProf `S.member` ways dflags = "-prof"
-             | WayDyn `S.member` ways dflags  = "-dyn"
-             | otherwise                      = ""
+             | profiled  = "-prof" -- FIXME: can't we have both?
+             | dynamic   = "-dyn"
+             | otherwise = ""
            msg = text "Starting " <> text prog
          tr <- if verbosity dflags >= 3
                 then return (logInfo dflags $ withPprStyle defaultDumpStyle msg)
@@ -617,8 +619,8 @@ setSessionDynFlags dflags = do
           conf = IServConfig
             { iservConfProgram  = prog
             , iservConfOpts     = getOpts dflags opt_i
-            , iservConfProfiled = gopt Opt_SccProfilingOn dflags
-            , iservConfDynamic  = WayDyn `S.member` ways dflags
+            , iservConfProfiled = profiled
+            , iservConfDynamic  = dynamic
             , iservConfHook     = createIservProcessHook (hooks dflags)
             , iservConfTrace    = tr
             }
diff --git a/compiler/GHC/Cmm/Info.hs b/compiler/GHC/Cmm/Info.hs
index 3dcff4a517..0e187a97b2 100644
--- a/compiler/GHC/Cmm/Info.hs
+++ b/compiler/GHC/Cmm/Info.hs
@@ -405,7 +405,7 @@ mkStdInfoTable dflags (type_descr, closure_descr) cl_type srt layout_lit
  where
     platform = targetPlatform dflags
     prof_info
-        | gopt Opt_SccProfilingOn dflags = [type_descr, closure_descr]
+        | sccProfilingEnabled dflags = [type_descr, closure_descr]
         | otherwise = []
 
     tag = CmmInt (fromIntegral cl_type) (halfWordWidth platform)
@@ -565,7 +565,7 @@ stdInfoTableSizeW :: DynFlags -> WordOff
 -- It must vary in sync with mkStdInfoTable
 stdInfoTableSizeW dflags
   = fixedInfoTableSizeW
-  + if gopt Opt_SccProfilingOn dflags
+  + if sccProfilingEnabled dflags
        then profInfoTableSizeW
        else 0
 
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index 7bf60f58da..cadda66b11 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -1168,7 +1168,7 @@ reserveStackFrame psize preg body = do
   withUpdFrameOff frame body
 
 profilingInfo dflags desc_str ty_str
-  = if not (gopt Opt_SccProfilingOn dflags)
+  = if not (sccProfilingEnabled dflags)
     then NoProfilingInfo
     else ProfilingInfo (BS8.pack desc_str) (BS8.pack ty_str)
 
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index 8d4726baf6..b8b48425e9 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -275,11 +275,9 @@ outputForeignStubs_help fname doc_str header footer
 -- module;
 
 -- | Generate code to initialise cost centres
-profilingInitCode :: DynFlags -> Module -> CollectedCCs -> SDoc
-profilingInitCode dflags this_mod (local_CCs, singleton_CCSs)
- = if not (gopt Opt_SccProfilingOn dflags)
-   then empty
-   else vcat
+profilingInitCode :: Module -> CollectedCCs -> SDoc
+profilingInitCode this_mod (local_CCs, singleton_CCSs)
+ = vcat
     $  map emit_cc_decl local_CCs
     ++ map emit_ccs_decl singleton_CCSs
     ++ [emit_cc_list local_CCs]
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index 5f4d14723e..93748bbc06 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -252,7 +252,6 @@ data GeneralFlag
    | Opt_PIE                         -- ^ @-fPIE@
    | Opt_PICExecutable               -- ^ @-pie@
    | Opt_ExternalDynamicRefs
-   | Opt_SccProfilingOn
    | Opt_Ticky
    | Opt_Ticky_Allocd
    | Opt_Ticky_LNE
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 9bfd3704cd..62f7467b11 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -1412,7 +1412,9 @@ hscGenHardCode hsc_env cgguts location output_filename = do
 
         let cost_centre_info =
               (S.toList local_ccs ++ caf_ccs, caf_cc_stacks)
-            prof_init = profilingInitCode dflags this_mod cost_centre_info
+            prof_init
+               | sccProfilingEnabled dflags = profilingInitCode this_mod cost_centre_info
+               | otherwise = empty
             foreign_stubs = foreign_stubs0 `appendStubC` prof_init
 
         ------------------  Code generation ------------------
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 0a45d96621..85eca17aed 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -42,6 +42,7 @@ module GHC.Driver.Session (
         whenCannotGenerateDynamicToo,
         dynamicTooMkDynamicDynFlags,
         dynamicOutputFile,
+        sccProfilingEnabled,
         DynFlags(..),
         FlagSpec(..),
         HasDynFlags(..), ContainsDynFlags(..),
@@ -5094,6 +5095,10 @@ isBmi2Enabled dflags = case platformArch (targetPlatform dflags) of
     ArchX86    -> bmiVersion dflags >= Just BMI2
     _          -> False
 
+-- | Indicate if cost-centre profiling is enabled
+sccProfilingEnabled :: DynFlags -> Bool
+sccProfilingEnabled dflags = ways dflags `hasWay` WayProf
+
 -- -----------------------------------------------------------------------------
 -- Linker/compiler information
 
diff --git a/compiler/GHC/Driver/Ways.hs b/compiler/GHC/Driver/Ways.hs
index c33cf24702..29a4d72082 100644
--- a/compiler/GHC/Driver/Ways.hs
+++ b/compiler/GHC/Driver/Ways.hs
@@ -20,6 +20,7 @@
 -- this compilation.
 module GHC.Driver.Ways
    ( Way(..)
+   , hasWay
    , allowed_combination
    , wayGeneralFlags
    , wayUnsetGeneralFlags
@@ -60,12 +61,15 @@ data Way
   | WayDyn           -- ^ Dynamic linking
   deriving (Eq, Ord, Show)
 
+-- | Test if a ways is enabled
+hasWay :: Set Way -> Way -> Bool
+hasWay ws w = Set.member w ws
 
 -- | Check if a combination of ways is allowed
 allowed_combination :: Set Way -> Bool
 allowed_combination ways = not disallowed
   where
-   disallowed = or [ Set.member ways x && Set.member ways y
+   disallowed = or [ hasWay ways x && hasWay ways y
                    | (x,y) <- couples
                    ]
    -- List of disallowed couples of ways
@@ -121,7 +125,7 @@ wayGeneralFlags _ WayDyn      = [Opt_PIC, Opt_ExternalDynamicRefs]
     -- .so before loading the .so using the system linker.  Since only
     -- PIC objects can be linked into a .so, we have to compile even
     -- modules of the main program with -fPIC when using -dynamic.
-wayGeneralFlags _ WayProf     = [Opt_SccProfilingOn]
+wayGeneralFlags _ WayProf     = []
 wayGeneralFlags _ WayEventLog = []
 
 -- | Turn these flags off when enabling this way
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 17335eb6b3..7451d0113d 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -1040,7 +1040,7 @@ coveragePasses :: DynFlags -> [TickishType]
 coveragePasses dflags =
     ifa (breakpointsEnabled dflags)          Breakpoints $
     ifa (gopt Opt_Hpc dflags)                HpcTicks $
-    ifa (gopt Opt_SccProfilingOn dflags &&
+    ifa (sccProfilingEnabled dflags &&
          profAuto dflags /= NoProfAuto)      ProfNotes $
     ifa (debugLevel dflags > 0)              SourceNotes []
   where ifa f x xs | f         = x:xs
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index fe60d06f83..696cebe565 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -813,7 +813,7 @@ dsExpr (HsRecFld      {})  = panic "dsExpr:HsRecFld"
 ds_prag_expr :: HsPragE GhcTc -> LHsExpr GhcTc -> DsM CoreExpr
 ds_prag_expr (HsPragSCC _ _ cc) expr = do
     dflags <- getDynFlags
-    if gopt Opt_SccProfilingOn dflags
+    if sccProfilingEnabled dflags
       then do
         mod_name <- getModule
         count <- goptM Opt_ProfCountEntries
diff --git a/compiler/GHC/Iface/Recomp/Flags.hs b/compiler/GHC/Iface/Recomp/Flags.hs
index eac1277b75..391aaf2c86 100644
--- a/compiler/GHC/Iface/Recomp/Flags.hs
+++ b/compiler/GHC/Iface/Recomp/Flags.hs
@@ -55,7 +55,7 @@ fingerprintDynFlags dflags@DynFlags{..} this_mod nameio =
         paths = [ hcSuf ]
 
         -- -fprof-auto etc.
-        prof = if gopt Opt_SccProfilingOn dflags then fromEnum profAuto else 0
+        prof = if sccProfilingEnabled dflags then fromEnum profAuto else 0
 
         -- Ticky
         ticky =
diff --git a/compiler/GHC/Runtime/Heap/Layout.hs b/compiler/GHC/Runtime/Heap/Layout.hs
index 4f43c13344..a092b04a22 100644
--- a/compiler/GHC/Runtime/Heap/Layout.hs
+++ b/compiler/GHC/Runtime/Heap/Layout.hs
@@ -282,8 +282,8 @@ fixedHdrSizeW dflags = sTD_HDR_SIZE dflags + profHdrSize dflags
 -- (StgProfHeader in includes\/rts\/storage\/Closures.h)
 profHdrSize  :: DynFlags -> WordOff
 profHdrSize dflags
- | gopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags
- | otherwise                      = 0
+ | sccProfilingEnabled dflags = pROF_HDR_SIZE dflags
+ | otherwise                  = 0
 
 -- | The garbage collector requires that every closure is at least as
 --   big as this.
diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs
index ec8e30e689..ea6eef7d22 100644
--- a/compiler/GHC/Stg/Syntax.hs
+++ b/compiler/GHC/Stg/Syntax.hs
@@ -805,7 +805,7 @@ pprStgRhs :: OutputablePass pass => GenStgRhs pass -> SDoc
 
 pprStgRhs (StgRhsClosure ext cc upd_flag args body)
   = sdocWithDynFlags $ \dflags ->
-    hang (hsep [if gopt Opt_SccProfilingOn dflags then ppr cc else empty,
+    hang (hsep [if sccProfilingEnabled dflags then ppr cc else empty,
                 ppUnlessOption sdocSuppressStgExts (ppr ext),
                 char '\\' <> ppr upd_flag, brackets (interppSP args)])
          4 (ppr body)
diff --git a/compiler/GHC/StgToCmm/Bind.hs b/compiler/GHC/StgToCmm/Bind.hs
index 2217724922..c83bca2217 100644
--- a/compiler/GHC/StgToCmm/Bind.hs
+++ b/compiler/GHC/StgToCmm/Bind.hs
@@ -307,7 +307,7 @@ mkRhsClosure    dflags bndr _cc
   , all (isGcPtrRep . idPrimRep . fromNonVoid) fvs
   , isUpdatable upd_flag
   , n_fvs <= mAX_SPEC_AP_SIZE dflags
-  , not (gopt Opt_SccProfilingOn dflags)
+  , not (sccProfilingEnabled dflags)
                          -- not when profiling: we don't want to
                          -- lose information about this particular
                          -- thunk (e.g. its type) (#949)
@@ -626,7 +626,7 @@ emitBlackHoleCode node = do
   -- Note the eager-blackholing check is here rather than in blackHoleOnEntry,
   -- because emitBlackHoleCode is called from GHC.Cmm.Parser.
 
-  let  eager_blackholing =  not (gopt Opt_SccProfilingOn dflags)
+  let  eager_blackholing =  not (sccProfilingEnabled dflags)
                          && gopt Opt_EagerBlackHoling dflags
              -- Profiling needs slop filling (to support LDV
              -- profiling), so currently eager blackholing doesn't
@@ -655,7 +655,7 @@ setupUpdate closure_info node body
           dflags <- getDynFlags
           let
               bh = blackHoleOnEntry closure_info &&
-                   not (gopt Opt_SccProfilingOn dflags) &&
+                   not (sccProfilingEnabled dflags) &&
                    gopt Opt_EagerBlackHoling dflags
 
               lbl | bh        = mkBHUpdInfoLabel
diff --git a/compiler/GHC/StgToCmm/Closure.hs b/compiler/GHC/StgToCmm/Closure.hs
index 98a9c878af..a21be98ceb 100644
--- a/compiler/GHC/StgToCmm/Closure.hs
+++ b/compiler/GHC/StgToCmm/Closure.hs
@@ -381,7 +381,7 @@ nodeMustPointToIt dflags (LFThunk top no_fvs updatable NonStandardThunk _)
   =  not no_fvs            -- Self parameter
   || isNotTopLevel top     -- Note [GC recovery]
   || updatable             -- Need to push update frame
-  || gopt Opt_SccProfilingOn dflags
+  || sccProfilingEnabled dflags
           -- For the non-updatable (single-entry case):
           --
           -- True if has fvs (in which case we need access to them, and we
@@ -508,7 +508,7 @@ getCallMethod dflags _ id _ n_args v_args _cg_loc
 getCallMethod dflags name id (LFReEntrant _ arity _ _) n_args _v_args _cg_loc
               _self_loop_info
   | n_args == 0 -- No args at all
-  && not (gopt Opt_SccProfilingOn dflags)
+  && not (sccProfilingEnabled dflags)
      -- See Note [Evaluating functions with profiling] in rts/Apply.cmm
   = ASSERT( arity /= 0 ) ReturnIt
   | n_args < arity = SlowCall        -- Not enough args
@@ -859,7 +859,7 @@ enterIdLabel platform id c
 
 mkProfilingInfo :: DynFlags -> Id -> String -> ProfilingInfo
 mkProfilingInfo dflags id val_descr
-  | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
+  | not (sccProfilingEnabled dflags) = NoProfilingInfo
   | otherwise = ProfilingInfo ty_descr_w8 (BS8.pack val_descr)
   where
     ty_descr_w8  = BS8.pack (getTyDescription (idType id))
@@ -906,8 +906,8 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
                   -- We keep the *zero-indexed* tag in the srt_len field
                   -- of the info table of a data constructor.
 
-   prof | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
-        | otherwise                            = ProfilingInfo ty_descr val_descr
+   prof | not (sccProfilingEnabled dflags) = NoProfilingInfo
+        | otherwise                        = ProfilingInfo ty_descr val_descr
 
    ty_descr  = BS8.pack $ occNameString $ getOccName $ dataConTyCon data_con
    val_descr = BS8.pack $ occNameString $ getOccName data_con
diff --git a/compiler/GHC/StgToCmm/Foreign.hs b/compiler/GHC/StgToCmm/Foreign.hs
index 87e4ae6ccb..aaffa17699 100644
--- a/compiler/GHC/StgToCmm/Foreign.hs
+++ b/compiler/GHC/StgToCmm/Foreign.hs
@@ -306,7 +306,7 @@ saveThreadState dflags = do
             spExpr,
     close_nursery,
     -- and save the current cost centre stack in the TSO when profiling:
-    if gopt Opt_SccProfilingOn dflags then
+    if sccProfilingEnabled dflags then
         mkStore (cmmOffset platform (CmmReg (CmmLocal tso)) (tso_CCCS dflags)) cccsExpr
       else mkNop
     ]
@@ -421,7 +421,7 @@ loadThreadState dflags = do
     mkAssign hpAllocReg (zeroExpr platform),
     open_nursery,
     -- and load the current cost centre stack from the TSO when profiling:
-    if gopt Opt_SccProfilingOn dflags
+    if sccProfilingEnabled dflags
        then storeCurCCS
               (CmmLoad (cmmOffset platform (CmmReg (CmmLocal tso))
                  (tso_CCCS dflags)) (ccsType platform))
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs
index 646f4fa1d9..3ccc3c51ac 100644
--- a/compiler/GHC/StgToCmm/Layout.hs
+++ b/compiler/GHC/StgToCmm/Layout.hs
@@ -367,7 +367,7 @@ just more arguments that we are passing on the stack (cml_args).
 slowArgs :: DynFlags -> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
 slowArgs _ [] = []
 slowArgs dflags args -- careful: reps contains voids (V), but args does not
-  | gopt Opt_SccProfilingOn dflags
+  | sccProfilingEnabled dflags
               = save_cccs ++ this_pat ++ slowArgs dflags rest_args
   | otherwise =              this_pat ++ slowArgs dflags rest_args
   where
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index 5aa7566846..6c785d24ff 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -300,8 +300,8 @@ emitPrimOp dflags = \case
   GetCCSOfOp -> \[arg] -> opAllDone $ \[res] -> do
     let
       val
-       | gopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag dflags arg)
-       | otherwise                      = CmmLit (zeroCLit platform)
+       | sccProfilingEnabled dflags = costCentreFrom dflags (cmmUntag dflags arg)
+       | otherwise                  = CmmLit (zeroCLit platform)
     emitAssign (CmmLocal res) val
 
   GetCurrentCCSOp -> \[_] -> opAllDone $ \[res] -> do
diff --git a/compiler/GHC/StgToCmm/Prof.hs b/compiler/GHC/StgToCmm/Prof.hs
index 8de1445d21..1381617f89 100644
--- a/compiler/GHC/StgToCmm/Prof.hs
+++ b/compiler/GHC/StgToCmm/Prof.hs
@@ -76,15 +76,15 @@ costCentreFrom dflags cl = CmmLoad (cmmOffsetB platform cl (oFFSET_StgHeader_ccs
 -- | The profiling header words in a static closure
 staticProfHdr :: DynFlags -> CostCentreStack -> [CmmLit]
 staticProfHdr dflags ccs
-  | gopt Opt_SccProfilingOn dflags = [mkCCostCentreStack ccs, staticLdvInit platform]
-  | otherwise                      = []
+  | sccProfilingEnabled dflags = [mkCCostCentreStack ccs, staticLdvInit platform]
+  | otherwise                  = []
   where platform = targetPlatform dflags
 
 -- | Profiling header words in a dynamic closure
 dynProfHdr :: DynFlags -> CmmExpr -> [CmmExpr]
 dynProfHdr dflags ccs
-  | gopt Opt_SccProfilingOn dflags = [ccs, dynLdvInit dflags]
-  | otherwise                      = []
+  | sccProfilingEnabled dflags = [ccs, dynLdvInit dflags]
+  | otherwise                  = []
 
 -- | Initialise the profiling field of an update frame
 initUpdFrameProf :: CmmExpr -> FCode ()
@@ -130,7 +130,7 @@ saveCurrentCostCentre :: FCode (Maybe LocalReg)
 saveCurrentCostCentre
   = do dflags <- getDynFlags
        platform <- getPlatform
-       if not (gopt Opt_SccProfilingOn dflags)
+       if not (sccProfilingEnabled dflags)
            then return Nothing
            else do local_cc <- newTemp (ccType platform)
                    emitAssign (CmmLocal local_cc) cccsExpr
@@ -195,7 +195,7 @@ enterCostCentreFun ccs closure =
 ifProfiling :: FCode () -> FCode ()
 ifProfiling code
   = do dflags <- getDynFlags
-       if gopt Opt_SccProfilingOn dflags
+       if sccProfilingEnabled dflags
            then code
            else return ()
 
@@ -207,7 +207,7 @@ initCostCentres :: CollectedCCs -> FCode ()
 -- Emit the declarations
 initCostCentres (local_CCs, singleton_CCSs)
   = do dflags <- getDynFlags
-       when (gopt Opt_SccProfilingOn dflags) $
+       when (sccProfilingEnabled dflags) $
            do mapM_ emitCostCentreDecl local_CCs
               mapM_ emitCostCentreStackDecl singleton_CCSs
 
@@ -277,7 +277,7 @@ emitSetCCC :: CostCentre -> Bool -> Bool -> FCode ()
 emitSetCCC cc tick push
  = do dflags <- getDynFlags
       platform <- getPlatform
-      if not (gopt Opt_SccProfilingOn dflags)
+      if not (sccProfilingEnabled dflags)
           then return ()
           else do tmp <- newTemp (ccsType platform)
                   pushCostCentre tmp cccsExpr cc