anchor.diff:  			:function (eval (make-message-lambda '(new-value sheep) 
   							     `((setf (get-property sheep ',prop-name)
   								     new-value)))))))
  +
  +;;;
  +;;; Inheritance setup
  +;;;
  +(defun add-parent (new-parent child)
  +  (cond ((equal new-parent child)
  +	 (error "Can't inherit from self."))
  +	((not (equal (class-of new-parent)
  +		     (class-of child)))
  +	 (error "Wrong metaclass for parent"))
  +	(t
  +	 (handler-case
  +	     (progn
  +	       (pushnew new-parent (sheep-direct-parents child))
  +	       (let ((pointer (make-weak-pointer child)))
  +		 (pushnew pointer (sheep-direct-children new-parent))
  +		 (finalize child (lambda () (setf (sheep-direct-children new-parent)
  +						  (delete pointer 
  +							  (sheep-direct-children new-parent))))))
  +	       child)
  +	   (sheep-hierarchy-error ()
  +	     (progn
  +	       (setf (sheep-direct-parents child) (delete new-parent (sheep-direct-parents child)))
  +	       (error 'sheep-hierarchy-error))))))
  +  (finalize-sheep child))
  +
  +(defun remove-parent (parent child)
  +  (setf (sheep-direct-parents child)
  +	(delete parent (sheep-direct-parents child)))
  +  (setf (sheep-direct-children parent)
  +	(delete child (sheep-direct-children parent) :key #'weak-pointer-value))
  +  (when keep-properties
  +    (with-accessors ((parent-properties sheep-direct-properties))
  +	parent
  +      (loop for property-name being the hash-keys of parent-properties
  +	 using (hash-value value)
  +	 do (unless (has-direct-property-p child property-name)
  +	      (setf (get-property child property-name) value)))))
  +  (finalize-sheep child)
  +  child)
  +
  +;;; Inheritance predicates
  +(defun direct-parent-p (maybe-parent child)
  +  (when (member maybe-parent (sheep-direct-parents child))
  +    t))
  +
  +(defun ancestor-p (maybe-ancestor descendant)
  +  (when (and (not (equal maybe-ancestor descendant))
  +	     (member maybe-ancestor (collect-parents descendant)))
  +    t))
  +
  +(defun direct-child-p (maybe-child parent)
  +  (direct-parent-p parent maybe-child))
  +
  +(defun descendant-p (maybe-descendant ancestor)
  +  (ancestor-p ancestor maybe-descendant))
   
   ;;;
   ;;; Buzzword setup
  
positive.code: 	(setf (fdefinition name) (lambda (&rest args) (apply-buzzword name args)))
  	buzzword)))
  
  ;;;
  ;;; Bootstrap
  ;;;
  (defvar =standard-buzzword-metaobject= 
    (let ((obj (generate-sheep-object)))
      (setf (get-property obj 'name) '=standard-buzzword-metaobject=)
      (setf (get-property obj 'messages) nil)
      (setf (get-property obj 'documentation) "Standard buzzword metaobject")))
  (defvar =standard-message-metaobject=
    (let ((obj (generate-sheep-object)))
      (setf (get-property obj 'name) '=standard-message-metaobject=)
      (setf (get-property obj 'qualifiers) nil)
      (setf (get-property obj 'lambda-list) nil)
      (setf (get-property obj 'participants) nil)
      (setf (get-property obj 'body) '(values))
      (setf (get-property obj 'function) (lambda () (values)))
      (setf (get-property obj 'documentation) "Standard message metaobject")))
  (defvar =standard-role-metaobject=
    (let ((obj (generate-sheep-object)))
      (setf (get-property obj 'name) '=standard-role-metaobject=)
      (setf (get-property obj 'position) secret-unbound-value)
      (setf (get-property obj 'message-pointer) secret-unbound-value)))
  
  
negative.code:       (:mitosis (warn "Mitosis successful."))
        (otherwise (error 'invalid-option-error)))))
  
  (defun std-finalize-sheep (sheep)
    (memoize-sheep-hierarchy-list sheep)
    (memoize-property-access sheep)
  