A partial attempt to improve :stepover

  With this patch, :stepover can effectively appear to step over recursive calls and
  calls to locally bound functions (in a where clause).

  However, when we run out of ticks in the current expression,
  the illusion vanishes and laziness brings us to the body of the last function
  we "stepped over".
  This is not desired at all, it is potentially very confusing.
  As a countermeasure, when this happens :stepover emits a warning

     "Warning: no more breakpoints in this function body, switching to :step"

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index e868d14..a926bdc 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -643,6 +643,21 @@ lookupCommand str = do
                c:_ -> return (Just c)
 
 
                c:_ -> return (Just c)
 
 

+getCurrentBreakTick :: GHCi (Maybe BreakIndex)
+getCurrentBreakTick = do
+  session <- getSession
+  resumes <- io $ GHC.getResumeContext session
+  case resumes of
+    [] -> return Nothing
+    (r:rs) -> do
+        let ix = GHC.resumeHistoryIx r
+        if ix == 0
+           then return (GHC.breakInfo_number `fmap` GHC.resumeBreakInfo r)
+           else do
+                let hist = GHC.resumeHistory r !! (ix-1)
+                let tick = GHC.getHistoryTick hist
+                return (Just tick)
+

 getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
 getCurrentBreakSpan = do
   session <- getSession
 getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
 getCurrentBreakSpan = do
   session <- getSession

@@ -1549,29 +1564,37 @@ stepCmd expression = do runStmt expression GHC.SingleStep; return ()
 
 stepOverCmd [] = do 
   mb_span <- getCurrentBreakSpan
 
 stepOverCmd [] = do 
   mb_span <- getCurrentBreakSpan

+  session <- getSession

   case mb_span of
     Nothing  -> stepCmd []
   case mb_span of
     Nothing  -> stepCmd []

-    Just loc -> do
-       Just mod <- getCurrentBreakModule
-       parent   <- enclosingTickSpan mod loc
+    Just curr_loc -> do
+       Just tick   <- getCurrentBreakTick
+       Just mod    <- getCurrentBreakModule 
+       parent      <- io$ GHC.findEnclosingDeclSpanByTick session mod tick

        allTicksRightmost <- (sortBy rightmost . map snd) `fmap` 
                                ticksIn mod parent
        let lastTick = null allTicksRightmost || 
        allTicksRightmost <- (sortBy rightmost . map snd) `fmap` 
                                ticksIn mod parent
        let lastTick = null allTicksRightmost || 

-                      head allTicksRightmost == loc
+                      head allTicksRightmost == curr_loc

        if not lastTick
        if not lastTick

-              then doContinue (`isSubspanOf` parent) GHC.SingleStep
-              else doContinue (const True) GHC.SingleStep
+              then let f t = t `isSubspanOf` parent && 
+                             (curr_loc `leftmost_largest` t == LT)
+                   in doContinue f GHC.SingleStep
+              else printForUser (text "Warning: no more breakpoints in this function body, switching to :step") >>
+                   doContinue (const True) GHC.SingleStep

 
 stepOverCmd expression = stepCmd expression
 
 {- 
 
 stepOverCmd expression = stepCmd expression
 
 {- 

- So, the only tricky part in stepOver is detecting that we have 
+ The first tricky bit in stepOver is detecting that we have 

  arrived to the last tick in an expression, in which case we must
  step normally to the next tick.
  What we do is:
   1. Retrieve the enclosing expression block (with a tick)
   2. Retrieve all the ticks there and sort them out by 'rightness'
   3. See if the current tick turned out the first one in the list
  arrived to the last tick in an expression, in which case we must
  step normally to the next tick.
  What we do is:
   1. Retrieve the enclosing expression block (with a tick)
   2. Retrieve all the ticks there and sort them out by 'rightness'
   3. See if the current tick turned out the first one in the list

+
+ The second tricky bit is how to step over recursive calls.
+

 -}
 
 --ticksIn :: Module -> SrcSpan -> GHCi [Tick]
 -}
 
 --ticksIn :: Module -> SrcSpan -> GHCi [Tick]

@@ -1584,15 +1607,6 @@ ticksIn mod src = do
                 , srcSpanEnd src   >= srcSpanEnd span
                 ]
 
                 , srcSpanEnd src   >= srcSpanEnd span
                 ]
 

