Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!usc!samsung!think.com!linus!linus!thelonius!john
From: john@thelonius.mitre.org (John D. Burger)
Newsgroups: comp.lang.lisp
Subject: Re: SETF of LET
Message-ID: <1991May23.181234.23060@linus.mitre.org>
Date: 23 May 91 18:12:34 GMT
Sender: news@linus.mitre.org (News Service)
Organization: The MITRE Corporation, Bedford, MA 01730
Lines: 164
Nntp-Posting-Host: thelonius.mitre.org

Here's one implementation, at the end of this message.  As Tim Moore
suggests, you'd ideally do it with symbol macros and augmentating
environments, but I think you can do the same thing by establishing
the appropriate environment around the relevant subforms with a number
of LETs.

One complication is that the temporary variables returned from a SETF
method are bound in a LET*, but a LET's bindings have to be done in
parallel.  This makes the SETF method for LET* simpler, so I've
included that first, as a build-up to the LET method.  Another thing
common to both is that the body of the LET (minus the last subform)
has to be evaluated in the context of the LET bindings, but before the
access and store forms for the last subform are evaluated.  I've done
that here with a bogus variable binding.

I have to agree with Tim in that I wouldn't find this to be very
useful.  Most macro definitions I write require rather idiosyncratic
SETF methods.

Anyway, this definition gives this example:

(setf (let ((x (foo 1 2))
            (y (bar 3 4)))
        (do-stuff x y)
        (car x))
      z)

the following expansion, modulo some renamed variables:

(let* ((temp-x nil)
       (temp-y nil)
       (bogus (progn
                (psetf temp-x (foo 1 2)
                       temp-y (bar 3 4))
                (let ((x temp-x)
                      (y temp-y))
                  x y
                  (do-stuff x y))))
       (temp-cons (let ((x temp-x)
                        (y temp-y))
                    x y
                    x))
       (new-car z))
  (let ((x temp-x)
        (y temp-y))
    x y
    (locally
      (declare (ignore bogus))
      (rplaca temp-cons new-car)
      new-car)))

------------------------- Lisp Code Follows -------------------------

(define-setf-method let* (clauses &rest body)
  (let ((setf-subform (first (last body)))
        (other-subforms (butlast body))
        (let-vars '())
        (let-forms '())
        (temp-let-vars '())
        (bogus-var (make-symbol "BOGUS")))
    ;; Process LET* clauses
    (dolist (clause clauses)
      (let ((let-var nil)
            (let-form nil)
            (temp-let-var (gensym)))
        (cond ((listp clause)
               (setf let-var (first clause)
                     let-form (second clause)))
              (t (setf let-var clause)))
        (push let-var let-vars)
        (push let-form let-forms)
        (push temp-let-var temp-let-vars)))
    (setf let-vars (nreverse let-vars)
          let-forms (nreverse let-forms)
          temp-let-vars (nreverse temp-let-vars))
    (flet ((wrap-it (body-forms)
             "Establish the right variable bindings around some subforms"
             `(let ,(mapcar #'(lambda (let-var temp-let-var)
                                `(,let-var ,temp-let-var))
                            let-vars temp-let-vars)
                ,@let-vars      ; Make sure each var gets used
                . ,body-forms)))
      ;; Get SETF method for subform to be SETFed
      (multiple-value-bind (subform-temp-vars subform-temp-forms
                            subform-store-vars subform-store-form
                            subform-access-form)
          (get-setf-method setf-subform)
        ;; Do it
        (values `(,@temp-let-vars
                  ,bogus-var
                  . ,subform-temp-vars)
                `(,@let-forms
                  ,(wrap-it other-subforms)
                  . ,(mapcar #'(lambda (form)
                                 (wrap-it (list form)))
                             subform-temp-forms))
                subform-store-vars
                (wrap-it `((locally
                             (declare (ignore ,bogus-var))
                             ,subform-store-form)))
                (wrap-it `((locally
                             (declare (ignore ,bogus-var))
                             ,subform-access-form))))))))

(define-setf-method let (clauses &rest body)
  (let ((setf-subform (first (last body)))
        (other-subforms (butlast body))
        (let-vars '())
        (temp-let-vars '())
        (psetf-args '())
        (list-o-nils (make-list (length clauses) :initial-element nil))
        (bogus-var (make-symbol "BOGUS")))
    ;; Process LET clauses
    (dolist (clause clauses)
      (let ((let-var nil)
            (let-form nil)
            (temp-let-var (gensym "TEMP")))
        (cond ((listp clause)
               (setf let-var (first clause)
                     let-form (second clause)))
              (t (setf let-var clause)))
        (push let-var let-vars)
        (push temp-let-var temp-let-vars)
        ;; We're going to PSETF each temporary LET var
        ;; to the appropriate LET form
        (push temp-let-var psetf-args)
        (push let-form psetf-args)))
    (setf let-vars (nreverse let-vars)
          temp-let-vars (nreverse temp-let-vars)
          psetf-args (nreverse psetf-args))
    (flet ((wrap-it (body-forms)
            "Establish the right variable bindings around some subforms"
	    `(let ,(mapcar #'(lambda (let-var temp-let-var)
			       `(,let-var ,temp-let-var))
			   let-vars temp-let-vars)
	       ,@let-vars		; Make sure each var gets used
	       . ,body-forms)))
      ;; Get SETF method for subform to be SETFed
      (multiple-value-bind (subform-temp-vars subform-temp-forms
                            subform-store-vars subform-store-form
			    subform-access-form)
          (get-setf-method setf-subform)
        ;; Do it
        (values `(,@temp-let-vars
                  ,bogus-var
                  . ,subform-temp-vars)
                `(,@list-o-nils
                  (progn (psetf . ,psetf-args)
                         ,(wrap-it other-subforms))
                  . ,(mapcar #'(lambda (form)
                                 (wrap-it (list form)))
                             subform-temp-forms))
                subform-store-vars
                (wrap-it `((locally
                             (declare (ignore ,bogus-var))
                             ,subform-store-form)))
                (wrap-it `((locally
                             (declare (ignore ,bogus-var))
                             ,subform-access-form))))))))
--
John Burger                                               john@mitre.org

"You ever think about .signature files? I mean, do we really need them?"
  - alt.andy.rooney