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

3 files changed, 34 insertions, 32 deletions

diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index 05487e769e..3c6ec71079 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/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
diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index f3eb5ab0b3..498fe888b8 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/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)
diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs
index 7b779f3ea1..ac55220cbf 100644
--- a/compiler/GHC/Iface/Make.hs
+++ b/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