anchor.diff:                           (params-adj
                             (remove meta-prop params
                                     :test #'eq)))
  -                    (values (cadr meta-prop) params-adj)))
  +                    #+NIL (values (cadr meta-prop) params-adj)
  +                    (values (cdr meta-prop) params-adj)
  +                    ))
                    (t
  -                  (values 'singleton params))))))
  -    (let ((%proto-name
  -           ;; FIXME: Allow this to be specified in PARAMS (??)
  -           ;; FIXME: Also provide the class, itself, as the value of
  -           ;;        a :singleton-prototype initarg or
  -           ;;        SINGLETON-PROTOTYPE access for the resulting
  -           ;;        class named NAME - such that would serve to
  -           ;;        differentiate the automatically created prototype
  -           ;;        class from the list of user-specified direct
  -           ;;        superclasses
  -           (make-symbol (concatenate 'simple-string
  -                                    (symbol-name name)
  -                                    (symbol-name '#:-prototype)))))
  -      (with-symbols (%proto %superclasses %supers
  -                            %fwd %c %cdef %fwdc
  -                            %singleton )
  -        (multiple-value-bind (%metaclass %params)
  -            (compute-metaclass params) ;; NB: May be unused here
  -
  -          ;; NB: This mayx fail if any of the superclasses is a
  -          ;; forward-referenced class - that can be worked around, locally.
  -
  -          ;; NB: Using an implcit PROTOTYPE-METACLASS := SINGLETON here.
  -          ;;     This may be updated, in a later revision.
  -          `(let* ((,%fwd nil)
  -                  (,%superclasses (quote ,superclasses))
  -                  (,%supers
  -                   (mapcar #'(lambda (,%c)
  -                               (let ((,%cdef (find-class ,%c nil)))
  -                                 (cond
  -                                   (,%cdef (values ,%cdef))
  -                                   (t
  -                                    ;; FIXME: Consider using
  -                                    ;; ENSURE-CLASS here
  -                                    (let ((,%fwdc (make-instance
  -                                                   'forward-referenced-class
  -                                                   :name ,%c)))
  -                                      (setf ,%fwd
  -                                            (nconc ,%fwd (list ,%fwdc)))
  -                                      (values ,%fwdc))))))
  -                           ,%superclasses)))
  -
  -             ;; T.D: Emit a style-warning about each class in %FWD
  -             ;;
  -             ;; TBD: Also define a rudimentary DEFTYPE ... CLASS
  -             ;; within the compiler environment, for each class in %FWD
  -
  +                  #+NIL (values 'singleton* params)
  +                  (values nil params)))))
  +           (compute-prototype-class-name (params)
  +             (let ((name-n (position :prototype-class
  +                                     (the list params)
  +                                     :test #'eq
  +                                     :key #'car)))
  +               (cond
  +                 (name-n
  +                  (let* ((name-prop
  +                          (nth name-n params))
  +                         (params-adj
  +                          (remove name-prop params
  +                                  :test #'eq)))
  +                    (values (cadr name-prop) params-adj)))
  +                 (t
  +                  ;: NB: Calling INTERN in the macroexpansion @ default name
  +                  (values (intern (concatenate 'simple-string
  +                                               (symbol-name name)
  +                                               #.(symbol-name '#:-prototype)))
  +                          params))))))
  +
  +    (multiple-value-bind (%proto-name %params)
  +        (compute-prototype-class-name params)
  +
  +      (with-symbols (%singleton) ;; FIXME review for unused symbols
  +
  +        (multiple-value-bind (%user-metaclass %params)
  +            (compute-user-metaclass %params) ;; NB: May be unused here
  +
  +          ;; NB: Using an implcit PROTOTYPE-METACLASS is-a SINGLETON here.
  +
  +          `(let* ()
  +
  +             #+NIL
  +             ;; NB being handled with a trivial direct-superclasses hack, below
                (let ((,%singleton (load-time-value (find-class 'singleton)
                                                    t)))
                  (unless (some (lambda (c)
  
positive.code: ;; => T, T, T, T
  
  
  (class-slots (find-class 'singleton-1-1))q
  
  (class-direct-slots (find-class 'singleton-1-1))
  
  
negative.code:      ))
      ;; => T, NIL, NIL, T, T
  
  
    (defsingleton s-x-1 ()
      ())
  
    (defsingleton s-x-2 (s-x-1)
      ())
  
    (typep (find-class 's-x-2) 's-x-1)
    ;; => NIL ; which is - in short - why this was updated with DEFSINGLETON*
    ;;
    ;; NB: A broader synposis about the DEFSINGLETON* update is provided,
    ;; in commentary available in the macro definition's source form, below.
  
    )
  
  
  