1 ;;;; the 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 (declaim #.*optimize-byte-compilation*)
16 ;;; The inspector views LISP objects as being composed of parts. A
17 ;;; list, for example, would be divided into its members, and a
18 ;;; instance into its slots. These parts are stored in a list. The
19 ;;; first two elements of this list are for bookkeeping. The first
20 ;;; element is a preamble string that will be displayed before the
21 ;;; object. The second element is a boolean value that indicates
22 ;;; whether a label will be printed in front of a value, or just the
23 ;;; value. Symbols and instances need to display both a slot name and
24 ;;; a value, while lists, vectors, and atoms need only display a
25 ;;; value. If the second member of a parts list is t, then the third
26 ;;; and successive members must be an association list of slot names
27 ;;; and values. When the second slot is nil, the third and successive
28 ;;; slots must be the parts of an object.
30 ;;; *INSPECT-OBJECT-STACK* is an assoc list of objects to their parts.
31 (defvar *inspect-object-stack* ())
33 (defparameter *inspect-length* 10)
35 #-sb-fluid (declaim (inline numbered-parts-p))
36 (defun numbered-parts-p (parts)
39 (defconstant parts-offset 2)
41 (defun nth-parts (parts n)
42 (if (numbered-parts-p parts)
43 (cdr (nth (+ n parts-offset) parts))
44 (nth (+ n parts-offset) parts)))
46 (defun inspect (object)
47 (declare #.*optimize-external-despite-byte-compilation*)
49 (input-loop object (describe-parts object) *standard-output*)
50 (setf *inspect-object-stack* nil))
53 ;;; When *ILLEGAL-OBJECT-MARKER* occurs in a parts list, it indicates
54 ;;; that that slot is unbound.
55 (defvar *illegal-object-marker* (cons nil nil))
57 (defun input-loop (object parts s)
58 (tty-display-object parts s)
62 (let ((command (read))
63 ;; Use 2 less than the length because the first 2 elements
65 (parts-len-2 (- (length parts) 2)))
68 (cond ((< -1 command parts-len-2)
69 (cond ((eq (nth-parts parts command) *illegal-object-marker*)
70 (format s "~%That slot is unbound.~%"))
72 (push (cons object parts) *inspect-object-stack*)
73 (setf object (nth-parts parts command))
74 (setf parts (describe-parts object))
75 (tty-display-object parts s))))
78 (format s "~%This object contains nothing to inspect.~%~%")
79 (format s "~%Enter a VALID number (~:[0-~D~;0~]).~%~%"
80 (= parts-len-2 1) (1- parts-len-2))))))
82 (case (find-symbol (symbol-name command) *keyword-package*)
86 (cond (*inspect-object-stack*
87 (setf object (caar *inspect-object-stack*))
88 (setf parts (cdar *inspect-object-stack*))
89 (pop *inspect-object-stack*)
90 (tty-display-object parts s))
91 (t (format s "~%Bottom of Stack.~%"))))
93 (setf parts (describe-parts object))
94 (tty-display-object parts s))
96 (tty-display-object parts s))
100 (do-inspect-eval command s))))
102 (do-inspect-eval command s))))))
104 (defun do-inspect-eval (command stream)
105 (let ((result-list (restart-case (multiple-value-list (eval command))
106 (nil () :report "Return to the inspector."
107 (format stream "~%returning to the inspector~%")
108 (return-from do-inspect-eval nil)))))
109 (setf /// // // / / result-list)
110 (setf +++ ++ ++ + + - - command)
111 (setf *** ** ** * * (car /))
112 (format stream "~&~{~S~%~}" /)))
116 (write-line "inspector help:" s)
117 (write-line " R - recompute current object." s)
118 (write-line " D - redisplay current object." s)
119 (write-line " U - Move upward through the object stack." s)
120 (write-line " Q, E - Quit inspector." s)
121 (write-line " ?, H, Help - Show this help." s))
123 (defun tty-display-object (parts stream)
124 (format stream "~%~A" (car parts))
125 (let ((numbered-parts-p (numbered-parts-p parts))
126 (parts (cddr parts)))
127 (do ((part parts (cdr part))
131 (format stream "~D. ~A: ~A~%" i (caar part)
132 (if (eq (cdar part) *illegal-object-marker*)
135 (format stream "~D. ~A~%" i (car part))))))
139 (defun describe-parts (object)
141 (symbol (describe-symbol-parts object))
142 (instance (describe-instance-parts object :structure))
144 (if (sb-kernel:funcallable-instance-p object)
145 (describe-instance-parts object :funcallable-instance)
146 (describe-function-parts object)))
147 (vector (describe-vector-parts object))
148 (array (describe-array-parts object))
149 (cons (describe-cons-parts object))
150 (t (describe-atomic-parts object))))
152 (defun describe-symbol-parts (object)
153 (list (format nil "~S is a symbol.~%" object) t
154 (cons "Value" (if (boundp object)
155 (symbol-value object)
156 *illegal-object-marker*))
157 (cons "Function" (if (fboundp object)
158 (symbol-function object)
159 *illegal-object-marker*))
160 (cons "Plist" (symbol-plist object))
161 (cons "Package" (symbol-package object))))
163 (defun describe-instance-parts (object kind)
164 (let ((info (layout-info (sb-kernel:layout-of object)))
166 (push (format nil "~S is a ~(~A~).~%" object kind) parts-list)
168 (when (sb-kernel::defstruct-description-p info)
169 (dolist (dd-slot (dd-slots info) (nreverse parts-list))
170 (push (cons (dsd-%name dd-slot)
171 (funcall (dsd-accessor dd-slot) object))
174 (defun describe-function-parts (object)
175 (let* ((type (sb-kernel:get-type object))
176 (object (if (= type sb-vm:closure-header-type)
177 (sb-kernel:%closure-function object)
179 (list (format nil "Function ~S.~@[~%Argument List: ~A~]." object
180 (sb-kernel:%function-arglist object)
181 ;; Defined-from stuff used to be here. Someone took
182 ;; it out. FIXME: We should make it easy to get
183 ;; to DESCRIBE from the inspector.
187 (defun describe-vector-parts (object)
188 (list* (format nil "The object is a ~:[~;displaced ~]vector of length ~D.~%"
189 (and (array-header-p object)
190 (%array-displaced-p object))
193 (coerce object 'list)))
195 (defun describe-cons-parts (object)
196 (list* (format nil "The object is a LIST of length ~D.~%" (length object))
200 (defun index-string (index rev-dimensions)
201 (if (null rev-dimensions)
204 (dolist (dim rev-dimensions)
205 (multiple-value-bind (q r) (floor index dim)
208 (format nil "[~D~{,~D~}]" (car list) (cdr list)))))
210 (defun describe-array-parts (object)
211 (let* ((length (min (array-total-size object) *inspect-length*))
212 (reference-array (make-array length :displaced-to object))
213 (dimensions (array-dimensions object))
215 (push (format nil "The object is ~:[a displaced~;an~] array of ~A.~%~
216 Its dimensions are ~S.~%"
217 (array-element-type object)
218 (and (array-header-p object)
219 (%array-displaced-p object))
223 (dotimes (i length (nreverse parts))
224 (push (cons (format nil "~A " (index-string i (reverse dimensions)))
225 (aref reference-array i))
228 (defun describe-atomic-parts (object)
229 (list (format nil "The object is an atom.~%") nil object))