From: Luigi Panzeri
Subject: setf logger
Date: 
Message-ID: <87k641qtu6.fsf@matley.muppetslab.org>
Some months ago i see on this newsgroup a setf wrapper useful to log
application state change in non-functional code (and i remember its
implementation was not so obvious). Unluckly i cant find it and i try
to reimplement it. Is there something wrong in the following code?

(defmacro mysetf (&rest couples)
  (let ((place (gensym))
	(old-val (gensym))
	(new-val (gensym)))
    `(let* ((,place ',(car couples))
	    (,old-val (eval ,place))
	    (,new-val ,(cadr couples)))
       (warn "Changing ~s from ~s to ~s" ,place ,old-val ,new-val)
       (setf ,place ,new-val)
       ,(when (> (length couples) 2)
	  `(mysetf ,@(cddr couples))))))

PPE> (defparameter tmp1 nil)
TMP1
PPE> (defparameter tmp2 nil)
TMP2
PPE> (mysetf tmp1 3 tmp2 2)
WARNING: Changing TMP1 from NIL to 3
WARNING: Changing TMP2 from NIL to 2
NIL
PPE> 
From: Lars Brinkhoff
Subject: Re: setf logger
Date: 
Message-ID: <85ac4x8e1z.fsf@junk.nocrew.org>
Luigi Panzeri <······@muppetslab.org> writes:
> Some months ago I see on this newsgroup a setf wrapper useful to log
> application state change in non-functional code (and I remember its
> implementation was not so obvious).  Unluckly I can't find it and I
> try to reimplement it.

I would suggest something more like this:

(defmacro logging-setf (place value &rest more &environment env)
  (multiple-value-bind (a b c d e) (get-setf-expansion place env)
    `(let* ,(mapcar #'list a b)
       (multiple-value-bind ,c ,value
         (warn "Changing ~s from ~s to ~s" ',place ,e ,(first c))
         ,d)
       ,@(when more `((logging-setf ,@more))))))

> Is there something wrong in the following code?

Yes, there are some problems.

> (defmacro mysetf (&rest couples)
>   (let ((place (gensym))
> 	(old-val (gensym))
> 	(new-val (gensym)))
>     `(let* ((,place ',(car couples))
> 	    (,old-val (eval ,place))
> 	    (,new-val ,(cadr couples)))
>        (warn "Changing ~s from ~s to ~s" ,place ,old-val ,new-val)
>        (setf ,place ,new-val)
>        ,(when (> (length couples) 2)
> 	  `(mysetf ,@(cddr couples))))))