A new :stepover command for the debugger

[ghc-hetmet.git] / compiler / main / InteractiveEval.hs

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 42b787a..069a829 100644 (file)
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -14,6 +14,7 @@ module InteractiveEval (
         abandon, abandonAll,
         getResumeContext,
         getHistorySpan,
+        getHistoryModule,
         back, forward,
        setContext, getContext, 
         nameSetToGlobalRdrEnv,
@@ -131,6 +132,9 @@ data History
         historyBreakInfo :: BreakInfo
    }
 
+getHistoryModule :: History -> Module 
+getHistoryModule = breakInfo_module . historyBreakInfo
+
 getHistorySpan :: Session -> History -> IO SrcSpan
 getHistorySpan s hist = withSession s $ \hsc_env -> do
    let inf = historyBreakInfo hist 
@@ -358,7 +362,7 @@ resume (Session ref) step
         when (isStep step) $ setStepFlag
         case r of 
           Resume expr tid breakMVar statusMVar bindings 
-              final_ids apStack info _ _ _ -> do
+              final_ids apStack info _ hist _ -> do
                 withBreakAction (isStep step) (hsc_dflags hsc_env) 
                                         breakMVar statusMVar $ do
                 status <- withInterruptsSentTo
@@ -366,14 +370,18 @@ resume (Session ref) step
                                       -- this awakens the stopped thread...
                                  return tid)
                              (takeMVar statusMVar)
-                                      -- and wait for the result
+                                      -- and wait for the result 
+                let hist' = case info of 
+                              Nothing -> fromListBL 50 hist
+                              Just i -> History apStack i `consBL` 
+                                                     fromListBL 50 hist
                 case step of
                   RunAndLogSteps -> 
                         traceRunStatus expr ref bindings final_ids
-                                       breakMVar statusMVar status emptyHistory
+                                       breakMVar statusMVar status hist'
                   _other ->
                         handleRunStatus expr ref bindings final_ids
-                                        breakMVar statusMVar status emptyHistory
+                                        breakMVar statusMVar status hist'
 
 
 back :: Session -> IO ([Name], Int, SrcSpan)
@@ -632,6 +640,8 @@ consBL a (BL len bound left right)
 
 toListBL (BL _ _ left right) = left ++ reverse right
 
+fromListBL bound l = BL (length l) bound l []
+
 -- lenBL (BL len _ _ _) = len
 
 -- -----------------------------------------------------------------------------