summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorAndreas Klebinger <klebinger.andreas@gmx.at>2022-03-30 15:44:16 +0200
committerMatthew Pickering <matthewtpickering@gmail.com>2022-04-07 17:55:12 +0000
commitf80e59a48fe381808b7aec92cf68c7563349768e (patch)
tree77835afeac214d2980aa1c504bf47499d08c0039 /compiler
parentb3d6d23d11a19d5304538b4a55bd9b93f39a3e63 (diff)
downloadhaskell-wip/andreask/no_manual_scc.tar.gz
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
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/Driver/Flags.hs1
-rw-r--r--compiler/GHC/Driver/Session.hs2
-rw-r--r--compiler/GHC/HsToCore/Expr.hs2
3 files changed, 4 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