1 ;;;; Inspector for sb-aclrepl
3 ;;;; The documentation, which may or may not apply in its entirety at
4 ;;;; any given time, for this functionality is on the ACL website:
5 ;;;; <http://www.franz.com/support/documentation/6.2/doc/inspector.htm>.
7 ;;;; A summary of inspector navigation is contained in the below *INSPECT-HELP*
10 (cl:in-package #:sb-aclrepl)
12 (eval-when (:compile-toplevel :load-toplevel :execute)
13 (defconstant +default-inspect-length+ 10))
16 ;; stack of parents of inspected object
18 ;; a stack of indices of parent object components
21 ;; FIXME - raw mode isn't currently used in object display
22 (defparameter *current-inspect* nil
24 (defparameter *inspect-raw* nil
25 "Raw mode for object display.")
26 (defparameter *inspect-length* +default-inspect-length+
27 "maximum number of components to print")
28 (defparameter *inspect-skip* 0
29 "number of initial components to skip when displaying an object")
30 (defparameter *skip-address-display* nil
31 "Skip displaying addresses of objects.")
33 (defvar *inspect-help*
34 ":istep takes between 0 to 3 arguments.
36 :i redisplay current object
37 :i = redisplay current object
38 :i nil redisplay current object
39 :i ? display this help
40 :i * inspect the current * value
41 :i + <form> inspect the (eval form)
42 :i <index> inspect the numbered component of object
43 :i <name> inspect the named component of object
44 :i <form> evaluation and inspect form
47 :i < inspect previous parent component
48 :i > inspect next parent component
49 :i set <index> <form> set indexed component to evalated form
50 i set <name> <form> set named component to evalated form
51 :i print <max> set the maximum number of components to print
52 :i skip <n> skip a number of components when printing
53 :i tree print inspect stack
56 ;;; When *INSPECT-UNBOUND-OBJECT-MARKER* occurs in a parts list, it
57 ;;; indicates that that a slot is unbound.
58 (eval-when (:compile-toplevel :load-toplevel :execute)
59 (defvar *inspect-unbound-object-marker* (gensym "INSPECT-UNBOUND-OBJECT-")))
62 ;; Setup binding for multithreading
63 (let ((*current-inspect* nil)
65 (*inspect-length* +default-inspect-length+)
67 (*skip-address-display* nil))
69 (defun inspector (object input-stream output-stream)
70 (declare (ignore input-stream))
71 (setq object (eval object))
72 (setq *current-inspect* (make-inspect))
73 (new-break :inspect *current-inspect*)
75 (setf (inspect-object-stack *current-inspect*) (list object))
76 (setf (inspect-select-stack *current-inspect*)
77 (list (format nil "(inspect ...)")))
78 (redisplay output-stream))
80 (setq sb-impl::*inspect-fun* #'inspector)
82 (defun istep (args stream)
83 (unless *current-inspect*
84 (setq *current-inspect* (make-inspect)))
87 (when (first args) (read-from-string (first args)))
90 (defun istep-dispatch (args option-string option stream)
92 ((or (string= "=" option-string) (zerop (length args)))
93 (istep-cmd-redisplay stream))
94 ((or (string= "-" option-string) (string= "^" option-string))
95 (istep-cmd-parent stream))
96 ((string= "*" option-string)
97 (istep-cmd-inspect-* stream))
98 ((string= "+" option-string)
99 (istep-cmd-inspect-new-form (read-from-string (second args)) stream))
100 ((or (string= "<" option-string)
101 (string= ">" option-string))
102 (istep-cmd-select-parent-component option-string stream))
103 ((string-equal "set" option-string)
104 (istep-cmd-set (second args) (third args) stream))
105 ((string-equal "raw" option-string)
106 (istep-cmd-set-raw (second args) stream))
107 ((string-equal "q" option-string)
109 ((string-equal "?" option-string)
110 (istep-cmd-help stream))
111 ((string-equal "skip" option-string)
112 (istep-cmd-skip (second args) stream))
113 ((string-equal "tree" option-string)
114 (istep-cmd-tree stream))
115 ((string-equal "print" option-string)
116 (istep-cmd-print (second args) stream))
117 ((or (symbolp option)
119 (istep-cmd-select-component option stream))
121 (istep-cmd-set-stack option stream))))
123 (defun set-current-inspect (inspect)
124 (setq *current-inspect* inspect))
126 (defun reset-stack ()
127 (setf (inspect-object-stack *current-inspect*) nil)
128 (setf (inspect-select-stack *current-inspect*) nil))
130 (defun output-inspect-note (stream note &rest args)
131 (apply #'format stream note args)
132 (princ #\Newline stream))
135 (inspect-object-stack *current-inspect*))
137 (defun redisplay (stream)
138 (display-current stream))
141 ;;; istep command processing
144 (defun istep-cmd-redisplay (stream)
147 (defun istep-cmd-parent (stream)
149 ((> (length (inspect-object-stack *current-inspect*)) 1)
150 (setf (inspect-object-stack *current-inspect*)
151 (cdr (inspect-object-stack *current-inspect*)))
152 (setf (inspect-select-stack *current-inspect*)
153 (cdr (inspect-select-stack *current-inspect*)))
156 (output-inspect-note stream "Object has no parent"))
158 (no-object-msg stream))))
160 (defun istep-cmd-inspect-* (stream)
162 (setf (inspect-object-stack *current-inspect*) (list *))
163 (setf (inspect-select-stack *current-inspect*) (list "(inspect *)"))
164 (set-break-inspect *current-inspect*)
167 (defun istep-cmd-inspect-new-form (form stream)
168 (inspector (eval form) nil stream))
170 (defun istep-cmd-select-parent-component (option stream)
172 (if (eql (length (stack)) 1)
173 (output-inspect-note stream "Object does not have a parent")
174 (let ((parent (second (stack)))
175 (id (car (inspect-select-stack *current-inspect*))))
176 (multiple-value-bind (position parts)
177 (find-part-id parent id)
178 (let ((new-position (if (string= ">" option)
181 (if (< -1 new-position (parts-count parts))
182 (let* ((value (element-at parts new-position)))
183 (setf (car (inspect-object-stack *current-inspect*))
185 (setf (car (inspect-select-stack *current-inspect*))
186 (id-at parts new-position))
188 (output-inspect-note stream
189 "Parent has no selectable component indexed by ~d"
191 (no-object-msg stream)))
193 (defun istep-cmd-set-raw (option-string stream)
194 (when (inspect-object-stack *current-inspect*)
196 ((null option-string)
197 (setq *inspect-raw* t))
198 ((eq (read-from-string option-string) t)
199 (setq *inspect-raw* t))
200 ((eq (read-from-string option-string) nil)
201 (setq *inspect-raw* nil)))
204 (defun istep-cmd-reset ()
206 (set-break-inspect *current-inspect*))
208 (defun istep-cmd-help (stream)
209 (format stream *inspect-help*))
211 (defun istep-cmd-skip (option-string stream)
213 (let ((len (read-from-string option-string)))
214 (if (and (integerp len) (>= len 0))
215 (let ((*inspect-skip* len))
217 (output-inspect-note stream "Skip length invalid")))
218 (output-inspect-note stream "Skip length missing")))
220 (defun istep-cmd-print (option-string stream)
222 (let ((len (read-from-string option-string)))
223 (if (and (integerp len) (plusp len))
224 (setq *inspect-length* len)
225 (output-inspect-note stream "Cannot set print limit to ~A~%" len)))
226 (output-inspect-note stream "Print length missing")))
228 (defun select-description (select)
231 (format nil "which is componenent number ~d of" select))
233 (format nil "which is the ~a component of" select))
235 (format nil "which was selected by ~A" select))
237 (write-to-string select))))
239 (defun istep-cmd-tree (stream)
240 (let ((stack (inspect-object-stack *current-inspect*)))
243 (output-inspect-note stream "The current object is:")
244 (dotimes (i (length stack))
247 (inspected-description (nth i stack))
249 (nth i (inspect-select-stack *current-inspect*))))))
250 (no-object-msg stream))))
252 (defun istep-cmd-set (id-string value-string stream)
254 (let ((id (when id-string (read-from-string id-string))))
255 (multiple-value-bind (position parts)
256 (find-part-id (car (stack)) id)
260 (let ((new-value (eval (read-from-string value-string))))
261 (let ((result (set-component-value (car (stack))
268 (output-inspect-note stream result))
270 (redisplay stream))))))
273 "Object has no selectable component named by ~A" id))
274 (output-inspect-note stream
275 "Object has no selectable components"))))
276 (no-object-msg stream)))
278 (defun istep-cmd-select-component (id stream)
280 (multiple-value-bind (position parts)
281 (find-part-id (car (stack)) id)
284 (let* ((value (element-at parts position)))
285 (cond ((eq value *inspect-unbound-object-marker*)
286 (output-inspect-note stream "That slot is unbound"))
288 (push value (inspect-object-stack *current-inspect*))
289 (push id (inspect-select-stack *current-inspect*))
290 (redisplay stream)))))
292 (output-inspect-note stream "Object does not contain any subobjects"))
297 stream "Object has no selectable component named ~A"
301 stream "Object has no selectable component indexed by ~d"
304 stream "Enter a valid index (~:[0-~W~;0~])"
305 (= (parts-count parts) 1)
306 (1- (parts-count parts))))))))
307 (no-object-msg stream)))
309 (defun istep-cmd-set-stack (form stream)
311 (let ((object (eval form)))
312 (setf (inspect-object-stack *current-inspect*) (list object))
313 (setf (inspect-select-stack *current-inspect*)
314 (list (format nil ":i ..."))))
315 (set-break-inspect *current-inspect*)
319 ;;; aclrepl-specific inspection display
322 (defun no-object-msg (s)
323 (output-inspect-note s "No object is being inspected"))
325 (defun display-current (s)
327 (let ((inspected (car (stack))))
328 (setq cl:* inspected)
329 (display-inspect inspected s *inspect-length* *inspect-skip*))
332 ) ;; end binding for multithreading
335 (defun display-inspect (object stream &optional length (skip 0))
336 (multiple-value-bind (elements labels count)
337 (inspected-elements object length skip)
339 (format stream "~A" (inspected-description object))
340 (unless (or *skip-address-display*
341 (characterp object) (typep object 'fixnum))
342 (format stream " at #x~X" (sb-kernel:get-lisp-obj-address object)))
345 (display-labeled-element (elt elements i) (elt labels i) stream))))
347 (defun array-label-p (label)
348 (and (stringp (cdr label)) (char= (char (cdr label) 0) #\[)))
350 (defun named-or-array-label-p (label)
353 (defun display-labeled-element (element label stream)
355 ((eq label :ellipses)
356 (format stream " ..."))
358 (format stream "tail-> ~A" (inspected-description element)))
359 ((named-or-array-label-p label)
361 (if (array-label-p label)
363 "~4,' D ~16,1,1,'-A> ~A")
365 (format nil "~A " (cdr label))
366 (inspected-description element)))
368 (format stream "~4,' D-> ~A" label (inspected-description element)))))
370 ;;; THE BEGINNINGS OF AN INSPECTOR API
371 ;;; which can be used to retrieve object descriptions as component values/labels and also
372 ;;; process print length and skip selectors
374 ;;; FUNCTIONS TO CONSIDER FOR EXPORT
378 ;;; INSPECTED-ELEMENTS
379 ;;; INSPECTED-DESCRIPTION
381 ;;; will also need hooks
382 ;;; *inspect-start-inspection*
383 ;;; (maybe. Would setup a window for a GUI inspector)
384 ;;; *inspect-prompt-fun*
385 ;;; *inspect-read-cmd*
387 ;;; and, either an *inspect-process-cmd*, or *inspect-display* hook
388 ;;; That'll depend if choose to have standardized inspector commands such that
389 ;;; (funcall *inspect-read-cmd*) will return a standard command that SBCL will
390 ;;; process and then call the *inspect-display* hook, or if the
391 ;;; *inspect-read-cmd* will return an impl-dependent cmd that sbcl will
392 ;;; send to the contributed inspector for processing and display.
394 (defun find-part-id (object id)
395 "COMPONENT-ID can be an integer or a name of a id.
396 Returns (VALUES POSITION PARTS).
397 POSITION is NIL if the id is invalid or not found."
398 (let* ((parts (inspected-parts object))
399 (name (if (symbolp id) (symbol-name id) id)))
402 (when (< -1 id (parts-count parts)) id)
403 (case (parts-seq-type parts)
405 (position name (the list (parts-components parts))
406 :key #'car :test #'string-equal))
408 (when (string-equal name "tail")
409 (1- (parts-count parts))))))
412 (defun element-at (parts position)
413 (let ((count (parts-count parts))
414 (components (parts-components parts)))
415 (when (< -1 position count)
416 (case (parts-seq-type parts)
418 (if (= position (1- count))
419 (cdr (last components))
420 (elt components position)))
422 (cdr (elt components position)))
424 (aref (the array components) position))
426 (elt components position))))))
428 (defun id-at (parts position)
429 (let ((count (parts-count parts)))
430 (when (< -1 position count)
431 (case (parts-seq-type parts)
433 (if (= position (1- count))
437 (array-index-string position parts))
439 (car (elt (parts-components parts) position)))
443 (defun inspected-elements (object &optional length (skip 0))
444 "Returns elements of an object that have been trimmed and labeled based on
445 length and skip. Returns (VALUES ELEMENTS LABELS ELEMENT-COUNT)
446 where ELEMENTS and LABELS are vectors containing ELEMENT-COUNT items.
447 LABELS may be a string, number, cons pair, :tail, or :ellipses.
448 This function may return an ELEMENT-COUNT of up to (+ 3 length) which would
449 include an :ellipses at the beginning, :ellipses at the end,
450 and the last element."
451 (let* ((parts (inspected-parts object))
452 (print-length (if length length (parts-count parts)))
453 (last-part (last-part parts))
454 (last-requested (last-requested parts print-length skip))
455 (element-count (compute-elements-count parts print-length skip))
456 (first-to (if (first-element-ellipses-p parts skip) 1 0))
457 (elements (when (plusp element-count) (make-array element-count)))
458 (labels (when (plusp element-count) (make-array element-count))))
459 (when (plusp element-count)
460 ;; possible first ellipses
461 (when (first-element-ellipses-p parts skip)
462 (set-element-values elements labels 0 nil :ellipses))
465 ((> i (- last-requested skip)))
466 (set-element elements labels parts (+ i first-to) (+ i skip)))
467 ;; last parts value if needed
468 (when (< last-requested last-part)
469 (set-element elements labels parts (- element-count 1) last-part))
470 ;; ending ellipses or next to last parts value if needed
471 (when (< last-requested (1- last-part))
472 (if (= last-requested (- last-part 2))
473 (set-element elements labels parts (- element-count 2) (1- last-part))
474 (set-element-values elements labels (- element-count 2) nil :ellipses))))
475 (values elements labels element-count)))
477 (defun last-requested (parts print skip)
478 (min (1- (parts-count parts)) (+ skip print -1)))
480 (defun last-part (parts)
481 (1- (parts-count parts)))
483 (defun compute-elements-count (parts length skip)
484 "Compute the number of elements in parts given the print length and skip."
485 (let ((element-count (min (parts-count parts) length
486 (max 0 (- (parts-count parts) skip)))))
487 (when (and (plusp (parts-count parts)) (plusp skip)) ; starting ellipses
488 (incf element-count))
489 (when (< (last-requested parts length skip)
490 (last-part parts)) ; last value
492 (when (< (last-requested parts length skip)
493 (1- (last-part parts))) ; ending ellipses
494 (incf element-count)))
497 (defun set-element (elements labels parts to-index from-index)
498 (set-element-values elements labels to-index (element-at parts from-index)
499 (label-at parts from-index)))
501 (defun set-element-values (elements labels index element label)
502 (setf (aref elements index) element)
503 (setf (aref labels index) label))
505 (defun first-element-ellipses-p (parts skip)
506 (and (parts-count parts) (plusp skip)))
508 (defun label-at (parts position)
509 "Helper function for inspected-elements. Conses the
510 position with the label if the label is a string."
511 (let ((id (id-at parts position)))
516 (defun array-index-string (index parts)
517 "Formats an array index in row major format."
518 (let ((rev-dimensions (parts-seq-hint parts)))
519 (if (null rev-dimensions)
522 (dolist (dim rev-dimensions)
523 (multiple-value-bind (q r) (floor index dim)
526 (format nil "[~W~{,~W~}]" (car list) (cdr list))))))
529 ;;; INSPECTED-DESCRIPTION
531 ;;; Accepts an object and returns
532 ;;; DESCRIPTION is a summary description of the destructured object,
533 ;;; e.g. "the object is a CONS".
535 (defgeneric inspected-description (object))
537 (defmethod inspected-description ((object symbol))
538 (format nil "the symbol ~A" object))
540 (defmethod inspected-description ((object structure-object))
541 (format nil "~W" (find-class (type-of object))))
543 (defmethod inspected-description ((object package))
544 (format nil "the ~A package" (package-name object)))
546 (defmethod inspected-description ((object standard-object))
547 (format nil "~W" (class-of object)))
549 (defmethod inspected-description ((object sb-kernel:funcallable-instance))
550 (format nil "a funcallable-instance of type ~S" (type-of object)))
552 (defmethod inspected-description ((object function))
553 (format nil "~S" object) nil)
555 (defmethod inspected-description ((object vector))
556 (declare (vector object))
557 (format nil "a ~:[~;displaced ~]vector (~W)"
558 (and (sb-kernel:array-header-p object)
559 (sb-kernel:%array-displaced-p object))
562 (defmethod inspected-description ((object simple-vector))
563 (declare (simple-vector object))
564 (format nil "a simple ~A vector (~D)"
565 (array-element-type object)
568 (defmethod inspected-description ((object array))
569 (declare (array object))
570 (format nil "~:[A displaced~;An~] array of ~A with dimensions ~W"
571 (and (sb-kernel:array-header-p object)
572 (sb-kernel:%array-displaced-p object))
573 (array-element-type object)
574 (array-dimensions object)))
576 (defun simple-cons-pair-p (object)
579 (defmethod inspected-description ((object cons))
580 (if (simple-cons-pair-p object)
582 (inspected-description-of-nontrivial-list object)))
584 (defun dotted-safe-length (object)
585 "Returns (VALUES LENGTH PROPER-P) where length is the number of cons cells"
586 (do ((length 0 (1+ length))
587 (lst object (cdr lst)))
591 (values length nil)))
592 ;; nothing to do in body
595 (defun inspected-description-of-nontrivial-list (object)
596 (multiple-value-bind (length proper-p) (dotted-safe-length object)
598 (format nil "a proper list with ~D element~:*~P" length)
599 (format nil "a dotted list with ~D element~:*~P + tail" length))))
601 (defmethod inspected-description ((object double-float))
602 (format nil "double-float ~W" object))
604 (defmethod inspected-description ((object single-float))
605 (format nil "single-float ~W" object))
607 (defmethod inspected-description ((object fixnum))
608 (format nil "fixnum ~W" object))
610 (defmethod inspected-description ((object complex))
611 (format nil "complex number ~W" object))
613 (defmethod inspected-description ((object simple-string))
614 (format nil "a simple-string (~W) ~W" (length object) object))
616 (defmethod inspected-description ((object bignum))
617 (format nil "bignum ~W" object))
619 (defmethod inspected-description ((object ratio))
620 (format nil "ratio ~W" object))
622 (defmethod inspected-description ((object character))
623 (format nil "character ~W char-code #x~X" object (char-code object)))
625 (defmethod inspected-description ((object t))
626 (format nil "a generic object ~W" object))
628 (defmethod inspected-description ((object (eql *inspect-unbound-object-marker*)))
634 ;;; Accepts the arguments OBJECT LENGTH SKIP and returns,
635 ;;; (LIST COMPONENTS SEQ-TYPE COUNT SEQ-HINT)
638 ;;; COMPONENTS are the component parts of OBJECT (whose
639 ;;; representation is determined by SEQ-TYPE). Except for the
640 ;;; SEQ-TYPE :named and :array, components is just the OBJECT itself
642 ;;; SEQ-TYPE determines what representation is used for components
644 ;;; If SEQ-TYPE is :named, then each element is (CONS NAME VALUE)
645 ;;; If SEQ-TYPE is :improper-list, then each element is just value,
646 ;;; but the last element must be retrieved by
647 ;;; (cdr (last components))
648 ;;; If SEQ-TYPE is :list, then each element is a value of an array
649 ;;; If SEQ-TYPE is :vector, then each element is a value of an vector
650 ;;; If SEQ-TYPE is :array, then each element is a value of an array
651 ;;; with rank >= 2. The
653 ;;; COUNT is the total number of components in the OBJECT
655 ;;; SEQ-HINT is a seq-type dependent hint. Used by SEQ-TYPE :array
656 ;;; to hold the reverse-dimensions of the orignal array.
658 (declaim (inline parts-components))
659 (defun parts-components (parts)
662 (declaim (inline parts-count))
663 (defun parts-count (parts)
666 (declaim (inline parts-seq-type))
667 (defun parts-seq-type (parts)
670 (declaim (inline parts-seq-hint))
671 (defun parts-seq-hint (parts)
674 (defgeneric inspected-parts (object)
677 (defmethod inspected-parts ((object symbol))
679 (list (cons "NAME" (symbol-name object))
680 (cons "PACKAGE" (symbol-package object))
681 (cons "VALUE" (if (boundp object)
682 (symbol-value object)
683 *inspect-unbound-object-marker*))
684 (cons "FUNCTION" (if (fboundp object)
685 (symbol-function object)
686 *inspect-unbound-object-marker*))
687 (cons "PLIST" (symbol-plist object)))))
688 (list components (length components) :named nil)))
690 (defun inspected-structure-parts (object)
691 (let ((components-list '())
692 (info (sb-kernel:layout-info (sb-kernel:layout-of object))))
693 (when (sb-kernel::defstruct-description-p info)
694 (dolist (dd-slot (sb-kernel:dd-slots info) (nreverse components-list))
695 (push (cons (sb-kernel:dsd-%name dd-slot)
696 (funcall (sb-kernel:dsd-accessor-name dd-slot) object))
699 (defmethod inspected-parts ((object structure-object))
700 (let ((components (inspected-structure-parts object)))
701 (list components (length components) :named nil)))
703 (defun inspected-standard-object-parts (object)
704 (let ((components nil)
705 (class-slots (sb-pcl::class-slots (class-of object))))
706 (dolist (class-slot class-slots components)
707 (let* ((slot-name (slot-value class-slot 'sb-pcl::name))
708 (slot-value (if (slot-boundp object slot-name)
709 (slot-value object slot-name)
710 *inspect-unbound-object-marker*)))
711 (push (cons (symbol-name slot-name) slot-value) components)))))
714 (defmethod inspected-parts ((object standard-object))
715 (let ((components (inspected-standard-object-parts object)))
716 (list components (length components) :named nil)))
718 (defmethod inspected-parts ((object sb-kernel:funcallable-instance))
719 (let ((components (inspected-structure-parts object)))
720 (list components (length components) :named nil)))
722 (defmethod inspected-parts ((object function))
723 (let* ((type (sb-kernel:widetag-of object))
724 (object (if (= type sb-vm:closure-header-widetag)
725 (sb-kernel:%closure-fun object)
727 (components (list (cons "arglist"
728 (sb-kernel:%simple-fun-arglist object)))))
729 (list components (length components) :named nil)))
731 (defmethod inspected-parts ((object vector))
732 (list object (length object) :vector nil))
734 (defmethod inspected-parts ((object array))
735 (let ((size (array-total-size object)))
736 (list (make-array size :displaced-to object)
739 (reverse (array-dimensions object)))))
741 (defmethod inspected-parts ((object cons))
742 (if (simple-cons-pair-p object)
743 (inspected-parts-of-simple-cons object)
744 (inspected-parts-of-nontrivial-list object)))
746 (defun inspected-parts-of-simple-cons (object)
747 (let ((components (list (cons "car" (car object))
748 (cons "cdr" (cdr object)))))
749 (list components 2 :named nil)))
751 (defun inspected-parts-of-nontrivial-list (object)
752 (multiple-value-bind (count proper-p) (dotted-safe-length object)
754 (list object count :list nil)
755 ;; count tail element
756 (list object (1+ count) :improper-list nil))))
758 (defmethod inspected-parts ((object complex))
759 (let ((components (list (cons "real" (realpart object))
760 (cons "imag" (imagpart object)))))
761 (list components (length components) :named nil)))
763 (defmethod inspected-parts ((object ratio))
764 (let ((components (list (cons "numerator" (numerator object))
765 (cons "denominator" (denominator object)))))
766 (list components (length components) :named nil)))
768 (defmethod inspected-parts ((object t))
769 (list nil 0 nil nil))
772 ;; FIXME - implement setting of component values
774 (defgeneric set-component-value (object component-id value element))
776 (defmethod set-component-value ((object cons) id value element)
777 (format nil "Cons object does not support setting of component ~A" id))
779 (defmethod set-component-value ((object array) id value element)
780 (format nil "Array object does not support setting of component ~A" id))
782 (defmethod set-component-value ((object symbol) id value element)
783 (format nil "Symbol object does not support setting of component ~A" id))
785 (defmethod set-component-value ((object structure-object) id value element)
786 (format nil "Structure object does not support setting of component ~A" id))
788 (defmethod set-component-value ((object standard-object) id value element)
789 (format nil "Standard object does not support setting of component ~A" id))
791 (defmethod set-component-value ((object t) id value element)
792 (format nil "Object does not support setting of component ~A" id))