[SOLVED] How to implement recursion when defining a setf function?

How to implement recursion when defining a setf function?

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.

Solution

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