Replace _scc_'s in the GHC source with SCC pragmas
[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs
index f0a8fb4..179f259 100644 (file)
@@ -186,6 +186,7 @@ helpText =
  "   :sprint [<name> ...]        simplifed version of :print\n" ++
  "   :step                       single-step after stopping at a breakpoint\n"++
  "   :step <expr>                single-step into <expr>\n"++
+ "   :stepover                   single-step without following function applications\n"++
  "   :trace                      trace after stopping at a breakpoint\n"++
  "   :trace <expr>               trace into <expr> (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
@@ -1554,13 +1555,13 @@ 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 
@@ -1570,7 +1571,7 @@ stepOverCmd [] = do
  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 +1586,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 +1648,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 "<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
@@ -1765,9 +1768,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 +1785,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 +1802,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 +1813,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 +1905,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