[Openmcl-devel] MOP initialize-instance question

[Gary Byers]

On Mon, 13 Sep 2004, Cyrus Harmon wrote:

> So I'm trying to make my own metaclasses and I have a class that has a
> mix of some "special" slots and some standard slots. I can get
> slot-value-using-class and setf s-v-u-c to work properly, but I can't
> figure out how to hijack the initargs stuff so the MOP code Does What I
> Mean. It would be nice if there were an initialize-slot that got called
> by initialize-instance (or %shared-initialize). But there doesn't seem
> to be. Any suggestions for how I can get slot-specific (or even
> direct-slot-definition-specific) behavior so I can use the built-in
> stuff for "normal" slots and do my own work to figure out what the
> values (and where they should go are) for my non-normal slots?
>
> Is there a better way to skin this cat?
>
> Thanks,
>
> Cyrus
>

OpenMCL defines:

(defmethod shared-initialize ((instance standard-object) slot-names &rest initargs)
  (declare (dynamic-extent initargs))
  (%shared-initialize instance slot-names initargs))

e.g., the function CCL::%SHARED-INITIALIZE happens to do all of the heavy
lifting.

CCL::%SHARED-INITIALIZE does that heavy lifting under the assumption
that it's dealing with standard objects that have standard slot definitions,
and it bypasses most of the MOP in doing what it does, for two reasons:

1) Because It Can
2) Because most of the MOP doesn't necessarily exist until the methods/
classes/etc in question can be initialized with, and this function is
used to initialize those objects.

After CLOS has initialized itself (it's mostly all there by the time
that "ccl:level-1;l1-clos" has finished loading during XLOAD-LEVEL-0),
reason 2 becomes less compelling; it'd be possible to redefine
CCL::%SHARED-INITIALIZE (mostly) in terms of MOP functions:

(defun more-moppish-%shared-initialize (instance slot-names initargs)
  (unless (or (listp slot-names) (eq slot-names t))
    (report-bad-arg slot-names '(or list (eql t))))

  ;; Check that initargs contains valid key/value pairs,
  ;; signal a PROGRAM-ERROR otherwise.  (Yes, this is
  ;; an obscure way to do so.)

  (destructuring-bind (&key &allow-other-keys) initargs)

  ;; I'm not sure if there's a more portable way of detecting
  ;; obsolete instances.  This'll eventually call
  ;; UPDATE-INSTANCE-FOR-REDEFINED-CLASS if it needs to.

  (let* ((wrapper (instance-class-wrapper instance))
         (class (%wrapper-class wrapper)))
    (when (eql 0 (%wrapper-hash-index wrapper)) ; obsolete
      (update-obsolete-instance instance))

    ;; Now loop over all of the class's effective slot definitions.

    (dolist (slotd (class-slots class))

      ;; Anything that inherits from STANDARD-EFFECTIVE-SLOT-DEFINITION
      ;; in OpenMCL will have a CCL::TYPE-PREDICATE slot, derived from
      ;; the slot's specified TYPE.  This check for slot existence
      ;; and -boundp-ness is probably overkill: it's not well-defined
      ;; to try to inherit from EFFECTIVE-SLOT-DEFINITION without
      ;; also inheriting from STANDARD-EFFECTIVE-SLOT-DEFINITION,
      ;; and these checks might slow things down a bit.

      (let* ((predicate
              (if (and (slot-exists-p slotd 'type-predicate)
                       (slot-boundp slotd 'type-predicate))
                (slot-value slotd 'type-predicate)
                #'true)))
      (multiple-value-bind (ignore new-value foundp)
          (get-properties initargs (slot-definition-initargs slotd))
        (declare (ignore ignore))
        (cond (foundp

               ;; an initarg for the slot was passed to this function
               ;; Typecheck the new-value, then call
               ;; (SETF SLOT-VALUE-USING-CLASS)

                (unless (funcall predicate new-value)
                  (error 'bad-slot-type-from-initarg
                         :slot-definition slotd
                         :instance instance
                         :datum new-value
                         :expected-type  (slot-definition-type slotd)
                         :initarg-name (car foundp)))
                (setf (slot-value-using-class class instance slotd) new-value))
              ((and (or (eq slot-names t)
                        (member (slot-definition-name slotd)
                                slot-names
                                :test #'eq))
                    (not (slot-boundp-using-class class instance slotd)))

               ;; If the slot name is among the specified slot names, or
               ;; we're reinitializing all slots, and the slot is currently
               ;; unbound in the instance, set the slot's value based
               ;; on the initfunction (which captures the :INITFORM).

               (let* ((initfunction (slot-definition-initfunction slotd)))
                 (if initfunction
                   (let* ((newval (funcall initfunction)))
                     (unless (funcall predicate newval)
                       (error 'bad-slot-type-from-initform
                              :slot-definition slotd
                              :expected-type (slot-definition-type slotd)
                              :datum newval
                              :instance instance))
                     (setf (slot-value-using-class class instance slotd)
                           newval))))))))))
  instance)

This is basically a slightly re-written version of
CCL::%SHARED-INITIALIZE, with a few more comments and with lower-level
accessors that know lots about the representation of STANDARD-OBJECTs
replaced with more general MOP functions where possible (and quite
possibly with a few bugs introduced; save important work before trying
to use this, and don't be shocked if args are backwards or parens are
misplaced ...)

Although this -could- be used as a replacement for
CCL::%SHARED-INITIALIZE after things are bootstrapped, there are some
tradeoffs involved.  If we're dealing with things that are
semantically far-removed from STANDARD-OBJECT, some concepts may not
apply (the SHARED-INITIALIZE method that Randall Beer wrote for the
ObjC bridge had to deal with the fact that ObjC has no real concept of
"boundp-ness" and that ObjC may not even like the idea of instance
reinitialization too much.)  Likewise, the typechecking that happens
on standard objects may not apply (or be desirable) in some cases.

If the objects in question are "standard" CLOS objects with standard
semantics, skipping the MOP's generality makes instance initialization
a little faster, which is probably A Good Thing.   (Perhaps the right
thing is to use the current version of CCL::%SHARED-INITIALIZE if
the metaclass of the instance is STANDARD-CLASS or FUNCALLABLE-STANDARD-
CLASS exactly, and fall back on the more general case if it's a subclass
of one of those classes.)