summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2021-06-08 20:49:49 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-06-09 09:46:51 -0400
commitd69067a1b920f1122f55dd9caa39cf9ed9ba1d9b (patch)
treeae2d44ac308c134cc19fa7390dbe0299e49bda35
parent31bfafeca2f652a466f8a091f74393ab2e314176 (diff)
downloadhaskell-d69067a1b920f1122f55dd9caa39cf9ed9ba1d9b.tar.gz
FinderCache: Also cache file hashing in interface file checks
Now that we hash object files to decide when to recompile due to TH, this can make a big difference as each interface file in a project will contain reference to the object files of all package dependencies. Especially when these are statically linked, hashing them can add up. The cache is invalidated when `depanalPartial` is called, like the normal finder cache.
-rw-r--r--compiler/GHC/Iface/Recomp.hs21
-rw-r--r--compiler/GHC/Unit/Finder.hs28
-rw-r--r--compiler/GHC/Unit/Finder/Types.hs7
3 files changed, 39 insertions, 17 deletions
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index 68ca5bfdbe..7759aea72d 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -271,7 +271,7 @@ checkVersions hsc_env mod_summary iface
when (isOneShot (ghcMode (hsc_dflags hsc_env))) $ do {
; updateEps_ $ \eps -> eps { eps_is_boot = mkModDeps $ (dep_boot_mods (mi_deps iface)) }
}
- ; recomp <- checkList [checkModUsage (homeUnitAsUnit home_unit) u
+ ; recomp <- checkList [checkModUsage (hsc_FC hsc_env) (homeUnitAsUnit home_unit) u
| u <- mi_usages iface]
; return (recomp, Just iface)
}}}}}}}}}}}
@@ -550,8 +550,8 @@ getFromModIface doc_msg mod getter
-- | Given the usage information extracted from the old
-- M.hi file for the module being compiled, figure out
-- whether M needs to be recompiled.
-checkModUsage :: Unit -> Usage -> IfG RecompileRequired
-checkModUsage _this_pkg UsagePackageModule{
+checkModUsage :: FinderCache -> Unit -> Usage -> IfG RecompileRequired
+checkModUsage _ _this_pkg UsagePackageModule{
usg_mod = mod,
usg_mod_hash = old_mod_hash } = do
logger <- getLogger
@@ -563,19 +563,19 @@ checkModUsage _this_pkg UsagePackageModule{
-- recompile. This is safe but may entail more recompilation when
-- a dependent package has changed.
-checkModUsage _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_hash } = do
+checkModUsage _ _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_hash } = do
logger <- getLogger
needInterface mod $ \iface -> do
let reason = moduleNameString (moduleName mod) ++ " changed (raw)"
checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash (mi_final_exts iface))
-checkModUsage this_pkg UsageHomeModuleInterface{ usg_mod_name = mod_name, usg_iface_hash = old_mod_hash } = do
+checkModUsage _ this_pkg UsageHomeModuleInterface{ usg_mod_name = mod_name, usg_iface_hash = old_mod_hash } = do
let mod = mkModule this_pkg mod_name
logger <- getLogger
needInterface mod $ \iface -> do
let reason = moduleNameString (moduleName mod) ++ " changed (interface)"
checkIfaceFingerprint logger reason old_mod_hash (mi_iface_hash (mi_final_exts iface))
-checkModUsage this_pkg UsageHomeModule{
+checkModUsage _ this_pkg UsageHomeModule{
usg_mod_name = mod_name,
usg_mod_hash = old_mod_hash,
usg_exports = maybe_old_export_hash,
@@ -602,19 +602,18 @@ checkModUsage this_pkg UsageHomeModule{
(text " Export list changed") $ do
-- CHECK ITEMS ONE BY ONE
- recompile <- checkList [ checkEntityUsage logger reason new_decl_hash u
- | u <- old_decl_hash]
+ !recompile <- checkList [ checkEntityUsage logger reason new_decl_hash u
+ | u <- old_decl_hash]
if recompileRequired recompile
then return recompile -- This one failed, so just bail out now
else up_to_date logger (text " Great! The bits I use are up to date")
-
-checkModUsage _this_pkg UsageFile{ usg_file_path = file,
+checkModUsage fc _this_pkg UsageFile{ usg_file_path = file,
usg_file_hash = old_hash,
usg_file_label = mlabel } =
liftIO $
handleIO handler $ do
- new_hash <- getFileHash file
+ new_hash <- lookupFileCache fc file
if (old_hash /= new_hash)
then return recomp
else return UpToDate
diff --git a/compiler/GHC/Unit/Finder.hs b/compiler/GHC/Unit/Finder.hs
index 0a42149a42..57e458af79 100644
--- a/compiler/GHC/Unit/Finder.hs
+++ b/compiler/GHC/Unit/Finder.hs
@@ -30,6 +30,9 @@ module GHC.Unit.Finder (
findObjectLinkableMaybe,
findObjectLinkable,
+ -- Hash cache
+ lookupFileCache
+
) where
import GHC.Prelude
@@ -56,11 +59,13 @@ import GHC.Utils.Panic
import GHC.Linker.Types
+import GHC.Fingerprint
import Data.IORef
import System.Directory
import System.FilePath
import Control.Monad
import Data.Time
+import qualified Data.Map as M
type FileExt = String -- Filename extension
@@ -82,28 +87,41 @@ type BaseName = String -- Basename of file
initFinderCache :: IO FinderCache
initFinderCache = FinderCache <$> newIORef emptyInstalledModuleEnv
+ <*> newIORef M.empty
-- remove all the home modules from the cache; package modules are
--- assumed to not move around during a session.
+-- assumed to not move around during a session; also flush the file hash
+-- cache
flushFinderCaches :: FinderCache -> HomeUnit -> IO ()
-flushFinderCaches (FinderCache ref) home_unit =
+flushFinderCaches (FinderCache ref file_ref) home_unit = do
atomicModifyIORef' ref $ \fm -> (filterInstalledModuleEnv is_ext fm, ())
+ atomicModifyIORef' file_ref $ \_ -> (M.empty, ())
where
is_ext mod _ = not (isHomeInstalledModule home_unit mod)
addToFinderCache :: FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
-addToFinderCache (FinderCache ref) key val =
+addToFinderCache (FinderCache ref _) key val =
atomicModifyIORef' ref $ \c -> (extendInstalledModuleEnv c key val, ())
removeFromFinderCache :: FinderCache -> InstalledModule -> IO ()
-removeFromFinderCache (FinderCache ref) key =
+removeFromFinderCache (FinderCache ref _) key =
atomicModifyIORef' ref $ \c -> (delInstalledModuleEnv c key, ())
lookupFinderCache :: FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult)
-lookupFinderCache (FinderCache ref) key = do
+lookupFinderCache (FinderCache ref _) key = do
c <- readIORef ref
return $! lookupInstalledModuleEnv c key
+lookupFileCache :: FinderCache -> FilePath -> IO Fingerprint
+lookupFileCache (FinderCache _ ref) key = do
+ c <- readIORef ref
+ case M.lookup key c of
+ Nothing -> do
+ hash <- getFileHash key
+ atomicModifyIORef' ref $ \c -> (M.insert key hash c, ())
+ return hash
+ Just fp -> return fp
+
-- -----------------------------------------------------------------------------
-- The three external entry points
diff --git a/compiler/GHC/Unit/Finder/Types.hs b/compiler/GHC/Unit/Finder/Types.hs
index 06f4ea8aae..c48b7d9789 100644
--- a/compiler/GHC/Unit/Finder/Types.hs
+++ b/compiler/GHC/Unit/Finder/Types.hs
@@ -9,6 +9,8 @@ where
import GHC.Prelude
import GHC.Unit
import GHC.Unit.State
+import qualified Data.Map as M
+import GHC.Fingerprint
import Data.IORef
@@ -18,7 +20,10 @@ import Data.IORef
-- contents of this cache.
--
type FinderCacheState = InstalledModuleEnv InstalledFindResult
-newtype FinderCache = FinderCache (IORef FinderCacheState)
+type FileCacheState = M.Map FilePath Fingerprint
+data FinderCache = FinderCache { fcModuleCache :: (IORef FinderCacheState)
+ , fcFileCache :: (IORef FileCacheState)
+ }
data InstalledFindResult
= InstalledFound ModLocation InstalledModule