mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 13:00:26 +02:00
Code Activity

,frame and related commands handle for-trap? appropriately

Browse source 
* 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?.
This commit is contained in:
Andy Wingo 2010-10-12 13:24:46 +02:00
parent 5414d33376
commit 5aa12c699c
2 changed files with 26 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

22
module/system/repl/command.scm
View file

@ -472,6 +472,8 @@ Trace execution."
(identifier-syntax (debug-frames debug))) (identifier-syntax (debug-frames debug)))
(#,(datum->syntax #'repl 'message) (#,(datum->syntax #'repl 'message)
(identifier-syntax (debug-error-message debug))) (identifier-syntax (debug-error-message debug)))
(#,(datum->syntax #'repl 'for-trap?)
(identifier-syntax (debug-for-trap? debug)))
(#,(datum->syntax #'repl 'index) (#,(datum->syntax #'repl 'index)
(identifier-syntax (identifier-syntax
(id (debug-index debug)) (id (debug-index debug))
@ -493,7 +495,8 @@ If COUNT is negative, the last COUNT frames will be shown."
(print-frames frames (print-frames frames
#:count count #:count count
#:width width #:width width
#:full? full?)) #:full? full?
#:for-trap? for-trap?))
(define-stack-command (up repl #:optional (count 1)) (define-stack-command (up repl #:optional (count 1))
"up [COUNT] "up [COUNT]
@ -510,10 +513,12 @@ An argument says how many frames up to go."
(format #t "Already at outermost frame.\n")) (format #t "Already at outermost frame.\n"))
(else (else
(set! index (1- (vector-length frames))) (set! index (1- (vector-length frames)))
(print-frame cur #:index index)))) (print-frame cur #:index index
#:next-source? (and (zero? index) for-trap?)))))
(else (else
(set! index (+ count index)) (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)) (define-stack-command (down repl #:optional (count 1))
"down [COUNT] "down [COUNT]
@ -530,10 +535,11 @@ An argument says how many frames down to go."
(format #t "Already at innermost frame.\n")) (format #t "Already at innermost frame.\n"))
(else (else
(set! index 0) (set! index 0)
(print-frame cur #:index index)))) (print-frame cur #:index index #:next-source? for-trap?))))
(else (else
(set! index (- index count)) (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) (define-stack-command (frame repl #:optional idx)
"frame [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.~%")) (format #t "Invalid argument to `frame': expected a non-negative integer for IDX.~%"))
((< idx (vector-length frames)) ((< idx (vector-length frames))
(set! index idx) (set! index idx)
(print-frame cur #:index index)) (print-frame cur #:index index
#:next-source? (and (zero? index) for-trap?)))
(else (else
(format #t "No such frame.~%")))) (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) (define-stack-command (procedure repl)
"procedure "procedure

16
module/system/repl/debug.scm
View file

@ -99,12 +99,13 @@
(frame-bindings frame)))))) (frame-bindings frame))))))
(define* (print-frame frame #:optional (port (current-output-port)) (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) (define (source:pretty-file source)
(if source (if source
(or (source:file source) "current input") (or (source:file source) "current input")
"unknown file")) "unknown file"))
(let* ((source (frame-source frame)) (let* ((source ((if next-source? frame-next-source frame-source) frame))
(file (source:pretty-file source)) (file (source:pretty-file source))
(line (and=> source source:line-for-user)) (line (and=> source source:line-for-user))
(col (and=> source source:column))) (col (and=> source source:column)))
@ -119,7 +120,8 @@
(define* (print-frames frames (define* (print-frames frames
#:optional (port (current-output-port)) #: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)) (let* ((len (vector-length frames))
(lower-idx (if (or (not count) (positive? count)) (lower-idx (if (or (not count) (positive? count))
0 0
@ -133,8 +135,12 @@
(if (<= lower-idx i upper-idx) (if (<= lower-idx i upper-idx)
(let* ((frame (vector-ref frames i))) (let* ((frame (vector-ref frames i)))
(print-frame frame port #:index i #:width width #:full? full? (print-frame frame port #:index i #:width width #:full? full?
#:last-source last-source) #:last-source last-source
(lp (+ i inc) (frame-source frame))))))) #: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 ;; 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 ;; local var that is not settable would raise an error, and export etc forms