From: Dennis Dunn
Subject: Fun with class allocated slots
Date: 
Message-ID: <ynxh9.168874$2L.7465797@e3500-atl2.usenetserver.com>
Hello,

I am having trouble understanding what is happening with a class that has a
class allocated slot.  I think that this might be one of those
"implementation-dependent" things since I get different behaviour from CMUCL
and LispWorks. Then again, it might be one of those "ambiguous
specification" things since I get different behavior from CMUCL with the
.lisp file and CMUCL with the .x86f file.  I am using LispWorks Personal
Edition 4.2 (thx Xanalys!) on Win2k and CMUCL 18c+ on Linux (Debian woody).

Here is some code to illustrate the problem, it is one simple class with a
class allocated slot and then two functions to manipulate the slot.  The
file name is "a-class.lisp".

(defclass a-class ()
        ((a-slot :accessor a-slot
                 :initform 1
                 :allocation :class)))

(defun get-slot ()
  (a-slot (make-instance 'a-class)))

(defun set-slot (val)
  (setf (a-slot (make-instance 'a-class)) val))

When I load the .lisp file into CMUCL I can set the value of the slot with
the set-slot function and read the value with the get-slot function.  The
important thing to note is that the value of the slot returned by get-slot
is the same as the value of the slot set by set-slot.

Now, when I compile the source file and then load the .x86f file into CMUCL,
I get a different behavior!  I can set the value of the slot with set-slot
but when I read the value of the slot with get-slot it returns a 1!  It is
as if the call to make-instance in the get-slot function re-evaluated the
:initform of the slot.  I also noticed that if I use set-slot and then
access the slot with the accessor, I get the correct value of the slot.

I am wading through chapter 7 of the HyperSpec and I've done a search of
Google groups but I am still confused as to what is going on.  Why is the
compiled version of get-slot resetting the value of the slot to the value of
the :initform?  Is this behavior specific to this version of CMUCL?  Is
there an implementation-independent idiom for writing the get-slot and
set-slot functions? Or am I writing Java in Lisp?  Should they be
implemented as macros instead of functions?

Thank you for your time.

Dennis Dunn


PS Here is a transcript that shows the behavior:

········@erwin:~/ann$ lisp
CMU Common Lisp release x86-linux 3.0.8 18c+ 31 December 2001 build 3030,
running on erwin
<snip>
* (load "a-class")
; Loading #p"/home/ansofive/ann/a-class.lisp".
T
* (get-slot)
1
* (set-slot 99)
99
* (get-slot)
99
* (compile-file "a-class")
<snip>
a-class.x86f written.
<snip>
* (load "a-class")
; Loading #p"/home/ansofive/ann/a-class.x86f".
T
* (get-slot)
1
* (set-slot 99)
99
* (get-slot)
1
* (a-slot (make-instance 'a-class))
1
* (set-slot 99)
99
* (a-slot (make-instance 'a-class))
99
*
From: Tim Bradshaw
Subject: Re: Fun with class allocated slots
Date: 
Message-ID: <ey3u1kpw1mv.fsf@cley.com>
* Dennis Dunn wrote:
> I am wading through chapter 7 of the HyperSpec and I've done a search of
> Google groups but I am still confused as to what is going on.  Why is the
> compiled version of get-slot resetting the value of the slot to the value of
> the :initform?  Is this behavior specific to this version of CMUCL?  Is
> there an implementation-independent idiom for writing the get-slot and
> set-slot functions? Or am I writing Java in Lisp?  Should they be
> implemented as macros instead of functions?

It may be that redefining the class causes the initform to be
reevaluated, although I'm not sure if it should (I think it should not
but I can't quote chapter and verse).  Other than that I can't see
that what you are doing is wrong.

--tim
From: Gerd Moellmann
Subject: Re: Fun with class allocated slots
Date: 
Message-ID: <86bs6wrjez.fsf@gerd.free-bsd.org>
Tim Bradshaw <···@cley.com> writes:

> It may be that redefining the class causes the initform to be
> reevaluated, although I'm not sure if it should (I think it should not
> but I can't quote chapter and verse).

It's a bug---each make-instance resets the slot to its initial value.
I'll send a patch to cmucl-imp.
From: Dennis Dunn
Subject: Re: Fun with class allocated slots
Date: 
Message-ID: <aJGh9.62322$AY5.26661875@e3500-atl1.usenetserver.com>
Hello Gerd,

> It's a bug---each make-instance resets the slot to its initial value.
> I'll send a patch to cmucl-imp.

Is there a way to patch my current CMUCL image?  Could I compile some form
and then dump an image or do I need to learn the voodoo of compiling CMUCL?

Thank you for your time.  I'll keep an eye on cmucl-imp, also.

Dennis Dunn
From: Gerd Moellmann
Subject: Re: Fun with class allocated slots
Date: 
Message-ID: <86sn08zkil.fsf@gerd.free-bsd.org>
"Dennis Dunn" <········@bellsouth.net> writes:

> Is there a way to patch my current CMUCL image?  Could I compile some form
> and then dump an image or do I need to learn the voodoo of compiling
> CMUCL?

I think the patch below should work with 18d.  Please save the patch
to a file, compile and load it, then dump a new core, like so, where
`*' is the CMUCL prompt:

  * (compile-file "the-patch-file" :load t)
  * (save-lisp "new-lisp.core")


(in-package "PCL")

(defun make-shared-initialize-form-list (class keys si-slot-names simple-p)
  (let* ((initialize-form-list (cons nil nil))
	 (type (cond ((structure-class-p class)
		      'structure)
		     ((standard-class-p class)
		      'standard)
		     ((funcallable-standard-class-p class)
		      'funcallable)
		     (t (error "error in make-shared-initialize-form-list"))))
	 (wrapper (class-wrapper class))
	 (constants (when simple-p
		      (make-list (wrapper-no-of-instance-slots wrapper)
				 :initial-element *slot-unbound*)))
	 (slots (loop for slotd in (class-slots class)
		      when (eq :instance (slot-definition-allocation slotd))
		      collect slotd))
	 (slot-names (mapcar #'slot-definition-name slots))
	 (slots-key (mapcar (lambda (slot)
			      (let ((index most-positive-fixnum))
				(dolist (key (slot-definition-initargs slot))
				  (let ((pos (position key keys)))
				    (when pos (setq index (min index pos)))))
				(cons slot index)))
			    slots))
	 (slots (stable-sort slots-key #'< :key #'cdr)))
    (let ((n-popped 0))
      (dolist (slot+index slots)
	(let* ((slot (car slot+index))
	       (name (slot-definition-name slot))
	       (npop (1+ (- (cdr slot+index) n-popped))))
	  (unless (eql (cdr slot+index) most-positive-fixnum)
	    (let* ((pv-offset (1+ (position name slot-names))))
	      (add-forms `(,@(when (plusp npop)
			       `((pop-initargs ,(* 2 npop))))
			   (instance-set ,pv-offset ,slot))
			 initialize-form-list))
	    (incf n-popped npop)))))
    (dolist (slot+index slots)
      (let* ((slot (car slot+index))
	     (name (slot-definition-name slot)))
	(when (and (eql (cdr slot+index) most-positive-fixnum)
		   (or (eq si-slot-names t)
		       (member name si-slot-names)))
	  (let* ((initform (slot-definition-initform slot))
		 (initfunction (slot-definition-initfunction slot))
		 (location (unless (eq type 'structure)
			     (slot-definition-location slot)))
		 (pv-offset (1+ (position name slot-names)))
		 (forms (cond ((null initfunction)
			       nil)
			      ((constantp initform)
			       (let ((value (funcall initfunction)))
				 (if (and simple-p (integerp location))
				     (progn (setf (nth location constants) value)
					    nil)
				     `((const ,value)
				       (instance-set ,pv-offset ,slot)))))
			      (t
			       `((funcall ,(slot-definition-initfunction slot))
				 (instance-set ,pv-offset ,slot))))))
	    (add-forms `(,@(unless (or simple-p (null forms))
			     `((skip-when-instance-boundp ,pv-offset ,slot
				,(length forms))))
			 ,@forms)
		       initialize-form-list)))))
    (values (car initialize-form-list) constants)))

(defmethod shared-initialize ((instance slot-object) slot-names &rest initargs)
  (cond ((eq slot-names t)
	 (call-initialize-function
	  (initialize-info-shared-initialize-t-function
	   (initialize-info (class-of instance) initargs))
	  instance initargs))
	((null slot-names)
	 (call-initialize-function
	  (initialize-info-shared-initialize-nil-function
	   (initialize-info (class-of instance) initargs))
	  instance initargs))
	(t
	 (flet ((initialize-slot-from-initarg (class instance slotd)
		  (let ((slot-initargs (slot-definition-initargs slotd)))
		    (doplist (initarg value) initargs
		      (when (memq initarg slot-initargs)
			(setf (slot-value-using-class class instance slotd)
			      value)
			(return t)))))
		(initialize-slot-from-initfunction (class instance slotd)
		  (unless (or (slot-boundp-using-class class instance slotd)
			      (null (slot-definition-initfunction slotd)))
		    (setf (slot-value-using-class class instance slotd)
			  (funcall (slot-definition-initfunction slotd)))))
		(class-slot-p (slotd)
		  ;; Note: contrary to AMOP, SLOT-DEFINITION-ALLOCATION
		  ;; returns a class and not :CLASS for class slots.
		  (classp (slot-definition-allocation slotd))))
	   (loop with class = (class-of instance)
		 for slotd in (class-slots class)
		 unless (or (class-slot-p slotd)
			    (initialize-slot-from-initarg class instance slotd))
		   when (memq (slot-definition-name slotd) slot-names) do
		     (initialize-slot-from-initfunction class instance slotd))
	 instance))))
From: Kenny Tilton
Subject: Re: Fun with class allocated slots
Date: 
Message-ID: <3D874ED0.7090603@nyc.rr.com>
Tim Bradshaw wrote:
> It may be that redefining the class causes the initform to be
> reevaluated, although I'm not sure if it should (I think it should not
> but I can't quote chapter and verse).  

You think right. Chapter and verse:


4.3.6 Redefining Classes

.....

The value of a slot that is specified as shared both in the old class 
and in the new class is retained. If such a shared slot was unbound in 
the old class, it is unbound in the new class. Slots that were local in 
the old class and that are shared in the new class are initialized. 
Newly added shared slots are initialized.

.....
From: Dennis Dunn
Subject: Re: Fun with class allocated slots
Date: 
Message-ID: <pRFh9.59891$AY5.26371078@e3500-atl1.usenetserver.com>
Hello again!

Thank you for all of your help.  Everything I had read seemed to imply that
the initform of a shared slot should be evaluated only once.

I changed the get-slot and set-slot functions to macros in a-class.lisp:

(defclass a-class ()
        ((a-slot :accessor a-slot
                 :initform 1
                 :allocation :class)))

(defmacro get-slot ()
        `(a-slot (make-instance 'a-class)))

(defmacro set-slot (a-value)
  `(setf (a-slot (make-instance 'a-class)) ,a-value))

(defun try ()
        (format t "slot=~A~%" (get-slot))
        (format t "set slot=99 ~A~%" (set-slot 99))
        (format t "slot=~A~%" (get-slot)))

When I comile and load the file, get-slot and set-slot work as expected from
the top-level but the (try) function displays the incorrect behavior.  Here
is another transcript:

; Loading #p"/home/ansofive/.cmucl-init".
CMU Common Lisp release x86-linux 3.0.8 18c+ 31 December 2001 build 3030,
running on erwin
<snip>
* (load "a-class")
; Loading #p"/home/ansofive/ann/a-class.x86f".
T
* (get-slot)
1
* (set-slot 99)
99
* (get-slot)
99
* (try)
slot=1
set slot=99 99
slot=1
NIL
*

I guess I'll have to make my shared slots into special variables.

Thanks again for your help.

Dennis Dunn
From: ilias
Subject: Re: Fun with class allocated slots
Date: 
Message-ID: <am6it8$rs0$1@usenet.otenet.gr>
Dennis Dunn wrote:
> Hello,
> 
> I am having trouble understanding what is happening with a class that has a
> class allocated slot.  I think that this might be one of those
> "implementation-dependent" things since I get different behaviour from CMUCL
> and LispWorks. Then again, it might be one of those "ambiguous
> specification" things since I get different behavior from CMUCL with the

sorry, i'm a lisp-novice and i cannot help you.

"implementeation-dependent" things => this i know.

"ambiguous specification" things => sounds like its something what 
happens frequently.

can you please clarify?
From: Frode Vatvedt Fjeld
Subject: Re: Fun with class allocated slots
Date: 
Message-ID: <2hwupldkg2.fsf@vserver.cs.uit.no>
"Dennis Dunn" <········@bellsouth.net> writes:

> I am having trouble understanding what is happening with a class
> that has a class allocated slot.  I think that this might be one of
> those "implementation-dependent" things since I get different
> behaviour from CMUCL and LispWorks. [..]

Seems to me to be a bug in CMUCL. This is I believe the relevant
sentences from CLHS "7.1 Object Creation and Initialization":

  [..] The :initform form for a local slot may be used when creating
  an instance, when updating an instance to conform to a redefined
  class, or when updating an instance to conform to the definition of
  a different class. The :initform form for a shared slot may be used
  when defining or re-defining the class.

The class-allocated slot is a shared slot, and thus its initform
should only be used when defclass is evaluated, or the class is
re-defined, and may not (as I read it) be used at make-instance time.


On a side-note, I usually prefer to use simple constant
value-returning methods over class-allocated slots, because that way
it's usually clearer what is going on. Something like this:

  (defmethod a-slot ((x a-class)) 1)

or, if needed:

  (defvar *a-class-a-slot* 1)
  (defmethod a-slot ((x a-class)) *a-class-a-slot*)
  (defmethod (setf a-slot) (value (x a-class))
    (setf *a-class-a-slot* value))

I find it's just easier to play around with, and the semantics are
quite clear.

-- 
Frode Vatvedt Fjeld
comp.lang.lisp / 2002 / sep