Driver Rework Patch

This patch comprises of four different but closely related ideas. The
net result is fixing a large number of open issues with the driver
whilst making it simpler to understand.

1. Use the hash of the source file to determine whether the source file
has changed or not. This makes the recompilation checking more robust to
modern build systems which are liable to copy files around changing
their modification times.

2. Remove the concept of a "stable module", a stable module was one
where the object file was older than the source file, and all transitive
dependencies were also stable. Now we don't rely on the modification
time of the source file, the notion of stability is moot.

3. Fix TH/plugin recompilation after the removal of stable modules. The
TH recompilation check used to rely on stable modules. Now there is a
uniform and simple way, we directly track the linkables which were
loaded into the interpreter whilst compiling a module. This is an
over-approximation but more robust wrt package dependencies changing.

4. Fix recompilation checking for dynamic object files. Now we actually
check if the dynamic object file exists when compiling with -dynamic-too

Fixes #19774 #19771 #19758 #17434 #11556 #9121 #8211 #16495 #7277 #16093

1 files changed, 61 insertions, 106 deletions

diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index 0da8f59070..4731d32591 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -12,8 +12,6 @@ import GHC.Prelude
 import GHC.Driver.Env
 import GHC.Driver.Session
 
-import GHC.Platform
-import GHC.Platform.Ways
 
 import GHC.Tc.Types
 
@@ -23,29 +21,26 @@ import GHC.Utils.Fingerprint
 import GHC.Utils.Panic
 
 import GHC.Types.Name
-import GHC.Types.Name.Set
+import GHC.Types.Name.Set ( NameSet, allUses )
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.FM
 
 import GHC.Unit
 import GHC.Unit.External
-import GHC.Unit.State
-import GHC.Unit.Finder
 import GHC.Unit.Module.Imported
 import GHC.Unit.Module.ModIface
 import GHC.Unit.Module.Deps
 
 import GHC.Data.Maybe
 
-import Control.Monad (filterM)
-import Data.List (sortBy, sort, nub)
-import Data.IORef
+import Data.List (sortBy, sort, partition)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 
-import System.Directory
-import System.FilePath
+import GHC.Linker.Types
+import GHC.Linker.Loader ( getLoaderState )
+import GHC.Types.SourceFile
 
 {- Note [Module self-dependency]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -73,15 +68,15 @@ its dep_orphs. This was the cause of #14128.
 mkDependencies :: UnitId -> [Module] -> TcGblEnv -> IO Dependencies
 mkDependencies iuid pluginModules
           (TcGblEnv{ tcg_mod = mod,
-                    tcg_imports = imports,
-                    tcg_th_used = th_var
+                    tcg_imports = imports
                   })
  = do
-      -- Template Haskell used?
-      let (dep_plgins, ms) = unzip [ (moduleName mn, mn) | mn <- pluginModules ]
-          plugin_dep_pkgs = filter (/= iuid) (map (toUnitId . moduleUnit) ms)
-      th_used <- readIORef th_var
-      let direct_mods = modDepsElts (delFromUFM (imp_direct_dep_mods imports) (moduleName mod))
+
+      let (home_plugins, package_plugins) = partition ((== iuid) . toUnitId . moduleUnit) pluginModules
+          plugin_dep_pkgs =  map (toUnitId . moduleUnit) package_plugins
+          all_direct_mods = foldr (\mn m -> addToUFM m mn (GWIB mn NotBoot)) (imp_direct_dep_mods imports) (map moduleName home_plugins)
+
+          direct_mods = modDepsElts (delFromUFM all_direct_mods (moduleName mod))
                 -- M.hi-boot can be in the imp_dep_mods, but we must remove
                 -- it before recording the modules on which this one depends!
                 -- (We want to retain M.hi-boot in imp_dep_mods so that
@@ -95,9 +90,7 @@ mkDependencies iuid pluginModules
 
           direct_pkgs_0 = foldr Set.insert (imp_dep_direct_pkgs imports) plugin_dep_pkgs
 
-          direct_pkgs
-            | th_used = Set.insert thUnitId direct_pkgs_0
-            | otherwise = direct_pkgs_0
+          direct_pkgs = direct_pkgs_0
 
           -- Set the packages required to be Safe according to Safe Haskell.
           -- See Note [Tracking Trust Transitively] in GHC.Rename.Names
@@ -116,7 +109,6 @@ mkDependencies iuid pluginModules
                     dep_trusted_pkgs = sort (Set.toList trust_pkgs),
                     dep_boot_mods  = sort source_mods,
                     dep_orphs  = dep_orphs,
-                    dep_plgins = dep_plgins,
                     dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
                     -- sort to get into canonical order
                     -- NB. remember to use lexicographic ordering
@@ -124,25 +116,26 @@ mkDependencies iuid pluginModules
 mkUsedNames :: TcGblEnv -> NameSet
 mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
 
-mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath]
-            -> [(Module, Fingerprint)] -> [ModIface] -> IO [Usage]
-mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files merged
-  pluginModules
+mkUsageInfo :: HscEnv -> Module -> HscSource -> ImportedMods -> NameSet -> [FilePath]
+            -> [(Module, Fingerprint)] -> IO [Usage]
+mkUsageInfo hsc_env this_mod src dir_imp_mods used_names dependent_files merged
   = do
     eps <- hscEPS hsc_env
     hashes <- mapM getFileHash dependent_files
-    plugin_usages <- mapM (mkPluginUsage hsc_env) pluginModules
+    -- Dependencies on object files due to TH and plugins
+    object_usages <- mkObjectUsage (eps_PIT eps) hsc_env (GWIB (moduleName this_mod) (hscSourceToIsBoot src))
     let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod
                                        dir_imp_mods used_names
         usages = mod_usages ++ [ UsageFile { usg_file_path = f
-                                           , usg_file_hash = hash }
+                                           , usg_file_hash = hash
+                                           , usg_file_label = Nothing }
                                | (f, hash) <- zip dependent_files hashes ]
                             ++ [ UsageMergedRequirement
                                     { usg_mod = mod,
                                       usg_mod_hash = hash
                                     }
                                | (mod, hash) <- merged ]
