(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))
(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]
(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]
(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]
(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
(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)))
(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
(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