寻求可遍历defstruct的Common Lisp subst变体（支持SBCL）

标准subst仅会遍历列表和原子类型，无法深入结构体、数组等复合类型内部进行替换。针对SBCL环境，我们可以实现一个递归遍历所有常见Lisp对象类型的深层替换函数，满足你的需求：

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :sb-mop))

(defun deep-subst (new old tree &key (hash-table-handle :values) (include-clos-objects t))
  "递归替换树中所有出现的OLD为NEW，支持列表、数组、结构体、哈希表等类型。
HASH-TABLE-HANDLE可选值: :values (只替换值)、:keys (只替换键)、:both (替换键和值)
INCLUDE-CLOS-OBJECTS为T时，也递归处理CLOS实例的槽"
  (cond
    ;; 匹配目标值，直接替换
    ((eql tree old)
     new)
    ;; 处理列表/cons
    ((consp tree)
     (cons (deep-subst new old (car tree)
                       :hash-table-handle hash-table-handle
                       :include-clos-objects include-clos-objects)
           (deep-subst new old (cdr tree)
                       :hash-table-handle hash-table-handle
                       :include-clos-objects include-clos-objects)))
    ;; 处理数组（含向量）
    ((arrayp tree)
     (let* ((dimensions (array-dimensions tree))
            (new-array (make-array dimensions
                                   :element-type (array-element-type tree)
                                   :adjustable (adjustable-array-p tree)
                                   :fill-pointer (when (array-has-fill-pointer-p tree)
                                                   (fill-pointer tree)))))
       (dotimes (i (array-total-size tree) new-array)
         (setf (row-major-aref new-array i)
               (deep-subst new old (row-major-aref tree i)
                           :hash-table-handle hash-table-handle
                           :include-clos-objects include-clos-objects)))))
    ;; 处理结构体
    ((structurep tree)
     (let ((copy (copy-structure tree)))
       (loop for slot in (sb-mop:class-slots (class-of tree))
             for slot-name = (sb-mop:slot-definition-name slot)
             do (setf (slot-value copy slot-name)
                      (deep-subst new old (slot-value tree slot-name)
                                  :hash-table-handle hash-table-handle
                                  :include-clos-objects include-clos-objects)))
       copy))
    ;; 处理CLOS对象（可选开启）
    ((and include-clos-objects (standard-object-p tree))
     (let ((copy (make-instance (class-of tree))))
       (loop for slot in (sb-mop:class-slots (class-of tree))
             for slot-name = (sb-mop:slot-definition-name slot)
             when (slot-boundp tree slot-name)
               do (setf (slot-value copy slot-name)
                        (deep-subst new old (slot-value tree slot-name)
                                    :hash-table-handle hash-table-handle
                                    :include-clos-objects include-clos-objects)))
       copy))
    ;; 处理哈希表
    ((hash-table-p tree)
     (let ((new-hash (make-hash-table :test (hash-table-test tree)
                                      :size (hash-table-size tree)
                                      :rehash-size (hash-table-rehash-size tree)
                                      :rehash-threshold (hash-table-rehash-threshold tree))))
       (maphash (lambda (k v)
                  (let ((new-k (if (or (eq hash-table-handle :keys) (eq hash-table-handle :both))
                                   (deep-subst new old k
                                               :hash-table-handle hash-table-handle
                                               :include-clos-objects include-clos-objects)
                                   k))
                        (new-v (if (or (eq hash-table-handle :values) (eq hash-table-handle :both))
                                   (deep-subst new old v
                                               :hash-table-handle hash-table-handle
                                               :include-clos-objects include-clos-objects)
                                   v)))
                    (setf (gethash new-k new-hash) new-v)))
                tree)
       new-hash))
    ;; 其他原子类型直接返回
    (t tree)))

测试你的示例 #

CL-USER> (defstruct my-struct slot-1 slot-2)
MY-STRUCT
CL-USER> (deep-subst 'b1 'b (make-my-struct :slot-1 'a :slot-2 'b))
#S(MY-STRUCT :SLOT-1 A :SLOT-2 B1)

这个函数会递归遍历所有嵌套的复合类型，包括结构体的槽、数组元素、哈希表的键/值等，完全满足深层替换的需求。由于使用了SBCL的sb-mop扩展来访问结构体的槽定义，它是SBCL特定的实现，符合你不介意编译器特定方案的要求。

内容的提问来源于stack exchange，提问作者fakedrake