anchor.diff:  ; PERFORMANCE OF THIS SOFTWARE.
   
   ;-------------------------------------------------------------------------------
  -; Behavior/support/utility layer.
  +; Utility
   ;-------------------------------------------------------------------------------
   
   (defmacro mop-push-on-end (value location)
  
positive.code:   (if (null x)
        ()
        (cons (funcall fun (car x) (cadr x))
              (mapplist fun (cddr x)))))
  
  (let ((mop-class-table (make-hash-table :test #'eq)))
  
  
negative.code:         (setf (mop-find-class name) class)
          class)))
  
  (defmacro mop-defclass (name direct-superclasses direct-slots &rest options)
    `(mop-ensure-class ',name
       :direct-superclasses ,(mop-canonicalize-direct-superclasses direct-superclasses)
       :direct-slots ,(mop-canonicalize-direct-slots direct-slots)
       ,@(mop-canonicalize-defclass-options options)))
  
  ;-------------------------------------------------------------------------------
  ; defgeneric
  ;-------------------------------------------------------------------------------
  
  (let ((mop-generic-function-table (make-hash-table :test #'equal)))
  
    (defun mop-find-generic-function (symbol &optional (errorp t))
      (let ((gf (gethash symbol mop-generic-function-table nil)))
        (if (and (null gf) errorp)
            (error "No generic function named ~S." symbol)
            gf)))
  
    (defun (setf mop-find-generic-function) (new-value symbol)
      (setf (gethash symbol mop-generic-function-table) new-value))
  
    (defun mop-forget-all-generic-functions ()
      (clrhash mop-generic-function-table)
      (values))
  
  )
  
  (defparameter mop-the-defclass-standard-method
    '(defclass mop-standard-method ()
       ((lambda-list :initarg :lambda-list)
        (qualifiers :initarg :qualifiers)
        (specializers :initarg :specializers)
        (body :initarg :body)
        (environment :initarg :environment)
        (generic-function :initform nil)
        (function))))
  
  (defvar mop-the-class-standard-method)
  
  (defun mop-method-lambda-list (method) (mop-slot-value method 'lambda-list))
  (defun (setf mop-method-lambda-list) (new-value method)
    (setf (mop-slot-value method 'lambda-list) new-value))
  
  (defun mop-method-qualifiers (method) (mop-slot-value method 'qualifiers))
  (defun (setf mop-method-qualifiers) (new-value method)
    (setf (mop-slot-value method 'qualifiers) new-value))
  
  (defun mop-method-specializers (method) (mop-slot-value method 'specializers))
  (defun (setf mop-method-specializers) (new-value method)
    (setf (mop-slot-value method 'specializers) new-value))
  
  (defun mop-method-body (method) (mop-slot-value method 'body))
  (defun (setf mop-method-body) (new-value method)
    (setf (mop-slot-value method 'body) new-value))
  
  (defun mop-method-environment (method) (mop-slot-value method 'environment))
  (defun (setf mop-method-environment) (new-value method)
    (setf (mop-slot-value method 'environment) new-value))
  
  (defun mop-method-generic-function (method) (mop-slot-value method 'generic-function))
  (defun (setf mop-method-generic-function) (new-value method)
    (setf (mop-slot-value method 'generic-function) new-value))
  
  (defun mop-method-function (method) (mop-slot-value method 'function))
  (defun (setf mop-method-function) (new-value method)
    (setf (mop-slot-value method 'function) new-value))
  
  (defun mop-canonicalize-defgeneric-option (option)
    (case (car option)
      (:generic-function-class (list ':generic-function-class `(find-class ',(cadr option))))
      (:method-class (list ':method-class `(find-class ',(cadr option))))
      (otherwise (list `',(car option) `',(cadr option)))))
  
  (defun mop-canonicalize-defgeneric-options (options)
    (mop-mapappend #'mop-canonicalize-defgeneric-option options))
  
  (defun mop-ensure-generic-function (function-name
                                      &rest all-keys
                                      &key (generic-function-class mop-the-class-standard-gf)
                                           (method-class mop-the-class-standard-method)
                                      &allow-other-keys)
    (if (mop-find-generic-function function-name nil)
        (mop-find-generic-function function-name)
        (let ((gf (apply (if (eq generic-function-class mop-the-class-standard-gf)
                             #'mop-make-instance-standard-generic-function
                             #'mop-make-instance)
                         generic-function-class
                         :name function-name
                         :method-class method-class
                         all-keys)))
          (setf (mop-find-generic-function function-name) gf)
          gf)))
  
  (defun finalize-generic-function (gf)
    (setf (mop-generic-function-discriminating-function gf)
          (funcall (if (eq (mop-class-of gf) mop-the-class-standard-gf)
                       #'mop-std-compute-discriminating-function
                       #'mop-compute-discriminating-function)
                   gf))
    (setf (fdefinition (mop-generic-function-name gf))
          (mop-generic-function-discriminating-function gf))
    (clrhash (mop-classes-to-emf-table gf))
    (values))
  
  (defmacro mop-defgeneric (function-name lambda-list &rest options)
    `(mop-ensure-generic-function ',function-name
                                  :lambda-list ',lambda-list
                                  ,@(mop-canonicalize-defgeneric-options options)))
  
  ;-------------------------------------------------------------------------------
  ; Definitions.
  