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)