From b27c2774fb8191e566bcae0ed7b06bb96afa466b Mon Sep 17 00:00:00 2001 From: Dominik Peteler Date: Thu, 14 Jul 2022 15:23:32 +0200 Subject: 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 --- compiler/GHC.hs | 2 +- compiler/GHC/Driver/Flags.hs | 42 ++++++++++++++++++++++++++++++++++++++++++ compiler/GHC/Driver/Session.hs | 31 +------------------------------ 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 -- cgit v1.2.1