Path: utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!iuvax!purdue!tut.cis.ohio-state.edu!cs.utexas.edu!milano!perseus!rcp
From: rcp@perseus.sw.mcc.com (Rob Pettengill)
Newsgroups: comp.lang.lisp
Subject: Re: Use of backquote & macro question - a real use for &aux!
Message-ID: <2292@perseus.sw.mcc.com>
Date: 1 May 89 18:37:35 GMT
References: <2277@perseus.sw.mcc.com>
Reply-To: rcp@perseus.sw.mcc.com (Rob Pettengill)
Organization: MCC Software Technology Program
Lines: 99

In article <2277@perseus.sw.mcc.com> rcp@perseus.sw.mcc.com (Rob Pettengill) writes:
;In the course of writing the following macro I ran into the limitation
;that backquote appears to be valid only when used on an evaluated form
;(eg not in the binding clause of a let).  This appears to be
;reasonable although I can't find an explicit discussion of where it is
;allowed in CLtL.  In any case I was able to write a nice general
;purpose macro for temporarily overriding state in a defstruct or CLOS
;instance.  However, I was only able to do this by using an explicit
;eval at macro expansion time.  Normally the explicit use of eval is
;red flag so I am curious to see if anyone can propose a better
;solution to this problem:
;
;(defmacro with-context
;  ((state-holder state-binding-list) &body body)
;  ...
;  (eval
;  `(let			; first set up bindings to be useful later
;       ,(do ((state-var (car state-binding-list) (car rest)) ;even members
;	     (state-binding (cadr state-binding-list) (cadr rest)) ;odd
;	     (rest (cddr state-binding-list) (cddr rest))
;	     (state-vars ())	;setfable state accessors
;	     (state-vals ())	;new temporary bindings
;	     (state-temps ())	;temporary storage for previous bindings
; ...

I want to thank everyone who sent in suggestions.  The solution I like best
to my problem appeared in the response from donc@vaxa.isi.edu (Don Cohen).
Useing &aux variables to handle the setup required to write the macro
eliminates the need for the evaled let that bothered me in the original. 
This is the first real use for &aux that I have seen!
Here is my latest version:

(defmacro with-context
  ((state-holder state-binding-list) &body body
   &aux
   (state-vars (do ((rest state-binding-list (cddr rest)) (result '()))
		   ((null rest) result)
		 (push (car rest) result))) ; odd elements
   (state-vals (do ((rest (cdr state-binding-list) (cddr rest)) (result '()))
		   ((null rest) result)
		 (push (car rest) result))) ; even elements
   (state-temps (do ((rest state-vars (cdr rest)) (result '()))
		    ((null rest) result)
		  (push (gensym) result))) ; temp storage on stack
   )
  "This macro overrides the state in the STATE-HOLDER with the values in 
   the STATE-BINDING-LIST for the scope of the BODY.  The STATE-HOLDER
   typically a defstruct or CLOS instance although it may be any lisp
   object with  SETFable accessors.  An unwind-protect ensures that the
   original STATE-HOLDER state is restored when the body is exited.  The
   STATE-BINDING-LIST is a list of alternate state accessors and new bindings.
   The STATE-HOLDER and the bindings are evaluated.  The symbols which name
   the stare accessors are not.  All of the accessors must be symbols which
   name valid SETF-able accessors for the given STATE-HOLDER.
   Example:
   <cl> (defstruct bar a b)
   BAR 
   <cl> (setq bar1 (make-bar :a 1 :b 2))
   #s(BAR :A 1 :B 2) 
   <cl> (with-context (bar1 (bar-a 'a bar-b (+ 1 2)))
          (format t \"~%~S\" bar1) bar1)
   #s(BAR :A A :B 3)
   #s(BAR :A 1 :B 2) 
  "
  ;; > (macroexpand-1 '(with-context (bar1 (bar-a 'a bar-b (+ 1 2)))
  ;;                     (format t "~%~S" bar1) bar1))
  ;; (LET ((#:G49 (BAR-B BAR1)) (#:G48 (BAR-A BAR1)))
  ;;      (SETF (BAR-B BAR1) (+ 1 2))
  ;;      (SETF (BAR-A BAR1) (QUOTE A))
  ;;      (UNWIND-PROTECT
  ;; 	   (PROGN (FORMAT T "~%~S" BAR1) BAR1)
  ;;	   (SETF (BAR-B BAR1) #:G49)
  ;;	   (SETF (BAR-A BAR1) #:G48)))
  `(let				;save the old state in temp vars
       ,(mapcar
	 #'(lambda (tmp-var var)
	     (list tmp-var (list var `,state-holder)))
	 state-temps state-vars)
     ;; set the new state in the state-holder
     ,@(mapcar
	#'(lambda (var val) (list 'setf (list var `,state-holder) val))
	state-vars state-vals)
     ;; run the body with unwind-protect
     (unwind-protect
	 (progn ,@body)
       ;; restore the original state-holder state
       ,@(mapcar
	  #'(lambda (var val) (list 'setf (list var `,state-holder) val))
	  state-vars state-temps)
       )
     )
  )

;rob

  Robert C. Pettengill, MCC Software Technology Program
  P. O. Box 200195, Austin, Texas  78720
  ARPA:  rcp@mcc.com            PHONE:  (512) 338-3533
  UUCP:  {ihnp4,seismo,harvard,gatech,pyramid}!ut-sally!im4u!milano!rcp