Re: problem with class variables in stklos

From: Erik Ostrom <>
Date: Thu, 05 Sep 1996 19:07:35 -0400

> I use class allocated slots all the time. The way to set them in
> define-class is with the :initform slot option. Here's an example:
> (define-class <Whatever> ()
> [(shared-counter :allocation :class :initform 0)])

Okay... so if I want to make a subclass of <Whatever> that has its
own value (its own _initial_ value) for shared-counter, do I need to
redefine the slot?

  (define-class <Whatever-with-counter-starting-at-50> (<Whatever>)
    [(shared-counter :allocation :class :initform 50)])

I guess this works, but (in addition to some insignificant problems)
it's just kind of clumsy if the slot definition is much bigger than
this. Also, it just feels wrong to have to keep redefining it--it's
the same slot, right? I already defined it, right?

> Although I've used a simple initial value here (0), I could put arbitrary
> complex expression after the :initform keyword.

This suggests another possibility, something like this:

  (define-class <Whatever> ()
    [(shared-counter :allocation :class :initform *shared-counter-starter*)])

... the idea being that you could store the desired value for each class you
create in *shared-counter-starter*. The problem is, the :initform is
evaluated _when you create the first instance_, which makes it too awkward
to try to anticipate and set *shared-counter-starter* accordingly.

Just as a somewhat more motivating example:  In the library's implementation
of Tk widgets as STklos objects, there's a method `tk-constructor', which
must be defined for each simple widget class, and just returns a function
that can be called to create the appropriate kind of Tk command.
Now, this works; but to me, it feels a little heavy-handed to create a new
method for what is essentially just a data slot (with unchanging data)
of the Tk widget class.  If I were designing from scratch, I would be trying
to use a class slot.  And this is the kind of situation I _do_ design
from scratch, a lot.
So this is all I'm saying:  I'd like _this_ kind of thing to be easy to
do.  Both "define a method for each class" and "define the slot on each
class" seem like more than it should require just to set a value.  It's
not a great hardship--I'll probably drop the subject soon.  But it does
seem to me like a small flaw, and probably easily correctable.
P.S. Here's another solution, mostly untested:
;;; given the following function and redefinition of define-class,
;;; class slots can be set as keyword arguments on the end of a
;;; class definition.  the implementation is gross, but the end
;;; result is reasonably straightforward.  an example follows
;;; the code.
(define-method set-class-slots ((class <class>) initargs)
  (let ((getters-n-setters (slot-ref class 'getters-n-setters)))
    (map (lambda (slot)
	   (if (eq? (get-slot-allocation slot) :class)
	       (let* ((init-keyword (get-keyword :init-keyword (cdr slot) #f))
		      (initform #f)
		      (has-initform (not (catch
					  (set! initform 
						(get-keyword :initform
							     (cdr slot))))))
		      (setter (lambda (quoted-value)
				((caddr (assq (car slot) getters-n-setters))
				 "it doesn't matter what this argument is"
				 (eval quoted-value)))))
		 (cond ((and init-keyword has-initform)
			(setter (get-keyword init-keyword initargs
			(setter initform))
			 (setter (get-keyword init-keyword
	 (slot-ref class 'slots))))
(define-macro (define-class name supers slots . options)
  `(define ,name
     (let ((class (make (or ,(get-keyword :metaclass options #f)
			    ,(ensure-metaclass (map eval supers)))
			:dsupers ,(if (null? supers)
				      `(list <object>)
				      `(list ,_at_supers))
			:slots ',slots
			:name ',name)))
       (set-class-slots class ',options)
;;; STk> (define-class <Whatever2> ()
;;;        [(shared-counter :allocation :class
;;;                         :initform 0
;;;                         :init-keyword :shared-counter)])
;;; #[undefined]
;;; STk> (define-class <whatever3> (<whatever2>) ())
;;; #[undefined]
;;; STk> (define-class <whatever4> (<whatever2>) () :shared-counter 5)
;;; #[undefined]
;;; STk> (slot-ref (make <whatever2>) 'shared-counter)
;;; 0
;;; STk> (slot-ref (make <whatever3>) 'shared-counter)
;;; 0
;;; STk> (slot-ref (make <whatever4>) 'shared-counter)
;;; 5
Received on Fri Sep 06 1996 - 01:11:00 CEST

This archive was generated by hypermail 2.3.0 : Mon Jul 21 2014 - 19:38:59 CEST