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/Utils | |
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/Utils')
-rw-r--r-- | compiler/GHC/Utils/Error.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Utils/Logger.hs | 15 |
2 files changed, 11 insertions, 7 deletions
diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs index 2ee1763ebb..d18791d0c6 100644 --- a/compiler/GHC/Utils/Error.hs +++ b/compiler/GHC/Utils/Error.hs @@ -87,7 +87,8 @@ import System.CPUTime -- particular diagnostic message is built, otherwise the computed 'Severity' might -- not be correct, due to the mutable nature of the 'DynFlags' in GHC. diagReasonSeverity :: DynFlags -> DiagnosticReason -> Severity -diagReasonSeverity dflags (WarningWithFlag wflag) | wopt_fatal wflag dflags = SevError +diagReasonSeverity dflags (WarningWithFlag wflag) | not (wopt wflag dflags) = SevIgnore + | wopt_fatal wflag dflags = SevError | otherwise = SevWarning diagReasonSeverity dflags WarningWithoutFlag | gopt Opt_WarnIsError dflags = SevError | otherwise = SevWarning diff --git a/compiler/GHC/Utils/Logger.hs b/compiler/GHC/Utils/Logger.hs index fbbacb2b48..2e5a9b06a7 100644 --- a/compiler/GHC/Utils/Logger.hs +++ b/compiler/GHC/Utils/Logger.hs @@ -198,6 +198,7 @@ makeThreadSafe logger = do -- See Note [JSON Error Messages] -- jsonLogAction :: LogAction +jsonLogAction _ (MCDiagnostic SevIgnore _) _ _ = return () -- suppress the message jsonLogAction dflags msg_class srcSpan msg = defaultLogActionHPutStrDoc dflags True stdout @@ -214,12 +215,13 @@ defaultLogAction :: LogAction defaultLogAction dflags msg_class srcSpan msg | dopt Opt_D_dump_json dflags = jsonLogAction dflags msg_class srcSpan msg | otherwise = case msg_class of - MCOutput -> printOut msg - MCDump -> printOut (msg $$ blankLine) - MCInteractive -> putStrSDoc msg - MCInfo -> printErrs msg - MCFatal -> printErrs msg - MCDiagnostic sev rea -> printDiagnostics sev rea + MCOutput -> printOut msg + MCDump -> printOut (msg $$ blankLine) + MCInteractive -> putStrSDoc msg + MCInfo -> printErrs msg + MCFatal -> printErrs msg + MCDiagnostic SevIgnore _ -> pure () -- suppress the message + MCDiagnostic sev rea -> printDiagnostics sev rea where printOut = defaultLogActionHPrintDoc dflags False stdout printErrs = defaultLogActionHPrintDoc dflags False stderr @@ -242,6 +244,7 @@ defaultLogAction dflags msg_class srcSpan msg -- each unicode char. flagMsg :: Severity -> DiagnosticReason -> Maybe String + flagMsg SevIgnore _ = panic "Called flagMsg with SevIgnore" flagMsg SevError WarningWithoutFlag = Just "-Werror" flagMsg SevError (WarningWithFlag wflag) = do spec <- flagSpecOf wflag |