summaryrefslogtreecommitdiff
path: root/compiler/GHC.hs
diff options
context:
space:
mode:
authorAlfredo Di Napoli <alfredo@well-typed.com>2021-03-01 09:27:54 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-04-01 16:13:23 -0400
commit15b6c9f920d8f60ebfef4580ec7e8f063799a83a (patch)
tree7e40890412df649c043881b57d44e6a157f4108c /compiler/GHC.hs
parentd44e42a26e54857cc6174f2bb7dc86cc41fcd249 (diff)
downloadhaskell-15b6c9f920d8f60ebfef4580ec7e8f063799a83a.tar.gz
Compute Severity of diagnostics at birth
This commit further expand on the design for #18516 by getting rid of the `defaultReasonSeverity` in favour of a function called `diagReasonSeverity` which correctly takes the `DynFlags` as input. The idea is to compute the `Severity` and the `DiagnosticReason` of each message "at birth", without doing any later re-classifications, which are potentially error prone, as the `DynFlags` might evolve during the course of the program. In preparation for a proper refactoring, now `pprWarning` from the Parser.Ppr module has been renamed to `mkParserWarn`, which now takes a `DynFlags` as input. We also get rid of the reclassification we were performing inside `printOrThrowWarnings`. Last but not least, this commit removes the need for reclassify inside GHC.Tc.Errors, and also simplifies the implementation of `maybeReportError`. Update Haddock submodule
Diffstat (limited to 'compiler/GHC.hs')
-rw-r--r--compiler/GHC.hs12
1 files changed, 6 insertions, 6 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index f77ab69532..4ba5e9b68a 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -907,8 +907,8 @@ checkNewInteractiveDynFlags logger dflags0 = do
-- We currently don't support use of StaticPointers in expressions entered on
-- the REPL. See #12356.
if xopt LangExt.StaticPointers dflags0
- then do liftIO $ printOrThrowWarnings logger dflags0 $ listToBag
- [mkPlainMsgEnvelope Session.WarningWithoutFlag interactiveSrcSpan
+ then do liftIO $ printOrThrowDiagnostics logger dflags0 $ listToBag
+ [mkPlainMsgEnvelope dflags0 Session.WarningWithoutFlag interactiveSrcSpan
$ text "StaticPointers is not supported in GHCi interactive expressions."]
return $ xopt_unset dflags0 LangExt.StaticPointers
else return dflags0
@@ -1605,7 +1605,7 @@ getTokenStream mod = do
let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
case lexTokenStream (initParserOpts dflags) source startLoc of
POk _ ts -> return ts
- PFailed pst -> throwErrors (fmap pprError (getErrorMessages pst))
+ PFailed pst -> throwErrors (fmap mkParserErr (getErrorMessages pst))
-- | Give even more information on the source than 'getTokenStream'
-- This function allows reconstructing the source completely with
@@ -1616,7 +1616,7 @@ getRichTokenStream mod = do
let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
case lexTokenStream (initParserOpts dflags) source startLoc of
POk _ ts -> return $ addSourceToTokens startLoc source ts
- PFailed pst -> throwErrors (fmap pprError (getErrorMessages pst))
+ PFailed pst -> throwErrors (fmap mkParserErr (getErrorMessages pst))
-- | Given a source location and a StringBuffer corresponding to this
-- location, return a rich token stream with the source associated to the
@@ -1796,11 +1796,11 @@ parser str dflags filename =
PFailed pst ->
let (warns,errs) = getMessages pst in
- (fmap pprWarning warns, Left (fmap pprError errs))
+ (fmap (mkParserWarn dflags) warns, Left (fmap mkParserErr errs))
POk pst rdr_module ->
let (warns,_) = getMessages pst in
- (fmap pprWarning warns, Right rdr_module)
+ (fmap (mkParserWarn dflags) warns, Right rdr_module)
-- -----------------------------------------------------------------------------
-- | Find the package environment (if one exists)