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:
parent
3f686b10a2
commit
0ea632464e
1 changed files with 52 additions and 21 deletions
|
@ -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)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue