" :sprint [<name> ...] simplifed version of :print\n" ++
" :step single-step after stopping at a breakpoint\n"++
" :step <expr> single-step into <expr>\n"++
+ " :stepover (locally) single-step over function applications"++
" :trace trace after stopping at a breakpoint\n"++
" :trace <expr> trace into <expr> (remembers breakpoints for :history)\n"++
then return (brackets (ppr (GHC.resumeSpan r)) <> space)
else do
let hist = GHC.resumeHistory r !! (ix-1)
- span <- io $ GHC.getHistorySpan session hist
+ span <- io$ GHC.getHistorySpan session hist
return (brackets (ppr (negate ix) <> char ':'
<+> ppr span) <> space)
let
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
(r:rs) -> do
let ix = GHC.resumeHistoryIx r
if ix == 0
- then return (GHC.breakInfo_module `fmap` GHC.resumeBreakInfo r)
+ then return (GHC.breakInfo_module `liftM` GHC.resumeBreakInfo r)
else do
let hist = GHC.resumeHistory r !! (ix-1)
return $ Just $ GHC.getHistoryModule hist
reloadModule :: String -> GHCi ()
reloadModule m = do
- io (revertCAFs) -- always revert CAFs on reload.
- discardActiveBreakPoints
session <- getSession
doLoad session $ if null m then LoadAllTargets
else LoadUpTo (GHC.mkModuleName m)
stepOverCmd [] = do
mb_span <- getCurrentBreakSpan
+ session <- getSession
case mb_span of
Nothing -> stepCmd []
- Just loc -> do
- Just mod <- getCurrentBreakModule
- parent <- enclosingSubSpan mod loc
- allTicksRightmost <- sortBy rightmost `fmap`
+ 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 ||
- snd(head allTicksRightmost) == loc
+ head allTicksRightmost == curr_loc
if not lastTick
- then doContinue (`lexicalSubSpanOf` 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
- where
+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
+ 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]
, srcSpanEnd src >= srcSpanEnd span
]
-enclosingSubSpan :: Module -> SrcSpan -> GHCi SrcSpan
-enclosingSubSpan mod src = do
- ticks <- getTickArray mod
- let line = srcSpanStartLine src
- ASSERT (inRange (bounds arr) line) do
- let enclosing_spans = [ t | t@(_,span) <- ticks ! line
- , srcSpanEnd span >= srcSpanEnd src]
- return . snd . head . sortBy leftmost_largest $ enclosing_spans
-
-lexicalSubSpanOf :: SrcSpan -> SrcSpan -> Bool
-lexicalSubSpanOf src parent
- | GHC.srcSpanFile parent /= GHC.srcSpanFile src = False
- | otherwise = srcSpanStart parent <= srcSpanStart src &&
- srcSpanEnd parent >= srcSpanEnd src
-
traceCmd :: String -> GHCi ()
traceCmd [] = doContinue (const True) GHC.RunAndLogSteps
traceCmd expression = do runStmt expression GHC.RunAndLogSteps; return ()
let hist = GHC.resumeHistory r
(took,rest) = splitAt num hist
spans <- mapM (io . GHC.getHistorySpan s) took
- let nums = map (printf "-%-3d:") [(1::Int)..]
- printForUser (vcat (zipWith (<+>) (map text nums) (map ppr spans)))
+ let nums = map (printf "-%-3d:") [(1::Int)..]
+ let names = map GHC.historyEnclosingDecl took
+ printForUser (vcat(zipWith3
+ (\x y z -> x <+> y <+> z)
+ (map text nums)
+ (map (bold . ppr) names)
+ (map (parens . ppr) spans)))
io $ putStrLn $ if null rest then "<end of history>" else "..."
+bold c | do_bold = text start_bold <> c <> text end_bold
+ | otherwise = c
+
backCmd :: String -> GHCi ()
backCmd = noArgs $ do
s <- getSession
findBreakByLine line arr
| not (inRange (bounds arr) line) = Nothing
| otherwise =
- listToMaybe (sortBy leftmost_largest complete) `mplus`
- listToMaybe (sortBy leftmost_smallest incomplete) `mplus`
- listToMaybe (sortBy rightmost ticks)
+ listToMaybe (sortBy (leftmost_largest `on` snd) complete) `mplus`
+ listToMaybe (sortBy (leftmost_smallest `on` snd) incomplete) `mplus`
+ listToMaybe (sortBy (rightmost `on` snd) ticks)
where
ticks = arr ! line
findBreakByCoord mb_file (line, col) arr
| not (inRange (bounds arr) line) = Nothing
| otherwise =
- listToMaybe (sortBy rightmost contains) `mplus`
- listToMaybe (sortBy leftmost_smallest after_here)
+ listToMaybe (sortBy (rightmost `on` snd) contains ++
+ sortBy (leftmost_smallest `on` snd) after_here)
where
ticks = arr ! line
GHC.srcSpanStartLine span == line,
GHC.srcSpanStartCol span >= col ]
-
-leftmost_smallest (_,a) (_,b) = a `compare` b
-leftmost_largest (_,a) (_,b) = (GHC.srcSpanStart a `compare` GHC.srcSpanStart b)
- `thenCmp`
- (GHC.srcSpanEnd b `compare` GHC.srcSpanEnd a)
-rightmost (_,a) (_,b) = b `compare` a
-
-spans :: SrcSpan -> (Int,Int) -> Bool
-spans span (l,c) = GHC.srcSpanStart span <= loc && loc <= GHC.srcSpanEnd span
- where loc = GHC.mkSrcLoc (GHC.srcSpanFile span) l c
-
-- for now, use ANSI bold on Unixy systems. On Windows, we add a line
-- of carets under the active expression instead. The Windows console
-- doesn't support ANSI escape sequences, and most Unix terminals
do_bold = False
#endif
-start_bold = BS.pack "\ESC[1m"
-end_bold = BS.pack "\ESC[0m"
+start_bold = "\ESC[1m"
+end_bold = "\ESC[0m"
listCmd :: String -> GHCi ()
listCmd "" = do
= let (a,r) = BS.splitAt col1 line
(b,c) = BS.splitAt (col2-col1) r
in
- BS.concat [a,start_bold,b,end_bold,c]
+ BS.concat [a,BS.pack start_bold,b,BS.pack end_bold,c]
| no == line1
= let (a,b) = BS.splitAt col1 line in
- BS.concat [a, start_bold, b]
+ BS.concat [a, BS.pack start_bold, b]
| no == line2
= let (a,b) = BS.splitAt col2 line in
- BS.concat [a, end_bold, b]
+ BS.concat [a, BS.pack end_bold, b]
| otherwise = line
highlight_carets no line
projects / ghc-hetmet.git / blobdiff