give the statements under evaluation in the ":show context" output

2 files changed, 34 insertions, 21 deletions

diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs
index d63dfb18ea..f7f2014ea2 100644
--- a/compiler/ghci/GhciMonad.hs
+++ b/compiler/ghci/GhciMonad.hs
@@ -47,7 +47,7 @@ data GHCiState = GHCiState
 	session        :: GHC.Session,
 	options        :: [GHCiOption],
         prelude        :: GHC.Module,
-        resume         :: [(SrcSpan, ThreadId, GHC.ResumeHandle)],
+        resume         :: [EvalInProgress],
         breaks         :: !ActiveBreakPoints,
         tickarrays     :: ModuleEnv TickArray
                 -- tickarrays caches the TickArray for loaded modules,
@@ -69,6 +69,14 @@ data ActiveBreakPoints
    , breakLocations :: ![(Int, BreakLocation)]  -- break location uniquely numbered 
    }
 
+-- The context of an evaluation in progress that stopped at a breakpoint
+data EvalInProgress
+   = EvalInProgress
+   { evalStmt         :: String,
+     evalSpan         :: SrcSpan,
+     evalThreadId     :: ThreadId,
+     evalResumeHandle :: GHC.ResumeHandle }
+
 instance Outputable ActiveBreakPoints where
    ppr activeBrks = prettyLocations $ breakLocations activeBrks 
 
@@ -181,18 +189,18 @@ unsetOption opt
 io :: IO a -> GHCi a
 io m = GHCi { unGHCi = \s -> m >>= return }
 
-popResume :: GHCi (Maybe (SrcSpan, ThreadId, GHC.ResumeHandle))
+popResume :: GHCi (Maybe EvalInProgress)
 popResume = do
    st <- getGHCiState 
    case (resume st) of
       []     -> return Nothing
       (x:xs) -> do setGHCiState $ st { resume = xs } ; return (Just x)
          
-pushResume :: SrcSpan -> ThreadId -> GHC.ResumeHandle -> GHCi ()
-pushResume span threadId resumeAction = do
+pushResume :: EvalInProgress -> GHCi ()
+pushResume eval = do
    st <- getGHCiState
    let oldResume = resume st
-   setGHCiState $ st { resume = (span, threadId, resumeAction) : oldResume }
+   setGHCiState $ st { resume = eval : oldResume }
 
 discardResumeContext :: GHCi ()
 discardResumeContext = do
diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index cd08d11419..53afbf3d15 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -451,9 +451,9 @@ mkPrompt toplevs exports resumes prompt
         f [] = empty
     
         perc_s
-          | (span,_,_):rest <- resumes 
+          | eval:rest <- resumes 
           = (if not (null rest) then text "... " else empty)
-            <> brackets (ppr span) <+> modules_prompt
+            <> brackets (ppr (evalSpan eval)) <+> modules_prompt
           | otherwise
           = modules_prompt
 
@@ -521,13 +521,13 @@ runStmt stmt
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $
 	     	     GHC.runStmt session stmt
-      switchOnRunResult result
+      switchOnRunResult stmt result
 
-switchOnRunResult :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
-switchOnRunResult GHC.RunFailed = return Nothing
-switchOnRunResult (GHC.RunException e) = throw e
-switchOnRunResult (GHC.RunOk names) = return $ Just (False,names)
-switchOnRunResult (GHC.RunBreak threadId names info resume) = do
+switchOnRunResult :: String -> GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
+switchOnRunResult stmt GHC.RunFailed = return Nothing
+switchOnRunResult stmt (GHC.RunException e) = throw e
+switchOnRunResult stmt (GHC.RunOk names) = return $ Just (False,names)
+switchOnRunResult stmt (GHC.RunBreak threadId names info resume) = do
    session <- getSession
    Just mod_info <- io $ GHC.getModuleInfo session (GHC.breakInfo_module info) 
    let modBreaks  = GHC.modInfoModBreaks mod_info
@@ -537,7 +537,10 @@ switchOnRunResult (GHC.RunBreak threadId names info resume) = do
    let location = ticks ! GHC.breakInfo_number info
    printForUser $ ptext SLIT("Stopped at") <+> ppr location
 
-   pushResume location threadId resume
+   pushResume EvalInProgress{ evalStmt = stmt,
+                              evalSpan = location,
+                              evalThreadId = threadId,
+                              evalResumeHandle = resume }
 
    -- run the command set with ":set stop <cmd>"
    st <- getGHCiState
@@ -1150,9 +1153,11 @@ showBkptTable = do
 showContext :: GHCi ()
 showContext = do
    st <- getGHCiState
-   printForUser $ vcat (map pp_resume (resume st))
+   printForUser $ vcat (map pp_resume (reverse (resume st)))
   where
-   pp_resume (span, _, _) = ptext SLIT("Stopped at") <+> ppr span
+   pp_resume eval =
+        ptext SLIT("--> ") <> text (evalStmt eval)
+        $$ nest 2 (ptext SLIT("Stopped at") <+> ppr (evalSpan eval))
 
 -- -----------------------------------------------------------------------------
 -- Completion
@@ -1386,11 +1391,11 @@ doContinue actionBeforeCont = do
       Nothing -> do 
          io $ putStrLn "There is no computation running."
          return False
-      Just (_,_,handle) -> do
+      Just eval -> do
          io $ actionBeforeCont
          session <- getSession
-         runResult <- io $ GHC.resume session handle
-         names <- switchOnRunResult runResult
+         runResult <- io $ GHC.resume session (evalResumeHandle eval)
+         names <- switchOnRunResult (evalStmt eval) runResult
          finishEvalExpr names
          return False
 
@@ -1400,7 +1405,7 @@ abandonCmd "" = do
    case mb_res of
       Nothing -> do 
          io $ putStrLn "There is no computation running."
-      Just (span,_,_) ->
+      Just eval ->
          return ()
          -- the prompt will change to indicate the new context
 
@@ -1570,7 +1575,7 @@ listCmd str = do
    st <- getGHCiState
    case resume st of
       []  -> printForUser $ text "not stopped at a breakpoint; nothing to list"
-      (span,_,_):_ -> io $ listAround span True
+      eval:_ -> io $ listAround (evalSpan eval) True
 
 -- | list a section of a source file around a particular SrcSpan.
 -- If the highlight flag is True, also highlight the span using