-                            ++ concat plugin_usages
+                            ++ object_usages
     usages `seqList` return usages
     -- seq the list of Usages returned: occasionally these
     -- don't get evaluated for a while and we can end up hanging on to
@@ -185,85 +178,47 @@ One way to improve this is to either:
     compare implementation hashes for recompilation. Creation of implementation
     hashes is however potentially expensive.
 -}
-mkPluginUsage :: HscEnv -> ModIface -> IO [Usage]
-mkPluginUsage hsc_env pluginModule
-  = case lookupPluginModuleWithSuggestions pkgs pNm Nothing of
-    LookupFound _ pkg -> do
-    -- The plugin is from an external package:
-    -- search for the library files containing the plugin.
-      let searchPaths = collectLibraryDirs (ways dflags) [pkg]
-          useDyn = WayDyn `elem` ways dflags
-          suffix = if useDyn then platformSOExt platform else "a"
-          libLocs = [ searchPath </> "lib" ++ libLoc <.> suffix
-                    | searchPath <- searchPaths
-                    , libLoc     <- unitHsLibs (ghcNameVersion dflags) (ways dflags) pkg
-                    ]
-          -- we also try to find plugin library files by adding WayDyn way,
-          -- if it isn't already present (see trac #15492)
-          paths =
-            if useDyn
-              then libLocs
-              else
-                let dflags'  = dflags { targetWays_ = addWay WayDyn (targetWays_ dflags) }
-                    dlibLocs = [ searchPath </> platformHsSOName platform dlibLoc
-                               | searchPath <- searchPaths
-                               , dlibLoc    <- unitHsLibs (ghcNameVersion dflags') (ways dflags') pkg
-                               ]
-                in libLocs ++ dlibLocs
-      files <- filterM doesFileExist paths
-      case files of
-        [] ->
-          pprPanic
-             ( "mkPluginUsage: missing plugin library, tried:\n"
-              ++ unlines paths
-             )
-             (ppr pNm)
-        _  -> mapM hashFile (nub files)
-    _ -> do
-      let fc = hsc_FC hsc_env
-      let units = hsc_units hsc_env
-      let home_unit = hsc_home_unit hsc_env
-      let dflags = hsc_dflags hsc_env
-      foundM <- findPluginModule fc units home_unit dflags pNm
-      case foundM of
-      -- The plugin was built locally: look up the object file containing
-      -- the `plugin` binder, and all object files belong to modules that are
-      -- transitive dependencies of the plugin that belong to the same package.
-        Found ml _ -> do
-          pluginObject <- hashFile (ml_obj_file ml)
-          depObjects   <- catMaybes <$> mapM lookupObjectFile deps
-          return (nub (pluginObject : depObjects))
-        _ -> pprPanic "mkPluginUsage: no object file found" (ppr pNm)
+
+-- | Find object files corresponding to the transitive closure of given home
+-- modules and direct object files for pkg dependencies
+mkObjectUsage :: PackageIfaceTable -> HscEnv -> ModuleNameWithIsBoot -> IO [Usage]
+mkObjectUsage pit hsc_env mnwib = do
+  case hsc_interp hsc_env of
+      Just interp -> do
+        mps <- getLoaderState interp
+        case mps of
+          Just ps -> do
+            let ls = fromMaybe [] $ Map.lookup mnwib (module_deps ps)
+                ds = hs_objs_loaded ps
+            concat <$> sequence (map linkableToUsage ls ++ map librarySpecToUsage ds)
+          Nothing -> return []
+      Nothing -> return []
+
+
   where
