-- -----------------------------------------------------------------------------
--
-- (c) The University of Glasgow, 2005-2007
--
-- Running statements interactively
--
-- -----------------------------------------------------------------------------

module GHC.Runtime.Eval.Types (
        Resume(..), ResumeBindings, IcGlobalRdrEnv(..),
        History(..), ExecResult(..),
        SingleStep(..), enableGhcStepMode, breakHere,
        ExecOptions(..)
        ) where

import GHC.Prelude

import GHCi.RemoteTypes
import GHCi.Message (EvalExpr, ResumeContext)
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.TyThing
import GHC.Types.Breakpoint
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
import GHC.Utils.Exception

import Data.Word
import GHC.Stack.CCS

data ExecOptions
 = ExecOptions
     { ExecOptions -> SingleStep
execSingleStep :: SingleStep         -- ^ stepping mode
     , ExecOptions -> String
execSourceFile :: String             -- ^ filename (for errors)
     , ExecOptions -> Int
execLineNumber :: Int                -- ^ line number (for errors)
     , ExecOptions -> ForeignHValue -> EvalExpr ForeignHValue
execWrap :: ForeignHValue -> EvalExpr ForeignHValue
     }

-- | What kind of stepping are we doing?
data SingleStep
   = RunToCompletion

   -- | :trace [expr]
   | RunAndLogSteps

   -- | :step [expr]
   | SingleStep

   -- | :steplocal [expr]
   | LocalStep
      { SingleStep -> SrcSpan
breakAt :: SrcSpan }

   -- | :stepmodule [expr]
   | ModuleStep
      { breakAt :: SrcSpan }

-- | Whether this 'SingleStep' mode requires instructing the interpreter to
-- step at every breakpoint.
enableGhcStepMode :: SingleStep -> Bool
enableGhcStepMode :: SingleStep -> Bool
enableGhcStepMode SingleStep
RunToCompletion = Bool
False
enableGhcStepMode SingleStep
_ = Bool
True

-- | Given a 'SingleStep' mode and the SrcSpan of a breakpoint we hit, return
-- @True@ if based on the step-mode alone we should stop at this breakpoint.
--
-- In particular, this will always be @False@ for @'RunToCompletion'@ and
-- @'RunAndLogSteps'@. We'd need further information e.g. about the user
-- breakpoints to determine whether to break in those modes.
breakHere :: SingleStep -> SrcSpan -> Bool
breakHere :: SingleStep -> SrcSpan -> Bool
breakHere SingleStep
step SrcSpan
break_span = case SingleStep
step of
  SingleStep
RunToCompletion -> Bool
False
  SingleStep
RunAndLogSteps  -> Bool
False
  SingleStep
SingleStep      -> Bool
True
  LocalStep  SrcSpan
span -> SrcSpan
break_span SrcSpan -> SrcSpan -> Bool
`isSubspanOf` SrcSpan
span
  ModuleStep SrcSpan
span -> SrcSpan -> Maybe FastString
srcSpanFileName_maybe SrcSpan
span Maybe FastString -> Maybe FastString -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan -> Maybe FastString
srcSpanFileName_maybe SrcSpan
break_span

data ExecResult

  -- | Execution is complete
  = ExecComplete
       { ExecResult -> Either SomeException [Name]
execResult :: Either SomeException [Name]
       , ExecResult -> Word64
execAllocation :: Word64
       }

    -- | Execution stopped at a breakpoint.
    --
    -- Note: `ExecBreak` is only returned by `handleRunStatus` when GHCi should
    -- definitely stop at this breakpoint. GHCi is /not/ responsible for
    -- subsequently deciding whether to really stop here.
    -- `ExecBreak` always means GHCi breaks.
    | ExecBreak
       { ExecResult -> [Name]
breakNames   :: [Name]
       , ExecResult -> Maybe InternalBreakpointId
breakPointId :: Maybe InternalBreakpointId
       }

-- | Essentially a GlobalRdrEnv, but with additional cached values to allow
-- efficient re-calculation when the imports change.
-- Fields are strict to avoid space leaks (see T4029)
-- All operations are in GHC.Runtime.Context.
-- See Note [icReaderEnv recalculation]
data IcGlobalRdrEnv = IcGlobalRdrEnv
  { IcGlobalRdrEnv -> GlobalRdrEnv
igre_env :: !GlobalRdrEnv
    -- ^ The final environment
  , IcGlobalRdrEnv -> GlobalRdrEnv
igre_prompt_env :: !GlobalRdrEnv
    -- ^ Just the things defined at the prompt (excluding imports!)
  }

data Resume = Resume
       { Resume -> String
resumeStmt      :: String       -- the original statement
       , Resume -> ForeignRef (ResumeContext [HValueRef])
resumeContext   :: ForeignRef (ResumeContext [HValueRef])
       , Resume -> ResumeBindings
resumeBindings  :: ResumeBindings
       , Resume -> [Id]
resumeFinalIds  :: [Id]         -- [Id] to bind on completion
       , Resume -> ForeignHValue
resumeApStack   :: ForeignHValue -- The object from which we can get
                                        -- value of the free variables.
       , Resume -> Maybe InternalBreakpointId
resumeBreakpointId :: Maybe InternalBreakpointId
                                        -- ^ the breakpoint we stopped at
                                        -- (Nothing <=> exception)
       , Resume -> SrcSpan
resumeSpan      :: SrcSpan     -- just a copy of the SrcSpan
                                        -- from the ModBreaks,
                                        -- otherwise it's a pain to
                                        -- fetch the ModDetails &
                                        -- ModBreaks to get this.
       , Resume -> String
resumeDecl      :: String       -- ditto
       , Resume -> RemotePtr CostCentreStack
resumeCCS       :: RemotePtr CostCentreStack
       , Resume -> [History]
resumeHistory   :: [History]
       , Resume -> Int
resumeHistoryIx :: Int           -- 0 <==> at the top of the history
       }

type ResumeBindings = ([TyThing], IcGlobalRdrEnv)

data History = History
  { History -> ForeignHValue
historyApStack        :: ForeignHValue
  , History -> InternalBreakpointId
historyBreakpointId   :: InternalBreakpointId -- ^ breakpoint identifier
  , History -> [String]
historyEnclosingDecls :: [String]             -- ^ declarations enclosing the breakpoint
  }