summaryrefslogtreecommitdiff
path: root/compiler/GHC/Rename/Names.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Rename/Names.hs')
-rw-r--r--compiler/GHC/Rename/Names.hs77
1 files changed, 59 insertions, 18 deletions
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) })) }