Path: utzoo!utgpu!news-server.csri.toronto.edu!bonnie.concordia.ca!uunet!zaphod.mps.ohio-state.edu!caen!hellgate.utah.edu!defmacro.utah.edu!moore
From: moore%defmacro.utah.edu@cs.utah.edu (Tim Moore)
Newsgroups: comp.lang.lisp
Subject: Re: (setf (values ...
Message-ID: <1991Jun13.170657.23523@hellgate.utah.edu>
Date: 13 Jun 91 23:06:57 GMT
References: <1991Jun13.204847.5625@jpl-devvax.jpl.nasa.gov>
Organization: University of Utah CS Dept
Lines: 33

In article <1991Jun13.204847.5625@jpl-devvax.jpl.nasa.gov> charest@AI-Cyclops.JPL.NASA.GOV writes:
>Anyone out there have CL code for a setf method for values as mentioned on page 129 of CLtL2? The code should handle the case wherein any of the sub-forms of values can themselves have setf methods. Thanks in advance.

Assuming setf does the right thing with multiple store values, this
should work:

(define-setf-method values (&rest args &environment env)
  (let ((vars nil)
	(vals nil)
	(store-vars nil)
	(store-forms nil)
	(access-forms nil)
	(nil-store-vars nil))
    (dolist (arg args)
      (multiple-value-bind (these-vars these-vals these-store-vars
			    store-form access-form)
	  (get-setf-method-multiple-value arg env)
	(setq vars (nconc vars these-vars))
	(setq vals (nconc vals these-vals))
	(push (car these-store-vars) store-vars)
	(setq nil-store-vars (nconc nil-store-vars (cdr these-store-vars)))
	(push store-form store-forms)
	(push access-form access-forms)))
    (values (nconc vars nil-store-vars)
	    (nconc vals (make-list (length nil-store-vars)))
	    (nreverse store-vars)
	    `(values ,.(nreverse store-forms))
	    `(values ,.(nreverse access-forms)))))

-- 
Tim Moore                    moore@cs.utah.edu {bellcore,hplabs}!utah-cs!moore
"Ah, youth. Ah, statute of limitations."
		-John Waters