common-lisp
CLOS-Metaobjekt-Protokoll

Ermitteln Sie die Steckplatznamen einer Klasse

Sagen wir, wir haben eine Klasse als

(defclass person ()
  (name email age))

Um die Namen der Slots der Klasse zu erhalten, verwenden wir die Funktion Class-Slots. Dies ist in dem Closemop-Paket enthalten, das vom Closemop-System bereitgestellt wird. Um das laufende Lisp-Image zu laden, verwenden wir (ql:quickload :closer-mop) . Wir müssen auch sicherstellen, dass die Klasse abgeschlossen ist, bevor Klassen-Slots aufgerufen werden.

(let ((class (find-class 'person)))
  (c2mop:ensure-finalized class)
  (c2mop:class-slots class))

die eine Liste der effektiven Slot-Definitionsobjekte zurückgibt:

(#<SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION S/TRANSFORMATIONS::NAME>
 #<SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION S/TRANSFORMATIONS::EMAIL>
 #<SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION S/TRANSFORMATIONS::AGE>)

Aktualisieren Sie einen Steckplatz, wenn ein anderer Steckplatz geändert wird

Das CLOS-MOP stellt die Hook-Slot-Value-using-Klasse bereit, die aufgerufen wird, wenn auf einen Slot-Wert zugegriffen wird, gelesen oder geändert wird. Da in diesem Fall nur Änderungen vorgenommen werden, definieren wir eine Methode für (setf slot-value-using-class) .

(defclass document ()
  ((id :reader id :documentation "A hash computed with the contents of every other slot")
   (title :initarg :title :accessor title)
   (body :initarg :body :accessor body)))

(defmethod (setf c2mop:slot-value-using-class) :after
    (new class (object document) (slot c2mop:standard-effective-slot-definition))
  ;; To avoid this method triggering a call to itself, we check that the slot
  ;; the modification occurred in is not the slot we are updating.
  (unless (eq (slot-definition-name slot) 'id)
    (setf (slot-value object 'id) (hash-slots object))))

Beachten Sie, dass, da bei der Instanzerstellung kein slot-value aufgerufen wird, der Code in der initialize-instance :after Methode dupliziert werden muss

(defmethod initialize-instance :after ((obj document) &key)
  (setf (slot-value obj 'id)
        (hash-slots obj)))