anchor.diff:                                     ((:accessor this-accessor))
                                      ((:multiplicity this-multiplicity))
                                      ((:implementation this-implementation))
  +                                   ;; ((:ordered this-ordered))
                                      ((:test this-test) '(function eql))
  +                                   ((:lessp this-lessp) nil this-lessp-givenp)
  +                                   ((:key this-key) '(function identity))
                                      ((:copy this-copy) '(function identity))
                                      &allow-other-keys) this
         (declare (ignore this-copy))
         (multiple-value-bind (this-min this-max) (multiplicity this-multiplicity)
           (let ((this-implementation (or this-implementation
  -                                       (if (equal 1 this-max) 'reference 'list))))
  +                                       (if (equal 1 this-max) 'reference 'list)))
  +              (this-test (if this-lessp-givenp
  +                           (let ((a (gensym))
  +                                 (b (gensym))
  +                                 (lessp (gensym)))
  +                             `(lambda (,a ,b)
  +                                (let ((,lessp ,this-lessp))
  +                                  (and (not (funcall ,lessp ,a ,b))
  +                                       (not (funcall ,lessp ,b ,a))))))
  +                           this-test)))
             (assert (member this-implementation  '(list reference))
                     (this-implementation)
                     "IMPLEMENTATION other than REFERENCE or LIST ~
  
positive.code:                        (setf ,(slot) ,(value))))
                ((list)
                 (cond
                   ((eql  1 this-max)
                    `(progn (assert (null ,(slot)))
                            (setf ,(slot) (list ,(value)))))
                   ((eql '* this-max)
                    `(progn (assert (not (member ,value ,(slot) :test ,this-test)))
                            (pushnew ,(value) ,(slot) :test ,this-test)))
                   (t
                    (let ((vendpoint (gensym)))
                      `(let ((,vendpoint  ,(slot)))
                         (if (and (<  (length ,vendpoint) ,this-max)
                                  (not (member ,value ,vendpoint :test ,this-test)))
                             (progn (assert (not (member ,value ,(slot) :test ,this-test)))
                                    (push ,(value) ,(slot)))
                             (cerror "Endpoint ~A of association ~A is full, maximum multiplicity is ~A is reached."
                                     ',this-role ',association-name ',this-max)))))))))))))
  
  
negative.code: 
      Currently implemented:  REFERENCE and LIST.
      MULTIPLE is not implemented yet.
  
  OPTIONS        a list of (:keyword ...) options.
     (:DOCUMENTATION string)
  