    {-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP,
        UnboxedTuples #-}
    {-# OPTIONS_GHC -fno-warn-name-shadowing #-}

    -- |
    -- Execute GHCi messages.
    --
    -- For details on Remote GHCi, see Note [Remote GHCi] in
    -- compiler/GHC/Runtime/Interpreter.hs.
    --
    module GHCi.Run
      ( run, redirectInterrupts
      ) where

    import Prelude -- See note [Why do we import Prelude here?]
    import GHCi.CreateBCO
    import GHCi.InfoTable
    import GHCi.FFI
    import GHCi.Message
    import GHCi.ObjLink
    import GHCi.RemoteTypes
    import GHCi.TH
    import GHCi.BreakArray
    import GHCi.StaticPtrTable

    import Control.Concurrent
    import Control.DeepSeq
    import Control.Exception
    import Control.Monad
    import Data.Binary
    import Data.Binary.Get
    import Data.ByteString (ByteString)
    import qualified Data.ByteString.Unsafe as B
    import GHC.Exts
    import qualified GHC.Exts.Heap as Heap
    import GHC.Stack
    import Foreign hiding (void)
    import Foreign.C
    import GHC.Conc.Sync
    import GHC.IO hiding ( bracket )
    import System.Mem.Weak  ( deRefWeak )
    import Unsafe.Coerce

    -- -----------------------------------------------------------------------------
    -- Implement messages

    foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()
            -- Make it "safe", just in case

    run :: Message a -> IO a
    run :: forall a. Message a -> IO a
    run Message a
    m = case Message a
    m of
      Message a
    InitLinker -> ShouldRetainCAFs -> IO ()
    initObjLinker ShouldRetainCAFs
    RetainCAFs
      Message a
    RtsRevertCAFs -> IO ()
    rts_revertCAFs
      LookupSymbol String
    str -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap forall a. Ptr a -> RemotePtr a
    toRemotePtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall a. String -> IO (Maybe (Ptr a))
    lookupSymbol String
    str
      LookupClosure String
    str -> String -> IO (Maybe HValueRef)
    lookupClosure String
    str
      LoadDLL String
    str -> String -> IO (Maybe String)
    loadDLL String
    str
      LoadArchive String
    str -> String -> IO ()
    loadArchive String
    str
      LoadObj String
    str -> String -> IO ()
    loadObj String
    str
      UnloadObj String
    str -> String -> IO ()
    unloadObj String
    str
      AddLibrarySearchPath String
    str -> forall a. Ptr a -> RemotePtr a
    toRemotePtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO (Ptr ())
    addLibrarySearchPath String
    str
      RemoveLibrarySearchPath RemotePtr ()
    ptr -> Ptr () -> IO Bool
    removeLibrarySearchPath (forall a. RemotePtr a -> Ptr a
    fromRemotePtr RemotePtr ()
    ptr)
      Message a
    ResolveObjs -> IO Bool
    resolveObjs
      FindSystemLibrary String
    str -> String -> IO (Maybe String)
    findSystemLibrary String
    str
      CreateBCOs [ByteString]
    bcos -> [ResolvedBCO] -> IO [HValueRef]
    createBCOs (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (forall a. Get a -> ByteString -> a
    runGet forall t. Binary t => Get t
    get) [ByteString]
    bcos)
      FreeHValueRefs [HValueRef]
    rs -> forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ forall a. RemoteRef a -> IO ()
    freeRemoteRef [HValueRef]
    rs
      AddSptEntry Fingerprint
    fpr HValueRef
    r -> forall a. RemoteRef a -> IO a
    localRef HValueRef
    r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Fingerprint -> HValue -> IO ()
    sptAddEntry Fingerprint
    fpr
      EvalStmt EvalOpts
    opts EvalExpr HValueRef
    r -> EvalOpts
    -> EvalExpr HValueRef -> IO (EvalStatus_ [HValueRef] [HValueRef])
    evalStmt EvalOpts
    opts EvalExpr HValueRef
    r
      ResumeStmt EvalOpts
    opts RemoteRef (ResumeContext [HValueRef])
    r -> EvalOpts
    -> RemoteRef (ResumeContext [HValueRef])
    -> IO (EvalStatus_ [HValueRef] [HValueRef])
    resumeStmt EvalOpts
    opts RemoteRef (ResumeContext [HValueRef])
    r
      AbandonStmt RemoteRef (ResumeContext [HValueRef])
    r -> RemoteRef (ResumeContext [HValueRef]) -> IO ()
    abandonStmt RemoteRef (ResumeContext [HValueRef])
    r
      EvalString HValueRef
    r -> HValueRef -> IO (EvalResult String)
    evalString HValueRef
    r
      EvalStringToString HValueRef
    r String
    s -> HValueRef -> String -> IO (EvalResult String)
    evalStringToString HValueRef
    r String
    s
      EvalIO HValueRef
    r -> HValueRef -> IO (EvalResult ())
    evalIO HValueRef
    r
      MkCostCentres String
    mod [(String, String)]
    ccs -> String -> [(String, String)] -> IO [RemotePtr CostCentre]
    mkCostCentres String
    mod [(String, String)]
    ccs
      CostCentreStackInfo RemotePtr CostCentreStack
    ptr -> Ptr CostCentreStack -> IO [String]
    ccsToStrings (forall a. RemotePtr a -> Ptr a
    fromRemotePtr RemotePtr CostCentreStack
    ptr)
      NewBreakArray Int
    sz -> forall a. a -> IO (RemoteRef a)
    mkRemoteRef forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Int -> IO BreakArray
    newBreakArray Int
    sz
      SetupBreakpoint RemoteRef BreakArray
    ref Int
    ix Int
    cnt -> do
        BreakArray
    arr <- forall a. RemoteRef a -> IO a
    localRef RemoteRef BreakArray
    ref;
        Bool
    _ <- BreakArray -> Int -> Int -> IO Bool
    setupBreakpoint BreakArray
    arr Int
    ix Int
    cnt
        forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      BreakpointStatus RemoteRef BreakArray
    ref Int
    ix -> do
        BreakArray
    arr <- forall a. RemoteRef a -> IO a
    localRef RemoteRef BreakArray
    ref; Maybe Int
    r <- BreakArray -> Int -> IO (Maybe Int)
    getBreak BreakArray
    arr Int
    ix
        case Maybe Int
    r of
          Maybe Int
    Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
          Just Int
    w -> forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    w forall a. Eq a => a -> a -> Bool
    == Int
    0)
      GetBreakpointVar HValueRef
    ref Int
    ix -> do
        HValue
    aps <- forall a. RemoteRef a -> IO a
    localRef HValueRef
    ref
        forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM forall a. a -> IO (RemoteRef a)
    mkRemoteRef forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< HValue -> Int -> IO (Maybe HValue)
    getIdValFromApStack HValue
    aps Int
    ix
      MallocData ByteString
    bs -> ByteString -> IO (RemotePtr ())
    mkString ByteString
    bs
      MallocStrings [ByteString]
    bss -> forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ByteString -> IO (RemotePtr ())
    mkString0 [ByteString]
    bss
      PrepFFI FFIConv
    conv [FFIType]
    args FFIType
    res -> forall a. Ptr a -> RemotePtr a
    toRemotePtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FFIConv -> [FFIType] -> FFIType -> IO (Ptr C_ffi_cif)
    prepForeignCall FFIConv
    conv [FFIType]
    args FFIType
    res
      FreeFFI RemotePtr C_ffi_cif
    p -> Ptr C_ffi_cif -> IO ()
    freeForeignCallInfo (forall a. RemotePtr a -> Ptr a
    fromRemotePtr RemotePtr C_ffi_cif
    p)
      MkConInfoTable Bool
    tc Int
    ptrs Int
    nptrs Int
    tag Int
    ptrtag ByteString
    desc ->
        forall a. Ptr a -> RemotePtr a
    toRemotePtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool
    -> Int -> Int -> Int -> Int -> ByteString -> IO (Ptr StgInfoTable)
    mkConInfoTable Bool
    tc Int
    ptrs Int
    nptrs Int
    tag Int
    ptrtag ByteString
    desc
      Message a
    StartTH -> IO (RemoteRef (IORef QState))
    startTH
      GetClosure HValueRef
    ref -> do
        Closure
    clos <- forall a. HasHeapRep a => a -> IO Closure
    Heap.getClosureData forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< forall a. RemoteRef a -> IO a
    localRef HValueRef
    ref
        forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (\(Heap.Box Any
    x) -> forall a. a -> IO (RemoteRef a)
    mkRemoteRef (Any -> HValue
    HValue Any
    x)) Closure
    clos
      Seq HValueRef
    ref -> forall a. RemoteRef a -> IO (EvalStatus_ () ())
    doSeq HValueRef
    ref
      ResumeSeq RemoteRef (ResumeContext ())
    ref -> RemoteRef (ResumeContext ()) -> IO (EvalStatus_ () ())
    resumeSeq RemoteRef (ResumeContext ())
    ref
      Message a
    _other -> forall a. HasCallStack => String -> a
    error String
    "GHCi.Run.run"

    evalStmt :: EvalOpts -> EvalExpr HValueRef -> IO (EvalStatus [HValueRef])
    evalStmt :: EvalOpts
    -> EvalExpr HValueRef -> IO (EvalStatus_ [HValueRef] [HValueRef])
    evalStmt EvalOpts
    opts EvalExpr HValueRef
    expr = do
      HValue
    io <- EvalExpr HValueRef -> IO HValue
    mkIO EvalExpr HValueRef
    expr
      forall a. EvalOpts -> IO a -> IO (EvalStatus a)
    sandboxIO EvalOpts
    opts forall a b. (a -> b) -> a -> b
    $ do
        [HValue]
    rs <- forall a b. a -> b
    unsafeCoerce HValue
    io :: IO [HValue]
        forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM forall a. a -> IO (RemoteRef a)
    mkRemoteRef [HValue]
    rs
     where
      mkIO :: EvalExpr HValueRef -> IO HValue
    mkIO (EvalThis HValueRef
    href) = forall a. RemoteRef a -> IO a
    localRef HValueRef
    href
      mkIO (EvalApp EvalExpr HValueRef
    l EvalExpr HValueRef
    r) = do
        HValue
    l' <- EvalExpr HValueRef -> IO HValue
    mkIO EvalExpr HValueRef
    l
        HValue
    r' <- EvalExpr HValueRef -> IO HValue
    mkIO EvalExpr HValueRef
    r
        forall (m :: * -> *) a. Monad m => a -> m a
    return ((forall a b. a -> b
    unsafeCoerce HValue
    l' :: HValue -> HValue) HValue
    r')

    evalIO :: HValueRef -> IO (EvalResult ())
    evalIO :: HValueRef -> IO (EvalResult ())
    evalIO HValueRef
    r = do
      HValue
    io <- forall a. RemoteRef a -> IO a
    localRef HValueRef
    r
      forall a. IO a -> IO (EvalResult a)
    tryEval (forall a b. a -> b
    unsafeCoerce HValue
    io :: IO ())

    evalString :: HValueRef -> IO (EvalResult String)
    evalString :: HValueRef -> IO (EvalResult String)
    evalString HValueRef
    r = do
      HValue
    io <- forall a. RemoteRef a -> IO a
    localRef HValueRef
    r
      forall a. IO a -> IO (EvalResult a)
    tryEval forall a b. (a -> b) -> a -> b
    $ do
        String
    r <- forall a b. a -> b
    unsafeCoerce HValue
    io :: IO String
        forall a. a -> IO a
    evaluate (forall a. NFData a => a -> a
    force String
    r)

    evalStringToString :: HValueRef -> String -> IO (EvalResult String)
    evalStringToString :: HValueRef -> String -> IO (EvalResult String)
    evalStringToString HValueRef
    r String
    str = do
      HValue
    io <- forall a. RemoteRef a -> IO a
    localRef HValueRef
    r
      forall a. IO a -> IO (EvalResult a)
    tryEval forall a b. (a -> b) -> a -> b
    $ do
        String
    r <- (forall a b. a -> b
    unsafeCoerce HValue
    io :: String -> IO String) String
    str
        forall a. a -> IO a
    evaluate (forall a. NFData a => a -> a
    force String
    r)

    -- | Process the Seq message to force a value.                       #2950
    -- If during this processing a breakpoint is hit, return
    -- an EvalBreak value in the EvalStatus to the UI process,
    -- otherwise return an EvalComplete.
    -- The UI process has more and therefore also can show more
    -- information about the breakpoint than the current iserv
    -- process.
    doSeq :: RemoteRef a -> IO (EvalStatus ())
    doSeq :: forall a. RemoteRef a -> IO (EvalStatus_ () ())
    doSeq RemoteRef a
    ref = do
        forall a. EvalOpts -> IO a -> IO (EvalStatus a)
    sandboxIO EvalOpts
    evalOptsSeq forall a b. (a -> b) -> a -> b
    $ do
          ()
    _ <- (forall (f :: * -> *) a. Functor f => f a -> f ()
    void forall a b. (a -> b) -> a -> b
    $ forall a. a -> IO a
    evaluate forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< forall a. RemoteRef a -> IO a
    localRef RemoteRef a
    ref)
          forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Process a ResumeSeq message. Continue the :force processing     #2950
    -- after a breakpoint.
    resumeSeq :: RemoteRef (ResumeContext ()) -> IO (EvalStatus ())
    resumeSeq :: RemoteRef (ResumeContext ()) -> IO (EvalStatus_ () ())
    resumeSeq RemoteRef (ResumeContext ())
    hvref = do
        ResumeContext{ThreadId
    MVar ()
    MVar (EvalStatus_ () ())
    resumeThreadId :: forall a. ResumeContext a -> ThreadId
    resumeStatusMVar :: forall a. ResumeContext a -> MVar (EvalStatus a)
    resumeBreakMVar :: forall a. ResumeContext a -> MVar ()
    resumeThreadId :: ThreadId
    resumeStatusMVar :: MVar (EvalStatus_ () ())
    resumeBreakMVar :: MVar ()
    ..} <- forall a. RemoteRef a -> IO a
    localRef RemoteRef (ResumeContext ())
    hvref
        forall b a.
    EvalOpts -> MVar () -> MVar (EvalStatus b) -> IO a -> IO a
    withBreakAction EvalOpts
    evalOptsSeq MVar ()
    resumeBreakMVar MVar (EvalStatus_ () ())
    resumeStatusMVar forall a b. (a -> b) -> a -> b
    $
          forall a. IO a -> IO a
    mask_ forall a b. (a -> b) -> a -> b
    $ do
            forall a. MVar a -> a -> IO ()
    putMVar MVar ()
    resumeBreakMVar () -- this awakens the stopped thread...
            forall a. ThreadId -> IO a -> IO a
    redirectInterrupts ThreadId
    resumeThreadId forall a b. (a -> b) -> a -> b
    $ forall a. MVar a -> IO a
    takeMVar MVar (EvalStatus_ () ())
    resumeStatusMVar

    evalOptsSeq :: EvalOpts
    evalOptsSeq :: EvalOpts
    evalOptsSeq = EvalOpts
                  { useSandboxThread :: Bool
    useSandboxThread = Bool
    True
                  , singleStep :: Bool
    singleStep = Bool
    False
                  , breakOnException :: Bool
    breakOnException = Bool
    False
                  , breakOnError :: Bool
    breakOnError = Bool
    False
                  }

    -- When running a computation, we redirect ^C exceptions to the running
    -- thread.  ToDo: we might want a way to continue even if the target
    -- thread doesn't die when it receives the exception... "this thread
    -- is not responding".
    --
    -- Careful here: there may be ^C exceptions flying around, so we start the new
    -- thread blocked (forkIO inherits mask from the parent, #1048), and unblock
    -- only while we execute the user's code.  We can't afford to lose the final
    -- putMVar, otherwise deadlock ensues. (#1583, #1922, #1946)

    sandboxIO :: EvalOpts -> IO a -> IO (EvalStatus a)
    sandboxIO :: forall a. EvalOpts -> IO a -> IO (EvalStatus a)
    sandboxIO EvalOpts
    opts IO a
    io = do
      -- We are running in uninterruptibleMask
      MVar ()
    breakMVar <- forall a. IO (MVar a)
    newEmptyMVar
      MVar (EvalStatus a)
    statusMVar <- forall a. IO (MVar a)
    newEmptyMVar
      forall b a.
    EvalOpts -> MVar () -> MVar (EvalStatus b) -> IO a -> IO a
    withBreakAction EvalOpts
    opts MVar ()
    breakMVar MVar (EvalStatus a)
    statusMVar forall a b. (a -> b) -> a -> b
    $ do
        let runIt :: IO (EvalStatus a)
    runIt = forall a. IO (EvalResult a) -> IO (EvalStatus a)
    measureAlloc forall a b. (a -> b) -> a -> b
    $ forall a. IO a -> IO (EvalResult a)
    tryEval forall a b. (a -> b) -> a -> b
    $ forall a. EvalOpts -> IO a -> IO a
    rethrow EvalOpts
    opts forall a b. (a -> b) -> a -> b
    $ forall a. IO a -> IO a
    clearCCS IO a
    io
        if EvalOpts -> Bool
    useSandboxThread EvalOpts
    opts
           then do
             ThreadId
    tid <- IO () -> IO ThreadId
    forkIO forall a b. (a -> b) -> a -> b
    $ do forall a. IO a -> IO a
    unsafeUnmask IO (EvalStatus a)
    runIt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= forall a. MVar a -> a -> IO ()
    putMVar MVar (EvalStatus a)
    statusMVar
                                    -- empty: can't block
             forall a. ThreadId -> IO a -> IO a
    redirectInterrupts ThreadId
    tid forall a b. (a -> b) -> a -> b
    $ forall a. IO a -> IO a
    unsafeUnmask forall a b. (a -> b) -> a -> b
    $ forall a. MVar a -> IO a
    takeMVar MVar (EvalStatus a)
    statusMVar
           else
              -- GLUT on OS X needs to run on the main thread. If you
              -- try to use it from another thread then you just get a
              -- white rectangle rendered. For this, or anything else
              -- with such restrictions, you can turn the GHCi sandbox off
              -- and things will be run in the main thread.
              --
              -- BUT, note that the debugging features (breakpoints,
              -- tracing, etc.) need the expression to be running in a
              -- separate thread, so debugging is only enabled when
              -- using the sandbox.
             IO (EvalStatus a)
    runIt

    -- We want to turn ^C into a break when -fbreak-on-exception is on,
    -- but it's an async exception and we only break for sync exceptions.
    -- Idea: if we catch and re-throw it, then the re-throw will trigger
    -- a break.  Great - but we don't want to re-throw all exceptions, because
    -- then we'll get a double break for ordinary sync exceptions (you'd have
    -- to :continue twice, which looks strange).  So if the exception is
    -- not "Interrupted", we unset the exception flag before throwing.
    --
    rethrow :: EvalOpts -> IO a -> IO a
    rethrow :: forall a. EvalOpts -> IO a -> IO a
    rethrow EvalOpts{Bool
    breakOnError :: Bool
    breakOnException :: Bool
    singleStep :: Bool
    useSandboxThread :: Bool
    breakOnError :: EvalOpts -> Bool
    breakOnException :: EvalOpts -> Bool
    singleStep :: EvalOpts -> Bool
    useSandboxThread :: EvalOpts -> Bool
    ..} IO a
    io =
      forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    catch IO a
    io forall a b. (a -> b) -> a -> b
    $ \SomeException
    se -> do
        -- If -fbreak-on-error, we break unconditionally,
        --  but with care of not breaking twice
        if Bool
    breakOnError Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    breakOnException
           then forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr CInt
    exceptionFlag CInt
    1
           else case forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    se of
                   -- If it is a "UserInterrupt" exception, we allow
                   --  a possible break by way of -fbreak-on-exception
                   Just AsyncException
    UserInterrupt -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                   -- In any other case, we don't want to break
                   Maybe AsyncException
    _ -> forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr CInt
    exceptionFlag CInt
    0
        forall e a. Exception e => e -> IO a
    throwIO SomeException
    se

    --
    -- While we're waiting for the sandbox thread to return a result, if
    -- the current thread receives an asynchronous exception we re-throw
    -- it at the sandbox thread and continue to wait.
    --
    -- This is for two reasons:
    --
    --  * So that ^C interrupts runStmt (e.g. in GHCi), allowing the
    --    computation to run its exception handlers before returning the
    --    exception result to the caller of runStmt.
    --
    --  * clients of the GHC API can terminate a runStmt in progress
    --    without knowing the ThreadId of the sandbox thread (#1381)
    --
    -- NB. use a weak pointer to the thread, so that the thread can still
    -- be considered deadlocked by the RTS and sent a BlockedIndefinitely
    -- exception.  A symptom of getting this wrong is that conc033(ghci)
    -- will hang.
    --
    redirectInterrupts :: ThreadId -> IO a -> IO a
    redirectInterrupts :: forall a. ThreadId -> IO a -> IO a
    redirectInterrupts ThreadId
    target IO a
    wait = do
      Weak ThreadId
    wtid <- ThreadId -> IO (Weak ThreadId)
    mkWeakThreadId ThreadId
    target
      IO a
    wait forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` \SomeException
    e -> do
         Maybe ThreadId
    m <- forall v. Weak v -> IO (Maybe v)
    deRefWeak Weak ThreadId
    wtid
         case Maybe ThreadId
    m of
           Maybe ThreadId
    Nothing -> IO a
    wait
           Just ThreadId
    target -> do forall e. Exception e => ThreadId -> e -> IO ()
    throwTo ThreadId
    target (SomeException
    e :: SomeException); IO a
    wait

    measureAlloc :: IO (EvalResult a) -> IO (EvalStatus a)
    measureAlloc :: forall a. IO (EvalResult a) -> IO (EvalStatus a)
    measureAlloc IO (EvalResult a)
    io = do
      Int64 -> IO ()
    setAllocationCounter Int64
    0                                 -- #16012
      EvalResult a
    a <- IO (EvalResult a)
    io
      Int64
    ctr <- IO Int64
    getAllocationCounter
      let allocs :: Word64
    allocs = forall a. Num a => a -> a
    negate forall a b. (a -> b) -> a -> b
    $ forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int64
    ctr
      forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a b. Word64 -> EvalResult a -> EvalStatus_ a b
    EvalComplete Word64
    allocs EvalResult a
    a)

    -- Exceptions can't be marshaled because they're dynamically typed, so
    -- everything becomes a String.
    tryEval :: IO a -> IO (EvalResult a)
    tryEval :: forall a. IO a -> IO (EvalResult a)
    tryEval IO a
    io = do
      Either SomeException a
    e <- forall e a. Exception e => IO a -> IO (Either e a)
    try IO a
    io
      case Either SomeException a
    e of
        Left SomeException
    ex -> forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. SerializableException -> EvalResult a
    EvalException (SomeException -> SerializableException
    toSerializableException SomeException
    ex))
        Right a
    a -> forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. a -> EvalResult a
    EvalSuccess a
    a)

    -- This function sets up the interpreter for catching breakpoints, and
    -- resets everything when the computation has stopped running.  This
    -- is a not-very-good way to ensure that only the interactive
    -- evaluation should generate breakpoints.
    withBreakAction :: EvalOpts -> MVar () -> MVar (EvalStatus b) -> IO a -> IO a
    withBreakAction :: forall b a.
    EvalOpts -> MVar () -> MVar (EvalStatus b) -> IO a -> IO a
    withBreakAction EvalOpts
    opts MVar ()
    breakMVar MVar (EvalStatus b)
    statusMVar IO a
    act
     = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket IO (StablePtr BreakpointCallback)
    setBreakAction forall {a}. StablePtr a -> IO ()
    resetBreakAction (\StablePtr BreakpointCallback
    _ -> IO a
    act)
     where
       setBreakAction :: IO (StablePtr BreakpointCallback)
    setBreakAction = do
         StablePtr BreakpointCallback
    stablePtr <- forall a. a -> IO (StablePtr a)
    newStablePtr BreakpointCallback
    onBreak
         forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr (StablePtr BreakpointCallback)
    breakPointIOAction StablePtr BreakpointCallback
    stablePtr
         forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (EvalOpts -> Bool
    breakOnException EvalOpts
    opts) forall a b. (a -> b) -> a -> b
    $ forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr CInt
    exceptionFlag CInt
    1
         forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (EvalOpts -> Bool
    singleStep EvalOpts
    opts) forall a b. (a -> b) -> a -> b
    $ IO ()
    setStepFlag
         forall (m :: * -> *) a. Monad m => a -> m a
    return StablePtr BreakpointCallback
    stablePtr
            -- Breaking on exceptions is not enabled by default, since it
            -- might be a bit surprising.  The exception flag is turned off
            -- as soon as it is hit, or in resetBreakAction below.

       onBreak :: BreakpointCallback
       onBreak :: BreakpointCallback
    onBreak Int#
    ix# Int#
    uniq# Bool
    is_exception HValue
    apStack = do
         ThreadId
    tid <- IO ThreadId
    myThreadId
         let resume :: ResumeContext b
    resume = ResumeContext
               { resumeBreakMVar :: MVar ()
    resumeBreakMVar = MVar ()
    breakMVar
               , resumeStatusMVar :: MVar (EvalStatus b)
    resumeStatusMVar = MVar (EvalStatus b)
    statusMVar
               , resumeThreadId :: ThreadId
    resumeThreadId = ThreadId
    tid }
         RemoteRef (ResumeContext b)
    resume_r <- forall a. a -> IO (RemoteRef a)
    mkRemoteRef ResumeContext b
    resume
         HValueRef
    apStack_r <- forall a. a -> IO (RemoteRef a)
    mkRemoteRef HValue
    apStack
         RemotePtr CostCentreStack
    ccs <- forall a. Ptr a -> RemotePtr a
    toRemotePtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall a. a -> IO (Ptr CostCentreStack)
    getCCSOf HValue
    apStack
         forall a. MVar a -> a -> IO ()
    putMVar MVar (EvalStatus b)
    statusMVar forall a b. (a -> b) -> a -> b
    $ forall a b.
    Bool
    -> HValueRef
    -> Int
    -> Int
    -> RemoteRef (ResumeContext b)
    -> RemotePtr CostCentreStack
    -> EvalStatus_ a b
    EvalBreak Bool
    is_exception HValueRef
    apStack_r (Int# -> Int
    I# Int#
    ix#) (Int# -> Int
    I# Int#
    uniq#) RemoteRef (ResumeContext b)
    resume_r RemotePtr CostCentreStack
    ccs
         forall a. MVar a -> IO a
    takeMVar MVar ()
    breakMVar

       resetBreakAction :: StablePtr a -> IO ()
    resetBreakAction StablePtr a
    stablePtr = do
         forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr (StablePtr BreakpointCallback)
    breakPointIOAction StablePtr BreakpointCallback
    noBreakStablePtr
         forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr CInt
    exceptionFlag CInt
    0
         IO ()
    resetStepFlag
         forall {a}. StablePtr a -> IO ()
    freeStablePtr StablePtr a
    stablePtr

    resumeStmt
      :: EvalOpts -> RemoteRef (ResumeContext [HValueRef])
      -> IO (EvalStatus [HValueRef])
    resumeStmt :: EvalOpts
    -> RemoteRef (ResumeContext [HValueRef])
    -> IO (EvalStatus_ [HValueRef] [HValueRef])
    resumeStmt EvalOpts
    opts RemoteRef (ResumeContext [HValueRef])
    hvref = do
      ResumeContext{ThreadId
    MVar ()
    MVar (EvalStatus_ [HValueRef] [HValueRef])
    resumeThreadId :: ThreadId
    resumeStatusMVar :: MVar (EvalStatus_ [HValueRef] [HValueRef])
    resumeBreakMVar :: MVar ()
    resumeThreadId :: forall a. ResumeContext a -> ThreadId
    resumeStatusMVar :: forall a. ResumeContext a -> MVar (EvalStatus a)
    resumeBreakMVar :: forall a. ResumeContext a -> MVar ()
    ..} <- forall a. RemoteRef a -> IO a
    localRef RemoteRef (ResumeContext [HValueRef])
    hvref
      forall b a.
    EvalOpts -> MVar () -> MVar (EvalStatus b) -> IO a -> IO a
    withBreakAction EvalOpts
    opts MVar ()
    resumeBreakMVar MVar (EvalStatus_ [HValueRef] [HValueRef])
    resumeStatusMVar forall a b. (a -> b) -> a -> b
    $
        forall a. IO a -> IO a
    mask_ forall a b. (a -> b) -> a -> b
    $ do
          forall a. MVar a -> a -> IO ()
    putMVar MVar ()
    resumeBreakMVar () -- this awakens the stopped thread...
          forall a. ThreadId -> IO a -> IO a
    redirectInterrupts ThreadId
    resumeThreadId forall a b. (a -> b) -> a -> b
    $ forall a. MVar a -> IO a
    takeMVar MVar (EvalStatus_ [HValueRef] [HValueRef])
    resumeStatusMVar

    -- when abandoning a computation we have to
    --      (a) kill the thread with an async exception, so that the
    --          computation itself is stopped, and
    --      (b) fill in the MVar.  This step is necessary because any
    --          thunks that were under evaluation will now be updated
    --          with the partial computation, which still ends in takeMVar,
    --          so any attempt to evaluate one of these thunks will block
    --          unless we fill in the MVar.
    --      (c) wait for the thread to terminate by taking its status MVar.  This
    --          step is necessary to prevent race conditions with
    --          -fbreak-on-exception (see #5975).
    --  See test break010.
    abandonStmt :: RemoteRef (ResumeContext [HValueRef]) -> IO ()
    abandonStmt :: RemoteRef (ResumeContext [HValueRef]) -> IO ()
    abandonStmt RemoteRef (ResumeContext [HValueRef])
    hvref = do
      ResumeContext{ThreadId
    MVar ()
    MVar (EvalStatus_ [HValueRef] [HValueRef])
    resumeThreadId :: ThreadId
    resumeStatusMVar :: MVar (EvalStatus_ [HValueRef] [HValueRef])
    resumeBreakMVar :: MVar ()
    resumeThreadId :: forall a. ResumeContext a -> ThreadId
    resumeStatusMVar :: forall a. ResumeContext a -> MVar (EvalStatus a)
    resumeBreakMVar :: forall a. ResumeContext a -> MVar ()
    ..} <- forall a. RemoteRef a -> IO a
    localRef RemoteRef (ResumeContext [HValueRef])
    hvref
      ThreadId -> IO ()
    killThread ThreadId
    resumeThreadId
      forall a. MVar a -> a -> IO ()
    putMVar MVar ()
    resumeBreakMVar ()
      EvalStatus_ [HValueRef] [HValueRef]
    _ <- forall a. MVar a -> IO a
    takeMVar MVar (EvalStatus_ [HValueRef] [HValueRef])
    resumeStatusMVar
      forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    foreign import ccall "&rts_stop_next_breakpoint" stepFlag      :: Ptr CInt
    foreign import ccall "&rts_stop_on_exception"    exceptionFlag :: Ptr CInt

    setStepFlag :: IO ()
    setStepFlag :: IO ()
    setStepFlag = forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr CInt
    stepFlag CInt
    1
    resetStepFlag :: IO ()
    resetStepFlag :: IO ()
    resetStepFlag = forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr CInt
    stepFlag CInt
    0

    type BreakpointCallback
         = Int#    -- the breakpoint index
        -> Int#    -- the module uniq
        -> Bool    -- exception?
        -> HValue  -- the AP_STACK, or exception
        -> IO ()

    foreign import ccall "&rts_breakpoint_io_action"
       breakPointIOAction :: Ptr (StablePtr BreakpointCallback)

    noBreakStablePtr :: StablePtr BreakpointCallback
    noBreakStablePtr :: StablePtr BreakpointCallback
    noBreakStablePtr = forall a. IO a -> a
    unsafePerformIO forall a b. (a -> b) -> a -> b
    $ forall a. a -> IO (StablePtr a)
    newStablePtr BreakpointCallback
    noBreakAction

    noBreakAction :: BreakpointCallback
    noBreakAction :: BreakpointCallback
    noBreakAction Int#
    _ Int#
    _ Bool
    False HValue
    _ = String -> IO ()
    putStrLn String
    "*** Ignoring breakpoint"
    noBreakAction Int#
    _ Int#
    _ Bool
    True  HValue
    _ = forall (m :: * -> *) a. Monad m => a -> m a
    return () -- exception: just continue

    -- Malloc and copy the bytes.  We don't have any way to monitor the
    -- lifetime of this memory, so it just leaks.
    mkString :: ByteString -> IO (RemotePtr ())
    mkString :: ByteString -> IO (RemotePtr ())
    mkString ByteString
    bs = forall a. ByteString -> (CStringLen -> IO a) -> IO a
    B.unsafeUseAsCStringLen ByteString
    bs forall a b. (a -> b) -> a -> b
    $ \(Ptr CChar
    cstr,Int
    len) -> do
      Ptr CChar
    ptr <- forall a. Int -> IO (Ptr a)
    mallocBytes Int
    len
      forall a. Ptr a -> Ptr a -> Int -> IO ()
    copyBytes Ptr CChar
    ptr Ptr CChar
    cstr Int
    len
      forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a b. RemotePtr a -> RemotePtr b
    castRemotePtr (forall a. Ptr a -> RemotePtr a
    toRemotePtr Ptr CChar
    ptr))

    mkString0 :: ByteString -> IO (RemotePtr ())
    mkString0 :: ByteString -> IO (RemotePtr ())
    mkString0 ByteString
    bs = forall a. ByteString -> (CStringLen -> IO a) -> IO a
    B.unsafeUseAsCStringLen ByteString
    bs forall a b. (a -> b) -> a -> b
    $ \(Ptr CChar
    cstr,Int
    len) -> do
      Ptr CChar
    ptr <- forall a. Int -> IO (Ptr a)
    mallocBytes (Int
    lenforall a. Num a => a -> a -> a
    +Int
    1)
      forall a. Ptr a -> Ptr a -> Int -> IO ()
    copyBytes Ptr CChar
    ptr Ptr CChar
    cstr Int
    len
      forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff (Ptr CChar
    ptr :: Ptr CChar) Int
    len CChar
    0
      forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a b. RemotePtr a -> RemotePtr b
    castRemotePtr (forall a. Ptr a -> RemotePtr a
    toRemotePtr Ptr CChar
    ptr))

    mkCostCentres :: String -> [(String,String)] -> IO [RemotePtr CostCentre]
    #if defined(PROFILING)
    mkCostCentres mod ccs = do
      c_module <- newCString mod
      mapM (mk_one c_module) ccs
     where
      mk_one c_module (decl_path,srcspan) = do
        c_name <- newCString decl_path
        c_srcspan <- newCString srcspan
        toRemotePtr <$> c_mkCostCentre c_name c_module c_srcspan

    foreign import ccall unsafe "mkCostCentre"
      c_mkCostCentre :: Ptr CChar -> Ptr CChar -> Ptr CChar -> IO (Ptr CostCentre)
    #else
    mkCostCentres :: String -> [(String, String)] -> IO [RemotePtr CostCentre]
    mkCostCentres String
    _ [(String, String)]
    _ = forall (m :: * -> *) a. Monad m => a -> m a
    return []
    #endif

    getIdValFromApStack :: HValue -> Int -> IO (Maybe HValue)
    getIdValFromApStack :: HValue -> Int -> IO (Maybe HValue)
    getIdValFromApStack HValue
    apStack (I# Int#
    stackDepth) = do
       case forall a b. a -> Int# -> (# Int#, b #)
    getApStackVal# HValue
    apStack Int#
    stackDepth of
            (# Int#
    ok, Any
    result #) ->
                case Int#
    ok of
                  Int#
    0# -> forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. Maybe a
    Nothing -- AP_STACK not found
                  Int#
    _  -> forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. a -> Maybe a
    Just (unsafeCoerce# :: forall a b. a -> b
    unsafeCoerce# Any
    result))