From 8f0034600a8a5fa507994646f96e63e2933a5330 Mon Sep 17 00:00:00 2001
From: Peter Hercek <phercek@gmail.com>
Date: Sun, 22 Feb 2009 20:10:02 +0000
Subject: [PATCH] :steplocal and :stepmodule should not polute trace history

---
 compiler/ghci/GhciMonad.hs       |    4 ++--
 compiler/ghci/InteractiveUI.hs   |    4 ++--
 compiler/main/InteractiveEval.hs |   16 +++++++++-------
 3 files changed, 13 insertions(+), 11 deletions(-)

diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs
index 8374491..d5e491b 100644
--- a/compiler/ghci/GhciMonad.hs
+++ b/compiler/ghci/GhciMonad.hs
@@ -248,8 +248,8 @@ runStmt expr step = do
                                         return GHC.RunFailed) $ do
           GHC.runStmt expr step
 
-resume :: GHC.SingleStep -> GHCi GHC.RunResult
-resume step = GHC.resume step
+resume :: (SrcSpan -> Bool) -> GHC.SingleStep -> GHCi GHC.RunResult
+resume canLogSpan step = GHC.resume canLogSpan step
 
 -- --------------------------------------------------------------------------
 -- timing & statistics
diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 12a1713..9feae0e 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -742,7 +742,7 @@ afterRunStmt step_here run_result = do
                st <- getGHCiState
                enqueueCommands [stop st]
                return ()
-         | otherwise -> resume GHC.SingleStep >>=
+         | otherwise -> resume step_here GHC.SingleStep >>=
                         afterRunStmt step_here >> return ()
      _ -> return ()
 
@@ -1978,7 +1978,7 @@ continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion
 -- doContinue :: SingleStep -> GHCi ()
 doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
 doContinue pred step = do 
-  runResult <- resume step
+  runResult <- resume pred step
   afterRunStmt pred runResult
   return ()
 
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 36e6f7c..50eae9f 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -431,8 +431,8 @@ noBreakAction :: Bool -> BreakInfo -> HValue -> IO ()
 noBreakAction False _ _ = putStrLn "*** Ignoring breakpoint"
 noBreakAction True  _ _ = return () -- exception: just continue
 
-resume :: GhcMonad m => SingleStep -> m RunResult
-resume step
+resume :: GhcMonad m => (SrcSpan->Bool) -> SingleStep -> m RunResult
+resume canLogSpan step
  = do
    hsc_env <- getSession
    let ic = hsc_IC hsc_env
@@ -459,7 +459,7 @@ resume step
         when (isStep step) $ liftIO setStepFlag
         case r of 
           Resume expr tid breakMVar statusMVar bindings 
-              final_ids apStack info _ hist _ -> do
+              final_ids apStack info span hist _ -> do
                withVirtualCWD $ do
                 withBreakAction (isStep step) (hsc_dflags hsc_env) 
                                         breakMVar statusMVar $ do
@@ -468,10 +468,12 @@ resume step
                                       -- this awakens the stopped thread...
                              takeMVar statusMVar
                                       -- and wait for the result 
-                let hist' = 
-                     case info of 
-                       Nothing -> fromListBL 50 hist
-                       Just i -> mkHistory hsc_env apStack i `consBL` 
+                let prevHistoryLst = fromListBL 50 hist
+                    hist' = case info of
+                       Nothing -> prevHistoryLst
+                       Just i
+                         | not $canLogSpan span -> prevHistoryLst
+                         | otherwise -> mkHistory hsc_env apStack i `consBL`
                                                         fromListBL 50 hist
                 case step of
                   RunAndLogSteps -> 
-- 
1.7.10.4