rcp@perseus.sw.mcc.com (Rob Pettengill) (04/27/89)
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)
"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))
;; returns:
;; (LET ((#:G88 (BAR-B BAR1))
;; (#:G87 (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) #:G88)
;; (SETF (BAR-A BAR1) #:G87)))
;;
(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
)
((null state-var) `((state-vars ',state-vars) ;format for let
(state-vals ',state-vals)
(state-temps ',state-temps)))
(push state-var state-vars) ; gather the lists
(push state-binding state-vals)
(push (gensym) state-temps)
)
;;
`(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
,(cons 'progn ',body)
;; restore the original state-holder state
,@(mapcar
#'(lambda (var val) (list 'setf (list var ',state-holder) val))
state-vars state-temps)
)
)
)))
;robharrisr@cs.rpi.edu (Richard Harris) (04/28/89)
In article <2277@perseus.sw.mcc.com> rcp@perseus.sw.mcc.com (Rob Pettengill) writes: ... >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) > "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) > " Here is a definition of with-context that does not use EVAL. Instead, this definition uses a macro called LETF (defined below). (defmacro with-context ((state-holder-form state-binding-list) &body body) (let ((state-holder (gensym)) (state-binding-functions nil) (state-binding-forms nil)) (do ((functions nil (cons (car sbl-tail) functions)) (forms nil (cons (car sbl-tail) functions)) (sbl-tail state-binding-list (cddr sbl-tail))) ((null sbl-tail) (setq state-binding-functions (nreverse functions)) (setq state-binding-forms (nreverse forms)))) `(let ((,state-holder ,state-holder-form)) (letf ,(mapcar #'(lambda (function form) `((,function ,state-holder) ,form)) state-binding-functions state-binding-forms) ,@body)))) (export '(LETF LETF*)) ;The function LETF (defined below) is really a cross between the (Symbolics) functions ;LETF and LET-GLOBALLY, and should really be called LETF-GLOBALLY. ;"letf plaves-and-values body... Special form ; Just like let, except that it can bind any storage cells rather than just variables." ;"let-globally ((var value)...) body... Special form ; Similar in form to let. The difference is that let-globally does not bind the ; variables; instead, it saves the old values and sets the variables, and sets up ; an unwind-protect to set them back." ; The difference between let and let-globally is important (only) ; in a multiple-process Lisp system. (defmacro letf (bindings &body forms) (let ((tvars nil) (tvals nil) (store-vars nil) (store-forms nil) (access-forms nil) (value-forms nil) (save-vars nil)) (dolist (binding bindings) (let ((setf-form (if (atom binding) binding (car binding))) (value-form (if (atom binding) nil (cadr binding)))) (multiple-value-bind (vars vals stores store-form access-form) (get-setf-method setf-form) (setq tvars (nconc tvars vars)) (setq tvals (nconc tvals vals)) (setq store-vars (nconc store-vars stores)) (setq store-forms (nconc store-forms (list store-form))) (setq access-forms (nconc access-forms (list access-form))) (setq value-forms (nconc value-forms (list value-form))) (setq save-vars (nconc save-vars (list (gensym))))))) `(let ,(mapcar #'list tvars tvals) (let ,(mapcar #'list save-vars access-forms) (unwind-protect (progn (let ,(mapcar #'list store-vars value-forms) ,@store-forms) ,@forms) (let ,(mapcar #'list store-vars save-vars) ,@store-forms)))))) (defmacro letf* (bindings &body forms) (if (null (cdr bindings)) `(letf ,bindings ,@forms) `(letf (,(car bindings)) (letf* ,(cdr bindings) ,@forms))))
barmar@think.COM (Barry Margolin) (04/28/89)
You are correct that backquote only works in an evaluation context.
On p.349 of CltL, it says "Note that the [resulting] form is
equivalent only in the sense that when it is evaluated it will
calculate the correct result." Backquote expands into a form that
constructs the specified data structure, but it has to be invoked
somehow. If it's used in a non-evaluation context, it will simply be
left there.
For instance, a possible expansion of `(a ,b c) is (list (quote a) b
(quote c)). If this were used in a let-binding, e.g.
(let `(a ,b c)
...)
the result will be
(let (list
(quote a)
b)
...)
which will bind the variables LIST and B to NIL, and bind the variable
QUOTE to the value of A.
Note, however, that you can frequently solve this problem by
restructuring the expression. What was probably mean above was
something like
`(let (a ,b c) ...)
which uses the value (at macro-expansion time) of B as the
let-binding.
Barry Margolin
Thinking Machines Corp.
barmar@think.com
{uunet,harvard}!think!barmar