Re: Useful code - perhaps worth modifying base distribution?

From: Moises Lejter <>
Date: Wed, 26 Jul 1995 04:33:41 -0400

So - it turns out the code I just sent will not work, with either
STk-2.1.6 (the one I am still using) or STk-2.2. It will complain
that all locally defined symbols are undefined while creating the

It seems to me it *ought* to work, so I went looking to see what the
problem was. It turns out that the slots specified in a
#'define-class are passed on in the expansion of #'define-class as a
simple quoted list. The environment in which the (define-class ...)
form appeared is thrown away.

What follows is a patch to stklos.stk (which I think works for both
STk-2.1.6 and STk-2.2) that fixes this problem.. With this patch,
#'define-class passes the environment a define-class form appears in
as the :environment option. That information is passed on into the
code that creates the class, and in particular it is used when
evaluating the :slot-ref and :slot-set! options of :virtual slots.
With this patch, the code in my previous message works properly... ;-)

---patch begins here---
< :name ',name
< :environment (the-environment))))
> 	   :name ',name)))
< (define (compute-getters-n-setters class slots environment)
> (define (compute-getters-n-setters class slots)
< 	     (cons (car s) (compute-get-n-set class s environment))
< 	     (cons s	   (compute-get-n-set class (list s) environment))))
> 	     (cons (car s) (compute-get-n-set class s))
> 	     (cons s	   (compute-get-n-set class (list s)))))
< (define-method compute-get-n-set ((class <class>) s env)
> (define-method compute-get-n-set ((class <class>) s)
< 	       (list (eval get env)
< 		     (eval set env))))
> 	       (list (eval get) 
> 		     (eval set))))
<     (let ((slots (%compute-slots class))
< 	  (environment (get-keyword :environment initargs
< 				    (global-environment))))
>     (let ((slots (%compute-slots class)))
<       (slot-set! class 'getters-n-setters
< 		 (compute-getters-n-setters class slots environment)))
>       (slot-set! class 'getters-n-setters (compute-getters-n-setters class slots)))
< (define-method compute-get-n-set ((class <Composite-metaclass>) slot env)
> (define-method compute-get-n-set ((class <Composite-metaclass>) slot)
---patch ends here---
No promises, but it seems to work for me just fine.
Internet/CSnet:	BITNET:  mlm_at_browncs.BITNET
UUCP:    ...!uunet!!mlm		Phone:	 (401)863-7671
USmail:  Moises Lejter, Box 1910 Brown University, Providence RI 02912
Received on Wed Jul 26 1995 - 10:37:11 CEST

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