anchor.diff:  	       (setf (slot-contents slots i)
   		     (eval (cadr (member :initform slot-description))))))))
   
  -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;;
   ;;; Make an instance using slot-descriptions
   
  
positive.code: 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; Accessing slots using the slot definitions above.
  
  (defun slot-value-using-slots (instance slot-name slots)
    (let ((pos (position slot-name slots :key #'car)))
      (slot-contents (standard-instance-slots instance) pos)))
  
  (defun (setf slot-value-using-slots) (new-value instance slot-name slots)
    (let ((pos (position slot-name slots :key #'car)))
      (setf (slot-contents (standard-instance-slots instance) pos) new-value)))
  
  (defun (setf slot-value-using-slot-initarg) (new-value instance initarg slots)
    (let ((pos (position initarg slots
  		       :key (lambda (slot) (cadr (member :initarg slot))))))
      (unless (null pos)
        (setf (slot-contents (standard-instance-slots instance) pos) new-value))))
  
  ;;; For each unbound slot, evaluate its initform to obtain a value to
  ;;; initialize it with.  We could probably avois using EVAL here
  ;;; because, all of the initforms are constant forms anyway, but we do
  ;;; not want to take the risk.
  (defun initialize-unbound-slots (instance slots)
    (loop for slot in slots
  	do (when (eq (slot-value-using-slots instance (car slot) slots)
  		     *secret-unbound-value*)
  	     (setf (slot-value-using-slots instance (car slot) slots)
  		   (eval (cadr (member :initform slot)))))))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; Allocating direct slot definitions
  ;;;
  ;;; To create any class metaobject whatsoever, we need to fill its
  ;;; DIRECT-SLOTS slot with instances of
  ;;; STANDARD-DIRECT-SLOT-DEFININTION.  But
  ;;; STANDARD-DIRECT-SLOT-DEFININTION is itself a class metaobject so
  ;;; we have a circular dependency.  We fix this problem by allocating
  ;;; direct slot definitions "manually", i.e., without the help of
  ;;; MAKE-INSTANCE and the machinery that comes with it.
  
  (defparameter *class-standard-direct-slot-definition*
    (let ((class (allocate-standard-instance nil nil)))
      (setf (find-class 'standard-direct-slot-definition) class)
      class))
      
  ;;; REMEMBER: Patch standard-direct-slot-definition. +
  
  (defun make-direct-slot-definition (&rest initargs
  				    &key &allow-other-keys)
    (let* ((defs (find-effective-slots 'standard-direct-slot-definition))
  	 (slot-descriptions defs)
  	 (slot-storage (allocate-slot-storage (length slot-descriptions)
  					      *secret-unbound-value*))
  	 (instance (allocate-standard-instance
  		    *class-standard-direct-slot-definition*
  		    slot-storage)))
      (loop for (initarg value) on initargs by #'cddr
  	  do (setf (slot-value-using-slot-initarg instance initarg defs)
  		   value))
      (initialize-unbound-slots instance defs)
      instance))
  
  ;;; REMEMBER: Change make-direct-slot-definition to use make-instance. +
  ;;; REMEMBER: Patch version information of slot-definition-instances. +
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; Class T, so that we can allocate the class STANDARD-INSTANCE.
  
  (setf (find-class 't) (allocate-standard-instance nil nil))
  
  ;;; REMEMBER: Patch class T. +
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; Class standard-class.
  
  (defparameter *class-standard-class*
    (let ((class (allocate-standard-instance nil nil)))
      ;; STANDARD-CLASS is an instance of itself. 
      (setf (standard-instance-class class) class)
      (setf (find-class 'standard-class) class)
      class))
      
  ;;; REMEMBER: Patch class STANDARD-CLASS. +
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; Provide an :after method on initialize-instance to be used
  ;;; when class meta-objects are instantiated.  As the AMOP says,
  ;;; we have to provide appropriate default values for the superclasses
  ;;; and we have to link the superclasses to this new class meta-object.
  ;;; We also have to create slot meta-objects from the slot property
  ;;; list provided to initialize-instance.
  
  ;;; We implement this functionality as a function at first, because
  ;;; we don't have any generic functions to begin with.  Later, 
  ;;; we have the real :after method call this function to accomplish
  ;;; its work. 
  (defun initialize-instance-after-standard-class
      (class name direct-superclasses direct-slots)
    (setf (class-name class) name)
    (let ((superclasses (or direct-superclasses
  			  (list (find-class 'standard-object)))))
      (setf (class-direct-superclasses class) superclasses))
    (let ((slots (loop for slot-properties in direct-slots
  		     collect (apply #'make-direct-slot-definition
  				    slot-properties))))
      (setf (class-direct-slots class) slots)))
      
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; Initialize an instance using slot-descriptions.
  
  
negative.code:     (apply #'sd-initialize-instance instance slot-descriptions initargs)
      instance))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; Accessing slots using the slot definitions above.
  
  (defun slot-value-using-slots (instance slot-name slots)
    (let ((pos (position slot-name slots :key #'car)))
      (slot-contents (standard-instance-slots instance) pos)))
  
  (defun (setf slot-value-using-slots) (new-value instance slot-name slots)
    (let ((pos (position slot-name slots :key #'car)))
      (setf (slot-contents (standard-instance-slots instance) pos) new-value)))
  
  (defun (setf slot-value-using-slot-initarg) (new-value instance initarg slots)
    (let ((pos (position initarg slots
  		       :key (lambda (slot) (cadr (member :initarg slot))))))
      (unless (null pos)
        (setf (slot-contents (standard-instance-slots instance) pos) new-value))))
  
  ;;; For each unbound slot, evaluate its initform to obtain a value to
  ;;; initialize it with.  We could probably avois using EVAL here
  ;;; because, all of the initforms are constant forms anyway, but we do
  ;;; not want to take the risk.
  (defun initialize-unbound-slots (instance slots)
    (loop for slot in slots
  	do (when (eq (slot-value-using-slots instance (car slot) slots)
  		     *secret-unbound-value*)
  	     (setf (slot-value-using-slots instance (car slot) slots)
  		   (eval (cadr (member :initform slot)))))))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; Allocating direct slot definitions
  ;;;
  ;;; To create any class metaobject whatsoever, we need to fill its
  ;;; DIRECT-SLOTS slot with instances of
  ;;; STANDARD-DIRECT-SLOT-DEFININTION.  But
  ;;; STANDARD-DIRECT-SLOT-DEFININTION is itself a class metaobject so
  ;;; we have a circular dependency.  We fix this problem by allocating
  ;;; direct slot definitions "manually", i.e., without the help of
  ;;; MAKE-INSTANCE and the machinery that comes with it.
  
  (defparameter *class-standard-direct-slot-definition*
    (let ((class (allocate-standard-instance nil nil)))
      (setf (find-class 'standard-direct-slot-definition) class)
      class))
      
  ;;; REMEMBER: Patch standard-direct-slot-definition. +
  
  (defun make-direct-slot-definition (&rest initargs
  				    &key &allow-other-keys)
    (let* ((defs (find-effective-slots 'standard-direct-slot-definition))
  	 (slot-descriptions defs)
  	 (slot-storage (allocate-slot-storage (length slot-descriptions)
  					      *secret-unbound-value*))
  	 (instance (allocate-standard-instance
  		    *class-standard-direct-slot-definition*
  		    slot-storage)))
      (loop for (initarg value) on initargs by #'cddr
  	  do (setf (slot-value-using-slot-initarg instance initarg defs)
  		   value))
      (initialize-unbound-slots instance defs)
      instance))
  
  ;;; REMEMBER: Change make-direct-slot-definition to use make-instance. +
  ;;; REMEMBER: Patch version information of slot-definition-instances. +
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; Class T, so that we can allocate the class STANDARD-INSTANCE.
  
  (setf (find-class 't) (allocate-standard-instance nil nil))
  
  ;;; REMEMBER: Patch class T. +
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; Class standard-class.
  
  (defparameter *class-standard-class*
    (let ((class (allocate-standard-instance nil nil)))
      ;; STANDARD-CLASS is an instance of itself. 
      (setf (standard-instance-class class) class)
      (setf (find-class 'standard-class) class)
      class))
      
  ;;; REMEMBER: Patch class STANDARD-CLASS. +
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; Provide an :after method on initialize-instance to be used
  ;;; when class meta-objects are instantiated.  As the AMOP says,
  ;;; we have to provide appropriate default values for the superclasses
  ;;; and we have to link the superclasses to this new class meta-object.
  ;;; We also have to create slot meta-objects from the slot property
  ;;; list provided to initialize-instance.
  
  ;;; We implement this functionality as a function at first, because
  ;;; we don't have any generic functions to begin with.  Later, 
  ;;; we have the real :after method call this function to accomplish
  ;;; its work. 
  (defun initialize-instance-after-standard-class
      (class name direct-superclasses direct-slots)
    (setf (class-name class) name)
    (let ((superclasses (or direct-superclasses
  			  (list (find-class 'standard-object)))))
      (setf (class-direct-superclasses class) superclasses))
    (let ((slots (loop for slot-properties in direct-slots
  		     collect (apply #'make-direct-slot-definition
  				    slot-properties))))
      (setf (class-direct-slots class) slots)))
      
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; Function make-instance.  
  