1 ;;;; the CL:INSPECT function
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB-IMPL") ;(SB-IMPL, not SB!IMPL, since we're built in warm load.)
14 (defparameter *inspect-length
* 10)
16 ;;; When *INSPECT-UNBOUND-OBJECT-MARKER* occurs in a parts list, it
17 ;;; indicates that that a slot is unbound.
18 (defvar *inspect-unbound-object-marker
* (gensym "INSPECT-UNBOUND-OBJECT-"))
20 (defun inspector (object input-stream output-stream
)
21 (declare (ignore input-stream
))
23 (%inspect object output-stream
))
26 (defvar *inspect-fun
* #'inspector
27 "a function of three arguments OBJECT, INPUT, and OUTPUT which starts an interactive inspector.")
30 (setf (documentation '*inspected
* 'variable
)
31 "the value currently being inspected in CL:INSPECT")
33 (defun inspect (object)
34 (funcall *inspect-fun
* object
*standard-input
* *standard-output
*))
36 (defvar *help-for-inspect
*
39 Q, E - Quit the inspector.
40 <integer> - Inspect the numbered slot.
41 R - Redisplay current inspected object.
42 U - Move upward/backward to previous inspected object.
43 ?, H, Help - Show this help.
44 <other> - Evaluate the input as an expression.
45 Within the inspector, the special variable SB-EXT:*INSPECTED* is bound
46 to the current inspected object, so that it can be referred to in
47 evaluated expressions.
50 (defun %inspect
(*inspected
* s
)
51 (named-let redisplay
() ; "LAMBDA, the ultimate GOTO":-|
52 (multiple-value-bind (description named-p elements
)
53 (inspected-parts *inspected
*)
54 (tty-display-inspected-parts description named-p elements s
)
58 (let (;; KMP idiom, using stream itself as EOF value
59 (command (read *standard-input
* nil
*standard-input
*)))
62 ;; currently-undocumented feature: EOF is handled as Q.
63 ;; If there's ever consensus that this is *the* right
64 ;; thing to do (as opposed to e.g. handling it as U), we
65 ;; could document it. Meanwhile, it seems more Unix-y to
66 ;; do this than to signal an error.
67 (/show0
"THROWing QUIT-INSPECT for EOF")
68 (throw 'quit-inspect nil
))
70 (let ((elements-length (length elements
)))
71 (cond ((< -
1 command elements-length
)
72 (let* ((element (nth command elements
))
73 (value (if named-p
(cdr element
) element
)))
74 (cond ((eq value
*inspect-unbound-object-marker
*)
75 (format s
"~%That slot is unbound.~%")
76 (return-from %inspect
(reread)))
79 ;; If we ever return, then we should be
80 ;; looking at *INSPECTED* again.
81 (return-from %inspect
(redisplay))))))
82 ((zerop elements-length
)
83 (format s
"~%The object contains nothing to inspect.~%")
84 (return-from %inspect
(reread)))
86 (format s
"~%Enter a valid index (~:[0-~W~;0~]).~%"
87 (= elements-length
1) (1- elements-length
))
88 (return-from %inspect
(reread))))))
90 (case (find-symbol (symbol-name command
) *keyword-package
*)
92 (/show0
"THROWing QUIT-INSPECT for :Q or :E")
93 (throw 'quit-inspect nil
))
95 (return-from %inspect
))
97 (return-from %inspect
(redisplay)))
99 (write-string *help-for-inspect
* s
)
100 (return-from %inspect
(reread)))
102 (eval-for-inspect command s
)
103 (return-from %inspect
(reread)))))
105 (eval-for-inspect command s
)
106 (return-from %inspect
(reread)))))))))
108 (defun eval-for-inspect (command stream
)
109 (let ((result-list (restart-case (multiple-value-list (eval command
))
110 (nil () :report
"Return to the inspector."
111 (format stream
"~%returning to the inspector~%")
112 (return-from eval-for-inspect nil
)))))
113 ;; FIXME: Much of this interactive-EVAL logic is shared with
114 ;; the main REPL EVAL and with the debugger EVAL. The code should
115 ;; be shared explicitly.
116 (setf /// // // / / result-list
)
117 (setf +++ ++ ++ + + - - command
)
118 (setf *** ** ** * * (car /))
119 (format stream
"~&~{~S~%~}" /)))
121 (defun tty-display-inspected-parts (description named-p elements stream
)
122 (format stream
"~%~A" description
)
124 (dolist (element elements
)
126 (destructuring-bind (name . value
) element
127 (format stream
"~W. ~A: ~W~%" index name
128 (if (eq value
*inspect-unbound-object-marker
*)
131 (format stream
"~W. ~W~%" index element
))
136 ;;; Destructure an object for inspection, returning
137 ;;; (VALUES DESCRIPTION NAMED-P ELEMENTS),
140 ;;; DESCRIPTION is a summary description of the destructured object,
141 ;;; e.g. "The object is a CONS.~%".
143 ;;; NAMED-P determines what representation is used for elements
144 ;;; of ELEMENTS. If NAMED-P is true, then each element is
145 ;;; (CONS NAME VALUE); otherwise each element is just VALUE.
147 ;;; ELEMENTS is a list of the component parts of OBJECT (whose
148 ;;; representation is determined by NAMED-P).
150 ;;; (The NAMED-P dichotomy is useful because symbols and instances
151 ;;; need to display both a slot name and a value, while lists and
152 ;;; vectors need only display a value.)
153 (defgeneric inspected-parts
(object))
155 (defmethod inspected-parts ((object symbol
))
156 (values (format nil
"The object is a SYMBOL.~%" object
)
158 (list (cons "Name" (symbol-name object
))
159 (cons "Package" (symbol-package object
))
160 (cons "Value" (if (boundp object
)
161 (symbol-value object
)
162 *inspect-unbound-object-marker
*))
163 (cons "Function" (if (fboundp object
)
164 (symbol-function object
)
165 *inspect-unbound-object-marker
*))
166 (cons "Plist" (symbol-plist object
)))))
168 (defun inspected-structure-elements (object)
169 (let ((parts-list '())
170 (info (layout-info (sb-kernel:layout-of object
))))
171 (when (sb-kernel::defstruct-description-p info
)
172 (dolist (dd-slot (dd-slots info
) (nreverse parts-list
))
173 (push (cons (dsd-%name dd-slot
)
174 (funcall (dsd-accessor-name dd-slot
) object
))
177 (defmethod inspected-parts ((object structure-object
))
178 (values (format nil
"The object is a STRUCTURE-OBJECT of type ~S.~%"
181 (inspected-structure-elements object
)))
183 (defun inspected-standard-object-elements (object)
184 (let ((reversed-elements nil
)
185 (class-slots (sb-pcl::class-slots
(class-of object
))))
186 (dolist (class-slot class-slots
(nreverse reversed-elements
))
187 (let* ((slot-name (slot-value class-slot
'sb-pcl
::name
))
188 (slot-value (if (slot-boundp object slot-name
)
189 (slot-value object slot-name
)
190 *inspect-unbound-object-marker
*)))
191 (push (cons slot-name slot-value
) reversed-elements
)))))
193 (defmethod inspected-parts ((object standard-object
))
194 (values (format nil
"The object is a STANDARD-OBJECT of type ~S.~%"
197 (inspected-standard-object-elements object
)))
199 (defmethod inspected-parts ((object funcallable-instance
))
200 (values (format nil
"The object is a FUNCALLABLE-INSTANCE of type ~S.~%"
203 (inspected-structure-elements object
)))
205 (defmethod inspected-parts ((object function
))
206 (let* ((type (sb-kernel:widetag-of object
))
207 (object (if (= type sb-vm
:closure-header-widetag
)
208 (sb-kernel:%closure-fun object
)
210 (values (format nil
"FUNCTION ~S.~@[~%Argument List: ~A~]." object
211 (sb-kernel:%simple-fun-arglist object
)
212 ;; Defined-from stuff used to be here. Someone took
213 ;; it out. FIXME: We should make it easy to get
214 ;; to DESCRIBE from the inspector.
219 (defmethod inspected-parts ((object vector
))
221 "The object is a ~:[~;displaced ~]VECTOR of length ~W.~%"
222 (and (array-header-p object
)
223 (%array-displaced-p object
))
226 ;; FIXME: Should we respect *INSPECT-LENGTH* here? If not, what
227 ;; does *INSPECT-LENGTH* mean?
228 (coerce object
'list
)))
230 (defun inspected-index-string (index rev-dimensions
)
231 (if (null rev-dimensions
)
234 (dolist (dim rev-dimensions
)
235 (multiple-value-bind (q r
) (floor index dim
)
238 (format nil
"[~W~{,~W~}]" (car list
) (cdr list
)))))
240 (defmethod inspected-parts ((object array
))
241 (let* ((length (min (array-total-size object
) *inspect-length
*))
242 (reference-array (make-array length
:displaced-to object
))
243 (dimensions (array-dimensions object
))
244 (reversed-elements nil
))
245 ;; FIXME: Should we respect *INSPECT-LENGTH* here? If not, what does
246 ;; *INSPECT-LENGTH* mean?
248 (push (cons (format nil
250 (inspected-index-string i
(reverse dimensions
)))
251 (aref reference-array i
))
253 (values (format nil
"The object is ~:[a displaced~;an~] ARRAY of ~A.~%~
254 Its dimensions are ~S.~%"
255 (array-element-type object
)
256 (and (array-header-p object
)
257 (%array-displaced-p object
))
260 (nreverse reversed-elements
))))
262 (defmethod inspected-parts ((object cons
))
263 (if (consp (cdr object
))
264 (inspected-parts-of-nontrivial-list object
)
265 (inspected-parts-of-simple-cons object
)))
267 (defun inspected-parts-of-simple-cons (object)
268 (values "The object is a CONS.
271 (list (cons 'car
(car object
))
272 (cons 'cdr
(cdr object
)))))
274 (defun inspected-parts-of-nontrivial-list (object)
277 (reversed-elements nil
))
278 (flet ((done (description-format)
279 (return-from inspected-parts-of-nontrivial-list
280 (values (format nil description-format length
)
282 (nreverse reversed-elements
)))))
284 (cond ((null in-list
)
285 (done "The object is a proper list of length ~S.~%"))
286 ((>= length
*inspect-length
*)
287 (push (cons 'rest in-list
) reversed-elements
)
288 (done "The object is a long list (more than ~S elements).~%"))
290 (push (cons length
(pop in-list
)) reversed-elements
)
293 (push (cons 'rest in-list
) reversed-elements
)
294 (done "The object is an improper list of length ~S.~%")))))))
296 (defmethod inspected-parts ((object t
))
297 (values (format nil
"The object is an ATOM:~% ~W~%" object
) nil nil
))