X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=a926bdcdc3cc97c0c081d91e5a7e36940896d816;hb=24ee75415832b05f53726f2bbdf52972b1cfb613;hp=aacf8b3e621f01e1dddd1fff556b1264af2a7dab;hpb=68a8c3bbab3a77a982fcac980e69f47b4ec13dfd;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index aacf8b3..a926bdc 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -186,6 +186,7 @@ helpText = " :sprint [ ...] simplifed version of :print\n" ++ " :step single-step after stopping at a breakpoint\n"++ " :step single-step into \n"++ + " :stepover (locally) single-step over function applications"++ " :trace trace after stopping at a breakpoint\n"++ " :trace trace into (remembers breakpoints for :history)\n"++ @@ -642,6 +643,21 @@ lookupCommand str = do 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 @@ -666,7 +682,7 @@ getCurrentBreakModule = do (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 @@ -892,8 +908,6 @@ checkModule m = do 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) @@ -1550,29 +1564,37 @@ stepCmd expression = do runStmt expression GHC.SingleStep; return () stepOverCmd [] = do mb_span <- getCurrentBreakSpan + session <- getSession 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 || - head allTicksRightmost == loc + head allTicksRightmost == curr_loc 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 - 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 (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] @@ -1585,15 +1607,6 @@ ticksIn mod src = do , 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 () @@ -1652,10 +1665,13 @@ historyCmd arg printForUser (vcat(zipWith3 (\x y z -> x <+> y <+> z) (map text nums) - (map (ftext . occNameFS . nameOccName) names) + (map (bold . ppr) names) (map (parens . ppr) spans))) io $ putStrLn $ if null rest then "" else "..." +bold c | do_bold = text start_bold <> c <> text end_bold + | otherwise = c + backCmd :: String -> GHCi () backCmd = noArgs $ do s <- getSession @@ -1809,8 +1825,8 @@ do_bold = True 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 @@ -1901,13 +1917,13 @@ listAround span do_highlight = 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