obtainTerm, obtainTerm1,
ModBreaks(..), BreakIndex,
BreakInfo(breakInfo_number, breakInfo_module),
+ BreakArray, setBreakOn, setBreakOff, getBreak,
modInfoModBreaks,
#endif
-- ** Source locations
SrcLoc, pprDefnLoc,
+ mkSrcLoc, isGoodSrcLoc,
+ srcLocFile, srcLocLine, srcLocCol,
+ SrcSpan,
+ mkSrcSpan, srcLocSpan,
+ srcSpanStart, srcSpanEnd,
+ srcSpanFile,
+ srcSpanStartLine, srcSpanEndLine,
+ srcSpanStartCol, srcSpanEndCol,
-- * Exceptions
GhcException(..), showGhcException,
import Foreign.StablePtr( deRefStablePtr, StablePtr, newStablePtr, freeStablePtr )
import Foreign ( poke )
import qualified Linker
+import Linker ( HValue )
import Data.Dynamic ( Dynamic )
-import Linker ( HValue, getHValue, extendLinkEnv )
import ByteCodeInstr
import DebuggerTys
import IdInfo
import HscMain ( hscParseIdentifier, hscTcExpr, hscKcType, hscStmt )
+import BreakArray
#endif
import Packages
inner
-#if defined(GHCI)
-GLOBAL_VAR(v_bkptLinkEnv, [], [(Name, HValue)])
- -- stores the current breakpoint handler to help setContext to
- -- restore it after a context change
-#endif
-
-- | Starts a new session. A session consists of a set of loaded
-- modules, a set of options (DynFlags), and an interactive context.
newSession :: Maybe FilePath -> IO Session
hsc_env <- readIORef ref
let
dflags = hsc_dflags hsc_env
- gmode = ghcMode (hsc_dflags hsc_env)
targets = hsc_targets hsc_env
old_graph = hsc_mod_graph hsc_env
let hpt1 = hsc_HPT hsc_env
let dflags = hsc_dflags hsc_env
- let ghci_mode = ghcMode dflags -- this never changes
-- The "bad" boot modules are the ones for which we have
-- B.hs-boot in the module graph, but no B.hs
| RunBreak ThreadId [Name] BreakInfo ResumeHandle
data Status
- = Break HValue BreakInfo ThreadId ResumeHandle -- ^ the computation hit a breakpoint
- | Complete (Either Exception [HValue]) -- ^ the computation completed with either an exception or a value
-
-data ResumeHandle = ResumeHandle (MVar ()) (MVar Status) [Name]
+ = Break HValue BreakInfo ThreadId
+ -- ^ the computation hit a breakpoint
+ | Complete (Either Exception [HValue])
+ -- ^ the computation completed with either an exception or a value
+
+-- | This is a token given back to the client when runStmt stops at a
+-- breakpoint. It allows the original computation to be resumed, restoring
+-- the old interactive context.
+data ResumeHandle
+ = ResumeHandle
+ (MVar ()) -- breakMVar
+ (MVar Status) -- statusMVar
+ [Name] -- [Name] to bind on completion
+ InteractiveContext -- IC on completion
+ InteractiveContext -- IC to restore on resumption
+ [Name] -- [Name] to remove from the link env
+
+-- We need to track two InteractiveContexts:
+-- - the IC before runStmt, which is restored on each resume
+-- - the IC binding the results of the original statement, which
+-- will be the IC when runStmt returns with RunOk.
-- | Run a statement in the current interactive context. Statement
-- may bind multple values.
case maybe_stuff of
Nothing -> return RunFailed
- Just (new_hsc_env, names, hval) -> do
- writeIORef ref new_hsc_env
+ Just (new_IC, names, hval) -> do
- let resume_handle = ResumeHandle breakMVar statusMVar names
-- set the onBreakAction to be performed when we hit a
-- breakpoint this is visible in the Byte Code
-- Interpreter, thus it is a global variable,
-- implemented with stable pointers
- stablePtr <- setBreakAction resume_handle
+ stablePtr <- setBreakAction breakMVar statusMVar
let thing_to_run = unsafeCoerce# hval :: IO [HValue]
status <- sandboxIO statusMVar thing_to_run
freeStablePtr stablePtr -- be careful not to leak stable pointers!
- handleRunStatus ref names status
+ handleRunStatus ref new_IC names (hsc_IC hsc_env)
+ breakMVar statusMVar status
-handleRunStatus ref names status =
+handleRunStatus ref final_ic final_names resume_ic breakMVar statusMVar status =
case status of
-- did we hit a breakpoint or did we complete?
- (Break apStack info tid res) -> do
+ (Break apStack info tid) -> do
hsc_env <- readIORef ref
(new_hsc_env, names) <- extendEnvironment hsc_env apStack
(breakInfo_vars info)
writeIORef ref new_hsc_env
+ let res = ResumeHandle breakMVar statusMVar final_names
+ final_ic resume_ic names
return (RunBreak tid names info res)
(Complete either_hvals) ->
case either_hvals of
Left e -> return (RunException e)
Right hvals -> do
- extendLinkEnv (zip names hvals)
- return (RunOk names)
-
+ hsc_env <- readIORef ref
+ writeIORef ref hsc_env{hsc_IC=final_ic}
+ Linker.extendLinkEnv (zip final_names hvals)
+ return (RunOk final_names)
+
-- this points to the IO action that is executed when a breakpoint is hit
foreign import ccall "&breakPointIOAction"
breakPointIOAction :: Ptr (StablePtr (BreakInfo -> HValue -> IO ()))
putMVar interruptTargetThread (child:ts)
takeMVar statusMVar `finally` modifyMVar_ interruptTargetThread (return.tail)
-setBreakAction res@(ResumeHandle breakMVar statusMVar names) = do
+setBreakAction breakMVar statusMVar = do
stablePtr <- newStablePtr onBreak
poke breakPointIOAction stablePtr
return stablePtr
where onBreak ids apStack = do
tid <- myThreadId
- putMVar statusMVar (Break apStack ids tid res)
+ putMVar statusMVar (Break apStack ids tid)
takeMVar breakMVar
resume :: Session -> ResumeHandle -> IO RunResult
-resume (Session ref) res@(ResumeHandle breakMVar statusMVar names) = do
- stablePtr <- setBreakAction res
- putMVar breakMVar ()
- status <- takeMVar statusMVar
- handleRunStatus ref names status
+resume (Session ref) res@(ResumeHandle breakMVar statusMVar
+ final_names final_ic resume_ic names)
+ = do
+ -- restore the original interactive context. This is not entirely
+ -- satisfactory: any new bindings made since the breakpoint stopped
+ -- will be dropped from the interactive context, but not from the
+ -- linker's environment.
+ hsc_env <- readIORef ref
+ writeIORef ref hsc_env{ hsc_IC = resume_ic }
+ Linker.deleteFromLinkEnv names
+
+ stablePtr <- setBreakAction breakMVar statusMVar
+ putMVar breakMVar () -- this awakens the stopped thread...
+ status <- takeMVar statusMVar -- and wait for the result
+ freeStablePtr stablePtr -- be careful not to leak stable pointers!
+ handleRunStatus ref final_ic final_names resume_ic
+ breakMVar statusMVar status
{-
-- This version of sandboxIO runs the expression in a completely new
new_type_env = extendTypeEnvWithIds filtered_type_env (typed_ids)
new_ic = ictxt { ic_rn_local_env = new_rn_env,
ic_type_env = new_type_env }
- extendLinkEnv (zip names hValues) -- ToDo: we must remember to restore the old env after we finish a breakpoint
+ Linker.extendLinkEnv (zip names hValues)
return (hsc_env{hsc_IC = new_ic}, names)
where
globaliseAndTidy :: Id -> Id
obtainTerm :: Session -> Bool -> Id -> IO (Maybe Term)
obtainTerm sess force id = withSession sess $ \hsc_env -> do
- mb_v <- getHValue (varName id)
+ mb_v <- Linker.getHValue (varName id)
case mb_v of
Just v -> fmap Just$ cvObtainTerm hsc_env force (Just$ idType id) v
Nothing -> return Nothing
projects / ghc-hetmet.git / blobdiff