rcp@perseus.sw.mcc.com (Rob Pettengill) (05/02/89)
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!rcpjeff@aiai.ed.ac.uk (Jeff Dalton) (05/03/89)
In article <2292@perseus.sw.mcc.com> rcp@perseus.sw.mcc.com (Rob Pettengill) writes: >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: Just to make sure there isn't some subtle confusion here, I think I should point out that &AUX isn't the only straightforward way to eliminate the evaluated LET. In particular, the &AUX can be replaced in a simple, mechanical way by a LET*. A macro that looks like this (defmacro with-context ((state-holder state-binding-list) &body body &aux (state-vars ...) (state-vals ...) (state-temps ...)) "This macro ..." `(let ... more backquoted stuff ... )) can be rewritten to look like this: (defmacro with-context ((state-holder state-binding-list) &body body) "This macro ..." (let* ((state-vars ...) (state-vals ...) (state-temps ...)) `(let ... more backquoted stuff ... ))) You need to use LET* rather than LET because the calculation of STATE-TEMPS refers to STATE-VARS. You could also use nested LETs. This sort of thing can be done for any use of &AUX, so whether you use &AUX or not is largely a matter of taste. -- Jeff