diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/deSugar/DsUsage.hs | 19 | ||||
| -rw-r--r-- | compiler/iface/MkIface.hs | 10 | ||||
| -rw-r--r-- | compiler/main/HscMain.hs | 3 | ||||
| -rw-r--r-- | compiler/main/HscTypes.hs | 17 | ||||
| -rw-r--r-- | compiler/rename/RnEnv.hs | 2 | ||||
| -rw-r--r-- | compiler/rename/RnNames.hs | 9 | ||||
| -rw-r--r-- | compiler/typecheck/TcBackpack.hs | 6 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnExports.hs | 3 |
8 files changed, 49 insertions, 20 deletions
diff --git a/compiler/deSugar/DsUsage.hs b/compiler/deSugar/DsUsage.hs index ec6fe81035..aa9efd9480 100644 --- a/compiler/deSugar/DsUsage.hs +++ b/compiler/deSugar/DsUsage.hs @@ -176,13 +176,22 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names export_hash | depend_on_exports = Just (mi_exp_hash iface) | otherwise = Nothing + by_is_safe (ImportedByUser imv) = imv_is_safe imv + by_is_safe _ = False (is_direct_import, imp_safe) = case lookupModuleEnv direct_imports mod of - Just (imv : _xs) -> (True, imv_is_safe imv) - Just _ -> pprPanic "mkUsage: empty direct import" Outputable.empty - Nothing -> (False, safeImplicitImpsReq dflags) - -- Nothing case is for implicit imports like 'System.IO' when 'putStrLn' - -- is used in the source code. We require them to be safe in Safe Haskell + -- ezyang: I'm not sure if any is the correct + -- metric here. If safety was guaranteed to be uniform + -- across all imports, why did the old code only look + -- at the first import? + Just bys -> (True, any by_is_safe bys) + Just _ -> pprPanic "mkUsage: empty direct import" Outputable.empty + Nothing -> (False, safeImplicitImpsReq dflags) + -- Nothing case is for references to entities which were + -- not directly imported (NB: the "implicit" Prelude import + -- counts as directly imported! An entity is not directly + -- imported if, e.g., we got a reference to it from a + -- reexport of another module.) used_occs = lookupModuleEnv ent_map mod `orElse` [] diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index a3418860b5..435d06c5db 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -163,7 +163,6 @@ mkIfaceTc :: HscEnv -> IO (ModIface, Bool) mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details tc_result@TcGblEnv{ tcg_mod = this_mod, - tcg_semantic_mod = semantic_mod, tcg_src = hsc_src, tcg_imports = imports, tcg_rdr_env = rdr_env, @@ -180,7 +179,14 @@ mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details let hpc_info = emptyHpcInfo other_hpc_info used_th <- readIORef tc_splice_used dep_files <- (readIORef dependent_files) - usages <- mkUsageInfo hsc_env semantic_mod (imp_mods imports) used_names dep_files merged + -- Do NOT use semantic module here; this_mod in mkUsageInfo + -- is used solely to decide if we should record a dependency + -- or not. When we instantiate a signature, the semantic + -- module is something we want to record dependencies for, + -- but if you pass that in here, we'll decide it's the local + -- module and does not need to be recorded as a dependency. + -- See Note [Identity versus semantic module] + usages <- mkUsageInfo hsc_env this_mod (imp_mods imports) used_names dep_files merged mkIface_ hsc_env maybe_old_fingerprint this_mod hsc_src used_th deps rdr_env diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index ebb9420d4b..fd8c2c0ca9 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -940,7 +940,8 @@ checkSafeImports dflags tcg_env where impInfo = tcg_imports tcg_env -- ImportAvails imports = imp_mods impInfo -- ImportedMods - imports' = moduleEnvToList imports -- (Module, [ImportedModsVal]) + imports1 = moduleEnvToList imports -- (Module, [ImportedBy]) + imports' = map (fmap importedByUser) imports1 -- (Module, [ImportedModsVal]) pkgReqs = imp_trust_pkgs impInfo -- [UnitId] condense :: (Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, IsSafeImport) diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 4ba9d440ee..56d2ac5eb9 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -22,7 +22,7 @@ module HscTypes ( -- * Information about modules ModDetails(..), emptyModDetails, ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC, - ImportedMods, ImportedModsVal(..), SptEntry(..), + ImportedMods, ImportedBy(..), importedByUser, ImportedModsVal(..), SptEntry(..), ForeignSrcLang(..), ModSummary(..), ms_imps, ms_installed_mod, ms_mod_name, showModMsg, isBootSummary, @@ -1185,7 +1185,20 @@ emptyModDetails -- | Records the modules directly imported by a module for extracting e.g. -- usage information, and also to give better error message -type ImportedMods = ModuleEnv [ImportedModsVal] +type ImportedMods = ModuleEnv [ImportedBy] + +-- | If a module was "imported" by the user, we associate it with +-- more detailed usage information 'ImportedModsVal'; a module +-- imported by the system only gets used for usage information. +data ImportedBy + = ImportedByUser ImportedModsVal + | ImportedBySystem + +importedByUser :: [ImportedBy] -> [ImportedModsVal] +importedByUser (ImportedByUser imv : bys) = imv : importedByUser bys +importedByUser (ImportedBySystem : bys) = importedByUser bys +importedByUser [] = [] + data ImportedModsVal = ImportedModsVal { imv_name :: ModuleName, -- ^ The name the module is imported with diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index 7484061856..cbf70cd6a1 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -2065,7 +2065,7 @@ importSuggestions where_look imports rdr_name -- or, if this is an unqualified name, are not qualified imports interesting_imports = [ (mod, imp) | (mod, mod_imports) <- moduleEnvToList (imp_mods imports) - , Just imp <- return $ pick mod_imports + , Just imp <- return $ pick (importedByUser mod_imports) ] -- We want to keep only one for each original module; preferably one with an diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 87e041c659..eccd728db4 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -297,9 +297,7 @@ rnImportDecl this_mod , imv_all_exports = potential_gres , imv_qualified = qual_only } - let imports - = (calculateAvails dflags iface mod_safe' want_boot) - { imp_mods = unitModuleEnv (mi_module iface) [imv] } + imports = calculateAvails dflags iface mod_safe' want_boot (ImportedByUser imv) -- Complain if we import a deprecated module whenWOptM Opt_WarnWarningsDeprecations ( @@ -320,8 +318,9 @@ calculateAvails :: DynFlags -> ModIface -> IsSafeImport -> IsBootInterface + -> ImportedBy -> ImportAvails -calculateAvails dflags iface mod_safe' want_boot = +calculateAvails dflags iface mod_safe' want_boot imported_by = let imp_mod = mi_module iface imp_sem_mod= mi_semantic_module iface orph_iface = mi_orphan iface @@ -395,7 +394,7 @@ calculateAvails dflags iface mod_safe' want_boot = ([], (ipkg, False) : dep_pkgs deps, False) in ImportAvails { - imp_mods = emptyModuleEnv, -- this gets filled in later + imp_mods = unitModuleEnv (mi_module iface) [imported_by], imp_orphs = orphans, imp_finsts = finsts, imp_dep_mods = mkModDeps dependent_mods, diff --git a/compiler/typecheck/TcBackpack.hs b/compiler/typecheck/TcBackpack.hs index 694428612e..72c8652b92 100644 --- a/compiler/typecheck/TcBackpack.hs +++ b/compiler/typecheck/TcBackpack.hs @@ -768,8 +768,8 @@ mergeSignatures -- in the listing. We don't want it because a module is NOT -- supposed to include itself in its dep_orphs/dep_finsts. See #13214 iface' = iface { mi_orphan = False, mi_finsts = False } - avails = plusImportAvails (tcg_imports tcg_env) - (calculateAvails dflags iface' False False) + avails = plusImportAvails (tcg_imports tcg_env) $ + calculateAvails dflags iface' False False ImportedBySystem return tcg_env { tcg_inst_env = inst_env, tcg_insts = insts, @@ -856,7 +856,7 @@ checkImplements impl_mod req_mod@(IndefModule uid mod_name) = dflags <- getDynFlags let avails = calculateAvails dflags - impl_iface False{- safe -} False{- boot -} + impl_iface False{- safe -} False{- boot -} ImportedBySystem fix_env = mkNameEnv [ (gre_name rdr_elt, FixItem occ f) | (occ, f) <- mi_fixities impl_iface , rdr_elt <- lookupGlobalRdrEnv impl_gr occ ] diff --git a/compiler/typecheck/TcRnExports.hs b/compiler/typecheck/TcRnExports.hs index 99ab7474ad..35e30a797d 100644 --- a/compiler/typecheck/TcRnExports.hs +++ b/compiler/typecheck/TcRnExports.hs @@ -206,7 +206,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod imported_modules = [ imv_name imv - | xs <- moduleEnvElts $ imp_mods imports, imv <- xs ] + | xs <- moduleEnvElts $ imp_mods imports + , imv <- importedByUser xs ] exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum exports_from_item acc@(ExportAccum ie_names occs exports) |