2
(define-module (ice-9 debugger utils)
3
#:use-module (ice-9 debugger state)
4
#:export (display-position
8
write-frame-short/expression
9
write-frame-short/application
14
;;; Procedures in this module print information about a stack frame.
15
;;; The available information is as follows.
17
;;; * Source code location.
19
;;; For an evaluation frame, this is the location recorded at the time
20
;;; that the expression being evaluated was read, if the 'positions
21
;;; read option was enabled at that time.
23
;;; For an application frame, I'm not yet sure. Some applications
24
;;; seem to have associated source expressions.
26
;;; * Whether frame is still evaluating its arguments.
28
;;; Only applies to an application frame. For example, an expression
29
;;; like `(+ (* 2 3) 4)' goes through the following stages of
32
;;; (+ (* 2 3) 4) -- evaluation
33
;;; [+ ... -- application; the car of the evaluation
34
;;; has been evaluated and found to be a
35
;;; procedure; before this procedure can
36
;;; be applied, its arguments must be evaluated
37
;;; [+ 6 ... -- same application after evaluating the
39
;;; [+ 6 4] -- same application after evaluating all
43
;;; * Whether frame is real or tail-recursive.
45
;;; If a frame is tail-recursive, its containing frame as shown by the
46
;;; debugger backtrace doesn't really exist as far as the Guile
47
;;; evaluator is concerned. The effect of this is that when a
48
;;; tail-recursive frame returns, it looks as though its containing
49
;;; frame returns at the same time. (And if the containing frame is
50
;;; also tail-recursive, _its_ containing frame returns at that time
51
;;; also, and so on ...)
53
;;; A `real' frame is one that is not tail-recursive.
56
(define (write-state-short state)
57
(let* ((frame (stack-ref (state-stack state) (state-index state)))
58
(source (frame-source frame))
59
(position (and source (source-position source))))
60
(format #t "Frame ~A at " (frame-number frame))
62
(display-position position)
63
(display "unknown source location"))
66
(write-frame-short frame)
69
(define (write-state-short* stack index)
70
(write-frame-index-short stack index)
72
(write-frame-short (stack-ref stack index))
75
(define (write-frame-index-short stack index)
76
(let ((s (number->string (frame-number (stack-ref stack index)))))
79
(write-chars #\space (- 4 (string-length s)))))
81
(define (write-frame-short frame)
82
(if (frame-procedure? frame)
83
(write-frame-short/application frame)
84
(write-frame-short/expression frame)))
86
(define (write-frame-short/application frame)
88
(write (let ((procedure (frame-procedure frame)))
89
(or (and (procedure? procedure)
90
(procedure-name procedure))
92
(if (frame-evaluating-args? frame)
95
(for-each (lambda (argument)
98
(frame-arguments frame))
101
;;; Use builtin function instead:
102
(set! write-frame-short/application
104
(display-application frame (current-output-port) 12)))
106
(define (write-frame-short/expression frame)
107
(write (let* ((source (frame-source frame))
108
(copy (source-property source 'copy)))
111
(unmemoize-expr source)))))
113
(define (write-state-long state)
114
(let ((index (state-index state)))
115
(let ((frame (stack-ref (state-stack state) index)))
116
(write-frame-index-long frame)
117
(write-frame-long frame))))
119
(define (write-frame-index-long frame)
120
(display "Stack frame: ")
121
(write (frame-number frame))
122
(if (frame-real? frame)
126
(define (write-frame-long frame)
127
(if (frame-procedure? frame)
128
(write-frame-long/application frame)
129
(write-frame-long/expression frame)))
131
(define (write-frame-long/application frame)
132
(display "This frame is an application.")
134
(if (frame-source frame)
136
(display "The corresponding expression is:")
138
(display-source frame)
140
(display "The procedure being applied is: ")
141
(write (let ((procedure (frame-procedure frame)))
142
(or (and (procedure? procedure)
143
(procedure-name procedure))
146
(display "The procedure's arguments are")
147
(if (frame-evaluating-args? frame)
148
(display " being evaluated.")
151
(write (frame-arguments frame))))
154
(define (display-source frame)
155
(let* ((source (frame-source frame))
156
(copy (source-property source 'copy)))
157
(cond ((source-position source)
158
=> (lambda (p) (display-position p) (display ":\n"))))
160
(write (or copy (unmemoize-expr source)))))
162
(define (source-position source)
163
(let ((fname (source-property source 'filename))
164
(line (source-property source 'line))
165
(column (source-property source 'column)))
167
(list fname line column))))
169
(define (display-position pos)
170
(format #t "~A:~D:~D" (car pos) (+ 1 (cadr pos)) (+ 1 (caddr pos))))
172
(define (write-frame-long/expression frame)
173
(display "This frame is an evaluation.")
175
(display "The expression being evaluated is:")
177
(display-source frame)
180
(define (write-frame-args-long frame)
181
(if (frame-procedure? frame)
182
(let ((arguments (frame-arguments frame)))
183
(let ((n (length arguments)))
184
(display "This frame has ")
186
(display " argument")
189
(write-char (if (null? arguments) #\. #\:))
191
(for-each (lambda (argument)
197
(display "This frame is an evaluation frame; it has no arguments.")
200
(define (write-chars char n)
added
removed
ice-9/debugger/utils.scm
