Ticket #3035: traceOnlyStops.patch

File traceOnlyStops.patch, 3.5 KB (added by phercek, 7 years ago)

unified diff version of the patch (aganist ghc version from 2009-02-11 at http://darcs.haskell.org/ghc-6.10/ghc)

  • compiler/ghci/GhciMonad.hs

    Thu Feb 19 00:34:27 CET 2009  Peter Hercek <[email protected]>
      * step(local|module) should not extend trace history with records outside (local|module) scope
    diff -rN -u old-ghc/compiler/ghci/GhciMonad.hs new-ghc/compiler/ghci/GhciMonad.hs
    old new  
    248248                                        return GHC.RunFailed) $ do
    249249          GHC.runStmt expr step
    250250
    251 resume :: GHC.SingleStep -> GHCi GHC.RunResult
    252 resume step = GHC.resume step
     251resume :: (SrcSpan->Bool) -> GHC.SingleStep -> GHCi GHC.RunResult
     252resume canLogSpan step = GHC.resume canLogSpan step
    253253
    254254-- --------------------------------------------------------------------------
    255255-- timing & statistics
  • compiler/ghci/InteractiveUI.hs

    diff -rN -u old-ghc/compiler/ghci/InteractiveUI.hs new-ghc/compiler/ghci/InteractiveUI.hs
    old new  
    742742               st <- getGHCiState
    743743               enqueueCommands [stop st]
    744744               return ()
    745          | otherwise -> resume GHC.SingleStep >>=
     745         | otherwise -> resume step_here GHC.SingleStep >>=
    746746                        afterRunStmt step_here >> return ()
    747747     _ -> return ()
    748748
     
    19651965-- doContinue :: SingleStep -> GHCi ()
    19661966doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
    19671967doContinue pred step = do
    1968   runResult <- resume step
     1968  runResult <- resume pred step
    19691969  afterRunStmt pred runResult
    19701970  return ()
    19711971
  • compiler/main/InteractiveEval.hs

    diff -rN -u old-ghc/compiler/main/InteractiveEval.hs new-ghc/compiler/main/InteractiveEval.hs
    old new  
    434434  putStrLn $ "*** Ignoring breakpoint: "++mn ++ " #"++show i
    435435noBreakAction True  _ _ = return () -- exception: just continue
    436436
    437 resume :: GhcMonad m => SingleStep -> m RunResult
    438 resume step
     437resume :: GhcMonad m => (SrcSpan->Bool) -> SingleStep -> m RunResult
     438resume canLogSpan step
    439439 = do
    440440   hsc_env <- getSession
    441441   let ic = hsc_IC hsc_env
     
    462462        when (isStep step) $ liftIO setStepFlag
    463463        case r of
    464464          Resume expr tid breakMVar statusMVar bindings
    465               final_ids apStack info _ hist _ -> do
     465              final_ids apStack info span hist _ -> do
    466466               withVirtualCWD $ do
    467467                withBreakAction (isStep step) (hsc_dflags hsc_env)
    468468                                        breakMVar statusMVar $ do
     
    471471                                      -- this awakens the stopped thread...
    472472                             takeMVar statusMVar
    473473                                      -- and wait for the result
    474                 let hist' =
    475                      case info of
    476                        Nothing -> fromListBL 50 hist
    477                        Just i -> mkHistory hsc_env apStack i `consBL`
     474                let prevHistoryLst = fromListBL 50 hist
     475                    hist' = case info of
     476                       Nothing -> prevHistoryLst
     477                       Just i
     478                         | not $canLogSpan span -> prevHistoryLst
     479                         | otherwise -> mkHistory hsc_env apStack i `consBL`
    478480                                                        fromListBL 50 hist
    479481                case step of
    480482                  RunAndLogSteps ->