haskell-debugger-0.11.0.0: haskell-debugger/GHC/Debugger/Stopped.hs
{-# LANGUAGE CPP, NamedFieldPuns, TupleSections, LambdaCase,
DuplicateRecordFields, RecordWildCards, TupleSections, ViewPatterns,
TypeApplications, ScopedTypeVariables, BangPatterns #-}
module GHC.Debugger.Stopped where
import Control.Monad
import Control.Monad.Reader
import Data.IORef
import GHC.Stack.CloneStack as Stack
import GHC
import GHC.Types.Unique.FM
import GHC.Types.Name.Occurrence (sizeOccEnv)
import GHC.ByteCode.Breakpoints
import GHC.Types.Name.Reader
import GHC.Unit.Home.ModInfo
import GHC.Unit.Module.ModDetails
import GHC.Types.TypeEnv
import GHC.Data.Maybe
import GHC.Driver.Env as GHC
import GHC.Runtime.Debugger.Breakpoints as GHC
import GHC.Runtime.Eval
import GHC.Types.SrcLoc
import GHC.Utils.Outputable as Ppr
import qualified GHC.Unit.Home.Graph as HUG
import GHC.Debugger.Stopped.Variables
import GHC.Debugger.Runtime
import GHC.Debugger.Runtime.Thread
import GHC.Debugger.Runtime.Thread.Stack
import GHC.Debugger.Runtime.Thread.Map
import GHC.Debugger.Monad
import GHC.Debugger.Interface.Messages
import GHC.Debugger.Utils
import qualified GHC.Debugger.Logger as Logger
{-
Note [Don't crash if not stopped]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Requests such as `stacktrace`, `scopes`, or `variables` may end up
coming after the execution of a program has terminated. For instance,
consider this interleaving:
1. SENT Stopped event <-- we're stopped
2. RECEIVED StackTrace req <-- client issues after stopped event
3. RECEIVED Next req <-- user clicks step-next
4. <program execution resumes and fails>
5. SENT Terminate event <-- execution failed and we report it to exit cleanly
6. RECEIVED Scopes req <-- happens as a sequence of 2 that wasn't canceled
7. <used to crash! because we're no longer at a breakpoint>
Now, we simply returned empty responses when these requests come in
while we're no longer at a breakpoint. The client will soon come to a halt
because of the termination event we sent.
-}
--------------------------------------------------------------------------------
-- * Threads
--------------------------------------------------------------------------------
getThreads :: Debugger [DebuggeeThread]
getThreads = do
-- TODO: we want something more like 'listThreads', but ensure that we only
-- report the threads of the debuggee (and not the debugger, if they
-- are the same process). Perhaps the solution is to not allow them to be in
-- the same process, in which case 'listThreads' would be correct as is by
-- construction.
--
-- For now, we approximate by just listing out the ThreadsMap, under the
-- assumption the debugger client will only care about threads we've already
-- stopped at (which are the only ones we've inserted in the threads map),
-- but for full multi threaded debugging we need the listThreads.
--
-- tmap <- liftIO . readIORef =<< asks threadMap
-- let (t_ids, remote_refs) = unzip (threadMapToList tmap)
--
-- Oh, try the listThreads just for fun.
(t_ids, remote_refs) <- unzip <$> listAllLiveRemoteThreads
t_labels <- getRemoteThreadsLabels remote_refs
let
_mkDebuggeeThread tid tlbl
= DebuggeeThread
{ tId = tid
, tName = tlbl
}
_all_threads
= zipWith _mkDebuggeeThread t_ids t_labels
-- TODO: We ignore _all_threads and report only the main execution thread for now.
GHC.getResumeContext >>= \case
[] ->
-- See Note [Don't crash if not stopped]
return []
r:_ -> do
r_tid <- getRemoteThreadIdFromRemoteContext (GHC.resumeContext r)
return
[ DebuggeeThread
{ tId = r_tid
, tName = Just "Main Thread"
}
]
--------------------------------------------------------------------------------
-- * Stack trace
--------------------------------------------------------------------------------
-- | Get the stack frames at the point we're stopped at
getStacktrace :: RemoteThreadId -> Debugger [DbgStackFrame]
getStacktrace req_tid = do
tm <- liftIO . readIORef =<< asks threadMap
let m_f_tid = lookupThreadMap (remoteThreadIntRef req_tid) tm
ipe_stack <- case m_f_tid of
Nothing -> pure []
Just f_tid -> do
-- For now, assume that if we can get an IPE backtrace then this thread
-- is compiled and doesn't have any interpreter frames.
-- Of course, this isn't true since we should also be able to get an IPE
-- backtrace for interpreter threads. Just not yet.
--
-- If IPE is empty => it's not an interpreter thread => the IPE backtrace
-- is the best we can do, so just return that.
getRemoteThreadIPEStack f_tid
case ipe_stack of
[] -> do
_decoded_frames <- case m_f_tid of
Nothing -> pure []
Just f_tid -> do
hsc_env <- getSession
ibis <- getRemoteThreadStackCopy f_tid
let hug = hsc_HUG hsc_env
forM ibis $ \ibi -> do
info_brks <- liftIO $ readIModBreaks hug ibi
let modl = getBreakSourceMod ibi info_brks
srcSpan <- liftIO $ getBreakLoc (readIModModBreaks hug) ibi info_brks
-- Find function name
-- TODO: Cache moduleLineMap?
ticks <- fromMaybe (error "getStacktrace:getTicks") <$> makeModuleLineMap modl
let current_toplevel_decl = enclosingTickSpan ticks srcSpan
modl_str <- display modl
return DbgStackFrame
{ name = modl_str ++ "." -- ++ Stack.functionName stack_entry
, sourceSpan = realSrcSpanToSourceSpan $ current_toplevel_decl -- realSrcSpan srcSpan
}
-- Try decoding a stack with interpreter continuation frames (RetBCOs) and use the BRK_FUN src locations.
-- Add the latest resume context at the head.
head_frame <- GHC.getResumeContext >>= \case
[] ->
-- See Note [Don't crash if not stopped]
return Nothing
r:_
| Just ss <- srcSpanToRealSrcSpan (GHC.resumeSpan r)
-> do
r_tid <- getRemoteThreadIdFromRemoteContext (GHC.resumeContext r)
if r_tid == req_tid then
-- We're getting the stacktrace for the thread we're stopped at.
return $
Just DbgStackFrame
{ name = GHC.resumeDecl r
, sourceSpan = realSrcSpanToSourceSpan ss
}
else
return Nothing
| otherwise ->
-- No resume span; which should mean we're stopped on an exception.
-- No info for now.
return Nothing
-- TODO: Currently, only display head_frame
-- return (maybe id (:) head_frame $ decoded_frames)
return (maybe [] (:[]) head_frame)
ipe_frames -> catMaybes <$> do
forM ipe_frames $ \stack_entry -> do
case srcSpanStringToSourceSpan (Stack.srcLoc stack_entry) of
Left err -> do
-- Couldn't parse. The srcLoc may be invalid so just keep this as info, not warning.
logSDoc Logger.Info $
text "Couldn't parse StackEntry srcLoc \"" Ppr.<> text (Stack.srcLoc stack_entry)
Ppr.<> text "\":" <+> text err
return Nothing
Right sourceSpan ->
return $ Just DbgStackFrame
{ name = Stack.moduleName stack_entry ++ "." ++ Stack.functionName stack_entry
, sourceSpan = sourceSpan
}
--------------------------------------------------------------------------------
-- * Scopes
--------------------------------------------------------------------------------
-- | Get the stack frames at the point we're stopped at
getScopes :: Debugger [ScopeInfo]
getScopes = GHC.getCurrentBreakSpan >>= \case
Nothing ->
-- See Note [Don't crash if not stopped]
return []
Just span'
| Just rss <- srcSpanToRealSrcSpan span'
, let sourceSpan = realSrcSpanToSourceSpan rss
-> do
-- It is /very important/ to report a number of variables (numVars) for
-- larger scopes. If we just say "Nothing", then all variables of all
-- scopes will be fetched at every stopped event.
curr_modl <- expectJust <$> getCurrentBreakModule
in_mod <- getTopEnv curr_modl
imported <- getTopImported curr_modl
return
[ ScopeInfo { kind = LocalVariablesScope
, expensive = False
, numVars = Nothing
, sourceSpan
}
, ScopeInfo { kind = ModuleVariablesScope
, expensive = True
, numVars = Just (sizeUFM in_mod)
, sourceSpan
}
, ScopeInfo { kind = GlobalVariablesScope
, expensive = True
, numVars = Just (sizeOccEnv imported)
, sourceSpan
}
]
| otherwise ->
-- No resume span; which should mean we're stopped on an exception
-- TODO: Use exception context to create source span, or at least
-- return the source span null to have Scopes at least.
return []
--------------------------------------------------------------------------------
-- * Variables
--------------------------------------------------------------------------------
-- Note [Variables Requests]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~
-- We can receive a Variables request for three different reasons
--
-- 1. To get the variables in a certain scope
-- 2. To inspect the value of a lazy variable
-- 3. To expand the structure of a variable
--
-- The replies are, respectively:
--
-- (VARR)
-- (a) All the variables in the request scope
-- (b) ONLY the variable requested
-- (c) The fields of the variable requested but NOT the original variable
-- | Get variables using a variable/variables reference
--
-- If the Variable Request ends up being case (VARR)(b), then we signal the
-- request forced the variable and return @Left varInfo@. Otherwise, @Right vis@.
--
-- See Note [Variables Requests]
getVariables :: VariableReference -> Debugger (Either VarInfo [VarInfo])
getVariables vk = do
hsc_env <- getSession
GHC.getResumeContext >>= \case
[] ->
-- See Note [Don't crash if not stopped]
return (Right [])
r:_ -> case vk of
-- Only `seq` the variable when inspecting a specific one (`SpecificVariable`)
-- (VARR)(b,c)
SpecificVariable i -> do
lookupVarByReference i >>= \case
Nothing -> do
-- lookupVarByReference failed.
-- This may happen if, in a race, we change scope while asking for
-- variables of the previous scope.
-- Somewhat similar to the race in Note [Don't crash if not stopped]
return (Right [])
Just key -> do
term <- obtainTerm key
case term of
-- (VARR)(b)
Suspension{} -> do
-- Original Term was a suspension:
-- It is a "lazy" DAP variable: our reply can ONLY include
-- this single variable.
term' <- forceTerm term
vi <- termToVarInfo key term'
return (Left vi)
-- (VARR)(c)
_ -> Right <$> do
-- Original Term was already something other than a Suspension;
-- Meaning the @SpecificVariable@ request means to inspect the structure.
-- Return ONLY the fields
termVarFields key term >>= \case
VarFields vfs -> return vfs
-- (VARR)(a) from here onwards
LocalVariables -> fmap Right $ do
-- bindLocalsAtBreakpoint hsc_env (GHC.resumeApStack r) (GHC.resumeSpan r) (GHC.resumeBreakpointId r)
mapM tyThingToVarInfo =<< GHC.getBindings
ModuleVariables -> Right <$> do
case GHC.resumeBreakpointId r of
Nothing -> return []
Just ibi -> do
curr_modl <- liftIO $ getBreakSourceMod ibi <$>
readIModBreaks (hsc_HUG hsc_env) ibi
things <- typeEnvElts <$> getTopEnv curr_modl
mapM (\tt -> do
nameStr <- display (getName tt)
vi <- tyThingToVarInfo tt
return vi{varName = nameStr}) things
GlobalVariables -> Right <$> do
case GHC.resumeBreakpointId r of
Nothing -> return []
Just ibi -> do
curr_modl <- liftIO $ getBreakSourceMod ibi <$>
readIModBreaks (hsc_HUG hsc_env) ibi
names <- map greName . globalRdrEnvElts <$> getTopImported curr_modl
mapM (\n-> do
nameStr <- display n
liftIO (GHC.lookupType hsc_env n) >>= \case
Nothing ->
return VarInfo
{ varName = nameStr
, varType = ""
, varValue = ""
, isThunk = False
, varRef = NoVariables
}
Just tt -> do
vi <- tyThingToVarInfo tt
return vi{varName = nameStr}
) names
NoVariables -> Right <$> do
return []
--------------------------------------------------------------------------------
-- Inspect
--------------------------------------------------------------------------------
-- | All top-level things from a module, including unexported ones.
getTopEnv :: Module -> Debugger TypeEnv
getTopEnv modl = do
hsc_env <- getSession
liftIO $ HUG.lookupHugByModule modl (hsc_HUG hsc_env) >>= \case
Nothing -> return emptyTypeEnv
Just HomeModInfo
{ hm_details = ModDetails
{ md_types = things
}
} -> return things
-- | All bindings imported at a given module
getTopImported :: Module -> Debugger GlobalRdrEnv
getTopImported modl = do
hsc_env <- getSession
liftIO $ HUG.lookupHugByModule modl (hsc_HUG hsc_env) >>= \case
Nothing -> return emptyGlobalRdrEnv
Just hmi -> mkTopLevImportedEnv hsc_env hmi