How to implement recursion when defining a setf function?

Question

From the book "ANSI Common Lisp", p. 100 ch 6.1 :

Suppose that a marble is a structure with a single field called color. The function UNIFORM-COLOR takes a list of marbles and returns their color, if they all have the same color, or nil if they have different colors. UNIFORM-COLOR is usable on a setf place in order to make the color of each element of list of marbles be a specific color.

(defstruct marble color)

(defun uniform-color (lst &optional (color (and lst (marble-color (car lst)))))
  (every #'(lambda (m) (equal (marble-color m) color)) lst))

(defun (setf uniform-color) (color lst)
  (mapc #'(lambda (m) (setf (marble-color m) color)) lst))

How could you implement the defun (setf uniform) in a tail-recursive way instead of using the mapc applicative operator ?

This question is specific to the case of (defun (setf ...)), it is not a question about how recursion or tail-recursion work in general.

Answer 1

General case

The answer is the same for setf functions and regular functions. Let's say you have another function f that you want to call to print all the values in a list:

(defun f (list)
  (mapc 'print list))

You can rewrite it recursively, you have to consider the two distinct case of recursion for a list, either it is nil or a cons cell:

(defun f (list)
  (etypecase list
     (null ...)
     (cons ...)))

Typically in the null case (this is a type), you won't do anything. In the general cons case (this is also a type), you have to process the first item and recurse:

(defun f (list)
  (etypecase list
    (null nil)
    (cons 
      (print (first list))
      (f (rest list)))))

The call to f is in tail position: its return value is the return value of the enclosing f, no other processing is done to the return value.

You can do the same with your function.

Note

It looks like the setf function defined in the book does not return the value being set (the color), which is bad practice as far as I know:

all that is guaranteed is that the expansion is an update form that works for that particular implementation, that the left-to-right evaluation of subforms is preserved, and that the ultimate result of evaluating setf is the value or values being stored.

5.1.1 Overview of Places and Generalized Reference

Also, in your specific case you are subject to 5.1.2.9 Other Compound Forms as Places, which also says:

A function named (setf f) must return its first argument as its only value in order to preserve the semantics of setf.

In other words (setf uniform-color) should return color.

But apart from that, the same section guarantees that a call to (setf (uniform-color ...) ...) expands into a call to the function named (setf uniform-color), so it can be a recursive function too. This could have been a problem if this was implemented as macro that expands into the body of your function, but fortunately this is not the case.

Implementation

Setting all the colors in a list named marbles to "yellow" is done as follows:

(setf (uniform-color marbles) "yellow")

You can define (setf uniform-color) recursively by first setting the color of the first marble and then setting the color of the rest of the marbles. A possible tail-recursive implementation that respects the semantics of setf is:

(defun (setf uniform-color) (color list)
  (if list
      (destructuring-bind (head . tail) list
        (setf (marble-color head) color)
        (setf (uniform-color tail) color))
      color))

Answer 2

i guess you can just call setf recursively:

(defun (setf all-vals) (v ls)
  (when ls
    (setf (car ls) v)
    (setf (all-vals (cdr ls)) v)))

CL-USER> (let ((ls (list 1 2 3 4)))
           (setf (all-vals ls) :new-val)
           ls)
;;=> (:NEW-VAL :NEW-VAL :NEW-VAL :NEW-VAL)

this is how sbcl expands this:

(defun (setf all-vals) (v ls)
  (if ls
      (progn
       (sb-kernel:%rplaca ls v)
       (let* ((#:g328 (cdr ls)) (#:new1 v))
         (funcall #'(setf all-vals) #:new1 #:g328)))))

For the specific case of marbles:

(defun (setf uniform-color) (color lst)
  (when lst
    (setf (marble-color (car lst)) color)
    (setf (uniform-color (cdr lst)) color)))