import GHC.Prelude

 import GHCi.RemoteTypes

 import GHC.ByteCode.Types (InternalBreakpointId(..))

 import GHC.Driver.Config (EvalStep(..))

 import GHC.Types.Id

 import Data.Word

 import GHC.Stack.CCS

 data ExecOptions

  = ExecOptions

 data Resume = Resume

        { resumeStmt      :: String       -- the original statement

        , resumeBindings  :: ResumeBindings

        , resumeFinalIds  :: [Id]         -- [Id] to bind on completion

        , resumeApStack   :: ForeignHValue -- The object from which we can get

 resumeStmt

   :: Interp

   -> EvalOpts

   -> IO (EvalStatus_ [ForeignHValue] [HValueRef])

     interpCmd interp (ResumeStmt opts rhv)

   handleEvalStatus interp status

     interpCmd interp (AbandonStmt rhv)

 handleEvalStatus

   , SerializableException(..)

   , toSerializableException, fromSerializableException

   , THResult(..), THResultType(..)

   , QState(..)

   , getMessage, putMessage, getTHMessage, putTHMessage

   , Pipe, mkPipeFromHandles, mkPipeFromContinuations, remoteCall, remoteTHCall, readPipe, writePipe

   -- | Resume evaluation of a statement after a breakpoint

   ResumeStmt

    :: EvalOpts

    -> Message (EvalStatus [HValueRef])

   -- | Abandon evaluation of a statement after a breakpoint

   AbandonStmt

    -> Message ()

   -- | Evaluate something of type @IO String@

   -- | Resume forcing a free variable in a breakpoint (#2950)

   ResumeSeq

     -> Message (EvalStatus ())

   -- | User-defined request encoded as a tag/payload pair.  This is left

 instance Binary EvalOpts

 -- | We can pass simple expressions to EvalStmt, consisting of values

 -- and application.  This allows us to wrap the statement to be

 -- executed in another function, which is used by GHCi to implement

   | EvalBreak

        HValueRef{- AP_STACK -}

        (Maybe EvalBreakpoint)

        (RemotePtr CostCentreStack) -- Cost centre stack

   deriving (Generic, Show)

 {-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP,

     UnboxedTuples, LambdaCase, UnliftedFFITypes #-}

 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}

 -- |

 -- Execute GHCi messages.

 import GHCi.BreakArray

 import GHCi.StaticPtrTable

 import Control.Concurrent

 import Control.DeepSeq

 import Control.Exception

 -- information about the breakpoint than the current iserv

 -- process.

 doSeq :: RemoteRef a -> IO (EvalStatus ())

     sandboxIO evalOptsSeq $ do

       _ <- (void $ evaluate =<< localRef ref)

 -- | Process a ResumeSeq message. Continue the :force processing     #2950

 -- after a breakpoint.

       mask_ $ do

         putMVar resumeBreakMVar () -- this awakens the stopped thread...

 evalOptsSeq :: EvalOpts

 evalOptsSeq = EvalOpts

 -- only while we execute the user's code.  We can't afford to lose the final

 -- putMVar, otherwise deadlock ensues. (#1583, #1922, #1946)

 sandboxIO opts io = do

   -- We are running in uninterruptibleMask

     let runIt = measureAlloc $ tryEval $ rethrow opts $ clearCCS io

     if useSandboxThread opts

        then do

          tid <- forkIO $ do

            tid <- myThreadId

            labelThread tid "GHCi sandbox"

                                 -- empty: can't block

        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

 -- 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.

                 -> Maybe ThreadId -- ^ If resuming, the current threadId

                 -> IO a -> IO a

  = bracket setBreakAction resetBreakAction (\_ -> act)

  where

    setBreakAction = do

      when (breakOnException opts) $ poke exceptionFlag 1

      when (stepOut opts) $ do

       case mtid of

         Nothing -> rts_enableStopNextBreakpointAll -- just enable single-step when no thread is stopped

         Just (ThreadId tid) -> do

           rts_enableStopAfterReturn tid

         -- 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.

      poke exceptionFlag 0

      rts_disableStopNextBreakpointAll

      case mtid of

       Just (ThreadId tid) -> rts_disableStopAfterReturn tid

       _                   -> pure ()

 resumeStmt

   -> IO (EvalStatus [HValueRef])

     mask_ $ do

       putMVar resumeBreakMVar () -- this awakens the stopped thread...

       redirectInterrupts resumeThreadId $ takeMVar resumeStatusMVar

 --          step is necessary to prevent race conditions with

 --          -fbreak-on-exception (see #5975).

 --  See test break010.

 abandonStmt hvref = do

   putMVar resumeBreakMVar ()

   _ <- takeMVar resumeStatusMVar

   return ()

 -- Malloc and copy the bytes.  We don't have any way to monitor the

 -- lifetime of this memory, so it just leaks.

             case ok of

               0# -> return Nothing -- AP_STACK not found

               _  -> return (Just (unsafeCoerce# result))