Add flag -fprof-manual which controls if GHC should honour manual cost centres.wip/andreask/no_manual_scc

This allows disabling of manual control centres in code a user doesn't control like
libraries.

Fixes #18867

8 files changed, 61 insertions, 1 deletions

diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index 671d163ac7..fef0fb4d90 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -256,6 +256,7 @@ data GeneralFlag
    | Opt_AutoSccsOnIndividualCafs
    | Opt_ProfCountEntries
    | Opt_ProfLateCcs
+   | Opt_ProfManualCcs -- ^ Ignore manual SCC annotations
 
    -- misc opts
    | Opt_Pp
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index b0f5888317..327f7cc2bc 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -3427,6 +3427,7 @@ fFlagsDeps = [
   flagSpec "prof-cafs"                        Opt_AutoSccsOnIndividualCafs,
   flagSpec "prof-count-entries"               Opt_ProfCountEntries,
   flagSpec "prof-late"                        Opt_ProfLateCcs,
+  flagSpec "prof-manual"                      Opt_ProfManualCcs,
   flagSpec "regs-graph"                       Opt_RegsGraph,
   flagSpec "regs-iterative"                   Opt_RegsIterative,
   depFlagSpec' "rewrite-rules"                Opt_EnableRewriteRules
@@ -3926,6 +3927,7 @@ optLevelFlags -- see Note [Documenting optimisation flags]
   = [ ([0,1,2], Opt_DoLambdaEtaExpansion)
     , ([0,1,2], Opt_DoEtaReduction)       -- See Note [Eta-reduction in -O0]
     , ([0,1,2], Opt_LlvmTBAA)
+    , ([0,1,2], Opt_ProfManualCcs )
     , ([2], Opt_DictsStrict)
 
     , ([0],     Opt_IgnoreInterfacePragmas)
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 18e7cfbb8a..e7d2d58d66 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -765,7 +765,7 @@ dsExpr (SectionR x _ _)  = dataConCantHappen x
 ds_prag_expr :: HsPragE GhcTc -> LHsExpr GhcTc -> DsM CoreExpr
 ds_prag_expr (HsPragSCC _ _ cc) expr = do
     dflags <- getDynFlags
-    if sccProfilingEnabled dflags
+    if sccProfilingEnabled dflags && gopt Opt_ProfManualCcs dflags
       then do
         mod_name <- getModule
         count <- goptM Opt_ProfCountEntries
diff --git a/docs/users_guide/profiling.rst b/docs/users_guide/profiling.rst
index d1721919f4..0258aad815 100644
--- a/docs/users_guide/profiling.rst
+++ b/docs/users_guide/profiling.rst
@@ -463,6 +463,17 @@ compiled program.
     "big" CAF cost-centre. With this option, all CAFs get their own
     cost-centre. An "if all else fails" option…
 
+.. ghc-flag:: -fprof-manual
+    :shortdesc: Process manual ``SCC`` annotations.
+    :type: dynamic
+    :reverse: -fno-prof-manual
+    :category:
+
+    :default: on
+
+    Process (or ignore) manual ``SCC`` annotations. Can be helpful to ignore annotations from libraries which
+    are not desired.
+
 .. ghc-flag:: -auto-all
     :shortdesc: *(deprecated)* Alias for :ghc-flag:`-fprof-auto`
     :type: dynamic
diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T
index 399ec3da71..22fa287750 100644
--- a/testsuite/tests/profiling/should_run/all.T
+++ b/testsuite/tests/profiling/should_run/all.T
@@ -179,3 +179,7 @@ test('T15897',
 test('T17572', [], compile_and_run, [''])
 
 test('TraverseHeapTest', [only_ways(['prof'])], compile_and_run, ['-debug'])
+
+# Check if -fno-prof-manual results in the manual cost center being ignored.
+test('ignore_scc', [], compile_and_run,
+     ['-fno-prof-manual'])
diff --git a/testsuite/tests/profiling/should_run/ignore_scc.hs b/testsuite/tests/profiling/should_run/ignore_scc.hs
new file mode 100644
index 0000000000..0ee9134340
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/ignore_scc.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE BangPatterns #-}
+main = print (f 20 30)
+
+{-# NOINLINE f #-}
+f x = {-# SCC customScc #-} (let !x' = fib x in \y -> x' + fib y)
+
+fib :: Int -> Int
+fib n = if n < 2 then 1 else fib (n-1) + fib (n-2)
diff --git a/testsuite/tests/profiling/should_run/ignore_scc.prof.sample b/testsuite/tests/profiling/should_run/ignore_scc.prof.sample
new file mode 100644
index 0000000000..f12e56b83e
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/ignore_scc.prof.sample
@@ -0,0 +1,33 @@
+	Wed Mar 30 16:31 2022 Time and Allocation Profiling Report  (Final)
+
+	   ignore_scc +RTS -hc -p -RTS
+
+	total time  =        0.03 secs   (25 ticks @ 1000 us, 1 processor)
+	total alloc =      48,328 bytes  (excludes profiling overheads)
+
+COST CENTRE MODULE           SRC                   %time %alloc
+
+fib         Main             ignore_scc.hs:8:1-50  100.0    0.0
+MAIN        MAIN             <built-in>              0.0    1.7
+CAF         GHC.IO.Handle.FD <entire-module>         0.0   71.9
+CAF         GHC.IO.Encoding  <entire-module>         0.0    5.1
+CAF         GHC.Conc.Signal  <entire-module>         0.0    1.3
+main        Main             ignore_scc.hs:2:1-22    0.0   19.6
+
+
+                                                                            individual      inherited
+COST CENTRE  MODULE                SRC                   no.     entries  %time %alloc   %time %alloc
+
+MAIN         MAIN                  <built-in>            127           0    0.0    1.7   100.0  100.0
+ CAF         Main                  <entire-module>       253           0    0.0    0.0   100.0    0.7
+  main       Main                  ignore_scc.hs:2:1-22  254           1    0.0    0.7   100.0    0.7
+   f         Main                  ignore_scc.hs:5:1-65  256           1    0.0    0.0   100.0    0.0
+    f.\      Main                  ignore_scc.hs:5:55-64 259           1    0.0    0.0   100.0    0.0
+     fib     Main                  ignore_scc.hs:8:1-50  260     2692537  100.0    0.0   100.0    0.0
+    f.x'     Main                  ignore_scc.hs:5:34-44 257           1    0.0    0.0     0.0    0.0
+     fib     Main                  ignore_scc.hs:8:1-50  258       21891    0.0    0.0     0.0    0.0
+ CAF         GHC.Conc.Signal       <entire-module>       248           0    0.0    1.3     0.0    1.3
+ CAF         GHC.IO.Encoding       <entire-module>       239           0    0.0    5.1     0.0    5.1
+ CAF         GHC.IO.Encoding.Iconv <entire-module>       237           0    0.0    0.4     0.0    0.4
+ CAF         GHC.IO.Handle.FD      <entire-module>       229           0    0.0   71.9     0.0   71.9
+ main        Main                  ignore_scc.hs:2:1-22  255           0    0.0   19.0     0.0   19.0
diff --git a/testsuite/tests/profiling/should_run/ignore_scc.stdout b/testsuite/tests/profiling/should_run/ignore_scc.stdout
new file mode 100644
index 0000000000..bbdd2bf878
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/ignore_scc.stdout
@@ -0,0 +1 @@
+1357215