I also once thought that the magic underlying SETF has access to true L-values, and had also been surprised by it being macros under the hood.<p>Here are my thoughts on the article:<p>Firstly, there are errors in the definition of OUR-SETF macro:<p>1. (symbol-function ,our-setf-function-name) will signal an unbound variable error.
,our-setf-function-name must be quoted: (symbol-function ',our-setf-function-name)<p>2. Arguments to APPLY are ill-formed. Instead of CONS, LIST must be used.<p><pre><code> (apply (symbol-function ',our-setf-function-name)
(cons ,new-value ,@(cdr locator)))
</code></pre>
Using CONS, (our-setf (head (list 1 2)) 0) expands to:<p><pre><code> (apply (symbol-function '|(our-setf head)|)
(cons 0 (list 1 2)))
</code></pre>
Which is equivalent to (|(our-setf head)| 0 1 2), clearly not what we want.<p>Furthermore, an OUR-SETF that accepts multiple places will fail.
Consider an example from the article:<p><pre><code> (our-setf (aref a 23) 0)
</code></pre>
It expands to:<p><pre><code> (|(our-setf aref)| (cons 0 a 23))
</code></pre>
Clearly, an error.<p>The correct usage of APPLY is:<p><pre><code> (apply (symbol-function ',our-setf-function-name)
(list ,new-value ,@(cdr locator)))
</code></pre>
Alternatively, use a FUNCALL:<p><pre><code> (funcall (symbol-function ',our-setf-function-name)
,new-value ,@(cdr locator))
</code></pre>
Also, SYMBOL-FUNCTION can be dropped, as both FUNCALL and APPLY accept a <i>function designator</i>.<p><pre><code> (funcall ',our-setf-function-name ,new-value ,@(cdr locator))
</code></pre>
This concludes the errors part.<p>Secondly, I was really confused by the symbol generation for OUR-SETF example. I thought of function-defining macros, such as DEFUN and DEFMETHOD, and they accept lists of the form (SETF X) and not symbols whose name looks like a list. This latter notation could be better explained by using multiple escape characters from the Common Lisp HyperSpec. For example, the bar character: |(our-setf head)|.<p>Multiple escape characters also mean that symbol generation is needed only in OUR-SETF macro. Generic functions and methods can be defined directly:<p><pre><code> (defgeneric |(OUR-SETF HEAD)| (new-value place))
(defmethod |(OUR-SETF HEAD)| (new-value (place list))
(rplaca place new-value)
new-value)
</code></pre>
This would also require changes to OUR-SETF macro because the symbols used to name generic functions and methods are now interned in a package.<p><pre><code> (defmacro our-setf (locator new-value)
(let* ((selector (car locator))
; use the selector's package,
; selector must be interned
(our-setf-function-name (intern (format nil "(OUR-SETF ~a)"
selector)
(symbol-package selector))))
`(funcall ',our-setf-function-name
,new-value ,@(cdr locator))))
</code></pre>
With this change we can even use selectors from other packages.<p>As the author said, these are symbols with weird names. So we can remove most of the weirdness with more macros:<p><pre><code> (eval-when (:compile-toplevel :load-toplevel :execute)
(defun selector-symbol (selector)
(or (get selector 'our-setf-name)
(gentemp (string selector) (symbol-package selector)))))
(defmacro defgeneric-setf ((selector &rest selector-params) (new-value))
(let ((name (selector-symbol selector)))
`(progn
(setf (get ',selector 'our-setf-name) ',name)
(defgeneric ,name (,new-value ,@selector-params)))))
(defmacro defmethod-setf ((selector &rest selector-params) (new-value) &body body)
(let ((name (selector-symbol selector)))
`(progn
(setf (get ',selector 'our-setf-name) ',name)
(defmethod ,name (,new-value ,@selector-params)
,@body))))
(defmacro our-setf ((selector &rest selector-params) new-value)
(let ((our-setf-function-name (selector-symbol selector)))
`(funcall ',our-setf-function-name ,new-value ,@selector-params)))
(defgeneric-setf (head x) (new-value))
(defmethod-setf (head (x cons)) (new-value)
(rplaca x new-value)
new-value)
#+nil
(let ((xs (list 1 2)))
; expands to (funcall 'headN 0 xs) where N is a number from GENTEMP
(our-setf (head xs) 0)
xs) ; => (0 2)
(defgeneric-setf (our-elt seq idx) (new-value))
(defmethod-setf (our-elt (seq list) idx) (new-value)
(loop for i from 0 to idx
for cons on seq
finally (our-setf (head cons) new-value))
new-value)
#+nil
(let ((xs (list 'a 'b 'c)))
; expands to (funcall 'our-eltN 'k xs 1) where N is a number from GENTEMP
(our-setf (our-elt xs 1) 'k)
xs) ; => (a k c)</code></pre>