Commit 5fb485a3 authored by Edward Z. Yang's avatar Edward Z. Yang

Fix recompilation avoidance bug for implementor of hsig.

Summary:
I observed a bug where if I modified the module which implemented
an hsig in another package, GHC would not recompile the signature
in this situation.

The root cause was that we were conflating modules from user
imports, and "system" module dependencies (from signature
merging and instantiation.) So this patch handles them separately.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, bgamari, austin

Subscribers: rwbarton, thomie, snowleopard

Differential Revision: https://phabricator.haskell.org/D3381
parent d4e8ebcd
......@@ -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` []
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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,
......
......@@ -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 ]
......
......@@ -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)
......
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
import Distribution.Simple
main = defaultMain
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])
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
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]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment