Rewrite the unsafe code dealing with unboxed primitives in RtClosureInspect

[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 4fb9269..3bda8bd 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -186,11 +186,11 @@ helpText =
  "   :forward                    go forward in the history (after :back)\n" ++
  "   :history [<n>]              show the last <n> items in the history (after :trace)\n" ++
  "   :print [<name> ...]         prints a value without forcing its computation\n" ++
+ "   :sprint [<name> ...]        simplifed version of :print\n" ++
  "   :step                       single-step after stopping at a breakpoint\n"++
  "   :step <expr>                single-step into <expr>\n"++
  "   :trace                      trace after stopping at a breakpoint\n"++
  "   :trace <expr>               trace into <expr> (remembers breakpoints for :history)\n"++
- "   :sprint [<name> ...]        simplifed version of :print\n" ++
 
  "\n" ++
  " -- Commands for changing settings:\n" ++
@@ -555,6 +555,7 @@ runCommandEval c = ghciHandle handleEval (doCommand c)
 runStmt :: String -> SingleStep -> GHCi Bool
 runStmt stmt step
  | null (filter (not.isSpace) stmt) = return False
+ | ["import", mod] <- words stmt    = keepGoing setContext ('+':mod)
  | otherwise
  = do st <- getGHCiState
       session <- getSession
@@ -1677,7 +1678,8 @@ findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
 findBreakByCoord mb_file (line, col) arr
   | not (inRange (bounds arr) line) = Nothing
   | otherwise =
-    listToMaybe (sortBy rightmost contains)
+    listToMaybe (sortBy rightmost contains) `mplus`
+    listToMaybe (sortBy leftmost_smallest after_here)
   where 
         ticks = arr ! line
 
@@ -1689,6 +1691,10 @@ findBreakByCoord mb_file (line, col) arr
                  | Just f <- mb_file = GHC.srcSpanFile span == f
                  | otherwise         = True
 
+        after_here = [ tick | tick@(nm,span) <- ticks,
+                              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)
@@ -1700,6 +1706,17 @@ 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
+-- (including xterm) do, so this is a reasonable guess until we have a
+-- proper termcap/terminfo library.
+#if !defined(mingw32_TARGET_OS)
+do_bold = True
+#else
+do_bold = False
+#endif
+
 start_bold = BS.pack "\ESC[1m"
 end_bold   = BS.pack "\ESC[0m"
 
@@ -1784,7 +1801,10 @@ listAround span do_highlight = do
                    | otherwise  = 1
         pad_after = 1
 
-        highlight no line
+        highlight | do_bold   = highlight_bold
+                  | otherwise = highlight_carets
+
+        highlight_bold no line
           | no == line1 && no == line2
           = let (a,r) = BS.splitAt col1 line
                 (b,c) = BS.splitAt (col2-col1) r
@@ -1798,6 +1818,20 @@ listAround span do_highlight = do
             BS.concat [a, end_bold, b]
           | otherwise   = line
 
+        highlight_carets no line
+          | no == line1 && no == line2
+          = BS.concat [line, nl, indent, BS.replicate col1 ' ',
+                                         BS.replicate (col2-col1) '^']
+          | no == line1
+          = BS.concat [line, nl, indent, BS.replicate col1 ' ',
+                                         BS.replicate (BS.length line-col1) '^']
+          | no == line2
+          = BS.concat [line, nl, indent, BS.replicate col2 '^']
+          | otherwise   = line
+         where
+           indent = BS.pack "   "
+           nl = BS.singleton '\n'
+
 -- --------------------------------------------------------------------------
 -- Tick arrays