diff options
author | Alfredo Di Napoli <alfredo@well-typed.com> | 2021-03-09 09:11:47 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-04-05 20:39:54 -0400 |
commit | 495281215ae0fdcb296b2b30c1efd3a683006f42 (patch) | |
tree | 721e48d12c7bd79f05eb03f4a4d3c7114a71f9b8 /compiler/GHC/Rename | |
parent | 77772bb122410ef58ff006a1d18c6f2212216fda (diff) | |
download | haskell-495281215ae0fdcb296b2b30c1efd3a683006f42.tar.gz |
Introduce SevIgnore Severity to suppress warnings
This commit introduces a new `Severity` type constructor called
`SevIgnore`, which can be used to classify diagnostic messages which are
not meant to be displayed to the user, for example suppressed warnings.
This extra constructor allows us to get rid of a bunch of redundant
checks when emitting diagnostics, typically in the form of the pattern:
```
when (optM Opt_XXX) $
addDiagnosticTc (WarningWithFlag Opt_XXX) ...
```
Fair warning! Not all checks should be omitted/skipped, as evaluating some data
structures used to produce a diagnostic might still be expensive (e.g.
zonking, etc). Therefore, a case-by-case analysis must be conducted when
deciding if a check can be removed or not.
Last but not least, we remove the unnecessary `CmdLine.WarnReason` type, which is now
redundant with `DiagnosticReason`.
Diffstat (limited to 'compiler/GHC/Rename')
-rw-r--r-- | compiler/GHC/Rename/Env.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Rename/HsType.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Rename/Module.hs | 19 | ||||
-rw-r--r-- | compiler/GHC/Rename/Names.hs | 13 | ||||
-rw-r--r-- | compiler/GHC/Rename/Splice.hs | 7 |
5 files changed, 19 insertions, 26 deletions
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs index da2794f805..67b3d0d8c0 100644 --- a/compiler/GHC/Rename/Env.hs +++ b/compiler/GHC/Rename/Env.hs @@ -1047,8 +1047,7 @@ lookup_demoted rdr_name ; case mb_demoted_name of Nothing -> unboundNameX WL_Any rdr_name star_info Just demoted_name -> - do { whenWOptM Opt_WarnUntickedPromotedConstructors $ - addDiagnostic + do { addDiagnostic (WarningWithFlag Opt_WarnUntickedPromotedConstructors) (untickedPromConstrWarn demoted_name) ; return demoted_name } } diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs index 07cc79fd17..fbdcc15730 100644 --- a/compiler/GHC/Rename/HsType.hs +++ b/compiler/GHC/Rename/HsType.hs @@ -1648,8 +1648,7 @@ dataKindsErr env thing warnUnusedForAll :: OutputableBndrFlag flag 'Renamed => HsDocContext -> LHsTyVarBndr flag GhcRn -> FreeVars -> TcM () warnUnusedForAll doc (L loc tv) used_names - = whenWOptM Opt_WarnUnusedForalls $ - unless (hsTyVarName tv `elemNameSet` used_names) $ + = unless (hsTyVarName tv `elemNameSet` used_names) $ addDiagnosticAt (WarningWithFlag Opt_WarnUnusedForalls) (locA loc) $ vcat [ text "Unused quantified type variable" <+> quotes (ppr tv) , inHsDocContext doc ] diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs index b5c91c8cc3..d5a787f9ab 100644 --- a/compiler/GHC/Rename/Module.hs +++ b/compiler/GHC/Rename/Module.hs @@ -1945,16 +1945,15 @@ warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) -> RnM () warnNoDerivStrat mds loc = do { dyn_flags <- getDynFlags - ; when (wopt Opt_WarnMissingDerivingStrategies dyn_flags) $ - case mds of - Nothing -> addDiagnosticAt - (WarningWithFlag Opt_WarnMissingDerivingStrategies) - loc - (if xopt LangExt.DerivingStrategies dyn_flags - then no_strat_warning - else no_strat_warning $+$ deriv_strat_nenabled - ) - _ -> pure () + ; case mds of + Nothing -> addDiagnosticAt + (WarningWithFlag Opt_WarnMissingDerivingStrategies) + loc + (if xopt LangExt.DerivingStrategies dyn_flags + then no_strat_warning + else no_strat_warning $+$ deriv_strat_nenabled + ) + _ -> pure () } where no_strat_warning :: SDoc diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs index aa5019895f..0502d8d962 100644 --- a/compiler/GHC/Rename/Names.hs +++ b/compiler/GHC/Rename/Names.hs @@ -394,12 +394,10 @@ rnImportDecl this_mod imports = calculateAvails home_unit iface mod_safe' want_boot (ImportedByUser imv) -- Complain if we import a deprecated module - whenWOptM Opt_WarnWarningsDeprecations ( - case (mi_warns iface) of - WarnAll txt -> addDiagnostic (WarningWithFlag Opt_WarnWarningsDeprecations) - (moduleWarn imp_mod_name txt) - _ -> return () - ) + case mi_warns iface of + WarnAll txt -> addDiagnostic (WarningWithFlag Opt_WarnWarningsDeprecations) + (moduleWarn imp_mod_name txt) + _ -> return () -- Complain about -Wcompat-unqualified-imports violations. warnUnqualifiedImport decl iface @@ -522,8 +520,7 @@ calculateAvails home_unit iface mod_safe' want_boot imported_by = -- Currently not used for anything. warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> RnM () warnUnqualifiedImport decl iface = - whenWOptM Opt_WarnCompatUnqualifiedImports - $ when bad_import + when bad_import $ addDiagnosticAt (WarningWithFlag Opt_WarnCompatUnqualifiedImports) loc warning where mod = mi_module iface diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs index b41170014c..f3bab6c3fe 100644 --- a/compiler/GHC/Rename/Splice.hs +++ b/compiler/GHC/Rename/Splice.hs @@ -912,10 +912,9 @@ check_cross_stage_lifting top_lvl name ps_var pend_splice = PendingRnSplice UntypedExpSplice name lift_expr -- Warning for implicit lift (#17804) - ; whenWOptM Opt_WarnImplicitLift $ - addDiagnosticTc (WarningWithFlag Opt_WarnImplicitLift) - (text "The variable" <+> quotes (ppr name) <+> - text "is implicitly lifted in the TH quotation") + ; addDiagnosticTc (WarningWithFlag Opt_WarnImplicitLift) + (text "The variable" <+> quotes (ppr name) <+> + text "is implicitly lifted in the TH quotation") -- Update the pending splices ; ps <- readMutVar ps_var |