summaryrefslogtreecommitdiff
path: root/compiler/GHC/Driver
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Driver')
-rw-r--r--compiler/GHC/Driver/Config/Diagnostic.hs14
-rw-r--r--compiler/GHC/Driver/Config/Tidy.hs15
-rw-r--r--compiler/GHC/Driver/Errors.hs12
-rw-r--r--compiler/GHC/Driver/Errors/Ppr.hs9
-rw-r--r--compiler/GHC/Driver/Errors/Types.hs18
-rw-r--r--compiler/GHC/Driver/Make.hs5
-rw-r--r--compiler/GHC/Driver/MakeFile.hs7
7 files changed, 43 insertions, 37 deletions
diff --git a/compiler/GHC/Driver/Config/Diagnostic.hs b/compiler/GHC/Driver/Config/Diagnostic.hs
index f4b709301b..1e8b5a1e67 100644
--- a/compiler/GHC/Driver/Config/Diagnostic.hs
+++ b/compiler/GHC/Driver/Config/Diagnostic.hs
@@ -8,11 +8,13 @@ module GHC.Driver.Config.Diagnostic
, initDsMessageOpts
, initTcMessageOpts
, initDriverMessageOpts
+ , initIfaceMessageOpts
)
where
import GHC.Driver.Flags
import GHC.Driver.Session
+import GHC.Prelude
import GHC.Utils.Outputable
import GHC.Utils.Error (DiagOpts (..))
@@ -22,6 +24,8 @@ import GHC.Tc.Errors.Types
import GHC.HsToCore.Errors.Types
import GHC.Types.Error
import GHC.Tc.Errors.Ppr
+import GHC.Iface.Errors.Types
+import GHC.Iface.Errors.Ppr
-- | Initialise the general configuration for printing diagnostic messages
-- For example, this configuration controls things like whether warnings are
@@ -50,11 +54,17 @@ initPsMessageOpts :: DynFlags -> DiagnosticOpts PsMessage
initPsMessageOpts _ = NoDiagnosticOpts
initTcMessageOpts :: DynFlags -> DiagnosticOpts TcRnMessage
-initTcMessageOpts dflags = TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags }
+initTcMessageOpts dflags =
+ TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags
+ , tcOptsIfaceOpts = initIfaceMessageOpts dflags }
initDsMessageOpts :: DynFlags -> DiagnosticOpts DsMessage
initDsMessageOpts _ = NoDiagnosticOpts
+initIfaceMessageOpts :: DynFlags -> DiagnosticOpts IfaceMessage
+initIfaceMessageOpts dflags =
+ IfaceMessageOpts { ifaceShowTriedFiles = verbosity dflags >= 3 }
+
initDriverMessageOpts :: DynFlags -> DiagnosticOpts DriverMessage
-initDriverMessageOpts dflags = DriverMessageOpts (initPsMessageOpts dflags)
+initDriverMessageOpts dflags = DriverMessageOpts (initPsMessageOpts dflags) (initIfaceMessageOpts dflags)
diff --git a/compiler/GHC/Driver/Config/Tidy.hs b/compiler/GHC/Driver/Config/Tidy.hs
index 89bdf31b2c..a02321ab78 100644
--- a/compiler/GHC/Driver/Config/Tidy.hs
+++ b/compiler/GHC/Driver/Config/Tidy.hs
@@ -17,11 +17,8 @@ import GHC.Driver.Env
import GHC.Driver.Backend
import GHC.Core.Make (getMkStringIds)
-import GHC.Data.Maybe
-import GHC.Utils.Panic
-import GHC.Utils.Outputable
import GHC.Builtin.Names
-import GHC.Tc.Utils.Env (lookupGlobal_maybe)
+import GHC.Tc.Utils.Env (lookupGlobal)
import GHC.Types.TyThing
import GHC.Platform.Ways
@@ -49,13 +46,9 @@ initStaticPtrOpts :: HscEnv -> IO StaticPtrOpts
initStaticPtrOpts hsc_env = do
let dflags = hsc_dflags hsc_env
- let lookupM n = lookupGlobal_maybe hsc_env n >>= \case
- Succeeded r -> pure r
- Failed err -> pprPanic "initStaticPtrOpts: couldn't find" (ppr (err,n))
-
- mk_string <- getMkStringIds (fmap tyThingId . lookupM)
- static_ptr_info_datacon <- tyThingDataCon <$> lookupM staticPtrInfoDataConName
- static_ptr_datacon <- tyThingDataCon <$> lookupM staticPtrDataConName
+ mk_string <- getMkStringIds (fmap tyThingId . lookupGlobal hsc_env )
+ static_ptr_info_datacon <- tyThingDataCon <$> lookupGlobal hsc_env staticPtrInfoDataConName
+ static_ptr_datacon <- tyThingDataCon <$> lookupGlobal hsc_env staticPtrDataConName
pure $ StaticPtrOpts
{ opt_platform = targetPlatform dflags
diff --git a/compiler/GHC/Driver/Errors.hs b/compiler/GHC/Driver/Errors.hs
index dd6834046b..ab62682517 100644
--- a/compiler/GHC/Driver/Errors.hs
+++ b/compiler/GHC/Driver/Errors.hs
@@ -13,7 +13,7 @@ import GHC.Types.SrcLoc
import GHC.Types.SourceError
import GHC.Types.Error
import GHC.Utils.Error
-import GHC.Utils.Outputable (hang, ppr, ($$), SDocContext, text, withPprStyle, mkErrStyle, sdocStyle )
+import GHC.Utils.Outputable (hang, ppr, ($$), text, mkErrStyle, sdocStyle, updSDocContext )
import GHC.Utils.Logger
import qualified GHC.Driver.CmdLine as CmdLine
@@ -22,21 +22,21 @@ printMessages logger msg_opts opts msgs
= sequence_ [ let style = mkErrStyle name_ppr_ctx
ctx = (diag_ppr_ctx opts) { sdocStyle = style }
in logMsg logger (MCDiagnostic sev (diagnosticReason dia) (diagnosticCode dia)) s $
- withPprStyle style (messageWithHints ctx dia)
+ updSDocContext (\_ -> ctx) (messageWithHints dia)
| MsgEnvelope { errMsgSpan = s,
errMsgDiagnostic = dia,
errMsgSeverity = sev,
errMsgContext = name_ppr_ctx }
<- sortMsgBag (Just opts) (getMessages msgs) ]
where
- messageWithHints :: Diagnostic a => SDocContext -> a -> SDoc
- messageWithHints ctx e =
- let main_msg = formatBulleted ctx $ diagnosticMessage msg_opts e
+ messageWithHints :: Diagnostic a => a -> SDoc
+ messageWithHints e =
+ let main_msg = formatBulleted $ diagnosticMessage msg_opts e
in case diagnosticHints e of
[] -> main_msg
[h] -> main_msg $$ hang (text "Suggested fix:") 2 (ppr h)
hs -> main_msg $$ hang (text "Suggested fixes:") 2
- (formatBulleted ctx . mkDecorated . map ppr $ hs)
+ (formatBulleted $ mkDecorated . map ppr $ hs)
handleFlagWarnings :: Logger -> GhcMessageOpts -> DiagOpts -> [CmdLine.Warn] -> IO ()
handleFlagWarnings logger print_config opts warns = do
diff --git a/compiler/GHC/Driver/Errors/Ppr.hs b/compiler/GHC/Driver/Errors/Ppr.hs
index 9e3822e460..a89e7992b1 100644
--- a/compiler/GHC/Driver/Errors/Ppr.hs
+++ b/compiler/GHC/Driver/Errors/Ppr.hs
@@ -16,7 +16,6 @@ import GHC.Driver.Flags
import GHC.Driver.Session
import GHC.HsToCore.Errors.Ppr ()
import GHC.Parser.Errors.Ppr ()
-import GHC.Tc.Errors.Ppr ()
import GHC.Types.Error
import GHC.Types.Error.Codes ( constructorCode )
import GHC.Unit.Types
@@ -30,6 +29,9 @@ import Data.Version
import Language.Haskell.Syntax.Decls (RuleDecl(..))
import GHC.Tc.Errors.Types (TcRnMessage)
import GHC.HsToCore.Errors.Types (DsMessage)
+import GHC.Iface.Errors.Types
+import GHC.Tc.Errors.Ppr ()
+import GHC.Iface.Errors.Ppr ()
--
-- Suggestions
@@ -86,7 +88,7 @@ instance Diagnostic GhcMessage where
instance Diagnostic DriverMessage where
type DiagnosticOpts DriverMessage = DriverMessageOpts
- defaultDiagnosticOpts = DriverMessageOpts (defaultDiagnosticOpts @PsMessage)
+ defaultDiagnosticOpts = DriverMessageOpts (defaultDiagnosticOpts @PsMessage) (defaultDiagnosticOpts @IfaceMessage)
diagnosticMessage opts = \case
DriverUnknownMessage (UnknownDiagnostic @e m)
-> diagnosticMessage (defaultDiagnosticOpts @e) m
@@ -218,6 +220,7 @@ instance Diagnostic DriverMessage where
-> mkSimpleDecorated $ vcat ([text "Home units are not closed."
, text "It is necessary to also load the following units:" ]
++ map (\uid -> text "-" <+> ppr uid) needed_unit_ids)
+ DriverInterfaceError reason -> diagnosticMessage (ifaceDiagnosticOpts opts) reason
diagnosticReason = \case
DriverUnknownMessage m
@@ -272,6 +275,7 @@ instance Diagnostic DriverMessage where
-> ErrorWithoutFlag
DriverHomePackagesNotClosed {}
-> ErrorWithoutFlag
+ DriverInterfaceError reason -> diagnosticReason reason
diagnosticHints = \case
DriverUnknownMessage m
@@ -328,5 +332,6 @@ instance Diagnostic DriverMessage where
-> noHints
DriverHomePackagesNotClosed {}
-> noHints
+ DriverInterfaceError reason -> diagnosticHints reason
diagnosticCode = constructorCode
diff --git a/compiler/GHC/Driver/Errors/Types.hs b/compiler/GHC/Driver/Errors/Types.hs
index c2ec9cbb0c..cbf0622025 100644
--- a/compiler/GHC/Driver/Errors/Types.hs
+++ b/compiler/GHC/Driver/Errors/Types.hs
@@ -8,7 +8,6 @@ module GHC.Driver.Errors.Types (
, DriverMessage(..)
, DriverMessageOpts(..)
, DriverMessages, PsMessage(PsHeaderMessage)
- , BuildingCabalPackage(..)
, WarningMessages
, ErrorMessages
, WarnMsg
@@ -32,7 +31,6 @@ import GHC.Unit.Module
import GHC.Unit.State
import GHC.Parser.Errors.Types ( PsMessage(PsHeaderMessage) )
-import GHC.Tc.Errors.Types ( TcRnMessage )
import GHC.HsToCore.Errors.Types ( DsMessage )
import GHC.Hs.Extension (GhcTc)
@@ -40,6 +38,9 @@ import Language.Haskell.Syntax.Decls (RuleDecl)
import GHC.Generics ( Generic )
+import GHC.Tc.Errors.Types
+import GHC.Iface.Errors.Types
+
-- | A collection of warning messages.
-- /INVARIANT/: Each 'GhcMessage' in the collection should have 'SevWarning' severity.
type WarningMessages = Messages GhcMessage
@@ -369,21 +370,18 @@ data DriverMessage where
DriverHomePackagesNotClosed :: ![UnitId] -> DriverMessage
+ DriverInterfaceError :: !IfaceMessage -> DriverMessage
+
deriving instance Generic DriverMessage
data DriverMessageOpts =
- DriverMessageOpts { psDiagnosticOpts :: DiagnosticOpts PsMessage }
+ DriverMessageOpts { psDiagnosticOpts :: DiagnosticOpts PsMessage
+ , ifaceDiagnosticOpts :: DiagnosticOpts IfaceMessage }
--- | Pass to a 'DriverMessage' the information whether or not the
--- '-fbuilding-cabal-package' flag is set.
-data BuildingCabalPackage
- = YesBuildingCabalPackage
- | NoBuildingCabalPackage
- deriving Eq
-- | Checks if we are building a cabal package by consulting the 'DynFlags'.
checkBuildingCabalPackage :: DynFlags -> BuildingCabalPackage
checkBuildingCabalPackage dflags =
if gopt Opt_BuildingCabalPackage dflags
then YesBuildingCabalPackage
- else NoBuildingCabalPackage
+ else NoBuildingCabalPackage \ No newline at end of file
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 7f60d5a8a0..d72b452d2e 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -153,6 +153,7 @@ import GHC.Utils.Constants
import GHC.Types.Unique.DFM (udfmRestrictKeysSet)
import qualified Data.IntSet as I
import GHC.Types.Unique
+import GHC.Iface.Errors.Types
-- -----------------------------------------------------------------------------
@@ -2336,8 +2337,8 @@ noModError :: HscEnv -> SrcSpan -> ModuleName -> FindResult -> MsgEnvelope GhcMe
-- ToDo: we don't have a proper line number for this error
noModError hsc_env loc wanted_mod err
= mkPlainErrorMsgEnvelope loc $ GhcDriverMessage $
- DriverUnknownMessage $ UnknownDiagnostic $ mkPlainError noHints $
- cannotFindModule hsc_env wanted_mod err
+ DriverInterfaceError $
+ (Can'tFindInterface (cannotFindModule hsc_env wanted_mod err) (LookingForModule wanted_mod NotBoot))
{-
noHsFileErr :: SrcSpan -> String -> DriverMessages
diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs
index a770637311..be20bfd89f 100644
--- a/compiler/GHC/Driver/MakeFile.hs
+++ b/compiler/GHC/Driver/MakeFile.hs
@@ -27,7 +27,6 @@ import GHC.Data.Graph.Directed ( SCC(..) )
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
-import GHC.Types.Error (UnknownDiagnostic(..))
import GHC.Types.SourceError
import GHC.Types.SrcLoc
import GHC.Types.PkgQual
@@ -53,6 +52,7 @@ import Control.Monad ( when, forM_ )
import Data.Maybe ( isJust )
import Data.IORef
import qualified Data.Set as Set
+import GHC.Iface.Errors.Types
-----------------------------------------------------------------
--
@@ -307,9 +307,8 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do
fail ->
throwOneError $
mkPlainErrorMsgEnvelope srcloc $
- GhcDriverMessage $ DriverUnknownMessage $
- UnknownDiagnostic $ mkPlainError noHints $
- cannotFindModule hsc_env imp fail
+ GhcDriverMessage $ DriverInterfaceError $
+ (Can'tFindInterface (cannotFindModule hsc_env imp fail) (LookingForModule imp is_boot))
-----------------------------
writeDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO ()
View Lorry Controller Status