🚀 go-pugleaf

I want to control the class of my effective-slot-definitions
based in information in my direct-slot-definitions, but the MOP
is so vague on how compute-effective-slot-definition computes
the initargs argument to effective-slot-definition-class that
I can't figure out how to do this.  In particular, the MOP
says that compute-effective-slot-definition follows the rules
described in the "Inheritance of Slots and Options" section of
the CLOS specification to generate the initargs described
in "Initialization of Slot Definition Metaobjects", without
saying anything about how other initargs are could be generated
or how the process of generation of initargs chould be changed in
any way.

If compute-effective-slot-definition-initargs were defined in the
MOP, I could use it.


Here is how I could use PCL (since PCL has
compute-effective-slot-definition-initargs) to do what I want:

#|| ;This is how compute-effective-slot-definition is defined in PCL
(defmethod compute-effective-slot-definition ((class std-class) dslotds)
  (let* ((initargs (compute-effective-slot-definition-initargs class dslotds))
	 (class (effective-slot-definition-class class initargs)))
    (apply #'make-instance class initargs)))
||#

(defclass my-direct-slot-class (standard-direct-slot-definition)
  ((my-direct-info :initarg my-direct-info)))

(defclass my-effective-slot-class (standard-effective-slot-definition)
  ((my-effective-info :initarg my-effective-info)))

(defmethod direct-slot-definition-class ((class my-class) initargs)
  (find-class (if (getf 'my-direct-info initargs)
                  'my-direct-slot-class
	          'standard-direct-slot-definition)))

(defmethod compute-effective-slot-definition-initargs :around
      ((class my-class) dslotds)
  (let ((my-direct-info-list nil))
    (dolist (dslotd dslotds)
      (when (typep dslotd 'my-direct-slot-class)
	(push (slot-value dslotd 'my-direct-info)
	      my-direct-info-list)))
    (let ((initargs (call-next-method)))
      (if my-direct-info-list
	  (list* 'my-effective-info my-direct-info-list initargs)
	  initargs))))

(defmethod effective-slot-definition-class ((class my-class) initargs)
  (find-class (if (getf 'my-effective-info initargs)
                  'my-effective-slot-class
	          'standard-effective-slot-definition)))
----------------
Richard Harris