- (let* ((description (find-layer class))
- (attribute-objects
- (mapcar
- (lambda (slot)
- (setf (attribute-object slot)
- (apply #'make-instance
- 'standard-attribute
- (attribute-object-initargs slot))))
- (class-slots (class-of description))))
- (defining-classes (partial-class-defining-classes (class-of description))))
+(defgeneric standard-description-p (description-candidate)
+ (:method (not-description)
+ NIL)
+ (:method ((description standard-description-object))
+ T))
+
+(defun compute-effective-attribute-objects (description)
+ (mapcar
+ (lambda (slot)
+ (or (find-attribute description
+ (slot-definition-name slot) nil)
+ (let* ((*init-time-description* description)
+ (attribute-class (or
+ (ignore-errors
+ (slot-value-using-class
+ (class-of description) description slot))
+ 'standard-attribute))
+ (attribute
+ (apply #'make-instance
+ attribute-class
+ :description description
+ :attribute-class attribute-class
+ (attribute-object-initargs slot))))
+ (setf (slot-definition-attribute-object slot) attribute))))
+ (remove 'described-object (class-slots (class-of description))
+ :key #'slot-definition-name)))
+
+(defmacro with-described-object ((object description &rest args)
+ &body body)
+ `(funcall-with-described-object
+ (lambda () ,@body)
+ ,object
+ ,description
+ ,@args))
+
+(defun initialize-effective-attribute-values-for-description-class (class description attribute-objects)