anchor.diff:    ;;    for any one or more of the :RESISTER-CONC-NAME, :FIND-CONC-NAME
     ;;    and :REMOVE-CONC-NAME options in PARAMS
   
  -  (labels ((get-one-param (%name %params)
  -             (declare (type symbol name) (type list params))
  -             (let ((n (position %name %params
  -                                :key #'car
  -                                :test #'eq)))
  -               (cond
  -                 (n (let ((p (nth n params)))
  -                      (values (cdr p)
  -                              t
  -                              (remove p %params :test #'eq))))
  -                 (t (values nil nil params)))))
  -           (ensure-symbol-name (name)
  -             (etypecase name
  -               (string name)
  -               (symbol (symbol-name name)))))
  -    (multiple-value-bind (conc-suffix conc-sfx-p params)
  -        (get-one-param :conc-suffix params)
  -      (declare (ignore conc-sfx-p))
  -
  -      (let* ((conc-rest (cdr conc-suffix))
  -             (%conc-suffix
  -              (cond
  -                ((and conc-suffix conc-rest)
  -                 (destructuring-bind (suffix &rest n-a) conc-rest
  -                   (when n-a
  -                     (simple-program-error
  -                      "~<Extraneous information ~
  +  ;; NB: This macro will destructively modify a copy of PARAMS
  +  (let ((%params (copy-list params))
  +        conc-suffix
  +        reg-prefix
  +        reg-name
  +        find-prefix
  +        find-name
  +        remove-prefix
  +        remove-name
  +        ;; subclasses
  +        )
  +    (macrolet ((pop-param (name)
  +                  `(let ((n (position (quote ,name) %params
  +                                      :key #'car
  +                                      :test #'eq)))
  +                     (cond
  +                       (n (let ((p (nth n params)))
  +                            (setq params
  +                              (delete p %params :test #'eq))
  +                            (values p)))
  +                       (t (values nil))))))
  +      ;; replace nested MV GET-ONE-PARAM calls with POP-PARAM
  +
  +      (labels ((ensure-symbol-name (name)
  +                 (etypecase name
  +                   (string name)
  +                   (symbol (symbol-name name)))))
  +        (setq conc-suffix (pop-param conc-suffix))
  +
  +        (let* ((conc-rest (cdr conc-suffix))
  +               (%conc-suffix
  +                (cond
  +                  ((and conc-suffix conc-rest)
  +                   (destructuring-bind (suffix &rest n-a) conc-rest
  +                     (when n-a
  +                       (simple-program-error
  +                        "~<Extraneous information ~
   in DEFINE-SINGLETON-ENUM~>~< (:CONC-SUFFIX . ~S)~>" conc-rest))
  -                   (when suffix
  -                     (ensure-symbol-name suffix))))
  -                (conc-suffix
  -                 ;; i.e (:CONC-SUFFIX)
  -                 ;; => do not define any default enum accessors
  -                 ;; NB: Ssame effect as (:CONC-SUFFIX NIL)
  -                 (values nil))
  -                (t (setq conc-suffix (concatenate 'simple-string
  -                                                "-" (symbol-name name)))))))
  -        (labels ((mk-default-name (prefix)
  -                   (cond
  -                     (%conc-suffix
  -                      (intern (concatenate 'simple-string
  -                                           (symbol-name prefix)
  -                                           %conc-suffix)))
  -                     (t (intern (symbol-name prefix))))))
  -
  -          (multiple-value-bind (reg-form regp params)
  -              (get-one-param :register-function params)
  -
  -            (unless regp
  +
  +                     (when suffix
  +                       (ensure-symbol-name suffix))))
  +                  (conc-suffix
  +                   ;; i.e (:CONC-SUFFIX)
  +                   ;; => do not define any default enum accessors
  +                   ;; NB: Ssame effect as (:CONC-SUFFIX NIL)
  +                   (values nil))
  +                  (t (setq conc-suffix (concatenate 'simple-string
  +                                                    "-" (symbol-name name)))))))
  +          (labels ((mk-default-name (prefix)
  +                     (cond
  +                       (%conc-suffix
  +                        (intern (concatenate 'simple-string
  +                                             (symbol-name prefix)
  +                                             %conc-suffix)))
  +                       (t (intern (symbol-name prefix))))))
  +
  +            (setq reg-form (pop-suffix register-function))
  +
  +            (unless reg-form
                 (setq reg-form (mk-default-name '#:register)))
   
               (cond
  
positive.code: (in-package #:ltp/common)
  
  (defpackage #:ltp/common/mop/enum
    (:use #:ltp/common/mop/singleton
          #:ltp/common/mop
          #:ltp/common
          #:cl))
  
negative.code: 
  (defgeneric enum-members (enum)
    (:method ((enum dynamic-enum))
      (when (slot-boundp enum '%members)
        (coerce (the (array t (*)) (%enum-members enum))
                'list))))
  
  (defgeneric (setf enum-members) (new-value enum)
    (:method ((new-value list) (enum dynamic-enum))
  