Track object file dependencies for TH accurately (#20604)

`hscCompileCoreExprHook` is changed to return a list of `Module`s required
by a splice. These modules are accumulated in the TcGblEnv (tcg_th_needed_mods).
Dependencies on the object files of these modules are recording in the
interface.

The data structures in `LoaderState` are replaced with more efficient versions
to keep track of all the information required. The
MultiLayerModulesTH_Make allocations increase slightly but runtime is
faster.

Fixes #20604

-------------------------
Metric Increase:
    MultiLayerModulesTH_Make
-------------------------

2 files changed, 37 insertions, 30 deletions

diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index 5c2f6ff6cc..b4bf25b9b3 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -1278,13 +1278,13 @@ obtainTermFromVal hsc_env _bound _force _ty _x = case interpInstance interp of
 
 obtainTermFromId :: HscEnv -> Int -> Bool -> Id -> IO Term
 obtainTermFromId hsc_env bound force id =  do
-  hv <- Loader.loadName (hscInterp hsc_env) hsc_env Nothing (varName id)
+  (hv, _, _) <- Loader.loadName (hscInterp hsc_env) hsc_env (varName id)
   cvObtainTerm hsc_env bound force (idType id) hv
 
 -- Uses RTTI to reconstruct the type of an Id, making it less polymorphic
 reconstructType :: HscEnv -> Int -> Id -> IO (Maybe Type)
 reconstructType hsc_env bound id = do
-  hv <- Loader.loadName (hscInterp hsc_env) hsc_env Nothing (varName id)
+  (hv, _, _) <- Loader.loadName (hscInterp hsc_env) hsc_env (varName id)
   cvReconstructType hsc_env bound (idType id) hv
 
 mkRuntimeUnkTyVar :: Name -> Kind -> TyVar
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
index 3803bc39fe..393573fd24 100644
--- a/compiler/GHC/Runtime/Loader.hs
+++ b/compiler/GHC/Runtime/Loader.hs
@@ -65,14 +65,16 @@ import GHC.Utils.Exception
 import Control.Monad     ( unless )
 import Data.Maybe        ( mapMaybe )
 import Unsafe.Coerce     ( unsafeCoerce )
-import GHC.Unit.Types (ModuleNameWithIsBoot)
+import GHC.Linker.Types
+import GHC.Types.Unique.DFM
+import Data.List (unzip4)
 
 -- | Loads the plugins specified in the pluginModNames field of the dynamic
 -- flags. Should be called after command line arguments are parsed, but before
 -- actual compilation starts. Idempotent operation. Should be re-called if
 -- pluginModNames or pluginModNameOpts changes.
-initializePlugins :: HscEnv -> Maybe ModuleNameWithIsBoot -> IO HscEnv
-initializePlugins hsc_env mnwib
+initializePlugins :: HscEnv -> IO HscEnv
+initializePlugins hsc_env
     -- plugins not changed
   | loaded_plugins <- loadedPlugins (hsc_plugins hsc_env)
   , map lpModuleName loaded_plugins == reverse (pluginModNames dflags)
@@ -80,8 +82,8 @@ initializePlugins hsc_env mnwib
   , all same_args loaded_plugins
   = return hsc_env -- no need to reload plugins FIXME: doesn't take static plugins into account
   | otherwise
-  = do loaded_plugins <- loadPlugins hsc_env mnwib
-       let plugins' = (hsc_plugins hsc_env) { loadedPlugins = loaded_plugins }
+  = do (loaded_plugins, links, pkgs) <- loadPlugins hsc_env
+       let plugins' = (hsc_plugins hsc_env) { loadedPlugins = loaded_plugins, loadedPluginDeps = (links, pkgs) }
        let hsc_env' = hsc_env { hsc_plugins = plugins' }
        withPlugins (hsc_plugins hsc_env') driverPlugin hsc_env'
   where
@@ -90,12 +92,14 @@ initializePlugins hsc_env mnwib
     argumentsForPlugin p = map snd . filter ((== lpModuleName p) . fst)
     dflags = hsc_dflags hsc_env
 
-loadPlugins :: HscEnv -> Maybe ModuleNameWithIsBoot -> IO [LoadedPlugin]
-loadPlugins hsc_env mnwib
+loadPlugins :: HscEnv -> IO ([LoadedPlugin], [Linkable], PkgsLoaded)
+loadPlugins hsc_env
   = do { unless (null to_load) $
            checkExternalInterpreter hsc_env
-       ; plugins <- mapM loadPlugin to_load
-       ; return $ zipWith attachOptions to_load plugins }
+       ; plugins_with_deps <- mapM loadPlugin to_load
+       ; let (plugins, ifaces, links, pkgs) = unzip4 plugins_with_deps
+       ; return (zipWith attachOptions to_load (zip plugins ifaces), concat links, foldl' plusUDFM emptyUDFM pkgs)
+       }
   where
     dflags  = hsc_dflags hsc_env
     to_load = reverse $ pluginModNames dflags
@@ -105,14 +109,16 @@ loadPlugins hsc_env mnwib
       where
         options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags
                             , opt_mod_nm == mod_nm ]
