[Git][ghc/ghc][wip/interface-loading-errs] refactor interface error datatypes
sheaf (@sheaf)
gitlab at gitlab.haskell.org
Wed Mar 15 15:40:08 UTC 2023
sheaf pushed to branch wip/interface-loading-errs at Glasgow Haskell Compiler / GHC
Commits:
bd925623 by sheaf at 2023-03-15T16:39:51+01:00
refactor interface error datatypes
- - - - -
16 changed files:
- compiler/GHC/Driver/Config/Diagnostic.hs
- compiler/GHC/Driver/Config/Tidy.hs
- compiler/GHC/Driver/Errors/Ppr.hs
- compiler/GHC/Iface/Errors.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/Error/Codes.hs
Changes:
=====================================
compiler/GHC/Driver/Config/Diagnostic.hs
=====================================
@@ -49,8 +49,9 @@ initPsMessageOpts :: DynFlags -> DiagnosticOpts PsMessage
initPsMessageOpts _ = NoDiagnosticOpts
initTcMessageOpts :: DynFlags -> DiagnosticOpts TcRnMessage
-initTcMessageOpts dflags = TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags
- , tcOptsShowTriedFiles = verbosity dflags >= 3 }
+initTcMessageOpts dflags =
+ TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags
+ , tcOptsShowTriedFiles = verbosity dflags >= 3 }
initDsMessageOpts :: DynFlags -> DiagnosticOpts DsMessage
initDsMessageOpts _ = NoDiagnosticOpts
=====================================
compiler/GHC/Driver/Config/Tidy.hs
=====================================
@@ -28,7 +28,6 @@ import GHC.Platform.Ways
import qualified GHC.LanguageExtensions as LangExt
import GHC.Types.Error
import GHC.Utils.Error
-import GHC.Tc.Errors.Types (TcRnMessage(..))
import GHC.Driver.Config.Diagnostic (initTcMessageOpts)
initTidyOpts :: HscEnv -> IO TidyOpts
@@ -56,11 +55,10 @@ initStaticPtrOpts hsc_env = do
let lookupM n = lookupGlobal_maybe hsc_env n >>= \case
Succeeded r -> pure r
Failed err ->
- let txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError err)
+ let txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) err
in pprPanic "initStaticPtrOpts: couldn't find" (ppr (txt, n))
-
mk_string <- getMkStringIds (fmap tyThingId . lookupM)
static_ptr_info_datacon <- tyThingDataCon <$> lookupM staticPtrInfoDataConName
static_ptr_datacon <- tyThingDataCon <$> lookupM staticPtrDataConName
=====================================
compiler/GHC/Driver/Errors/Ppr.hs
=====================================
@@ -16,7 +16,7 @@ import GHC.Driver.Flags
import GHC.Driver.Session
import GHC.HsToCore.Errors.Ppr ()
import GHC.Parser.Errors.Ppr ()
-import GHC.Tc.Errors.Ppr (missingInterfaceErrorHints, missingInterfaceErrorReason, missingInterfaceErrorDiagnostic)
+import GHC.Tc.Errors.Ppr
import GHC.Types.Error
import GHC.Types.Error.Codes ( constructorCode )
import GHC.Unit.Types
=====================================
compiler/GHC/Iface/Errors.hs
=====================================
@@ -16,28 +16,26 @@ import GHC.Driver.Env
import GHC.Driver.Errors.Types
import GHC.Data.Maybe
import GHC.Prelude
+import GHC.Tc.Errors.Types
import GHC.Unit
import GHC.Unit.Env
import GHC.Unit.Finder.Types
import GHC.Utils.Outputable as Outputable
-import GHC.Tc.Errors.Types (MissingInterfaceError (..), CantFindInstalled(..), CantFindInstalledReason(..), CantFindWhat(..), BuildingCabalPackage)
+-- -----------------------------------------------------------------------------
+-- Error messages
badIfaceFile :: String -> SDoc -> SDoc
badIfaceFile file err
= vcat [text "Bad interface file:" <+> text file,
nest 4 err]
-
-
-
--- -----------------------------------------------------------------------------
--- Error messages
-
-cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile -> ModuleName -> InstalledFindResult -> MissingInterfaceError
-cannotFindInterface us mhu p mn ifr = CantFindInstalledErr (cantFindInstalledErr CantLoadInterface
- AmbiguousInterface us mhu p mn ifr)
-
+cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile
+ -> ModuleName -> InstalledFindResult -> MissingInterfaceError
+cannotFindInterface us mhu p mn ifr =
+ CantFindInstalledErr $
+ cantFindInstalledErr CantLoadInterface
+ AmbiguousInterface us mhu p mn ifr
cantFindInstalledErr
:: CantFindWhat
@@ -96,11 +94,13 @@ cannotFindModule hsc_env = cannotFindModule'
(targetProfile (hsc_dflags hsc_env))
-cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> MissingInterfaceError
-cannotFindModule' dflags unit_env profile mod res = CantFindErr (ue_units unit_env) $
+cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult
+ -> MissingInterfaceError
+cannotFindModule' dflags unit_env profile mod res =
+ CantFindErr (ue_units unit_env) $
cantFindErr (checkBuildingCabalPackage dflags)
cannotFindMsg
- AmbigiousModule
+ AmbiguousModule
unit_env
profile
mod
@@ -125,15 +125,7 @@ cantFindErr
-> FindResult
-> CantFindInstalled
cantFindErr _ _ multiple_found _ _ mod_name (FoundMultiple mods)
- | Just pkgs <- unambiguousPackages
- = CantFindInstalled mod_name multiple_found (MultiplePackages pkgs)
- | otherwise
- = CantFindInstalled mod_name multiple_found (MultiplePackages2 mods)
- where
- unambiguousPackages = foldl' unambiguousPackage (Just []) mods
- unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _)
- = Just (moduleUnit m : xs)
- unambiguousPackage _ _ = Nothing
+ = CantFindInstalled mod_name multiple_found (MultiplePackages mods)
cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result
= CantFindInstalled mod_name cannot_find more_info
@@ -163,7 +155,9 @@ cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result
-> NotAModule
| otherwise
- -> GenericMissing using_cabal (map ((\uid -> (uid, lookupUnit (ue_units unit_env) uid))) pkg_hiddens) mod_hiddens unusables files
+ -> GenericMissing using_cabal
+ (map ((\uid -> (uid, lookupUnit (ue_units unit_env) uid))) pkg_hiddens)
+ mod_hiddens unusables files
_ -> panic "cantFindErr"
build_tag = waysBuildTag (profileWays profile)
@@ -177,4 +171,4 @@ cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result
MissingPackageWayFiles build pkg files
| otherwise
- = MissingPackageFiles pkg files
\ No newline at end of file
+ = MissingPackageFiles pkg files
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -143,7 +143,7 @@ where the code that e1 expands to might import some defns that
also turn out to be needed by the code that e2 expands to.
-}
-tcLookupImported_maybe :: Name -> TcM (MaybeErr MissingInterfaceError TyThing)
+tcLookupImported_maybe :: Name -> TcM (MaybeErr InterfaceError TyThing)
-- Returns (Failed err) if we can't find the interface file for the thing
tcLookupImported_maybe name
= do { hsc_env <- getTopEnv
@@ -152,7 +152,7 @@ tcLookupImported_maybe name
Just thing -> return (Succeeded thing)
Nothing -> tcImportDecl_maybe name }
-tcImportDecl_maybe :: Name -> TcM (MaybeErr MissingInterfaceError TyThing)
+tcImportDecl_maybe :: Name -> TcM (MaybeErr InterfaceError TyThing)
-- Entry point for *source-code* uses of importDecl
tcImportDecl_maybe name
| Just thing <- wiredInNameTyThing_maybe name
@@ -163,7 +163,7 @@ tcImportDecl_maybe name
| otherwise
= initIfaceTcRn (importDecl name)
-importDecl :: Name -> IfM lcl (MaybeErr MissingInterfaceError TyThing)
+importDecl :: Name -> IfM lcl (MaybeErr InterfaceError TyThing)
-- Get the TyThing for this Name from an interface file
-- It's not a wired-in thing -- the caller caught that
importDecl name
@@ -174,15 +174,18 @@ importDecl name
-- Load the interface, which should populate the PTE
; mb_iface <- assertPpr (isExternalName name) (ppr name) $
loadInterface nd_doc (nameModule name) ImportBySystem
- ; case mb_iface of {
- Failed err_msg -> return (Failed err_msg) ;
- Succeeded _ -> do
+ ; case mb_iface of
+ { Failed err_msg -> return $ Failed $
+ Can'tFindInterface err_msg (LookingForName name)
+ ; Succeeded _ -> do
-- Now look it up again; this time we should find it
{ eps <- getEps
; case lookupTypeEnv (eps_PTE eps) name of
Just thing -> return $ Succeeded thing
- Nothing -> return $ Failed (MissingDeclInInterface name (filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps))
+ Nothing -> return $ Failed $
+ Can'tFindNameInInterface name
+ (filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps)
}}}
where
nd_doc = text "Need decl for" <+> ppr name
@@ -289,8 +292,14 @@ loadSrcInterface :: SDoc
loadSrcInterface doc mod want_boot maybe_pkg
= do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg
; case res of
- Failed err -> failWithTc (TcRnMissingInterfaceError err)
- Succeeded iface -> return iface }
+ Failed err ->
+ failWithTc $
+ TcRnInterfaceError $
+ Can'tFindInterface err $
+ LookingForModule mod want_boot
+ Succeeded iface ->
+ return iface
+ }
-- | Like 'loadSrcInterface', but returns a 'MaybeErr'.
loadSrcInterface_maybe :: SDoc
@@ -886,8 +895,8 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
_ -> do
r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc)
case r of
- Failed _
- -> return r
+ Failed err
+ -> return (Failed $ BadIfaceFile err)
Succeeded (iface,_fp)
-> do
r2 <- load_dynamic_too_maybe logger name_cache unit_state
@@ -895,7 +904,7 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
iface loc
case r2 of
Failed sdoc -> return (Failed sdoc)
- Succeeded {} -> return r
+ Succeeded {} -> return $ Succeeded (iface,_fp)
err -> do
trace_if logger (text "...not found")
return $ Failed $ cannotFindInterface
@@ -906,14 +915,18 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
err
-- | Check if we need to try the dynamic interface for -dynamic-too
-load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr MissingInterfaceError ())
+load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags
+ -> Module -> ModIface -> ModLocation
+ -> IO (MaybeErr MissingInterfaceError ())
load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod iface loc
-- Indefinite interfaces are ALWAYS non-dynamic.
| not (moduleIsDefinite (mi_module iface)) = return (Succeeded ())
| gopt Opt_BuildDynamicToo dflags = load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc
| otherwise = return (Succeeded ())
-load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr MissingInterfaceError ())
+load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags
+ -> Module -> ModIface -> ModLocation
+ -> IO (MaybeErr MissingInterfaceError ())
load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do
read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case
Succeeded (dynIface, _)
@@ -929,7 +942,9 @@ load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do
-read_file :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr MissingInterfaceError (ModIface, FilePath))
+read_file :: Logger -> NameCache -> UnitState -> DynFlags
+ -> Module -> FilePath
+ -> IO (MaybeErr ReadInterfaceError (ModIface, FilePath))
read_file logger name_cache unit_state dflags wanted_mod file_path = do
trace_if logger (text "readIFace" <+> text file_path)
@@ -944,7 +959,7 @@ read_file logger name_cache unit_state dflags wanted_mod file_path = do
(uninstantiateInstantiatedModule indef_mod)
read_result <- readIface dflags name_cache wanted_mod' file_path
case read_result of
- Failed err -> return (Failed (BadIfaceFile file_path err))
+ Failed err -> return (Failed err)
Succeeded iface -> return (Succeeded (iface, file_path))
-- Don't forget to fill in the package name...
@@ -965,7 +980,7 @@ readIface
-> NameCache
-> Module
-> FilePath
- -> IO (MaybeErr MissingInterfaceError ModIface)
+ -> IO (MaybeErr ReadInterfaceError ModIface)
readIface dflags name_cache wanted_mod file_path = do
let profile = targetProfile dflags
res <- tryMost $ readBinIface profile name_cache CheckHiWay QuietBinIFace file_path
@@ -979,9 +994,9 @@ readIface dflags name_cache wanted_mod file_path = do
| otherwise -> return (Failed err)
where
actual_mod = mi_module iface
- err = HiModuleNameMismatchWarn wanted_mod actual_mod
+ err = HiModuleNameMismatchWarn file_path wanted_mod actual_mod
- Left exn -> return (Failed (GenericException exn))
+ Left exn -> return (Failed (ExceptionOccurred file_path exn))
{-
*********************************************************
=====================================
compiler/GHC/Iface/Recomp.hs
=====================================
@@ -35,6 +35,7 @@ import GHC.Iface.Recomp.Flags
import GHC.Iface.Env
import GHC.Core
+import GHC.Tc.Errors.Ppr
import GHC.Tc.Utils.Monad
import GHC.Hs
@@ -83,7 +84,6 @@ import GHC.List (uncons)
import Data.Ord
import Data.Containers.ListUtils
import Data.Bifunctor
-import GHC.Tc.Errors.Ppr (missingInterfaceErrorDiagnostic)
{-
-----------------------------------------------
@@ -293,8 +293,13 @@ check_old_iface hsc_env mod_summary maybe_iface
read_result <- readIface read_dflags ncu (ms_mod mod_summary) iface_path
case read_result of
Failed err -> do
- trace_if logger (text "FYI: cannot read old interface file:" $$ nest 4 (formatBulleted $ missingInterfaceErrorDiagnostic False err))
- trace_hi_diffs logger (text "Old interface file was invalid:" $$ nest 4 (formatBulleted $ missingInterfaceErrorDiagnostic False err))
+ let blah = readInterfaceErrorDiagnostic err
+ trace_if logger
+ $ vcat [ text "FYI: cannot read old interface file:"
+ , nest 4 (formatBulleted blah) ]
+ trace_hi_diffs logger $
+ vcat [ text "Old interface file was invalid:"
+ , nest 4 (formatBulleted blah) ]
return Nothing
Succeeded iface -> do
trace_if logger (text "Read the interface file" <+> text iface_path)
=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -50,6 +50,7 @@ import GHC.StgToCmm.Types
import GHC.Runtime.Heap.Layout
import GHC.Tc.Errors.Types
+import GHC.Tc.Errors.Ppr
import GHC.Tc.TyCl.Build
import GHC.Tc.Utils.Monad
import GHC.Tc.Utils.TcType
@@ -130,7 +131,7 @@ import GHC.Unit.Module.WholeCoreBindings
import Data.IORef
import Data.Foldable
import GHC.Builtin.Names (ioTyConName, rOOT_MAIN)
-import GHC.Tc.Errors.Ppr (missingInterfaceErrorDiagnostic)
+
import GHC.Utils.Error
{-
@@ -576,13 +577,14 @@ tcHiBootIface hsc_src mod
-- to check consistency against, rather than just when we notice
-- that an hi-boot is necessary due to a circular import.
{ hsc_env <- getTopEnv
- ; read_result <- liftIO $ findAndReadIface hsc_env
- need (fst (getModuleInstantiation mod)) mod
- IsBoot -- Hi-boot file
+ ; read_result <- liftIO $ findAndReadIface hsc_env need
+ (fst (getModuleInstantiation mod)) mod
+ IsBoot -- Hi-boot file
; case read_result of {
- Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface
- ; mkSelfBootInfo iface tc_iface } ;
+ Succeeded (iface, _path) ->
+ do { tc_iface <- initIfaceTcRn $ typecheckIface iface
+ ; mkSelfBootInfo iface tc_iface } ;
Failed err ->
-- There was no hi-boot file. But if there is circularity in
@@ -598,7 +600,10 @@ tcHiBootIface hsc_src mod
Nothing -> return NoSelfBoot
-- error cases
Just (GWIB { gwib_isBoot = is_boot }) -> case is_boot of
- IsBoot -> failWithTc (TcRnMissingInterfaceError (CantFindHiBoot mod err))
+ IsBoot ->
+ let diag = Can'tFindInterface err
+ (LookingForHiBoot mod)
+ in failWithTc (TcRnInterfaceError diag)
-- The hi-boot file has mysteriously disappeared.
NotBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints moduleLoop)
-- Someone below us imported us!
@@ -1961,7 +1966,7 @@ tcIfaceGlobal name
{ mb_thing <- importDecl name -- It's imported; go get it
; case mb_thing of
- Failed err -> failIfM (ppr name <+> (formatBulleted $ missingInterfaceErrorDiagnostic False err))
+ Failed err -> failIfM (ppr name <+> (formatBulleted $ interfaceErrorDiagnostic False err))
Succeeded thing -> return thing
}}}
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -48,6 +48,7 @@ import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Finder
import GHC.Tc.Utils.Monad
+import GHC.Tc.Errors.Ppr
import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
@@ -120,7 +121,6 @@ import GHC.Iface.Load
import GHC.Unit.Home
import Data.Either
import Control.Applicative
-import GHC.Tc.Errors.Types (TcRnMessage(..))
uninitialised :: a
uninitialised = panic "Loader not initialised"
@@ -792,8 +792,9 @@ getLinkDeps hsc_env pls replace_osuf span mods
mb_iface <- initIfaceCheck (text "getLinkDeps") hsc_env $
loadInterface msg mod (ImportByUser NotBoot)
iface <- case mb_iface of
- Maybes.Failed err ->
- let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError err)
+ Maybes.Failed err ->
+ let tries = tcOptsShowTriedFiles $ initTcMessageOpts dflags
+ err_txt = formatBulleted $ missingInterfaceErrorDiagnostic tries err
in throwGhcExceptionIO (ProgramError (showSDoc dflags err_txt))
Maybes.Succeeded iface -> return iface
=====================================
compiler/GHC/Runtime/Loader.hs
=====================================
@@ -44,6 +44,8 @@ import GHC.Core.Type ( Type, mkTyConTy )
import GHC.Core.TyCo.Compare( eqType )
import GHC.Core.TyCon ( TyCon )
+import GHC.Tc.Errors.Ppr
+
import GHC.Types.SrcLoc ( noSrcSpan )
import GHC.Types.Name ( Name, nameModule_maybe )
import GHC.Types.Id ( idType )
@@ -52,11 +54,13 @@ import GHC.Types.Name.Occurrence ( OccName, mkVarOccFS )
import GHC.Types.Name.Reader ( RdrName, ImportSpec(..), ImpDeclSpec(..)
, ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName
, greMangledName, mkRdrQual )
+import GHC.Types.Unique.DFM
import GHC.Unit.Finder ( findPluginModule, FindResult(..) )
import GHC.Driver.Config.Finder ( initFinderOpts )
+import GHC.Driver.Config.Diagnostic ( initTcMessageOpts )
import GHC.Unit.Module ( Module, ModuleName )
-import GHC.Unit.Module.ModIface
+import GHC.Unit.Module.ModIface ( ModIface_(mi_exports), ModIface )
import GHC.Unit.Env
import GHC.Utils.Panic
@@ -69,10 +73,8 @@ import Control.Monad ( unless )
import Data.Maybe ( mapMaybe )
import Unsafe.Coerce ( unsafeCoerce )
import GHC.Linker.Types
-import GHC.Types.Unique.DFM
import Data.List (unzip4)
-import GHC.Tc.Errors.Types (TcRnMessage(..))
-import GHC.Driver.Config.Diagnostic (initTcMessageOpts)
+
-- | Loads the plugins specified in the pluginModNames field of the dynamic
-- flags. Should be called after command line arguments are parsed, but before
@@ -331,7 +333,9 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
Nothing -> throwCmdLineErrorS dflags $ hsep [text "Could not determine the exports of the module", ppr mod_name]
err ->
- let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError (cannotFindModule hsc_env mod_name err))
+ let tries = tcOptsShowTriedFiles $ initTcMessageOpts dflags
+ err_txt = formatBulleted $ missingInterfaceErrorDiagnostic tries
+ $ cannotFindModule hsc_env mod_name err
in throwCmdLineErrorS dflags err_txt
where
doc = text "contains a name used in an invocation of lookupRdrNameInModule"
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -21,9 +21,13 @@ module GHC.Tc.Errors.Ppr
, inHsDocContext
, TcRnMessageOpts(..)
+ , interfaceErrorHints
+ , interfaceErrorReason
+ , interfaceErrorDiagnostic
, missingInterfaceErrorHints
, missingInterfaceErrorReason
, missingInterfaceErrorDiagnostic
+ , readInterfaceErrorDiagnostic
)
where
@@ -1411,9 +1415,10 @@ instance Diagnostic TcRnMessage where
hsep [ text "Unknown type variable" <> plural errorVars
, text "on the RHS of injectivity condition:"
, interpp'SP errorVars ]
-
- TcRnMissingInterfaceError reason
- -> missingInterfaceErrorDiagnostic (tcOptsShowTriedFiles opts) reason
+ TcRnCan'tFindLocalName name
+ -> mkSimpleDecorated $ text "Can't find local name: " <+> ppr name
+ TcRnInterfaceError reason
+ -> interfaceErrorDiagnostic (tcOptsShowTriedFiles opts) reason
diagnosticReason = \case
@@ -1877,22 +1882,10 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnUnknownTyVarsOnRhsOfInjCond{}
-> ErrorWithoutFlag
- TcRnMissingInterfaceError reason
- -> case reason of
- BadSourceImport {} -> ErrorWithoutFlag
- MissingDeclInInterface {} -> ErrorWithoutFlag
- HomeModError {} -> ErrorWithoutFlag
- DynamicHashMismatchError {} -> ErrorWithoutFlag
- CantFindErr {} -> ErrorWithoutFlag
- CantFindInstalledErr {} -> ErrorWithoutFlag
- HiModuleNameMismatchWarn {} -> ErrorWithoutFlag
- BadIfaceFile {} -> ErrorWithoutFlag
- FailedToLoadDynamicInterface {} -> ErrorWithoutFlag
- GenericException {} -> ErrorWithoutFlag
- CantFindLocalName {} -> ErrorWithoutFlag
- CantFindHiInterfaceForSig {} -> ErrorWithoutFlag
- CantFindHiBoot {} -> ErrorWithoutFlag
- InterfaceLookupError {} -> ErrorWithoutFlag
+ TcRnCan'tFindLocalName {}
+ -> ErrorWithoutFlag
+ TcRnInterfaceError err
+ -> interfaceErrorReason err
diagnosticHints = \case
@@ -2374,8 +2367,10 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnUnknownTyVarsOnRhsOfInjCond{}
-> noHints
- TcRnMissingInterfaceError reason
- -> missingInterfaceErrorHints reason
+ TcRnCan'tFindLocalName {}
+ -> noHints
+ TcRnInterfaceError reason
+ -> interfaceErrorHints reason
diagnosticCode = constructorCode
@@ -2390,32 +2385,62 @@ commafyWith conjunction xs = addConjunction $ punctuate comma xs
addConjunction (x : xs) = x : addConjunction xs
addConjunction _ = panic "commafyWith expected 2 or more elements"
+interfaceErrorHints :: InterfaceError -> [GhcHint]
+interfaceErrorHints = \ case
+ Can'tFindInterface err _looking_for ->
+ missingInterfaceErrorHints err
+ Can'tFindNameInInterface {} ->
+ noHints
+
missingInterfaceErrorHints :: MissingInterfaceError -> [GhcHint]
-missingInterfaceErrorHints reason =
- case reason of
- BadSourceImport {} -> noHints
- MissingDeclInInterface {} -> noHints
- HomeModError {} -> noHints
- DynamicHashMismatchError {} -> noHints
- CantFindErr {} -> noHints
- CantFindInstalledErr {} -> noHints
- HiModuleNameMismatchWarn {} -> noHints
- BadIfaceFile {} -> noHints
- FailedToLoadDynamicInterface {} -> noHints
- GenericException {} -> noHints
- CantFindLocalName {} -> noHints
- CantFindHiInterfaceForSig {} -> noHints
- CantFindHiBoot {} -> noHints
- InterfaceLookupError {} -> noHints
+missingInterfaceErrorHints = \case
+ BadSourceImport {} ->
+ noHints
+ HomeModError {} ->
+ noHints
+ DynamicHashMismatchError {} ->
+ noHints
+ CantFindErr {} ->
+ noHints
+ CantFindInstalledErr {} ->
+ noHints
+ BadIfaceFile {} ->
+ noHints
+ FailedToLoadDynamicInterface {} ->
+ noHints
+ CantFindLocalName {} ->
+ noHints
+
+interfaceErrorReason :: InterfaceError -> DiagnosticReason
+interfaceErrorReason (Can'tFindInterface err _)
+ = missingInterfaceErrorReason err
+interfaceErrorReason (Can'tFindNameInInterface {})
+ = ErrorWithoutFlag
missingInterfaceErrorReason :: MissingInterfaceError -> DiagnosticReason
-missingInterfaceErrorReason _reason = ErrorWithoutFlag
+missingInterfaceErrorReason = \ case
+ BadSourceImport {} ->
+ ErrorWithoutFlag
+ HomeModError {} ->
+ ErrorWithoutFlag
+ DynamicHashMismatchError {} ->
+ ErrorWithoutFlag
+ CantFindErr {} ->
+ ErrorWithoutFlag
+ CantFindInstalledErr {} ->
+ ErrorWithoutFlag
+ BadIfaceFile {} ->
+ ErrorWithoutFlag
+ FailedToLoadDynamicInterface {} ->
+ ErrorWithoutFlag
+ CantFindLocalName {} ->
+ ErrorWithoutFlag
prettyCantFindWhat :: CantFindWhat -> SDoc
prettyCantFindWhat CantFindModule = text "Could not find module"
prettyCantFindWhat CantLoadModule = text "Could not load module"
prettyCantFindWhat CantLoadInterface = text "Failed to load interface for"
-prettyCantFindWhat AmbigiousModule = text "Ambiguous module name"
+prettyCantFindWhat AmbiguousModule = text "Ambiguous module name"
prettyCantFindWhat AmbiguousInterface = text "Ambigious interface for"
cantFindError :: Bool -> CantFindInstalled -> DecoratedSDoc
@@ -2493,11 +2518,18 @@ cantFindError verbose (CantFindInstalled mod_name what cfir) =
in mkSimpleDecorated $ pp_suggestions ms $$ mayShowLocations verbose fps
NotAModule -> mkSimpleDecorated $ text "It is not a module in the current program, or in any known package."
CouldntFindInFiles fps -> mkSimpleDecorated (vcat (map text fps))
- MultiplePackages pkgs -> mkSimpleDecorated $
- sep [text "it was found in multiple packages:",
- hsep (map ppr pkgs)]
- MultiplePackages2 mods -> mkSimpleDecorated $
- vcat (map pprMod mods)
+ MultiplePackages mods
+ | Just pkgs <- unambiguousPackages
+ -> mkSimpleDecorated $
+ sep [text "it was found in multiple packages:",
+ hsep (map ppr pkgs)]
+ | otherwise
+ -> mkSimpleDecorated $ vcat (map pprMod mods)
+ where
+ unambiguousPackages = foldl' unambiguousPackage (Just []) mods
+ unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _)
+ = Just (moduleUnit m : xs)
+ unambiguousPackage _ _ = Nothing
GenericMissing using_cabal pkg_hiddens mod_hiddens unusables files -> mkSimpleDecorated $
vcat (map (pkg_hidden using_cabal) pkg_hiddens) $$
vcat (map mod_hidden mod_hiddens) $$
@@ -2554,34 +2586,64 @@ mayShowLocations verbose files
| otherwise =
hang (text "Locations searched:") 2 $ vcat (map text files)
+interfaceErrorDiagnostic :: Bool -> InterfaceError -> DecoratedSDoc
+interfaceErrorDiagnostic verbose_files = \ case
+ Can'tFindInterface err looking_for ->
+ case looking_for of
+ LookingForName name ->
+ mkSimpleDecorated $ missingDeclInInterface name []
+ LookingForModule mod is_boot ->
+ mkSimpleDecorated
+ (text "Could not find" <+> what <+> text "for" <+> quotes (ppr mod))
+ `unionDecoratedSDoc`
+ (missingInterfaceErrorDiagnostic verbose_files err)
+ where
+ what
+ | IsBoot <- is_boot
+ = text "boot interface"
+ | otherwise
+ = text "interface"
+ LookingForHiBoot mod ->
+ mkSimpleDecorated
+ (text "Could not find hi-boot interface for" <+> quotes (ppr mod))
+ `unionDecoratedSDoc`
+ (missingInterfaceErrorDiagnostic verbose_files err)
+ LookingForSig sig ->
+ mkSimpleDecorated
+ (text "Could not find interface file for signature" <+> quotes (ppr sig))
+ `unionDecoratedSDoc`
+ (missingInterfaceErrorDiagnostic verbose_files err)
+
+ Can'tFindNameInInterface name relevant_tyThings ->
+ mkSimpleDecorated $ missingDeclInInterface name relevant_tyThings
+
+readInterfaceErrorDiagnostic :: ReadInterfaceError -> DecoratedSDoc
+readInterfaceErrorDiagnostic = \ case
+ ExceptionOccurred fp ex ->
+ mkSimpleDecorated $
+ hang (text "Exception when reading interface file " <+> text fp)
+ 2 (text (showException ex))
+ HiModuleNameMismatchWarn _ m1 m2 ->
+ mkSimpleDecorated $ hiModuleNameMismatchWarn m1 m2
+
missingInterfaceErrorDiagnostic :: Bool -> MissingInterfaceError -> DecoratedSDoc
missingInterfaceErrorDiagnostic verbose_files reason =
case reason of
BadSourceImport m -> mkSimpleDecorated $ badSourceImport m
- MissingDeclInInterface name things -> mkSimpleDecorated $ missingDeclInInterface name things
+ --MissingDeclInInterface name things -> mkSimpleDecorated $ missingDeclInInterface name things
HomeModError im ml -> mkSimpleDecorated $ homeModError im ml
DynamicHashMismatchError m ml -> mkSimpleDecorated $ dynamicHashMismatchError m ml
CantFindErr us cfi -> mkDecorated . map (pprWithUnitState us) . unDecorated $ cantFindError verbose_files cfi
CantFindInstalledErr cfi -> cantFindError verbose_files cfi
- HiModuleNameMismatchWarn m1 m2 -> mkSimpleDecorated $ hiModuleNameMismatchWarn m1 m2
- BadIfaceFile fp mie ->
- -- TODO
- mkSimpleDecorated (text fp)
- `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie
+ BadIfaceFile rie -> readInterfaceErrorDiagnostic rie
FailedToLoadDynamicInterface wanted_mod err ->
mkSimpleDecorated (text "Failed to load dynamic interface file for" <+> ppr wanted_mod)
- `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files err
- GenericException se ->
--- mkSimpleDecorated $ text "Exception when reading interface file for" <+> ppr mod
- mkSimpleDecorated $ text (showException se)
+ `unionDecoratedSDoc`
+ readInterfaceErrorDiagnostic err
CantFindLocalName name -> mkSimpleDecorated (text "Can't find local name: " <+> ppr name)
- CantFindHiInterfaceForSig isig_mod mie ->
- mkSimpleDecorated (text "Could not find hi interface for signature" <+> quotes (ppr isig_mod))
- `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie
- CantFindHiBoot m mie ->
- mkSimpleDecorated (text "Could not find hi-boot interface for" <+> quotes (ppr m))
- `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie
- InterfaceLookupError _ mie -> missingInterfaceErrorDiagnostic verbose_files mie
+ --CantFindHiBoot m mie ->
+ -- mkSimpleDecorated (text "Could not find hi-boot interface for" <+> quotes (ppr m))
+ -- `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie
hiModuleNameMismatchWarn :: Module -> Module -> SDoc
hiModuleNameMismatchWarn requested_mod read_mod
@@ -2626,9 +2688,9 @@ missingDeclInInterface :: Name -> [TyThing] -> SDoc
missingDeclInInterface name things =
whenPprDebug (found_things $$ empty) $$
hang (text "Can't find interface-file declaration for" <+>
- pprNameSpace (nameNameSpace name) <+> ppr name)
- 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file",
- text "Use -ddump-if-trace to get an idea of which file caused the error"])
+ pprNameSpace (nameNameSpace name) <+> ppr name)
+ 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file",
+ text "Use -ddump-if-trace to get an idea of which file caused the error"])
where
found_things =
hang (text "Found the following declarations in" <+> ppr (nameModule name) <> colon)
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -49,6 +49,10 @@ module GHC.Tc.Errors.Types (
, FixedRuntimeRepErrorInfo(..)
, MissingInterfaceError(..)
+ , InterfaceLookingFor(..)
+ , InterfaceError(..)
+ , ReadInterfaceError(..)
+ , ModDesc(..)
, CantFindInstalled(..)
, CantFindInstalledReason(..)
, CantFindWhat(..)
@@ -112,12 +116,14 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol)
, FixedRuntimeRepOrigin(..) )
import GHC.Tc.Types.Rank (Rank)
import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType)
+import GHC.Types.Basic
import GHC.Types.Error
import GHC.Types.Hint (UntickedPromotedThing(..))
import GHC.Types.ForeignCall (CLabelString)
import GHC.Types.Name (Name, OccName, getSrcLoc, getSrcSpan)
import qualified GHC.Types.Name.Occurrence as OccName
import GHC.Types.Name.Reader
+import GHC.Types.PkgQual
import GHC.Types.SrcLoc
import GHC.Types.TyThing (TyThing)
import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar)
@@ -137,7 +143,6 @@ import GHC.Core.TyCon (TyCon, TyConFlavour)
import GHC.Core.Type (Kind, Type, ThetaType, PredType)
import GHC.Driver.Backend (Backend)
import GHC.Unit.State (UnitState, ModuleSuggestion, ModuleOrigin, UnusableUnitReason, UnitInfo)
-import GHC.Types.Basic
import GHC.Utils.Misc (capitalise, filterOut)
import qualified GHC.LanguageExtensions as LangExt
import GHC.Data.FastString (FastString)
@@ -3178,7 +3183,9 @@ data TcRnMessage where
-}
TcRnUnknownTyVarsOnRhsOfInjCond :: [Name] -> TcRnMessage
- TcRnMissingInterfaceError :: !MissingInterfaceError -> TcRnMessage
+ TcRnCan'tFindLocalName :: !Name -> TcRnMessage
+
+ TcRnInterfaceError :: !InterfaceError -> TcRnMessage
deriving Generic
@@ -3598,41 +3605,63 @@ instance Outputable Exported where
ppr IsNotExported = text "IsNotExported"
ppr IsExported = text "IsExported"
-data MissingInterfaceError =
- BadSourceImport !Module
- | MissingDeclInInterface !Name [TyThing]
- | HomeModError !InstalledModule !ModLocation
- | DynamicHashMismatchError !Module !ModLocation
- | HiModuleNameMismatchWarn Module Module
- | CantFindLocalName Name
- -- dodgy?
- | GenericException SomeException
- -- Can't find errors
- | CantFindErr !UnitState CantFindInstalled
- | CantFindInstalledErr CantFindInstalled
- -- Adding context
- | BadIfaceFile FilePath MissingInterfaceError
- | FailedToLoadDynamicInterface Module MissingInterfaceError
- | CantFindHiInterfaceForSig InstalledModule MissingInterfaceError
- | CantFindHiBoot Module MissingInterfaceError
- | InterfaceLookupError Name MissingInterfaceError
- deriving Generic
-
-data CantFindInstalledReason = NoUnitIdMatching UnitId [UnitInfo]
- | MissingPackageFiles UnitId [FilePath]
- | MissingPackageWayFiles String UnitId [FilePath]
- | ModuleSuggestion [ModuleSuggestion] [FilePath]
- | NotAModule
- | CouldntFindInFiles [FilePath]
- | GenericMissing BuildingCabalPackage [(Unit, Maybe UnitInfo)] [Unit] [(Unit, UnusableUnitReason)] [FilePath]
- -- Ambiguous
- | MultiplePackages [Unit]
- | MultiplePackages2 [(Module, ModuleOrigin)]
- deriving Generic
-
-data CantFindInstalled = CantFindInstalled ModuleName CantFindWhat CantFindInstalledReason deriving Generic
-
-data CantFindWhat = CantFindModule | CantLoadModule | CantLoadInterface | AmbiguousInterface | AmbigiousModule
+data InterfaceLookingFor
+ = LookingForName !Name
+ | LookingForHiBoot !Module
+ | LookingForModule !ModuleName !IsBootInterface
+ | LookingForSig !InstalledModule
+
+data ModDesc
+ = NamedModule !ModuleName !PkgQual
+ | ActualModule !Module
+
+data InterfaceError
+ = Can'tFindInterface
+ MissingInterfaceError
+ InterfaceLookingFor
+ | Can'tFindNameInInterface
+ Name
+ [TyThing] -- possibly relevant TyThings
+ deriving Generic
+
+data MissingInterfaceError
+ = BadSourceImport !Module
+ | HomeModError !InstalledModule !ModLocation
+ | DynamicHashMismatchError !Module !ModLocation
+ | CantFindLocalName Name
+ -- dodgy?
+ -- Can't find errors
+ | CantFindErr !UnitState CantFindInstalled
+ | CantFindInstalledErr CantFindInstalled
+ -- Adding context
+ | BadIfaceFile ReadInterfaceError
+ | FailedToLoadDynamicInterface Module ReadInterfaceError
+ deriving Generic
+
+data ReadInterfaceError
+ = ExceptionOccurred FilePath SomeException
+ | HiModuleNameMismatchWarn FilePath Module Module
+ deriving Generic
+
+data CantFindInstalledReason
+ = NoUnitIdMatching UnitId [UnitInfo]
+ | MissingPackageFiles UnitId [FilePath]
+ | MissingPackageWayFiles String UnitId [FilePath]
+ | ModuleSuggestion [ModuleSuggestion] [FilePath]
+ | NotAModule
+ | CouldntFindInFiles [FilePath]
+ | GenericMissing BuildingCabalPackage [(Unit, Maybe UnitInfo)] [Unit] [(Unit, UnusableUnitReason)] [FilePath]
+ | MultiplePackages [(Module, ModuleOrigin)]
+ deriving Generic
+
+data CantFindInstalled =
+ CantFindInstalled ModuleName CantFindWhat CantFindInstalledReason
+ deriving Generic
+
+data CantFindWhat
+ = CantFindModule | CantLoadModule | CantLoadInterface
+ | AmbiguousInterface | AmbiguousModule
+
--------------------------------------------------------------------------------
--
-- Errors used in GHC.Tc.Errors
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -2024,7 +2024,7 @@ tcLookupTh name
do { mb_thing <- tcLookupImported_maybe name
; case mb_thing of
Succeeded thing -> return (AGlobal thing)
- Failed msg -> failWithTc (TcRnMissingInterfaceError (InterfaceLookupError name msg))
+ Failed msg -> failWithTc (TcRnInterfaceError msg)
}}}}
notInScope :: TH.Name -> TcRnMessage
=====================================
compiler/GHC/Tc/Utils/Backpack.hs
=====================================
@@ -168,7 +168,7 @@ checkHsigIface tcg_env gr sig_iface
-- tcg_env (TODO: but maybe this isn't relevant anymore).
r <- tcLookupImported_maybe name
case r of
- Failed err -> addErr (TcRnMissingInterfaceError (InterfaceLookupError name err))
+ Failed err -> addErr (TcRnInterfaceError err)
Succeeded real_thing -> checkHsigDeclM sig_iface sig_thing real_thing
-- The hsig did NOT define this function; that means it must
@@ -564,8 +564,7 @@ mergeSignatures
ctx = initSDocContext dflags defaultUserStyle
fmap fst
. withIfaceErr ctx
- $ findAndReadIface hsc_env
- (text "mergeSignatures") im m NotBoot
+ $ findAndReadIface hsc_env (text "mergeSignatures") im m NotBoot
-- STEP 3: Get the unrenamed exports of all these interfaces,
-- thin it according to the export list, and do shaping on them.
@@ -996,11 +995,9 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do
isig_mod sig_mod NotBoot
isig_iface <- case mb_isig_iface of
Succeeded (iface, _) -> return iface
- Failed err -> failWithTc $ TcRnMissingInterfaceError $ CantFindHiInterfaceForSig isig_mod err
- {-
- hang (text "Could not find hi interface for signature" <+>
- quotes (ppr isig_mod) <> colon) 4 err
- -}
+ Failed err ->
+ failWithTc $ TcRnInterfaceError $
+ Can'tFindInterface err (LookingForSig isig_mod)
-- STEP 3: Check that the implementing interface exports everything
-- we need. (Notice we IGNORE the Modules in the AvailInfos.)
=====================================
compiler/GHC/Tc/Utils/Env.hs
=====================================
@@ -153,12 +153,13 @@ lookupGlobal hsc_env name
mb_thing <- lookupGlobal_maybe hsc_env name
; case mb_thing of
Succeeded thing -> return thing
- Failed msg ->
- let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts (hsc_dflags hsc_env)) (TcRnMissingInterfaceError msg)
+ Failed err ->
+ let err_txt = formatBulleted
+ $ diagnosticMessage (initTcMessageOpts (hsc_dflags hsc_env))
+ err
in pprPanic "lookupGlobal" err_txt
}
-
-lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing)
+lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr TcRnMessage TyThing)
-- This may look up an Id that one has previously looked up.
-- If so, we are going to read its interface file, and add its bindings
-- to the ExternalPackageTable.
@@ -169,24 +170,26 @@ lookupGlobal_maybe hsc_env name
tcg_semantic_mod = homeModuleInstantiation mhome_unit mod
; if nameIsLocalOrFrom tcg_semantic_mod name
- then (return
- (Failed (CantFindLocalName name)))
- -- Internal names can happen in GHCi
- else
- -- Try home package table and external package table
- lookupImported_maybe hsc_env name
+ then return $ Failed $ TcRnCan'tFindLocalName name
+ -- Internal names can happen in GHCi
+ else do
+ res <- lookupImported_maybe hsc_env name
+ -- Try home package table and external package table
+ return $ case res of
+ Succeeded ok -> Succeeded ok
+ Failed err -> Failed (TcRnInterfaceError err)
}
-lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing)
+lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr InterfaceError TyThing)
-- Returns (Failed err) if we can't find the interface file for the thing
lookupImported_maybe hsc_env name
= do { mb_thing <- lookupType hsc_env name
; case mb_thing of
Just thing -> return (Succeeded thing)
Nothing -> importDecl_maybe hsc_env name
- }
+ }
-importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing)
+importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr InterfaceError TyThing)
importDecl_maybe hsc_env name
| Just thing <- wiredInNameTyThing_maybe name
= do { when (needWiredInHomeIface thing)
@@ -245,7 +248,7 @@ tcLookupGlobal name
do { mb_thing <- tcLookupImported_maybe name
; case mb_thing of
Succeeded thing -> return thing
- Failed msg -> failWithTc (TcRnMissingInterfaceError (InterfaceLookupError name msg))
+ Failed msg -> failWithTc (TcRnInterfaceError msg)
}}}
-- Look up only in this module's global env't. Don't look in imports, etc.
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -2,6 +2,7 @@
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -217,6 +218,7 @@ import Data.IORef
import Control.Monad
import GHC.Tc.Errors.Types
+import GHC.Tc.Errors.Ppr
import {-# SOURCE #-} GHC.Tc.Utils.Env ( tcInitTidyEnv )
import qualified Data.Map as Map
@@ -668,8 +670,8 @@ withIfaceErr ctx do_this = do
r <- do_this
case r of
Failed err -> do
- let diag = TcRnMissingInterfaceError err
- msg = pprDiagnostic diag
+ let tries = tcOptsShowTriedFiles $ defaultDiagnosticOpts @TcRnMessage
+ msg = formatBulleted $ missingInterfaceErrorDiagnostic tries err
liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx msg))
Succeeded result -> return result
=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -530,6 +530,7 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnShadowedTyVarNameInFamResult" = 99412
GhcDiagnosticCode "TcRnIncorrectTyVarOnLhsOfInjCond" = 88333
GhcDiagnosticCode "TcRnUnknownTyVarsOnRhsOfInjCond" = 48254
+ GhcDiagnosticCode "TcRnCan'tFindLocalName" = 11111 -- SLD TODO
-- IllegalNewtypeReason
GhcDiagnosticCode "DoesNotHaveSingleField" = 23517
@@ -583,32 +584,28 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "OneArgExpected" = 91490
GhcDiagnosticCode "AtLeastOneArgExpected" = 07641
- -- Missing interface errors
+ -- Interface errors
GhcDiagnosticCode "BadSourceImport" = 00001
- GhcDiagnosticCode "MissingDeclInInterface" = 00002
- GhcDiagnosticCode "MissingInterfaceError" = 00003
- GhcDiagnosticCode "HomeModError" = 00004
- GhcDiagnosticCode "DynamicHashMismatchError" = 00005
- GhcDiagnosticCode "BadIfaceFile" = 00006
- GhcDiagnosticCode "CantFindLocalName" = 00009
- GhcDiagnosticCode "FailedToLoadDynamicInterface" = 00010
- GhcDiagnosticCode "GenericException" = 00011
- GhcDiagnosticCode "HiModuleNameMismatch" = 00012
- GhcDiagnosticCode "HiModuleNameMismatchWarn" = 00013
- GhcDiagnosticCode "UsedAsDataConstructor" = 00014
- GhcDiagnosticCode "CantFindHiInterfaceForSig" = 00015
-
- GhcDiagnosticCode "CouldntFindInFiles" = 00016
- GhcDiagnosticCode "GenericMissing" = 00017
- GhcDiagnosticCode "MissingPackageFiles" = 00018
- GhcDiagnosticCode "MissingPackageWayFiles" = 00019
- GhcDiagnosticCode "ModuleSuggestion" = 00020
- GhcDiagnosticCode "MultiplePackages" = 00021
- GhcDiagnosticCode "MultiplePackages2" = 00022
- GhcDiagnosticCode "NoUnitIdMatching" = 00023
- GhcDiagnosticCode "NotAModule" = 00024
- GhcDiagnosticCode "CantFindHiBoot" = 00025
-
+ GhcDiagnosticCode "MissingDeclInInterface" = 00002
+ GhcDiagnosticCode "MissingInterfaceError" = 00003
+ GhcDiagnosticCode "HomeModError" = 00004
+ GhcDiagnosticCode "DynamicHashMismatchError" = 00005
+ GhcDiagnosticCode "BadIfaceFile" = 00006
+ GhcDiagnosticCode "CantFindLocalName" = 00009
+ GhcDiagnosticCode "FailedToLoadDynamicInterface" = 00010
+ GhcDiagnosticCode "UsedAsDataConstructor" = 00014
+ GhcDiagnosticCode "CouldntFindInFiles" = 00016
+ GhcDiagnosticCode "GenericMissing" = 00017
+ GhcDiagnosticCode "MissingPackageFiles" = 00018
+ GhcDiagnosticCode "MissingPackageWayFiles" = 00019
+ GhcDiagnosticCode "ModuleSuggestion" = 00020
+ GhcDiagnosticCode "MultiplePackages" = 00022
+ GhcDiagnosticCode "NoUnitIdMatching" = 00023
+ GhcDiagnosticCode "NotAModule" = 00024
+ GhcDiagnosticCode "Can'tFindNameInInterface" = 00026
+
+ GhcDiagnosticCode "HiModuleNameMismatchWarn" = 00012
+ GhcDiagnosticCode "ExceptionOccurred" = 00011
-- Out of scope errors
GhcDiagnosticCode "NotInScope" = 76037
@@ -702,13 +699,10 @@ type family ConRecursInto con where
ConRecursInto "CantFindErr" = 'Just CantFindInstalled
ConRecursInto "CantFindInstalledErr" = 'Just CantFindInstalled
- ConRecursInto "CantFindInstalled" = 'Just CantFindInstalledReason
+ ConRecursInto "CantFindInstalled" = 'Just CantFindInstalledReason
- ConRecursInto "BadIfaceFile" = 'Just MissingInterfaceError
- ConRecursInto "FailedToLoadDynamicInterface" = 'Just MissingInterfaceError
- ConRecursInto "CantFindHiInterfaceForSig" = 'Just MissingInterfaceError
- ConRecursInto "CantFindHiBoot" = 'Just MissingInterfaceError
- ConRecursInto "InterfaceLookupError" = 'Just MissingInterfaceError
+ ConRecursInto "BadIfaceFile" = 'Just ReadInterfaceError
+ ConRecursInto "FailedToLoadDynamicInterface" = 'Just ReadInterfaceError
----------------------------------
-- Constructors of PsMessage
@@ -737,7 +731,10 @@ type family ConRecursInto con where
ConRecursInto "TcRnRunSpliceFailure" = 'Just RunSpliceFailReason
ConRecursInto "ConversionFail" = 'Just ConversionFailReason
- ConRecursInto "TcRnMissingInterfaceError" = 'Just MissingInterfaceError
+ -- Interface file errors
+
+ ConRecursInto "TcRnInterfaceError" = 'Just InterfaceError
+ ConRecursInto "Can'tFindInterface" = 'Just MissingInterfaceError
------------------
-- FFI errors
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd9256235ec8c70f9248f4f2289559cde3255b27
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd9256235ec8c70f9248f4f2289559cde3255b27
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230315/a4f57d1d/attachment-0001.html>
More information about the ghc-commits
mailing list