anchor.diff:  
   (defgeneric ensure-prototype-metaclass (proto use-metaclass for-class
                                           direct-superclasses)
  -  (:method ((proto prototype-class) (use-metaclass standard-class)
  +  (:method ((proto singleton) (use-metaclass standard-class)
               (for-class singleton)
               (direct-superclasses list))
  -    (declare (ignore use-metaclass for-class direct-superclasses))
  -    ;; FIXME - DO NOT IGNORE PARAMS - VERIFY PROTO onto those parameters
  -    (values proto))
  +    ;; (declare (ignore use-metaclass for-class direct-superclasses))
  +    ;; FIXME - note the FIND-CLASS call, below, similarly
  +    ;; (values proto))
  +
  +    ;; NB - a trivial hack to ensure that the PROTO class matches per
  +    ;; the  protocol implemented for a newly defined prototype-metaclass
  +    (ensure-prototype-metaclass (class-name proto)
  +                                use-metaclass for-class
  +                                (remove proto direct-superclasses
  +                                        :test #'eq)))
   
   
     (:method ((proto null) (use-metaclass standard-class)
               (for-class singleton)
               (direct-superclasses list))
  -    (error "Erroneous prototype metaclass name for ~s: ~s" proto
  +    (error "Invalid prototype metaclass name for ~s: ~s" proto
              for-class))
   
   
  
positive.code: 
  (defgeneric class-prototype-metaclass (class)
    (:method ((class singleton))
      (find-class 'prototype-class))
    #+NIL
    (:method ((class standard-class))
      ;; NB: STANDARD-CLASS would not support an :IMPLEMENTATION-CLASS
  
negative.code: 
  
  (defmethod allocate-instance ((class singleton*) &rest initargs)
    (cond
      ((or (getf initargs :prototype-class)
           (getf initargs :ensure-prototype))
       ;; ^ NB: Prevent that this protocol would be, in effect, active for
       ;; definitions of classes outside of DEFSINGLETON and similar.
       ;;
       ;; This, by side effect, may serve to ensure that each class will
       ;; have a conventional PROTOTYPE that is an instance of that class'
       ;; metaclass, rather than an instance of any class as would be
       ;; created, below.
  
       (labels ((mk-default-name (class)
                  (make-symbol
                   (concatenate 'simple-string
                                #.(symbol-name (quote #:uninterned-))
                                (symbol-name (class-name class))))))
         (let* ((name (or (getf initargs :name (mk-default-name class))))
                (proto-spec (getf initargs :prototype-class
                                  (ensure-prototype-metaclass-name class name)))
                (metaclass (compute-class
                            (getf initargs :metaclass
                                  (load-time-value (find-class 'singleton*)
                                                   t))))
                (direct-supers (getf initargs :direct-superclasses))
                (proto-metaclass
                 (ensure-prototype-metaclass proto-spec metaclass class
                                             direct-supers)))
  
           ;; (warn "ALLOCATE-INSTANCE ~s as instance of ~s" class proto-metaclass)
           #+NIL ;; unused
           (setf (getf initargs :prototype-class)
                 proto-metaclass)
  
           (apply #'allocate-instance proto-metaclass initargs))))
      (t (call-next-method))))
  
  
  (eval-when ()
  
    (let ((s (find-class 'singleton**)))
      ;; NB: As a side-effect, this form may result in [FIXME] two subclasses
      ;;     of PROTOTYPE-CLASS for the first call, and [OK] one subclass
      ;;     for each subsequent call. [SBCL]
      ;;
      ;; In some implementations ...
      ;;
      ;; The first of those is produced for SINGLETON** here -- certainly,
      ;; due to how the ALLOCATE-INSTANCE method is specialized onto
      ;; SINGLETON*. The latter, of course, is the metaclss of SINGLETON**
      ;;
      ;; FIXME: That first metaclass might appear to be unused, except as
      ;; it being - by some side effect - the metaclass of the PROTOTYPE
      ;; object created for the SINGLETON** class (during class finalization?)
      ;; [SBCL]
      ;;
      (defparameter *the-s*
        (make-instance s :name (gentemp "S")
                       :prototype-class (gensym "S-PROTO-")
                       :direct-superclasses (list s)
                       ;; :ensure-prototype t ;; this obviates the previous remarks
                       ))
      (values #+NIL (typep *the-s* s)
              *the-s*))
  
    ;; (class-of *the-s*)
  
    ;; (class-of (class-of *the-s*))
  
    ;; (class-direct-superclasses (class-of *the-s*))
  
    ;; (class-direct-subclasses (find-class 'prototype-class))
  
    ;; (class-prototype (find-class 'singleton**))
    ;; ^ is of class SINGLETON** which is [OK]
  
    (eq (class-of (class-prototype *the-s*) ) *the-s*)
    ;; => T
  
    (eq (class-of (class-prototype (class-of *the-s*)))
        (class-of *the-s*))
    ;; => T
  
    (subtypep *the-s* 'singleton**)
    ;; => T, T
  
    (subtypep *the-s* 'singleton*)
    ;; => T, T
  
    (subtypep *the-s* 'singleton)
    ;; => T, T
  
  
    (typep *the-s* 'singleton)
  