The Art of the Metaobject Protocol, and ENSURE-CLASS-USING-CLASS: Part 3

In Part 2 of this accidental mini-series, I improved the original version of ensure-class-using-metaclass to handle arbitrary initialization arguments, and fixed the call from ensure-class-using-class.

It turned out that that version of ensure-class-using-metaclass was still subpar, though. Because the implementation of ensure-class-using-metaclass was piggybacking on top of ensure-class-using-class, we wouldn’t want to risk using a different method of it (through %ecuc-method), than how ensure-class-using-metaclass would’ve behaved if it was the “direct implementation” of the two.

In other words, %ecuc-method was leaky and resulted in some weird errors.

However, patching that leak up turned out to be easy: we simply shouldn’t need to care about %ecuc-method beyond its usage in the basic low-level implementation. Then we can simply pretend ensure-class-using-class doesn’t exist, and that the protocol “really is” ensure-class-using-metaclass.

Establishing the covert low-level communication between ensure-class-using-class and ensure-class-using-metaclass is trivial – just use a dynamic variable.

;; Let's hack the desired symbol for now
(eval-when (:compile-toplevel :load-toplevel :execute)
  (intern "ENSURE-CLASS-USING-METACLASS" 'c2mop)
  (export (find-symbol "ENSURE-CLASS-USING-METACLASS" 'c2mop) 'c2mop)
  (intern "*%ECUC-METHOD*" 'c2mop)
  (export (find-symbol "*%ECUC-METHOD*" 'c2mop) 'c2mop))

(defvar c2mop:*%ecuc-method* nil
  "This holds the next ensure-class-using-class method for use with the
ensure-class-using-metaclass modification of the MOP. Internal implementation detail.")

(defgeneric c2mop:ensure-class-using-metaclass
    (metaclass class name
     &key &allow-other-keys)
  (:documentation "Extend the MOP since ENSURE-CLASS-USING-CLASS doesn't allow specializing on the metaclass.

METACLASS is a prototype of the metaclass."))

(defmethod c2mop:ensure-class-using-class :around
    (class name &rest args &key (metaclass 'standard-class) &allow-other-keys)
  (assert (or (symbolp metaclass) (c2mop:classp metaclass)))
  (let ((metaclass (if (symbolp metaclass) (find-class metaclass) metaclass))
        (c2mop:*%ecuc-method*
          (lambda (class name &rest internal-args &key &allow-other-keys)
            (apply #'call-next-method
                   class
                   name
                   :metaclass metaclass
                   ;; And, so we'll capture implementation-specific extras:
                   (append internal-args args)))))
    (apply #'c2mop:ensure-class-using-metaclass (c2mop:class-prototype metaclass) class name args)))

(defmethod c2mop:ensure-class-using-metaclass
    (metaclass class name
     &rest args &key &allow-other-keys)
  (apply c2mop:*%ecuc-method*
         class
         name
         args))

This third version has been behaving amicably, and I can simply pretend defclass expands into a call to ensure-class-using-metaclass. It should be straightforwards to modify programs that have methods on ensure-class-using-class into ones that use ensure-class-using-metaclass instead: after all, the set of possible methods on ensure-class-using-class are the set of possible methods on ensure-class-using-metaclass that don’t specialize on the metaclass. The exception would be if others have done similar local protocol modifications.