-    loadPlugin = loadPlugin' (mkVarOcc "plugin") pluginTyConName hsc_env mnwib
+    loadPlugin = loadPlugin' (mkVarOcc "plugin") pluginTyConName hsc_env
 
 
-loadFrontendPlugin :: HscEnv -> ModuleName -> IO FrontendPlugin
+loadFrontendPlugin :: HscEnv -> ModuleName -> IO (FrontendPlugin, [Linkable], PkgsLoaded)
 loadFrontendPlugin hsc_env mod_name = do
     checkExternalInterpreter hsc_env
-    fst <$> loadPlugin' (mkVarOcc "frontendPlugin") frontendPluginTyConName
-                hsc_env Nothing mod_name
+    (plugin, _iface, links, pkgs)
+      <- loadPlugin' (mkVarOcc "frontendPlugin") frontendPluginTyConName
+           hsc_env mod_name
+    return (plugin, links, pkgs)
 
 -- #14335
 checkExternalInterpreter :: HscEnv -> IO ()
@@ -121,8 +127,8 @@ checkExternalInterpreter hsc_env = case interpInstance <$> hsc_interp hsc_env of
     -> throwIO (InstallationError "Plugins require -fno-external-interpreter")
   _ -> pure ()
 
-loadPlugin' :: OccName -> Name -> HscEnv -> Maybe ModuleNameWithIsBoot -> ModuleName -> IO (a, ModIface)
-loadPlugin' occ_name plugin_name hsc_env mnwib mod_name
+loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, ModIface, [Linkable], PkgsLoaded)
+loadPlugin' occ_name plugin_name hsc_env mod_name
   = do { let plugin_rdr_name = mkRdrQual mod_name occ_name
              dflags = hsc_dflags hsc_env
        ; mb_name <- lookupRdrNameInModuleForPlugins hsc_env mod_name
@@ -136,7 +142,7 @@ loadPlugin' occ_name plugin_name hsc_env mnwib mod_name
             Just (name, mod_iface) ->
 
      do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name
-        ; eith_plugin <- getValueSafely hsc_env mnwib name (mkTyConTy plugin_tycon)
+        ; eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon)
         ; case eith_plugin of
             Left actual_type ->
                 throwGhcExceptionIO (CmdLineError $
@@ -147,7 +153,7 @@ loadPlugin' occ_name plugin_name hsc_env mnwib mod_name
                           , text "did not have the type"
                           , text "GHC.Plugins.Plugin"
                           , text "as required"])
-            Right plugin -> return (plugin, mod_iface) } } }
+            Right (plugin, links, pkgs) -> return (plugin, mod_iface, links, pkgs) } } }
 
 
 -- | Force the interfaces for the given modules to be loaded. The 'SDoc' parameter is used
@@ -192,23 +198,23 @@ forceLoadTyCon hsc_env con_name = do
 -- * If the Name does not exist in the module
 -- * If the link failed
 
-getValueSafely :: HscEnv -> Maybe ModuleNameWithIsBoot -> Name -> Type -> IO (Either Type a)
-getValueSafely hsc_env mnwib val_name expected_type = do
+getValueSafely :: HscEnv -> Name -> Type -> IO (Either Type (a, [Linkable], PkgsLoaded))
+getValueSafely hsc_env val_name expected_type = do
   eith_hval <- case getValueSafelyHook hooks of
-    Nothing -> getHValueSafely interp hsc_env mnwib val_name expected_type
-    Just h  -> h                      hsc_env mnwib val_name expected_type
+    Nothing -> getHValueSafely interp hsc_env val_name expected_type
+    Just h  -> h                      hsc_env val_name expected_type
   case eith_hval of
     Left actual_type -> return (Left actual_type)
-    Right hval -> do
+    Right (hval, links, pkgs) -> do
       value <- lessUnsafeCoerce logger "getValueSafely" hval
-      return (Right value)
+      return (Right (value, links, pkgs))
   where
     interp = hscInterp hsc_env
     logger = hsc_logger hsc_env
     hooks  = hsc_hooks hsc_env
 
-getHValueSafely :: Interp -> HscEnv -> Maybe ModuleNameWithIsBoot -> Name -> Type -> IO (Either Type HValue)
-getHValueSafely interp hsc_env mnwib val_name expected_type = do
+getHValueSafely :: Interp -> HscEnv -> Name -> Type -> IO (Either Type (HValue, [Linkable], PkgsLoaded))
+getHValueSafely interp hsc_env val_name expected_type = do
     forceLoadNameModuleInterface hsc_env (text "contains a name used in an invocation of getHValueSafely") val_name
     -- Now look up the names for the value and type constructor in the type environment
     mb_val_thing <- lookupType hsc_env val_name
@@ -221,13 +227,14 @@ getHValueSafely interp hsc_env mnwib val_name expected_type = do
              then do
                 -- Link in the module that contains the value, if it has such a module
                 case nameModule_maybe val_name of
-                    Just mod -> do loadModule interp hsc_env mnwib mod
+                    Just mod -> do loadModule interp hsc_env mod
                                    return ()
                     Nothing ->  return ()
                 -- Find the value that we just linked in and cast it given that we have proved it's type
                 hval <- do
-                  v <- loadName interp hsc_env mnwib val_name
-                  wormhole interp v
+                  (v, links, pkgs) <- loadName interp hsc_env val_name
+                  hv <- wormhole interp v
+                  return (hv, links, pkgs)
                 return (Right hval)
              else return (Left (idType id))
         Just val_thing -> throwCmdLineErrorS dflags $ wrongTyThingError val_name val_thing