summaryrefslogtreecommitdiff
path: root/compiler/GHC/Rename
diff options
context:
space:
mode:
authorAlfredo Di Napoli <alfredo@well-typed.com>2021-03-09 09:11:47 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-04-05 20:39:54 -0400
commit495281215ae0fdcb296b2b30c1efd3a683006f42 (patch)
tree721e48d12c7bd79f05eb03f4a4d3c7114a71f9b8 /compiler/GHC/Rename
parent77772bb122410ef58ff006a1d18c6f2212216fda (diff)
downloadhaskell-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.hs3
-rw-r--r--compiler/GHC/Rename/HsType.hs3
-rw-r--r--compiler/GHC/Rename/Module.hs19
-rw-r--r--compiler/GHC/Rename/Names.hs13
-rw-r--r--compiler/GHC/Rename/Splice.hs7
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