从书中"ANSI Common Lisp"；，第100页第6.1页：
假设大理石是一个具有一个称为颜色的单一字段的结构。函数UNIFORM-COLOR获取弹珠列表并返回它们的颜色，如果它们都有相同的颜色，或者如果它们有不同的颜色。UNIFORM-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))
如何以尾部递归方式实现defun (setf uniform)，而不是使用mapc应用运算符
这个问题特定于(defun (setf ...))的情况，而不是关于递归或尾递归一般如何工作的问题。
一般情况
对于setf函数和正则函数，答案是相同的。假设您有另一个函数f，您想调用它来打印列表中的所有值：
(defun f (list)
(mapc 'print list))
你可以递归地重写它，你必须考虑列表递归的两种不同情况，要么是nil，要么是cons单元格：
(defun f (list)
(etypecase list
(null ...)
(cons ...)))
通常在null的情况下(这是一种类型(，您不会做任何事情。在一般的cons情况下(这也是一种类型(，您必须处理第一个项目并递归：
(defun f (list)
(etypecase list
(null nil)
(cons
(print (first list))
(f (rest list)))))
对f的调用处于尾部位置：它的返回值是封闭的f的返回值，对返回值不做其他处理。
你可以用你的函数做同样的事情。
备注
书中定义的setf函数似乎不会返回正在设置的值(颜色(，据我所知，这是一种糟糕的做法：
所有可以保证的是，扩展是一个适用于特定实现的更新表单，保留了从左到右对子表单的评估，并且评估setf的最终结果是存储的一个或多个值。
5.1.1位置和通用参考概述
此外，在您的具体情况下，您需要遵守5.1.2.9其他复合形式作为场所，其中还规定：
名为
(setf f)的函数必须返回其第一个参数作为其唯一值，才能保留setf的语义。
换句话说，(setf uniform-color)应该返回color。
但除此之外，同一部分保证了对(setf (uniform-color ...) ...)的调用扩展为对名为(setf uniform-color)的函数的调用，因此它也可以是递归函数。如果这是作为扩展到函数体中的宏实现的，那么这可能是一个问题，但幸运的是，情况并非如此。
实施
将名为marbles到"yellow"的列表中的所有颜色设置如下：
(setf (uniform-color marbles) "yellow")
可以通过首先设置第一个大理石的颜色，然后设置其余大理石的颜色来递归定义(setf uniform-color)。尊重setf语义的一种可能的尾部递归实现是：
(defun (setf uniform-color) (color list)
(if list
(destructuring-bind (head . tail) list
(setf (marble-color head) color)
(setf (uniform-color tail) color))
color))
我想你可以递归地调用setf：
(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)
sbcl就是这样扩展的：
(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)))))
对于弹珠的具体情况：
(defun (setf uniform-color) (color lst)
(when lst
(setf (marble-color (car lst)) color)
(setf (uniform-color (cdr lst)) color)))