Common Lisp如何从嵌套plist树获取可setf位置修改键值

普通递归查找函数只能返回匹配到的值，无法直接作为setf的赋值目标（也就是place），核心要做两件事：

1. 遍历树结构时，同时覆盖cons列表和向量两种示例中存在的嵌套结构，匹配到目标键时定位到其对应值的可修改位置
2. 通过Common Lisp的setf扩展机制，定义查找函数的赋值展开逻辑，让它能直接出现在setf的左侧
   因为目标键在树中仅出现一次，不需要处理多匹配冲突，递归逻辑可以直接复用已有的深度优先遍历顺序。

可直接运行的实现代码 #

;; 读取用的查找函数，遍历顺序和原有查找逻辑完全一致
(defun find-place-in-tree (item tree &key (test #'eql))
  (labels ((aux (subtree)
             (cond
               ;; 匹配到plist键：键为cons的car，对应值在cadr位置
               ((and (consp subtree) (funcall test item (car subtree)))
                (return-from find-place-in-tree (cadr subtree)))
               ;; 遍历cons的左右分支
               ((consp subtree)
                (aux (car subtree))
                (aux (cdr subtree)))
               ;; 遍历向量的所有元素
               ((vectorp subtree)
                (dotimes (i (length subtree))
                  (aux (aref subtree i)))))))
    (aux tree)))

;; 定义setf展开，让查找函数成为合法的可赋值place
(define-setf-expander find-place-in-tree (item tree &key (test #'eql) &environment env)
  (multiple-value-bind (tree-vars tree-vals store-vars setter getter)
      (get-setf-expansion tree env)
    (let ((item-var (gensym))
          (test-var (gensym))
          (store-var (first store-vars)))
      (values
       (list* item-var test-var tree-vars)
       (list* item test tree-vals)
       (list store-var)
       ;; 赋值时递归定位位置后直接修改结构
       `(labels ((aux (subtree)
                   (cond
                     ((and (consp subtree) (funcall ,test-var ,item-var (car subtree)))
                      (setf (cadr subtree) ,store-var))
                     ((consp subtree)
                      (aux (car subtree))
                      (aux (cdr subtree)))
                     ((vectorp subtree)
                      (dotimes (i (length subtree))
                        (aux (aref subtree i)))))))
          (aux ,getter)
          ,store-var)
       ;; 读取时直接调用查找函数返回值
       `(find-place-in-tree ,item-var ,getter :test ,test-var)))))

用法示例 #

用给出的嵌套结构测试：

(defparameter *demo-tree*
  '(:title "A title"
    :repeat (:row    #(:a :b :c)
             :column #(:c :a :b))
    :spec (:data my-data
           :late t)))

;; 读取目标键对应值
(find-place-in-tree :data *demo-tree*)  ; 返回 MY-DATA

;; 直接赋值修改
(setf (find-place-in-tree :data *demo-tree*) 'foo)

;; 再次读取验证，返回 FOO，原树结构已被修改
(find-place-in-tree :data *demo-tree*)

适配说明 #

• 如果需求不是修改plist键对应的值，而是修改任意位置等于item的元素本身，只需要把两处匹配判断从(and (consp subtree) (funcall test item (car subtree)))改成(funcall test item subtree)，对应修改位置从(cadr subtree)改成subtree即可。
• 实现自动兼容tree本身是其他复杂place的场景，不需要限制tree必须是普通变量。

内容的提问来源于stack exchange，提问作者CL-USER