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.

2 files changed, 29 insertions, 6 deletions

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