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, 50 insertions, 40 deletions

diff --git a/rts/Printer.c b/rts/Printer.c
index 637cd9a861..e2fa57c306 100644
--- a/rts/Printer.c
+++ b/rts/Printer.c
@@ -17,6 +17,10 @@
 #include "Printer.h"
 #include "RtsUtils.h"
 
+#ifdef PROFILING
+#include "Profiling.h"
+#endif
+
 #include <string.h>
 
 #ifdef DEBUG
@@ -422,42 +426,6 @@ void printGraph( StgClosure *obj )
 }
 */
 
-StgPtr
-printStackObj( StgPtr sp )
-{
-    /*debugBelch("Stack[%d] = ", &stgStack[STACK_SIZE] - sp); */
-
-        StgClosure* c = (StgClosure*)(*sp);
-        printPtr((StgPtr)*sp);
-        if (c == (StgClosure*)&stg_ctoi_R1p_info) {
-           debugBelch("\t\t\tstg_ctoi_ret_R1p_info\n" );
-        } else
-        if (c == (StgClosure*)&stg_ctoi_R1n_info) {
-           debugBelch("\t\t\tstg_ctoi_ret_R1n_info\n" );
-        } else
-        if (c == (StgClosure*)&stg_ctoi_F1_info) {
-           debugBelch("\t\t\tstg_ctoi_ret_F1_info\n" );
-        } else
-        if (c == (StgClosure*)&stg_ctoi_D1_info) {
-           debugBelch("\t\t\tstg_ctoi_ret_D1_info\n" );
-        } else
-        if (c == (StgClosure*)&stg_ctoi_V_info) {
-           debugBelch("\t\t\tstg_ctoi_ret_V_info\n" );
-        } else
-        if (get_itbl(c)->type == BCO) {
-           debugBelch("\t\t\t");
-           debugBelch("BCO(...)\n");
-        }
-        else {
-           debugBelch("\t\t\t");
-           printClosure ( (StgClosure*)(*sp));
-        }
-        sp += 1;
-
-    return sp;
-
-}
-
 static void
 printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap, nat size )
 {
@@ -513,15 +481,58 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
         case CATCH_FRAME:
         case UNDERFLOW_FRAME:
         case STOP_FRAME:
-            printObj((StgClosure*)sp);
+            printClosure((StgClosure*)sp);
             continue;
 
-        case RET_SMALL:
-            debugBelch("RET_SMALL (%p)\n", info);
+        case RET_SMALL: {
+            StgWord c = *sp;
+            if (c == (StgWord)&stg_ctoi_R1p_info) {
+                debugBelch("tstg_ctoi_ret_R1p_info\n" );
+            } else if (c == (StgWord)&stg_ctoi_R1n_info) {
+                debugBelch("stg_ctoi_ret_R1n_info\n" );
+            } else if (c == (StgWord)&stg_ctoi_F1_info) {
+                debugBelch("stg_ctoi_ret_F1_info\n" );
+            } else if (c == (StgWord)&stg_ctoi_D1_info) {
+                debugBelch("stg_ctoi_ret_D1_info\n" );
+            } else if (c == (StgWord)&stg_ctoi_V_info) {
+                debugBelch("stg_ctoi_ret_V_info\n" );
+            } else if (c == (StgWord)&stg_ap_v_info) {
+                debugBelch("stg_ap_v_info\n" );
+            } else if (c == (StgWord)&stg_ap_f_info) {
+                debugBelch("stg_ap_f_info\n" );
+            } else if (c == (StgWord)&stg_ap_d_info) {
+                debugBelch("stg_ap_d_info\n" );
+            } else if (c == (StgWord)&stg_ap_l_info) {
+                debugBelch("stg_ap_l_info\n" );
+            } else if (c == (StgWord)&stg_ap_n_info) {
+                debugBelch("stg_ap_n_info\n" );
+            } else if (c == (StgWord)&stg_ap_p_info) {
+                debugBelch("stg_ap_p_info\n" );
+            } else if (c == (StgWord)&stg_ap_pp_info) {
+                debugBelch("stg_ap_pp_info\n" );
+            } else if (c == (StgWord)&stg_ap_ppp_info) {
+                debugBelch("stg_ap_ppp_info\n" );
+            } else if (c == (StgWord)&stg_ap_pppp_info) {
+                debugBelch("stg_ap_pppp_info\n" );
+            } else if (c == (StgWord)&stg_ap_ppppp_info) {
+                debugBelch("stg_ap_ppppp_info\n" );
+            } else if (c == (StgWord)&stg_ap_pppppp_info) {
+                debugBelch("stg_ap_pppppp_info\n" );
+#ifdef PROFILING
+            } else if (c == (StgWord)&stg_restore_cccs_info) {
+                debugBelch("stg_restore_cccs_info\n" );
+                fprintCCS(stderr, (CostCentreStack*)sp[1]);
+                debugBelch("\n" );
+                continue;
+#endif
+            } else {
+                debugBelch("RET_SMALL (%p)\n", info);
+            }
             bitmap = info->layout.bitmap;
             printSmallBitmap(spBottom, sp+1,
                              BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap));
             continue;
+        }
 
         case RET_BCO: {
             StgBCO *bco;
@@ -963,4 +974,3 @@ void
 info_hdr_type(StgClosure *closure, char *res){
   strcpy(res,closure_type_names[get_itbl(closure)->type]);
 }
-