[barmar@Think.COM: MULTIPLE-VALUE-SETQ and SYMBOL-MACROLET interaction]

[Gregor.pa@Xerox.COM]

This message from Barmar points out an ommission in the spec, and a bug
in the current version of PCL.  This is fixed in the next version of
PCL, and a patch is included at the end of this message.

    Date: Thu, 28 Jul 88 19:15 PDT
    From: Barry Margolin <barmar@Think.COM>
    
    In CLOS, the way to access slots as if they were lexical variables is to
    use WITH-SLOTS, which uses SYMBOL-MACROLET to macroexpand occurrences of
    the slot names into (SLOT-VALUE <object> '<name>) forms.  It also
    converts any SETQ special forms into SETF forms.
    
    But what about MULTIPLE-VALUE-SETQ?  If SETQ is allowed to assign slot
    variables then so should MULTIPLE-VALUE-SETQ.  

To install this patch and save time:

1) edit boot.lisp
2) compile boot.lisp in an already loaded pcl
3) put this changes in their own file, with (in-package 'pcl)
4) compile and load that file in your running pcl

You do not need to recompile or reload your application.

;from boot.lisp
(defmacro with-slots
	  (slots instance &body body &environment env)
  (let ((gensym (gensym)))
    (expand-with-slots (mapcar #'(lambda (ss)
				   (if (symbolp ss) (list ss ss) ss))
			       slots)
		       body
		       env
		       gensym
		       instance
		       #'(lambda (s) `(slot-value ,gensym ',s)))))

(defmacro with-accessors
	  (slot-accessor-pairs instance &body body &environment env)
  (let ((gensym (gensym)))
    (expand-with-slots slot-accessor-pairs
		       body
		       env
		       gensym
		       instance
		       #'(lambda (a) `(,a ,gensym)))))

(defun expand-with-slots (specs body env gensym instance translate-fn)
  `(let ((,gensym ,instance))
     ,@(and (symbolp instance)
	    `((declare (variable-rebinding ,gensym ,instance))))
     ,gensym
     ,@(walk-form body
		  env
		  #'(lambda (f c e)
		      (declare (ignore e))
		      (expand-with-slots-internal specs
						  f
						  c
						  translate-fn)))))

(defun expand-with-slots-internal (specs form context translate-fn &aux entry)
  (cond ((not (eq context :eval)) form)
	((symbolp form)
	 (if (setq entry (assoc form specs))
	     (funcall translate-fn (cadr entry))
	     form))
	((not (listp form)) form)
	((member (car form) '(setq setf))
	 ;; Have to be careful.  We must only convert the form to a SETF
	 ;; form when we convert one of the 'logical' variables to a form
	 ;; Otherwise we will get looping in implementations where setf
	 ;; is a macro which expands into setq.
	 (let ((kind (car form)))
	   (labels ((scan-setf (tail)
		      (if (null tail)
			  nil
			  (walker::relist*
			    tail
			    (if (setq entry (assoc (car tail) specs))
				(progn (setq kind 'setf)
				       (funcall translate-fn (cadr entry)))
				(car tail))
			    (cadr tail)
			    (scan-setf (cddr tail))))))
	     (let (new-tail)
	       (setq new-tail (scan-setf (cdr form)))
	       (walker::recons form kind new-tail)))))
	((eq (car form) 'multiple-value-setq)
	 (let* ((vars (cadr form))
		(gensyms (mapcar #'(lambda (i) (declare (ignore i)) (gensym))
				 vars)))
	   `(multiple-value-call #'(lambda ,gensyms
				     .,(mapcar #'(lambda (v g) `(setf ,v ,g))
					       vars
					       gensyms))
				 ,(caddr form))))
	(t form)))
-------