[Git][ghc/ghc][wip/fc-hook] compiler: Turn `FinderCache` into a record of operations so that GHC API clients can

[Zubin (@wz1000)]

Zubin pushed to branch wip/fc-hook at Glasgow Haskell Compiler / GHC


Commits:
94ab8c96 by Zubin Duggal at 2023-07-18T18:27:01+05:30
compiler: Turn `FinderCache` into a record of operations so that GHC API clients can
have full control over how its state is managed by overriding `hsc_FC`.

Also removes the `uncacheModule` function as this wasn't being used by anything
since 1893ba12fe1fa2ade35a62c336594afcd569736e

Fixes #23604

- - - - -


2 changed files:

- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Finder/Types.hs


Changes:

=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -5,15 +5,15 @@
 
 
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards  #-}
 
 -- | Module finder
 module GHC.Unit.Finder (
     FindResult(..),
     InstalledFindResult(..),
     FinderOpts(..),
-    FinderCache,
+    FinderCache(..),
     initFinderCache,
-    flushFinderCaches,
     findImportedModule,
     findPluginModule,
     findExactModule,
@@ -26,14 +26,10 @@ module GHC.Unit.Finder (
     mkObjPath,
     addModuleToFinder,
     addHomeModuleToFinder,
-    uncacheModule,
     mkStubPaths,
 
     findObjectLinkableMaybe,
     findObjectLinkable,
-
-    -- Hash cache
-    lookupFileCache
   ) where
 
 import GHC.Prelude
@@ -89,41 +85,35 @@ 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; also flush the file hash
--- cache
-flushFinderCaches :: FinderCache -> UnitEnv -> IO ()
-flushFinderCaches (FinderCache ref file_ref) ue = do
-  atomicModifyIORef' ref $ \fm -> (filterInstalledModuleEnv is_ext fm, ())
-  atomicModifyIORef' file_ref $ \_ -> (M.empty, ())
- where
-  is_ext mod _ = not (isUnitEnvInstalledModule ue mod)
-
-addToFinderCache :: FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
-addToFinderCache (FinderCache ref _) key val =
-  atomicModifyIORef' ref $ \c -> (extendInstalledModuleEnv c key val, ())
-
-removeFromFinderCache :: FinderCache -> InstalledModule -> IO ()
-removeFromFinderCache (FinderCache ref _) key =
-  atomicModifyIORef' ref $ \c -> (delInstalledModuleEnv c key, ())
-
-lookupFinderCache :: FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult)
-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
+initFinderCache = do
+  mod_cache <- newIORef emptyInstalledModuleEnv
+  file_cache <- newIORef M.empty
+  let flushFinderCaches :: UnitEnv -> IO ()
+      flushFinderCaches ue = do
+        atomicModifyIORef' mod_cache $ \fm -> (filterInstalledModuleEnv is_ext fm, ())
+        atomicModifyIORef' file_cache $ \_ -> (M.empty, ())
+       where
+        is_ext mod _ = not (isUnitEnvInstalledModule ue mod)
+
+      addToFinderCache :: InstalledModule -> InstalledFindResult -> IO ()
+      addToFinderCache key val =
+        atomicModifyIORef' mod_cache $ \c -> (extendInstalledModuleEnv c key val, ())
+
+      lookupFinderCache :: InstalledModule -> IO (Maybe InstalledFindResult)
+      lookupFinderCache key = do
+         c <- readIORef mod_cache
+         return $! lookupInstalledModuleEnv c key
+
+      lookupFileCache :: FilePath -> IO Fingerprint
+      lookupFileCache key = do
+         c <- readIORef file_cache
+         case M.lookup key c of
+           Nothing -> do
+             hash <- getFileHash key
+             atomicModifyIORef' file_cache $ \c -> (M.insert key hash c, ())
+             return hash
+           Just fp -> return fp
+  return FinderCache{..}
 
 -- -----------------------------------------------------------------------------
 -- The three external entry points
@@ -341,11 +331,6 @@ addHomeModuleToFinder fc home_unit mod_name loc = do
   addToFinderCache fc mod (InstalledFound loc mod)
   return (mkHomeModule home_unit mod_name)
 
-uncacheModule :: FinderCache -> HomeUnit -> ModuleName -> IO ()
-uncacheModule fc home_unit mod_name = do
-  let mod = mkHomeInstalledModule home_unit mod_name
-  removeFromFinderCache fc mod
-
 -- -----------------------------------------------------------------------------
 --      The internal workers
 


=====================================
compiler/GHC/Unit/Finder/Types.hs
=====================================
@@ -1,6 +1,7 @@
 module GHC.Unit.Finder.Types
    ( FinderCache (..)
    , FinderCacheState
+   , FileCacheState
    , FindResult (..)
    , InstalledFindResult (..)
    , FinderOpts(..)
@@ -12,8 +13,8 @@ import GHC.Unit
 import qualified Data.Map as M
 import GHC.Fingerprint
 import GHC.Platform.Ways
+import GHC.Unit.Env
 
-import Data.IORef
 import GHC.Data.FastString
 import qualified Data.Set as Set
 
@@ -24,8 +25,17 @@ import qualified Data.Set as Set
 --
 type FinderCacheState = InstalledModuleEnv InstalledFindResult
 type FileCacheState   = M.Map FilePath Fingerprint
-data FinderCache = FinderCache { fcModuleCache :: (IORef FinderCacheState)
-                               , fcFileCache   :: (IORef FileCacheState)
+data FinderCache = FinderCache { flushFinderCaches :: UnitEnv -> IO ()
+                               -- ^ remove all the home modules from the cache; package modules are
+                               -- assumed to not move around during a session; also flush the file hash
+                               -- cache.
+                               , addToFinderCache  :: InstalledModule -> InstalledFindResult -> IO ()
+                               -- ^ Add a found location to the cache for the module.
+                               , lookupFinderCache :: InstalledModule -> IO (Maybe InstalledFindResult)
+                               -- ^ Look for a location in the cache.
+                               , lookupFileCache   :: FilePath -> IO Fingerprint
+                               -- ^ Look for the hash of a file in the cache. This should add it to the
+                               -- cache. If the file doesn't exist, raise an IOException.
                                }
 
 data InstalledFindResult



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/94ab8c9683b58711c1abe981091b5bec8f27cadd

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/94ab8c9683b58711c1abe981091b5bec8f27cadd
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230718/91ddcd4e/attachment-0001.html>