🚀 go-pugleaf

This note presents a new instance structure protocol.  The basic ideas
underlying this protocol arose during recent conversations with Dan
Friedman, Jon Rossie and Erik Ruf.  But they are innocent of the specific
details in this message -- any brain-damage that follows is entirely my
fault.

This protocol is an improvement over the one presented in Chapters 5 and
6 of AMOP in the following ways:
   
 * Radically improved performance. Under the old protocol, user 
   extensions that modify slot access, by defining methods on 
   SLOT-VALUE-USING-CLASS and its setf, perform significantly
   less well than they would if they had been provided natively.
   
   Under this new protocol, such extensions perform much better,
   often just as well as they would if they had been provided 
   natively.  The body of this note is an implementation of the
   per-instance and per-class slots of STANDARD-CLASS, entirely
   in this new protocol, that can be expected to perform as well
   as the existing implementations do by eliding the real protocol.
   This note also includes an implementation of dynamic slots,
   which can be expected to perform well.
    
 * Extensions which need ``hidden storage'' in the instance will
   now be able to actually hide that storage.  They won't have to
   introduce those silly generated slots (i.e. the all-attributes
   slot in the example on page 88).

 * It is also somewhat more clean in that it does not require the
   documentation of either STANDARD-INSTANCE-ACCESS (and its setf)
   or FUNCALLABLE-STANDARD-INSTANCE-ACCESS (and its setf).


The basic idea to improve the performance is just as suggested in AMOP; to
convert the procedural protocol of SLOT-VALUE-USING-CLASS into a more
functional protocol. (Since AMOP, several people have suggested that
`imperative' and `declarative' might be better terms for these two kinds of
protocols. As an experiment, those terms are used in the rest of this
note.)

Briefly, the differences between this protocol and the previous one are:
  
  * There is one new generic function: COMPUTE-GETTER-AND-SETTER,
    that determines, at class finalization time, how slots will
	be read and written.
	
  * The behavior of FINALIZE-INHERITANCE is extended, to include
    an appropriate call to COMPUTE-GETTER-AND-SETTER.
	
  * The behavior of ALLOCATE-INSTANCE changes slightly.
	
  * SLOT-VALUE-USING-CLASS and (SETF SLOT-VALUE-USING-CLASS) are
    eliminated.   

  * STANDARD-INSTANCE-ACCESS, FUNCALLABLE-STANDARD-INSTANCE-ACCESS
    and their setfs are eliminated.


In this note, pseudo-code is used, in something like the style of the first
part of AMOP, to simultaneously demonstrate the protocol, the behavior of
the specified methods, and some sense of how a typical implementation that
supports the protocol would work.

In reading the pseudo code, keep the following conventions in mind.
Wherever slot-value or (setf slot-value) are used, the existence of the
slot isn't a documented part of the protocol (in line with the rest of
the MOP).  Of course sometimes those slots are supporting documented
accessors (i.e.  class-precedence-list, class-slots and
class-default-initargs).  Other times they are supporting purely
internal state (i.e. getters-n-setters and nfields). The `%%' prefix on
a symbol indicates that the function it names is super-low-level and
internal. Finally, for convenience, `slot-definition' is abbreviated as
`slotd.'


First, let's look at finalize-inheritance. What happens here is that we
call new sub-protocol that takes care of determining two things. First,
how much space, as measured in `fields,' should be allocated in each
instance of the class. Second, how access to each of the effective slots
in the class should be implemented, in terms of fields and any other
work that needs doing.

