diff options
author | Dominik Peteler <haskell+gitlab@with-h.at> | 2022-07-14 15:23:32 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-07-16 07:23:43 -0400 |
commit | b27c2774fb8191e566bcae0ed7b06bb96afa466b (patch) | |
tree | f9c6e19eefda7f284bd5e088b77328620d65985f | |
parent | 3acbd7ad4a5ee3246c694674e6248a935430104c (diff) | |
download | haskell-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.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Driver/Flags.hs | 42 | ||||
-rw-r--r-- | compiler/GHC/Driver/Session.hs | 31 | ||||
-rw-r--r-- | compiler/GHC/Utils/Logger.hs | 2 |
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 |