summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDominik Peteler <haskell+gitlab@with-h.at>2022-07-14 15:23:32 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-07-16 07:23:43 -0400
commitb27c2774fb8191e566bcae0ed7b06bb96afa466b (patch)
treef9c6e19eefda7f284bd5e088b77328620d65985f
parent3acbd7ad4a5ee3246c694674e6248a935430104c (diff)
downloadhaskell-b27c2774fb8191e566bcae0ed7b06bb96afa466b.tar.gz
Align the behaviour of `dopt` and `log_dopt`
Before the behaviour of `dopt` and `logHasDumpFlag` (and the underlying function `log_dopt`) were different as the latter did not take the verbosity level into account. This led to problems during the refactoring as we cannot simply replace calls to `dopt` with calls to `logHasDumpFlag`. In addition to that a subtle bug in the GHC module was fixed: `setSessionDynFlags` did not update the logger and as a consequence the verbosity value of the logger was not set appropriately. Fixes #21861
-rw-r--r--compiler/GHC.hs2
-rw-r--r--compiler/GHC/Driver/Flags.hs42
-rw-r--r--compiler/GHC/Driver/Session.hs31
-rw-r--r--compiler/GHC/Utils/Logger.hs2
4 files changed, 45 insertions, 32 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 9689bd828f..750c17c141 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -597,7 +597,7 @@ setSessionDynFlags dflags0 = do
case S.toList all_uids of
[uid] -> do
setUnitDynFlagsNoCheck uid dflags
- modifySession (hscSetActiveUnitId (homeUnitId_ dflags))
+ modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ dflags))
dflags' <- getDynFlags
setTopSessionDynFlags dflags'
[] -> panic "nohue"
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index bac257670c..f158e6a42b 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -1,5 +1,7 @@
module GHC.Driver.Flags
( DumpFlag(..)
+ , getDumpFlagFrom
+ , enabledIfVerbose
, GeneralFlag(..)
, Language(..)
, optimisationFlags
@@ -142,6 +144,46 @@ data DumpFlag
| Opt_D_faststring_stats
deriving (Eq, Show, Enum)
+-- | Helper function to query whether a given `DumpFlag` is enabled or not.
+getDumpFlagFrom
+ :: (a -> Int) -- ^ Getter for verbosity setting
+ -> (a -> EnumSet DumpFlag) -- ^ Getter for the set of enabled dump flags
+ -> DumpFlag -> a -> Bool
+getDumpFlagFrom getVerbosity getFlags f x
+ = (f `EnumSet.member` getFlags x)
+ || (getVerbosity x >= 4 && enabledIfVerbose f)
+
+-- | Is the flag implicitly enabled when the verbosity is high enough?
+enabledIfVerbose :: DumpFlag -> Bool
+enabledIfVerbose Opt_D_dump_tc_trace = False
+enabledIfVerbose Opt_D_dump_rn_trace = False
+enabledIfVerbose Opt_D_dump_cs_trace = False
+enabledIfVerbose Opt_D_dump_if_trace = False
+enabledIfVerbose Opt_D_dump_tc = False
+enabledIfVerbose Opt_D_dump_rn = False
+enabledIfVerbose Opt_D_dump_rn_stats = False
+enabledIfVerbose Opt_D_dump_hi_diffs = False
+enabledIfVerbose Opt_D_verbose_core2core = False
+enabledIfVerbose Opt_D_verbose_stg2stg = False
+enabledIfVerbose Opt_D_dump_splices = False
+enabledIfVerbose Opt_D_th_dec_file = False
+enabledIfVerbose Opt_D_dump_rule_firings = False
+enabledIfVerbose Opt_D_dump_rule_rewrites = False
+enabledIfVerbose Opt_D_dump_simpl_trace = False
+enabledIfVerbose Opt_D_dump_rtti = False
+enabledIfVerbose Opt_D_dump_inlinings = False
+enabledIfVerbose Opt_D_dump_verbose_inlinings = False
+enabledIfVerbose Opt_D_dump_core_stats = False
+enabledIfVerbose Opt_D_dump_asm_stats = False
+enabledIfVerbose Opt_D_dump_types = False
+enabledIfVerbose Opt_D_dump_simpl_iterations = False
+enabledIfVerbose Opt_D_dump_ticked = False
+enabledIfVerbose Opt_D_dump_view_pattern_commoning = False
+enabledIfVerbose Opt_D_dump_mod_cycles = False
+enabledIfVerbose Opt_D_dump_mod_map = False
+enabledIfVerbose Opt_D_dump_ec_trace = False
+enabledIfVerbose _ = True
+
-- | Enumerates the simple on-or-off dynamic flags
data GeneralFlag
-- See Note [Updating flag description in the User's Guide]
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 67c6ff6938..ef7a7bdd08 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -1427,36 +1427,7 @@ hasNoOptCoercion = gopt Opt_G_NoOptCoercion
-- | Test whether a 'DumpFlag' is set
dopt :: DumpFlag -> DynFlags -> Bool
-dopt f dflags = (f `EnumSet.member` dumpFlags dflags)
- || (verbosity dflags >= 4 && enableIfVerbose f)
- where enableIfVerbose Opt_D_dump_tc_trace = False
- enableIfVerbose Opt_D_dump_rn_trace = False
- enableIfVerbose Opt_D_dump_cs_trace = False
- enableIfVerbose Opt_D_dump_if_trace = False
- enableIfVerbose Opt_D_dump_tc = False
- enableIfVerbose Opt_D_dump_rn = False
- enableIfVerbose Opt_D_dump_rn_stats = False
- enableIfVerbose Opt_D_dump_hi_diffs = False
- enableIfVerbose Opt_D_verbose_core2core = False
- enableIfVerbose Opt_D_verbose_stg2stg = False
- enableIfVerbose Opt_D_dump_splices = False
- enableIfVerbose Opt_D_th_dec_file = False
- enableIfVerbose Opt_D_dump_rule_firings = False
- enableIfVerbose Opt_D_dump_rule_rewrites = False
- enableIfVerbose Opt_D_dump_simpl_trace = False
- enableIfVerbose Opt_D_dump_rtti = False
- enableIfVerbose Opt_D_dump_inlinings = False
- enableIfVerbose Opt_D_dump_verbose_inlinings = False
- enableIfVerbose Opt_D_dump_core_stats = False
- enableIfVerbose Opt_D_dump_asm_stats = False
- enableIfVerbose Opt_D_dump_types = False
- enableIfVerbose Opt_D_dump_simpl_iterations = False
- enableIfVerbose Opt_D_dump_ticked = False
- enableIfVerbose Opt_D_dump_view_pattern_commoning = False
- enableIfVerbose Opt_D_dump_mod_cycles = False
- enableIfVerbose Opt_D_dump_mod_map = False
- enableIfVerbose Opt_D_dump_ec_trace = False
- enableIfVerbose _ = True
+dopt = getDumpFlagFrom verbosity dumpFlags
-- | Set a 'DumpFlag'
dopt_set :: DynFlags -> DumpFlag -> DynFlags
diff --git a/compiler/GHC/Utils/Logger.hs b/compiler/GHC/Utils/Logger.hs
index 878e6d52f4..83b2600439 100644
--- a/compiler/GHC/Utils/Logger.hs
+++ b/compiler/GHC/Utils/Logger.hs
@@ -146,7 +146,7 @@ defaultLogFlags = LogFlags
-- | Test if a DumpFlag is enabled
log_dopt :: DumpFlag -> LogFlags -> Bool
-log_dopt f logflags = f `EnumSet.member` log_dump_flags logflags
+log_dopt = getDumpFlagFrom log_verbosity log_dump_flags
-- | Enable a DumpFlag
log_set_dopt :: DumpFlag -> LogFlags -> LogFlags