Ticket #3035: traceOnlyStops.patch

File traceOnlyStops.patch, 3.5 KB (added by phercek, 5 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 <phercek@gmail.com>
      * 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 ->