finally, backtraces only showing frames for the computation

* module/system/repl/repl.scm (run-repl): Run the thunk in a stack in a
  prompt, similar to the default prompt. Gives proper backtraces.

* module/system/repl/error-handling.scm (call-with-error-handling):
  Narrow one more outer frame, for the %start-stack thunk invocation.

* module/ice-9/boot-9.scm (%start-stack): Reindent.

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index f8b3eb0..e7ef923 100644 (file)
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1056,7 +1056,7 @@ If there is no handler at all, Guile prints an error and then exits."
                                      (or (fluid-ref %stacks) '()))))
          (thunk)))
      (lambda (k . args)
-              (%start-stack tag (lambda () (apply k args)))))))
+       (%start-stack tag (lambda () (apply k args)))))))
 (define-syntax start-stack
   (syntax-rules ()
     ((_ tag exp)

diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm
index d7d43bd..28b5428 100644 (file)
--- a/module/system/repl/error-handling.scm
+++ b/module/system/repl/error-handling.scm
@@ -88,15 +88,19 @@
                 (format #t " or `,q' to return to the old prompt.\n")
                 (let ((debug
                        (make-debug
-                        (narrow-stack->vector
-                         stack
-                         ;; Cut three frames from the top of the stack:
-                         ;; make-stack, this one, and the throw handler.
-                         3 
-                         ;; Narrow the end of the stack to the most recent
-                         ;; start-stack.
-                         (and (pair? (fluid-ref %stacks))
-                              (cdar (fluid-ref %stacks))))
+                        (let ((tag (and (pair? (fluid-ref %stacks))
+                                        (cdar (fluid-ref %stacks)))))
+                          (narrow-stack->vector
+                           stack
+                           ;; Cut three frames from the top of the stack:
+                           ;; make-stack, this one, and the throw handler.
+                           3 
+                           ;; Narrow the end of the stack to the most recent
+                           ;; start-stack.
+                           tag
+                           ;; And one more frame, because %start-stack invoking
+                           ;; the start-stack thunk has its own frame too.
+                           0 (and tag 1)))
                         0)))
                   ((@ (system repl repl) start-repl) #:debug debug)))))))
         ((pass)

diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index fba6776..21998ba 100644 (file)
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -106,6 +106,12 @@
          (abort))))))
 
 (define (run-repl repl)
+  (define (with-stack-and-prompt thunk)
+    (call-with-prompt (default-prompt-tag)
+                      (lambda () (start-stack #t (thunk)))
+                      (lambda (k proc)
+                        (with-stack-and-prompt (lambda () (proc k))))))
+  
   (% (with-fluids ((*repl-stack*
                     (cons repl (or (fluid-ref *repl-stack*) '()))))
        (if (null? (cdr (fluid-ref *repl-stack*)))
@@ -140,7 +146,7 @@
                                          (repl-parse repl exp))))))
                                (run-hook before-eval-hook exp)
                                (with-error-handling
-                                 (start-stack #t (% (thunk)))))
+                                 (with-stack-and-prompt thunk)))
                              (lambda (k) (values))))
                       (lambda l
                         (for-each (lambda (v)