diff options
-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 | ||||
-rw-r--r-- | testsuite/tests/backpack/cabal/bkpcabal06/.gitignore | 1 | ||||
-rw-r--r-- | testsuite/tests/backpack/cabal/bkpcabal06/Makefile | 27 | ||||
-rw-r--r-- | testsuite/tests/backpack/cabal/bkpcabal06/Setup.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/backpack/cabal/bkpcabal06/all.T | 9 | ||||
-rw-r--r-- | testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.cabal | 24 | ||||
-rw-r--r-- | testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr | 4 | ||||
-rw-r--r-- | testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in1 | 3 | ||||
-rw-r--r-- | testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in2 | 1 | ||||
-rw-r--r-- | testsuite/tests/backpack/cabal/bkpcabal06/sig/P.hsig | 2 |
17 files changed, 122 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) diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/.gitignore b/testsuite/tests/backpack/cabal/bkpcabal06/.gitignore new file mode 100644 index 0000000000..873250a6f8 --- /dev/null +++ b/testsuite/tests/backpack/cabal/bkpcabal06/.gitignore @@ -0,0 +1 @@ +impl/P.hs diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/Makefile b/testsuite/tests/backpack/cabal/bkpcabal06/Makefile new file mode 100644 index 0000000000..29f1456e63 --- /dev/null +++ b/testsuite/tests/backpack/cabal/bkpcabal06/Makefile @@ -0,0 +1,27 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +SETUP='$(PWD)/Setup' -v0 +CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db='$(PWD)/tmp.d' --prefix='$(PWD)/inst' + +# This test checks if recompilation works correctly when we change an +# hsig file which modifies the set of exported instances. Makes sure +# we track dependencies on instances from signatures correctly. + +bkpcabal06: clean + $(MAKE) -s --no-print-directory clean + '$(GHC_PKG)' init tmp.d + '$(TEST_HC)' -v0 --make Setup + $(CONFIGURE) + cp impl/P.hs.in1 impl/P.hs + $(SETUP) build + sleep 1 + cp impl/P.hs.in2 impl/P.hs + ! $(SETUP) build +ifneq "$(CLEANUP)" "" + $(MAKE) -s --no-print-directory clean +endif + +clean : + $(RM) -rf tmp.d inst dist Setup$(exeext) impl/P.hs diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/Setup.hs b/testsuite/tests/backpack/cabal/bkpcabal06/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/testsuite/tests/backpack/cabal/bkpcabal06/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/all.T b/testsuite/tests/backpack/cabal/bkpcabal06/all.T new file mode 100644 index 0000000000..26db90c976 --- /dev/null +++ b/testsuite/tests/backpack/cabal/bkpcabal06/all.T @@ -0,0 +1,9 @@ +if config.cleanup: + cleanup = 'CLEANUP=1' +else: + cleanup = 'CLEANUP=0' + +test('bkpcabal06', + extra_files(['bkpcabal06.cabal', 'Setup.hs', 'sig', 'impl']), + run_command, + ['$MAKE -s --no-print-directory bkpcabal06 ' + cleanup]) diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.cabal b/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.cabal new file mode 100644 index 0000000000..7dfac20986 --- /dev/null +++ b/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.cabal @@ -0,0 +1,24 @@ +name: bkpcabal06 +version: 0.1.0.0 +license: BSD3 +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: >=1.10 + +library sig + signatures: P + reexported-modules: Prelude + build-depends: base + default-language: Haskell2010 + hs-source-dirs: sig + +library impl + exposed-modules: P + build-depends: base + default-language: Haskell2010 + hs-source-dirs: impl + +library + build-depends: sig, impl + default-language: Haskell2010 diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr b/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr new file mode 100644 index 0000000000..8998e6555e --- /dev/null +++ b/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr @@ -0,0 +1,4 @@ + +sig/P.hsig:1:1: error: + • ‘p’ is exported by the hsig file, but not exported by the implementing module ‘z-bkpcabal06-z-impl-0.1.0.0:P’ + • while checking that z-bkpcabal06-z-impl-0.1.0.0:P implements signature P in bkpcabal06-0.1.0.0:sig[P=z-bkpcabal06-z-impl-0.1.0.0:P] diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in1 b/testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in1 new file mode 100644 index 0000000000..f0a4da313b --- /dev/null +++ b/testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in1 @@ -0,0 +1,3 @@ +module P where +p :: Int +p = 3 diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in2 b/testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in2 new file mode 100644 index 0000000000..fc4877ad85 --- /dev/null +++ b/testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in2 @@ -0,0 +1 @@ +module P where diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/sig/P.hsig b/testsuite/tests/backpack/cabal/bkpcabal06/sig/P.hsig new file mode 100644 index 0000000000..3c99ed9ed9 --- /dev/null +++ b/testsuite/tests/backpack/cabal/bkpcabal06/sig/P.hsig @@ -0,0 +1,2 @@ +signature P where +p :: Int |