-    dflags   = hsc_dflags hsc_env
-    fc       = hsc_FC hsc_env
-    home_unit = hsc_home_unit hsc_env
-    units    = hsc_units hsc_env
-    platform = targetPlatform dflags
-    pkgs     = hsc_units hsc_env
-    pNm      = moduleName $ mi_module pluginModule
-    pPkg     = moduleUnit $ mi_module pluginModule
-    deps     = map gwib_mod $
-      dep_direct_mods $ mi_deps pluginModule
-
-    -- Lookup object file for a plugin dependency,
-    -- from the same package as the plugin.
-    lookupObjectFile nm = do
-      foundM <- findImportedModule fc units home_unit dflags nm Nothing
-      case foundM of
-        Found ml m
-          | moduleUnit m == pPkg -> Just <$> hashFile (ml_obj_file ml)
-          | otherwise              -> return Nothing
-        _ -> pprPanic "mkPluginUsage: no object for dependency"
-                      (ppr pNm <+> ppr nm)
-
-    hashFile f = do
-      fExist <- doesFileExist f
-      if fExist
-         then do
-            h <- getFileHash f
-            return (UsageFile f h)
-         else pprPanic "mkPluginUsage: file not found" (ppr pNm <+> text f)
+    linkableToUsage (LM _ m uls) = mapM (unlinkedToUsage m) uls
+
+    msg m = moduleNameString (moduleName m) ++ "[TH] changed"
+
+    fing mmsg fn = UsageFile fn <$> getFileHash fn <*> pure mmsg
+
+    unlinkedToUsage m ul =
+      case nameOfObject_maybe ul of
+        Just fn -> fing (Just (msg m)) fn
+        Nothing ->  do
+          -- This should only happen for home package things but oneshot puts
+          -- home package ifaces in the PIT.
+          let miface = lookupIfaceByModule (hsc_HPT hsc_env) pit m
+          case miface of
+            Nothing -> pprPanic "mkObjectUsage" (ppr m)
+            Just iface ->
+              return $ UsageHomeModuleInterface (moduleName m) (mi_iface_hash (mi_final_exts iface))
+
+    librarySpecToUsage :: LibrarySpec -> IO [Usage]
+    librarySpecToUsage (Objects os) = traverse (fing Nothing) os
+    librarySpecToUsage (Archive fn) = traverse (fing Nothing) [fn]
+    librarySpecToUsage (DLLPath fn) = traverse (fing Nothing) [fn]
+    librarySpecToUsage _ = return []
 
 mk_mod_usage_info :: PackageIfaceTable
               -> HscEnv