X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=d7de9404e365cc2745edf6fc22632fa7e4e58e58;hb=99794f66b568709176dd9fc2248a57a21a165556;hp=f0a8fb4a1483bd5c6b1e38d23d99e54e5656ea3f;hpb=fcd7ba21a64c12b6e0f1053892d2698ae7d29f81;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index f0a8fb4..d7de940 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 single-step without following function applications\n"++ " :trace trace after stopping at a breakpoint\n"++ " :trace trace into (remembers breakpoints for :history)\n"++ @@ -464,7 +465,7 @@ mkPrompt = do 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 @@ -666,7 +667,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 +893,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) @@ -1554,23 +1553,23 @@ stepOverCmd [] = do Nothing -> stepCmd [] Just loc -> do Just mod <- getCurrentBreakModule - parent <- enclosingSubSpan mod loc - allTicksRightmost <- sortBy rightmost `fmap` + parent <- enclosingTickSpan mod loc + allTicksRightmost <- (sortBy rightmost . map snd) `fmap` ticksIn mod parent let lastTick = null allTicksRightmost || - snd(head allTicksRightmost) == loc + head allTicksRightmost == loc if not lastTick - then doContinue (`lexicalSubSpanOf` parent) GHC.SingleStep + then doContinue (`isSubspanOf` parent) GHC.SingleStep else doContinue (const True) GHC.SingleStep - where +stepOverCmd expression = stepCmd expression {- So, the only tricky part 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 -} @@ -1585,20 +1584,14 @@ ticksIn mod src = do , srcSpanEnd src >= srcSpanEnd span ] -enclosingSubSpan :: Module -> SrcSpan -> GHCi SrcSpan -enclosingSubSpan mod src = do +enclosingTickSpan :: Module -> SrcSpan -> GHCi SrcSpan +enclosingTickSpan 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 + 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 @@ -1653,10 +1646,18 @@ historyCmd arg 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 "" else "..." +bold c | do_bold = text start_bold <> c <> text end_bold + | otherwise = c + backCmd :: String -> GHCi () backCmd = noArgs $ do s <- getSession @@ -1765,9 +1766,9 @@ findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,SrcSpan) 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 @@ -1782,8 +1783,8 @@ findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray 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 @@ -1799,17 +1800,6 @@ findBreakByCoord mb_file (line, col) arr 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 @@ -1821,8 +1811,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 @@ -1913,13 +1903,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