Re: Failed attempt to create a metaclass

[Gregor.pa@Xerox.COM]

    Date: Fri, 07 Oct 88 13:08:06 CDT
    From: collins@mmm.3m.com (John Collins)

    I am trying to make a class that keeps a list of its instances around.  This
    looked like a metaclass problem, so I wrote the following: (using the 8/28/88
    version of PCL under Coral's Allegro Common Lisp on a Mac+)

There is some debate about whether this is best done with a metaclass,
or whether it is fine to do it with a mixin class that provides this
behavior.  This message includes both implementations.  I can't tell
from your message what problems you were having exactly, but I have
tested the code I am sending you, so you shouldn't have problems with
it.


    MAKE-INSTANCE is documented as a generic function, but is a function in PCL.
    I would have liked to specialize it for the subclass I created.

*MAKE-INSTANCE is the current name for MAKE-INSTANCE.  I can't stress
enough how important it is to read the notes.text file carefully.  There
is nowhere near enough documentation for PCL, but what there is is
essential reading.

    The symbol STANDARD-CLASS is not exported from the "PCL" package.
    Maybe you didn't intend to export it until the metaobject protocol is
    documented.

Yes.

    DEFGENERIC doesn't seem to be defined.  Maybe this is one of those
    differences between CLOS and PCL.

Yes.


The code follows:

(in-package 'collins :use '(pcl lisp))

(import (mapcar #'(lambda (s) (find-symbol s (find-package 'pcl)))
		'("STANDARD-CLASS"
		  "*MAKE-INSTANCE"
		  "CHECK-SUPER-METACLASS-COMPATIBILITY"
		  "*INITIALIZE-INSTANCE"
		  "CLASS-PROTOTYPE")))
		  
;;;
;;; An implementation using a new metaclass.
;;; 

(defclass instance-list-class (standard-class)
    ((all-instances :initform nil :reader class-all-instances))
  (:documentation "A metaclass that keeps track of its instances"))

(defmethod check-super-metaclass-compatibility ((sub instance-list-class)
						(sup standard-class))
  t)

(defmethod check-super-metaclass-compatibility ((sub standard-class)
						(sup instance-list-class))
  t)
   
(defmethod *make-instance ((class instance-list-class) &rest args)
  (declare (ignore args))
  (let ((instance (call-next-method)))
    (push instance (slot-value class 'all-instances))
    instance))

(defclass foo ()
    ()
  (:metaclass instance-list-class))

;;;
;;; An implementation using a mixin class.
;;;

(defclass record-instances-mixin ()
    ((all-instances-db :initform (make-hash-table :test #'eq :size 20)
		       :allocation :class))
    (:documentation "A mixin class to record all instances."))

(defmethod *initialize-instance :after
	   ((inst record-instances-mixin) &rest initargs)
  (declare (ignore initargs))
  (push inst (gethash (class-of inst) (slot-value inst 'all-instances-db) ()))
  inst)

(defmethod class-all-instances ((class standard-class))
  (class-all-instances-1 (class-prototype class) class))

(defmethod class-all-instances-1 ((proto record-instances-mixin) class)
  (gethash class (slot-value proto 'all-instances-db) ()))

(defclass bar (record-instances-mixin)
    ())
-------