Refactor runtime interpreter code

In #14335 we want to be able to use both the internal interpreter (for
the plugins) and the external interpreter (for TH and GHCi) at the same
time.

This patch performs some preliminary refactoring: the `hsc_interp` field
of HscEnv replaces `hsc_iserv` and is now used to indicate which
interpreter (internal, external) to use to execute TH and GHCi.

Opt_ExternalInterpreter flag and iserv options in DynFlags are now
queried only when we set the session DynFlags. It should help making GHC
multi-target in the future by selecting an interpreter according to the
selected target.

13 files changed, 409 insertions, 259 deletions

diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index af0fb5885a..fb1ac703a2 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -299,11 +299,13 @@ import GHC.ByteCode.Types
 import GHC.Runtime.Eval
 import GHC.Runtime.Eval.Types
 import GHC.Runtime.Interpreter
+import GHC.Runtime.Interpreter.Types
 import GHCi.RemoteTypes
 
 import GHC.Core.Ppr.TyThing  ( pprFamInst )
 import GHC.Driver.Main
 import GHC.Driver.Make
+import GHC.Driver.Hooks
 import GHC.Driver.Pipeline   ( compileOne' )
 import GHC.Driver.Monad
 import TcRnMonad        ( finalSafeMode, fixSafeInstances, initIfaceTcRn )
@@ -373,6 +375,8 @@ import System.Exit      ( exitWith, ExitCode(..) )
 import Exception
 import Data.IORef
 import System.FilePath
+import Control.Concurrent
+import Control.Applicative ((<|>))
 
 import Maybes
 import System.IO.Error  ( isDoesNotExistError )
@@ -486,7 +490,7 @@ withCleanupSession ghc = ghc `gfinally` cleanup
       liftIO $ do
           cleanTempFiles dflags
           cleanTempDirs dflags
-          stopIServ hsc_env -- shut down the IServ
+          stopInterp hsc_env -- shut down the IServ
           --  exceptions will be blocked while we clean the temporary files,
           -- so there shouldn't be any difficulty if we receive further
           -- signals.
@@ -594,8 +598,42 @@ setSessionDynFlags dflags = do
   dflags' <- checkNewDynFlags dflags
   dflags'' <- liftIO $ interpretPackageEnv dflags'
   (dflags''', preload) <- liftIO $ initPackages dflags''
+
+  -- Interpreter
+  interp  <- if gopt Opt_ExternalInterpreter dflags
+    then do
+         let
+           prog = pgm_i dflags ++ flavour
+           flavour
+             | WayProf `elem` ways dflags = "-prof"
+             | WayDyn `elem` ways dflags  = "-dyn"
+             | otherwise                  = ""
+           msg = text "Starting " <> text prog
+         tr <- if verbosity dflags >= 3
+                then return (logInfo dflags (defaultDumpStyle dflags) msg)
+                else return (pure ())
+         let
+          conf = IServConfig
+            { iservConfProgram = prog
+            , iservConfOpts    = getOpts dflags opt_i
+            , iservConfHook    = createIservProcessHook (hooks dflags)
+            , iservConfTrace   = tr
+            }
+         s <- liftIO $ newMVar (IServPending conf)
+         return (Just (ExternalInterp (IServ s)))
+    else
+#if defined(HAVE_INTERNAL_INTERPRETER)
+      return (Just InternalInterp)
+#else
+      return Nothing
+#endif
+
   modifySession $ \h -> h{ hsc_dflags = dflags'''
-                         , hsc_IC = (hsc_IC h){ ic_dflags = dflags''' } }
+                         , hsc_IC = (hsc_IC h){ ic_dflags = dflags''' }
+                         , hsc_interp = hsc_interp h <|> interp
+                           -- we only update the interpreter if there wasn't
+                           -- already one set up
+                         }
   invalidateModSummaryCache
   return preload
 
diff --git a/compiler/GHC/CoreToByteCode.hs b/compiler/GHC/CoreToByteCode.hs
index 6b5a40f4a8..a9c3ce3711 100644
--- a/compiler/GHC/CoreToByteCode.hs
+++ b/compiler/GHC/CoreToByteCode.hs
@@ -19,6 +19,7 @@ import GHC.ByteCode.Asm
 import GHC.ByteCode.Types
 
 import GHC.Runtime.Interpreter
+import GHC.Runtime.Interpreter.Types
 import GHCi.FFI
 import GHCi.RemoteTypes
 import BasicTypes
@@ -991,9 +992,10 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
   | otherwise
   = do
      dflags <- getDynFlags
+     hsc_env <- getHscEnv
      let
         profiling
-          | gopt Opt_ExternalInterpreter dflags = gopt Opt_SccProfilingOn dflags
+          | Just (ExternalInterp _) <- hsc_interp hsc_env = gopt Opt_SccProfilingOn dflags
           | otherwise = rtsIsProfiled
 
         -- Top of stack is the return itbl, as usual.
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 0e4c5addb9..00eff081ee 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -99,7 +99,6 @@ import GHC.Core.Lint           ( lintInteractiveExpr )
 import VarEnv                  ( emptyTidyEnv )
 import Panic
 import ConLike
-import Control.Concurrent
 
 import ApiAnnotation
 import Module
@@ -197,7 +196,6 @@ newHscEnv dflags = do
     us      <- mkSplitUniqSupply 'r'
     nc_var  <- newIORef (initNameCache us knownKeyNames)
     fc_var  <- newIORef emptyInstalledModuleEnv
-    iserv_mvar <- newMVar Nothing
     emptyDynLinker <- uninitializedLinker
     return HscEnv {  hsc_dflags       = dflags
                   ,  hsc_targets      = []
@@ -208,7 +206,7 @@ newHscEnv dflags = do
                   ,  hsc_NC           = nc_var
                   ,  hsc_FC           = fc_var
                   ,  hsc_type_env_var = Nothing
-                  ,  hsc_iserv        = iserv_mvar
+                  ,  hsc_interp       = Nothing
                   ,  hsc_dynLinker    = emptyDynLinker
                   }
 
diff --git a/compiler/GHC/Driver/Types.hs b/compiler/GHC/Driver/Types.hs
index 9e7b175a1c..58fe239900 100644
--- a/compiler/GHC/Driver/Types.hs
+++ b/compiler/GHC/Driver/Types.hs
@@ -22,7 +22,6 @@ module GHC.Driver.Types (
         FinderCache, FindResult(..), InstalledFindResult(..),
         Target(..), TargetId(..), InputFileBuffer, pprTarget, pprTargetId,
         HscStatus(..),
-        IServ(..),
 
         -- * ModuleGraph
         ModuleGraph, emptyMG, mkModuleGraph, extendMG, mapMG,
@@ -157,8 +156,7 @@ import GhcPrelude
 
 import GHC.ByteCode.Types
 import GHC.Runtime.Eval.Types ( Resume )
-import GHCi.Message         ( Pipe )
-import GHCi.RemoteTypes
+import GHC.Runtime.Interpreter.Types (Interp)
 import GHC.ForeignSrcLang
 
 import UniqFM
@@ -221,8 +219,6 @@ import Data.IORef
 import Data.Time
 import Exception
 import System.FilePath
-import Control.Concurrent
-import System.Process   ( ProcessHandle )
 import Control.DeepSeq
 import Control.Monad.Trans.Reader
 import Control.Monad.Trans.Class
@@ -473,15 +469,43 @@ data HscEnv
                 -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for
                 -- 'TcRnTypes.TcGblEnv'.  See also Note [hsc_type_env_var hack]
 
-        , hsc_iserv :: MVar (Maybe IServ)
-                -- ^ interactive server process.  Created the first
-                -- time it is needed.
+        , hsc_interp :: Maybe Interp
+                -- ^ target code interpreter (if any) to use for TH and GHCi.
+                -- See Note [Target code interpreter]
 
         , hsc_dynLinker :: DynLinker
                 -- ^ dynamic linker.
 
  }
 
+{-
+
+Note [Target code interpreter]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Template Haskell and GHCi use an interpreter to execute code that is built for
+the compiler target platform (= code host platform) on the compiler host
+platform (= code build platform).
+
+The internal interpreter can be used when both platforms are the same and when
+the built code is compatible with the compiler itself (same way, etc.). This
+interpreter is not always available: for instance stage1 compiler doesn't have
+it because there might be an ABI mismatch between the code objects (built by
+stage1 compiler) and the stage1 compiler itself (built by stage0 compiler).
+
+In most cases, an external interpreter can be used instead: it runs in a
+separate process and it communicates with the compiler via a two-way message
+passing channel. The process is lazily spawned to avoid overhead when it is not
+used.
+
+The target code interpreter to use can be selected per session via the
+`hsc_interp` field of `HscEnv`. There may be no interpreter available at all, in
+which case Template Haskell and GHCi will fail to run. The interpreter to use is
+configured via command-line flags (in `GHC.setSessionDynFlags`).
+
+
+-}
+
 -- Note [hsc_type_env_var hack]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -- hsc_type_env_var is used to initialize tcg_type_env_var, and
@@ -524,14 +548,6 @@ data HscEnv
 -- should not populate the EPS. But that's a refactor for
 -- another day.
 
-
-data IServ = IServ
-  { iservPipe :: Pipe
-  , iservProcess :: ProcessHandle
-  , iservLookupSymbolCache :: IORef (UniqFM (Ptr ()))
-  , iservPendingFrees :: [HValueRef]
-  }
-
 -- | Retrieve the ExternalPackageState cache.
 hscEPS :: HscEnv -> IO ExternalPackageState
 hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index 8890192d92..7b5962e6bf 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE CPP, MagicHash, NondecreasingIndentation,
-    RecordWildCards, BangPatterns #-}
+{-# LANGUAGE CPP, MagicHash, RecordWildCards, BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
@@ -51,6 +51,7 @@ import GhcPrelude
 import GHC.Runtime.Eval.Types
 
 import GHC.Runtime.Interpreter as GHCi
+import GHC.Runtime.Interpreter.Types
 import GHCi.Message
 import GHCi.RemoteTypes
 import GHC.Driver.Monad
@@ -278,24 +279,25 @@ withVirtualCWD m = do
 
     -- a virtual CWD is only necessary when we're running interpreted code in
     -- the same process as the compiler.
-  if gopt Opt_ExternalInterpreter (hsc_dflags hsc_env) then m else do
-
-  let ic = hsc_IC hsc_env
-  let set_cwd = do
-        dir <- liftIO $ getCurrentDirectory
-        case ic_cwd ic of
-           Just dir -> liftIO $ setCurrentDirectory dir
-           Nothing  -> return ()
-        return dir
-
-      reset_cwd orig_dir = do
-        virt_dir <- liftIO $ getCurrentDirectory
-        hsc_env <- getSession
-        let old_IC = hsc_IC hsc_env
-        setSession hsc_env{  hsc_IC = old_IC{ ic_cwd = Just virt_dir } }
-        liftIO $ setCurrentDirectory orig_dir
-
-  gbracket set_cwd reset_cwd $ \_ -> m
+  case hsc_interp hsc_env of
+    Just (ExternalInterp _) -> m
+    _ -> do
+      let ic = hsc_IC hsc_env
+      let set_cwd = do
+            dir <- liftIO $ getCurrentDirectory
+            case ic_cwd ic of
+               Just dir -> liftIO $ setCurrentDirectory dir
+               Nothing  -> return ()
+            return dir
+
+          reset_cwd orig_dir = do
+            virt_dir <- liftIO $ getCurrentDirectory
+            hsc_env <- getSession
+            let old_IC = hsc_IC hsc_env
+            setSession hsc_env{  hsc_IC = old_IC{ ic_cwd = Just virt_dir } }
+            liftIO $ setCurrentDirectory orig_dir
+
+      gbracket set_cwd reset_cwd $ \_ -> m
 
 parseImportDecl :: GhcMonad m => String -> m (ImportDecl GhcPs)
 parseImportDecl expr = withSession $ \hsc_env -> liftIO $ hscImport hsc_env expr
@@ -1213,8 +1215,9 @@ compileParsedExprRemote expr@(L loc _) = withSession $ \hsc_env -> do
 compileParsedExpr :: GhcMonad m => LHsExpr GhcPs -> m HValue
 compileParsedExpr expr = do
    fhv <- compileParsedExprRemote expr
-   dflags <- getDynFlags
-   liftIO $ wormhole dflags fhv
+   hsc_env <- getSession
+   liftIO $ withInterp hsc_env $ \interp ->
+      wormhole interp fhv
 
 -- | Compile an expression, run it and return the result as a Dynamic.
 dynCompileExpr :: GhcMonad m => String -> m Dynamic
@@ -1249,12 +1252,14 @@ moduleIsBootOrNotObjectLinkable mod_summary = withSession $ \hsc_env ->
 -- RTTI primitives
 
 obtainTermFromVal :: HscEnv -> Int -> Bool -> Type -> a -> IO Term
-obtainTermFromVal hsc_env bound force ty x
-  | gopt Opt_ExternalInterpreter (hsc_dflags hsc_env)
-  = throwIO (InstallationError
-      "this operation requires -fno-external-interpreter")
-  | otherwise
-  = cvObtainTerm hsc_env bound force ty (unsafeCoerce x)
+#if defined(HAVE_INTERNAL_INTERPRETER)
+obtainTermFromVal hsc_env bound force ty x = withInterp hsc_env $ \case
+  InternalInterp   -> cvObtainTerm hsc_env bound force ty (unsafeCoerce x)
+#else
+obtainTermFromVal hsc_env _bound _force _ty _x = withInterp hsc_env $ \case
+#endif
+  ExternalInterp _ -> throwIO (InstallationError
+                        "this operation requires -fno-external-interpreter")
 
 obtainTermFromId :: HscEnv -> Int -> Bool -> Id -> IO Term
 obtainTermFromId hsc_env bound force id =  do
diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs
index 8524e92cdc..3eb9c85a01 100644
--- a/compiler/GHC/Runtime/Interpreter.hs
+++ b/compiler/GHC/Runtime/Interpreter.hs
@@ -1,4 +1,6 @@
 {-# LANGUAGE RecordWildCards, ScopedTypeVariables, BangPatterns, CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TupleSections #-}
 
 --
 -- | Interacting with the interpreter, whether it is running on an
@@ -38,7 +40,8 @@ module GHC.Runtime.Interpreter
   , findSystemLibrary
 
   -- * Lower-level API using messages
-  , iservCmd, Message(..), withIServ, stopIServ
+  , iservCmd, Message(..), withIServ, withIServ_
+  , withInterp, stopInterp
   , iservCall, readIServ, writeIServ
   , purgeLookupSymbolCache
   , freeHValueRefs
@@ -50,6 +53,7 @@ module GHC.Runtime.Interpreter
 
 import GhcPrelude
 
+import GHC.Runtime.Interpreter.Types
 import GHCi.Message
 #if defined(HAVE_INTERNAL_INTERPRETER)
 import GHCi.Run
@@ -62,13 +66,10 @@ import GHC.Driver.Types
 import UniqFM
 import Panic
 import GHC.Driver.Session
-import ErrUtils
-import Outputable
 import Exception
 import BasicTypes
 import FastString
 import Util
-import GHC.Driver.Hooks
 
 import Control.Concurrent
 import Control.Monad
@@ -157,11 +158,6 @@ Other Notes on Remote GHCi
   * Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs
 -}
 
-#if !defined(HAVE_INTERNAL_INTERPRETER)
-needExtInt :: IO a
-needExtInt = throwIO
-  (InstallationError "this operation requires -fexternal-interpreter")
-#endif
 
 -- | Run a command in the interpreter's context.  With
 -- @-fexternal-interpreter@, the command is serialized and sent to an
@@ -169,23 +165,28 @@ needExtInt = throwIO
 -- @Binary@ constraint).  With @-fno-external-interpreter@ we execute
 -- the command directly here.
 iservCmd :: Binary a => HscEnv -> Message a -> IO a
-iservCmd hsc_env@HscEnv{..} msg
- | gopt Opt_ExternalInterpreter hsc_dflags =
-     withIServ hsc_env $ \iserv ->
-       uninterruptibleMask_ $ do -- Note [uninterruptibleMask_]
-         iservCall iserv msg
- | otherwise = -- Just run it directly
+iservCmd hsc_env msg = withInterp hsc_env $ \case
 #if defined(HAVE_INTERNAL_INTERPRETER)
-   run msg
-#else
-   needExtInt
+  InternalInterp     -> run msg -- Just run it directly
 #endif
+  (ExternalInterp i) -> withIServ_ i $ \iserv ->
+    uninterruptibleMask_ $ do -- Note [uninterruptibleMask_]
+      iservCall iserv msg
+
+
+-- | Execute an action with the interpreter
+--
+-- Fails if no target code interpreter is available
+withInterp :: HscEnv -> (Interp -> IO a) -> IO a
+withInterp hsc_env action = case hsc_interp hsc_env of
+   Nothing -> throwIO (InstallationError "Couldn't find a target code interpreter. Try with -fexternal-interpreter")
+   Just i  -> action i
 
 -- Note [uninterruptibleMask_ and iservCmd]
 --
 -- If we receive an async exception, such as ^C, while communicating
 -- with the iserv process then we will be out-of-sync and not be able
--- to recoever.  Thus we use uninterruptibleMask_ during
+-- to recover.  Thus we use uninterruptibleMask_ during
 -- communication.  A ^C will be delivered to the iserv process (because
 -- signals get sent to the whole process group) which will interrupt
 -- the running computation and return an EvalException result.
@@ -194,24 +195,37 @@ iservCmd hsc_env@HscEnv{..} msg
 -- Overloaded because this is used from TcM as well as IO.
 withIServ
   :: (MonadIO m, ExceptionMonad m)
-  => HscEnv -> (IServ -> m a) -> m a
-withIServ HscEnv{..} action =
+  => IServ -> (IServInstance -> m (IServInstance, a)) -> m a
+withIServ (IServ mIServState) action = do
   gmask $ \restore -> do
-    m <- liftIO $ takeMVar hsc_iserv
-      -- start the iserv process if we haven't done so yet
-    iserv <- maybe (liftIO $ startIServ hsc_dflags) return m
-               `gonException` (liftIO $ putMVar hsc_iserv Nothing)
+    state <- liftIO $ takeMVar mIServState
+
+    iserv <- case state of
+      -- start the external iserv process if we haven't done so yet
+      IServPending conf ->
+         liftIO (spawnIServ conf)
+           `gonException` (liftIO $ putMVar mIServState state)
+
+      IServRunning inst -> return inst
+
+
+    let iserv'  = iserv{ iservPendingFrees = [] }
+
+    (iserv'',a) <- (do
       -- free any ForeignHValues that have been garbage collected.
-    let iserv' = iserv{ iservPendingFrees = [] }
-    a <- (do
       liftIO $ when (not (null (iservPendingFrees iserv))) $
         iservCall iserv (FreeHValueRefs (iservPendingFrees iserv))
-        -- run the inner action
-      restore $ action iserv)
-          `gonException` (liftIO $ putMVar hsc_iserv (Just iserv'))
-    liftIO $ putMVar hsc_iserv (Just iserv')
+      -- run the inner action
+      restore $ action iserv')
+          `gonException` (liftIO $ putMVar mIServState (IServRunning iserv'))
+    liftIO $ putMVar mIServState (IServRunning iserv'')
     return a
 
+withIServ_
+  :: (MonadIO m, ExceptionMonad m)
+  => IServ -> (IServInstance -> m a) -> m a
+withIServ_ iserv action = withIServ iserv $ \inst ->
+   (inst,) <$> action inst
 
 -- -----------------------------------------------------------------------------
 -- Wrappers around messages
@@ -371,41 +385,45 @@ initObjLinker :: HscEnv -> IO ()
 initObjLinker hsc_env = iservCmd hsc_env InitLinker
 
 lookupSymbol :: HscEnv -> FastString -> IO (Maybe (Ptr ()))
-lookupSymbol hsc_env@HscEnv{..} str
- | gopt Opt_ExternalInterpreter hsc_dflags =
-     -- Profiling of GHCi showed a lot of time and allocation spent
-     -- making cross-process LookupSymbol calls, so I added a GHC-side
-     -- cache which sped things up quite a lot.  We have to be careful
-     -- to purge this cache when unloading code though.
-     withIServ hsc_env $ \iserv@IServ{..} -> do
-       cache <- readIORef iservLookupSymbolCache
-       case lookupUFM cache str of
-         Just p -> return (Just p)
-         Nothing -> do
-           m <- uninterruptibleMask_ $
-                    iservCall iserv (LookupSymbol (unpackFS str))
-           case m of
-             Nothing -> return Nothing
-             Just r -> do
-               let p = fromRemotePtr r
-               writeIORef iservLookupSymbolCache $! addToUFM cache str p
-               return (Just p)
- | otherwise =
+lookupSymbol hsc_env str = withInterp hsc_env $ \case
 #if defined(HAVE_INTERNAL_INTERPRETER)
-   fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str))
-#else
-   needExtInt
+  InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str))
 #endif
 
+  ExternalInterp i -> withIServ i $ \iserv -> do
+    -- Profiling of GHCi showed a lot of time and allocation spent
+    -- making cross-process LookupSymbol calls, so I added a GHC-side
+    -- cache which sped things up quite a lot.  We have to be careful
+    -- to purge this cache when unloading code though.
+    let cache = iservLookupSymbolCache iserv
+    case lookupUFM cache str of
+      Just p -> return (iserv, Just p)
+      Nothing -> do
+        m <- uninterruptibleMask_ $
+                 iservCall iserv (LookupSymbol (unpackFS str))
+        case m of
+          Nothing -> return (iserv, Nothing)
+          Just r -> do
+            let p      = fromRemotePtr r
+                cache' = addToUFM cache str p
+                iserv' = iserv {iservLookupSymbolCache = cache'}
+            return (iserv', Just p)
+
 lookupClosure :: HscEnv -> String -> IO (Maybe HValueRef)
 lookupClosure hsc_env str =
   iservCmd hsc_env (LookupClosure str)
 
 purgeLookupSymbolCache :: HscEnv -> IO ()
-purgeLookupSymbolCache hsc_env@HscEnv{..} =
- when (gopt Opt_ExternalInterpreter hsc_dflags) $
-   withIServ hsc_env $ \IServ{..} ->
-     writeIORef iservLookupSymbolCache emptyUFM
+purgeLookupSymbolCache hsc_env = case hsc_interp hsc_env of
+  Nothing             -> pure ()
+#if defined(HAVE_INTERNAL_INTERPRETER)
+  Just InternalInterp -> pure ()
+#endif
+  Just (ExternalInterp (IServ mstate)) ->
+    modifyMVar_ mstate $ \state -> pure $ case state of
+      IServPending {}    -> state
+      IServRunning iserv -> IServRunning
+        (iserv { iservLookupSymbolCache = emptyUFM })
 
 
 -- | loadDLL loads a dynamic library using the OS's native linker
@@ -460,74 +478,70 @@ findSystemLibrary hsc_env str = iservCmd hsc_env (FindSystemLibrary str)
 -- Raw calls and messages
 
 -- | Send a 'Message' and receive the response from the iserv process
-iservCall :: Binary a => IServ -> Message a -> IO a
-iservCall iserv@IServ{..} msg =
-  remoteCall iservPipe msg
+iservCall :: Binary a => IServInstance -> Message a -> IO a
+iservCall iserv msg =
+  remoteCall (iservPipe iserv) msg
     `catch` \(e :: SomeException) -> handleIServFailure iserv e
 
 -- | Read a value from the iserv process
-readIServ :: IServ -> Get a -> IO a
-readIServ iserv@IServ{..} get =
-  readPipe iservPipe get
+readIServ :: IServInstance -> Get a -> IO a
+readIServ iserv get =
+  readPipe (iservPipe iserv) get
     `catch` \(e :: SomeException) -> handleIServFailure iserv e
 
 -- | Send a value to the iserv process
-writeIServ :: IServ -> Put -> IO ()
-writeIServ iserv@IServ{..} put =
-  writePipe iservPipe put
+writeIServ :: IServInstance -> Put -> IO ()
+writeIServ iserv put =
+  writePipe (iservPipe iserv) put
     `catch` \(e :: SomeException) -> handleIServFailure iserv e
 
-handleIServFailure :: IServ -> SomeException -> IO a
-handleIServFailure IServ{..} e = do
-  ex <- getProcessExitCode iservProcess
+handleIServFailure :: IServInstance -> SomeException -> IO a
+handleIServFailure iserv e = do
+  let proc = iservProcess iserv
+  ex <- getProcessExitCode proc
   case ex of
     Just (ExitFailure n) ->
-      throw (InstallationError ("ghc-iserv terminated (" ++ show n ++ ")"))
+      throwIO (InstallationError ("ghc-iserv terminated (" ++ show n ++ ")"))
     _ -> do
-      terminateProcess iservProcess
-      _ <- waitForProcess iservProcess
+      terminateProcess proc
+      _ <- waitForProcess proc
       throw e
 
--- -----------------------------------------------------------------------------
--- Starting and stopping the iserv process
-
-startIServ :: DynFlags -> IO IServ
-startIServ dflags = do
-  let flavour
-        | WayProf `elem` ways dflags = "-prof"
-        | WayDyn `elem` ways dflags = "-dyn"
-        | otherwise = ""
-      prog = pgm_i dflags ++ flavour
-      opts = getOpts dflags opt_i
-  debugTraceMsg dflags 3 $ text "Starting " <> text prog
-  let createProc = lookupHook createIservProcessHook
-                              (\cp -> do { (_,_,_,ph) <- createProcess cp
-                                         ; return ph })
-                              dflags
-  (ph, rh, wh) <- runWithPipes createProc prog opts
+-- | Spawn an external interpreter
+spawnIServ :: IServConfig -> IO IServInstance
+spawnIServ conf = do
+  iservConfTrace conf
+  let createProc = fromMaybe (\cp -> do { (_,_,_,ph) <- createProcess cp
+                                        ; return ph })
+                             (iservConfHook conf)
+  (ph, rh, wh) <- runWithPipes createProc (iservConfProgram conf)
+                                          (iservConfOpts    conf)
   lo_ref <- newIORef Nothing
-  cache_ref <- newIORef emptyUFM
-  return $ IServ
-    { iservPipe = Pipe { pipeRead = rh
-                       , pipeWrite = wh
-                       , pipeLeftovers = lo_ref }
-    , iservProcess = ph
-    , iservLookupSymbolCache = cache_ref
-    , iservPendingFrees = []
+  return $ IServInstance
+    { iservPipe              = Pipe { pipeRead = rh, pipeWrite = wh, pipeLeftovers = lo_ref }
+    , iservProcess           = ph
+    , iservLookupSymbolCache = emptyUFM
+    , iservPendingFrees      = []
+    , iservConfig            = conf
     }
 
-stopIServ :: HscEnv -> IO ()
-stopIServ HscEnv{..} =
-  gmask $ \_restore -> do
-    m <- takeMVar hsc_iserv
-    maybe (return ()) stop m
-    putMVar hsc_iserv Nothing
- where
-  stop iserv = do
-    ex <- getProcessExitCode (iservProcess iserv)
-    if isJust ex
-       then return ()
-       else iservCall iserv Shutdown
+-- | Stop the interpreter
+stopInterp :: HscEnv -> IO ()
+stopInterp hsc_env = case hsc_interp hsc_env of
+  Nothing             -> pure ()
+#if defined(HAVE_INTERNAL_INTERPRETER)
+  Just InternalInterp -> pure ()
+#endif
+  Just (ExternalInterp (IServ mstate)) ->
+    gmask $ \_restore -> modifyMVar_ mstate $ \state -> do
+      case state of
+        IServPending {} -> pure state -- already stopped
+        IServRunning i  -> do
+          ex <- getProcessExitCode (iservProcess i)
+          if isJust ex
+             then pure ()
+             else iservCall i Shutdown
+          pure (IServPending (iservConfig i))
 
 runWithPipes :: (CreateProcess -> IO ProcessHandle)
              -> FilePath -> [String] -> IO (ProcessHandle, Handle, Handle)
@@ -609,20 +623,23 @@ principle it would probably be ok, but it seems less hairy this way.
 -- | Creates a 'ForeignRef' that will automatically release the
 -- 'RemoteRef' when it is no longer referenced.
 mkFinalizedHValue :: HscEnv -> RemoteRef a -> IO (ForeignRef a)
-mkFinalizedHValue HscEnv{..} rref = mkForeignRef rref free
- where
-  !external = gopt Opt_ExternalInterpreter hsc_dflags
-  hvref = toHValueRef rref
-
-  free :: IO ()
-  free
-    | not external = freeRemoteRef hvref
-    | otherwise =
-      modifyMVar_ hsc_iserv $ \mb_iserv ->
-        case mb_iserv of
-          Nothing -> return Nothing -- already shut down
-          Just iserv@IServ{..} ->
-            return (Just iserv{iservPendingFrees = hvref : iservPendingFrees})
+mkFinalizedHValue hsc_env rref = do
+   let hvref = toHValueRef rref
+
+   free <- case hsc_interp hsc_env of
+     Nothing                         -> return (pure ())
+#if defined(HAVE_INTERNAL_INTERPRETER)
+     Just InternalInterp             -> return (freeRemoteRef hvref)
+#endif
+     Just (ExternalInterp (IServ i)) -> return $ modifyMVar_ i $ \state ->
+       case state of
+         IServPending {}   -> pure state -- already shut down
+         IServRunning inst -> do
+            let !inst' = inst {iservPendingFrees = hvref:iservPendingFrees inst}
+            pure (IServRunning inst')
+
+   mkForeignRef rref free
+
 
 freeHValueRefs :: HscEnv -> [HValueRef] -> IO ()
 freeHValueRefs _ [] = return ()
@@ -631,25 +648,19 @@ freeHValueRefs hsc_env refs = iservCmd hsc_env (FreeHValueRefs refs)
 -- | Convert a 'ForeignRef' to the value it references directly.  This
 -- only works when the interpreter is running in the same process as
 -- the compiler, so it fails when @-fexternal-interpreter@ is on.
-wormhole :: DynFlags -> ForeignRef a -> IO a
-wormhole dflags r = wormholeRef dflags (unsafeForeignRefToRemoteRef r)
+wormhole :: Interp -> ForeignRef a -> IO a
+wormhole interp r = wormholeRef interp (unsafeForeignRefToRemoteRef r)
 
 -- | Convert an 'RemoteRef' to the value it references directly.  This
 -- only works when the interpreter is running in the same process as
 -- the compiler, so it fails when @-fexternal-interpreter@ is on.
-wormholeRef :: DynFlags -> RemoteRef a -> IO a
-wormholeRef dflags _r
-  | gopt Opt_ExternalInterpreter dflags
-  = throwIO (InstallationError
-      "this operation requires -fno-external-interpreter")
+wormholeRef :: Interp -> RemoteRef a -> IO a
 #if defined(HAVE_INTERNAL_INTERPRETER)
-  | otherwise
-  = localRef _r
-#else
-  | otherwise
-  = throwIO (InstallationError
-      "can't wormhole a value in a stage1 compiler")
+wormholeRef InternalInterp     _r = localRef _r
 #endif
+wormholeRef (ExternalInterp _) _r
+  = throwIO (InstallationError
+      "this operation requires -fno-external-interpreter")
 
 -- -----------------------------------------------------------------------------
 -- Misc utils
diff --git a/compiler/GHC/Runtime/Interpreter/Types.hs b/compiler/GHC/Runtime/Interpreter/Types.hs
new file mode 100644
index 0000000000..1c9474c2e5
--- /dev/null
+++ b/compiler/GHC/Runtime/Interpreter/Types.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE CPP #-}
+
+-- | Types used by the runtime interpreter
+module GHC.Runtime.Interpreter.Types
+   ( Interp(..)
+   , IServ(..)
+   , IServInstance(..)
+   , IServConfig(..)
+   , IServState(..)
+   )
+where
+
+import GhcPrelude
+
+import GHCi.RemoteTypes
+import GHCi.Message         ( Pipe )
+import UniqFM
+import Foreign
+
+import Control.Concurrent
+import System.Process   ( ProcessHandle, CreateProcess )
+
+-- | Runtime interpreter
+data Interp
+   = ExternalInterp !IServ -- ^ External interpreter
+#if defined(HAVE_INTERNAL_INTERPRETER)
+   | InternalInterp        -- ^ Internal interpreter
+#endif
+
+-- | External interpreter
+--
+-- The external interpreter is spawned lazily (on first use) to avoid slowing
+-- down sessions that don't require it. The contents of the MVar reflects the
+-- state of the interpreter (running or not).
+newtype IServ = IServ (MVar IServState)
+
+-- | State of an external interpreter
+data IServState
+   = IServPending !IServConfig    -- ^ Not spawned yet
+   | IServRunning !IServInstance  -- ^ Running
+
+-- | Configuration needed to spawn an external interpreter
+data IServConfig = IServConfig
+  { iservConfProgram :: !String   -- ^ External program to run
+  , iservConfOpts    :: ![String] -- ^ Command-line options
+  , iservConfHook    :: !(Maybe (CreateProcess -> IO ProcessHandle)) -- ^ Hook
+  , iservConfTrace   :: IO ()   -- ^ Trace action executed after spawn
+  }
+
+-- | External interpreter instance
+data IServInstance = IServInstance
+  { iservPipe              :: !Pipe
+  , iservProcess           :: !ProcessHandle
+  , iservLookupSymbolCache :: !(UniqFM (Ptr ()))
+  , iservPendingFrees      :: ![HValueRef]
+      -- ^ Values that need to be freed before the next command is sent.
+      -- Threads can append values to this list asynchronously (by modifying the
+      -- IServ state MVar).
+
+  , iservConfig            :: !IServConfig
+      -- ^ Config used to spawn the external interpreter
+  }
+
diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
index 3dcdce34d1..46e4c9fbd7 100644
--- a/compiler/GHC/Runtime/Linker.hs
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -32,6 +32,7 @@ where
 import GhcPrelude
 
 import GHC.Runtime.Interpreter
+import GHC.Runtime.Interpreter.Types
 import GHCi.RemoteTypes
 import GHC.Iface.Load
 import GHC.ByteCode.Linker
@@ -193,12 +194,11 @@ linkDependencies :: HscEnv -> PersistentLinkerState
 linkDependencies hsc_env pls span needed_mods = do
 --   initDynLinker (hsc_dflags hsc_env) dl
    let hpt = hsc_HPT hsc_env
-       dflags = hsc_dflags hsc_env
    -- The interpreter and dynamic linker can only handle object code built
    -- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky.
    -- So here we check the build tag: if we're building a non-standard way
    -- then we need to find & link object files built the "normal" way.
-   maybe_normal_osuf <- checkNonStdWay dflags span
+   maybe_normal_osuf <- checkNonStdWay hsc_env span
 
    -- Find what packages and linkables are required
    (lnks, pkgs) <- getLinkDeps hsc_env hpt pls
@@ -575,9 +575,9 @@ dieWith :: DynFlags -> SrcSpan -> MsgDoc -> IO a
 dieWith dflags span msg = throwGhcExceptionIO (ProgramError (showSDoc dflags (mkLocMessage SevFatal span msg)))
 
 
-checkNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe FilePath)
-checkNonStdWay dflags srcspan
-  | gopt Opt_ExternalInterpreter dflags = return Nothing
+checkNonStdWay :: HscEnv -> SrcSpan -> IO (Maybe FilePath)
+checkNonStdWay hsc_env srcspan
+  | Just (ExternalInterp _) <- hsc_interp hsc_env = return Nothing
     -- with -fexternal-interpreter we load the .o files, whatever way
     -- they were built.  If they were built for a non-std way, then
     -- we will use the appropriate variant of the iserv binary to load them.
@@ -586,12 +586,12 @@ checkNonStdWay dflags srcspan
     -- Only if we are compiling with the same ways as GHC is built
     -- with, can we dynamically load those object files. (see #3604)
 
-  | objectSuf dflags == normalObjectSuffix && not (null haskellWays)
-  = failNonStd dflags srcspan
+  | objectSuf (hsc_dflags hsc_env) == normalObjectSuffix && not (null haskellWays)
+  = failNonStd (hsc_dflags hsc_env) srcspan
 
   | otherwise = return (Just (interpTag ++ "o"))
   where
-    haskellWays = filter (not . wayRTSOnly) (ways dflags)
+    haskellWays = filter (not . wayRTSOnly) (ways (hsc_dflags hsc_env))
     interpTag = case mkBuildTag interpWays of
                   "" -> ""
                   tag -> tag ++ "_"
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
index 15d0b7d5dc..c595b53c4e 100644
--- a/compiler/GHC/Runtime/Loader.hs
+++ b/compiler/GHC/Runtime/Loader.hs
@@ -24,9 +24,10 @@ import GhcPrelude
 import GHC.Driver.Session
 
 import GHC.Runtime.Linker      ( linkModule, getHValue )
-import GHC.Runtime.Interpreter ( wormhole )
+import GHC.Runtime.Interpreter ( wormhole, withInterp )
+import GHC.Runtime.Interpreter.Types
 import SrcLoc           ( noSrcSpan )
-import GHC.Driver.Finder           ( findPluginModule, cannotFindModule )
+import GHC.Driver.Finder( findPluginModule, cannotFindModule )
 import TcRnMonad        ( initTcInteractive, initIfaceTcRn )
 import GHC.Iface.Load   ( loadPluginInterface )
 import RdrName          ( RdrName, ImportSpec(..), ImpDeclSpec(..)
@@ -52,7 +53,7 @@ import Outputable
 import Exception
 import GHC.Driver.Hooks
 
-import Control.Monad     ( when, unless )
+import Control.Monad     ( unless )
 import Data.Maybe        ( mapMaybe )
 import Unsafe.Coerce     ( unsafeCoerce )
 
@@ -103,12 +104,11 @@ loadFrontendPlugin hsc_env mod_name = do
 
 -- #14335
 checkExternalInterpreter :: HscEnv -> IO ()
-checkExternalInterpreter hsc_env =
-    when (gopt Opt_ExternalInterpreter dflags) $
-      throwCmdLineError $ showSDoc dflags $
-        text "Plugins require -fno-external-interpreter"
-  where
-    dflags = hsc_dflags hsc_env
+checkExternalInterpreter hsc_env
+  | Just (ExternalInterp _) <- hsc_interp hsc_env
+  = throwIO (InstallationError "Plugins require -fno-external-interpreter")
+  | otherwise
+  = pure ()
 
 loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, ModIface)
 loadPlugin' occ_name plugin_name hsc_env mod_name
@@ -206,7 +206,7 @@ getHValueSafely hsc_env val_name expected_type = do
                                    return ()
                     Nothing ->  return ()
                 -- Find the value that we just linked in and cast it given that we have proved it's type
-                hval <- getHValue hsc_env val_name >>= wormhole dflags
+                hval <- withInterp hsc_env $ \interp -> getHValue hsc_env val_name >>= wormhole interp
                 return (Just hval)
              else return Nothing
         Just val_thing -> throwCmdLineErrorS dflags $ wrongTyThingError val_name val_thing
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index a9903b9ded..17b2334e2b 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -657,3 +657,4 @@ Library
             GHC.Runtime.Linker
             GHC.Runtime.Heap.Inspect
             GHC.Runtime.Interpreter
+            GHC.Runtime.Interpreter.Types
diff --git a/compiler/typecheck/TcAnnotations.hs b/compiler/typecheck/TcAnnotations.hs
index 5b49699eb4..8f5af9743b 100644
--- a/compiler/typecheck/TcAnnotations.hs
+++ b/compiler/typecheck/TcAnnotations.hs
@@ -5,7 +5,6 @@
 \section[TcAnnotations]{Typechecking annotations}
 -}
 
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -24,17 +23,17 @@ import Annotations
 import TcRnMonad
 import SrcLoc
 import Outputable
+import GHC.Driver.Types
 
--- Some platforms don't support the external interpreter, and
--- compilation on those platforms shouldn't fail just due to
--- annotations
-#if !defined(HAVE_INTERNAL_INTERPRETER)
+-- Some platforms don't support the interpreter, and compilation on those
+-- platforms shouldn't fail just due to annotations
 tcAnnotations :: [LAnnDecl GhcRn] -> TcM [Annotation]
 tcAnnotations anns = do
-  dflags <- getDynFlags
-  case gopt Opt_ExternalInterpreter dflags of
-    True  -> tcAnnotations' anns
-    False -> warnAnns anns
+  hsc_env <- getTopEnv
+  case hsc_interp hsc_env of
+    Just _  -> mapM tcAnnotation anns
+    Nothing -> warnAnns anns
+
 warnAnns :: [LAnnDecl GhcRn] -> TcM [Annotation]
 --- No GHCI; emit a warning (not an error) and ignore. cf #4268
 warnAnns [] = return []
@@ -43,13 +42,6 @@ warnAnns anns@(L loc _ : _)
              (text "Ignoring ANN annotation" <> plural anns <> comma
              <+> text "because this is a stage-1 compiler without -fexternal-interpreter or doesn't support GHCi")
        ; return [] }
-#else
-tcAnnotations :: [LAnnDecl GhcRn] -> TcM [Annotation]
-tcAnnotations = tcAnnotations'
-#endif
-
-tcAnnotations' :: [LAnnDecl GhcRn] -> TcM [Annotation]
-tcAnnotations' anns = mapM tcAnnotation anns
 
 tcAnnotation :: LAnnDecl GhcRn -> TcM Annotation
 tcAnnotation (L loc ann@(HsAnnotation _ _ provenance expr)) = do
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index ecbf07c36d..a4ea37db72 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -7,6 +7,7 @@ TcSplice: Template Haskell splices
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -58,6 +59,7 @@ import Control.Monad
 import GHCi.Message
 import GHCi.RemoteTypes
 import GHC.Runtime.Interpreter
+import GHC.Runtime.Interpreter.Types
 import GHC.Driver.Main
         -- These imports are the reason that TcSplice
         -- is very high up the module hierarchy
@@ -122,8 +124,11 @@ import qualified Language.Haskell.TH as TH
 -- THSyntax gives access to internal functions and data types
 import qualified Language.Haskell.TH.Syntax as TH
 
+#if defined(HAVE_INTERNAL_INTERPRETER)
 -- Because GHC.Desugar might not be in the base library of the bootstrapping compiler
 import GHC.Desugar      ( AnnotationWrapper(..) )
+import Unsafe.Coerce    ( unsafeCoerce )
+#endif
 
 import Control.Exception
 import Data.Binary
@@ -135,7 +140,6 @@ import qualified Data.Map as Map
 import Data.Typeable ( typeOf, Typeable, TypeRep, typeRep )
 import Data.Data (Data)
 import Data.Proxy    ( Proxy (..) )
-import Unsafe.Coerce        ( unsafeCoerce )
 
 {-
 ************************************************************************
@@ -770,12 +774,12 @@ runAnnotation target expr = do
 
 convertAnnotationWrapper :: ForeignHValue -> TcM (Either MsgDoc Serialized)
 convertAnnotationWrapper fhv = do
-  dflags <- getDynFlags
-  if gopt Opt_ExternalInterpreter dflags
-    then do
-      Right <$> runTH THAnnWrapper fhv
-    else do
-      annotation_wrapper <- liftIO $ wormhole dflags fhv
+  interp <- tcGetInterp
+  case interp of
+    ExternalInterp _ -> Right <$> runTH THAnnWrapper fhv
+#if defined(HAVE_INTERNAL_INTERPRETER)
+    InternalInterp   -> do
+      annotation_wrapper <- liftIO $ wormhole InternalInterp fhv
       return $ Right $
         case unsafeCoerce annotation_wrapper of
            AnnotationWrapper value | let serialized = toSerialized serializeWithData value ->
@@ -791,6 +795,7 @@ convertAnnotationWrapper fhv = do
 seqSerialized :: Serialized -> ()
 seqSerialized (Serialized the_type bytes) = the_type `seq` bytes `seqList` ()
 
+#endif
 
 {-
 ************************************************************************
@@ -805,13 +810,18 @@ runQuasi act = TH.runQ act
 
 runRemoteModFinalizers :: ThModFinalizers -> TcM ()
 runRemoteModFinalizers (ThModFinalizers finRefs) = do
-  dflags <- getDynFlags
   let withForeignRefs [] f = f []
       withForeignRefs (x : xs) f = withForeignRef x $ \r ->
         withForeignRefs xs $ \rs -> f (r : rs)
-  if gopt Opt_ExternalInterpreter dflags then do
-    hsc_env <- env_top <$> getEnv
-    withIServ hsc_env $ \i -> do
+  interp <- tcGetInterp
+  case interp of
+#if defined(HAVE_INTERNAL_INTERPRETER)
+    InternalInterp -> do
+      qs <- liftIO (withForeignRefs finRefs $ mapM localRef)
+      runQuasi $ sequence_ qs
+#endif
+
+    ExternalInterp iserv -> withIServ_ iserv $ \i -> do
       tcg <- getGblEnv
       th_state <- readTcRef (tcg_th_remote_state tcg)
       case th_state of
@@ -822,9 +832,6 @@ runRemoteModFinalizers (ThModFinalizers finRefs) = do
               writeIServ i (putMessage (RunModFinalizers st qrefs))
           () <- runRemoteTH i []
           readQResult i
-  else do
-    qs <- liftIO (withForeignRefs finRefs $ mapM localRef)
-    runQuasi $ sequence_ qs
 
 runQResult
   :: (a -> String)
@@ -1159,7 +1166,7 @@ instance TH.Quasi TcM where
       addModFinalizerRef fref
 
   qAddCorePlugin plugin = do
-      hsc_env <- env_top <$> getEnv
+      hsc_env <- getTopEnv
       r <- liftIO $ findHomeModule hsc_env (mkModuleName plugin)
       let err = hang
             (text "addCorePlugin: invalid plugin module "
@@ -1206,10 +1213,16 @@ addModFinalizerRef finRef = do
 -- | Releases the external interpreter state.
 finishTH :: TcM ()
 finishTH = do
-  dflags <- getDynFlags
-  when (gopt Opt_ExternalInterpreter dflags) $ do
-    tcg <- getGblEnv
-    writeTcRef (tcg_th_remote_state tcg) Nothing
+  hsc_env <- getTopEnv
+  case hsc_interp hsc_env of
+    Nothing                 -> pure ()
+#if defined(HAVE_INTERNAL_INTERPRETER)
+    Just InternalInterp     -> pure ()
+#endif
+    Just (ExternalInterp _) -> do
+      tcg <- getGblEnv
+      writeTcRef (tcg_th_remote_state tcg) Nothing
+
 
 runTHExp :: ForeignHValue -> TcM TH.Exp
 runTHExp = runTH THExp
@@ -1225,19 +1238,21 @@ runTHDec = runTH THDec
 
 runTH :: Binary a => THResultType -> ForeignHValue -> TcM a
 runTH ty fhv = do
-  hsc_env <- env_top <$> getEnv
-  dflags <- getDynFlags
-  if not (gopt Opt_ExternalInterpreter dflags)
-    then do
+  interp <- tcGetInterp
+  case interp of
+#if defined(HAVE_INTERNAL_INTERPRETER)
+    InternalInterp -> do
        -- Run it in the local TcM
-      hv <- liftIO $ wormhole dflags fhv
+      hv <- liftIO $ wormhole InternalInterp fhv
       r <- runQuasi (unsafeCoerce hv :: TH.Q a)
       return r
-    else
+#endif
+
+    ExternalInterp iserv ->
       -- Run it on the server.  For an overview of how TH works with
       -- Remote GHCi, see Note [Remote Template Haskell] in
       -- libraries/ghci/GHCi/TH.hs.
-      withIServ hsc_env $ \i -> do
+      withIServ_ iserv $ \i -> do
         rstate <- getTHState i
         loc <- TH.qLocation
         liftIO $
@@ -1252,7 +1267,7 @@ runTH ty fhv = do
 -- | communicate with a remotely-running TH computation until it finishes.
 -- See Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs.
 runRemoteTH
-  :: IServ
+  :: IServInstance
   -> [Messages]   --  saved from nested calls to qRecover
   -> TcM ()
 runRemoteTH iserv recovers = do
@@ -1281,7 +1296,7 @@ runRemoteTH iserv recovers = do
       runRemoteTH iserv recovers
 
 -- | Read a value of type QResult from the iserv
-readQResult :: Binary a => IServ -> TcM a
+readQResult :: Binary a => IServInstance -> TcM a
 readQResult i = do
   qr <- liftIO $ readIServ i get
   case qr of
@@ -1330,14 +1345,14 @@ Back in GHC, when we receive:
 --
 -- The TH state is stored in tcg_th_remote_state in the TcGblEnv.
 --
-getTHState :: IServ -> TcM (ForeignRef (IORef QState))
+getTHState :: IServInstance -> TcM (ForeignRef (IORef QState))
 getTHState i = do
   tcg <- getGblEnv
   th_state <- readTcRef (tcg_th_remote_state tcg)
   case th_state of
     Just rhv -> return rhv
     Nothing -> do
-      hsc_env <- env_top <$> getEnv
+      hsc_env <- getTopEnv
       fhv <- liftIO $ mkFinalizedHValue hsc_env =<< iservCall i StartTH
       writeTcRef (tcg_th_remote_state tcg) (Just fhv)
       return fhv
@@ -1366,7 +1381,7 @@ handleTHMessage msg = case msg of
   AddDependentFile f -> wrapTHResult $ TH.qAddDependentFile f
   AddTempFile s -> wrapTHResult $ TH.qAddTempFile s
   AddModFinalizer r -> do
-    hsc_env <- env_top <$> getEnv
+    hsc_env <- getTopEnv
     wrapTHResult $ liftIO (mkFinalizedHValue hsc_env r) >>= addModFinalizerRef
   AddCorePlugin str -> wrapTHResult $ TH.qAddCorePlugin str
   AddTopDecls decs -> wrapTHResult $ TH.qAddTopDecls decs
@@ -2361,3 +2376,10 @@ such fields defined in the module (see the test case
 overloadedrecflds/should_fail/T11103.hs).  The "proper" fix requires changes to
 the TH AST to make it able to represent duplicate record fields.
 -}
+
+tcGetInterp :: TcM Interp
+tcGetInterp = do
+   hsc_env <- getTopEnv
+   case hsc_interp hsc_env of
+      Nothing -> liftIO $ throwIO (InstallationError "Template haskell requires a target code interpreter")
+      Just i  -> pure i
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 7793b7183a..67903c80bf 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -37,6 +37,7 @@ import GHC.Runtime.Debugger
 
 -- The GHC interface
 import GHC.Runtime.Interpreter
+import GHC.Runtime.Interpreter.Types
 import GHCi.RemoteTypes
 import GHCi.BreakArray
 import GHC.Driver.Session as DynFlags
@@ -53,7 +54,7 @@ import GHC.Hs.ImpExp
 import GHC.Hs
 import GHC.Driver.Types ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC,
                   setInteractivePrintName, hsc_dflags, msObjFilePath, runInteractiveHsc,
-                  hsc_dynLinker )
+                  hsc_dynLinker, hsc_interp )
 import Module
 import Name
 import GHC.Driver.Packages ( trusted, getPackageDetails, getInstalledPackageDetails,
@@ -1559,14 +1560,15 @@ changeDirectory dir = do
   GHC.workingDirectoryChanged
   dir' <- expandPath dir
   liftIO $ setCurrentDirectory dir'
-  dflags <- getDynFlags
   -- With -fexternal-interpreter, we have to change the directory of the subprocess too.
   -- (this gives consistent behaviour with and without -fexternal-interpreter)
-  when (gopt Opt_ExternalInterpreter dflags) $ do
-    hsc_env <- GHC.getSession
-    fhv <- compileGHCiExpr $
-      "System.Directory.setCurrentDirectory " ++ show dir'
-    liftIO $ evalIO hsc_env fhv
+  hsc_env <- GHC.getSession
+  case hsc_interp hsc_env of
+    Just (ExternalInterp {}) -> do
+      fhv <- compileGHCiExpr $
+        "System.Directory.setCurrentDirectory " ++ show dir'
+      liftIO $ evalIO hsc_env fhv
+    _ -> pure ()
 
 trySuccess :: GHC.GhcMonad m => m SuccessFlag -> m SuccessFlag
 trySuccess act =