diff options
| author | Peter Hercek <phercek@gmail.com> | 2009-02-22 20:10:02 +0000 |
|---|---|---|
| committer | Peter Hercek <phercek@gmail.com> | 2009-02-22 20:10:02 +0000 |
| commit | 8f0034600a8a5fa507994646f96e63e2933a5330 (patch) | |
| tree | 212e2e67dde28c819728a37ac7197b5b4bbd96dd | |
| parent | 47b550ecf0edcada00034925830a52603f3a87df (diff) | |
| download | haskell-8f0034600a8a5fa507994646f96e63e2933a5330.tar.gz | |
:steplocal and :stepmodule should not polute trace history
| -rw-r--r-- | compiler/ghci/GhciMonad.hs | 4 | ||||
| -rw-r--r-- | compiler/ghci/InteractiveUI.hs | 4 | ||||
| -rw-r--r-- | 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 8374491891..d5e491bbf5 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 12a1713dde..9feae0e977 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 36e6f7c2c8..50eae9f997 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 -> |