Common Lisp: Method to minimize code duplication when defining setf expanders - macros

Question

Triggered from this question about setf expanders: defining setf-expanders in Common Lisp
When writing setf expanders for user-defined getters, I commonly find that there is code duplication in the getter and setter, as far as how the property is retrieved. For example:
CL-USER>
(defun new-car (lst)
(car lst))
NEW-CAR
CL-USER>
(defun (setf new-car) (new-value lst)
(setf (car lst) new-value))
(SETF NEW-CAR)
CL-USER>
(defparameter *lst* (list 5 4 3))
*LST*
CL-USER>
*lst*
(5 4 3)
CL-USER>
(setf (new-car *lst*) 3)
3
CL-USER>
*lst*
(3 4 3)
CL-USER>
Note how the (car lst) form, the actual accessor that already has a setf expander defined, is in both defuns. This has always annoyed me somewhat. It would be nice to be able to say on the first defun, 'hey, I'm defining a defun that's a getter, but I also want it to have a typical setf expander'.
Is there any way with the common lisp standard to express this? Has anyone else worried about this issue, and defined a macro that does this?
To be clear, what I'd like here is a way to define a getter and typical setter, where the way that the getter compiles down to common lisp forms that already have setters ((car lst), e.g.) is written only once in the code.
I also understand there are times where you wouldn't want to do this, b/c the setter needs to perform some side effects before setting the value. Or it's an abstraction that actually sets multiple values, or whatever. This question is less relevant in that situation. What I'm talking about here is the case where the setter does the standard thing, and just sets the place of the getter.

Answer 1

What you want can be achieved with the use of macros.
(defmacro define-place (name lambda-list sexp)
(let ((value-var (gensym)))
`(progn
(defun ,name ,lambda-list
,sexp)
(defun (setf ,name) (,value-var ,#lambda-list)
(setf ,sexp ,value-var)))))
(define-place new-chr (list)
(car list))
More information on macros can be found in Peter Seibel's book, Practical Common Lisp. Chapter 10 of Paul Graham's book "ANSI Common Lisp" is another reference.

Answer 2

Note how the (car lst) form, the actual accessor that already has a setf expander defined, is in both defuns.
But that's only apparently true before macro expansion. In your setter, the (car lst) form is the target of an assignment. It will expand to something else, like the call to some internal function that resembles rplaca:
You can do a similar thing manually:
(defun new-car (lst)
(car lst))
(defun (setf new-car) (new-value lst)
(rplaca lst new-value)
new-value)
Voilà; you no longer have duplicate calls to car; the getter calls car, and the setter rplaca.
Note that we manually have to return new-value, because rplaca returns lst.
You will find that in many Lisps, the built-in setf expander for car uses an alternative function (perhaps named sys:rplaca, or variations thereupon) which returns the assigned value.
The way we generally minimize code duplication when defining new kinds of places in Common Lisp is to use define-setf-expander.
With this macro, we associate a new place symbol with two items:
a macro lambda list which defines the syntax for the place.
a body of code which calculates and returns five pieces of information, as five return values. These are collectively called the "setf expansion".
The place-mutating macros like setf use the macro lambda list to destructure the place syntax and invoke the body of code which calculates those five pieces. Those five pieces are then used to generate the place accessing/updating code.
Note, nevertheless, that the last two items of the setf expansion are the store form and the access form. We can't get away from this duality. If we were defining the setf expansion for a car-like place, our access form would invoke car and the store form would be based on rplaca, ensuring that the new value is returned, just like in the above two functions.
However there can exist places for which a significant internal calculation can be shared between the access and the store.
Suppose we were defining my-cadar instead of my-car:
(defun new-cadar (lst)
(cadar lst))
(defun (setf new-cadar) (new-value lst)
(rplaca (cdar lst) new-value)
new-value)
Note how if we do (incf (my-cadar place)), there is a wasteful duplicate traversal of the list structure because cadar is called to get the old value and then cdar is called again to calculate the cell where to store the new value.
By using the more difficult and lower level define-setf-expander interface, we can have it so that the cdar calculation is shared between the access form and the store form. So that is to say (incf (my-cadar x)) will calculate (cadr x) once and store that to a temporary variable #:c. Then the update will take place by accessing (car #:c), adding 1 to it, and storing it with (rplaca #:c ...).
This looks like:
(define-setf-expander my-cadar (cell)
(let ((cell-temp (gensym))
(new-val-temp (gensym)))
(values (list cell-temp) ;; these syms
(list `(cdar ,cell)) ;; get bound to these forms
(list new-val-temp) ;; these vars receive the values of access form
;; this form stores the new value(s) into the place:
`(progn (rplaca ,cell-temp ,new-val-temp) ,new-val-temp)
;; this form retrieves the current value(s):
`(car ,cell-temp))))
Test:
[1]> (macroexpand '(incf (my-cadar x)))
(LET* ((#:G3318 (CDAR X)) (#:G3319 (+ (CAR #:G3318) 1)))
(PROGN (RPLACA #:G3318 #:G3319) #:G3319)) ;
T
#:G3318 comes from cell-temp, and #:G3319 is the new-val-temp gensym.
However, note that the above defines only the setf expansion. With the above, we can only use my-cadar as a place. If we try to call it as a function, it is missing.

Answer 3

Working from Mark's approach, Rainer's post on macro-function, and Amalloy's post on transparent macrolet, I came up with this:
(defmacro with-setters (&body body)
`(macrolet ((defun-mod (name args &body body)
`(,#(funcall (macro-function 'defun)
`(defun ,name ,args ,#body) nil))))
(macrolet ((defun (name args &body body)
`(progn
(defun-mod ,name ,args ,#body)
(defun-mod (setf ,name) (new-val ,#args)
(setf ,#body new-val)))))
(progn
,#body))))
To use:
Clozure Common Lisp Version 1.8-r15286M (DarwinX8664) Port: 4005 Pid: 41757
; SWANK 2012-03-06
CL-USER>
(with-setters
(defun new-car (lst)
(car lst))
(defun new-first (lst)
(first lst)))
(SETF NEW-FIRST)
CL-USER>
(defparameter *t* (list 5 4 3))
*T*
CL-USER>
(new-car *t*)
5
CL-USER>
(new-first *t*)
5
CL-USER>
(setf (new-first *t*) 3)
3
CL-USER>
(new-first *t*)
3
CL-USER>
*t*
(3 4 3)
CL-USER>
(setf (new-car *t*) 9)
9
CL-USER>
*t*
(9 4 3)
There are some variable capture issues here that should probably be attended to, before using this macro in production code.