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")
31 (defvar *inspect-help
*
32 ":istep takes between 0 to 3 arguments.
34 :i redisplay current object
35 :i = redisplay current object
36 :i nil redisplay current object
37 :i ? display this help
38 :i * inspect the current * value
39 :i + <form> inspect the (eval form)
40 :i <index> inspect the numbered component of object
41 :i <name> inspect the named component of object
42 :i <form> evaluation and inspect form
45 :i < inspect previous parent component
46 :i > inspect next parent component
47 :i set <index> <form> set indexed component to evalated form
48 i set <name> <form> set named component to evalated form
49 :i print <max> set the maximum number of components to print
50 :i skip <n> skip a number of components when printing
51 :i tree print inspect stack
54 ;;; When *INSPECT-UNBOUND-OBJECT-MARKER* occurs in a parts list, it
55 ;;; indicates that that a slot is unbound.
56 (defvar *inspect-unbound-object-marker
* (gensym "INSPECT-UNBOUND-OBJECT-"))
59 ;; Setup binding for multithreading
60 (let ((*current-inspect
* nil
)
62 (*inspect-length
* +default-inspect-length
+)
65 (defun inspector (object input-stream output-stream
)
66 (declare (ignore input-stream
))
67 (setq object
(eval object
))
68 (setq *current-inspect
* (make-inspect))
69 (new-break :inspect
*current-inspect
*)
71 (setf (inspect-object-stack *current-inspect
*) (list object
))
72 (setf (inspect-select-stack *current-inspect
*)
73 (list (format nil
"(inspect ~S)" object
)))
74 (%inspect output-stream
))
77 (defun set-current-inspect (inspect)
78 (setq *current-inspect
* inspect
))
80 (defun istep (arg-string output-stream
)
81 (%istep arg-string output-stream
))
83 (setq sb-impl
::*inspect-fun
* #'inspector
)
86 (setf (inspect-object-stack *current-inspect
*) nil
)
87 (setf (inspect-select-stack *current-inspect
*) nil
))
89 (defun %istep
(arg-string output-stream
)
90 (unless *current-inspect
*
91 (setq *current-inspect
* (make-inspect)))
92 (let* ((args (when arg-string
(string-to-list-skip-spaces arg-string
)))
94 (option-read (when arg-string
95 (read-from-string arg-string
)))
96 (stack (inspect-object-stack *current-inspect
*)))
99 ((or (string= "=" option
)
100 (zerop (length args
)))
101 (%inspect output-stream
))
103 ((or (string= "-" option
)
104 (string= "^" option
))
106 ((> (length stack
) 1)
107 (setf (inspect-object-stack *current-inspect
*) (cdr stack
))
108 (setf (inspect-select-stack *current-inspect
*)
109 (cdr (inspect-select-stack *current-inspect
*)))
110 (%inspect output-stream
))
112 (format output-stream
"Object has no parent.~%"))
114 (%inspect output-stream
))))
115 ;; Select * to inspect
116 ((string= "*" option
)
118 (setf (inspect-object-stack *current-inspect
*) (list *))
119 (setf (inspect-select-stack *current-inspect
*) (list "(inspect *)"))
120 (set-break-inspect *current-inspect
*)
121 (%inspect output-stream
))
122 ;; Start new inspect level for eval'd form
123 ((string= "+" option
)
124 (inspector (eval (read-from-string (second args
))) nil output-stream
))
125 ;; Next or previous parent component
126 ((or (string= "<" option
)
127 (string= ">" option
))
129 (if (eq (length stack
) 1)
130 (format output-stream
"Object does not have a parent")
131 (let ((parent (second stack
))
132 (id (car (inspect-select-stack *current-inspect
*))))
133 (multiple-value-bind (position parts
)
134 (find-object-part-with-id parent id
)
135 (let ((new-position (if (string= ">" option
)
138 (if (< -
1 new-position
(parts-count parts
))
139 (let* ((value (element-at parts new-position
)))
140 (setf (car stack
) value
)
141 (setf (car (inspect-select-stack *current-inspect
*))
144 (let ((label (label-at parts new-position
)))
146 (read-from-string label
)
148 (%inspect output-stream
))
149 (format output-stream
"Parent has no selectable component indexed by ~d"
151 (%inspect output-stream
)))
152 ;; Set component to eval'd form
153 ((string-equal "set" option
)
155 (let ((id (when (second args
)
156 (read-from-string (second args
)))))
157 (multiple-value-bind (position parts
)
158 (find-object-part-with-id (car stack
) id
)
161 (let ((value-stirng (third args
)))
163 (let ((new-value (eval (read-from-string (third args
)))))
165 (set-component-value (car stack
)
168 (element-at parts position
))))
171 (format output-stream result
))
173 (%inspect output-stream
)))))))
174 (format output-stream
175 "Object has no selectable component named by ~A" id
))
176 (format output-stream
177 "Object has no selectable components"))))
178 (%inspect output-stream
)))
179 ;; Set/reset raw display mode for components
180 ((string-equal "raw" option
)
182 (when (and (second args
)
183 (or (null (second args
))
184 (eq (read-from-string (second args
)) t
)))
185 (setq *inspect-raw
* t
))
186 (%inspect output-stream
)))
188 ((string-equal "q" option
)
190 (set-break-inspect *current-inspect
*))
192 ((string-equal "?" option
)
193 (format output-stream
*inspect-help
*))
194 ;; Set number of components to skip
195 ((string-equal "skip" option
)
196 (let ((len (read-from-string (second args
))))
197 (if (and (integerp len
) (>= len
0))
198 (let ((*inspect-skip
* len
))
199 (%inspect output-stream
))
200 (format output-stream
"Skip missing or invalid~%"))))
202 ((string-equal "tree" option
)
205 (format output-stream
"The current object is:~%")
206 (dotimes (i (length stack
))
207 (format output-stream
"~A, ~A~%"
208 (inspected-description (nth i stack
))
209 (let ((select (nth i
(inspect-select-stack *current-inspect
*))))
212 (format nil
"which is componenent number ~d of" select
))
214 (format nil
"which is the ~a component of" select
))
216 (format nil
"which was selected by ~S" select
))
218 (write-to-string select
)))))))
219 (%inspect output-stream
)))
220 ;; Set maximum number of components to print
221 ((string-equal "print" option
)
222 (let ((len (read-from-string (second args
))))
223 (if (and (integerp len
) (plusp len
))
224 (setq *inspect-length
* len
)
225 (format output-stream
"Cannot set print limit to ~A~%" len
))))
226 ;; Select numbered or named component
227 ((or (symbolp option-read
)
228 (integerp option-read
))
230 (multiple-value-bind (position parts
)
231 (find-object-part-with-id (car stack
) option-read
)
234 (let* ((value (element-at parts position
)))
235 (cond ((eq value
*inspect-unbound-object-marker
*)
236 (format output-stream
"That slot is unbound~%"))
238 (push value
(inspect-object-stack *current-inspect
*))
239 (push option-read
(inspect-select-stack *current-inspect
*))
240 (%inspect output-stream
)))))
242 (format output-stream
"Object does not contain any subobjects~%"))
244 (typecase option-read
246 (format output-stream
247 "Object has no selectable component named ~A"
250 (format output-stream
251 "Object has no selectable component indexed by ~d~&Enter a valid index (~:[0-~W~;0~])~%"
253 (= (parts-count parts
) 1)
254 (1- (parts-count parts
))))))))
255 (%inspect output-stream
)))
256 ;; Default is to select eval'd form
259 (let ((object (eval option-read
)))
260 (setf (inspect-object-stack *current-inspect
*) (list object
))
261 (setf (inspect-select-stack *current-inspect
*)
262 (list (format nil
":i ~S" object
))))
263 (set-break-inspect *current-inspect
*)
264 (%inspect output-stream
))
268 (if (inspect-object-stack *current-inspect
*)
269 (let ((inspected (car (inspect-object-stack *current-inspect
*))))
270 (setq cl
:* inspected
)
271 (display-inspected-parts inspected s
))
272 (format s
"No object is being inspected")))
275 (defun display-inspected-parts (object stream
)
276 (multiple-value-bind (elements labels count
)
277 (inspected-elements object
*inspect-length
* *inspect-skip
*)
278 (format stream
"~&~A" (inspected-description object
))
279 (unless (or (characterp object
) (typep object
'fixnum
))
280 (format stream
" at #x~X" (sb-kernel:get-lisp-obj-address object
)))
281 (princ #\newline stream
)
283 (let ((label (elt labels i
))
284 (element (elt elements i
)))
286 ((eq label
:ellipses
)
287 (format stream
"~& ...~%"))
289 (format stream
"tail-> ~A~%" (inspected-description element
)))
292 (if (and (stringp (cdr label
)) (char= (char (cdr label
) 0) #\
[))
296 "~4,' D ~16,1,1,'-A> ~A~%")
298 (format nil
"~A " (cdr label
))
299 (if (eq element
*inspect-unbound-object-marker
*)
301 (inspected-description element
))))
304 (format stream
"~4,' D-> ~A~%" label
(inspected-description element
))
305 (format stream
"~4A-> ~A~%" label
(inspected-description element
)))))))))
307 ) ;; end binding for multithreading
310 ;;; THE BEGINNINGS OF AN INSPECTOR API
311 ;;; which can be used to retrieve object descriptions as component values/labels and also
312 ;;; process component length and skip selectors
314 ;;; FUNCTIONS TO CONSIDER FOR EXPORT
315 ;;; FIND-OBJECT-PART-WITH-ID
318 ;;; INSPECTED-ELEMENTS
319 ;;; INSPECTED-DESCRIPTION
321 ;;; will also need hooks
322 ;;; *inspect-start-inspection* (maybe. Would setup a window for a GUI inspector)
323 ;;; *inspect-prompt-fun*
324 ;;; *inspect-read-cmd*
326 ;;; and, either an *inspect-process-cmd*, or *inspect-display* hook
327 ;;; That'll depend if choose to have standardized inspector commands such that
328 ;;; (funcall *inspect-read-cmd*) will return a standard command that SBCL will
329 ;;; process and then call the *inspect-display* hook, or if the *inspect-read-cmd*
330 ;;; will return an impl-dependent cmd that sbcl will send to the contributed
331 ;;; inspector for processing and display.
333 (defun find-object-part-with-id (object id
)
334 "COMPONENT-ID can be an integer or a name of a id.
335 Returns (VALUES POSITION PARTS).
336 POSITION is NIL if the id is invalid or not found."
338 (let* ((parts (inspected-parts object
))
339 (seq-type (parts-seq-type parts
))
340 (count (parts-count parts
))
341 (components (parts-components parts
)))
343 (setq id
(symbol-name id
)))
345 (cond ((and (eq seq-type
:named
)
347 (position id
(the list components
) :key
#'car
348 :test
#'string-equal
))
349 ((and (eq seq-type
:improper-list
)
351 (string-equal id
"tail"))
354 (when (< -
1 id count
)
356 (values position parts
)))
360 (defun element-at (parts position
)
361 (let ((count (parts-count parts
))
362 (components (parts-components parts
)))
363 (when (< -
1 position count
)
364 (case (parts-seq-type parts
)
366 (if (= position
(1- count
))
367 (cdr (last components
))
368 (elt components position
)))
370 (cdr (elt components position
)))
372 (aref (the array components
) position
))
374 (elt components position
))))))
376 (defun label-at (parts position
)
377 (let ((count (parts-count parts
)))
378 (when (< -
1 position count
)
379 (case (parts-seq-type parts
)
381 (if (= position
(1- count
))
385 (array-index-string position parts
))
387 (car (elt (parts-components parts
) position
)))
391 (defun label-at-maybe-with-index (parts position
)
392 (let ((label (label-at parts position
)))
394 (cons position label
)
397 (defun array-index-string (index parts
)
398 (let ((rev-dimensions (parts-seq-hint parts
)))
399 (if (null rev-dimensions
)
402 (dolist (dim rev-dimensions
)
403 (multiple-value-bind (q r
) (floor index dim
)
406 (format nil
"[~W~{,~W~}]" (car list
) (cdr list
))))))
408 (defun inspected-elements (object length skip
)
409 "Returns elements of an object that have been trimmed and labeled based on
410 length and skip. Returns (VALUES ELEMENTS LABELS COUNT) where ELEMENTS contains
411 COUNT ITERMS, LABELS is a SEQUENCES with COUNT items. LABELS may be a string, number,
412 :tail, or :ellipses. This function may return a COUNT of up to (+ 3 length) which would
413 include an :ellipses at the beginning, :ellipses at the end, and the last element."
414 (let* ((parts (inspected-parts object
))
415 (count (parts-count parts
)))
416 (unless skip
(setq skip
0))
417 (unless length
(setq length count
))
418 (let* ((last (1- count
))
419 (last-req (min last
(+ skip length -
1))) ;; last requested element
420 (total (min (- count skip
) length
)))
421 (when (and (plusp total
) (plusp skip
)) ; starting ellipses
423 (when (< last-req last
) ; last value
425 (when (< last-req
(1- last
)) ; ending ellipses
430 (declare (type (or simple-vector null
) elements labels
))
432 (setq elements
(make-array total
:adjustable nil
:fill-pointer nil
:initial-element nil
))
433 (setq labels
(make-array total
:adjustable nil
:fill-pointer nil
))
435 (setf (aref labels
0) :ellipses
)
438 ((> i
(- last-req skip
)))
439 (setf (aref elements
(+ i index
)) (element-at parts
(+ i skip
)))
440 (setf (aref labels
(+ i index
)) (label-at-maybe-with-index parts
443 (when (< last-req last
) ; last value
444 (setf (aref elements
(- total
1)) (element-at parts last
))
445 (setf (aref labels
(- total
1)) (label-at-maybe-with-index parts
447 (when (< last-req
(1- last
)) ; ending ellipses or 2nd to last value
448 (if (= last-req
(- last
2))
450 (setf (aref elements
(- total
2)) (element-at parts
(1- last
)))
451 (setf (aref labels
(- total
2)) (label-at-maybe-with-index
453 (setf (aref labels
(- total
2)) :ellipses
)))))
454 (values elements labels total
)))))
458 ;;; INSPECTED-DESCRIPTION
460 ;;; Accepts an object and returns
461 ;;; DESCRIPTION is a summary description of the destructured object,
462 ;;; e.g. "the object is a CONS".
464 (defgeneric inspected-description
(object))
466 (defmethod inspected-description ((object symbol
))
467 (format nil
"the symbol ~A" object
))
469 (defmethod inspected-description ((object structure-object
))
470 (format nil
"~W" (find-class (type-of object
))))
472 (defmethod inspected-description ((object package
))
473 (format nil
"the ~A package" (package-name object
)))
475 (defmethod inspected-description ((object standard-object
))
476 (format nil
"~W" (class-of object
)))
478 (defmethod inspected-description ((object sb-kernel
:funcallable-instance
))
479 (format nil
"a funcallable-instance of type ~S" (type-of object
)))
481 (defmethod inspected-description ((object function
))
482 (format nil
"~S" object
) nil
)
484 (defmethod inspected-description ((object vector
))
485 (declare (vector object
))
486 (format nil
"a ~:[~;displaced ~]vector (~W)"
487 (and (sb-kernel:array-header-p object
)
488 (sb-kernel:%array-displaced-p object
))
491 (defmethod inspected-description ((object simple-vector
))
492 (declare (simple-vector object
))
493 (format nil
"a simple ~A vector (~D)"
494 (array-element-type object
)
497 (defmethod inspected-description ((object array
))
498 (declare (array object
))
499 (format nil
"~:[A displaced~;An~] array of ~A with dimensions ~W"
500 (and (sb-kernel:array-header-p object
)
501 (sb-kernel:%array-displaced-p object
))
502 (array-element-type object
)
503 (array-dimensions object
)))
505 (defun simple-cons-pair-p (object)
508 (defmethod inspected-description ((object cons
))
509 (if (simple-cons-pair-p object
)
511 (inspected-description-of-nontrivial-list object
)))
513 (defun dotted-safe-length (object)
514 "Returns (VALUES LENGTH PROPER-P) where length is the number of cons cells"
515 (do ((length 0 (1+ length
))
516 (lst object
(cdr lst
)))
520 (values length nil
)))
521 ;; nothing to do in body
524 (defun inspected-description-of-nontrivial-list (object)
525 (multiple-value-bind (length proper-p
) (dotted-safe-length object
)
527 (format nil
"a proper list with ~D element~:*~P" length
)
528 (format nil
"a dotted list with ~D element~:*~P + tail" length
))))
530 (defmethod inspected-description ((object double-float
))
531 (format nil
"double-float ~W" object
))
533 (defmethod inspected-description ((object single-float
))
534 (format nil
"single-float ~W" object
))
536 (defmethod inspected-description ((object fixnum
))
537 (format nil
"fixnum ~W" object
))
539 (defmethod inspected-description ((object complex
))
540 (format nil
"complex number ~W" object
))
542 (defmethod inspected-description ((object simple-string
))
543 (format nil
"a simple-string (~W) ~W" (length object
) object
))
545 (defmethod inspected-description ((object bignum
))
546 (format nil
"bignum ~W" object
))
548 (defmethod inspected-description ((object ratio
))
549 (format nil
"ratio ~W" object
))
551 (defmethod inspected-description ((object character
))
552 (format nil
"character ~W char-code #x~X" object
(char-code object
)))
554 (defmethod inspected-description ((object t
))
555 (format nil
"a generic object ~W" object
))
560 ;;; Accepts the arguments OBJECT LENGTH SKIP and returns,
561 ;;; (LIST COMPONENTS SEQ-TYPE COUNT SEQ-HINT)
564 ;;; COMPONENTS are the component parts of OBJECT (whose
565 ;;; representation is determined by SEQ-TYPE). Except for the
566 ;;; SEQ-TYPE :named and :array, components is just the OBJECT itself
568 ;;; SEQ-TYPE determines what representation is used for components
570 ;;; If SEQ-TYPE is :named, then each element is (CONS NAME VALUE)
571 ;;; If SEQ-TYPE is :improper-list, then each element is just value,
572 ;;; but the last element must be retrieved by
573 ;;; (cdr (last components))
574 ;;; If SEQ-TYPE is :list, then each element is a value of an array
575 ;;; If SEQ-TYPE is :vector, then each element is a value of an vector
576 ;;; If SEQ-TYPE is :array, then each element is a value of an array
579 ;;; COUNT is the total number of components in the OBJECT
581 ;;; SEQ-HINT Stores a seq-type dependent hint. Used by SEQ-TYPE :array
582 ;;; to hold the reverse-dimensions of the orignal array.
584 (declaim (inline parts-components
))
585 (defun parts-components (parts)
588 (declaim (inline parts-count
))
589 (defun parts-count (parts)
592 (declaim (inline parts-seq-type
))
593 (defun parts-seq-type (parts)
596 (declaim (inline parts-seq-hint
))
597 (defun parts-seq-hint (parts)
600 (defgeneric inspected-parts
(object)
603 (defmethod inspected-parts ((object symbol
))
605 (list (cons "name" (symbol-name object
))
606 (cons "package" (symbol-package object
))
607 (cons "value" (if (boundp object
)
608 (symbol-value object
)
609 *inspect-unbound-object-marker
*))
610 (cons "function" (if (fboundp object
)
611 (symbol-function object
)
612 *inspect-unbound-object-marker
*))
613 (cons "plist" (symbol-plist object
)))))
614 (list components
(length components
) :named nil
)))
616 (defun inspected-structure-parts (object)
617 (let ((components-list '())
618 (info (sb-kernel:layout-info
(sb-kernel:layout-of object
))))
619 (when (sb-kernel::defstruct-description-p info
)
620 (dolist (dd-slot (sb-kernel:dd-slots info
) (nreverse components-list
))
621 (push (cons (sb-kernel:dsd-%name dd-slot
)
622 (funcall (sb-kernel:dsd-accessor-name dd-slot
) object
))
625 (defmethod inspected-parts ((object structure-object
))
626 (let ((components (inspected-structure-parts object
)))
627 (list components
(length components
) :named nil
)))
629 (defun inspected-standard-object-parts (object)
630 (let ((reversed-components nil
)
631 (class-slots (sb-pcl::class-slots
(class-of object
))))
632 (dolist (class-slot class-slots
(nreverse reversed-components
))
633 (let* ((slot-name (slot-value class-slot
'sb-pcl
::name
))
634 (slot-value (if (slot-boundp object slot-name
)
635 (slot-value object slot-name
)
636 *inspect-unbound-object-marker
*)))
637 (push (cons slot-name slot-value
) reversed-components
)))))
639 (defmethod inspected-parts ((object standard-object
))
640 (let ((components (inspected-standard-object-parts object
)))
641 (list components
(length components
) :named nil
)))
643 (defmethod inspected-parts ((object sb-kernel
:funcallable-instance
))
644 (let ((components (inspected-structure-parts object
)))
645 (list components
(length components
) :named nil
)))
647 (defmethod inspected-parts ((object function
))
648 (let* ((type (sb-kernel:widetag-of object
))
649 (object (if (= type sb-vm
:closure-header-widetag
)
650 (sb-kernel:%closure-fun object
)
652 (components (list (cons "arglist"
653 (sb-kernel:%simple-fun-arglist object
)))))
654 (list components
(length components
) :named nil
)))
656 (defmethod inspected-parts ((object vector
))
657 (list object
(length object
) :vector nil
))
659 (defmethod inspected-parts ((object array
))
660 (let ((size (array-total-size object
)))
661 (list (make-array size
:displaced-to object
)
664 (reverse (array-dimensions object
)))))
666 (defmethod inspected-parts ((object cons
))
667 (if (simple-cons-pair-p object
)
668 (inspected-parts-of-simple-cons object
)
669 (inspected-parts-of-nontrivial-list object
)))
671 (defun inspected-parts-of-simple-cons (object)
672 (let ((components (list (cons "car" (car object
))
673 (cons "cdr" (cdr object
)))))
674 (list components
2 :named nil
)))
676 (defun inspected-parts-of-nontrivial-list (object)
677 (multiple-value-bind (count proper-p
) (dotted-safe-length object
)
679 (list object count
:list nil
)
680 ;; count tail element
681 (list object
(1+ count
) :improper-list nil
))))
683 (defmethod inspected-parts ((object complex
))
684 (let ((components (list (cons "real" (realpart object
))
685 (cons "imag" (imagpart object
)))))
686 (list components
(length components
) :named nil
)))
688 (defmethod inspected-parts ((object ratio
))
689 (let ((components (list (cons "numerator" (numerator object
))
690 (cons "denominator" (denominator object
)))))
691 (list components
(length components
) :named nil
)))
693 (defmethod inspected-parts ((object t
))
694 (list nil
0 nil nil
))
697 ;; FIXME - implement setting of component values
699 (defgeneric set-component-value
(object component-id value element
))
701 (defmethod set-component-value ((object cons
) id value element
)
702 (format nil
"Cons object does not support setting of component ~A" id
))
704 (defmethod set-component-value ((object array
) id value element
)
705 (format nil
"Array object does not support setting of component ~A" id
))
707 (defmethod set-component-value ((object symbol
) id value element
)
708 (format nil
"Symbol object does not support setting of component ~A" id
))
710 (defmethod set-component-value ((object structure-object
) id value element
)
711 (format nil
"Structure object does not support setting of component ~A" id
))
713 (defmethod set-component-value ((object standard-object
) id value element
)
714 (format nil
"Standard object does not support setting of component ~A" id
))
716 (defmethod set-component-value ((object sb-kernel
:funcallable-instance
) id value element
)
717 (format nil
"Funcallable instance object does not support setting of component ~A" id
))
719 (defmethod set-component-value ((object function
) id value element
)
720 (format nil
"Function object does not support setting of component ~A" id
))
722 ;; whn believes it is unsafe to change components of this object
723 (defmethod set-component-value ((object complex
) id value element
)
724 (format nil
"Object does not support setting of component ~A" id
))
726 ;; whn believes it is unsafe to change components of this object
727 (defmethod set-component-value ((object ratio
) id value element
)
728 (format nil
"Object does not support setting of component ~A" id
))
730 (defmethod set-component-value ((object t
) id value element
)
731 (format nil
"Object does not support setting of component ~A" id
))