如何以尾递归方式实现(setf uniform-color)函数替代mapc？

出自《ANSI Common Lisp》第6章第1节第100页的示例：

• marble是仅包含单个color字段的结构体
• uniform-color函数接收大理石列表，若所有大理石颜色一致则返回该颜色，否则返回nil
• 该函数支持用于SETF位置，可统一设置列表中所有大理石的颜色

原基于mapc的SETF实现 #

首先给出问题中提到的原实现作为对比：

(defstruct marble color)

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

尾递归版本实现 #

针对(defun (setf ...))的场景，我们可以通过内部定义尾递归辅助函数来完成遍历赋值，确保递归调用是函数的最后执行步骤：

(defstruct marble color)

(defun (setf uniform-color) (new-color marbles)
  (labels ((tail-rec-assign (remaining-marbles)
             (cond
               ((null remaining-marbles) new-color)  ; 遍历完成，返回赋值的颜色（符合SETF函数返回要求）
               (t
                (setf (marble-color (first remaining-marbles)) new-color)
                (tail-rec-assign (rest remaining-marbles))))))  ; 尾递归调用，无后续操作
    (tail-rec-assign marbles)))

实现说明 #

• 内部的tail-rec-assign是纯尾递归函数：每次处理列表首元素后，直接递归处理剩余列表，没有额外的后续计算
• 按照ANSI Common Lisp的规范，SETF的赋值函数需要返回被赋予的值，因此递归终止时返回new-color
• 整个逻辑完全遵循尾递归的定义，递归调用是当前分支的最后执行步骤

测试示例 #

;; 创建测试用的大理石实例
(setf m1 (make-marble :color 'red)
      m2 (make-marble :color 'blue)
      m3 (make-marble :color 'green))
(setf marble-list (list m1 m2 m3))

;; 使用SETF统一设置颜色
(setf (uniform-color marble-list) 'yellow)

;; 验证结果
(mapcar #'marble-color marble-list)  ; 输出 (YELLOW YELLOW YELLOW)

内容的提问来源于stack exchange，提问作者Jérôme Radix