[Git][ghc/ghc][wip/hackage-bindist] 2 commits: backpack: Be more careful when adding together ImportAvails
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Thu Dec 8 11:44:51 UTC 2022
Matthew Pickering pushed to branch wip/hackage-bindist at Glasgow Haskell Compiler / GHC
Commits:
08552434 by Matthew Pickering at 2022-12-08T11:44:41+00:00
backpack: Be more careful when adding together ImportAvails
There was some code in the signature merging logic which added together
the ImportAvails of the signature and the signature which was merged
into it. This had the side-effect of making the merged signature depend
on the signature (via a normal module dependency). The intention was to
propagate orphan instances through the merge but this also messed up
recompilation logic because we shouldn't be attempting to load B.hi when
mergeing it.
The fix is to just combine the part of ImportAvails that we intended to
(transitive info, orphan instances and type family instances) rather
than the whole thing.
- - - - -
ee599c52 by Matthew Pickering at 2022-12-08T11:44:41+00:00
Fix mk_mod_usage_info if the interface file is not already loaded
In #22217 it was observed that the order modules are compiled in affects
the contents of an interface file. This was because a module dependended
on another module indirectly, via a re-export but the interface file for
this module was never loaded because the symbol was never used in the
file.
If we decide that we depend on a module then we jolly well ought to
record this fact in the interface file! Otherwise it could lead to very
subtle recompilation bugs if the dependency is not tracked and the
module is updated.
Therefore the best thing to do is just to make sure the file is loaded
by calling the `loadSysInterface` function. This first checks the
caches (like we did before) but then actually goes to find the interface
on disk if it wasn't loaded.
Fixes #22217
- - - - -
10 changed files:
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- testsuite/tests/backpack/should_fail/T19244a.stderr
- + testsuite/tests/determinism/determ024/A.hs
- + testsuite/tests/determinism/determ024/B.hs
- + testsuite/tests/determinism/determ024/Makefile
- + testsuite/tests/determinism/determ024/all.T
Changes:
=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -41,7 +41,7 @@ import GHC.HsToCore.Coverage
import GHC.HsToCore.Docs
import GHC.Tc.Types
-import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances )
+import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances, initIfaceLoad )
import GHC.Tc.Module ( runTcInteractive )
import GHC.Core.Type
@@ -241,8 +241,9 @@ deSugar hsc_env
; let plugins = hsc_plugins hsc_env
; let fc = hsc_FC hsc_env
; let unit_env = hsc_unit_env hsc_env
- ; usages <- mkUsageInfo uc plugins fc unit_env mod (imp_mods imports) used_names
- dep_files merged needed_mods needed_pkgs
+ ; usages <- initIfaceLoad hsc_env $
+ mkUsageInfo uc plugins fc unit_env mod (imp_mods imports) used_names
+ dep_files merged needed_mods needed_pkgs
-- id_mod /= mod when we are processing an hsig, but hsigs
-- never desugared and compiled (there's no code!)
-- Consequently, this should hold for any ModGuts that make
=====================================
compiler/GHC/HsToCore/Usage.hs
=====================================
@@ -15,10 +15,13 @@ import GHC.Driver.Env
import GHC.Tc.Types
+import GHC.Iface.Load
+
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Fingerprint
import GHC.Utils.Panic
+import GHC.Utils.Monad
import GHC.Types.Name
import GHC.Types.Name.Set ( NameSet, allUses )
@@ -70,18 +73,18 @@ data UsageConfig = UsageConfig
}
mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv -> Module -> ImportedMods -> NameSet -> [FilePath]
- -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded -> IO [Usage]
+ -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded -> IfG [Usage]
mkUsageInfo uc plugins fc unit_env this_mod dir_imp_mods used_names dependent_files merged needed_links needed_pkgs
= do
- eps <- readIORef (euc_eps (ue_eps unit_env))
- hashes <- mapM getFileHash dependent_files
+ eps <- liftIO $ readIORef (euc_eps (ue_eps unit_env))
+ hashes <- liftIO $ mapM getFileHash dependent_files
let hu = unsafeGetHomeUnit unit_env
hug = ue_home_unit_graph unit_env
-- Dependencies on object files due to TH and plugins
- object_usages <- mkObjectUsage (eps_PIT eps) plugins fc hug needed_links needed_pkgs
- let mod_usages = mk_mod_usage_info (eps_PIT eps) uc hug hu this_mod
+ object_usages <- liftIO $ mkObjectUsage (eps_PIT eps) plugins fc hug needed_links needed_pkgs
+ mod_usages <- mk_mod_usage_info uc hu this_mod
dir_imp_mods used_names
- usages = mod_usages ++ [ UsageFile { usg_file_path = f
+ let usages = mod_usages ++ [ UsageFile { usg_file_path = f
, usg_file_hash = hash
, usg_file_label = Nothing }
| (f, hash) <- zip dependent_files hashes ]
@@ -189,16 +192,14 @@ mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do
librarySpecToUsage (DLLPath fn) = traverse (fing Nothing) [fn]
librarySpecToUsage _ = return []
-mk_mod_usage_info :: PackageIfaceTable
- -> UsageConfig
- -> HomeUnitGraph
+mk_mod_usage_info :: UsageConfig
-> HomeUnit
-> Module
-> ImportedMods
-> NameSet
- -> [Usage]
-mk_mod_usage_info pit uc hpt home_unit this_mod direct_imports used_names
- = mapMaybe mkUsage usage_mods
+ -> IfG [Usage]
+mk_mod_usage_info uc home_unit this_mod direct_imports used_names
+ = mapMaybeM mkUsageM usage_mods
where
safe_implicit_imps_req = uc_safe_implicit_imps_req uc
@@ -234,22 +235,27 @@ mk_mod_usage_info pit uc hpt home_unit this_mod direct_imports used_names
in extendModuleEnvWith (\_ xs -> occ:xs) mv_map mod' [occ]
where occ = nameOccName name
+ mkUsageM :: Module -> IfG (Maybe Usage)
+ mkUsageM mod | mod == this_mod -- We don't care about usages of things in *this* module
+ || moduleUnit mod == interactiveUnit -- ... or in GHCi
+ = return Nothing
+ mkUsageM mod = do
+ iface <- loadSysInterface (text "mk_mod_usage") mod
+ -- Make sure the interface is loaded even if we don't directly use
+ -- any symbols from it, to ensure determinism. See #22217.
+ return $ mkUsage mod iface
+
+
-- We want to create a Usage for a home module if
-- a) we used something from it; has something in used_names
-- b) we imported it, even if we used nothing from it
-- (need to recompile if its export list changes: export_fprint)
- mkUsage :: Module -> Maybe Usage
- mkUsage mod
- | isNothing maybe_iface -- We can't depend on it if we didn't
- -- load its interface.
- || mod == this_mod -- We don't care about usages of
- -- things in *this* module
- = Nothing
-
+ mkUsage :: Module -> ModIface -> Maybe Usage
+ mkUsage mod iface
| not (isHomeModule home_unit mod)
- = Just UsagePackageModule{ usg_mod = mod,
- usg_mod_hash = mod_hash,
- usg_safe = imp_safe }
+ = Just $ UsagePackageModule{ usg_mod = mod,
+ usg_mod_hash = mod_hash,
+ usg_safe = imp_safe }
-- for package modules, we record the module hash only
| (null used_occs
@@ -269,11 +275,6 @@ mk_mod_usage_info pit uc hpt home_unit this_mod direct_imports used_names
usg_entities = Map.toList ent_hashs,
usg_safe = imp_safe }
where
- maybe_iface = lookupIfaceByModule hpt pit mod
- -- In one-shot mode, the interfaces for home-package
- -- modules accumulate in the PIT not HPT. Sigh.
-
- Just iface = maybe_iface
finsts_mod = mi_finsts (mi_final_exts iface)
hash_env = mi_hash_fn (mi_final_exts iface)
mod_hash = mi_mod_hash (mi_final_exts iface)
=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -232,7 +232,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary mb_program
-- 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 uc plugins fc unit_env this_mod (imp_mods imports) used_names
+ usages <- initIfaceLoad hsc_env $ mkUsageInfo uc plugins fc unit_env this_mod (imp_mods imports) used_names
dep_files merged needed_links needed_pkgs
docs <- extractDocs (ms_hspp_opts mod_summary) tc_result
=====================================
compiler/GHC/Iface/Recomp.hs
=====================================
@@ -589,7 +589,7 @@ checkDependencies hsc_env summary iface
liftIO $
check_mods (sort hs) prev_dep_mods
`recompThen`
- let allPkgDeps = sortBy (comparing snd) $ nubOrdOn snd (ps ++ implicit_deps ++ bkpk_units)
+ let allPkgDeps = sortBy (comparing snd) $ nubOrdOn snd (ps ++ implicit_deps)
in check_packages allPkgDeps prev_dep_pkgs
where
@@ -613,7 +613,6 @@ checkDependencies hsc_env summary iface
prev_dep_mods = map (second gwib_mod) $ Set.toAscList $ dep_direct_mods (mi_deps iface)
prev_dep_pkgs = Set.toAscList (Set.union (dep_direct_pkgs (mi_deps iface))
(dep_plugin_pkgs (mi_deps iface)))
- bkpk_units = map ((fsLit "Signature",) . instUnitInstanceOf . moduleUnit) (requirementMerges units (moduleName (mi_module iface)))
implicit_deps = map (fsLit "Implicit",) (implicitPackageDeps dflags)
=====================================
compiler/GHC/Tc/Utils/Backpack.hs
=====================================
@@ -856,7 +856,6 @@ mergeSignatures
-- we hope that we get lucky / the overlapping instances never
-- get used, but it is not a very good situation to be in.
--
- hsc_env <- getTopEnv
let merge_inst (insts, inst_env) inst
| memberInstEnv inst_env inst -- test DFun Type equality
= (insts, inst_env)
@@ -867,18 +866,17 @@ mergeSignatures
(insts, inst_env) = foldl' merge_inst
(tcg_insts tcg_env, tcg_inst_env tcg_env)
(instEnvElts $ md_insts details)
- -- This is a HACK to prevent calculateAvails from including imp_mod
- -- in the listing. We don't want it because a module is NOT
+ -- Use mi_deps directly rather than calculateAvails.
+ -- because a module is NOT
-- supposed to include itself in its dep_orphs/dep_finsts. See #13214
- iface' = iface { mi_final_exts = (mi_final_exts iface){ mi_orphan = False, mi_finsts = False } }
- home_unit = hsc_home_unit hsc_env
- other_home_units = hsc_all_home_unit_ids hsc_env
- avails = plusImportAvails (tcg_imports tcg_env) $
- calculateAvails home_unit other_home_units iface' False NotBoot ImportedBySystem
+ avails = tcg_imports tcg_env
+ deps = mi_deps iface
+ avails_with_trans = addTransitiveDepInfo avails deps
+
return tcg_env {
tcg_inst_env = inst_env,
tcg_insts = insts,
- tcg_imports = avails,
+ tcg_imports = avails_with_trans,
tcg_merged =
if outer_mod == mi_module iface
-- Don't add ourselves!
@@ -912,6 +910,20 @@ mergeSignatures
return tcg_env
+-- | Add on the necessary transitive information from the merged signature to
+-- the 'ImportAvails' of the result of merging. This propagates the orphan instances
+-- which were in the transitive closure of the signature through the merge.
+addTransitiveDepInfo :: ImportAvails -- ^ From the signature resulting from the merge
+ -> Dependencies -- ^ From the original signature
+ -> ImportAvails
+addTransitiveDepInfo avails deps =
+ -- Avails for the merged in signature
+ -- Add on transitive information from the signature but nothing else..
+ -- because we do not "import" the signature.
+ avails { imp_orphs = imp_orphs avails ++ dep_orphs deps
+ , imp_finsts = imp_finsts avails ++ dep_finsts deps
+ , imp_sig_mods = imp_sig_mods avails ++ dep_sig_mods deps }
+
-- | Top-level driver for signature instantiation (run when compiling
-- an @hsig@ file.)
tcRnInstantiateSignature ::
=====================================
testsuite/tests/backpack/should_fail/T19244a.stderr
=====================================
@@ -13,7 +13,17 @@
Instantiating user[Map=ordmap:Map]
[1 of 2] Compiling Map[sig] ( user/Map.hsig, T19244a.out/user/user-GzloW2NeDdA2M0V8qzN4g2/Map.o )
-T19244a.bkp:9:9: error:
+T19244a.bkp:22:9: error:
+ • Type constructor ‘Key’ has conflicting definitions in the module
+ and its hsig file
+ Main module: type Key :: * -> Constraint
+ type Key = GHC.Classes.Ord :: * -> Constraint
+ Hsig file: type Key :: forall {k}. k -> Constraint
+ class Key k1
+ The types have different kinds
+ • while checking that ordmap:Map implements signature Map in user[Map=ordmap:Map]
+
+<no location info>: error:
• Type constructor ‘Map’ has conflicting definitions in the module
and its hsig file
Main module: type role Map nominal representational
@@ -31,16 +41,6 @@ T19244a.bkp:9:9: error:
The types have different kinds
• while checking that ordmap:Map implements signature Map in user[Map=ordmap:Map]
-T19244a.bkp:22:9: error:
- • Type constructor ‘Key’ has conflicting definitions in the module
- and its hsig file
- Main module: type Key :: * -> Constraint
- type Key = GHC.Classes.Ord :: * -> Constraint
- Hsig file: type Key :: forall {k}. k -> Constraint
- class Key k1
- The types have different kinds
- • while checking that ordmap:Map implements signature Map in user[Map=ordmap:Map]
-
<no location info>: error:
• Identifier ‘lookup’ has conflicting definitions in the module
and its hsig file
=====================================
testsuite/tests/determinism/determ024/A.hs
=====================================
@@ -0,0 +1,6 @@
+module A
+( isExtensionOf
+, stripExtension
+) where
+
+import System.FilePath.Posix
=====================================
testsuite/tests/determinism/determ024/B.hs
=====================================
@@ -0,0 +1,7 @@
+module B
+( isExtensionOf
+, stripExtension
+) where
+
+import System.FilePath
+
=====================================
testsuite/tests/determinism/determ024/Makefile
=====================================
@@ -0,0 +1,11 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+determ024:
+ $(RM) A.hi A.o B.hi B.o
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 B.hs
+ '$(TEST_HC)' --show-iface B.hi > B_clean_iface
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 A.hs B.hs -fforce-recomp
+ '$(TEST_HC)' --show-iface B.hi > B_dirty_iface
+ diff B_clean_iface B_dirty_iface
=====================================
testsuite/tests/determinism/determ024/all.T
=====================================
@@ -0,0 +1 @@
+test('determ024', [extra_files(['A.hs', 'B.hs'])], makefile_test, ['determ024'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2f3277fda3715491eef8be80498ef7befc53480a...ee599c52b4e3cbf449e3348f2e24d8624defdb07
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2f3277fda3715491eef8be80498ef7befc53480a...ee599c52b4e3cbf449e3348f2e24d8624defdb07
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221208/0e3338e8/attachment-0001.html>
More information about the ghc-commits
mailing list