anchor.diff:  
   
   
  +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  +;;;
  +;;; Bootstrapping issues.
  +
  +;;; While it is perfectly possible to figure out the structure of each
  +;;; class metaobject in advance, and to create all those class
  +;;; metaobjects "manually", it would be convenient to use as much as
  +;;; possible of the machinery as early as possible in the
  +;;; bootstrapping process.
  +;;;
  +;;; One problem is that standard-class has a bunch of superclasses
  +;;; that are nearly all instances of standard-class.  It would appear
  +;;; then, that all the classes in that inheritance chain would need to
  +;;; exist before standard-class is created, so that all those classed
  +;;; need to be created "manually".  However, in order to create an
  +;;; instance of a class, all information about that class need not be
  +;;; known.  
  +;;;
  +;;; So, what exactly is needed in order to create an instance of a
  +;;; class?  Well, creating an instance of a class using DEFCLASS,
  +;;; generates a call to some generic functions, so these generic
  +;;; functions must exist, and the dispatch mechanism must function.
  +;;; We will discuss this issue below.  
  +;;;
  +;;; The DEFCLASS macro generates a call to ENSURE-CLASS which
  +;;; essentially only calls ENSURE-CLASS-USING-CLASS.  When a new class
  +;;; is created, ENSURE-CLASS-USING-CLASS calls MAKE-INSTANCE, which
  +;;; creates a standard-instance and then calls INITIALIZE-INSTANCE to
  +;;; fill in the slots.  INITIALIZE-INSTANCE calls SHARED-INITIALIZE to
  +;;; do most of the job.  SHARED-INITIALIZE uses CLASS-OF to find the
  +;;; class of the instance it is initializing, and then calls
  +;;; CLASS-SLOTS on that class.  So obviously, CLASS-SLOTS must exist.
  +;;; It is an accessor of STANDARD-CLASS.  The method on CLASS-SLOTS
  +;;; specialized for STANDARD-CLASS should directly access the slot
  +;;; vector using the position of the slot, so no other mechanism is
  +;;; needed with respect to STANDARD-CLASS, but obviously, that method
  +;;; must be created beforehand somehow.  
  +;;;
  +;;; The return value of CLASS-SLOTS is a list of instances of the
  +;;; class EFFECTIVE-SLOT-DEFINITION.  So this class must exist and we
  +;;; must be able to create instance of it.  After SHARED-INITIALIZE
  +;;; has found the slots of the class metaobject, it uses accessors
  +;;; SLOT-DEFINITION-NAME, SLOT-DEFINITION-INITARGS, and
  +;;; SLOT-DEFINITION-INITFUNCTION, so these must exist as well.
  +;;;
  +;;; Finally, SHARED-INITIALIZE uses SLOT-BOUNDP (SETF SLOT-VALUE).
  +;;; These both use CLASS-SLOTS on the class of the instance to find
  +;;; the appropriate index of the slot vector of the instance. 
  +;;; 
  +;;; 
  +
  +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  +;;;
  +;;; Creating the hierarchy of class metaobjects.
  +
  +;;; Start by creating every class as a standard instance with
  +;;; no slot storage and no metaclass. 
  +
  +(defmacro make-class (name)
  +  `(defparameter ,name (allocate-standard-instance nil nil)))
  +
  +(make-class *class-t*)
  +(make-class *class-standard-object*)
  +(make-class *class-funcallable-standard-object*)
  +(make-class *class-metaobject*)
  +(make-class *class-generic-function*)
  +(make-class *class-standard-generic-function*)
  +(make-class *class-method*)
  +(make-class *class-standard-method*)
  +(make-class *class-standard-accessor-method*)
  +(make-class *class-standard-reader-method*)
  +(make-class *class-standard-writer-method*)
  +(make-class *class-method-combination*)
  +(make-class *class-slot-definition*)
  +(make-class *class-direct-slot-definition*)
  +(make-class *class-effective-slot-definition*)
  +(make-class *class-standard-slot-definition*)
  +(make-class *class-standard-direct-slot-definition*)
  +(make-class *class-standard-effective-slot-definition*)
  +(make-class *class-specializer*)
  +(make-class *class-eql-specializer*)
  +(make-class *class-class*)
  +(make-class *class-built-in-class*)
  +(make-class *class-forward-reference-class*)
  +(make-class *class-standard-class*)
  +(make-class *class-funcallable-standard-class*)
  +
  +;;; Make a list of all standard-classes in top-down breadth-first
  +;;; order.
  +
  +(defparameter *standard-classes*
  +  (list *class-standard-object*
  +	*class-funcallable-standard-object*
  +	*class-metaobject*
  +	*class-method*
  +	*class-standard-method*
  +	*class-standard-accessor-method*
  +	*class-standard-reader-method*
  +	*class-standard-writer-method*
  +	*class-method-combination*
  +	*class-slot-definition*
  +	*class-direct-slot-definition*
  +	*class-effective-slot-definition*
  +	*class-standard-slot-definition*
  +	*class-standard-direct-slot-definition*
  +	*class-standard-effective-slot-definition*
  +	*class-specializer*
  +	*class-eql-specializer*
  +	*class-class*
  +	*class-built-in-class*
  +	*class-forward-reference-class*
  +	*class-standard-class*
  +	*class-funcallable-standard-class*))
  +
  +;;; Make a list of all funcallable-standard-classes in top-down
  +;;; breadth-first order.
  +
  +(defparameter *funcallable-standard-classes*
  +  (list *class-generic-function* *class-standard-generic-function*)
  +
  +;;; Now that every class metaobject is allocated, we can fill in the
  +;;; metaclass of each class metaobject. 
  +
  +(defmacro set-class (class metaclass)
  +  `(setf (standard-instance class ,class) ,metaclass))
  +
  +(loop for class in *standard-classes*
  +      do (set-class class *class-standard-class*))
  +
  +(loop for class in *funcallable-standard-classes*
  +      do (set-class class *class-funcallable-standard-class*))
  +
  +(set-class *class-t* *class-built-in-class*)
  +
  +;;; Before a class metaobject can be used to create instance, it has
  +;;; to have a list of effective slot definitions, but those are
  +;;; themeselves instances that must be created, and so we have a
  +;;; circular dependency.  We fix this problem by starting to allocate
  +;;; effective slot definitions "manually", i.e. without the help of
  +;;; MAKE-INSTANCE and the machinery that comes with it. 
  +
  +;;; We cheat by creating a list of descriptions (name and one initarg)
  +;;; of the effective slots that we know we would en up with if we had
  +;;; used the normal machinery to create the class. 
  +
  +(defparameter *descriptions-of-slots-of-effective-slot-definition*
  +  '(;; Inherited from standard-object.  This information is what
  +    ;; allows us to update instances when a class changes. 
  +    (%version-information :version-information)
  +    (%name :name)
  +    (%allocation :allocation)
  +    (%type :type)
  +    (%location :location)
  +    (%initargs :initargs)
  +    (%initform :initform)
  +    (%initfunction :initfunction)
  +    (%readers :readers)
  +    (%writers :writers)))
  +
  +(defun make-effective-slot-definition (&rest initargs
  +				       &key &allow-other-keys)
  +  (let* ((slot-descriptions *descriptions-of-slots-of-effective-slot-definition*)
  +	 (slot-storage (make-array (length slot-descriptions))))
  +    (flet ((set-slot-value (initarg value)
  +	     (let ((position (position initarg slot-descriptions :key #'cadr)))
  +	       (setf (aref slot-storage position) value))))
  +      ;; Give default values for :type and :allocation
  +      (set-slot-value :type t)
  +      (set-slot-value :allocation :instance)
  +      (loop for (initarg value) on initargs by #'cddr
  +	    do (set-slot-value initarg value)))
  +    (allocate-standard-instance *class-effective-slot-definition*
  +				slot-storage)))
  +
  +				       
positive.code: 		 (setf all-supers (remove candidate all-supers))
  		 (setf relation (remove candidate relation :key #'car)))))
      reverse-result))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  
negative.code: 		 :name '(setf find-class)
  		 :datum new-class)
  	  (setf (gethash name *classes*) new-class))))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; Functions initialize-instance, reinitialize-instance, shared-initialize
  
  (defgeneric shared-initialize (instance
  			       slot-names
  			       &rest initargs
  			       &key &allow-other-keys))
  
  ;;; The spec requires the method on initialize-instance and
  ;;; reinitialize-instance specialized for standard-object to call
  ;;; shared-initialize as shown below.  The slot-name argument is a
  ;;; list of slot-names to be initialized, or t which means all slots.
  ;;; A slot is initialized from the initargs if one of its initargs is
  ;;; in that list.  Otherwise it is initialized by evaluating the
  ;;; corresponding intitform if and only if it is one of the slots to
  ;;; be initialized (according to the value of slot-names), and if it
  ;;; does not already have a value.  In that case, if no initform
  ;;; exists, the slot is left unbound.
  
  (defmethod shared-initialize ((instance standard-object)
  			      slot-names
  			      &rest initargs)
    (loop for slot in (class-slots (class-of instance))
          for slot-name = (slot-definition-name slot)
          do (multiple-value-bind (key value foundp)
  	       ;; Find the first key/value pair in initargs where the
  	       ;; key is one of the initargs of the slot. 
  	       (get-properties initargs (slot-definition-initargs slot))
  	     (declare (ignore key))
  	     (if foundp
  		 ;; Found an explicit initarg in initargs.  Initialize
  		 ;; the slot from its value
  		 (setf (slot-value instance slot-name) value)
  		 ;; No explicit initarg found.  
  		 (when (and (not (slot-boundp instance slot-name))
  			    (not (null (slot-definition-initfunction slot)))
  			    (or (eq slot-names t)
  				(member slot-name slot-names)))
  		   ;; Evaluate the initform by executing the initfunction. 
  		   (setf (slot-value instance slot-name)
  			 (funcall (slot-definition-initfunction slot)))))))
    instance)
  
  (defgeneric initialize-instance (instance
  				 &rest initargs
  				 &key &allow-other-keys))
  
  ;;; The method on initialize-instance specialized for standard-object
  ;;; is especially important to bootstrapping, because all important
  ;;; metaobject classes are subclasses of standard-object.  So if
  ;;; make-instance is used, directly or indirectly (using ensure-class)
  ;;; to create a metaobject class, then this method must already be in
  ;;; place.
  
  (defmethod initialize-instance ((instance standard-object)
  				&rest initargs
  				&key &allow-other-keys)
    ;; Call shared-initialize with a slot-list of t, meaning all slots,
    ;; i.e., for every slot that is not explicitly initialized and which
    ;; is unbound, evaluate its initform if it has one. 
    (apply #'shared-initialize instance t initargs))
  
  (defgeneric reinitialize-instance (instance
  				   &rest initargs
  				   &key &allow-other-keys))
  
  (defmethod reinitialize-instance ((instance standard-object)
  				  &rest initargs
  				  &key &allow-other-keys)
    ;; Call shared-initialize with a slot-list of (), meaning no slot,
    ;; i.e., only assign values to slots that have explicit
    ;; initialization arguments in initargs. 
    (apply #'shared-initialize instance () initargs))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  