ghci: Explicitly store and restore interface file cache

In the old days the old HPT was used as an interface file cache when
using ghci. The HPT is a `ModuleEnv HomeModInfo` and so if you were
using hs-boot files then the interface file from compiling the .hs file
would be present in the cache but not the hi-boot file. This used to be
ok, because the .hi file used to just be a better version of the
.hi-boot file, with more information so it was fine to reuse it. Now the
source hash of a module is kept track of in the interface file and the
source hash for the .hs and .hs-boot file are correspondingly different
so it's no longer safe to reuse an interface file.

I took the decision to move the cache management of interface files to
GHCi itself, and provide an API where `load` can be provided with a list
of interface files which can be used as a cache. An alternative would be
to manage this cache somewhere in the HscEnv but it seemed that an API
user should be responsible for populating and suppling the cache rather
than having it managed implicitly.

Fixes #20217

3 files changed, 26 insertions, 6 deletions

diff --git a/ghc/GHCi/Leak.hs b/ghc/GHCi/Leak.hs
index 6102df9e04..e99ff405aa 100644
--- a/ghc/GHCi/Leak.hs
+++ b/ghc/GHCi/Leak.hs
@@ -59,7 +59,9 @@ checkLeakIndicators dflags (LeakIndicators leakmods)  = do
       Just hmi ->
         report ("HomeModInfo for " ++
           showSDoc dflags (ppr (mi_module (hm_iface hmi)))) (Just hmi)
-    deRefWeak leakIface >>= report "ModIface"
+    deRefWeak leakIface >>= \case
+      Nothing -> return ()
+      Just miface -> report ("ModIface:" ++ moduleNameString (moduleName (mi_module miface))) (Just miface)
     deRefWeak leakDetails >>= report "ModDetails"
     forM_ leakLinkable $ \l -> deRefWeak l >>= report "Linkable"
  where
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 369002b8bc..4a82a51e84 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -550,7 +550,8 @@ interactiveUI config srcs maybe_exprs = do
                    lastErrorLocations = lastErrLocationsRef,
                    mod_infos          = M.empty,
                    flushStdHandles    = flush,
-                   noBuffering        = nobuffering
+                   noBuffering        = nobuffering,
+                   hmiCache = []
                  }
 
    return ()
@@ -1656,6 +1657,12 @@ trySuccess act =
                                 return Failed) $ do
       act
 
+trySuccessWithRes :: (Monoid a, GHC.GhcMonad m) => m (SuccessFlag, a) -> m (SuccessFlag, a)
+trySuccessWithRes act =
+    handleSourceError (\e -> do GHC.printException e
+                                return (Failed, mempty))
+      act
+
 -----------------------------------------------------------------------------
 -- :edit
 
@@ -2114,7 +2121,10 @@ doLoad retain_context howmuch = do
              (\_ ->
               liftIO $ do hSetBuffering stdout NoBuffering
                           hSetBuffering stderr NoBuffering) $ \_ -> do
-      ok <- trySuccess $ GHC.load howmuch
+      hmis <- hmiCache <$> getGHCiState
+      modifyGHCiState (\ghci -> ghci { hmiCache = [] })
+      (ok, new_cache) <- trySuccessWithRes $ GHC.loadWithCache hmis howmuch
+      modifyGHCiState (\ghci -> ghci { hmiCache = new_cache })
       afterLoad ok retain_context
       return ok
 
@@ -4397,6 +4407,11 @@ 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 = [] })
+
 deleteBreak :: GhciMonad m => Int -> m ()
 deleteBreak identity = do
    st <- getGHCiState
@@ -4579,6 +4594,7 @@ wantNameFromInterpretedModule noCanDo str and_then =
 
 clearAllTargets :: GhciMonad m => m ()
 clearAllTargets = discardActiveBreakPoints
+                >> discardInterfaceCache
                 >> GHC.setTargets []
                 >> GHC.load LoadAllTargets
                 >> pure ()
diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index a24c40e804..72a44530e6 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -56,6 +56,7 @@ 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
@@ -159,8 +160,9 @@ data GHCiState = GHCiState
 
         flushStdHandles :: ForeignHValue,
             -- ^ @hFlush stdout; hFlush stderr@ in the interpreter
-        noBuffering :: ForeignHValue
+        noBuffering :: ForeignHValue,
             -- ^ @hSetBuffering NoBuffering@ for stdin/stdout/stderr
+        hmiCache :: [HomeModInfo]
      }
 
 type TickArray = Array Int [(GHC.BreakIndex,RealSrcSpan)]
@@ -288,7 +290,7 @@ class GhcMonad m => GhciMonad m where
 instance GhciMonad GHCi where
   getGHCiState      = GHCi $ \r -> liftIO $ readIORef r
   setGHCiState s    = GHCi $ \r -> liftIO $ writeIORef r s
-  modifyGHCiState f = GHCi $ \r -> liftIO $ modifyIORef r f
+  modifyGHCiState f = GHCi $ \r -> liftIO $ modifyIORef' r f
   reifyGHCi f       = GHCi $ \r -> reifyGhc $ \s -> f (s, r)
 
 instance GhciMonad (InputT GHCi) where
@@ -327,7 +329,7 @@ instance GhcMonad (InputT GHCi) where
 isOptionSet :: GhciMonad m => GHCiOption -> m Bool
 isOptionSet opt
  = do st <- getGHCiState
-      return (opt `elem` options st)
+      return $! (opt `elem` options st)
 
 setOption :: GhciMonad m => GHCiOption -> m ()
 setOption opt