Get the InteractiveContext right when stopped at a breakpoint

we shouldn't be binding 'it' until the computation has actually finished.

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 0b93cd8..f35c7fd 100644 (file)
--- 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 (file)
--- 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)