Method: (COMPUTE-EFFECTIVE-SLOT-DEFINITION PERSISTENT-CLASS T T)

Source

(defmethod compute-effective-slot-definition ((class persistent-class)
                                              slot-name
                                              direct-slot-definitions)
  (let ((effective-slotdef (call-next-method))
        (persistent-slotdefs
         (remove-if-not (lambda (slotdef)
                          (typep slotdef 'persistent-direct-slot-definition))
                        direct-slot-definitions)))

    ;; If any direct slot is persistent, then the effective one is too.
    (setf (slot-value effective-slotdef 'persistence)
          (some #'slot-persistence persistent-slotdefs))

    ;; If exactly one direct slot is indexed, then the effective one is
    ;; too. If more then one is indexed, signal an error.
    (let ((index-slotdefs (remove-if-not #'slot-index persistent-slotdefs)))
      (cond ((cdr index-slotdefs)
             (error "Multiple indexes for slot ~S in ~S:~% ~{~S~^, ~}."
                    slot-name class
                    (mapcar #'slot-index index-slotdefs)))
            (index-slotdefs
             (setf (slot-value effective-slotdef 'index)
                   (slot-index (car index-slotdefs))))))
     
    ;; If exactly one direct slot is unique, then the effective one is
    ;; too. If more then one is unique, signal an error.
    (let ((unique-slotdefs (remove-if-not #'slot-unique persistent-slotdefs)))
      (cond ((cdr unique-slotdefs)
             (error "Multiple uniques for slot ~S in ~S:~% ~{~S~^, ~}."
                    slot-name class
                    (mapcar #'slot-unique unique-slotdefs)))
            (unique-slotdefs
             (setf (slot-value effective-slotdef 'unique)
                   (slot-unique (car unique-slotdefs))))))
     
    ;; Return the effective slot definition.
    effective-slotdef))