Re: [Gcl-devel] Two new tests for (SETF (VALUES ...) ...)

[Paul F. Dietz]

Camm Maguire wrote:

> > I think define-set-method (or -expander) is the way to go.
>
>
> OK, I'm just now almost at the end of fixing your last setf-values
> tests.  I'll commit this, and then look into the define-setf, if no
> one else does first.

I've written a setf expander for MY-VALUES (equivalent to VALUES).
It still doesn't quite work, because as you noted GET-SETF-METHOD checks that 
there's
only one store variable. The various setf-like macros will have to be
rewritten to be able to handle multiple store values.

Here's my setf expander.  Rewritten with DEFINE-SETF-EXPANDER and 
GET-SETF-EXPANSION
it works under CMUCL:

#|
(defun my-values (&rest values)
  (apply #'values values))
|#

(define-setf-method my-values (&rest places &environment env)

  "Produce setf expansion for MY-VALUES, which is just like VALUES.
   PLACES is a list of places to which values will be assigned."

  (let (temp-lists value-forms store-vars-lists
        store-forms accessing-forms
        (new-store-vars (mapcar #'(lambda (x) (declare (ignore x)) (gensym))
                                places)))

    (dolist (place places)
      (multiple-value-bind
          (temp-list value-form store-vars-list store-form accessing-form)
          (get-setf-method-multiple-value place env)
        (push temp-list temp-lists)
        (push value-form value-forms)
        (push store-vars-list store-vars-lists)
        (push store-form store-forms)
        (push accessing-form accessing-forms)))

    (values
     (reduce #'append (nreverse temp-lists))
     (reduce #'append (nreverse value-forms))
     new-store-vars
     `(progn
        ,@(mapcar #'(lambda (svs nsv store-form &aux (sv (car svs)))
                       `(let ((,sv ,nsv)) ,store-form))
                  (nreverse store-vars-lists)
                  new-store-vars
                  (nreverse store-forms))
        (values ,@ new-store-vars))
     `(values ,@(nreverse accessing-forms)))))