-enclosingTickSpan :: Module -> SrcSpan -> GHCi SrcSpan
-enclosingTickSpan mod src = do
-  ticks <- getTickArray mod
-  let line = srcSpanStartLine src
-  ASSERT (inRange (bounds ticks) line) do
-  let enclosing_spans = [ span | (_,span) <- ticks ! line
-                               , srcSpanEnd span >= srcSpanEnd src]
-  return . head . sortBy leftmost_largest $ enclosing_spans
-

 traceCmd :: String -> GHCi ()
 traceCmd []         = doContinue (const True) GHC.RunAndLogSteps
 traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return ()
 traceCmd :: String -> GHCi ()
 traceCmd []         = doContinue (const True) GHC.RunAndLogSteps
 traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return ()

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 1fc3605..4c14ff6 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -85,7 +85,8 @@ module GHC (
         Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
                resumeHistory, resumeHistoryIx),
         History(historyBreakInfo, historyEnclosingDecl), 
         Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
                resumeHistory, resumeHistoryIx),
         History(historyBreakInfo, historyEnclosingDecl), 

-        GHC.getHistorySpan, getHistoryModule,
+        GHC.getHistorySpan, getHistoryModule, getHistoryTick,
+        GHC.findEnclosingDeclSpanByTick,

         getResumeContext,
         abandon, abandonAll,
         InteractiveEval.back,
         getResumeContext,
         abandon, abandonAll,
         InteractiveEval.back,

@@ -1987,4 +1988,8 @@ findModule' hsc_env mod_name maybe_pkg =
 getHistorySpan :: Session -> History -> IO SrcSpan
 getHistorySpan sess h = withSession sess $ \hsc_env -> 
                           return$ InteractiveEval.getHistorySpan hsc_env h
 getHistorySpan :: Session -> History -> IO SrcSpan
 getHistorySpan sess h = withSession sess $ \hsc_env -> 
                           return$ InteractiveEval.getHistorySpan hsc_env h

+
+findEnclosingDeclSpanByTick :: Session -> Module -> BreakIndex -> IO SrcSpan
+findEnclosingDeclSpanByTick sess m t = withSession sess $ \ hsc_env -> 
+               return$ InteractiveEval.findEnclosingDeclSpanByTick hsc_env m t

 #endif
 #endif

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 3173278..9c28c84 100644 (file)
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -13,8 +13,10 @@ module InteractiveEval (
         resume,
         abandon, abandonAll,
         getResumeContext,
         resume,
         abandon, abandonAll,
         getResumeContext,

+        getHistoryTick,

         getHistorySpan,
         getHistoryModule,
         getHistorySpan,
         getHistoryModule,

+        findEnclosingDeclSpanByTick,

         back, forward,
        setContext, getContext, 
         nameSetToGlobalRdrEnv,
         back, forward,
        setContext, getContext, 
         nameSetToGlobalRdrEnv,

@@ -142,6 +144,9 @@ mkHistory hsc_env hval bi = let
                                      (getHistorySpan hsc_env h)
     in h
 
                                      (getHistorySpan hsc_env h)
     in h
 

+getHistoryTick :: History -> BreakIndex
+getHistoryTick = breakInfo_number . historyBreakInfo 
+

 getHistoryModule :: History -> Module
 getHistoryModule = breakInfo_module . historyBreakInfo
 
 getHistoryModule :: History -> Module
 getHistoryModule = breakInfo_module . historyBreakInfo
 

@@ -165,6 +170,16 @@ findEnclosingDecl hsc_env mod span =
                               --   ^^ assumes md_types is sorted
               in decl
 
                               --   ^^ assumes md_types is sorted
               in decl
 

+-- | Finds the span of the (smallest) function containing this BreakIndex
+findEnclosingDeclSpanByTick :: HscEnv -> Module -> BreakIndex -> SrcSpan
+findEnclosingDeclSpanByTick hsc_env mod tick = 
+   case lookupUFM (hsc_HPT hsc_env) (moduleName mod) of
+         Nothing -> panic "findEnclosingDecl"
+         Just hmi -> let
+             modbreaks = md_modBreaks (hm_details hmi)
+          in ASSERT (inRange (bounds modBreaks) tick)
+             modBreaks_decls modbreaks ! tick
+

 -- | Find the Module corresponding to a FilePath
 findModuleFromFile :: HscEnv -> FilePath -> Maybe Module
 findModuleFromFile hsc_env fp =
 -- | Find the Module corresponding to a FilePath
 findModuleFromFile :: HscEnv -> FilePath -> Maybe Module
 findModuleFromFile hsc_env fp =