🚀 go-pugleaf

Allow me to follow-up on my own posting:

In article <1992Nov2.214651.18857@jpl-devvax.jpl.nasa.gov>, charest@Aig.Jpl.Nasa.Gov (Len Charest) writes:
|> Problem: given a metaclass CACHING-CLASS that maintains a list of all its direct 
|> instances, how can I create and use a CLASS-PROTOTYPE for a class based on
|> CACHING-CLASS and also, as a special case, ensure that the CLASS-PROTOTYPE does not
|> appear in the metaclass instance list?

I use the generic function CLASS-DIRECT-INSTANCES to access the instance list.
The following :AROUND method on CLASS-PROTOTYPE solves the problem described
above.

(defmethod class-prototype :around ((class caching-class))
  (let ((prototype (call-next-method)))
    (setf (class-direct-instances class)
          (delete prototype (class-direct-instances class) :test #'eq))
    prototype))

..................................................
                                  Len Charest, Jr.
                 JPL Artificial Intelligence Group
                          charest@aig.jpl.nasa.gov

I think a cleaner solution would be to add a new keyword to the
ALLOCATE-INSTANCE method which said whether the instance was a
prototype or not.

-- 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

Alas, the following message got lost somewhere in between the sending of it 
and the comp.lang.clos list; my apologies for being so late with it.


Date: Thu, 5 Nov 92 10:03:07 PST
From: jonl (Jon L White)
To: charest@Aig.Jpl.Nasa.Gov, peterson@sra.COM
In-Reply-To: your msgs of Wed, 4 Nov 1992 18:32:47 GMT  and  Thu, 5 Nov 1992 15:00:32 GMT
Subject: Avoiding CLASS-PROTOTYPE 

re: [Len] Lucid 4.0.2 *does* use MAKE-INSTANCE to create the class prototype. 
    . . . 
    [Eric] the MOP should specify that class instance prototypes be created 
    with allocate-instance instead of using make-instance (as Lucid has done).

This isn't fully accurate, and doesn't get at the heart of the problem.
Perhaps I can explain. 

First, Lucid "resorts" to MAKE-INSTANCE to supply, lazily, a class-protoype.
But it *doesn't* always "use" MAKE-INSTANCE -- at times, it must just call
ALLOCATE-INSTANCE.   I'll try to explain further below.

The real difficuly is not with the MOP proposal -- which does admit of 
a de facto standard in the existence of CLOS:CLASS-PROTOTYPE, even though
it doesn't say how or when the prototypical instance is created.  Rather,
the difficulty encountered by Len is that CLOS standard doesn't constrain
the system from a random creation here and there, for just about any class.
Of course, if it did (i.e., if it proscribed non-user allocations), then
the prototype would have to be created eagerly, rather than lazily, at 
class definition time; and this would be a loss since almost all classes
don't actually need prototypes.

Now, Lucid's 4.0 release might not set the division between a prototype's
creation by ALLOCATE-INSTANCE and its creation by MAKE-INSTANCE very tightly;
but it does use ALLOCATE-INSTANCE on some ocasions.    The 4.1 release 
(which is allegedly "shipping" right now) uses MAKE-INSTANCE only for 
metaclass prototypes and for generic-function-class prototypes; your vanilla
user class will have to put up with merely a "skeletal" prototype -- i.e. 
one created only by ALLOCATE-INSTANCE.  So while this seems in line with 
your suggestions that prototypes only use ALLOCATE-INSTANCE, this approach 
still has unsolvable problems with it.  Let me explain.

Even with these accommodations, prototypes are at best still an ill-advised
but ocasionally useful kludge.  Suppose a class, system-defined or user-
defined, has as part of its protocol a slot that always has a value 
describing some state about the class; then ALLOCATE-INSTANCE will return 
a very ill-formed object that could easily "crash the system."  It is for 
this reason that Lucid's 4.1 release still calls MAKE-INSTANCE for metaclass
prototypes; metaobject programming would be most awkard if class objects
don't obey the MOP'ish protocol.

On the other hand, suppose a class, system-defined or user defined, has an
init method that prevents successful initization.  With the user's freedom
to place random init methods here and there one could even mess up the 
above stated goal of using MAKE-INSTANCE on metaclasses.  So not being able
to presume about how random user-defined classes are to be used (maybe some
are intended to be "abstract" classes that forbid *any* instances?) then 
only ALLOCATE-INSTACE can be used in general.

Below is a terminal "dribble" showing an example of a successful creation 
of a metaclass prototype in Lucid 4.1, and another example showing an
intervention that prevents initialization so that only ALLOCATE-INSTACE
is used.  As the example continues -- trying to 'describe' the two
prototypes -- you can begin to see how the violation of class protocol
(in the non-initialized prototype) messes up the system.

One last comment.  CLIM seems to have forced prototypes into CLOS, and
because of their coding style, it is even necessary to have a prototype
for the class T. Phooo, T is perhaps the most abstract of abstract classes.
So, several implementations with which I am familiar have a singular-point 
in their code to support a hokey prototype for T.  I used to call it the 
"Moon's Magic Mumble", since Dave Moon referred to this pseudo-instance as 
a little bit of magic.


In the following example, look at the behaviour of the prototypes for the
two metaclasses WINNING-META-CLASS and LOSING-META-CLASS.



;;; Lucid Common Lisp/unknown
;;; [Internal] 4.1.0 Beta-0, 1 November 1992
;;; Copyright (C) 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 by Lucid, Inc.
;;; All Rights Reserved
;;;
;;; This software product contains confidential and trade secret information
;;; belonging to Lucid, Inc.  It may not be copied for any reason other than
;;; for archival and backup purposes.
;;;
;;; Lucid and Lucid Common Lisp are trademarks of Lucid, Inc.  Other brand
;;; or product names are trademarks or registered trademarks of their
;;; respective holders.
;;;
;;; This is a preliminary version to be used for testing purposes only.

;;; Loading source file "/net/kuwait/u/jonl/lisp-init.lisp"
;;; Expanding Dynamic Memory
;;; Loading binary file "/net/jonl/sun4/tools/defautoload.sbin"
;;; Warning: Redefining Function MX which used to be defined in "/tmp_mnt/net/pods/2-1/mods/tools/macroexpanders.lisp"
;;; Warning: Redefining Function MX1 which used to be defined in "/tmp_mnt/net/pods/2-1/mods/tools/macroexpanders.lisp"
;;; Warning: Redefining Function FIND-CALLERS which used to be defined in "/tmp_mnt/net/pods/2-1/mods/tools/find-callers.lisp"
;;; Warning: Redefining Function LOAD-SHADOWS which used to be defined in "/tmp_mnt/net/pods/2-1/mods/tools/load-shadows.lisp"


;;; So here's a random class, with only a "skeletal", uninitialized prototype


> (defclass foo () ((a :initform 'a)))
#<Standard-Class FOO>
> (clos:class-prototype *)
#<Foo #XBBEA86>
> (describe *)

#<Foo #XBBEA86>
    is an instance of the class FOO:
 The following slots have allocation :INSTANCE:
 A    #<Unbound-Slot 61A>


;;; Now let's have a winning metaclass, and watch the successful initialization
;;;  of it's prototype by tapping into the initialzation protocol.  

> (defclass winning-meta-class (standard-class) ())
#<Standard-Class WINNING-META-CLASS>
> (defmethod clos-system:validate-superclass ((x winning-meta-class) 
					      (y standard-class))
    t)
#<Standard-Method VALIDATE-SUPERCLASS (WINNING-META-CLASS STANDARD-CLASS)>
> (defmethod initialize-instance :before ((class winning-meta-class) &key)
    (when (eq (class-of class) (find-class 'winning-meta-class)) ;"exact" class
      (format t "Birth of a Prince!")))
#<Init-Method INITIALIZE-INSTANCE :BEFORE (WINNING-META-CLASS)>


;;; And  further, let's have a losing metaclass, which has an init method that
;;;  aborts any attempt at initialization.

> (defclass losing-meta-class (standard-class) ())
#<Standard-Class LOSING-META-CLASS>
> (defmethod clos-system:validate-superclass ((x losing-meta-class) 
					      (y standard-class))
    t)
#<Standard-Method VALIDATE-SUPERCLASS (LOSING-META-CLASS STANDARD-CLASS)>
>  (defmethod initialize-instance :before ((class losing-meta-class) &key)
    (when (eq (class-of class) (find-class 'losing-meta-class))	 ;"exact" class
      (format t "Shoot ArchDuke Ferdinand!")
      (error "Lose Big!")))
#<Init-Method INITIALIZE-INSTANCE :BEFORE (LOSING-META-CLASS)>
> 


;;; There are no prototypes for these weird metaclasses yet;  TMWFI -- JonL


(setq winner (clos:class-prototype (find-class 'winning-meta-class)))
Birth of a Prince!
#<Winning-Meta-Class (CLOS:CLASS-PROTOTYPE WINNING-META-CLASS)>

> (clos:class-prototype (find-class 'winning-meta-class))
#<Winning-Meta-Class (CLOS:CLASS-PROTOTYPE WINNING-META-CLASS)>

;;; What a winner!

> (describe *)
Class Object:
Name:                  (CLOS:CLASS-PROTOTYPE WINNING-META-CLASS)
MetaClass:             WINNING-META-CLASS
Class-Precedence-List: ((CLOS:CLASS-PROTOTYPE WINNING-META-CLASS) STANDARD-OBJECT CLOS::STANDARD-SLOTTED-OBJECT T)
Direct-Superclasses:   (STANDARD-OBJECT)
Direct-Subclasses:     



> (setq loser (clos:class-prototype (find-class 'losing-meta-class)))
Shoot ArchDuke Ferdinand!
#<Losing-Meta-Class  #XAD0A9E>

;;; Note that we "keep trying", but losing, to initialize this protype.

> (clos:class-prototype (find-class 'losing-meta-class))
Shoot ArchDuke Ferdinand!
#<Losing-Meta-Class  #XAD0A9E>

;;; What a loser!

> (describe loser)
>>Error: The slot CLOS::FULLY-DEFINED-P is unbound in the object #<Losing-Meta-Class  #XAD0A9E>

(:GENERIC-FUNCTION SLOT-UNBOUND :|dispatch code|):
   Required arg 0 (CLASS): #<Standard-Class LOSING-META-CLASS>
   Required arg 1 (INSTANCE): #<Losing-Meta-Class  #XAD0A9E>
   Required arg 2 (SLOT-NAME): CLOS::FULLY-DEFINED-P
    0: Supply a value to be put into the slot
    1: Supply one value to use for this particular call
    2: Try fetching this slot again
:A  3: Abort to Lisp Top Level

-> 

;;; CLOS::FULLY-DEFINED-P  is an implementational part of the CLASS-FINALIZED
;;;   protocol.






-- JonL --



P.S.: "TMWFI"  =  "Take My Word For It."