Lisp: Classes in the Metaobject Protocol

Now let's look at slow-value to see how the machinery in place will accomplish this. It is important to remember that a real CLOS imple mentation will not use a mechanism as inefficient as what I'll show for slot access.

The first ingredient in slot access is a function named slot-location, which takes a class and a slot name and finds the relative position in the list of effective slot definitions for that slot. Listing 7 shows the code. slot-location simply finds the index of the slot whose name is slot-namein the list of effecitve slot definitions stored in the class. Only local slots are checked, because only local slots have storage allocated in each instance. (Check the arguments passed to allocate-slot-storage in Listing 4).

(defun slot-location (class slot-name)
  (let ((slot (find slot-name
                    (class-slots class)
                    :key #'slot-definition-name)))
    (if (null slot)
        (error "The slot ~S is missing from the class ~S."
               slot-name class)
        (let ((pos (position slot
                             (remove-if-not #'instance-slot-p
                                            (class-slots class)))))
          (if (null pos)
              (error "The slot ~S is not an instance~@
                      slot in the class ~S."
                     slot-name class)
              pos))))))

The next ingredient is slot-value (Listing 8), which just calls slot-value-using-class. The method for slot-value-using-class on standard-class finds the location of the slot in the class object, gets the slots vector from the underlying instance representation, does an svref via slot-contents to get the value, checks the value to determine whether the slot is bound, and returns the value if all is well. (self slot-value) is similar.

(defun class-of (x)
  (if (std-instance-p x)
      (std-instance-class x)
      (built-in-class-of x)))

(defun slot-contents (slots location)
  (svref slots location))

(defun slot-value (object slot-name)
  (slot-value-using-class (class-of object) object slot-name))

(defmethod slot-value-using-class
   ((class standard-class) instance slot-name)
  (let* ((location (slot-location (class-of instance) slot-name))
         (slots (std-instance-slots instance))
         (val (slot-contents slots location)))
    (if (eq secret-unbound-value val)
        (error "The slot ~S is unbound in the object ~S."
               slot-name instance)
        val)))