Simplifying setf-like macros

Attention conservation notice: I sometimes post things that are of general interest to language designers, but this is not one of those times. If you don't speak Common Lisp, don't like macrology, or don't care about generalized assignment, this post is not for you.

As the rplacd&pop macro illustrates, defining new setf-like macros is quite awkward in Common Lisp. I'm not talking about defining new setf-able places, but about defining macros that operate on places, like push and swapf. They're so awkward to write that the Hyperspec doesn't directly define most of them, but instead resorts to simplified versions with disclaimers:

The effect of (push item place) is equivalent to

(setf place (cons item place))

except that the subforms of place are evaluated only once, and item is evaluated before place.

There is actually a sample implementation of pop at get-setf-expansion, but it's not linked from pop, probably because it's too complex to be of much help in explaining what pop does. Handling places properly requires calling get-setf-expansion and doing nonobvious things with its five return values, which is a lot of trouble that has little to do with the desired macro. Consider the definition of rplacd&pop:

(defmacro rplacd&pop (x &optional y &environment e)
  (multiple-value-bind (temps forms svars writeform readform)
                       (get-setf-expansion x e)
    `(let* (,@(mapcar #'list temps forms)
            (,(car svars) (cdr ,readform)))
      (prog1 ,readform
        (setf (cdr ,readform) ,y)
        ,writeform))))

There is a lot of predictable code here. This macro differs from pop in only two sections (italicized above), and from push in those two plus argument order. Most of the code is the same. Can we abstract it out with a macro?

(defmacro expand-setf ((valuevar readvar writevar) place env &body body)
  "Generate code for a SETF-like operation: evaluate BODY with the three
vars bound to the corresponding parts of PLACE's SETF expansion, then
wrap the result in a LET to bind the SETF temporaries.
BODY should normally evaluate to a form that binds VALUEVAR to the
desired new value of PLACE and then does WRITEVAR."
  (with-gensyms (temps forms storevars)
    `(multiple-value-bind (,temps ,forms ,storevars ,writevar ,readvar)
                          (get-setf-expansion ,place ,env)
       (let ((,valuevar (car ,storevars)))
         `(let (,@(mapcar #'list ,temps ,forms))
            ,,@body)))))

I confess that I had some trouble writing this: I got confused about nested splicing. I'd feel bad about this, but I know everyone else has trouble with it too. Is there any other part of Lisp that so reliably earns its difficult reputation?

Anyway, having spent an hour writing expand-setf, I tried it out and was disappointed: it doesn't save as much code as I hoped. I forgot one of the basic rules of making difficult abstractions: write an example call before you write the macro.

(defmacro rplacd&pop (place &optional newcdr &environment e)
  (expand-setf (val readform writeform) place e
    `(let ((,val (cdr ,readform)))
       (prog1 ,readform
         (setf (cdr ,readform) ,newcdr)
         ,writeform)))

This is, unfortunately, only two lines shorter than the get-setf-expansion version, because expand-setf still requires the hassle of binding the store variable and passing the environment around. It scales nicely to more complicated macros, though:

(defmacro swapf (p1 p2 &environment e)
  "Two-argument ROTATEF."
  (expand-setf (v1 r1 w1) p1 e
    (expand-setf (v2 r2 w2) p2 e
      `(let ((,v1 ,r2) (,v2 ,r1))
         ,w1
         ,w2))))

We could get rid of the magical storevar by packaging writeform as a function, so you do (,writefn exp) instead of (let ((,storeform exp)) ,writeform). Unfortunately this doesn't necessarily make the callers any shorter, because they often have to store the value in a variable anyway:

(defmacro rplacd&pop (place &optional y &environment e)
  (expand-setf (r w) place e
    (with-gensyms (newval)
      `(let ((,newval ,r))
         (prog1 ,r
           (rplacd (cdr ,r) ,y)
           (,w ,newval)))))

It's also annoying that expand-setf wraps a form around the result of its body. That's a surprising thing for a macro to do, and I can imagine it confusing people and causing bugs. We can get rid of that - and of the whole macro - in a clean way, by packaging the expansion as a function:

(defun place-accessor (place env)
  "Return a form evaluating to an accessor for PLACE: a function
that returns the value of PLACE when called with no arguments, and
sets PLACE when called with one argument."
  (expand-setf (v r w env)
    (with-gensyms (set?)
      `(lambda (&optional (,v nil ,set?))
         (if ,set?    ;CASE-LAMBDA would be ideal here
           ,r
           (progn ,w ,v))))))

This turns places into first-class values, which, not surprisingly, makes them easier to work with. (I think this has been done before to emulate pass-by-reference, but I've never seen it done to simplify writing other macros. Update January 2016: Strachey did it in 1967 in Fundamental Concepts in Programming Languages, under the name “load-update pair”.) Distinguishing reads from writes by arity this way isn't entirely clean, but it beats packaging them as two separate functions, which would be prohibitively awkward for the caller. Here's how it works in practice:

(defmacro swapf (place1 place2 &environment e)
  (with-gensyms (a1 a2 v)
    `(let ((,a1 ,(place-accessor place1 e))
           (,a2 ,(place-accessor place2 e)))
       (let ((,v (funcall ,a1)))
         (funcall ,a1 (funcall ,a2))
         (funcall ,a2 ,v)))))

This is longer than the expand-setf version, because it doesn't handle the gensyms and variables itself. (Ignore the funcalls; they wouldn't be there in a Lisp-1.) It's less magical, but I'm not sure it's any easier to read. place-accessor would be best used as the foundation of a setf system, since it's conceptually simpler than get-setf-expansion, but it still needs a with-place-accessor wrapper macro. And I've lost sight of the original problem. None of these solutions make defining rplacd&pop and push as simple as it ought to be. There must be a better way.

Maybe I'm coming at this from the wrong direction. Rather than simplify the general case, what about generalizing the simple case? define-modify-macro already covers the most common kind of one-place macros: those that simply apply some function to the value in the place, and store (and return) the result:

(setf place (some-function place args ...))

For example:

CL-USER> (define-modify-macro pop* () cdr
           "Like POP, but doesn't return the popped value.")
POP*
CL-USER> (macroexpand-1 '(pop* place))
(LET* ((#:G4467 (CDR PLACE)))
  (SETQ PLACE #:G4467))

The only reason define-modify-macro can't express pop and rplacd&pop is that the macros it defines must return the same value they store. We could fix this by adding another argument: in addition to a function to determine the stored value, we can supply one to determine the returned value:

(defmacro define-modify-macro* (name arglist transformfn resultfn
                                &optional docstring)
  "Like DEFINE-MODIFY-MACRO, but takes an additional function, to
define a macro that returns a different value than it stores.
Subforms of the place are evaluated first, then any additional arguments,
then TRANSFORMFN is called, then RESULTFN, then the value is stored, and
finally the result of RESULTFN is returned.
ARGLIST may contain &optional arguments but not &rest or &key."
  (let* ((args (arg-names arglist))
         (gensyms (mapcar (lambda (a) (gensym (symbol-name a))) args)))
         ;GENSYMS is a list of names (in the intermediate expansion) of
         ; names (in the final expansion) of the values of the ARGS. They
         ; have to be gensymmed to protect TRANSFORMFM and RESULTFN.
    (with-gensyms (place env)
      `(defmacro ,name (,place ,@arglist &environment ,env)
         ,@(when docstring (list docstring))
         (expand-setf (v r w) ,place ,env
           (with-gensyms ,gensyms
             `(let (,,@(mapcar (lambda (gen arg) ``(,,gen ,,arg))
                               gensyms args))
                (let ((,v (,',transformfn ,r ,,@gensyms)))
                  (prog1 (,',resultfn ,r ,,@gensyms)
                         ,w)))))))))

(defun arg-names (arglist)
  "Return the names of the arguments in a lambda-list."
  (loop for arg in arglist
        unless (member arg lambda-list-keywords)
        collect (if (consp arg) (car arg) arg)))

(I had trouble writing this macro too - not just the multiple levels of splicing and gensyms, but also the awkwardness of extracting the argument names. Common Lisp has complex argument-lists, but no tools to parse them, so it took me a few tries before I realized I needed to do it myself, and then a few more before I gave up trying to handle &rest and &key. And I almost forgot to prevent multiple evaluation of argument forms!)

With this macro, pop-like macros can be defined more conveniently:

(define-modify-macro* rplacd&pop (&optional newcdr)
  (lambda (x y) (declare (ignore y)) (cdr x))
  rplacd
  "I am not explaining this one again.")

Except for the hassle of lambda and ignore to give cdr the right argument, this is not too painful. push requires a wrapper to fix its argument order, but pop is easy:

(define-modify-macro %push (val)
  (lambda (list val) (cons val list))
  (lambda (list val) (declare (ignore list)) val)
  "Helper for PUSH")

(defmacro push (val place)
  `(%push ,place ,val))

(define-modify-macro* pop () cdr car)

Correction: push returns the same value it stores, so it doesn't require define-modify-macro*.

I started this post intending to learn something about how to design a better setf-like generalized assignment system, and succeeded only in writing a few macros to make dealing with Common Lisp's setf less painful. This is, I suppose, still useful, but it's disappointing.