[homedirectory]

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.

Here are my thoughts on the article:

Firstly, there are errors in the definition of OUR-SETF macro:

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)

2. Arguments to APPLY are ill-formed. Instead of CONS, LIST must be used.

    (apply (symbol-function ',our-setf-function-name)
           (cons ,new-value ,@(cdr locator)))

Using CONS, (our-setf (head (list 1 2)) 0) expands to:

    (apply (symbol-function '|(our-setf head)|) 
           (cons 0 (list 1 2)))

Which is equivalent to (|(our-setf head)| 0 1 2), clearly not what we want.

Furthermore, an OUR-SETF that accepts multiple places will fail. Consider an example from the article:

    (our-setf (aref a 23) 0)

It expands to:

    (|(our-setf aref)| (cons 0 a 23))

Clearly, an error.

The correct usage of APPLY is:

    (apply (symbol-function ',our-setf-function-name)
           (list ,new-value ,@(cdr locator)))

Alternatively, use a FUNCALL:

    (funcall (symbol-function ',our-setf-function-name)
             ,new-value ,@(cdr locator))

Also, SYMBOL-FUNCTION can be dropped, as both FUNCALL and APPLY accept a function designator.

    (funcall ',our-setf-function-name ,new-value ,@(cdr locator))

This concludes the errors part.

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)|.

Multiple escape characters also mean that symbol generation is needed only in OUR-SETF macro. Generic functions and methods can be defined directly:

    (defgeneric |(OUR-SETF HEAD)| (new-value place))

    (defmethod |(OUR-SETF HEAD)| (new-value (place list)) 
      (rplaca place new-value)
      new-value)

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.

    (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))))

With this change we can even use selectors from other packages.

As the author said, these are symbols with weird names. So we can remove most of the weirdness with more macros:

    (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)