From ac08abc6906991a811896b71eaf4cfc16c1df47c Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Thu, 19 Apr 2007 09:49:09 +0000 Subject: [PATCH] Get the InteractiveContext right when stopped at a breakpoint we shouldn't be binding 'it' until the computation has actually finished. --- compiler/main/GHC.hs | 44 ++++++++++++++++++++++++++------------------ compiler/main/HscMain.lhs | 4 ++-- 2 files changed, 28 insertions(+), 20 deletions(-) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 0b93cd8..f35c7fd 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -2132,7 +2132,7 @@ data RunResult | RunBreak ThreadId [Name] BreakInfo ResumeHandle data Status - = Break HValue BreakInfo ThreadId (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 @@ -2145,9 +2145,15 @@ data 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. runStmt :: Session -> String -> IO RunResult @@ -2167,38 +2173,40 @@ runStmt (Session ref) expr 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 -- 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 breakMVar statusMVar names + 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 (hsc_IC new_hsc_env) names status + handleRunStatus ref new_IC names (hsc_IC hsc_env) + breakMVar statusMVar status -handleRunStatus ref ic 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 breakMVar statusMVar final_names) -> 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 - ic 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 - Linker.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 ())) @@ -2214,33 +2222,33 @@ sandboxIO statusMVar thing = do putMVar interruptTargetThread (child:ts) takeMVar statusMVar `finally` modifyMVar_ interruptTargetThread (return.tail) -setBreakAction breakMVar statusMVar final_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 breakMVar statusMVar - final_names) + putMVar statusMVar (Break apStack ids tid) takeMVar breakMVar resume :: Session -> ResumeHandle -> IO RunResult resume (Session ref) res@(ResumeHandle breakMVar statusMVar - final_names ic names) + 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 = ic } + writeIORef ref hsc_env{ hsc_IC = resume_ic } Linker.deleteFromLinkEnv names - stablePtr <- setBreakAction breakMVar statusMVar final_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 ic names status + handleRunStatus ref final_ic final_names resume_ic + breakMVar statusMVar status {- -- This version of sandboxIO runs the expression in a completely new diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index 4413c52..20a0b5a 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -797,7 +797,7 @@ A naked expression returns a singleton Name [it]. hscStmt -- Compile a stmt all the way to an HValue, but don't run it :: HscEnv -> String -- The statement - -> IO (Maybe (HscEnv, [Name], HValue)) + -> IO (Maybe (InteractiveContext, [Name], HValue)) hscStmt hsc_env stmt = do { maybe_stmt <- hscParseStmt (hsc_dflags hsc_env) stmt @@ -828,7 +828,7 @@ hscStmt hsc_env stmt ; let src_span = srcLocSpan interactiveSrcLoc ; hval <- compileExpr hsc_env src_span ds_expr - ; return (Just (hsc_env{ hsc_IC=new_ic }, bound_names, hval)) + ; return (Just (new_ic, bound_names, hval)) }}}}}}} hscTcExpr -- Typecheck an expression (but don't run it) -- 1.7.10.4