(defmethod finalize-inheritance ((class standard-class))
  (setf (slot-value class 'cpl)   (compute-class-precedence-list class))
  (setf (slot-value class 'slots) (compute-slots class))
  ;
  ; This is the new part.
  ;
  ; Each of the eslotds is asked how it wants to be read and set.
  ; As part of answering that, it can request that it be given
  ; one field in the instance, to store whatever it wants.  By
  ; keeping track of how many fields are requested, we know how
  ; big to make the instance.  More on getters and setters in
  ; a moment.
  ;
  (let* ((nfields 0)
         (field-allocator #'(lambda () (prog1 nfields (incf nfields))))
		 (eslotds (class-slots class)))
    (setf (slot-value class 'getters-n-setters)
	  (mapcar #'(lambda (eslotd)
		      (compute-getter-and-setter class
						 eslotd
						 eslotds
						 field-allocator))
		  eslotds))
    (setf (slot-value class 'nfields) nfields))
  ;
  ; end of new part
  ;	
  (setf (slot-value class 'default-initargs)
	(compute-default-initargs class)))


Now ALLOCATE-INSTANCE just makes an instance of the appropriate size.  
Note the the communication between the FINALIZE-INHERITANCE method and 
the ALLOCATE-INSTANCE method is private.  (More on that later.)

(defmethod allocate-instance ((class standard-class))
  (%%allocate-std-instance (slot-value class 'nfields)))
  

The key synergy is between COMPUTE-GETTER-AND-SETTER and SLOT-VALUE (plus 
its setf).  For each eslotd, COMPUTE-GETTER-AND-SETTER returns three 
values:

  * A field, as gotten by funcalling the field allocator, or nil
    When present, it says that the getter and setter code want
    to have a field in the instance to store `stuff.'
	
  * A getter function.  When the slot is read, the getter function
    will be called to produce the value.  If a field was specified,
    the getter function receives its value as its only argument.
    If no field was specified, it receives an unspecified value as
    its only argument.
	
  * A setter function.  When the slot is set, this is called with
    two arguments.  The value of the field, or some unspecified
    value if there is no field; and the new value.  Whatever value
    is returned by the setter function is stored in the field, if
    of course there is a field.  (SETF SLOT-VALUE) itself takes
    care of returning the new value, the setter function need only
    return what it wants to have go into the field.

(defmethod compute-getter-and-setter ((class standard-class)
                                      (eslotd standard-effective-slotd)
				      field-allocator)
  (ecase (slotd-allocation eslotd)
    (:instance (list eslotd
		     (funcall field-allocator)
		     #'(lambda (x) x)
		     #'(lambda (x) x)))
    (:class    (let ((cell (cons ..put-initial-value-here.. nil)))
		 (list eslotd
		       nil
		       #'(lambda (ignore) (car cell))
		       #'(lambda (ignore new) (rplaca cell new)))))))


Now we can show how slot-value works.

(defun slot-value (object slot-name)
  (let* ((class (class-of object))
	 (eslotd  (find slot-name (class-slots class) :key #'slotd-name)))
    (destructuring-bind (field getter setter)
	(cdr (assoc eslotd (slot-value class 'getters-n-setters)))
      (funcall getter (and field (%%get-field object field))))))
	  
(defun (setf slot-value) (new object slot-name)
  (let* ((class (class-of object))
	 (eslotd  (find slot-name (class-slots class) :key #'slotd-name)))
    (destructuring-bind (field getter setter)
	(cdr (assoc eslotd (slot-value class 'getters-n-setters)))
      (if field
	  (%%set-field object
		       field
		       (funcall setter (%%get-field object field) new))
	  (funcall setter nil new)))))


Some things to note:

 *  What this implementation doesn't do, but is clearly the thing
    that is intended, is to somehow memoize the lookup of the field,
    getter and setter for a slot access.  This should be easy for
    most existing implementations; it might in fact be trivial.

 *  Nothing is documented about the nature of fields.  Users can
    get get them by calling the field allocator, and return them
    from COMPUTE-GETTER-AND-SETTER, but they can't do anything
    else with them.  Think of them as something like capabilities
    or tickets or something.  (In most implementations they will
    be fixnums, but that is beside the point.)
	
 *  The specified methods on FINALIZE-INHERITANCE have private
    communication with  SLOT-VALUE and its setf.  This could
    change if need be.

 *  The standard methods on COMPUTE-GETTER-AND-SETTER signal an
    error if they don't recognize the allocation.  It is the
    responsibility of a subclasser (as we'll see shortly) to
    prevent these methods from ever seeing an eslotd with a
    different allocation.

 *  Class slots are stored in `cells,' that is conses whose car
    holds the class slot value.  No overhead for looking up the
    cell, except the access to it as a closure variable, is done
    during actual slot access.  This is close to as well as any
    existing implementation ends up doing, and it can be improved
    beyond that by inlining the closures.
	
 *  We could make things even easier on implementors by suggesting
    that users say #'identity instead of #'(lambda (x) x).  Or, we
    could even go so far as to let users return nil for the getter
    and setter if they mean do no processing of the value.



For comparison, here is a simple implementation of dynamic slots.

As usual, we want to allocate one field, in each instance of the class, that
will hold all the dynamic slots for that instance. We will use that field to
store an alist of all the dynamically allocated slots. But, under this
protocol, we don't need to create a dummy eslotd to do that. We just call the
field allocator to get an extra field.


(defclass dynamic-class (standard-class) ())
	 
(defmethod compute-getters-and-setters ((class dynamic-class)
                                        eslotds 
                                        field-allocator)
  (let ((*dynamic-slots-field* nil))
    (call-next-method)))
  
(defmethod compute-getter-and-setter ((class dynamic-class)
                                      eslotd
				      field-allocator)
  (let ((name (slot-definition-name eslotd))
        (allocation (slot-definition-allocation eslotd)))
    (if (not (eq allocation ':dynamic))
        (call-next-method)
	(list (or *dynamic-slots-field*
		  (setq *dynamic-slots-field* (funcall field-allocator)))
              #'(lambda (alist)
		  (cdr (assq name alist)))
	      #'(lambda (alist new)
		  (let ((entry (assq name alist)))
		    (cond (entry (rplacd entry new) alist)
			  (t (cons (cons name new) alist)))))))))