From: Andy Wingo <wingo@pobox.com>
Date: Tue, 12 Oct 2010 11:24:46 +0000 (+0200)
Subject: ,frame and related commands handle for-trap? appropriately
X-Git-Url: http://git.hcoop.net/bpt/guile.git/commitdiff_plain/5aa12c699c126e5880649223dba94e6b0ef730b9

,frame and related commands handle for-trap? appropriately

* module/system/repl/debug.scm (print-frame): Add #:next-source? arg,
  for when print-frame should use frame-next-source instead of
  frame-source.
  (print-frames): Add #:for-trap? arg. If true, the 0th frame should be
  printed with frame-next-source.

* module/system/repl/command.scm (define-stack-command): Introduce
  for-trap? into the lexical env.
  (backtrace, up, down, frame): Update to do the right thing regarding
  #:for-trap?.
---

diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index e58b1167d..4fc203806 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -472,6 +472,8 @@ Trace execution."
                        (identifier-syntax (debug-frames debug)))
                       (#,(datum->syntax #'repl 'message)
                        (identifier-syntax (debug-error-message debug)))
+                      (#,(datum->syntax #'repl 'for-trap?)
+                       (identifier-syntax (debug-for-trap? debug)))
                       (#,(datum->syntax #'repl 'index)
                        (identifier-syntax
                         (id (debug-index debug))
@@ -493,7 +495,8 @@ If COUNT is negative, the last COUNT frames will be shown."
   (print-frames frames
                 #:count count
                 #:width width
-                #:full? full?))
+                #:full? full?
+                #:for-trap? for-trap?))
 
 (define-stack-command (up repl #:optional (count 1))
   "up [COUNT]
@@ -510,10 +513,12 @@ An argument says how many frames up to go."
       (format #t "Already at outermost frame.\n"))
      (else
       (set! index (1- (vector-length frames)))
-      (print-frame cur #:index index))))
+      (print-frame cur #:index index
+                   #:next-source? (and (zero? index) for-trap?)))))
    (else
     (set! index (+ count index))
-    (print-frame cur #:index index))))
+    (print-frame cur #:index index
+                 #:next-source? (and (zero? index) for-trap?)))))
 
 (define-stack-command (down repl #:optional (count 1))
   "down [COUNT]
@@ -530,10 +535,11 @@ An argument says how many frames down to go."
       (format #t "Already at innermost frame.\n"))
      (else
       (set! index 0)
-      (print-frame cur #:index index))))
+      (print-frame cur #:index index #:next-source? for-trap?))))
    (else
     (set! index (- index count))
-    (print-frame cur #:index index))))
+    (print-frame cur #:index index
+                 #:next-source? (and (zero? index) for-trap?)))))
 
 (define-stack-command (frame repl #:optional idx)
   "frame [IDX]
@@ -548,10 +554,12 @@ With an argument, select a frame by index, then show it."
       (format #t "Invalid argument to `frame': expected a non-negative integer for IDX.~%"))
      ((< idx (vector-length frames))
       (set! index idx)
-      (print-frame cur #:index index))
+      (print-frame cur #:index index
+                   #:next-source? (and (zero? index) for-trap?)))
      (else
       (format #t "No such frame.~%"))))
-   (else (print-frame cur #:index index))))
+   (else (print-frame cur #:index index
+                      #:next-source? (and (zero? index) for-trap?)))))
 
 (define-stack-command (procedure repl)
   "procedure
diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index 61ecf84bb..46ea6b4db 100644
--- a/module/system/repl/debug.scm
+++ b/module/system/repl/debug.scm
@@ -99,12 +99,13 @@
        (frame-bindings frame))))))
 
 (define* (print-frame frame #:optional (port (current-output-port))
-                      #:key index (width 72) (full? #f) (last-source #f))
+                      #:key index (width 72) (full? #f) (last-source #f)
+                      next-source?)
   (define (source:pretty-file source)
     (if source
         (or (source:file source) "current input")
         "unknown file"))
-  (let* ((source (frame-source frame))
+  (let* ((source ((if next-source? frame-next-source frame-source) frame))
          (file (source:pretty-file source))
          (line (and=> source source:line-for-user))
          (col (and=> source source:column)))
@@ -119,7 +120,8 @@
 
 (define* (print-frames frames
                        #:optional (port (current-output-port))
-                       #:key (width 72) (full? #f) (forward? #f) count)
+                       #:key (width 72) (full? #f) (forward? #f) count
+                       for-trap?)
   (let* ((len (vector-length frames))
          (lower-idx (if (or (not count) (positive? count))
                         0
@@ -133,8 +135,12 @@
       (if (<= lower-idx i upper-idx)
           (let* ((frame (vector-ref frames i)))
             (print-frame frame port #:index i #:width width #:full? full?
-                         #:last-source last-source)
-            (lp (+ i inc) (frame-source frame)))))))
+                         #:last-source last-source
+                         #:next-source? (and (zero? i) for-trap?))
+            (lp (+ i inc)
+                (if (and (zero? i) for-trap?)
+                    (frame-next-source frame)
+                    (frame-source frame))))))))
 
 ;; Ideally here we would have something much more syntactic, in that a set! to a
 ;; local var that is not settable would raise an error, and export etc forms