(require :closer-mop)

(defclass metainfo-aware-class
    (closer-mop:standard-class)
  ())

(defclass metaslot
    (closer-mop:standard-slot-definition)
  ((metainfo :initform nil
         :initarg :metainfo)))

(defclass direct-metaslot
    (closer-mop:standard-direct-slot-definition metaslot)
  ())

(defclass effective-metaslot
    (closer-mop:standard-effective-slot-definition metaslot)
  ())

(defmethod closer-mop:validate-superclass
    ((class metainfo-aware-class)
     (superclass closer-mop:standard-class))
  t)


(defmethod slot-definition-metainfo
    ((slot closer-mop:standard-slot-definition))
  nil)

(defmethod (setf slot-definition-metainfo)
    (new-value (slot closer-mop:standard-slot-definition))
  nil)

(defmethod slot-definition-metainfo
    ((slot metaslot))
  (slot-value slot 'metainfo))

(defmethod (setf slot-definition-metainfo)
    (new-value (slot metaslot))
  (setf (slot-value slot 'metainfo) new-value))

(defmethod closer-mop:direct-slot-definition-class
    ((class metainfo-aware-class) &rest initargs)
  (find-class 'direct-metaslot))

(defmethod closer-mop:effective-slot-definition-class
    ((class metainfo-aware-class) &rest initargs)
  (find-class 'effective-metaslot))

(defmethod closer-mop:compute-effective-slot-definition
    ((class metainfo-aware-class)
     name
     direct-slot-definitions)
  (let ((effective-slotd (call-next-method)))
    (dolist (slotd direct-slot-definitions)
      (when (typep slotd 'metaslot)
    (setf (slot-value effective-slotd 'metainfo)
          (slot-value slotd 'metainfo))
    (return)))
    effective-slotd))