driver: Introduce HomeModInfoCache abstraction

The HomeModInfoCache is a mutable cache which is updated incrementally
as the driver completes, this makes it robust to exceptions including
(SIGINT)

The interface for the cache is described by the `HomeMOdInfoCache` data
type:

```
data HomeModInfoCache = HomeModInfoCache { hmi_clearCache :: IO [HomeModInfo]
                                         , hmi_addToCache :: HomeModInfo -> IO () }
```

The first operation clears the cache and returns its contents. This is
designed so it's harder to end up in situations where the cache is
retained throughout the execution of upsweep.

The second operation allows a module to be added to the cache.

The one slightly nasty part is in `interpretBuildPlan` where we have to
be careful to ensure that the cache writes happen:

1. In parralel
2. Before the executation continues after upsweep.

This requires some simple, localised MVar wrangling.

Fixes #20780

2 files changed, 8 insertions, 15 deletions

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index fa04121821..8108accaa2 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -51,6 +51,7 @@ import GHC.Driver.Session as DynFlags
 import GHC.Driver.Ppr hiding (printForUser)
 import GHC.Utils.Error hiding (traceCmd)
 import GHC.Driver.Monad ( modifySession )
+import GHC.Driver.Make ( newHomeModInfoCache, HomeModInfoCache(..) )
 import GHC.Driver.Config.Parser (initParserOpts)
 import GHC.Driver.Config.Diagnostic
 import qualified GHC
@@ -541,6 +542,7 @@ interactiveUI config srcs maybe_exprs = do
    let prelude_import = simpleImportDecl preludeModuleName
    hsc_env <- GHC.getSession
    let in_multi = length (hsc_all_home_unit_ids hsc_env) > 1
+   empty_cache <- liftIO newHomeModInfoCache
    startGHCi (runGHCi srcs maybe_exprs)
         GHCiState{ progname           = default_progname,
                    args               = default_args,
@@ -575,7 +577,7 @@ interactiveUI config srcs maybe_exprs = do
                    mod_infos          = M.empty,
                    flushStdHandles    = flush,
                    noBuffering        = nobuffering,
-                   hmiCache = []
+                   hmiCache = empty_cache
                  }
 
    return ()
@@ -1679,12 +1681,6 @@ trySuccess act =
                                 return Failed) $ do
       act
 
-trySuccessWithRes :: (Monoid a, GhciMonad m) => m (SuccessFlag, a) -> m (SuccessFlag, a)
-trySuccessWithRes act =
-    handleSourceError (\e -> do printErrAndMaybeExit e -- immediately exit fith failure if in ghc -e
-                                return (Failed, mempty))
-      act
-
 -----------------------------------------------------------------------------
 -- :edit
 
@@ -2149,9 +2145,7 @@ doLoad retain_context howmuch = do
               liftIO $ do hSetBuffering stdout NoBuffering
                           hSetBuffering stderr NoBuffering) $ \_ -> do
       hmis <- hmiCache <$> getGHCiState
-      modifyGHCiState (\ghci -> ghci { hmiCache = [] })
-      (ok, new_cache) <- trySuccessWithRes $ GHC.loadWithCache hmis howmuch
-      modifyGHCiState (\ghci -> ghci { hmiCache = new_cache })
+      ok <- trySuccess $ GHC.loadWithCache (Just hmis) howmuch
       afterLoad ok retain_context
       return ok
 
@@ -4443,10 +4437,9 @@ discardActiveBreakPoints = do
    mapM_ (turnBreakOnOff False) $ breaks st
    setGHCiState $ st { breaks = IntMap.empty }
 
--- don't reset the counter back to zero?
 discardInterfaceCache :: GhciMonad m => m ()
-discardInterfaceCache = do
-   modifyGHCiState $ (\st -> st { hmiCache = [] })
+discardInterfaceCache =
+   void (liftIO . hmi_clearCache . hmiCache =<< getGHCiState)
 
 clearHPTs :: GhciMonad m => m ()
 clearHPTs = do
diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index aede0a9dc1..ee0edb1837 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -47,6 +47,7 @@ import GHC.Data.FastString
 import GHC.Driver.Env
 import GHC.Types.SrcLoc
 import GHC.Types.SafeHaskell
+import GHC.Driver.Make (HomeModInfoCache(..))
 import GHC.Unit
 import GHC.Types.Name.Reader as RdrName (mkOrig)
 import GHC.Builtin.Names (gHC_GHCI_HELPERS)
@@ -57,7 +58,6 @@ import GHC.Hs (ImportDecl, GhcPs, GhciLStmt, LHsDecl)
 import GHC.Hs.Utils
 import GHC.Utils.Misc
 import GHC.Utils.Logger
-import GHC.Unit.Home.ModInfo
 
 import GHC.Utils.Exception hiding (uninterruptibleMask, mask, catch)
 import Numeric
@@ -164,7 +164,7 @@ data GHCiState = GHCiState
             -- ^ @hFlush stdout; hFlush stderr@ in the interpreter
         noBuffering :: ForeignHValue,
             -- ^ @hSetBuffering NoBuffering@ for stdin/stdout/stderr
-        hmiCache :: [HomeModInfo]
+        hmiCache :: HomeModInfoCache
      }
 
 type TickArray = Array Int [(GHC.BreakIndex,RealSrcSpan)]