    {-# LANGUAGE RecordWildCards, ScopedTypeVariables, BangPatterns, CPP #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE TupleSections #-}

    -- | Interacting with the iserv interpreter, whether it is running on an
    -- external process or in the current process.
    --
    module GHC.Runtime.Interpreter
      ( module GHC.Runtime.Interpreter.Types

      -- * High-level interface to the interpreter
      , evalStmt, EvalStatus_(..), EvalStatus, EvalResult(..), EvalExpr(..)
      , resumeStmt
      , abandonStmt
      , evalIO
      , evalString
      , evalStringToIOString
      , mallocData
      , createBCOs
      , addSptEntry
      , mkCostCentres
      , costCentreStackInfo
      , newBreakArray
      , storeBreakpoint
      , breakpointStatus
      , getBreakpointVar
      , getClosure
      , getModBreaks
      , seqHValue
      , interpreterDynamic
      , interpreterProfiled

      -- * The object-code linker
      , initObjLinker
      , lookupSymbol
      , lookupClosure
      , loadDLL
      , loadArchive
      , loadObj
      , unloadObj
      , addLibrarySearchPath
      , removeLibrarySearchPath
      , resolveObjs
      , findSystemLibrary

      -- * Lower-level API using messages
      , interpCmd, Message(..), withIServ, withIServ_
      , hscInterp, stopInterp
      , iservCall, readIServ, writeIServ
      , purgeLookupSymbolCache
      , freeHValueRefs
      , mkFinalizedHValue
      , wormhole, wormholeRef
      , mkEvalOpts
      , fromEvalResult
      ) where

    import GHC.Prelude

    import GHC.Driver.Ppr (showSDoc)
    import GHC.Driver.Env
    import GHC.Driver.Session

    import GHC.Runtime.Interpreter.Types
    import GHCi.Message
    import GHCi.RemoteTypes
    import GHCi.ResolvedBCO
    import GHCi.BreakArray (BreakArray)
    import GHC.Runtime.Eval.Types(BreakInfo(..))
    import GHC.ByteCode.Types

    import GHC.Linker.Types

    import GHC.Data.Maybe
    import GHC.Data.FastString

    import GHC.Types.Unique
    import GHC.Types.SrcLoc
    import GHC.Types.Unique.FM
    import GHC.Types.Basic

    import GHC.Utils.Panic
    import GHC.Utils.Exception as Ex
    import GHC.Utils.Outputable(brackets, ppr)
    import GHC.Utils.Fingerprint
    import GHC.Utils.Misc

    import GHC.Unit.Module
    import GHC.Unit.Module.ModIface
    import GHC.Unit.Home.ModInfo

    #if defined(HAVE_INTERNAL_INTERPRETER)
    import GHCi.Run
    import GHC.Platform.Ways
    #endif

    import Control.Concurrent
    import Control.Monad
    import Control.Monad.IO.Class
    import Control.Monad.Catch as MC (mask, onException)
    import Data.Binary
    import Data.Binary.Put
    import Data.ByteString (ByteString)
    import qualified Data.ByteString.Lazy as LB
    import Data.Array ((!))
    import Data.IORef
    import Foreign hiding (void)
    import qualified GHC.Exts.Heap as Heap
    import GHC.Stack.CCS (CostCentre,CostCentreStack)
    import System.Exit
    import GHC.IO.Handle.Types (Handle)
    #if defined(mingw32_HOST_OS)
    import Foreign.C
    import GHC.IO.Handle.FD (fdToHandle)
    #else
    import System.Posix as Posix
    #endif
    import System.Directory
    import System.Process
    import GHC.Conc (getNumProcessors, pseq, par)

    {- Note [Remote GHCi]

    When the flag -fexternal-interpreter is given to GHC, interpreted code
    is run in a separate process called iserv, and we communicate with the
    external process over a pipe using Binary-encoded messages.

    Motivation
    ~~~~~~~~~~

    When the interpreted code is running in a separate process, it can
    use a different "way", e.g. profiled or dynamic.  This means

    - compiling Template Haskell code with -prof does not require
      building the code without -prof first

    - when GHC itself is profiled, it can interpret unprofiled code,
      and the same applies to dynamic linking.

    - An unprofiled GHCi can load and run profiled code, which means it
      can use the stack-trace functionality provided by profiling without
      taking the performance hit on the compiler that profiling would
      entail.

    For other reasons see remote-GHCi on the wiki.

    Implementation Overview
    ~~~~~~~~~~~~~~~~~~~~~~~

    The main pieces are:

    - libraries/ghci, containing:
      - types for talking about remote values (GHCi.RemoteTypes)
      - the message protocol (GHCi.Message),
      - implementation of the messages (GHCi.Run)
      - implementation of Template Haskell (GHCi.TH)
      - a few other things needed to run interpreted code

    - top-level iserv directory, containing the codefor the external
      server.  This is a fairly simple wrapper, most of the functionality
      is provided by modules in libraries/ghci.

    - This module which provides the interface to the server used
      by the rest of GHC.

    GHC works with and without -fexternal-interpreter.  With the flag, all
    interpreted code is run by the iserv binary.  Without the flag,
    interpreted code is run in the same process as GHC.

    Things that do not work with -fexternal-interpreter
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    dynCompileExpr cannot work, because we have no way to run code of an
    unknown type in the remote process.  This API fails with an error
    message if it is used with -fexternal-interpreter.

    Other Notes on Remote GHCi
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
      * This wiki page has an implementation overview:
        https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/external-interpreter
      * Note [External GHCi pointers] in "GHC.Runtime.Interpreter"
      * Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs
    -}

    -- | Run a command in the interpreter's context.  With
    -- @-fexternal-interpreter@, the command is serialized and sent to an
    -- external iserv process, and the response is deserialized (hence the
    -- @Binary@ constraint).  With @-fno-external-interpreter@ we execute
    -- the command directly here.
    interpCmd :: Binary a => Interp -> Message a -> IO a
    interpCmd :: forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp Message a
    msg = case Interp -> InterpInstance
    interpInstance Interp
    interp of
    #if defined(HAVE_INTERNAL_INTERPRETER)
      InterpInstance
    InternalInterp     -> Message a -> IO a
    forall a. Message a -> IO a
    run Message a
    msg -- Just run it directly
    #endif
      ExternalInterp IServConfig
    c IServ
    i -> IServConfig -> IServ -> (IServInstance -> IO a) -> IO a
    forall (m :: * -> *) a.
    (MonadIO m, ExceptionMonad m) =>
    IServConfig -> IServ -> (IServInstance -> m a) -> m a
    withIServ_ IServConfig
    c IServ
    i ((IServInstance -> IO a) -> IO a)
    -> (IServInstance -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \IServInstance
    iserv ->
        IO a -> IO a
    forall a. IO a -> IO a
    uninterruptibleMask_ (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ -- Note [uninterruptibleMask_]
          IServInstance -> Message a -> IO a
    forall a. Binary a => IServInstance -> Message a -> IO a
    iservCall IServInstance
    iserv Message a
    msg

    -- | Retrieve the target code interpreter
    --
    -- Fails if no target code interpreter is available
    hscInterp :: HscEnv -> Interp
    hscInterp :: HscEnv -> Interp
    hscInterp HscEnv
    hsc_env = case HscEnv -> Maybe Interp
    hsc_interp HscEnv
    hsc_env of
       Maybe Interp
    Nothing -> GhcException -> Interp
    forall a e. Exception e => e -> a
    throw (String -> GhcException
    InstallationError String
    "Couldn't find a target code interpreter. Try with -fexternal-interpreter")
       Just Interp
    i  -> Interp
    i

    -- Note [uninterruptibleMask_ and interpCmd]
    --
    -- 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 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.

    -- | Grab a lock on the 'IServ' and do something with it.
    -- Overloaded because this is used from TcM as well as IO.
    withIServ
      :: (ExceptionMonad m)
      => IServConfig -> IServ -> (IServInstance -> m (IServInstance, a)) -> m a
    withIServ :: forall (m :: * -> *) a.
    ExceptionMonad m =>
    IServConfig
    -> IServ -> (IServInstance -> m (IServInstance, a)) -> m a
    withIServ IServConfig
    conf (IServ MVar IServState
    mIServState) IServInstance -> m (IServInstance, a)
    action =
      ((forall a. m a -> m a) -> m a) -> m a
    forall (m :: * -> *) b.
    MonadMask m =>
    ((forall a. m a -> m a) -> m b) -> m b
    MC.mask (((forall a. m a -> m a) -> m a) -> m a)
    -> ((forall a. m a -> m a) -> m a) -> m a
    forall a b. (a -> b) -> a -> b
    $ \forall a. m a -> m a
    restore -> do
        IServState
    state <- IO IServState -> m IServState
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO IServState -> m IServState) -> IO IServState -> m IServState
    forall a b. (a -> b) -> a -> b
    $ MVar IServState -> IO IServState
    forall a. MVar a -> IO a
    takeMVar MVar IServState
    mIServState

        IServInstance
    iserv <- case IServState
    state of
          -- start the external iserv process if we haven't done so yet
          IServState
    IServPending ->
             IO IServInstance -> m IServInstance
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IServConfig -> IO IServInstance
    spawnIServ IServConfig
    conf)
               m IServInstance -> m () -> m IServInstance
    forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
    `MC.onException` (IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ MVar IServState -> IServState -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar IServState
    mIServState IServState
    state)

          IServRunning IServInstance
    inst -> IServInstance -> m IServInstance
    forall (m :: * -> *) a. Monad m => a -> m a
    return IServInstance
    inst

        let iserv' :: IServInstance
    iserv'  = IServInstance
    iserv{ iservPendingFrees :: [HValueRef]
    iservPendingFrees = [] }

        (IServInstance
    iserv'',a
    a) <- (do
          -- free any ForeignHValues that have been garbage collected.
          IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not ([HValueRef] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (IServInstance -> [HValueRef]
    iservPendingFrees IServInstance
    iserv))) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            IServInstance -> Message () -> IO ()
    forall a. Binary a => IServInstance -> Message a -> IO a
    iservCall IServInstance
    iserv ([HValueRef] -> Message ()
    FreeHValueRefs (IServInstance -> [HValueRef]
    iservPendingFrees IServInstance
    iserv))
          -- run the inner action
          m (IServInstance, a) -> m (IServInstance, a)
    forall a. m a -> m a
    restore (m (IServInstance, a) -> m (IServInstance, a))
    -> m (IServInstance, a) -> m (IServInstance, a)
    forall a b. (a -> b) -> a -> b
    $ IServInstance -> m (IServInstance, a)
    action IServInstance
    iserv')
              m (IServInstance, a) -> m () -> m (IServInstance, a)
    forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
    `MC.onException` (IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ MVar IServState -> IServState -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar IServState
    mIServState (IServInstance -> IServState
    IServRunning IServInstance
    iserv'))
        IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ MVar IServState -> IServState -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar IServState
    mIServState (IServInstance -> IServState
    IServRunning IServInstance
    iserv'')
        a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

    withIServ_
      :: (MonadIO m, ExceptionMonad m)
      => IServConfig -> IServ -> (IServInstance -> m a) -> m a
    withIServ_ :: forall (m :: * -> *) a.
    (MonadIO m, ExceptionMonad m) =>
    IServConfig -> IServ -> (IServInstance -> m a) -> m a
    withIServ_ IServConfig
    conf IServ
    iserv IServInstance -> m a
    action = IServConfig
    -> IServ -> (IServInstance -> m (IServInstance, a)) -> m a
    forall (m :: * -> *) a.
    ExceptionMonad m =>
    IServConfig
    -> IServ -> (IServInstance -> m (IServInstance, a)) -> m a
    withIServ IServConfig
    conf IServ
    iserv ((IServInstance -> m (IServInstance, a)) -> m a)
    -> (IServInstance -> m (IServInstance, a)) -> m a
    forall a b. (a -> b) -> a -> b
    $ \IServInstance
    inst ->
       (IServInstance
    inst,) (a -> (IServInstance, a)) -> m a -> m (IServInstance, a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IServInstance -> m a
    action IServInstance
    inst

    -- -----------------------------------------------------------------------------
    -- Wrappers around messages

    -- | Execute an action of type @IO [a]@, returning 'ForeignHValue's for
    -- each of the results.
    evalStmt
      :: Interp
      -> DynFlags -- used by mkEvalOpts
      -> Bool     -- "step" for mkEvalOpts
      -> EvalExpr ForeignHValue
      -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
    evalStmt :: Interp
    -> DynFlags
    -> Bool
    -> EvalExpr ForeignHValue
    -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
    evalStmt Interp
    interp DynFlags
    dflags Bool
    step EvalExpr ForeignHValue
    foreign_expr = do
      EvalStatus_ [HValueRef] [HValueRef]
    status <- EvalExpr ForeignHValue
    -> (EvalExpr HValueRef -> IO (EvalStatus_ [HValueRef] [HValueRef]))
    -> IO (EvalStatus_ [HValueRef] [HValueRef])
    forall a.
    EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
    withExpr EvalExpr ForeignHValue
    foreign_expr ((EvalExpr HValueRef -> IO (EvalStatus_ [HValueRef] [HValueRef]))
     -> IO (EvalStatus_ [HValueRef] [HValueRef]))
    -> (EvalExpr HValueRef -> IO (EvalStatus_ [HValueRef] [HValueRef]))
    -> IO (EvalStatus_ [HValueRef] [HValueRef])
    forall a b. (a -> b) -> a -> b
    $ \EvalExpr HValueRef
    expr ->
        Interp
    -> Message (EvalStatus_ [HValueRef] [HValueRef])
    -> IO (EvalStatus_ [HValueRef] [HValueRef])
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (EvalOpts
    -> EvalExpr HValueRef
    -> Message (EvalStatus_ [HValueRef] [HValueRef])
    EvalStmt (DynFlags -> Bool -> EvalOpts
    mkEvalOpts DynFlags
    dflags Bool
    step) EvalExpr HValueRef
    expr)
      Interp
    -> EvalStatus_ [HValueRef] [HValueRef]
    -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
    handleEvalStatus Interp
    interp EvalStatus_ [HValueRef] [HValueRef]
    status
     where
      withExpr :: EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
      withExpr :: forall a.
    EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
    withExpr (EvalThis ForeignHValue
    fhv) EvalExpr HValueRef -> IO a
    cont =
        ForeignHValue -> (HValueRef -> IO a) -> IO a
    forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
    withForeignRef ForeignHValue
    fhv ((HValueRef -> IO a) -> IO a) -> (HValueRef -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \HValueRef
    hvref -> EvalExpr HValueRef -> IO a
    cont (HValueRef -> EvalExpr HValueRef
    forall a. a -> EvalExpr a
    EvalThis HValueRef
    hvref)
      withExpr (EvalApp EvalExpr ForeignHValue
    fl EvalExpr ForeignHValue
    fr) EvalExpr HValueRef -> IO a
    cont =
        EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
    forall a.
    EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
    withExpr EvalExpr ForeignHValue
    fl ((EvalExpr HValueRef -> IO a) -> IO a)
    -> (EvalExpr HValueRef -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \EvalExpr HValueRef
    fl' ->
        EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
    forall a.
    EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
    withExpr EvalExpr ForeignHValue
    fr ((EvalExpr HValueRef -> IO a) -> IO a)
    -> (EvalExpr HValueRef -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \EvalExpr HValueRef
    fr' ->
        EvalExpr HValueRef -> IO a
    cont (EvalExpr HValueRef -> EvalExpr HValueRef -> EvalExpr HValueRef
    forall a. EvalExpr a -> EvalExpr a -> EvalExpr a
    EvalApp EvalExpr HValueRef
    fl' EvalExpr HValueRef
    fr')

    resumeStmt
      :: Interp
      -> DynFlags -- used by mkEvalOpts
      -> Bool     -- "step" for mkEvalOpts
      -> ForeignRef (ResumeContext [HValueRef])
      -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
    resumeStmt :: Interp
    -> DynFlags
    -> Bool
    -> ForeignRef (ResumeContext [HValueRef])
    -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
    resumeStmt Interp
    interp DynFlags
    dflags Bool
    step ForeignRef (ResumeContext [HValueRef])
    resume_ctxt = do
      EvalStatus_ [HValueRef] [HValueRef]
    status <- ForeignRef (ResumeContext [HValueRef])
    -> (RemoteRef (ResumeContext [HValueRef])
        -> IO (EvalStatus_ [HValueRef] [HValueRef]))
    -> IO (EvalStatus_ [HValueRef] [HValueRef])
    forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
    withForeignRef ForeignRef (ResumeContext [HValueRef])
    resume_ctxt ((RemoteRef (ResumeContext [HValueRef])
      -> IO (EvalStatus_ [HValueRef] [HValueRef]))
     -> IO (EvalStatus_ [HValueRef] [HValueRef]))
    -> (RemoteRef (ResumeContext [HValueRef])
        -> IO (EvalStatus_ [HValueRef] [HValueRef]))
    -> IO (EvalStatus_ [HValueRef] [HValueRef])
    forall a b. (a -> b) -> a -> b
    $ \RemoteRef (ResumeContext [HValueRef])
    rhv ->
        Interp
    -> Message (EvalStatus_ [HValueRef] [HValueRef])
    -> IO (EvalStatus_ [HValueRef] [HValueRef])
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (EvalOpts
    -> RemoteRef (ResumeContext [HValueRef])
    -> Message (EvalStatus_ [HValueRef] [HValueRef])
    ResumeStmt (DynFlags -> Bool -> EvalOpts
    mkEvalOpts DynFlags
    dflags Bool
    step) RemoteRef (ResumeContext [HValueRef])
    rhv)
      Interp
    -> EvalStatus_ [HValueRef] [HValueRef]
    -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
    handleEvalStatus Interp
    interp EvalStatus_ [HValueRef] [HValueRef]
    status

    abandonStmt :: Interp -> ForeignRef (ResumeContext [HValueRef]) -> IO ()
    abandonStmt :: Interp -> ForeignRef (ResumeContext [HValueRef]) -> IO ()
    abandonStmt Interp
    interp ForeignRef (ResumeContext [HValueRef])
    resume_ctxt =
      ForeignRef (ResumeContext [HValueRef])
    -> (RemoteRef (ResumeContext [HValueRef]) -> IO ()) -> IO ()
    forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
    withForeignRef ForeignRef (ResumeContext [HValueRef])
    resume_ctxt ((RemoteRef (ResumeContext [HValueRef]) -> IO ()) -> IO ())
    -> (RemoteRef (ResumeContext [HValueRef]) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \RemoteRef (ResumeContext [HValueRef])
    rhv ->
        Interp -> Message () -> IO ()
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (RemoteRef (ResumeContext [HValueRef]) -> Message ()
    AbandonStmt RemoteRef (ResumeContext [HValueRef])
    rhv)

    handleEvalStatus
      :: Interp
      -> EvalStatus [HValueRef]
      -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
    handleEvalStatus :: Interp
    -> EvalStatus_ [HValueRef] [HValueRef]
    -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
    handleEvalStatus Interp
    interp EvalStatus_ [HValueRef] [HValueRef]
    status =
      case EvalStatus_ [HValueRef] [HValueRef]
    status of
        EvalBreak Bool
    a HValueRef
    b Int
    c Int
    d RemoteRef (ResumeContext [HValueRef])
    e RemotePtr CostCentreStack
    f -> EvalStatus_ [ForeignHValue] [HValueRef]
    -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    -> HValueRef
    -> Int
    -> Int
    -> RemoteRef (ResumeContext [HValueRef])
    -> RemotePtr CostCentreStack
    -> EvalStatus_ [ForeignHValue] [HValueRef]
    forall a b.
    Bool
    -> HValueRef
    -> Int
    -> Int
    -> RemoteRef (ResumeContext b)
    -> RemotePtr CostCentreStack
    -> EvalStatus_ a b
    EvalBreak Bool
    a HValueRef
    b Int
    c Int
    d RemoteRef (ResumeContext [HValueRef])
    e RemotePtr CostCentreStack
    f)
        EvalComplete Word64
    alloc EvalResult [HValueRef]
    res ->
          Word64
    -> EvalResult [ForeignHValue]
    -> EvalStatus_ [ForeignHValue] [HValueRef]
    forall a b. Word64 -> EvalResult a -> EvalStatus_ a b
    EvalComplete Word64
    alloc (EvalResult [ForeignHValue]
     -> EvalStatus_ [ForeignHValue] [HValueRef])
    -> IO (EvalResult [ForeignHValue])
    -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> EvalResult [HValueRef] -> IO (EvalResult [ForeignHValue])
    addFinalizer EvalResult [HValueRef]
    res
     where
      addFinalizer :: EvalResult [HValueRef] -> IO (EvalResult [ForeignHValue])
    addFinalizer (EvalException SerializableException
    e) = EvalResult [ForeignHValue] -> IO (EvalResult [ForeignHValue])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SerializableException -> EvalResult [ForeignHValue]
    forall a. SerializableException -> EvalResult a
    EvalException SerializableException
    e)
      addFinalizer (EvalSuccess [HValueRef]
    rs)  =
        [ForeignHValue] -> EvalResult [ForeignHValue]
    forall a. a -> EvalResult a
    EvalSuccess ([ForeignHValue] -> EvalResult [ForeignHValue])
    -> IO [ForeignHValue] -> IO (EvalResult [ForeignHValue])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (HValueRef -> IO ForeignHValue)
    -> [HValueRef] -> IO [ForeignHValue]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Interp -> HValueRef -> IO ForeignHValue
    forall a. Interp -> RemoteRef a -> IO (ForeignRef a)
    mkFinalizedHValue Interp
    interp) [HValueRef]
    rs

    -- | Execute an action of type @IO ()@
    evalIO :: Interp -> ForeignHValue -> IO ()
    evalIO :: Interp -> ForeignHValue -> IO ()
    evalIO Interp
    interp ForeignHValue
    fhv =
      IO () -> IO ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ForeignHValue -> (HValueRef -> IO ()) -> IO ()
    forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
    withForeignRef ForeignHValue
    fhv ((HValueRef -> IO ()) -> IO ()) -> (HValueRef -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \HValueRef
    fhv ->
        Interp -> Message (EvalResult ()) -> IO (EvalResult ())
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (HValueRef -> Message (EvalResult ())
    EvalIO HValueRef
    fhv) IO (EvalResult ()) -> (EvalResult () -> IO ()) -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= EvalResult () -> IO ()
    forall a. EvalResult a -> IO a
    fromEvalResult

    -- | Execute an action of type @IO String@
    evalString :: Interp -> ForeignHValue -> IO String
    evalString :: Interp -> ForeignHValue -> IO String
    evalString Interp
    interp ForeignHValue
    fhv =
      IO String -> IO String
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO String -> IO String) -> IO String -> IO String
    forall a b. (a -> b) -> a -> b
    $ ForeignHValue -> (HValueRef -> IO String) -> IO String
    forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
    withForeignRef ForeignHValue
    fhv ((HValueRef -> IO String) -> IO String)
    -> (HValueRef -> IO String) -> IO String
    forall a b. (a -> b) -> a -> b
    $ \HValueRef
    fhv ->
        Interp -> Message (EvalResult String) -> IO (EvalResult String)
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (HValueRef -> Message (EvalResult String)
    EvalString HValueRef
    fhv) IO (EvalResult String)
    -> (EvalResult String -> IO String) -> IO String
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= EvalResult String -> IO String
    forall a. EvalResult a -> IO a
    fromEvalResult

    -- | Execute an action of type @String -> IO String@
    evalStringToIOString :: Interp -> ForeignHValue -> String -> IO String
    evalStringToIOString :: Interp -> ForeignHValue -> String -> IO String
    evalStringToIOString Interp
    interp ForeignHValue
    fhv String
    str =
      IO String -> IO String
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO String -> IO String) -> IO String -> IO String
    forall a b. (a -> b) -> a -> b
    $ ForeignHValue -> (HValueRef -> IO String) -> IO String
    forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
    withForeignRef ForeignHValue
    fhv ((HValueRef -> IO String) -> IO String)
    -> (HValueRef -> IO String) -> IO String
    forall a b. (a -> b) -> a -> b
    $ \HValueRef
    fhv ->
        Interp -> Message (EvalResult String) -> IO (EvalResult String)
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (HValueRef -> String -> Message (EvalResult String)
    EvalStringToString HValueRef
    fhv String
    str) IO (EvalResult String)
    -> (EvalResult String -> IO String) -> IO String
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= EvalResult String -> IO String
    forall a. EvalResult a -> IO a
    fromEvalResult

    -- | Allocate and store the given bytes in memory, returning a pointer
    -- to the memory in the remote process.
    mallocData :: Interp -> ByteString -> IO (RemotePtr ())
    mallocData :: Interp -> ByteString -> IO (RemotePtr ())
    mallocData Interp
    interp ByteString
    bs = Interp -> Message (RemotePtr ()) -> IO (RemotePtr ())
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (ByteString -> Message (RemotePtr ())
    MallocData ByteString
    bs)

    mkCostCentres :: Interp -> String -> [(String,String)] -> IO [RemotePtr CostCentre]
    mkCostCentres :: Interp -> String -> [(String, String)] -> IO [RemotePtr CostCentre]
    mkCostCentres Interp
    interp String
    mod [(String, String)]
    ccs =
      Interp
    -> Message [RemotePtr CostCentre] -> IO [RemotePtr CostCentre]
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (String -> [(String, String)] -> Message [RemotePtr CostCentre]
    MkCostCentres String
    mod [(String, String)]
    ccs)

    -- | Create a set of BCOs that may be mutually recursive.
    createBCOs :: Interp -> DynFlags -> [ResolvedBCO] -> IO [HValueRef]
    createBCOs :: Interp -> DynFlags -> [ResolvedBCO] -> IO [HValueRef]
    createBCOs Interp
    interp DynFlags
    dflags [ResolvedBCO]
    rbcos = do
      Int
    n_jobs <- case DynFlags -> Maybe Int
    parMakeCount DynFlags
    dflags of
                  Maybe Int
    Nothing -> IO Int -> IO Int
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO Int
    getNumProcessors
                  Just Int
    n  -> Int -> IO Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    n
      -- Serializing ResolvedBCO is expensive, so if we're in parallel mode
      -- (-j<n>) parallelise the serialization.
      if (Int
    n_jobs Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1)
        then
          Interp -> Message [HValueRef] -> IO [HValueRef]
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp ([ByteString] -> Message [HValueRef]
    CreateBCOs [Put -> ByteString
    runPut ([ResolvedBCO] -> Put
    forall t. Binary t => t -> Put
    put [ResolvedBCO]
    rbcos)])

        else do
          Int
    old_caps <- IO Int
    getNumCapabilities
          if Int
    old_caps Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    n_jobs
             then IO [ByteString] -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO [ByteString] -> IO ()) -> IO [ByteString] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> IO [ByteString]
    forall a. a -> IO a
    evaluate [ByteString]
    puts
             else IO () -> IO () -> IO () -> IO ()
    forall a b c. IO a -> IO b -> IO c -> IO c
    bracket_ (Int -> IO ()
    setNumCapabilities Int
    n_jobs)
                           (Int -> IO ()
    setNumCapabilities Int
    old_caps)
                           (IO [ByteString] -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO [ByteString] -> IO ()) -> IO [ByteString] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> IO [ByteString]
    forall a. a -> IO a
    evaluate [ByteString]
    puts)
          Interp -> Message [HValueRef] -> IO [HValueRef]
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp ([ByteString] -> Message [HValueRef]
    CreateBCOs [ByteString]
    puts)
     where
      puts :: [ByteString]
    puts = ([ResolvedBCO] -> ByteString) -> [[ResolvedBCO]] -> [ByteString]
    forall {t} {a}. (t -> a) -> [t] -> [a]
    parMap [ResolvedBCO] -> ByteString
    forall {t}. Binary t => t -> ByteString
    doChunk (Int -> [ResolvedBCO] -> [[ResolvedBCO]]
    forall a. Int -> [a] -> [[a]]
    chunkList Int
    100 [ResolvedBCO]
    rbcos)

      -- make sure we force the whole lazy ByteString
      doChunk :: t -> ByteString
    doChunk t
    c = Int64 -> ByteString -> ByteString
    forall a b. a -> b -> b
    pseq (ByteString -> Int64
    LB.length ByteString
    bs) ByteString
    bs
        where bs :: ByteString
    bs = Put -> ByteString
    runPut (t -> Put
    forall t. Binary t => t -> Put
    put t
    c)

      -- We don't have the parallel package, so roll our own simple parMap
      parMap :: (t -> a) -> [t] -> [a]
    parMap t -> a
    _ [] = []
      parMap t -> a
    f (t
    x:[t]
    xs) = a
    fx a -> [a] -> [a]
    forall a b. a -> b -> b
    `par` ([a]
    fxs [a] -> [a] -> [a]
    forall a b. a -> b -> b
    `pseq` (a
    fx a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    fxs))
        where fx :: a
    fx = t -> a
    f t
    x; fxs :: [a]
    fxs = (t -> a) -> [t] -> [a]
    parMap t -> a
    f [t]
    xs

    addSptEntry :: Interp -> Fingerprint -> ForeignHValue -> IO ()
    addSptEntry :: Interp -> Fingerprint -> ForeignHValue -> IO ()
    addSptEntry Interp
    interp Fingerprint
    fpr ForeignHValue
    ref =
      ForeignHValue -> (HValueRef -> IO ()) -> IO ()
    forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
    withForeignRef ForeignHValue
    ref ((HValueRef -> IO ()) -> IO ()) -> (HValueRef -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \HValueRef
    val ->
        Interp -> Message () -> IO ()
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (Fingerprint -> HValueRef -> Message ()
    AddSptEntry Fingerprint
    fpr HValueRef
    val)

    costCentreStackInfo :: Interp -> RemotePtr CostCentreStack -> IO [String]
    costCentreStackInfo :: Interp -> RemotePtr CostCentreStack -> IO [String]
    costCentreStackInfo Interp
    interp RemotePtr CostCentreStack
    ccs =
      Interp -> Message [String] -> IO [String]
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (RemotePtr CostCentreStack -> Message [String]
    CostCentreStackInfo RemotePtr CostCentreStack
    ccs)

    newBreakArray :: Interp -> Int -> IO (ForeignRef BreakArray)
    newBreakArray :: Interp -> Int -> IO (ForeignRef BreakArray)
    newBreakArray Interp
    interp Int
    size = do
      RemoteRef BreakArray
    breakArray <- Interp
    -> Message (RemoteRef BreakArray) -> IO (RemoteRef BreakArray)
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (Int -> Message (RemoteRef BreakArray)
    NewBreakArray Int
    size)
      Interp -> RemoteRef BreakArray -> IO (ForeignRef BreakArray)
    forall a. Interp -> RemoteRef a -> IO (ForeignRef a)
    mkFinalizedHValue Interp
    interp RemoteRef BreakArray
    breakArray

    storeBreakpoint :: Interp -> ForeignRef BreakArray -> Int -> Int -> IO ()
    storeBreakpoint :: Interp -> ForeignRef BreakArray -> Int -> Int -> IO ()
    storeBreakpoint Interp
    interp ForeignRef BreakArray
    ref Int
    ix Int
    cnt = do                               -- #19157
      ForeignRef BreakArray -> (RemoteRef BreakArray -> IO ()) -> IO ()
    forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
    withForeignRef ForeignRef BreakArray
    ref ((RemoteRef BreakArray -> IO ()) -> IO ())
    -> (RemoteRef BreakArray -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \RemoteRef BreakArray
    breakarray ->
        Interp -> Message () -> IO ()
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (RemoteRef BreakArray -> Int -> Int -> Message ()
    SetupBreakpoint RemoteRef BreakArray
    breakarray Int
    ix Int
    cnt)

    breakpointStatus :: Interp -> ForeignRef BreakArray -> Int -> IO Bool
    breakpointStatus :: Interp -> ForeignRef BreakArray -> Int -> IO Bool
    breakpointStatus Interp
    interp ForeignRef BreakArray
    ref Int
    ix =
      ForeignRef BreakArray
    -> (RemoteRef BreakArray -> IO Bool) -> IO Bool
    forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
    withForeignRef ForeignRef BreakArray
    ref ((RemoteRef BreakArray -> IO Bool) -> IO Bool)
    -> (RemoteRef BreakArray -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \RemoteRef BreakArray
    breakarray ->
        Interp -> Message Bool -> IO Bool
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (RemoteRef BreakArray -> Int -> Message Bool
    BreakpointStatus RemoteRef BreakArray
    breakarray Int
    ix)

    getBreakpointVar :: Interp -> ForeignHValue -> Int -> IO (Maybe ForeignHValue)
    getBreakpointVar :: Interp -> ForeignHValue -> Int -> IO (Maybe ForeignHValue)
    getBreakpointVar Interp
    interp ForeignHValue
    ref Int
    ix =
      ForeignHValue
    -> (HValueRef -> IO (Maybe ForeignHValue))
    -> IO (Maybe ForeignHValue)
    forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
    withForeignRef ForeignHValue
    ref ((HValueRef -> IO (Maybe ForeignHValue))
     -> IO (Maybe ForeignHValue))
    -> (HValueRef -> IO (Maybe ForeignHValue))
    -> IO (Maybe ForeignHValue)
    forall a b. (a -> b) -> a -> b
    $ \HValueRef
    apStack -> do
        Maybe HValueRef
    mb <- Interp -> Message (Maybe HValueRef) -> IO (Maybe HValueRef)
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (HValueRef -> Int -> Message (Maybe HValueRef)
    GetBreakpointVar HValueRef
    apStack Int
    ix)
        (HValueRef -> IO ForeignHValue)
    -> Maybe HValueRef -> IO (Maybe ForeignHValue)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Interp -> HValueRef -> IO ForeignHValue
    forall a. Interp -> RemoteRef a -> IO (ForeignRef a)
    mkFinalizedHValue Interp
    interp) Maybe HValueRef
    mb

    getClosure :: Interp -> ForeignHValue -> IO (Heap.GenClosure ForeignHValue)
    getClosure :: Interp -> ForeignHValue -> IO (GenClosure ForeignHValue)
    getClosure Interp
    interp ForeignHValue
    ref =
      ForeignHValue
    -> (HValueRef -> IO (GenClosure ForeignHValue))
    -> IO (GenClosure ForeignHValue)
    forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
    withForeignRef ForeignHValue
    ref ((HValueRef -> IO (GenClosure ForeignHValue))
     -> IO (GenClosure ForeignHValue))
    -> (HValueRef -> IO (GenClosure ForeignHValue))
    -> IO (GenClosure ForeignHValue)
    forall a b. (a -> b) -> a -> b
    $ \HValueRef
    hval -> do
        GenClosure HValueRef
    mb <- Interp
    -> Message (GenClosure HValueRef) -> IO (GenClosure HValueRef)
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (HValueRef -> Message (GenClosure HValueRef)
    GetClosure HValueRef
    hval)
        (HValueRef -> IO ForeignHValue)
    -> GenClosure HValueRef -> IO (GenClosure ForeignHValue)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Interp -> HValueRef -> IO ForeignHValue
    forall a. Interp -> RemoteRef a -> IO (ForeignRef a)
    mkFinalizedHValue Interp
    interp) GenClosure HValueRef
    mb

    -- | Send a Seq message to the iserv process to force a value      #2950
    seqHValue :: Interp -> HscEnv -> ForeignHValue -> IO (EvalResult ())
    seqHValue :: Interp -> HscEnv -> ForeignHValue -> IO (EvalResult ())
    seqHValue Interp
    interp HscEnv
    hsc_env ForeignHValue
    ref =
      ForeignHValue
    -> (HValueRef -> IO (EvalResult ())) -> IO (EvalResult ())
    forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
    withForeignRef ForeignHValue
    ref ((HValueRef -> IO (EvalResult ())) -> IO (EvalResult ()))
    -> (HValueRef -> IO (EvalResult ())) -> IO (EvalResult ())
    forall a b. (a -> b) -> a -> b
    $ \HValueRef
    hval -> do
        EvalStatus_ () ()
    status <- Interp -> Message (EvalStatus_ () ()) -> IO (EvalStatus_ () ())
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (HValueRef -> Message (EvalStatus_ () ())
    Seq HValueRef
    hval)
        Interp -> HscEnv -> EvalStatus_ () () -> IO (EvalResult ())
    handleSeqHValueStatus Interp
    interp HscEnv
    hsc_env EvalStatus_ () ()
    status

    -- | Process the result of a Seq or ResumeSeq message.             #2950
    handleSeqHValueStatus :: Interp -> HscEnv -> EvalStatus () -> IO (EvalResult ())
    handleSeqHValueStatus :: Interp -> HscEnv -> EvalStatus_ () () -> IO (EvalResult ())
    handleSeqHValueStatus Interp
    interp HscEnv
    hsc_env EvalStatus_ () ()
    eval_status =
      case EvalStatus_ () ()
    eval_status of
        (EvalBreak Bool
    is_exception HValueRef
    _ Int
    ix Int
    mod_uniq RemoteRef (ResumeContext ())
    resume_ctxt RemotePtr CostCentreStack
    _) -> do
          -- A breakpoint was hit; inform the user and tell them
          -- which breakpoint was hit.
          ForeignRef (ResumeContext ())
    resume_ctxt_fhv <- IO (ForeignRef (ResumeContext ()))
    -> IO (ForeignRef (ResumeContext ()))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (ForeignRef (ResumeContext ()))
     -> IO (ForeignRef (ResumeContext ())))
    -> IO (ForeignRef (ResumeContext ()))
    -> IO (ForeignRef (ResumeContext ()))
    forall a b. (a -> b) -> a -> b
    $ Interp
    -> RemoteRef (ResumeContext ())
    -> IO (ForeignRef (ResumeContext ()))
    forall a. Interp -> RemoteRef a -> IO (ForeignRef a)
    mkFinalizedHValue Interp
    interp RemoteRef (ResumeContext ())
    resume_ctxt
          let hmi :: HomeModInfo
    hmi = String -> Maybe HomeModInfo -> HomeModInfo
    forall a. HasCallStack => String -> Maybe a -> a
    expectJust String
    "handleRunStatus" (Maybe HomeModInfo -> HomeModInfo)
    -> Maybe HomeModInfo -> HomeModInfo
    forall a b. (a -> b) -> a -> b
    $
                      HomePackageTable -> Unique -> Maybe HomeModInfo
    lookupHptDirectly (HscEnv -> HomePackageTable
    hsc_HPT HscEnv
    hsc_env)
                        (Int -> Unique
    mkUniqueGrimily Int
    mod_uniq)
              modl :: Module
    modl = ModIface_ 'ModIfaceFinal -> Module
    forall (phase :: ModIfacePhase). ModIface_ phase -> Module
    mi_module (HomeModInfo -> ModIface_ 'ModIfaceFinal
    hm_iface HomeModInfo
    hmi)
              bp :: Maybe BreakInfo
    bp | Bool
    is_exception = Maybe BreakInfo
    forall a. Maybe a
    Nothing
                 | Bool
    otherwise = BreakInfo -> Maybe BreakInfo
    forall a. a -> Maybe a
    Just (Module -> Int -> BreakInfo
    BreakInfo Module
    modl Int
    ix)
              sdocBpLoc :: Maybe BreakInfo -> SDoc
    sdocBpLoc = SDoc -> SDoc
    brackets (SDoc -> SDoc)
    -> (Maybe BreakInfo -> SDoc) -> Maybe BreakInfo -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (SrcSpan -> SDoc)
    -> (Maybe BreakInfo -> SrcSpan) -> Maybe BreakInfo -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe BreakInfo -> SrcSpan
    getSeqBpSpan
          String -> IO ()
    putStrLn (String
    "*** Ignoring breakpoint " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                (DynFlags -> SDoc -> String
    showSDoc (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env) (SDoc -> String) -> SDoc -> String
    forall a b. (a -> b) -> a -> b
    $ Maybe BreakInfo -> SDoc
    sdocBpLoc Maybe BreakInfo
    bp))
          -- resume the seq (:force) processing in the iserv process
          ForeignRef (ResumeContext ())
    -> (RemoteRef (ResumeContext ()) -> IO (EvalResult ()))
    -> IO (EvalResult ())
    forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
    withForeignRef ForeignRef (ResumeContext ())
    resume_ctxt_fhv ((RemoteRef (ResumeContext ()) -> IO (EvalResult ()))
     -> IO (EvalResult ()))
    -> (RemoteRef (ResumeContext ()) -> IO (EvalResult ()))
    -> IO (EvalResult ())
    forall a b. (a -> b) -> a -> b
    $ \RemoteRef (ResumeContext ())
    hval -> do
            EvalStatus_ () ()
    status <- Interp -> Message (EvalStatus_ () ()) -> IO (EvalStatus_ () ())
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (RemoteRef (ResumeContext ()) -> Message (EvalStatus_ () ())
    ResumeSeq RemoteRef (ResumeContext ())
    hval)
            Interp -> HscEnv -> EvalStatus_ () () -> IO (EvalResult ())
    handleSeqHValueStatus Interp
    interp HscEnv
    hsc_env EvalStatus_ () ()
    status
        (EvalComplete Word64
    _ EvalResult ()
    r) -> EvalResult () -> IO (EvalResult ())
    forall (m :: * -> *) a. Monad m => a -> m a
    return EvalResult ()
    r
      where
        getSeqBpSpan :: Maybe BreakInfo -> SrcSpan
        -- Just case: Stopped at a breakpoint, extract SrcSpan information
        -- from the breakpoint.
        getSeqBpSpan :: Maybe BreakInfo -> SrcSpan
    getSeqBpSpan (Just BreakInfo{Int
    Module
    breakInfo_number :: BreakInfo -> Int
    breakInfo_module :: BreakInfo -> Module
    breakInfo_number :: Int
    breakInfo_module :: Module
    ..}) =
          (ModBreaks -> Array Int SrcSpan
    modBreaks_locs (Module -> ModBreaks
    breaks Module
    breakInfo_module)) Array Int SrcSpan -> Int -> SrcSpan
    forall i e. Ix i => Array i e -> i -> e
    ! Int
    breakInfo_number
        -- Nothing case - should not occur!
        -- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq
        getSeqBpSpan Maybe BreakInfo
    Nothing = FastString -> SrcSpan
    mkGeneralSrcSpan (String -> FastString
    fsLit String
    "<unknown>")
        breaks :: Module -> ModBreaks
    breaks Module
    mod = HomeModInfo -> ModBreaks
    getModBreaks (HomeModInfo -> ModBreaks) -> HomeModInfo -> ModBreaks
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe HomeModInfo -> HomeModInfo
    forall a. HasCallStack => String -> Maybe a -> a
    expectJust String
    "getSeqBpSpan" (Maybe HomeModInfo -> HomeModInfo)
    -> Maybe HomeModInfo -> HomeModInfo
    forall a b. (a -> b) -> a -> b
    $
          HomePackageTable -> ModuleName -> Maybe HomeModInfo
    lookupHpt (HscEnv -> HomePackageTable
    hsc_HPT HscEnv
    hsc_env) (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    mod)

    -- -----------------------------------------------------------------------------
    -- Interface to the object-code linker

    initObjLinker :: Interp -> IO ()
    initObjLinker :: Interp -> IO ()
    initObjLinker Interp
    interp = Interp -> Message () -> IO ()
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp Message ()
    InitLinker

    lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ()))
    lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ()))
    lookupSymbol Interp
    interp FastString
    str = case Interp -> InterpInstance
    interpInstance Interp
    interp of
    #if defined(HAVE_INTERNAL_INTERPRETER)
      InterpInstance
    InternalInterp -> (RemotePtr () -> Ptr ()) -> Maybe (RemotePtr ()) -> Maybe (Ptr ())
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap RemotePtr () -> Ptr ()
    forall a. RemotePtr a -> Ptr a
    fromRemotePtr (Maybe (RemotePtr ()) -> Maybe (Ptr ()))
    -> IO (Maybe (RemotePtr ())) -> IO (Maybe (Ptr ()))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Message (Maybe (RemotePtr ())) -> IO (Maybe (RemotePtr ()))
    forall a. Message a -> IO a
    run (String -> Message (Maybe (RemotePtr ()))
    LookupSymbol (FastString -> String
    unpackFS FastString
    str))
    #endif

      ExternalInterp IServConfig
    c IServ
    i -> IServConfig
    -> IServ
    -> (IServInstance -> IO (IServInstance, Maybe (Ptr ())))
    -> IO (Maybe (Ptr ()))
    forall (m :: * -> *) a.
    ExceptionMonad m =>
    IServConfig
    -> IServ -> (IServInstance -> m (IServInstance, a)) -> m a
    withIServ IServConfig
    c IServ
    i ((IServInstance -> IO (IServInstance, Maybe (Ptr ())))
     -> IO (Maybe (Ptr ())))
    -> (IServInstance -> IO (IServInstance, Maybe (Ptr ())))
    -> IO (Maybe (Ptr ()))
    forall a b. (a -> b) -> a -> b
    $ \IServInstance
    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 :: UniqFM FastString (Ptr ())
    cache = IServInstance -> UniqFM FastString (Ptr ())
    iservLookupSymbolCache IServInstance
    iserv
        case UniqFM FastString (Ptr ()) -> FastString -> Maybe (Ptr ())
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM FastString (Ptr ())
    cache FastString
    str of
          Just Ptr ()
    p -> (IServInstance, Maybe (Ptr ()))
    -> IO (IServInstance, Maybe (Ptr ()))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IServInstance
    iserv, Ptr () -> Maybe (Ptr ())
    forall a. a -> Maybe a
    Just Ptr ()
    p)
          Maybe (Ptr ())
    Nothing -> do
            Maybe (RemotePtr ())
    m <- IO (Maybe (RemotePtr ())) -> IO (Maybe (RemotePtr ()))
    forall a. IO a -> IO a
    uninterruptibleMask_ (IO (Maybe (RemotePtr ())) -> IO (Maybe (RemotePtr ())))
    -> IO (Maybe (RemotePtr ())) -> IO (Maybe (RemotePtr ()))
    forall a b. (a -> b) -> a -> b
    $
                     IServInstance
    -> Message (Maybe (RemotePtr ())) -> IO (Maybe (RemotePtr ()))
    forall a. Binary a => IServInstance -> Message a -> IO a
    iservCall IServInstance
    iserv (String -> Message (Maybe (RemotePtr ()))
    LookupSymbol (FastString -> String
    unpackFS FastString
    str))
            case Maybe (RemotePtr ())
    m of
              Maybe (RemotePtr ())
    Nothing -> (IServInstance, Maybe (Ptr ()))
    -> IO (IServInstance, Maybe (Ptr ()))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IServInstance
    iserv, Maybe (Ptr ())
    forall a. Maybe a
    Nothing)
              Just RemotePtr ()
    r -> do
                let p :: Ptr ()
    p      = RemotePtr () -> Ptr ()
    forall a. RemotePtr a -> Ptr a
    fromRemotePtr RemotePtr ()
    r
                    cache' :: UniqFM FastString (Ptr ())
    cache' = UniqFM FastString (Ptr ())
    -> FastString -> Ptr () -> UniqFM FastString (Ptr ())
    forall key elt.
    Uniquable key =>
    UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM UniqFM FastString (Ptr ())
    cache FastString
    str Ptr ()
    p
                    iserv' :: IServInstance
    iserv' = IServInstance
    iserv {iservLookupSymbolCache :: UniqFM FastString (Ptr ())
    iservLookupSymbolCache = UniqFM FastString (Ptr ())
    cache'}
                (IServInstance, Maybe (Ptr ()))
    -> IO (IServInstance, Maybe (Ptr ()))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IServInstance
    iserv', Ptr () -> Maybe (Ptr ())
    forall a. a -> Maybe a
    Just Ptr ()
    p)

    lookupClosure :: Interp -> String -> IO (Maybe HValueRef)
    lookupClosure :: Interp -> String -> IO (Maybe HValueRef)
    lookupClosure Interp
    interp String
    str =
      Interp -> Message (Maybe HValueRef) -> IO (Maybe HValueRef)
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (String -> Message (Maybe HValueRef)
    LookupClosure String
    str)

    purgeLookupSymbolCache :: Interp -> IO ()
    purgeLookupSymbolCache :: Interp -> IO ()
    purgeLookupSymbolCache Interp
    interp = case Interp -> InterpInstance
    interpInstance Interp
    interp of
    #if defined(HAVE_INTERNAL_INTERPRETER)
      InterpInstance
    InternalInterp -> () -> IO ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    #endif
      ExternalInterp IServConfig
    _ (IServ MVar IServState
    mstate) ->
        MVar IServState -> (IServState -> IO IServState) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar IServState
    mstate ((IServState -> IO IServState) -> IO ())
    -> (IServState -> IO IServState) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \IServState
    state -> IServState -> IO IServState
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (IServState -> IO IServState) -> IServState -> IO IServState
    forall a b. (a -> b) -> a -> b
    $ case IServState
    state of
          IServState
    IServPending       -> IServState
    state
          IServRunning IServInstance
    iserv -> IServInstance -> IServState
    IServRunning
            (IServInstance
    iserv { iservLookupSymbolCache :: UniqFM FastString (Ptr ())
    iservLookupSymbolCache = UniqFM FastString (Ptr ())
    forall key elt. UniqFM key elt
    emptyUFM })

    -- | loadDLL loads a dynamic library using the OS's native linker
    -- (i.e. dlopen() on Unix, LoadLibrary() on Windows).  It takes either
    -- an absolute pathname to the file, or a relative filename
    -- (e.g. "libfoo.so" or "foo.dll").  In the latter case, loadDLL
    -- searches the standard locations for the appropriate library.
    --
    -- Returns:
    --
    -- Nothing      => success
    -- Just err_msg => failure
    loadDLL :: Interp -> String -> IO (Maybe String)
    loadDLL :: Interp -> String -> IO (Maybe String)
    loadDLL Interp
    interp String
    str = Interp -> Message (Maybe String) -> IO (Maybe String)
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (String -> Message (Maybe String)
    LoadDLL String
    str)

    loadArchive :: Interp -> String -> IO ()
    loadArchive :: Interp -> String -> IO ()
    loadArchive Interp
    interp String
    path = do
      String
    path' <- String -> IO String
    canonicalizePath String
    path -- Note [loadObj and relative paths]
      Interp -> Message () -> IO ()
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (String -> Message ()
    LoadArchive String
    path')

    loadObj :: Interp -> String -> IO ()
    loadObj :: Interp -> String -> IO ()
    loadObj Interp
    interp String
    path = do
      String
    path' <- String -> IO String
    canonicalizePath String
    path -- Note [loadObj and relative paths]
      Interp -> Message () -> IO ()
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (String -> Message ()
    LoadObj String
    path')

    unloadObj :: Interp -> String -> IO ()
    unloadObj :: Interp -> String -> IO ()
    unloadObj Interp
    interp String
    path = do
      String
    path' <- String -> IO String
    canonicalizePath String
    path -- Note [loadObj and relative paths]
      Interp -> Message () -> IO ()
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (String -> Message ()
    UnloadObj String
    path')

    -- Note [loadObj and relative paths]
    -- the iserv process might have a different current directory from the
    -- GHC process, so we must make paths absolute before sending them
    -- over.

    addLibrarySearchPath :: Interp -> String -> IO (Ptr ())
    addLibrarySearchPath :: Interp -> String -> IO (Ptr ())
    addLibrarySearchPath Interp
    interp String
    str =
      RemotePtr () -> Ptr ()
    forall a. RemotePtr a -> Ptr a
    fromRemotePtr (RemotePtr () -> Ptr ()) -> IO (RemotePtr ()) -> IO (Ptr ())
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Interp -> Message (RemotePtr ()) -> IO (RemotePtr ())
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (String -> Message (RemotePtr ())
    AddLibrarySearchPath String
    str)

    removeLibrarySearchPath :: Interp -> Ptr () -> IO Bool
    removeLibrarySearchPath :: Interp -> Ptr () -> IO Bool
    removeLibrarySearchPath Interp
    interp Ptr ()
    p =
      Interp -> Message Bool -> IO Bool
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (RemotePtr () -> Message Bool
    RemoveLibrarySearchPath (Ptr () -> RemotePtr ()
    forall a. Ptr a -> RemotePtr a
    toRemotePtr Ptr ()
    p))

    resolveObjs :: Interp -> IO SuccessFlag
    resolveObjs :: Interp -> IO SuccessFlag
    resolveObjs Interp
    interp = Bool -> SuccessFlag
    successIf (Bool -> SuccessFlag) -> IO Bool -> IO SuccessFlag
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Interp -> Message Bool -> IO Bool
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp Message Bool
    ResolveObjs

    findSystemLibrary :: Interp -> String -> IO (Maybe String)
    findSystemLibrary :: Interp -> String -> IO (Maybe String)
    findSystemLibrary Interp
    interp String
    str = Interp -> Message (Maybe String) -> IO (Maybe String)
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp (String -> Message (Maybe String)
    FindSystemLibrary String
    str)

    -- -----------------------------------------------------------------------------
    -- Raw calls and messages

    -- | Send a 'Message' and receive the response from the iserv process
    iservCall :: Binary a => IServInstance -> Message a -> IO a
    iservCall :: forall a. Binary a => IServInstance -> Message a -> IO a
    iservCall IServInstance
    iserv Message a
    msg =
      Pipe -> Message a -> IO a
    forall a. Binary a => Pipe -> Message a -> IO a
    remoteCall (IServInstance -> Pipe
    iservPipe IServInstance
    iserv) Message a
    msg
        IO a -> (SomeException -> IO a) -> IO a
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` \(SomeException
    e :: SomeException) -> IServInstance -> SomeException -> IO a
    forall a. IServInstance -> SomeException -> IO a
    handleIServFailure IServInstance
    iserv SomeException
    e

    -- | Read a value from the iserv process
    readIServ :: IServInstance -> Get a -> IO a
    readIServ :: forall a. IServInstance -> Get a -> IO a
    readIServ IServInstance
    iserv Get a
    get =
      Pipe -> Get a -> IO a
    forall a. Pipe -> Get a -> IO a
    readPipe (IServInstance -> Pipe
    iservPipe IServInstance
    iserv) Get a
    get
        IO a -> (SomeException -> IO a) -> IO a
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` \(SomeException
    e :: SomeException) -> IServInstance -> SomeException -> IO a
    forall a. IServInstance -> SomeException -> IO a
    handleIServFailure IServInstance
    iserv SomeException
    e

    -- | Send a value to the iserv process
    writeIServ :: IServInstance -> Put -> IO ()
    writeIServ :: IServInstance -> Put -> IO ()
    writeIServ IServInstance
    iserv Put
    put =
      Pipe -> Put -> IO ()
    writePipe (IServInstance -> Pipe
    iservPipe IServInstance
    iserv) Put
    put
        IO () -> (SomeException -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` \(SomeException
    e :: SomeException) -> IServInstance -> SomeException -> IO ()
    forall a. IServInstance -> SomeException -> IO a
    handleIServFailure IServInstance
    iserv SomeException
    e

    handleIServFailure :: IServInstance -> SomeException -> IO a
    handleIServFailure :: forall a. IServInstance -> SomeException -> IO a
    handleIServFailure IServInstance
    iserv SomeException
    e = do
      let proc :: ProcessHandle
    proc = IServInstance -> ProcessHandle
    iservProcess IServInstance
    iserv
      Maybe ExitCode
    ex <- ProcessHandle -> IO (Maybe ExitCode)
    getProcessExitCode ProcessHandle
    proc
      case Maybe ExitCode
    ex of
        Just (ExitFailure Int
    n) ->
          GhcException -> IO a
    forall e a. Exception e => e -> IO a
    throwIO (String -> GhcException
    InstallationError (String
    "ghc-iserv terminated (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"))
        Maybe ExitCode
    _ -> do
          ProcessHandle -> IO ()
    terminateProcess ProcessHandle
    proc
          ExitCode
    _ <- ProcessHandle -> IO ExitCode
    waitForProcess ProcessHandle
    proc
          SomeException -> IO a
    forall a e. Exception e => e -> a
    throw SomeException
    e

    -- | Spawn an external interpreter
    spawnIServ :: IServConfig -> IO IServInstance
    spawnIServ :: IServConfig -> IO IServInstance
    spawnIServ IServConfig
    conf = do
      IServConfig -> IO ()
    iservConfTrace IServConfig
    conf
      let createProc :: CreateProcess -> IO ProcessHandle
    createProc = (CreateProcess -> IO ProcessHandle)
    -> Maybe (CreateProcess -> IO ProcessHandle)
    -> CreateProcess
    -> IO ProcessHandle
    forall a. a -> Maybe a -> a
    fromMaybe (\CreateProcess
    cp -> do { (Maybe Handle
    _,Maybe Handle
    _,Maybe Handle
    _,ProcessHandle
    ph) <- CreateProcess
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    createProcess CreateProcess
    cp
                                            ; ProcessHandle -> IO ProcessHandle
    forall (m :: * -> *) a. Monad m => a -> m a
    return ProcessHandle
    ph })
                                 (IServConfig -> Maybe (CreateProcess -> IO ProcessHandle)
    iservConfHook IServConfig
    conf)
      (ProcessHandle
    ph, Handle
    rh, Handle
    wh) <- (CreateProcess -> IO ProcessHandle)
    -> String -> [String] -> IO (ProcessHandle, Handle, Handle)
    runWithPipes CreateProcess -> IO ProcessHandle
    createProc (IServConfig -> String
    iservConfProgram IServConfig
    conf)
                                              (IServConfig -> [String]
    iservConfOpts    IServConfig
    conf)
      IORef (Maybe ByteString)
    lo_ref <- Maybe ByteString -> IO (IORef (Maybe ByteString))
    forall a. a -> IO (IORef a)
    newIORef Maybe ByteString
    forall a. Maybe a
    Nothing
      IServInstance -> IO IServInstance
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IServInstance -> IO IServInstance)
    -> IServInstance -> IO IServInstance
    forall a b. (a -> b) -> a -> b
    $ IServInstance
        { iservPipe :: Pipe
    iservPipe              = Pipe { pipeRead :: Handle
    pipeRead = Handle
    rh, pipeWrite :: Handle
    pipeWrite = Handle
    wh, pipeLeftovers :: IORef (Maybe ByteString)
    pipeLeftovers = IORef (Maybe ByteString)
    lo_ref }
        , iservProcess :: ProcessHandle
    iservProcess           = ProcessHandle
    ph
        , iservLookupSymbolCache :: UniqFM FastString (Ptr ())
    iservLookupSymbolCache = UniqFM FastString (Ptr ())
    forall key elt. UniqFM key elt
    emptyUFM
        , iservPendingFrees :: [HValueRef]
    iservPendingFrees      = []
        }

    -- | Stop the interpreter
    stopInterp :: Interp -> IO ()
    stopInterp :: Interp -> IO ()
    stopInterp Interp
    interp = case Interp -> InterpInstance
    interpInstance Interp
    interp of
    #if defined(HAVE_INTERNAL_INTERPRETER)
        InterpInstance
    InternalInterp -> () -> IO ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    #endif
        ExternalInterp IServConfig
    _ (IServ MVar IServState
    mstate) ->
          ((forall a. IO a -> IO a) -> IO ()) -> IO ()
    forall (m :: * -> *) b.
    MonadMask m =>
    ((forall a. m a -> m a) -> m b) -> m b
    MC.mask (((forall a. IO a -> IO a) -> IO ()) -> IO ())
    -> ((forall a. IO a -> IO a) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \forall a. IO a -> IO a
    _restore -> MVar IServState -> (IServState -> IO IServState) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar IServState
    mstate ((IServState -> IO IServState) -> IO ())
    -> (IServState -> IO IServState) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \IServState
    state -> do
            case IServState
    state of
              IServState
    IServPending    -> IServState -> IO IServState
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure IServState
    state -- already stopped
              IServRunning IServInstance
    i  -> do
                Maybe ExitCode
    ex <- ProcessHandle -> IO (Maybe ExitCode)
    getProcessExitCode (IServInstance -> ProcessHandle
    iservProcess IServInstance
    i)
                if Maybe ExitCode -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe ExitCode
    ex
                   then () -> IO ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                   else IServInstance -> Message () -> IO ()
    forall a. Binary a => IServInstance -> Message a -> IO a
    iservCall IServInstance
    i Message ()
    Shutdown
                IServState -> IO IServState
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure IServState
    IServPending

    runWithPipes :: (CreateProcess -> IO ProcessHandle)
                 -> FilePath -> [String] -> IO (ProcessHandle, Handle, Handle)
    #if defined(mingw32_HOST_OS)
    foreign import ccall "io.h _close"
       c__close :: CInt -> IO CInt

    foreign import ccall unsafe "io.h _get_osfhandle"
       _get_osfhandle :: CInt -> IO CInt

    runWithPipes createProc prog opts = do
        (rfd1, wfd1) <- createPipeFd -- we read on rfd1
        (rfd2, wfd2) <- createPipeFd -- we write on wfd2
        wh_client    <- _get_osfhandle wfd1
        rh_client    <- _get_osfhandle rfd2
        let args = show wh_client : show rh_client : opts
        ph <- createProc (proc prog args)
        rh <- mkHandle rfd1
        wh <- mkHandle wfd2
        return (ph, rh, wh)
          where mkHandle :: CInt -> IO Handle
                mkHandle fd = (fdToHandle fd) `Ex.onException` (c__close fd)

    #else
    runWithPipes :: (CreateProcess -> IO ProcessHandle)
    -> String -> [String] -> IO (ProcessHandle, Handle, Handle)
    runWithPipes CreateProcess -> IO ProcessHandle
    createProc String
    prog [String]
    opts = do
        (Fd
    rfd1, Fd
    wfd1) <- IO (Fd, Fd)
    Posix.createPipe -- we read on rfd1
        (Fd
    rfd2, Fd
    wfd2) <- IO (Fd, Fd)
    Posix.createPipe -- we write on wfd2
        Fd -> FdOption -> Bool -> IO ()
    setFdOption Fd
    rfd1 FdOption
    CloseOnExec Bool
    True
        Fd -> FdOption -> Bool -> IO ()
    setFdOption Fd
    wfd2 FdOption
    CloseOnExec Bool
    True
        let args :: [String]
    args = Fd -> String
    forall a. Show a => a -> String
    show Fd
    wfd1 String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : Fd -> String
    forall a. Show a => a -> String
    show Fd
    rfd2 String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    opts
        ProcessHandle
    ph <- CreateProcess -> IO ProcessHandle
    createProc (String -> [String] -> CreateProcess
    proc String
    prog [String]
    args)
        Fd -> IO ()
    closeFd Fd
    wfd1
        Fd -> IO ()
    closeFd Fd
    rfd2
        Handle
    rh <- Fd -> IO Handle
    fdToHandle Fd
    rfd1
        Handle
    wh <- Fd -> IO Handle
    fdToHandle Fd
    wfd2
        (ProcessHandle, Handle, Handle)
    -> IO (ProcessHandle, Handle, Handle)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ProcessHandle
    ph, Handle
    rh, Handle
    wh)
    #endif

    -- -----------------------------------------------------------------------------
    {- Note [External GHCi pointers]

    We have the following ways to reference things in GHCi:

    HValue
    ------

    HValue is a direct reference to a value in the local heap.  Obviously
    we cannot use this to refer to things in the external process.

    RemoteRef
    ---------

    RemoteRef is a StablePtr to a heap-resident value.  When
    -fexternal-interpreter is used, this value resides in the external
    process's heap.  RemoteRefs are mostly used to send pointers in
    messages between GHC and iserv.

    A RemoteRef must be explicitly freed when no longer required, using
    freeHValueRefs, or by attaching a finalizer with mkForeignHValue.

    To get from a RemoteRef to an HValue you can use 'wormholeRef', which
    fails with an error message if -fexternal-interpreter is in use.

    ForeignRef
    ----------

    A ForeignRef is a RemoteRef with a finalizer that will free the
    'RemoteRef' when it is garbage collected.  We mostly use ForeignHValue
    on the GHC side.

    The finalizer adds the RemoteRef to the iservPendingFrees list in the
    IServ record.  The next call to interpCmd will free any RemoteRefs in
    the list.  It was done this way rather than calling interpCmd directly,
    because I didn't want to have arbitrary threads calling interpCmd.  In
    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 :: Interp -> RemoteRef a -> IO (ForeignRef a)
    mkFinalizedHValue :: forall a. Interp -> RemoteRef a -> IO (ForeignRef a)
    mkFinalizedHValue Interp
    interp RemoteRef a
    rref = do
       let hvref :: HValueRef
    hvref = RemoteRef a -> HValueRef
    forall a. RemoteRef a -> HValueRef
    toHValueRef RemoteRef a
    rref

       IO ()
    free <- case Interp -> InterpInstance
    interpInstance Interp
    interp of
    #if defined(HAVE_INTERNAL_INTERPRETER)
          InterpInstance
    InternalInterp             -> IO () -> IO (IO ())
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HValueRef -> IO ()
    forall a. RemoteRef a -> IO ()
    freeRemoteRef HValueRef
    hvref)
    #endif
          ExternalInterp IServConfig
    _ (IServ MVar IServState
    i) -> IO () -> IO (IO ())
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO () -> IO (IO ())) -> IO () -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $ MVar IServState -> (IServState -> IO IServState) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar IServState
    i ((IServState -> IO IServState) -> IO ())
    -> (IServState -> IO IServState) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \IServState
    state ->
           case IServState
    state of
             IServPending {}   -> IServState -> IO IServState
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure IServState
    state -- already shut down
             IServRunning IServInstance
    inst -> do
                let !inst' :: IServInstance
    inst' = IServInstance
    inst {iservPendingFrees :: [HValueRef]
    iservPendingFrees = HValueRef
    hvrefHValueRef -> [HValueRef] -> [HValueRef]
    forall a. a -> [a] -> [a]
    :IServInstance -> [HValueRef]
    iservPendingFrees IServInstance
    inst}
                IServState -> IO IServState
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (IServInstance -> IServState
    IServRunning IServInstance
    inst')

       RemoteRef a -> IO () -> IO (ForeignRef a)
    forall a. RemoteRef a -> IO () -> IO (ForeignRef a)
    mkForeignRef RemoteRef a
    rref IO ()
    free

    freeHValueRefs :: Interp -> [HValueRef] -> IO ()
    freeHValueRefs :: Interp -> [HValueRef] -> IO ()
    freeHValueRefs Interp
    _ [] = () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    freeHValueRefs Interp
    interp [HValueRef]
    refs = Interp -> Message () -> IO ()
    forall a. Binary a => Interp -> Message a -> IO a
    interpCmd Interp
    interp ([HValueRef] -> Message ()
    FreeHValueRefs [HValueRef]
    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 :: Interp -> ForeignRef a -> IO a
    wormhole :: forall a. Interp -> ForeignRef a -> IO a
    wormhole Interp
    interp ForeignRef a
    r = Interp -> RemoteRef a -> IO a
    forall a. Interp -> RemoteRef a -> IO a
    wormholeRef Interp
    interp (ForeignRef a -> RemoteRef a
    forall a. ForeignRef a -> RemoteRef a
    unsafeForeignRefToRemoteRef ForeignRef a
    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 :: Interp -> RemoteRef a -> IO a
    wormholeRef :: forall a. Interp -> RemoteRef a -> IO a
    wormholeRef Interp
    interp RemoteRef a
    _r = case Interp -> InterpInstance
    interpInstance Interp
    interp of
    #if defined(HAVE_INTERNAL_INTERPRETER)
      InterpInstance
    InternalInterp -> RemoteRef a -> IO a
    forall a. RemoteRef a -> IO a
    localRef RemoteRef a
    _r
    #endif
      ExternalInterp {}
        -> GhcException -> IO a
    forall e a. Exception e => e -> IO a
    throwIO (String -> GhcException
    InstallationError String
    "this operation requires -fno-external-interpreter")

    -- -----------------------------------------------------------------------------
    -- Misc utils

    mkEvalOpts :: DynFlags -> Bool -> EvalOpts
    mkEvalOpts :: DynFlags -> Bool -> EvalOpts
    mkEvalOpts DynFlags
    dflags Bool
    step =
      EvalOpts
        { useSandboxThread :: Bool
    useSandboxThread = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_GhciSandbox DynFlags
    dflags
        , singleStep :: Bool
    singleStep = Bool
    step
        , breakOnException :: Bool
    breakOnException = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_BreakOnException DynFlags
    dflags
        , breakOnError :: Bool
    breakOnError = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_BreakOnError DynFlags
    dflags }

    fromEvalResult :: EvalResult a -> IO a
    fromEvalResult :: forall a. EvalResult a -> IO a
    fromEvalResult (EvalException SerializableException
    e) = SomeException -> IO a
    forall e a. Exception e => e -> IO a
    throwIO (SerializableException -> SomeException
    fromSerializableException SerializableException
    e)
    fromEvalResult (EvalSuccess a
    a) = a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

    getModBreaks :: HomeModInfo -> ModBreaks
    getModBreaks :: HomeModInfo -> ModBreaks
    getModBreaks HomeModInfo
    hmi
      | Just Linkable
    linkable <- HomeModInfo -> Maybe Linkable
    hm_linkable HomeModInfo
    hmi,
        [CompiledByteCode
    cbc] <- (Unlinked -> Maybe CompiledByteCode)
    -> [Unlinked] -> [CompiledByteCode]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Unlinked -> Maybe CompiledByteCode
    onlyBCOs ([Unlinked] -> [CompiledByteCode])
    -> [Unlinked] -> [CompiledByteCode]
    forall a b. (a -> b) -> a -> b
    $ Linkable -> [Unlinked]
    linkableUnlinked Linkable
    linkable
      = ModBreaks -> Maybe ModBreaks -> ModBreaks
    forall a. a -> Maybe a -> a
    fromMaybe ModBreaks
    emptyModBreaks (CompiledByteCode -> Maybe ModBreaks
    bc_breaks CompiledByteCode
    cbc)
      | Bool
    otherwise
      = ModBreaks
    emptyModBreaks -- probably object code
      where
        -- The linkable may have 'DotO's as well; only consider BCOs. See #20570.
        onlyBCOs :: Unlinked -> Maybe CompiledByteCode
        onlyBCOs :: Unlinked -> Maybe CompiledByteCode
    onlyBCOs (BCOs CompiledByteCode
    cbc [SptEntry]
    _) = CompiledByteCode -> Maybe CompiledByteCode
    forall a. a -> Maybe a
    Just CompiledByteCode
    cbc
        onlyBCOs Unlinked
    _            = Maybe CompiledByteCode
    forall a. Maybe a
    Nothing

    -- | Interpreter uses Profiling way
    interpreterProfiled :: Interp -> Bool
    interpreterProfiled :: Interp -> Bool
    interpreterProfiled Interp
    interp = case Interp -> InterpInstance
    interpInstance Interp
    interp of
    #if defined(HAVE_INTERNAL_INTERPRETER)
      InterpInstance
    InternalInterp     -> Bool
    hostIsProfiled
    #endif
      ExternalInterp IServConfig
    c IServ
    _ -> IServConfig -> Bool
    iservConfProfiled IServConfig
    c

    -- | Interpreter uses Dynamic way
    interpreterDynamic :: Interp -> Bool
    interpreterDynamic :: Interp -> Bool
    interpreterDynamic Interp
    interp = case Interp -> InterpInstance
    interpInstance Interp
    interp of
    #if defined(HAVE_INTERNAL_INTERPRETER)
      InterpInstance
    InternalInterp     -> Bool
    hostIsDynamic
    #endif
      ExternalInterp IServConfig
    c IServ
    _ -> IServConfig -> Bool
    iservConfDynamic IServConfig
    c