- "Process class subobjects slot"
- (setf (subobjects cl)
- (let ((subobjects '()))
- (dolist (slot (class-slots cl))
- (let-when
- (subobj-def (esd-subobject slot))
- (let ((subobject
- (make-instance 'subobject
- :name-class (class-name cl)
- :name-slot (slot-definition-name slot)
- :subobj-class (when (atom subobj-def)
- subobj-def)
- :lookup (when (listp subobj-def)
- (car subobj-def))
- :lookup-keys (when (listp subobj-def)
- (cdr subobj-def)))))
- (unless (eq (lookup subobject) t)
- (apply #'ensure-lazy-reader
- cl
- (name-class subobject) (name-slot subobject)
- (subobj-class subobject)
- (lookup subobject) (lookup-keys subobject))
- (push subobject subobjects)))))
- ;; sbcl/cmu reverse class-slots compared to the defclass form
- ;; so re-reverse on cmu/sbcl
- #+(or cmu sbcl) subobjects
- #-(or cmu sbcl) (nreverse subobjects)
- )))
+ (store-lazily-computed-objects cl 'subobjects 'esd-subobject 'subobject))
+
+(defun finalize-compute-cached (cl)
+ (store-lazily-computed-objects cl 'compute-cached-values
+ 'esd-compute-cached-value 'compute-cached-value))