common-lisp
Protocole de méta-objet CLOS

Obtenir les noms d'emplacement d'une classe

Disons que nous avons une classe comme

(defclass person ()
  (name email age))

Pour obtenir les noms des slots de la classe, nous utilisons les slots de classes de fonctions. Cela peut être trouvé dans le paquet de vadrouille rapprochée, fourni par le système de vadrouille rapprochée. Pour le charger, l’image lisp courante que nous utilisons (ql:quickload :closer-mop) . Nous devons également nous assurer que la classe est finalisée avant d'appeler des classes.

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

qui renvoie une liste d'objets de définition de logement effectifs :

(#<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>)

Mettre à jour un emplacement lorsqu'un autre emplacement est modifié

Le CLOS MOP fournit le hook slot-value-using-class, qui est appelé lorsqu'un accès à une valeur est accédé, lu ou modifié. Parce que nous ne prenons en compte que les modifications dans ce cas, nous définissons une méthode pour (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))))

Notez que parce que la création de la slot-value instance n'est pas appelée, il peut être nécessaire de dupliquer le code dans l' initialize-instance :after méthode

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