Re: :initform and :allocation :class

[David C. Martin <dcmartin%postgres.Berkeley.EDU@Berkeley.EDU>]

Yeah, I came across that problem long ago and my fix was to check for a 
correct value in the slot when I first wished to reference it.

(defclass foo (object)
  ((a
    :initform nil
    :type hash-table
    :allocation :class))
  (:constructor make-foo))

(defmethod foo-a ((self foo))
  (let ((a (slot-value self 'a)))
    (when (null a)
	  (setq a (make-hash-table))
	  (setf (slot-value self 'a) a))
    a))

The other way to do it is to check on first instantiation of an instance.
As for subtypep, why not use subclassp?

<pcl> (defclass foo () (x y z))
#<Class FOO 30235361> 

<pcl> (defclass goo (foo) (blah blaz blub))
#<Class GOO 30241051> 

<pcl> (subclassp 'goo 'foo) ; which is what you meant, right?

(#<Class FOO 30235361> #<Class OBJECT 12352051> #<Class T 12352101>) 
<pcl> 


In addition, the following functions might be useful, but note that they
depend on Gregor continuing to store class slots values in the initform slot 
of the slotd object.  Gregor - are you still passing out my PCL modifications?

(defun class-slot-value (class name)
  "Return the value of the class slot from the specified class.  The class
may be either a class object or the symbol which is the class name."
  ;; test if class specified is a symbol
  (if (symbolp class)
      ;; get class object
      (setq class (class-named class)))
  ;; test if class
  (if (not (classp class))
      ;; signal error
      (error "class-slot-value: invalid object ~s" class))
  ;; get all class slots and desired slot
  (let* ((class-slots (class-non-instance-slots class))
	 (slot (find name class-slots :key #'slotd-name)))
    ;; test if slot was found
    (if (not (null slot))
	;; return value
	(slotd-initform slot))))

(defun setf-class-slot-value (class name value)
  "Return the value of the class slot from the specified class.  The class
may be either a class object or the symbol which is the class name."
  ;; test if class specified is a symbol
  (if (symbolp class)
      ;; get class object
      (setq class (class-named class)))
  ;; test if class
  (if (not (classp class))
      ;; signal error
      (error "class-slot-value: invalid object ~s" class))
  ;; get all class slots and desired slot
  (let* ((class-slots (class-non-instance-slots class))
	 (slot (find name class-slots :key #'slotd-name)))
    ;; test if slot was found
    (if (not (null slot))
	;; test if types match
	(if (typep value (slotd-type slot))
	    ;; set value
	    (setf (slotd-initform slot) value)
	  ;; signal error
	  (error "class-slot-value: value not of type ~s" (slotd-type slot)))))
  ;; return value
  value)

(defsetf class-slot-value setf-class-slot-value)

--------
Your message:

    
    We've run into the following problems when using the St.
    Patrick's Day release of PCL: (Symbolics)

    1) Compiling or evaluating the form,

    (defclass foo () ((bar :initform 'bar :allocation :class)))

    creates a class whose "bar" slot is initialized to "'bar", rather than
    "bar" as the CLOS specification dictates.  Further, if the quote is
    left off of the argument to :initform, the compiler complains that "bar
    is unknown and has been declared special" but creates a class that
    behaves as if the argument was not evaluated (which turns out
    to be a problem in the initfunction that is created by
    cannonicalize-slot-description). 
     
    The documentation indicates that an :initform that is allocated at
    the class should be EVALUATED at evaluation/compile time.  This does
    not take place, leading to the behavior mentioned above.

    We have thought of the following fix to parse-class-slot:

    (defmethod PARSE-CLASS-SLOT ((class standard-class) slot)
    	.
    	.
    	.

        (make-slotd class
    		:name name
    		:keyword (make-keyword name)
    		:initform (IF (EQ ALLOCATION :CLASS)
    			      (EVAL INITFORM)
    	                      initform)
    		:initfunction initfunction
    		:initargs initargs
    		:allocation allocation
    		:type type
    		:accessors accessors
    		:readers readers)))

    The change is highlighted in caps.

    Has anyone come across this error and come up with a better fix?

    2) subtypep doesn't work on classes.  For instance:

    	(defclass foo () (x y z))

    	(defclass goo (foo) (blah blaz blub))

    	(subtypep 'foo 'goo) => nil nil

    	
    	Rich Piazza
--------