Maintain cost-centre stacks in the interpreter

Summary:
Breakpoints become SCCs, so we have detailed call-stack info for
interpreted code.  Currently this only works when GHC is compiled with
-prof, but D1562 (Remote GHCi) removes this constraint so that in the
future call stacks will be available without building your own GHCi.

How can you get a stack trace?

* programmatically: GHC.Stack.currentCallStack
* I've added an experimental :where command that shows the stack when
  stopped at a breakpoint
* `error` attaches a call stack automatically, although since calls to
  `error` are often lifted out to the top level, this is less useful
  than it might be (ImplicitParams still works though).
* Later we might attach call stacks to all exceptions

Other related changes in this diff:

* I reduced the number of places that get ticks attached for
  breakpoints.  In particular there was a breakpoint around the whole
  declaration, which was often redundant because it bound no variables.
  This reduces clutter in the stack traces and speeds up compilation.

* I tidied up some RealSrcSpan stuff in InteractiveUI, and made a few
  other small cleanups

Test Plan: validate

Reviewers: ezyang, bgamari, austin, hvr

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1595

GHC Trac Issues: #11047

1 files changed, 42 insertions, 41 deletions

diff --git a/compiler/main/BreakArray.hs b/compiler/main/BreakArray.hs
index 9b84931390..447490266c 100644
--- a/compiler/main/BreakArray.hs
+++ b/compiler/main/BreakArray.hs
@@ -2,13 +2,16 @@
 
 -------------------------------------------------------------------------------
 --
--- | Break Arrays in the IO monad
+-- (c) The University of Glasgow 2007
 --
--- Entries in the array are Word sized Conceptually, a zero-indexed IOArray of
--- Bools, initially False.  They're represented as Words with 0==False, 1==True.
--- They're used to determine whether GHCI breakpoints are on or off.
+-- | Break Arrays
 --
--- (c) The University of Glasgow 2007
+-- An array of bytes, indexed by a breakpoint number (breakpointId in Tickish)
+-- There is one of these arrays per module.
+--
+-- Each byte is
+--   1 if the corresponding breakpoint is enabled
+--   0 otherwise
 --
 -------------------------------------------------------------------------------
 
@@ -27,10 +30,10 @@ module BreakArray
 #endif
     ) where
 
-import DynFlags
-
 #ifdef GHCI
 import Control.Monad
+import Data.Word
+import GHC.Word
 
 import GHC.Exts
 import GHC.IO ( IO(..) )
@@ -38,43 +41,43 @@ import System.IO.Unsafe ( unsafeDupablePerformIO )
 
 data BreakArray = BA (MutableByteArray# RealWorld)
 
-breakOff, breakOn :: Word
+breakOff, breakOn :: Word8
 breakOn  = 1
 breakOff = 0
 
-showBreakArray :: DynFlags -> BreakArray -> IO ()
-showBreakArray dflags array = do
-    forM_ [0 .. (size dflags array - 1)] $ \i -> do
+showBreakArray :: BreakArray -> IO ()
+showBreakArray array = do
+    forM_ [0 .. (size array - 1)] $ \i -> do
         val <- readBreakArray array i
         putStr $ ' ' : show val
     putStr "\n"
 
-setBreakOn :: DynFlags -> BreakArray -> Int -> IO Bool
-setBreakOn dflags array index
-    | safeIndex dflags array index = do
+setBreakOn :: BreakArray -> Int -> IO Bool
+setBreakOn array index
+    | safeIndex array index = do
           writeBreakArray array index breakOn
           return True
     | otherwise = return False
 
-setBreakOff :: DynFlags -> BreakArray -> Int -> IO Bool
-setBreakOff dflags array index
-    | safeIndex dflags array index = do
+setBreakOff :: BreakArray -> Int -> IO Bool
+setBreakOff array index
+    | safeIndex array index = do
           writeBreakArray array index breakOff
           return True
     | otherwise = return False
 
-getBreak :: DynFlags -> BreakArray -> Int -> IO (Maybe Word)
-getBreak dflags array index
-    | safeIndex dflags array index = do
+getBreak :: BreakArray -> Int -> IO (Maybe Word8)
+getBreak array index
+    | safeIndex array index = do
           val <- readBreakArray array index
           return $ Just val
     | otherwise = return Nothing
 
-safeIndex :: DynFlags -> BreakArray -> Int -> Bool
-safeIndex dflags array index = index < size dflags array && index >= 0
+safeIndex :: BreakArray -> Int -> Bool
+safeIndex array index = index < size array && index >= 0
 
-size :: DynFlags -> BreakArray -> Int
-size dflags (BA array) = size `div` wORD_SIZE dflags
+size :: BreakArray -> Int
+size (BA array) = size
   where
     -- We want to keep this operation pure. The mutable byte array
     -- is never resized so this is safe.
@@ -90,30 +93,28 @@ allocBA (I# sz) = IO $ \s1 ->
     case newByteArray# sz s1 of { (# s2, array #) -> (# s2, BA array #) }
 
 -- create a new break array and initialise elements to zero
-newBreakArray :: DynFlags -> Int -> IO BreakArray
-newBreakArray dflags entries@(I# sz) = do
-    BA array <- allocBA (entries * wORD_SIZE dflags)
+newBreakArray :: Int -> IO BreakArray
+newBreakArray entries@(I# sz) = do
+    BA array <- allocBA entries
     case breakOff of
-        W# off -> do    -- Todo: there must be a better way to write zero as a Word!
-            let loop n | isTrue# (n ==# sz) = return ()
-                       | otherwise = do
-                             writeBA# array n off
-                             loop (n +# 1#)
-            loop 0#
+        W8# off -> do
+           let loop n | isTrue# (n ==# sz) = return ()
+                      | otherwise = do writeBA# array n off; loop (n +# 1#)
+           loop 0#
     return $ BA array
 
 writeBA# :: MutableByteArray# RealWorld -> Int# -> Word# -> IO ()
 writeBA# array i word = IO $ \s ->
-    case writeWordArray# array i word s of { s -> (# s, () #) }
+    case writeWord8Array# array i word s of { s -> (# s, () #) }
 
-writeBreakArray :: BreakArray -> Int -> Word -> IO ()
-writeBreakArray (BA array) (I# i) (W# word) = writeBA# array i word
+writeBreakArray :: BreakArray -> Int -> Word8 -> IO ()
+writeBreakArray (BA array) (I# i) (W8# word) = writeBA# array i word
 
-readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word
+readBA# :: MutableByteArray# RealWorld -> Int# -> IO Word8
 readBA# array i = IO $ \s ->
-    case readWordArray# array i s of { (# s, c #) -> (# s, W# c #) }
+    case readWord8Array# array i s of { (# s, c #) -> (# s, W8# c #) }
 
-readBreakArray :: BreakArray -> Int -> IO Word
+readBreakArray :: BreakArray -> Int -> IO Word8
 readBreakArray (BA array) (I# i) = readBA# array i
 
 #else /* !GHCI */
@@ -124,8 +125,8 @@ readBreakArray (BA array) (I# i) = readBA# array i
 -- presumably have a different representation.
 data BreakArray = Unspecified
 
-newBreakArray :: DynFlags -> Int -> IO BreakArray
-newBreakArray _ _ = return Unspecified
+newBreakArray :: Int -> IO BreakArray
+newBreakArray _ = return Unspecified
 
 #endif /* GHCI */