summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/deSugar/DsUsage.hs19
-rw-r--r--compiler/iface/MkIface.hs10
-rw-r--r--compiler/main/HscMain.hs3
-rw-r--r--compiler/main/HscTypes.hs17
-rw-r--r--compiler/rename/RnEnv.hs2
-rw-r--r--compiler/rename/RnNames.hs9
-rw-r--r--compiler/typecheck/TcBackpack.hs6
-rw-r--r--compiler/typecheck/TcRnExports.hs3
-rw-r--r--testsuite/tests/backpack/cabal/bkpcabal06/.gitignore1
-rw-r--r--testsuite/tests/backpack/cabal/bkpcabal06/Makefile27
-rw-r--r--testsuite/tests/backpack/cabal/bkpcabal06/Setup.hs2
-rw-r--r--testsuite/tests/backpack/cabal/bkpcabal06/all.T9
-rw-r--r--testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.cabal24
-rw-r--r--testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr4
-rw-r--r--testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in13
-rw-r--r--testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in21
-rw-r--r--testsuite/tests/backpack/cabal/bkpcabal06/sig/P.hsig2
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