1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-29 08:20:20 +02:00

* debugger.scm ("backtrace"): Don't pass length param to

display-backtrace if it wasn't explicitly given by the user.
(write-frame-long/application): Also print corresponding source
expression.
("evaluate"): Evaluate in local environment frame, if existent;
Handle errors.
This commit is contained in:
Mikael Djurfeldt 1999-09-12 02:23:13 +00:00
parent 3f686b10a2
commit 0ea632464e

View file

@ -54,9 +54,8 @@
(define (read-and-dispatch-command state port) (define (read-and-dispatch-command state port)
(if (using-readline?) (if (using-readline?)
(set-readline-prompt! debugger-prompt) (set-readline-prompt! debugger-prompt)
(begin (display debugger-prompt))
(display debugger-prompt) (force-output) ;This should not be necessary...
(force-output)))
(let ((token (read-token port))) (let ((token (read-token port)))
(cond ((eof-object? token) (cond ((eof-object? token)
(throw 'exit-debugger)) (throw 'exit-debugger))
@ -529,19 +528,39 @@ frames that were created more recently. N defaults to one."
(write-state-short state) (write-state-short state)
state))) state)))
(define (eval-handler key . args)
(apply display-error
(make-stack #t eval-handler)
(current-output-port)
args)
(throw 'continue))
(define-command "evaluate" '(object) (define-command "evaluate" '(object)
"Evaluate an expression. "Evaluate an expression.
The expression must appear on the same line as the command, The expression must appear on the same line as the command,
however it may be continued over multiple lines." however it may be continued over multiple lines."
(lambda (state expression) (lambda (state expression)
(let ((value (eval expression))) (let ((source (frame-source (stack-ref (state-stack state)
(display ";value: ") (state-index state)))))
(write value)) (if (not source)
state)) (display "No environment for this frame.")
(catch 'continue
(lambda ()
(lazy-catch #t
(lambda ()
(let* ((env (memoized-environment source))
(value (local-eval expression env)))
(display ";value: ")
(write-line value)))
eval-handler))
(lambda args args)))
state)))
(define-command "backtrace" '('optional exact-integer) (define-command "backtrace" '('optional exact-integer)
"Print backtrace of all stack frames, or innermost COUNT frames. "Print backtrace of all stack frames, or innermost COUNT frames.
With a negative argument, print outermost -COUNT frames." With a negative argument, print outermost -COUNT frames.
If the number of frames aren't explicitly given, the debug option
`depth' determines the maximum number of frames printed."
(lambda (state n-frames) (lambda (state n-frames)
(let ((stack (state-stack state))) (let ((stack (state-stack state)))
;; Kludge around lack of call-with-values. ;; Kludge around lack of call-with-values.
@ -552,12 +571,13 @@ With a negative argument, print outermost -COUNT frames."
;;(write-state-short* stack index)) ;;(write-state-short* stack index))
;; ;;
;; Use builtin backtrace instead: ;; Use builtin backtrace instead:
(display-backtrace stack (let ((start (if (memq 'backwards (debug-options))
(current-output-port) start
(if (memq 'backwards (debug-options)) (- end 1)))
start (port (current-output-port)))
(- end 1)) (if n-frames
(- end start)) (display-backtrace stack port start (abs n-frames))
(display-backtrace stack port start)))
))) )))
(let ((end (stack-length stack))) (let ((end (stack-length stack)))
(cond ((or (not n-frames) (>= (abs n-frames) end)) (cond ((or (not n-frames) (>= (abs n-frames) end))
@ -650,7 +670,9 @@ With a negative argument, print outermost -COUNT frames."
(write-char #\])))) (write-char #\]))))
;;; Use builtin function instead: ;;; Use builtin function instead:
(set! write-frame-short/application display-application) (set! write-frame-short/application
(lambda (frame)
(display-application frame (current-output-port) 12)))
(define (write-frame-short/expression frame) (define (write-frame-short/expression frame)
(write (let* ((source (frame-source frame)) (write (let* ((source (frame-source frame))
@ -680,6 +702,12 @@ With a negative argument, print outermost -COUNT frames."
(define (write-frame-long/application frame) (define (write-frame-long/application frame)
(display "This frame is an application.") (display "This frame is an application.")
(newline) (newline)
(if (frame-source frame)
(begin
(display "The corresponding expression is:")
(newline)
(display-source frame)
(newline)))
(display "The procedure being applied is: ") (display "The procedure being applied is: ")
(write (let ((procedure (frame-procedure frame))) (write (let ((procedure (frame-procedure frame)))
(or (and (procedure? procedure) (or (and (procedure? procedure)
@ -694,17 +722,20 @@ With a negative argument, print outermost -COUNT frames."
(write (frame-arguments frame)))) (write (frame-arguments frame))))
(newline)) (newline))
(define (write-frame-long/expression frame) (define (display-source frame)
(display "This frame is an evaluation.")
(newline)
(display "The expression being evaluated is:")
(newline)
(display " ") (display " ")
(write (let* ((source (frame-source frame)) (write (let* ((source (frame-source frame))
(copy (source-property source 'copy))) (copy (source-property source 'copy)))
(if (pair? copy) (if (pair? copy)
copy copy
(unmemoize source)))) (unmemoize source)))))
(define (write-frame-long/expression frame)
(display "This frame is an evaluation.")
(newline)
(display "The expression being evaluated is:")
(newline)
(display-source frame)
(newline)) (newline))
(define (write-frame-args-long frame) (define (write-frame-args-long frame)