summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2021-09-22 18:28:35 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-10-22 19:20:44 -0400
commit806e49ae36a058dbe4494055a6b936dd153c6194 (patch)
tree982c304986bf925187aae36997d4602e3419c8e9
parent6fd7da745a518a93f6685171701a27283cfe2d4e (diff)
downloadhaskell-806e49ae36a058dbe4494055a6b936dd153c6194.tar.gz
Refactor package imports
Use an (Raw)PkgQual datatype instead of `Maybe FastString` to represent package imports. Factorize the code that renames RawPkgQual into PkgQual in function `rnPkgQual`. Renaming consists in checking if the FastString is the magic "this" keyword, the home-unit unit-id or something else. Bump haddock submodule
-rw-r--r--compiler/GHC.hs48
-rw-r--r--compiler/GHC/Driver/Backpack.hs13
-rw-r--r--compiler/GHC/Driver/Make.hs18
-rw-r--r--compiler/GHC/Driver/MakeFile.hs4
-rw-r--r--compiler/GHC/Driver/Pipeline/Execute.hs20
-rw-r--r--compiler/GHC/Hs/ImpExp.hs21
-rw-r--r--compiler/GHC/Iface/Load.hs6
-rw-r--r--compiler/GHC/Parser.y7
-rw-r--r--compiler/GHC/Parser/Header.hs13
-rw-r--r--compiler/GHC/Plugins.hs4
-rw-r--r--compiler/GHC/Rename/Env.hs3
-rw-r--r--compiler/GHC/Rename/Names.hs77
-rw-r--r--compiler/GHC/Tc/Module.hs17
-rw-r--r--compiler/GHC/Tc/Plugin.hs4
-rw-r--r--compiler/GHC/Tc/Utils/Backpack.hs60
-rw-r--r--compiler/GHC/Types/PkgQual.hs40
-rw-r--r--compiler/GHC/Unit/Finder.hs20
-rw-r--r--compiler/GHC/Unit/Module/ModSummary.hs29
-rw-r--r--compiler/GHC/Unit/State.hs40
-rw-r--r--compiler/GHC/Unit/Types.hs10
-rw-r--r--compiler/ghc.cabal.in1
-rw-r--r--ghc/GHCi/UI.hs21
-rw-r--r--ghc/Main.hs3
-rw-r--r--testsuite/tests/count-deps/CountDepsAst.stdout3
-rw-r--r--testsuite/tests/count-deps/CountDepsParser.stdout3
-rw-r--r--testsuite/tests/module/mod185.stderr4
-rw-r--r--testsuite/tests/parser/should_compile/DumpParsedAst.stderr2
-rw-r--r--testsuite/tests/parser/should_compile/DumpRenamedAst.stderr6
-rw-r--r--testsuite/tests/parser/should_compile/DumpSemis.stderr8
-rw-r--r--testsuite/tests/parser/should_compile/KindSigs.stderr2
-rw-r--r--testsuite/tests/parser/should_compile/T14189.stderr2
-rw-r--r--testsuite/tests/plugins/defaulting-plugin/DefaultLifted.hs2
-rw-r--r--testsuite/tests/tcplugins/Common.hs3
-rw-r--r--testsuite/tests/tcplugins/RewritePerfPlugin.hs3
-rw-r--r--utils/check-exact/ExactPrint.hs3
m---------utils/haddock0
36 files changed, 324 insertions, 196 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 2074cd1054..5458f264e4 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -63,6 +63,7 @@ module GHC (
TypecheckedMod, ParsedMod,
moduleInfo, renamedSource, typecheckedSource,
parsedSource, coreModule,
+ PkgQual(..),
-- ** Compiling to Core
CoreModule(..),
@@ -116,6 +117,8 @@ module GHC (
-- ** Inspecting the current context
getBindings, getInsts, getPrintUnqual,
findModule, lookupModule,
+ findQualifiedModule, lookupQualifiedModule,
+ renamePkgQualM, renameRawPkgQualM,
isModuleTrusted, moduleTrustReqs,
getNamesInScope,
getRdrNamesInScope,
@@ -337,6 +340,7 @@ import GHC.Iface.Tidy
import GHC.Data.StringBuffer
import GHC.Data.FastString
import qualified GHC.LanguageExtensions as LangExt
+import GHC.Rename.Names (renamePkgQual, renameRawPkgQual)
import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances, initIfaceTcRn )
import GHC.Tc.Types
@@ -387,6 +391,7 @@ import GHC.Types.Name.Env
import GHC.Types.Name.Ppr
import GHC.Types.TypeEnv
import GHC.Types.BreakInfo
+import GHC.Types.PkgQual
import GHC.Unit
import GHC.Unit.Env
@@ -1631,29 +1636,35 @@ showRichTokenStream ts = go startLoc ts ""
-- filesystem and package database to find the corresponding 'Module',
-- using the algorithm that is used for an @import@ declaration.
findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
-findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
+findModule mod_name maybe_pkg = do
+ pkg_qual <- renamePkgQualM maybe_pkg
+ findQualifiedModule pkg_qual mod_name
+
+
+findQualifiedModule :: GhcMonad m => PkgQual -> ModuleName -> m Module
+findQualifiedModule pkgqual mod_name = withSession $ \hsc_env -> do
let fc = hsc_FC hsc_env
let home_unit = hsc_home_unit hsc_env
let units = hsc_units hsc_env
let dflags = hsc_dflags hsc_env
let fopts = initFinderOpts dflags
- case maybe_pkg of
- Just pkg | not (isHomeUnit home_unit (fsToUnit pkg)) && pkg /= fsLit "this" -> liftIO $ do
- res <- findImportedModule fc fopts units home_unit mod_name maybe_pkg
- case res of
- Found _ m -> return m
- err -> throwOneError $ noModError hsc_env noSrcSpan mod_name err
- _otherwise -> do
+ case pkgqual of
+ ThisPkg _ -> do
home <- lookupLoadedHomeModule mod_name
case home of
Just m -> return m
Nothing -> liftIO $ do
- res <- findImportedModule fc fopts units home_unit mod_name maybe_pkg
+ res <- findImportedModule fc fopts units home_unit mod_name pkgqual
case res of
Found loc m | not (isHomeModule home_unit m) -> return m
| otherwise -> modNotLoadedError dflags m loc
err -> throwOneError $ noModError hsc_env noSrcSpan mod_name err
- where
+
+ _ -> liftIO $ do
+ res <- findImportedModule fc fopts units home_unit mod_name pkgqual
+ case res of
+ Found _ m -> return m
+ err -> throwOneError $ noModError hsc_env noSrcSpan mod_name err
modNotLoadedError :: DynFlags -> Module -> ModLocation -> IO a
@@ -1662,6 +1673,12 @@ modNotLoadedError dflags m loc = throwGhcExceptionIO $ CmdLineError $ showSDoc d
quotes (ppr (moduleName m)) <+>
parens (text (expectJust "modNotLoadedError" (ml_hs_file loc)))
+renamePkgQualM :: GhcMonad m => Maybe FastString -> m PkgQual
+renamePkgQualM p = withSession $ \hsc_env -> pure (renamePkgQual (hsc_unit_env hsc_env) p)
+
+renameRawPkgQualM :: GhcMonad m => RawPkgQual -> m PkgQual
+renameRawPkgQualM p = withSession $ \hsc_env -> pure (renameRawPkgQual (hsc_unit_env hsc_env) p)
+
-- | Like 'findModule', but differs slightly when the module refers to
-- a source file, and the file has not been loaded via 'load'. In
-- this case, 'findModule' will throw an error (module not loaded),
@@ -1670,8 +1687,12 @@ modNotLoadedError dflags m loc = throwGhcExceptionIO $ CmdLineError $ showSDoc d
-- returned. If not, the usual module-not-found error will be thrown.
--
lookupModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
-lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg)
-lookupModule mod_name Nothing = withSession $ \hsc_env -> do
+lookupModule mod_name maybe_pkg = do
+ pkgqual <- renamePkgQualM maybe_pkg
+ lookupQualifiedModule pkgqual mod_name
+
+lookupQualifiedModule :: GhcMonad m => PkgQual -> ModuleName -> m Module
+lookupQualifiedModule NoPkgQual mod_name = withSession $ \hsc_env -> do
home <- lookupLoadedHomeModule mod_name
case home of
Just m -> return m
@@ -1680,10 +1701,11 @@ lookupModule mod_name Nothing = withSession $ \hsc_env -> do
let units = hsc_units hsc_env
let dflags = hsc_dflags hsc_env
let fopts = initFinderOpts dflags
- res <- findExposedPackageModule fc fopts units mod_name Nothing
+ res <- findExposedPackageModule fc fopts units mod_name NoPkgQual
case res of
Found _ m -> return m
err -> throwOneError $ noModError hsc_env noSrcSpan mod_name err
+lookupQualifiedModule pkgqual mod_name = findQualifiedModule pkgqual mod_name
lookupLoadedHomeModule :: GhcMonad m => ModuleName -> m (Maybe Module)
lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 57a7d1909f..8167402525 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -38,6 +38,8 @@ import GHC.Parser.Header
import GHC.Parser.Lexer
import GHC.Parser.Annotation
+import GHC.Rename.Names
+
import GHC hiding (Failed, Succeeded)
import GHC.Tc.Utils.Monad
import GHC.Iface.Recomp
@@ -45,7 +47,6 @@ import GHC.Builtin.Names
import GHC.Types.SrcLoc
import GHC.Types.SourceError
-import GHC.Types.SourceText
import GHC.Types.SourceFile
import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
@@ -781,7 +782,7 @@ summariseRequirement pn mod_name = do
ms_iface_date = hi_timestamp,
ms_hie_date = hie_timestamp,
ms_srcimps = [],
- ms_textual_imps = extra_sig_imports,
+ ms_textual_imps = ((,) NoPkgQual . noLoc) <$> extra_sig_imports,
ms_ghc_prim_import = False,
ms_parsed_mod = Just (HsParsedModule {
hpm_module = L loc (HsModule {
@@ -874,7 +875,9 @@ hsModuleToModSummary pn hsc_src modname
implicit_prelude = xopt LangExt.ImplicitPrelude dflags
implicit_imports = mkPrelImports modname loc
implicit_prelude imps
- convImport (L _ i) = (fmap sl_fs (ideclPkgQual i), ideclName i)
+
+ rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env)
+ convImport (L _ i) = (rn_pkg_qual (ideclPkgQual i), ideclName i)
extra_sig_imports <- liftIO $ findExtraSigImports hsc_env hsc_src modname
@@ -903,8 +906,8 @@ hsModuleToModSummary pn hsc_src modname
-- We have to do something special here:
-- due to merging, requirements may end up with
-- extra imports
- ++ extra_sig_imports
- ++ ((,) Nothing . noLoc <$> implicit_sigs),
+ ++ ((,) NoPkgQual . noLoc <$> extra_sig_imports)
+ ++ ((,) NoPkgQual . noLoc <$> implicit_sigs),
-- This is our hack to get the parse tree to the right spot
ms_parsed_mod = Just (HsParsedModule {
hpm_module = hsmod,
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 46ddd210c8..2f88539421 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -108,6 +108,7 @@ import GHC.Types.Unique.DSet
import GHC.Types.Unique.Set
import GHC.Types.Name
import GHC.Types.Name.Env
+import GHC.Types.PkgQual
import GHC.Unit
import GHC.Unit.Finder
@@ -149,6 +150,7 @@ import GHC.Driver.Env.KnotVars
import Control.Concurrent.STM
import Control.Monad.Trans.Maybe
import GHC.Runtime.Loader
+import GHC.Rename.Names
-- -----------------------------------------------------------------------------
@@ -1916,7 +1918,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
old_summary location
find_it = do
- found <- findImportedModule fc fopts units home_unit wanted_mod Nothing
+ found <- findImportedModule fc fopts units home_unit wanted_mod NoPkgQual
case found of
Found location mod
| isJust (ml_hs_file location) ->
@@ -2016,8 +2018,8 @@ makeNewModSummary hsc_env MakeNewModSummary{..} = do
, ms_srcimps = pi_srcimps
, ms_ghc_prim_import = pi_ghc_prim_import
, ms_textual_imps =
- extra_sig_imports ++
- ((,) Nothing . noLoc <$> implicit_sigs) ++
+ ((,) NoPkgQual . noLoc <$> extra_sig_imports) ++
+ ((,) NoPkgQual . noLoc <$> implicit_sigs) ++
pi_theimps
, ms_hs_hash = nms_src_hash
, ms_iface_date = hi_timestamp
@@ -2031,8 +2033,8 @@ makeNewModSummary hsc_env MakeNewModSummary{..} = do
data PreprocessedImports
= PreprocessedImports
{ pi_local_dflags :: DynFlags
- , pi_srcimps :: [(Maybe FastString, Located ModuleName)]
- , pi_theimps :: [(Maybe FastString, Located ModuleName)]
+ , pi_srcimps :: [(PkgQual, Located ModuleName)]
+ , pi_theimps :: [(PkgQual, Located ModuleName)]
, pi_ghc_prim_import :: Bool
, pi_hspp_fn :: FilePath
, pi_hspp_buf :: StringBuffer
@@ -2053,12 +2055,16 @@ getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do
(pi_local_dflags, pi_hspp_fn)
<- ExceptT $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase
pi_hspp_buf <- liftIO $ hGetStringBuffer pi_hspp_fn
- (pi_srcimps, pi_theimps, pi_ghc_prim_import, L pi_mod_name_loc pi_mod_name)
+ (pi_srcimps', pi_theimps', pi_ghc_prim_import, L pi_mod_name_loc pi_mod_name)
<- ExceptT $ do
let imp_prelude = xopt LangExt.ImplicitPrelude pi_local_dflags
popts = initParserOpts pi_local_dflags
mimps <- getImports popts imp_prelude pi_hspp_buf pi_hspp_fn src_fn
return (first (mkMessages . fmap mkDriverPsHeaderMessage . getMessages) mimps)
+ let rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env)
+ let rn_imps = fmap (first rn_pkg_qual)
+ let pi_srcimps = rn_imps pi_srcimps'
+ let pi_theimps = rn_imps pi_theimps'
return PreprocessedImports {..}
diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs
index 382d8d6b43..9cf23af831 100644
--- a/compiler/GHC/Driver/MakeFile.hs
+++ b/compiler/GHC/Driver/MakeFile.hs
@@ -30,8 +30,8 @@ import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Types.SourceError
import GHC.Types.SrcLoc
+import GHC.Types.PkgQual
import Data.List (partition)
-import GHC.Data.FastString
import GHC.Utils.TmpFs
import GHC.Iface.Load (cannotFindModule)
@@ -284,7 +284,7 @@ processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode (ExtendedM
findDependency :: HscEnv
-> SrcSpan
- -> Maybe FastString -- package qualifier, if any
+ -> PkgQual -- package qualifier, if any
-> ModuleName -- Imported module
-> IsBootInterface -- Source import
-> Bool -- Record dependency on package modules
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index fcc6372509..25aac65d85 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -82,6 +82,8 @@ import GHC.Utils.Panic
import GHC.Unit.Module.Env
import GHC.Driver.Env.KnotVars
import GHC.Driver.Config.Finder
+import GHC.Rename.Names
+import Data.Bifunctor (first)
newtype HookedUse a = HookedUse { runHookedUse :: (Hooks, PhaseHook) -> IO a }
deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch) via (ReaderT (Hooks, PhaseHook) IO)
@@ -636,14 +638,16 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do
-- gather the imports and module name
(hspp_buf,mod_name,imps,src_imps, ghc_prim_imp) <- do
- buf <- hGetStringBuffer input_fn
- let imp_prelude = xopt LangExt.ImplicitPrelude dflags
- popts = initParserOpts dflags
- eimps <- getImports popts imp_prelude buf input_fn (basename <.> suff)
- case eimps of
- Left errs -> throwErrors (GhcPsMessage <$> errs)
- Right (src_imps,imps, ghc_prim_imp, L _ mod_name) -> return
- (Just buf, mod_name, imps, src_imps, ghc_prim_imp)
+ buf <- hGetStringBuffer input_fn
+ let imp_prelude = xopt LangExt.ImplicitPrelude dflags
+ popts = initParserOpts dflags
+ rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env)
+ rn_imps = fmap (first rn_pkg_qual)
+ eimps <- getImports popts imp_prelude buf input_fn (basename <.> suff)
+ case eimps of
+ Left errs -> throwErrors (GhcPsMessage <$> errs)
+ Right (src_imps,imps, ghc_prim_imp, L _ mod_name) -> return
+ (Just buf, mod_name, rn_imps imps, rn_imps src_imps, ghc_prim_imp)
-- Take -o into account if present
-- Very like -ohi, but we must *only* do this if we aren't linking
diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs
index 05e176d9f7..891415c09f 100644
--- a/compiler/GHC/Hs/ImpExp.hs
+++ b/compiler/GHC/Hs/ImpExp.hs
@@ -20,7 +20,7 @@ import GHC.Prelude
import GHC.Unit.Module ( ModuleName, IsBootInterface(..) )
import GHC.Hs.Doc ( HsDocString )
-import GHC.Types.SourceText ( SourceText(..), StringLiteral(..), pprWithSourceText )
+import GHC.Types.SourceText ( SourceText(..) )
import GHC.Types.FieldLabel ( FieldLabel )
import GHC.Utils.Outputable
@@ -30,6 +30,7 @@ import Language.Haskell.Syntax.Extension
import GHC.Hs.Extension
import GHC.Parser.Annotation
import GHC.Types.Name
+import GHC.Types.PkgQual
import Data.Data
import Data.Maybe
@@ -85,7 +86,7 @@ data ImportDecl pass
ideclSourceSrc :: SourceText,
-- Note [Pragma source text] in GHC.Types.SourceText
ideclName :: XRec pass ModuleName, -- ^ Module name.
- ideclPkgQual :: Maybe StringLiteral, -- ^ Package qualifier.
+ ideclPkgQual :: ImportDeclPkgQual pass, -- ^ Package qualifier.
ideclSource :: IsBootInterface, -- ^ IsBoot <=> {-\# SOURCE \#-} import
ideclSafe :: Bool, -- ^ True => safe import
ideclQualified :: ImportDeclQualifiedStyle, -- ^ If/how the import is qualified.
@@ -112,6 +113,11 @@ data ImportDecl pass
-- For details on above see note [exact print annotations] in GHC.Parser.Annotation
+type family ImportDeclPkgQual pass
+type instance ImportDeclPkgQual GhcPs = RawPkgQual
+type instance ImportDeclPkgQual GhcRn = PkgQual
+type instance ImportDeclPkgQual GhcTc = PkgQual
+
type instance XCImportDecl GhcPs = EpAnn EpAnnImportDecl
type instance XCImportDecl GhcRn = NoExtField
type instance XCImportDecl GhcTc = NoExtField
@@ -141,7 +147,7 @@ simpleImportDecl mn = ImportDecl {
ideclExt = noAnn,
ideclSourceSrc = NoSourceText,
ideclName = noLoc mn,
- ideclPkgQual = Nothing,
+ ideclPkgQual = NoRawPkgQual,
ideclSource = NotBoot,
ideclSafe = False,
ideclImplicit = False,
@@ -151,7 +157,8 @@ simpleImportDecl mn = ImportDecl {
}
instance (OutputableBndrId p
- , Outputable (Anno (IE (GhcPass p))))
+ , Outputable (Anno (IE (GhcPass p)))
+ , Outputable (ImportDeclPkgQual (GhcPass p)))
=> Outputable (ImportDecl (GhcPass p)) where
ppr (ImportDecl { ideclSourceSrc = mSrcText, ideclName = mod'
, ideclPkgQual = pkg
@@ -159,16 +166,12 @@ instance (OutputableBndrId p
, ideclQualified = qual, ideclImplicit = implicit
, ideclAs = as, ideclHiding = spec })
= hang (hsep [text "import", ppr_imp from, pp_implicit implicit, pp_safe safe,
- pp_qual qual False, pp_pkg pkg, ppr mod', pp_qual qual True, pp_as as])
+ pp_qual qual False, ppr pkg, ppr mod', pp_qual qual True, pp_as as])
4 (pp_spec spec)
where
pp_implicit False = empty
pp_implicit True = text "(implicit)"
- pp_pkg Nothing = empty
- pp_pkg (Just (StringLiteral st p _))
- = pprWithSourceText st (doubleQuotes (ftext p))
-
pp_qual QualifiedPre False = text "qualified" -- Prepositive qualifier/prepositive position.
pp_qual QualifiedPost True = text "qualified" -- Postpositive qualifier/postpositive position.
pp_qual QualifiedPre True = empty -- Prepositive qualifier/postpositive position.
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 13fd3c1a3e..61ef61c8c4 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -98,6 +98,7 @@ import GHC.Types.Unique.FM
import GHC.Types.Unique.DSet
import GHC.Types.SrcLoc
import GHC.Types.TyThing
+import GHC.Types.PkgQual
import GHC.Unit.External
import GHC.Unit.Module
@@ -111,7 +112,6 @@ import GHC.Unit.Finder
import GHC.Unit.Env ( ue_hpt )
import GHC.Data.Maybe
-import GHC.Data.FastString
import Control.Monad
import Data.Map ( toList )
@@ -295,7 +295,7 @@ needWiredInHomeIface _ = False
loadSrcInterface :: SDoc
-> ModuleName
-> IsBootInterface -- {-# SOURCE #-} ?
- -> Maybe FastString -- "package", if any
+ -> PkgQual -- "package", if any
-> RnM ModIface
loadSrcInterface doc mod want_boot maybe_pkg
@@ -308,7 +308,7 @@ loadSrcInterface doc mod want_boot maybe_pkg
loadSrcInterface_maybe :: SDoc
-> ModuleName
-> IsBootInterface -- {-# SOURCE #-} ?
- -> Maybe FastString -- "package", if any
+ -> PkgQual -- "package", if any
-> RnM (MaybeErr SDoc ModIface)
loadSrcInterface_maybe doc mod want_boot maybe_pkg
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index b0b6a89e52..d3781af3b5 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -77,6 +77,7 @@ import GHC.Types.Fixity
import GHC.Types.ForeignCall
import GHC.Types.SourceFile
import GHC.Types.SourceText
+import GHC.Types.PkgQual
import GHC.Core.Type ( unrestrictedFunTyCon, Specificity(..) )
import GHC.Core.Class ( FunDep )
@@ -1126,13 +1127,13 @@ maybe_safe :: { (Maybe EpaLocation,Bool) }
: 'safe' { (Just (glAA $1),True) }
| {- empty -} { (Nothing, False) }
-maybe_pkg :: { (Maybe EpaLocation,Maybe StringLiteral) }
+maybe_pkg :: { (Maybe EpaLocation, RawPkgQual) }
: STRING {% do { let { pkgFS = getSTRING $1 }
; unless (looksLikePackageName (unpackFS pkgFS)) $
addError $ mkPlainErrorMsgEnvelope (getLoc $1) $
(PsErrInvalidPackageName pkgFS)
- ; return (Just (glAA $1), Just (StringLiteral (getSTRINGs $1) pkgFS Nothing)) } }
- | {- empty -} { (Nothing,Nothing) }
+ ; return (Just (glAA $1), RawPkgQual (StringLiteral (getSTRINGs $1) pkgFS Nothing)) } }
+ | {- empty -} { (Nothing,NoRawPkgQual) }
optqualified :: { Located (Maybe EpaLocation) }
: 'qualified' { sL1 $1 (Just (glAA $1)) }
diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs
index 1199d64957..c19c873c91 100644
--- a/compiler/GHC/Parser/Header.hs
+++ b/compiler/GHC/Parser/Header.hs
@@ -37,6 +37,7 @@ import GHC.Types.Error
import GHC.Types.SrcLoc
import GHC.Types.SourceError
import GHC.Types.SourceText
+import GHC.Types.PkgQual
import GHC.Utils.Misc
import GHC.Utils.Panic
@@ -72,8 +73,8 @@ getImports :: ParserOpts -- ^ Parser options
-- in the function result)
-> IO (Either
(Messages PsMessage)
- ([(Maybe FastString, Located ModuleName)],
- [(Maybe FastString, Located ModuleName)],
+ ([(RawPkgQual, Located ModuleName)],
+ [(RawPkgQual, Located ModuleName)],
Bool, -- Is GHC.Prim imported or not
Located ModuleName))
-- ^ The source imports and normal imports (with optional package
@@ -107,7 +108,7 @@ getImports popts implicit_prelude buf filename source_filename = do
implicit_imports = mkPrelImports (unLoc mod) main_loc
implicit_prelude imps
- convImport (L _ i) = (fmap sl_fs (ideclPkgQual i), ideclName i)
+ convImport (L _ i) = (ideclPkgQual i, ideclName i)
in
return (map convImport src_idecls
, map convImport (implicit_imports ++ ordinary_imps)
@@ -136,8 +137,8 @@ mkPrelImports this_mod loc implicit_prelude import_decls
unLoc (ideclName decl) == pRELUDE_NAME
-- allow explicit "base" package qualifier (#19082, #17045)
&& case ideclPkgQual decl of
- Nothing -> True
- Just b -> sl_fs b == unitIdFS baseUnitId
+ NoRawPkgQual -> True
+ RawPkgQual b -> sl_fs b == unitIdFS baseUnitId
loc' = noAnnSrcSpan loc
@@ -146,7 +147,7 @@ mkPrelImports this_mod loc implicit_prelude import_decls
= L loc' $ ImportDecl { ideclExt = noAnn,
ideclSourceSrc = NoSourceText,
ideclName = L loc pRELUDE_NAME,
- ideclPkgQual = Nothing,
+ ideclPkgQual = NoRawPkgQual,
ideclSource = NotBoot,
ideclSafe = False, -- Not a safe import
ideclQualified = NotQualified,
diff --git a/compiler/GHC/Plugins.hs b/compiler/GHC/Plugins.hs
index 8af39b5743..95ae21aba7 100644
--- a/compiler/GHC/Plugins.hs
+++ b/compiler/GHC/Plugins.hs
@@ -15,6 +15,7 @@ module GHC.Plugins
, module GHC.Types.Var
, module GHC.Types.Id
, module GHC.Types.Id.Info
+ , module GHC.Types.PkgQual
, module GHC.Core.Opt.Monad
, module GHC.Core
, module GHC.Types.Literal
@@ -29,6 +30,7 @@ module GHC.Plugins
, module GHC.Driver.Ppr
, module GHC.Unit.State
, module GHC.Unit.Module
+ , module GHC.Unit.Home
, module GHC.Core.Type
, module GHC.Core.TyCon
, module GHC.Core.Coercion
@@ -66,6 +68,7 @@ import GHC.Driver.Plugins
-- Variable naming
import GHC.Types.TyThing
+import GHC.Types.PkgQual
import GHC.Types.SourceError
import GHC.Types.Name.Reader
import GHC.Types.Name.Occurrence hiding ( varName {- conflicts with Var.varName -} )
@@ -92,6 +95,7 @@ import GHC.Types.Meta
import GHC.Driver.Session
import GHC.Unit.State
+import GHC.Unit.Home
import GHC.Unit.Module
import GHC.Unit.Module.ModGuts
import GHC.Unit.Module.ModSummary
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 3e99b18e20..b666defcb3 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -103,6 +103,7 @@ import Control.Arrow ( first )
import Data.Function
import GHC.Types.FieldLabel
import GHC.Data.Bag
+import GHC.Types.PkgQual
{-
*********************************************************
@@ -1714,7 +1715,7 @@ lookupQualifiedNameGHCi fos rdr_name
, is_ghci
, gopt Opt_ImplicitImportQualified dflags -- Enables this GHCi behaviour
, not (safeDirectImpsReq dflags) -- See Note [Safe Haskell and GHCi]
- = do { res <- loadSrcInterface_maybe doc mod NotBoot Nothing
+ = do { res <- loadSrcInterface_maybe doc mod NotBoot NoPkgQual
; case res of
Succeeded iface
-> return [ gname
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index c3d10a9237..f4fa104f1e 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -9,6 +9,7 @@ Extracting imported and top-level names in scope
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
@@ -25,6 +26,7 @@ module GHC.Rename.Names (
findImportUsage,
getMinimalImports,
printMinimalImports,
+ renamePkgQual, renameRawPkgQual,
ImportDeclUsage
) where
@@ -73,12 +75,14 @@ import GHC.Types.Id
import GHC.Types.HpcInfo
import GHC.Types.Unique.FM
import GHC.Types.Error
+import GHC.Types.PkgQual
import GHC.Unit
import GHC.Unit.Module.Warnings
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.Imported
import GHC.Unit.Module.Deps
+import GHC.Unit.Env
import GHC.Data.Maybe
import GHC.Data.FastString
@@ -304,13 +308,15 @@ rnImportDecl :: Module -> (LImportDecl GhcPs, SDoc)
-> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImportDecl this_mod
(L loc decl@(ImportDecl { ideclName = loc_imp_mod_name
- , ideclPkgQual = mb_pkg
+ , ideclPkgQual = raw_pkg_qual
, ideclSource = want_boot, ideclSafe = mod_safe
, ideclQualified = qual_style, ideclImplicit = implicit
, ideclAs = as_mod, ideclHiding = imp_details }), import_reason)
= setSrcSpanA loc $ do
- when (isJust mb_pkg) $ do
+ case raw_pkg_qual of
+ NoRawPkgQual -> pure ()
+ RawPkgQual _ -> do
pkg_imports <- xoptM LangExt.PackageImports
when (not pkg_imports) $ addErr packageImportErr
@@ -321,6 +327,9 @@ rnImportDecl this_mod
let imp_mod_name = unLoc loc_imp_mod_name
doc = ppr imp_mod_name <+> import_reason
+ unit_env <- hsc_unit_env <$> getTopEnv
+ let pkg_qual = renameRawPkgQual unit_env raw_pkg_qual
+
-- Check for self-import, which confuses the typechecker (#9032)
-- ghc --make rejects self-import cycles already, but batch-mode may not
-- at least not until GHC.IfaceToCore.tcHiBootIface, which is too late to avoid
@@ -334,13 +343,13 @@ rnImportDecl this_mod
-- extend Provenance to support a local definition in a qualified location.
-- For now, we don't support it, but see #10336
when (imp_mod_name == moduleName this_mod &&
- (case mb_pkg of -- If we have import "<pkg>" M, then we should
- -- check that "<pkg>" is "this" (which is magic)
- -- or the name of this_mod's package. Yurgh!
- -- c.f. GHC.findModule, and #9997
- Nothing -> True
- Just (StringLiteral _ pkg_fs _) -> pkg_fs == fsLit "this" ||
- fsToUnit pkg_fs == moduleUnit this_mod))
+ (case pkg_qual of -- If we have import "<pkg>" M, then we should
+ -- check that "<pkg>" is "this" (which is magic)
+ -- or the name of this_mod's package. Yurgh!
+ -- c.f. GHC.findModule, and #9997
+ NoPkgQual -> True
+ ThisPkg _ -> True
+ OtherPkg _ -> False))
(addErr $ TcRnUnknownMessage $ mkPlainError noHints $
(text "A module cannot import itself:" <+> ppr imp_mod_name))
@@ -358,7 +367,7 @@ rnImportDecl this_mod
addDiagnostic msg
- iface <- loadSrcInterface doc imp_mod_name want_boot (fmap sl_fs mb_pkg)
+ iface <- loadSrcInterface doc imp_mod_name want_boot pkg_qual
-- Compiler sanity check: if the import didn't say
-- {-# SOURCE #-} we should not get a hi-boot file
@@ -427,12 +436,44 @@ rnImportDecl this_mod
-- Complain about -Wcompat-unqualified-imports violations.
warnUnqualifiedImport decl iface
- let new_imp_decl = L loc (decl { ideclExt = noExtField, ideclSafe = mod_safe'
- , ideclHiding = new_imp_details
- , ideclName = ideclName decl
- , ideclAs = ideclAs decl })
-
- return (new_imp_decl, gbl_env, imports, mi_hpc iface)
+ let new_imp_decl = ImportDecl
+ { ideclExt = noExtField
+ , ideclSourceSrc = ideclSourceSrc decl
+ , ideclName = ideclName decl
+ , ideclPkgQual = pkg_qual
+ , ideclSource = ideclSource decl
+ , ideclSafe = mod_safe'
+ , ideclQualified = ideclQualified decl
+ , ideclImplicit = ideclImplicit decl
+ , ideclAs = ideclAs decl
+ , ideclHiding = new_imp_details
+ }
+
+ return (L loc new_imp_decl, gbl_env, imports, mi_hpc iface)
+
+
+-- | Rename raw package imports
+renameRawPkgQual :: UnitEnv -> RawPkgQual -> PkgQual
+renameRawPkgQual unit_env = \case
+ NoRawPkgQual -> NoPkgQual
+ RawPkgQual p -> renamePkgQual unit_env (Just (sl_fs p))
+
+-- | Rename raw package imports
+renamePkgQual :: UnitEnv -> Maybe FastString -> PkgQual
+renamePkgQual unit_env mb_pkg = case mb_pkg of
+ Nothing -> NoPkgQual
+ Just pkg_fs
+ | Just uid <- homeUnitId <$> ue_home_unit unit_env
+ , pkg_fs == fsLit "this" || pkg_fs == unitFS uid
+ -> ThisPkg uid
+
+ | Just uid <- lookupPackageName (ue_units unit_env) (PackageName pkg_fs)
+ -> OtherPkg uid
+
+ | otherwise
+ -> OtherPkg (UnitId pkg_fs)
+ -- not really correct as pkg_fs is unlikely to be a valid unit-id but
+ -- we will report the failure later...
-- | Calculate the 'ImportAvails' induced by an import of a particular
-- interface, but without 'imp_mods'.
@@ -1871,8 +1912,8 @@ getMinimalImports = fmap combine . mapM mk_minimal
| otherwise
= do { let ImportDecl { ideclName = L _ mod_name
, ideclSource = is_boot
- , ideclPkgQual = mb_pkg } = decl
- ; iface <- loadSrcInterface doc mod_name is_boot (fmap sl_fs mb_pkg)
+ , ideclPkgQual = pkg_qual } = decl
+ ; iface <- loadSrcInterface doc mod_name is_boot pkg_qual
; let used_avails = gresToAvailInfo used_gres
lies = map (L l) (concatMap (to_ie iface) used_avails)
; return (L l (decl { ideclHiding = Just (False, L (l2l l) lies) })) }
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 53ee34ed9e..2c425e6eda 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -153,9 +153,9 @@ import GHC.Types.Avail
import GHC.Types.Basic hiding( SuccessFlag(..) )
import GHC.Types.Annotations
import GHC.Types.SrcLoc
-import GHC.Types.SourceText
import GHC.Types.SourceFile
import GHC.Types.TyThing.Ppr ( pprTyThingInContext )
+import GHC.Types.PkgQual
import qualified GHC.LanguageExtensions as LangExt
import GHC.Unit.External
@@ -270,7 +270,8 @@ tcRnModuleTcRnM hsc_env mod_sum
; -- TODO This is a little skeevy; maybe handle a bit more directly
let { simplifyImport (L _ idecl) =
- ( fmap sl_fs (ideclPkgQual idecl) , ideclName idecl)
+ ( renameRawPkgQual (hsc_unit_env hsc_env) (ideclPkgQual idecl)
+ , ideclName idecl)
}
; raw_sig_imports <- liftIO
$ findExtraSigImports hsc_env hsc_src
@@ -279,10 +280,9 @@ tcRnModuleTcRnM hsc_env mod_sum
$ implicitRequirements hsc_env
(map simplifyImport (prel_imports
++ import_decls))
- ; let { mkImport (Nothing, L _ mod_name) = noLocA
+ ; let { mkImport mod_name = noLocA
$ (simpleImportDecl mod_name)
- { ideclHiding = Just (False, noLocA [])}
- ; mkImport _ = panic "mkImport" }
+ { ideclHiding = Just (False, noLocA [])}}
; let { withReason t imps = map (,text t) imps }
; let { all_imports = withReason "is implicitly imported" prel_imports
++ withReason "is directly imported" import_decls
@@ -2052,10 +2052,9 @@ runTcInteractive hsc_env thing_inside
; !orphs <- fmap (force . concat) . forM (ic_imports icxt) $ \i ->
case i of -- force above: see #15111
- IIModule n -> getOrphans n Nothing
- IIDecl i ->
- let mb_pkg = sl_fs <$> ideclPkgQual i in
- getOrphans (unLoc (ideclName i)) mb_pkg
+ IIModule n -> getOrphans n NoPkgQual
+ IIDecl i -> getOrphans (unLoc (ideclName i))
+ (renameRawPkgQual (hsc_unit_env hsc_env) (ideclPkgQual i))
; let imports = emptyImportAvails {
imp_orphs = orphs
diff --git a/compiler/GHC/Tc/Plugin.hs b/compiler/GHC/Tc/Plugin.hs
index f65b30db27..f2d9521a8c 100644
--- a/compiler/GHC/Tc/Plugin.hs
+++ b/compiler/GHC/Tc/Plugin.hs
@@ -86,8 +86,8 @@ import GHC.Utils.Outputable ( SDoc )
import GHC.Core.Type ( Kind, Type, PredType )
import GHC.Types.Id ( Id )
import GHC.Core.InstEnv ( InstEnvs )
-import GHC.Data.FastString ( FastString )
import GHC.Types.Unique ( Unique )
+import GHC.Types.PkgQual ( PkgQual )
-- | Perform some IO, typically to interact with an external tool.
@@ -99,7 +99,7 @@ tcPluginTrace :: String -> SDoc -> TcPluginM ()
tcPluginTrace a b = unsafeTcPluginTcM (traceTc a b)
-findImportedModule :: ModuleName -> Maybe FastString -> TcPluginM Finder.FindResult
+findImportedModule :: ModuleName -> PkgQual -> TcPluginM Finder.FindResult
findImportedModule mod_name mb_pkg = do
hsc_env <- getTopEnv
let fc = hsc_FC hsc_env
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index 5948f5a931..5594622100 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -4,9 +4,7 @@
{-# LANGUAGE TypeFamilies #-}
module GHC.Tc.Utils.Backpack (
- findExtraSigImports',
findExtraSigImports,
- implicitRequirements',
implicitRequirements,
implicitRequirementsShallow,
checkUnit,
@@ -40,6 +38,7 @@ import GHC.Types.SourceFile
import GHC.Types.Var
import GHC.Types.Unique.DSet
import GHC.Types.Name.Shape
+import GHC.Types.PkgQual
import GHC.Unit
import GHC.Unit.Finder
@@ -278,50 +277,33 @@ check_inst sig_inst = do
-- process A first, because the merging process will cause B to indirectly
-- import A. This function finds the TRANSITIVE closure of all such imports
-- we need to make.
-findExtraSigImports' :: HscEnv
- -> HscSource
- -> ModuleName
- -> IO (UniqDSet ModuleName)
-findExtraSigImports' hsc_env HsigFile modname =
- fmap unionManyUniqDSets (forM reqs $ \(Module iuid mod_name) ->
- (initIfaceLoad hsc_env
+findExtraSigImports :: HscEnv
+ -> HscSource
+ -> ModuleName
+ -> IO [ModuleName]
+findExtraSigImports hsc_env HsigFile modname = do
+ let
+ dflags = hsc_dflags hsc_env
+ ctx = initSDocContext dflags defaultUserStyle
+ unit_state = hsc_units hsc_env
+ reqs = requirementMerges unit_state modname
+ holes <- forM reqs $ \(Module iuid mod_name) -> do
+ initIfaceLoad hsc_env
. withException ctx
$ moduleFreeHolesPrecise (text "findExtraSigImports")
- (mkModule (VirtUnit iuid) mod_name)))
- where
- dflags = hsc_dflags hsc_env
- ctx = initSDocContext dflags defaultUserStyle
- unit_state = hsc_units hsc_env
- reqs = requirementMerges unit_state modname
-
-findExtraSigImports' _ _ _ = return emptyUniqDSet
-
--- | 'findExtraSigImports', but in a convenient form for "GHC.Driver.Make" and
--- "GHC.Tc.Module".
-findExtraSigImports :: HscEnv -> HscSource -> ModuleName
- -> IO [(Maybe FastString, Located ModuleName)]
-findExtraSigImports hsc_env hsc_src modname = do
- extra_requirements <- findExtraSigImports' hsc_env hsc_src modname
- return [ (Nothing, noLoc mod_name)
- | mod_name <- uniqDSetToList extra_requirements ]
-
--- A version of 'implicitRequirements'' which is more friendly
--- for "GHC.Tc.Module".
-implicitRequirements :: HscEnv
- -> [(Maybe FastString, Located ModuleName)]
- -> IO [(Maybe FastString, Located ModuleName)]
-implicitRequirements hsc_env normal_imports
- = do mns <- implicitRequirements' hsc_env normal_imports
- return [ (Nothing, noLoc mn) | mn <- mns ]
+ (mkModule (VirtUnit iuid) mod_name)
+ return (uniqDSetToList (unionManyUniqDSets holes))
+
+findExtraSigImports _ _ _ = return []
-- Given a list of 'import M' statements in a module, figure out
-- any extra implicit requirement imports they may have. For
-- example, if they 'import M' and M resolves to p[A=<B>,C=D], then
-- they actually also import the local requirement B.
-implicitRequirements' :: HscEnv
- -> [(Maybe FastString, Located ModuleName)]
+implicitRequirements :: HscEnv
+ -> [(PkgQual, Located ModuleName)]
-> IO [ModuleName]
-implicitRequirements' hsc_env normal_imports
+implicitRequirements hsc_env normal_imports
= fmap concat $
forM normal_imports $ \(mb_pkg, L _ imp) -> do
found <- findImportedModule fc fopts units home_unit imp mb_pkg
@@ -342,7 +324,7 @@ implicitRequirements' hsc_env normal_imports
-- than a transitive closure done here) all the free holes are still reachable.
implicitRequirementsShallow
:: HscEnv
- -> [(Maybe FastString, Located ModuleName)]
+ -> [(PkgQual, Located ModuleName)]
-> IO ([ModuleName], [InstantiatedUnit])
implicitRequirementsShallow hsc_env normal_imports = go ([], []) normal_imports
where
diff --git a/compiler/GHC/Types/PkgQual.hs b/compiler/GHC/Types/PkgQual.hs
new file mode 100644
index 0000000000..2ac5894d72
--- /dev/null
+++ b/compiler/GHC/Types/PkgQual.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE LambdaCase #-}
+
+module GHC.Types.PkgQual where
+
+import GHC.Types.SourceText
+import GHC.Unit.Types
+import GHC.Utils.Outputable
+
+import Data.Data
+
+-- | Package-qualifier as it was parsed
+data RawPkgQual
+ = NoRawPkgQual -- ^ No package qualifier
+ | RawPkgQual StringLiteral -- ^ Raw package qualifier string.
+ deriving (Data)
+
+-- | Package-qualifier after renaming
+--
+-- Renaming detects if "this" or the unit-id of the home-unit was used as a
+-- package qualifier.
+data PkgQual
+ = NoPkgQual -- ^ No package qualifier
+ | ThisPkg UnitId -- ^ Import from home-unit
+ | OtherPkg UnitId -- ^ Import from another unit
+ deriving (Data)
+
+instance Outputable RawPkgQual where
+ ppr = \case
+ NoRawPkgQual -> empty
+ RawPkgQual (StringLiteral st p _)
+ -> pprWithSourceText st (doubleQuotes (ftext p))
+
+instance Outputable PkgQual where
+ ppr = \case
+ NoPkgQual -> empty
+ ThisPkg _ -> doubleQuotes (text "this")
+ OtherPkg u -> doubleQuotes (ppr u)
+
+
diff --git a/compiler/GHC/Unit/Finder.hs b/compiler/GHC/Unit/Finder.hs
index 8a402dca15..cc16cd0dad 100644
--- a/compiler/GHC/Unit/Finder.hs
+++ b/compiler/GHC/Unit/Finder.hs
@@ -47,7 +47,6 @@ import GHC.Unit.Home
import GHC.Unit.State
import GHC.Unit.Finder.Types
-import GHC.Data.FastString
import GHC.Data.Maybe ( expectJust )
import qualified GHC.Data.ShortText as ST
@@ -56,6 +55,7 @@ import GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic
import GHC.Linker.Types
+import GHC.Types.PkgQual
import GHC.Fingerprint
import Data.IORef
@@ -136,21 +136,19 @@ findImportedModule
-> UnitState
-> HomeUnit
-> ModuleName
- -> Maybe FastString
+ -> PkgQual
-> IO FindResult
findImportedModule fc fopts units home_unit mod_name mb_pkg =
case mb_pkg of
- Nothing -> unqual_import
- Just pkg | pkg == fsLit "this" -> home_import -- "this" is special
- | otherwise -> pkg_import
+ NoPkgQual -> unqual_import
+ ThisPkg _ -> home_import
+ OtherPkg _ -> pkg_import
where
home_import = findHomeModule fc fopts home_unit mod_name
-
- pkg_import = findExposedPackageModule fc fopts units mod_name mb_pkg
-
+ pkg_import = findExposedPackageModule fc fopts units mod_name mb_pkg
unqual_import = home_import
`orIfNotFound`
- findExposedPackageModule fc fopts units mod_name Nothing
+ findExposedPackageModule fc fopts units mod_name NoPkgQual
-- | Locate a plugin module requested by the user, for a compiler
-- plugin. This consults the same set of exposed packages as
@@ -212,7 +210,7 @@ homeSearchCache fc home_unit mod_name do_this = do
let mod = mkHomeInstalledModule home_unit mod_name
modLocationCache fc mod do_this
-findExposedPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> Maybe FastString -> IO FindResult
+findExposedPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> PkgQual -> IO FindResult
findExposedPackageModule fc fopts units mod_name mb_pkg =
findLookupResult fc fopts
$ lookupModuleWithSuggestions units mod_name mb_pkg
@@ -220,7 +218,7 @@ findExposedPackageModule fc fopts units mod_name mb_pkg =
findExposedPluginPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> IO FindResult
findExposedPluginPackageModule fc fopts units mod_name =
findLookupResult fc fopts
- $ lookupPluginModuleWithSuggestions units mod_name Nothing
+ $ lookupPluginModuleWithSuggestions units mod_name NoPkgQual
findLookupResult :: FinderCache -> FinderOpts -> LookupResult -> IO FindResult
findLookupResult fc fopts r = case r of
diff --git a/compiler/GHC/Unit/Module/ModSummary.hs b/compiler/GHC/Unit/Module/ModSummary.hs
index 20d61ad4f8..0f29c5a477 100644
--- a/compiler/GHC/Unit/Module/ModSummary.hs
+++ b/compiler/GHC/Unit/Module/ModSummary.hs
@@ -37,9 +37,9 @@ import GHC.Unit.Module
import GHC.Types.SourceFile ( HscSource(..), hscSourceString )
import GHC.Types.SrcLoc
import GHC.Types.Target
+import GHC.Types.PkgQual
import GHC.Data.Maybe
-import GHC.Data.FastString
import GHC.Data.StringBuffer ( StringBuffer )
import GHC.Utils.Fingerprint
@@ -88,9 +88,9 @@ data ModSummary
-- See Note [When source is considered modified] and #9243
ms_hie_date :: Maybe UTCTime,
-- ^ Timestamp of hie file, if we have one
- ms_srcimps :: [(Maybe FastString, Located ModuleName)],
+ ms_srcimps :: [(PkgQual, Located ModuleName)], -- FIXME: source imports are never from an external package, why do we allow PkgQual?
-- ^ Source imports of the module
- ms_textual_imps :: [(Maybe FastString, Located ModuleName)],
+ ms_textual_imps :: [(PkgQual, Located ModuleName)],
-- ^ Non-source imports of the module from the module *text*
ms_ghc_prim_import :: !Bool,
-- ^ Whether the special module GHC.Prim was imported explicitliy
@@ -116,19 +116,22 @@ ms_mod_name :: ModSummary -> ModuleName
ms_mod_name = moduleName . ms_mod
-- | Textual imports, plus plugin imports but not SOURCE imports.
-ms_imps :: ModSummary -> [(Maybe FastString, Located ModuleName)]
+ms_imps :: ModSummary -> [(PkgQual, Located ModuleName)]
ms_imps ms = ms_textual_imps ms ++ ms_plugin_imps ms
-- | Plugin imports
-ms_plugin_imps :: ModSummary -> [(Maybe FastString, Located ModuleName)]
-ms_plugin_imps ms = map ((Nothing,) . noLoc) (pluginModNames (ms_hspp_opts ms))
-
-home_imps :: [(Maybe FastString, Located ModuleName)] -> [Located ModuleName]
-home_imps imps = [ lmodname | (mb_pkg, lmodname) <- imps,
- isLocal mb_pkg ]
- where isLocal Nothing = True
- isLocal (Just pkg) | pkg == fsLit "this" = True -- "this" is special
- isLocal _ = False
+ms_plugin_imps :: ModSummary -> [(PkgQual, Located ModuleName)]
+ms_plugin_imps ms = map ((NoPkgQual,) . noLoc) (pluginModNames (ms_hspp_opts ms))
+
+-- | All of the (possibly) home module imports from the given list that is to
+-- say, each of these module names could be a home import if an appropriately
+-- named file existed. (This is in contrast to package qualified imports, which
+-- are guaranteed not to be home imports.)
+home_imps :: [(PkgQual, Located ModuleName)] -> [Located ModuleName]
+home_imps imps = fmap snd (filter (maybe_home . fst) imps)
+ where maybe_home NoPkgQual = True
+ maybe_home (ThisPkg _) = True
+ maybe_home (OtherPkg _) = False
-- | Like 'ms_home_imps', but for SOURCE imports.
ms_home_srcimps :: ModSummary -> [Located ModuleName]
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index e7ddf779f5..55855da61f 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -90,6 +90,7 @@ import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
import GHC.Types.Unique.Set
import GHC.Types.Unique.DSet
+import GHC.Types.PkgQual
import GHC.Utils.Misc
import GHC.Utils.Panic
@@ -1794,7 +1795,7 @@ lookupModuleInAllUnits :: UnitState
-> ModuleName
-> [(Module, UnitInfo)]
lookupModuleInAllUnits pkgs m
- = case lookupModuleWithSuggestions pkgs m Nothing of
+ = case lookupModuleWithSuggestions pkgs m NoPkgQual of
LookupFound a b -> [(a,fst b)]
LookupMultiple rs -> map f rs
where f (m,_) = (m, expectJust "lookupModule" (lookupUnit pkgs
@@ -1822,7 +1823,7 @@ data ModuleSuggestion = SuggestVisible ModuleName Module ModuleOrigin
lookupModuleWithSuggestions :: UnitState
-> ModuleName
- -> Maybe FastString
+ -> PkgQual
-> LookupResult
lookupModuleWithSuggestions pkgs
= lookupModuleWithSuggestions' pkgs (moduleNameProvidersMap pkgs)
@@ -1830,7 +1831,7 @@ lookupModuleWithSuggestions pkgs
-- | The package which the module **appears** to come from, this could be
-- the one which reexports the module from it's original package. This function
-- is currently only used for -Wunused-packages
-lookupModulePackage :: UnitState -> ModuleName -> Maybe FastString -> Maybe [UnitInfo]
+lookupModulePackage :: UnitState -> ModuleName -> PkgQual -> Maybe [UnitInfo]
lookupModulePackage pkgs mn mfs =
case lookupModuleWithSuggestions' pkgs (moduleNameProvidersMap pkgs) mn mfs of
LookupFound _ (orig_unit, origin) ->
@@ -1849,7 +1850,7 @@ lookupModulePackage pkgs mn mfs =
lookupPluginModuleWithSuggestions :: UnitState
-> ModuleName
- -> Maybe FastString
+ -> PkgQual
-> LookupResult
lookupPluginModuleWithSuggestions pkgs
= lookupModuleWithSuggestions' pkgs (pluginModuleNameProvidersMap pkgs)
@@ -1857,7 +1858,7 @@ lookupPluginModuleWithSuggestions pkgs
lookupModuleWithSuggestions' :: UnitState
-> ModuleNameProvidersMap
-> ModuleName
- -> Maybe FastString
+ -> PkgQual
-> LookupResult
lookupModuleWithSuggestions' pkgs mod_map m mb_pn
= case Map.lookup m mod_map of
@@ -1892,24 +1893,29 @@ lookupModuleWithSuggestions' pkgs mod_map m mb_pn
-- Filters out origins which are not associated with the given package
-- qualifier. No-op if there is no package qualifier. Test if this
-- excluded all origins with 'originEmpty'.
- filterOrigin :: Maybe FastString
+ filterOrigin :: PkgQual
-> UnitInfo
-> ModuleOrigin
-> ModuleOrigin
- filterOrigin Nothing _ o = o
- filterOrigin (Just pn) pkg o =
- case o of
- ModHidden -> if go pkg then ModHidden else mempty
- (ModUnusable _) -> if go pkg then o else mempty
+ filterOrigin NoPkgQual _ o = o
+ filterOrigin (ThisPkg _) _ o = o
+ filterOrigin (OtherPkg u) pkg o =
+ let match_pkg p = u == unitId p
+ in case o of
+ ModHidden
+ | match_pkg pkg -> ModHidden
+ | otherwise -> mempty
+ ModUnusable _
+ | match_pkg pkg -> o
+ | otherwise -> mempty
ModOrigin { fromOrigUnit = e, fromExposedReexport = res,
fromHiddenReexport = rhs }
- -> ModOrigin {
- fromOrigUnit = if go pkg then e else Nothing
- , fromExposedReexport = filter go res
- , fromHiddenReexport = filter go rhs
- , fromPackageFlag = False -- always excluded
+ -> ModOrigin
+ { fromOrigUnit = if match_pkg pkg then e else Nothing
+ , fromExposedReexport = filter match_pkg res
+ , fromHiddenReexport = filter match_pkg rhs
+ , fromPackageFlag = False -- always excluded
}
- where go pkg = pn == fsPackageName pkg
suggestions = fuzzyLookup (moduleNameString m) all_mods
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
index 39efeb6e60..fd35e70957 100644
--- a/compiler/GHC/Unit/Types.hs
+++ b/compiler/GHC/Unit/Types.hs
@@ -487,12 +487,12 @@ unitIsDefinite = isEmptyUniqDSet . unitFreeModuleHoles
-- libraries as we can cheaply instantiate them on-the-fly, cf VirtUnit). Put
-- another way, an installed unit id is either fully instantiated, or not
-- instantiated at all.
-newtype UnitId =
- UnitId {
- -- | The full hashed unit identifier, including the component id
+newtype UnitId = UnitId
+ { unitIdFS :: FastString
+ -- ^ The full hashed unit identifier, including the component id
-- and the hash.
- unitIdFS :: FastString
- }
+ }
+ deriving (Data)
instance Binary UnitId where
put_ bh (UnitId fs) = put_ bh fs
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index e32e8572ec..ed5851a667 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -709,6 +709,7 @@ Library
GHC.Types.Name.Set
GHC.Types.Name.Shape
GHC.Types.Name.Ppr
+ GHC.Types.PkgQual
GHC.Types.RepType
GHC.Types.SafeHaskell
GHC.Types.SourceError
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 4a82a51e84..fc19207cc2 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -69,7 +69,6 @@ import GHC.Types.TyThing.Ppr
import GHC.Core.TyCo.Ppr
import GHC.Types.SafeHaskell ( getSafeMode )
import GHC.Types.Name
-import GHC.Types.SourceText
import GHC.Types.Var ( varType )
import GHC.Iface.Syntax ( showToHeader )
import GHC.Builtin.Names
@@ -78,6 +77,7 @@ import GHC.Types.Name.Reader as RdrName ( getGRE_NameQualifier_maybes, getRdrNam
import GHC.Types.SrcLoc as SrcLoc
import qualified GHC.Parser.Lexer as Lexer
import GHC.Parser.Header ( toArgs )
+import GHC.Types.PkgQual
import GHC.Unit
import GHC.Unit.Finder as Finder
@@ -2049,7 +2049,7 @@ addModule files = do
let dflags = hsc_dflags hsc_env
let fopts = initFinderOpts dflags
result <- liftIO $
- Finder.findImportedModule fc fopts units home_unit m (Just (fsLit "this"))
+ Finder.findImportedModule fc fopts units home_unit m (ThisPkg (homeUnitId home_unit))
case result of
Found _ _ -> return True
_ -> (liftIO $ putStrLn $
@@ -2208,7 +2208,8 @@ keepPackageImports = filterM is_pkg_import
is_pkg_import :: GHC.GhcMonad m => InteractiveImport -> m Bool
is_pkg_import (IIModule _) = return False
is_pkg_import (IIDecl d)
- = do e <- MC.try $ GHC.findModule mod_name (fmap sl_fs $ ideclPkgQual d)
+ = do pkgqual <- GHC.renameRawPkgQualM (ideclPkgQual d)
+ e <- MC.try $ GHC.findQualifiedModule pkgqual mod_name
case e :: Either SomeException Module of
Left _ -> return False
Right m -> return (not (isMainUnitModule m))
@@ -2216,6 +2217,7 @@ keepPackageImports = filterM is_pkg_import
mod_name = unLoc (ideclName d)
+
modulesLoadedMsg :: GHC.GhcMonad m => SuccessFlag -> [GHC.ModSummary] -> m ()
modulesLoadedMsg ok mods = do
dflags <- getDynFlags
@@ -2560,9 +2562,10 @@ guessCurrentModule cmd
when (null imports) $ throwGhcException $
CmdLineError (':' : cmd ++ ": no current module")
case (head imports) of
- IIModule m -> GHC.findModule m Nothing
- IIDecl d -> GHC.findModule (unLoc (ideclName d))
- (fmap sl_fs $ ideclPkgQual d)
+ IIModule m -> GHC.findQualifiedModule NoPkgQual m
+ IIDecl d -> do
+ pkgqual <- GHC.renameRawPkgQualM (ideclPkgQual d)
+ GHC.findQualifiedModule pkgqual (unLoc (ideclName d))
-- without bang, show items in context of their parents and omit children
-- with bang, show class methods and data constructors separately, and
@@ -2759,8 +2762,8 @@ checkAdd ii = do
IIDecl d -> do
let modname = unLoc (ideclName d)
- pkgqual = ideclPkgQual d
- m <- GHC.lookupModule modname (fmap sl_fs pkgqual)
+ pkgqual <- GHC.renameRawPkgQualM (ideclPkgQual d)
+ m <- GHC.lookupQualifiedModule pkgqual modname
when safe $ do
t <- GHC.isModuleTrusted m
when (not t) $ throwGhcException $ ProgramError $ ""
@@ -4510,7 +4513,7 @@ lookupModule :: GHC.GhcMonad m => String -> m Module
lookupModule mName = lookupModuleName (GHC.mkModuleName mName)
lookupModuleName :: GHC.GhcMonad m => ModuleName -> m Module
-lookupModuleName mName = GHC.lookupModule mName Nothing
+lookupModuleName mName = GHC.lookupQualifiedModule NoPkgQual mName
isMainUnitModule :: Module -> Bool
isMainUnitModule m = GHC.moduleUnit m == mainUnit
diff --git a/ghc/Main.hs b/ghc/Main.hs
index b1c45e9cc4..5e6042173f 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -53,6 +53,7 @@ import GHC.Types.Basic ( failed )
import GHC.Types.SrcLoc
import GHC.Types.SourceError
import GHC.Types.Unique.Supply
+import GHC.Types.PkgQual
import GHC.Utils.Error
import GHC.Utils.Misc
@@ -881,7 +882,7 @@ abiHash strs = do
let find_it str = do
let modname = mkModuleName str
- r <- findImportedModule fc fopts units home_unit modname Nothing
+ r <- findImportedModule fc fopts units home_unit modname NoPkgQual
case r of
Found _ m -> return m
_error -> throwGhcException $ CmdLineError $ showSDoc dflags $
diff --git a/testsuite/tests/count-deps/CountDepsAst.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout
index 9117f0892c..b557778846 100644
--- a/testsuite/tests/count-deps/CountDepsAst.stdout
+++ b/testsuite/tests/count-deps/CountDepsAst.stdout
@@ -1,4 +1,4 @@
-Found 276 Language.Haskell.Syntax module dependencies
+Found 277 Language.Haskell.Syntax module dependencies
GHC.Builtin.Names
GHC.Builtin.PrimOps
GHC.Builtin.Types
@@ -198,6 +198,7 @@ GHC.Types.Name.Occurrence
GHC.Types.Name.Ppr
GHC.Types.Name.Reader
GHC.Types.Name.Set
+GHC.Types.PkgQual
GHC.Types.RepType
GHC.Types.SafeHaskell
GHC.Types.SourceError
diff --git a/testsuite/tests/count-deps/CountDepsParser.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout
index 2738d7d33f..1e86aeb777 100644
--- a/testsuite/tests/count-deps/CountDepsParser.stdout
+++ b/testsuite/tests/count-deps/CountDepsParser.stdout
@@ -1,4 +1,4 @@
-Found 282 GHC.Parser module dependencies
+Found 283 GHC.Parser module dependencies
GHC.Builtin.Names
GHC.Builtin.PrimOps
GHC.Builtin.Types
@@ -204,6 +204,7 @@ GHC.Types.Name.Occurrence
GHC.Types.Name.Ppr
GHC.Types.Name.Reader
GHC.Types.Name.Set
+GHC.Types.PkgQual
GHC.Types.RepType
GHC.Types.SafeHaskell
GHC.Types.SourceError
diff --git a/testsuite/tests/module/mod185.stderr b/testsuite/tests/module/mod185.stderr
index a0f771ac43..1463324978 100644
--- a/testsuite/tests/module/mod185.stderr
+++ b/testsuite/tests/module/mod185.stderr
@@ -50,7 +50,7 @@
(L
{ mod185.hs:3:8-14 }
{ModuleName: Prelude})
- (Nothing)
+ (NoRawPkgQual)
(NotBoot)
(False)
(QualifiedPost)
@@ -127,3 +127,5 @@
[])))]
(Nothing)
(Nothing)))
+
+
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
index d42a808c62..31c2d79256 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
@@ -53,7 +53,7 @@
(L
{ DumpParsedAst.hs:6:8-16 }
{ModuleName: Data.Kind})
- (Nothing)
+ (NoRawPkgQual)
(NotBoot)
(False)
(NotQualified)
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index 84519126fc..d8beda8fa4 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -1263,7 +1263,7 @@
(L
{ DumpRenamedAst.hs:5:8-21 }
{ModuleName: Prelude})
- (Nothing)
+ (NoPkgQual)
(NotBoot)
(False)
(NotQualified)
@@ -1278,7 +1278,7 @@
(L
{ DumpRenamedAst.hs:6:8-16 }
{ModuleName: Data.Kind})
- (Nothing)
+ (NoPkgQual)
(NotBoot)
(False)
(NotQualified)
@@ -1293,7 +1293,7 @@
(L
{ DumpRenamedAst.hs:8:8-16 }
{ModuleName: Data.Kind})
- (Nothing)
+ (NoPkgQual)
(NotBoot)
(False)
(NotQualified)
diff --git a/testsuite/tests/parser/should_compile/DumpSemis.stderr b/testsuite/tests/parser/should_compile/DumpSemis.stderr
index 05465b8a75..0f5b6f869d 100644
--- a/testsuite/tests/parser/should_compile/DumpSemis.stderr
+++ b/testsuite/tests/parser/should_compile/DumpSemis.stderr
@@ -76,7 +76,7 @@
(L
{ DumpSemis.hs:5:8-16 }
{ModuleName: Data.List})
- (Nothing)
+ (NoRawPkgQual)
(NotBoot)
(False)
(NotQualified)
@@ -115,7 +115,7 @@
(L
{ DumpSemis.hs:7:8-16 }
{ModuleName: Data.Kind})
- (Nothing)
+ (NoRawPkgQual)
(NotBoot)
(False)
(NotQualified)
@@ -2069,4 +2069,6 @@
(FromSource))
[])))]
(Nothing)
- (Nothing))) \ No newline at end of file
+ (Nothing)))
+
+
diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr
index a8914e9c78..bd9c0deaf0 100644
--- a/testsuite/tests/parser/should_compile/KindSigs.stderr
+++ b/testsuite/tests/parser/should_compile/KindSigs.stderr
@@ -53,7 +53,7 @@
(L
{ KindSigs.hs:8:8-16 }
{ModuleName: Data.Kind})
- (Nothing)
+ (NoRawPkgQual)
(NotBoot)
(False)
(NotQualified)
diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr
index c845817586..eeadfcc06d 100644
--- a/testsuite/tests/parser/should_compile/T14189.stderr
+++ b/testsuite/tests/parser/should_compile/T14189.stderr
@@ -170,7 +170,7 @@
(L
{ T14189.hs:1:8-13 }
{ModuleName: Prelude})
- (Nothing)
+ (NoPkgQual)
(NotBoot)
(False)
(NotQualified)
diff --git a/testsuite/tests/plugins/defaulting-plugin/DefaultLifted.hs b/testsuite/tests/plugins/defaulting-plugin/DefaultLifted.hs
index 62071b9cfb..550a05e116 100644
--- a/testsuite/tests/plugins/defaulting-plugin/DefaultLifted.hs
+++ b/testsuite/tests/plugins/defaulting-plugin/DefaultLifted.hs
@@ -56,7 +56,7 @@ lookupModule mod_nm = do
case found_module of
FoundModule h -> return (fr_mod h)
_ -> do
- found_module' <- findImportedModule mod_nm $ Just $ fsLit "this"
+ found_module' <- findImportedModule mod_nm (ThisPkg (homeUnitId home_unit))
case found_module' of
FoundModule h -> return (fr_mod h)
_ -> panicDoc "Unable to resolve module looked up by plugin: "
diff --git a/testsuite/tests/tcplugins/Common.hs b/testsuite/tests/tcplugins/Common.hs
index e3ec1338a5..3ccc9a4a1b 100644
--- a/testsuite/tests/tcplugins/Common.hs
+++ b/testsuite/tests/tcplugins/Common.hs
@@ -40,6 +40,7 @@ import GHC.Types.Name.Occurrence
( mkClsOcc, mkDataOcc, mkTcOcc )
import GHC.Types.Unique.FM
( UniqFM, emptyUFM )
+import GHC.Types.PkgQual
import GHC.Unit.Finder
( FindResult(..) )
import GHC.Unit.Module
@@ -70,7 +71,7 @@ data PluginDefs =
definitionsModule :: TcPluginM Module
definitionsModule = do
- findResult <- findImportedModule ( mkModuleName "Definitions" ) Nothing
+ findResult <- findImportedModule ( mkModuleName "Definitions" ) NoPkgQual
case findResult of
Found _ res -> pure res
FoundMultiple _ -> error $ "TcPlugin test: found multiple modules named 'Definitions'."
diff --git a/testsuite/tests/tcplugins/RewritePerfPlugin.hs b/testsuite/tests/tcplugins/RewritePerfPlugin.hs
index 8659375c5d..036d89129c 100644
--- a/testsuite/tests/tcplugins/RewritePerfPlugin.hs
+++ b/testsuite/tests/tcplugins/RewritePerfPlugin.hs
@@ -35,6 +35,7 @@ import GHC.Types.Name.Occurrence
( mkTcOcc )
import GHC.Types.Unique.FM
( UniqFM, listToUFM )
+import GHC.Types.PkgQual
import GHC.Unit.Finder
( FindResult(..) )
import GHC.Unit.Module
@@ -54,7 +55,7 @@ type PluginDefs = [ TyCon ]
definitionsModule :: TcPluginM Module
definitionsModule = do
- findResult <- findImportedModule ( mkModuleName "RewritePerfDefs" ) Nothing
+ findResult <- findImportedModule ( mkModuleName "RewritePerfDefs" ) NoPkgQual
case findResult of
Found _ res -> pure res
FoundMultiple _ -> error $ "RewritePerfPlugin: found multiple modules named 'RewritePerfDefs'."
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 9de262547e..488fad1ca4 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -29,6 +29,7 @@ import GHC.Types.Basic hiding (EP)
import GHC.Types.Fixity
import GHC.Types.ForeignCall
import GHC.Types.SourceText
+import GHC.Types.PkgQual
import GHC.Types.Var
import GHC.Utils.Outputable hiding ( (<>) )
import GHC.Unit.Module.Warnings
@@ -760,7 +761,7 @@ instance ExactPrint (ImportDecl GhcPs) where
-> printStringAtMkw (importDeclAnnQualified an) "qualified"
_ -> return ()
case mpkg of
- Just (StringLiteral src v _) ->
+ RawPkgQual (StringLiteral src v _) ->
printStringAtMkw (importDeclAnnPackage an) (sourceTextToString src (show v))
_ -> return ()
diff --git a/utils/haddock b/utils/haddock
-Subproject a0938c6c48ecf8d324b636d178b2139a2d3396f
+Subproject d8b79d35ddd96c83f4a3a0303011defc209aa31