Ticket #3035: traceOnlyStops.patch

compiler/ghci/GhciMonad.hs

@@ -248 +248 @@
                                         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

compiler/ghci/InteractiveUI.hs

@@ -742 +742 @@
                st <- getGHCiState
                enqueueCommands [stop st]
                return ()
-         | otherwise -> resume GHC.SingleStep >>=
+         | otherwise -> resume step_here GHC.SingleStep >>=
                         afterRunStmt step_here >> return ()
      _ -> return ()
 
@@ -1965 +1965 @@
 -- doContinue :: SingleStep -> GHCi ()
 doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
 doContinue pred step = do 
-  runResult <- resume step
+  runResult <- resume pred step
   afterRunStmt pred runResult
   return ()
 

compiler/main/InteractiveEval.hs

@@ -434 +434 @@
   putStrLn $ "*** Ignoring breakpoint: "++mn ++ " #"++show i
 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
@@ -462 +462 @@
         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
@@ -471 +471 @@
                                       -- 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 ->