Move loader state into Interp

The loader state was stored into HscEnv. As we need to have two
interpreters and one loader state per interpreter in #14335, it's
natural to make the loader state a field of the Interp type.

As a side effect, many functions now only require a Interp parameter
instead of HscEnv. Sadly we can't fully free GHC.Linker.Loader of HscEnv
yet because the loader is initialised lazily from the HscEnv the first
time it is used. This is left as future work.

HscEnv may not contain an Interp value (i.e. hsc_interp :: Maybe Interp).
So a side effect of the previous side effect is that callers of the
modified functions now have to provide an Interp. It is satisfying as it
pushes upstream the handling of the case where HscEnv doesn't contain an
Interpreter. It is better than raising a panic (less partial functions,
"parse, don't validate", etc.).

2 files changed, 20 insertions, 20 deletions

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index ea2c8f25bb..494ab29021 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -41,7 +41,6 @@ import GHC.Runtime.Debugger
 
 -- The GHC interface
 import GHC.Runtime.Interpreter
-import GHC.Runtime.Interpreter.Types
 import GHCi.RemoteTypes
 import GHCi.BreakArray( breakOn, breakOff )
 import GHC.ByteCode.Types
@@ -1476,8 +1475,8 @@ getCallStackAtCurrentBreakpoint = do
   case resumes of
     [] -> return Nothing
     (r:_) -> do
-       hsc_env <- GHC.getSession
-       Just <$> liftIO (costCentreStackInfo hsc_env (GHC.resumeCCS r))
+       interp <- hscInterp <$> GHC.getSession
+       Just <$> liftIO (costCentreStackInfo interp (GHC.resumeCCS r))
 
 getCurrentBreakModule :: GHC.GhcMonad m => m (Maybe Module)
 getCurrentBreakModule = do
@@ -1605,12 +1604,12 @@ changeDirectory dir = do
   liftIO $ setCurrentDirectory dir'
   -- With -fexternal-interpreter, we have to change the directory of the subprocess too.
   -- (this gives consistent behaviour with and without -fexternal-interpreter)
-  hsc_env <- GHC.getSession
-  case hsc_interp hsc_env of
-    Just (ExternalInterp {}) -> do
+  interp <- hscInterp <$> GHC.getSession
+  case interpInstance interp of
+    ExternalInterp {} -> do
       fhv <- compileGHCiExpr $
         "System.Directory.setCurrentDirectory " ++ show dir'
-      liftIO $ evalIO hsc_env fhv
+      liftIO $ evalIO interp fhv
     _ -> pure ()
 
 trySuccess :: GHC.GhcMonad m => m SuccessFlag -> m SuccessFlag
@@ -1741,8 +1740,8 @@ runMacro
   -> String
   -> m Bool
 runMacro fun s = do
-  hsc_env <- GHC.getSession
-  str <- liftIO $ evalStringToIOString hsc_env fun s
+  interp <- hscInterp <$> GHC.getSession
+  str <- liftIO $ evalStringToIOString interp fun s
   enqueueCommands (lines str)
   return False
 
@@ -1775,8 +1774,8 @@ cmdCmd str = handleSourceError GHC.printException $ do
     let new_expr = step `mkHsApp` expr
     hv <- GHC.compileParsedExprRemote new_expr
 
-    hsc_env <- GHC.getSession
-    cmds <- liftIO $ evalString hsc_env hv
+    interp <- hscInterp <$> GHC.getSession
+    cmds <- liftIO $ evalString interp hv
     enqueueCommands (lines cmds)
 
 -- | Generate a typed ghciStepIO expression
@@ -3054,6 +3053,7 @@ newDynFlags interactive_only minus_opts = do
         -- the new packages.
         hsc_env <- GHC.getSession
         let dflags2 = hsc_dflags hsc_env
+        let interp  = hscInterp hsc_env
         when (packageFlagsChanged dflags2 dflags0) $ do
           when (verbosity dflags2 > 0) $
             liftIO . putStrLn $
@@ -3062,7 +3062,7 @@ newDynFlags interactive_only minus_opts = do
           clearAllTargets
           when must_reload $ do
             let units = preloadUnits (hsc_units hsc_env)
-            liftIO $ Loader.loadPackages hsc_env units
+            liftIO $ Loader.loadPackages interp hsc_env units
           -- package flags changed, we can't re-use any of the old context
           setContextAfterLoad False []
           -- and copy the package flags to the interactive DynFlags
@@ -3081,7 +3081,7 @@ newDynFlags interactive_only minus_opts = do
                                  , cmdlineFrameworks = newCLFrameworks } }
 
         when (not (null newLdInputs && null newCLFrameworks)) $
-          liftIO $ Loader.loadCmdLineLibs hsc_env'
+          liftIO $ Loader.loadCmdLineLibs (hscInterp hsc_env') hsc_env'
 
       return ()
 
@@ -3183,7 +3183,7 @@ showCmd str = do
             , action "modules"    $ showModules
             , action "bindings"   $ showBindings
             , action "linker"     $ do
-               msg <- liftIO $ Loader.showLoaderState (hsc_loader hsc_env)
+               msg <- liftIO $ Loader.showLoaderState (hscInterp hsc_env)
                putLogMsgM NoReason SevDump noSrcSpan msg
             , action "breaks"     $ showBkptTable
             , action "context"    $ showContext
diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index 80d4539849..11d575524f 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -468,8 +468,8 @@ printStats dflags ActionStats{actionAllocs = mallocs, actionElapsedTime = secs}
 
 revertCAFs :: GhciMonad m => m ()
 revertCAFs = do
-  hsc_env <- GHC.getSession
-  liftIO $ iservCmd hsc_env RtsRevertCAFs
+  interp <- hscInterp <$> GHC.getSession
+  liftIO $ interpCmd interp RtsRevertCAFs
   s <- getGHCiState
   when (not (ghc_e s)) turnOffBuffering
      -- Have to turn off buffering again, because we just
@@ -495,8 +495,8 @@ initInterpBuffering = do
 flushInterpBuffers :: GhciMonad m => m ()
 flushInterpBuffers = do
   st <- getGHCiState
-  hsc_env <- GHC.getSession
-  liftIO $ evalIO hsc_env (flushStdHandles st)
+  interp <- hscInterp <$> GHC.getSession
+  liftIO $ evalIO interp (flushStdHandles st)
 
 -- | Turn off buffering for stdin, stdout, and stderr in the interpreter
 turnOffBuffering :: GhciMonad m => m ()
@@ -506,8 +506,8 @@ turnOffBuffering = do
 
 turnOffBuffering_ :: GhcMonad m => ForeignHValue -> m ()
 turnOffBuffering_ fhv = do
-  hsc_env <- getSession
-  liftIO $ evalIO hsc_env fhv
+  interp <- hscInterp <$> getSession
+  liftIO $ evalIO interp fhv
 
 mkEvalWrapper :: GhcMonad m => String -> [String] ->  m ForeignHValue
 mkEvalWrapper progname args =