🚀 go-pugleaf

You have hit on a real problem in the CLOS MOP, at least as far as I am
concerned.  Unfortunately, given the current specification, it is pretty
hard to fix.  It depends a bit on how you look at it, but I guess I
would say the primary reason this can't be fixed is ``forward referenced
superclasses;'' or perhaps a combination of them and the rule that says
you can't change the class of a metaobject once it has been initialized.

If we got rid of forward referenced superclasses, your problem could be
fixed by providing a generic function called SUBCLASS-CLASS, which would
be called to determine the appropriate class of a subclass.  Some hair
would be needed to handle multiple inheritance, but that would be easy.

But, with forward referenced superclasses, we might not know that a
class needs to be an instance of something other than standard-class
until long after it is created, which causes problems with the change
class rule.  We might be able to get out of that by saying that one can
change the class of a class up until the time it is finalized; maybe
that is worth considering.

How serious a problem do people think this is?

One final note, in your message, you propose a fix that I don't
understand: 

   It seems that the only way of implementing this today is by
   defining an :around method on ENSURE-CLASS-USING-CLASS which
   is not exactly great to specialize, so maybe taking a look
   again at this part of the CLOS specification would be a good
   idea.

Can you elaborate on this?


Gregor

Here is a way of implementing the rule for implementing metaclass inheritance
proposed in my previous post (Note that it is NECESSARY to clearly specify in
the MOP that DEFCLASS should NOT default the :metaclass option to STANDARD-CLASS.
I found out that the current implementation of Allegro CL does exactly this.
(There is no problem if the standard methods on ENSURE-CLASS-USING-CLASS do it,
though).

(in-package :clos)
(use-package :series)

(defmethod ensure-class-using-class :around ((class t) name 
                                             &rest args
                                             &key (direct-superclasses nil)
                                                  (metaclass nil))
  (if (or metaclass (null direct-superclasses))
      (call-next-method)
    (let* ((forward-referenced-class (find-class 'forward-referenced-class))
           (direct-supers (if (collect-or (map-fn 't #'(lambda (class)
                                                         (symbolp class))
                                                  (scan 'list direct-superclasses)))
                              (collect '(list class)
                                       (map-fn 't #'(lambda (class)
                                                      (if (symbolp class)
                                                          (or (find-class class nil) 
                                                              (ensure-class class
                                                                            :metaclass 'forward-referenced-class))
                                                        class))
                                               (scan 'list direct-superclasses)))
                            direct-superclasses))
           (metaclasses (collect 'list
                                 (map-fn 'list ;(type standard-class))
                                         #'subclasses* 
                                         (choose-if #'(lambda (class)
                                                        (not (eq class forward-referenced-class)))
                                                    (map-fn 'class
                                                            #'class-of
                                                            (scan '(list class) direct-supers)))))))
      (cond (metaclasses
             (cond ((eql (length metaclasses) 1)
                    (setq metaclass (caar metaclasses)))
                   (t
                    (setq metaclasses (delete-duplicates (apply #'intersection metaclasses)))
                    (setq metaclass (collect '(list class) (choose-if #'(lambda (class)
                                                                   (collect-and (map-fn 't #'(lambda (c)
                                                                                               (subtypep c class))
                                                                                        (scan '(list class) metaclasses))))
                                                               (scan '(list class) metaclasses))))
                    (if (eql (length metaclass) 1)
                        (setq metaclass (car metaclass))
                      (setq metaclass 'standard-class)))))
            (t 
             (setq metaclass 'standard-class)))
      #+allegro ; non-compliance fix
      (if (symbolp metaclass)
          (apply #'call-next-method class name :direct-superclasses direct-supers :metaclass metaclass args)
        (apply #'call-next-method class name :direct-superclasses direct-supers :metaclass (class-name metaclass) args))
      #-allegro
      (apply #'call-next-method class name :direct-superclasses direct-supers :metaclass metaclass args))))


(defun subclasses* (class)
  (let (last-cons l)
    (clos::map-over-subclasses #'(lambda (x)
                                   (cond (last-cons
                                           (rplacd  last-cons (cons x nil))
                                           (setq last-cons (cdr last-cons)))
                                     (t
                                       (setq last-cons (cons x nil))
                                       (setq l last-cons))))
                               class)
    l))

-- 
Fernando D. Mato Mira
Computer Graphics Lab			   "Bury GIFs!! Get JPEGed!!!"
Swiss Federal Institute of Technology
matomira@di.epfl.ch

NeXTMail : matomira@lignext.epfl.ch
FAX 	 : +41 (21) 693 - 5328

In article <1993Jan8.220317@di.epfl.ch> matomira@di.epfl.ch (Fernando Mato Mira) writes:

   Here is a way of implementing the rule for implementing metaclass
   inheritance proposed in my previous post...

   (defmethod ensure-class-using-class :around ((class t) name 
						&rest args
						&key (direct-superclasses nil)
						     (metaclass nil))
     ...)


This is a nice hack, and it is probably good enough to get some work
done, but I guess I should point out that it is illegal, in portable
code, according to the rules on pages 142, 143 and 144 of AMOP.
Specifically the rule that:

  Any method defined by a portable program on a specified generic
  function must have at least one specializer that is neither a
  specified class nor an {\bf eql} specializer whose associated
  value is an instance of a specified class.

The basic problem with methods like this is that two programs, written
separately, which both have methods like this, will interfere with each
other if they are loaded together.  That is why this rule is there.  We
talk about this, and the origin of all these rules, in more detail in
our OOPSLA'92 paper.

In article <GREGOR.93Jan8173751@tracer-bullet.parc.xerox.com>, gregor@parc.xerox.com (Gregor Kiczales) writes:
> 
> This is a nice hack, and it is probably good enough to get some work
> done, but I guess I should point out that it is illegal, in portable
> code, according to the rules on pages 142, 143 and 144 of AMOP.
> Specifically the rule that:
> 
>   Any method defined by a portable program on a specified generic
>   function must have at least one specializer that is neither a
>   specified class nor an {\bf eql} specializer whose associated
>   value is an instance of a specified class.
> 
> The basic problem with methods like this is that two programs, written
> separately, which both have methods like this, will interfere with each
						      ^^^^^^^^^
> other if they are loaded together.  That is why this rule is there.  We

That's why I didn't like using an :around method. Now you know what I meant
when I said that "ENSURE-CLASS-USING-CLASS is not great to specialize".
Maybe specifying that the last action performed by ENSURE-CLASS-USING-CLASS is to call another function with the
same lamdba list, say FINALIZE-ENSURE-CLASS-USING-CLASS, (&allow-other-keys poses a problem for termination, so a
recursive call is out) but passing the newly created class as the class argument, and allowing to use CHANGE-CLASS in
this procedure would solve the problem.
One could see the class being defined as being "forward referenced" until DEFCLASS returns to avoid feeling "guilty" for allowing another exception to
the CHANGE-CLASS rule for class metaobjects.

-- 
Fernando D. Mato Mira
Computer Graphics Lab			   "Bury GIFs!! Get JPEGed!!!"
Swiss Federal Institute of Technology
matomira@di.epfl.ch

NeXTMail : matomira@lignext.epfl.ch
FAX 	 : +41 (21) 693 - 5328

In article <1993Jan8.154239@di.epfl.ch> matomira@di.epfl.ch (Fernando Mato Mira) writes:

   Let's say you have a metaclass ATTRIBUTED-CLASS, so when you do

   (defclass foo () () 
    (:metaclass attributed-class))

   you get something like
   #<ATTRIBUTED-CLASS SCHEMA @ #x10f7f26a>

   Then somebody comes and does  
   (defclass bar (foo) ())

   and he gets
   #<STANDARD-CLASS BAR @ #x10f82c02>

   when what he really needs is
   #<ATTRIBUTED-CLASS BAR @ #x10f82c02>

   and you would like to hide the implementation-dependent metaclass.

   I think that in many cases, if you can resolve the set of common
   subclasses of the set of metaclasses of the direct superclasses of
   a class to a hierarchy, taking the root of that hierarchy as the
   default metaclass is the way that you want to go, and not getting
   just STANDARD-CLASS instead.  For disambiguating more complicated
   cases, or for getting some other metaclass than this default one,
   the :metaclass option is there.  If you do not disambiguate by
   using the :metaclass option, then getting STANDARD-CLASS as the
   default would be OK.  When a direct superclass of the class being
   defined is a forward-referenced class, it is treated by the
   previous algorithm as if its metaclass were STANDARD-CLASS instead
   of FORWARD-REFERENCED-CLASS.

   It seems that the only way of implementing this today is by
   defining an :around method on ENSURE-CLASS-USING-CLASS which is not
   exactly great to specialize, so maybe taking a look again at this
   part of the CLOS specification would be a good idea.

I think the justification for this would be to allow the compiler to
use knowledge of the metaclass at compile time to make certain
optimizations.  In practice, I'm not sure how much CLOS
implementations could use this information given other constraints,
and I'm pretty sure none currently do.

The workaround is to define your own class
definition macro for your metaclass which could be just like DEFCLASS
but inserts its own metaclass in the :METACLASS option.

-- Harley Davis
--

------------------------------------------------------------------------------
nom: Harley Davis			ILOG S.A.
net: davis@ilog.fr			2 Avenue Gallie'ni, BP 85
tel: (33 1) 46 63 66 66			94253 Gentilly Cedex, France

In article <DAVIS.93Jan11113652@passy.ilog.fr>, davis@passy.ilog.fr (Harley Davis) writes:
> 
> The workaround is to define your own class
> definition macro for your metaclass which could be just like DEFCLASS
> but inserts its own metaclass in the :METACLASS option.
> 
The idea is never having to define a new DEFCLASS-like macro, but use the
MOP instead for your customizations.

-- 
Fernando D. Mato Mira
Computer Graphics Lab			   "Bury GIFs!! Get JPEGed!!!"
Swiss Federal Institute of Technology
matomira@di.epfl.ch

NeXTMail : matomira@lignext.epfl.ch
FAX 	 : +41 (21) 693 - 5328