common lisp setf的智慧

Common Lisp setf的智慧

我还记得我最开始学 Common Lisp 时看见 setf 是赋值当时心凉一半，很少语言把赋值写的这么长 (setf a 0)。我记得当时喜欢 lua 和 C++，它们有重载运算符/元方法，可以直接把修改赋值行为。CL 的 setf 就显得比较长了。

不过这段时间我借用 setf 的思路写我的规则引擎，写着写着我就感受我低估了 setf 的用处。接下来我就用 setf 和 CL 的其他机制整点花活：

1. 定义 #'(setf xx) 函数

这个应该算是 setf 最常用的拓展方式了。

(defmacro aif2 (cond then &optional else)
  (let ((win (gensym)))
    `(multiple-value-bind (it ,win) ,cond
       (declare (ignorable it))
       (if ,win ,then ,else))))

(defun mul-gethash (keys hash)
  (destructuring-bind (first . rest) keys
    (aif2 (gethash first hash)
          (if rest
              (mul-gethash rest it) it))))

这个函数用于嵌套式的根据多个 key 进行查找，如果中途查找到 nil 则直接返回 nil。这很像直接操作 lua 的 table 一样，但是 lua 的 table 引用 key 时如果 key 不存在再进行引用会直接报错。接下来我们写 (setf mul-gethash) 进行赋值，如果中途有没有这个键值对则自动创造一个哈希表。

(defun (setf mul-gethash) (val keys hash)
  (destructuring-bind (first . rest) keys
    (if rest
        (aif2 (gethash first hash)
              (setf (mul-gethash rest it) val)
              (setf (mul-gethash rest (setf (gethash first hash)
                                            (make-hash-table)))
                    val))
        (setf (gethash first hash) val))))

这里用的是递归写的，如果觉得效率可能偏低，也可以采用循环的写法。此外还可以用 defmethod 来创建广义的 #'(setf xx) 函数进行赋值，这些在 CL 入门书中应该讲的比较多就不多说了。

2. 定义组合式 setf

2.1 append-setf

(defmacro append-setf (place lst)
  `(setf ,place (append ,place ,lst)))

用法也很简单：

(defvar test '(1))
(append-setf test '(2 3))

此时 test 则为 (1 2 3)。

但是这个 append-setf 有大大的问题，如果这么调用：

(append-setf (aref arr (incf i)) '(1 2))

由于我们没有对 place 进行特殊处理，所以 (aref arr (incf i)) 会被展开两次，那 i 就会增加两次值，所以我们要用 get-setf-expansion 来分析 place。可以看一下这个表达式的返回值：

(get-setf-expansion '(aref arr (incf i)))

返回：

(#:ARR252 #:G253)
(ARR (INCF I))
(#:NEW251)
(FUNCALL #'(SETF AREF) #:NEW251 #:ARR252 #:G253)
(AREF #:ARR252 #:G253)

一共5个返回值，可以比较明显的看到前两个链表是用来临时绑定 place 里面的参数的，这样就能保证参数上的表达式只展开一次，然后在第三个链表中的变量保存新的值，第四个链表表示执行赋值语句，第五个用于读取 place 的值，于是我们就可以把 append-setf 写成以下这样。

(defmacro append-setf (place lst)
  (let ((meth (multiple-value-list (get-setf-expansion place))))
    `(let* ,(mapcar #'list (first meth) (second meth))
       (let ((,(first (third meth)) (append ,(fifth meth) ,lst)))
         ,(fourth meth)))))

使用 get-setf-expansion 解析除了可以消除 place 参数表达式多次执行的问题，还能进行效率提升，因为表达式都只执行了一次，对比直接展开的 place 中的每个表达式都被计算两次。

但是这样还有点小问题，如果 place 被 macrolet 或者 symbol-macrolet 进行包装了，那就会出错：

(symbol-macrolet ((a (aref arr i)))
  (append-setf a '(1 2 3)))

此时 get-setf-expansion 会以为 a 只是一个普通的符号，展开时就会用 setq 给它赋值，但是这里是给数组赋值。怎么解决呢？在宏展开时可以用 &environment 捕捉当前环境，再把环境传给 get-setf-expansion 就可以解决了：

(defmacro append-setf (place lst &environment env)
  (let ((meth (multiple-value-list (get-setf-expansion place env))))
    `(let* ,(mapcar #'list (first meth) (second meth))
       (let ((,(first (third meth)) (append ,(fifth meth) ,lst)))
         ,(fourth meth)))))

2.2 union-setf

(defmacro union-setf (place lst &environment env)
  (let ((meth (multiple-value-list (get-setf-expansion place env))))
    `(let* ,(mapcar #'list (first meth) (second meth))
       (let ((,(first (third meth)) (union ,(fifth meth) ,lst)))
         ,(fourth meth)))))

使用方法和 append-setf 一样，只是用的 union 函数。

等等，这是不是和 append-setf 很像啊？所以我们可以进行“终极”抽象。

2.3 define-combine-setf

(defmacro define-combine-setf (mname func)
  `(defmacro ,mname (place var &environment env)
     (let* ((meth (multiple-value-list (get-setf-expansion place env))))
       `(let ,(mapcar #'list (first meth) (second meth))
          (let ((,(first (third meth)) (funcall ,',func ,(fifth meth) ,var)))
            ,(fourth meth))))))

这样就把一整个封装过程抽象出来了，如果我们需要就可以直接用 define-combine-setf 定义出来。比如：

(define-combine-setf append-setf #'append)

这样就能直接定义 append-setf 和更多二元操作了。

3. 使用 define-setf-expander

这部分可能实用性不强，能体现 setf 的强大，可以选择性看。

3.1 ensure

通常我们会写 ensure 进行确保一个表达式的值为某个类型，否则就返回默认值，也就是：

(defun ensure (type var default)
  (if (typep var type)
      var default))

如果给它定义一个“逆”呢？能不能直接：

(defun (setf ensure) (new type var default)
  ...)

这是不能的，因为如果定义成函数 var 会在参数中直接计算出结果传入函数中，就不能给它赋值了。那么就得用 define-setf-expander 了——而它的返回值就是 get-setf-expansion 的返回值，也就是我们要写那5个返回值。

(define-setf-expander ensure (type place default &optional env)
  (let ((meth (multiple-value-list (get-setf-expansion place env)))
        (type-sym (gensym))
        (default-sym (gensym)))
    (values (append (first meth) (list type-sym default-sym))
            (append (second meth) (list type default))
            (third meth)
            (fourth meth)
            `(ensure ,type-sym ,(fifth meth) ,default-sym))))

这个 ensure 直接给 setf 是没多大用处的，但是如果给 incf 或者是上面我们定义的 append-setf，union-setf 就不一样了。

(incf (ensure 'integer test 0))
(append-setf (ensure 'list test '()) '(1 2 3))
(push 1 (ensure 'list test '()))

这样就能在变量或者一个 place 的值不是某个类型时给定一个默认值进行运算最后赋值回去。

3.2 more

有时我们会比较两个变量对较大或者较小的一方做出改变。

(define-setf-expander more (op place1 place2 &optional env)
  (let ((meth1 (multiple-value-list (get-setf-expansion place1 env)))
        (meth2 (multiple-value-list (get-setf-expansion place2 env)))
        (new (gensym))
        (cond (gensym)))
    (values (append (first  meth1) (first  meth2) (list cond))
            (append (second meth1) (second meth2)
                    `((funcall ,op ,(fifth meth1) ,(fifth meth2))))
            (list new)
            `(if ,cond
                 (symbol-macrolet ((,(first (third meth1)) ,new))
                   ,(fourth meth1))
                 (symbol-macrolet ((,(first (third meth2)) ,new))
                   ,(fourth meth2)))
            `(if ,cond ,(fifth meth1) ,(fifth meth2)))))

这里由于 get-setf-expansion 对于每个 place 都会返回一个 new 符号，所以导致出现两个符号，这里创建了一个新的符号，使用 symbol-macrolet 进行替换了。

(defvar a 0)
(defvar b 1)
(setf (more #'< a b) 10)

a 被改为 10。

4. 什么时候用 define-setf-expander

这种情况目前来说挺少的，刚才举的 ensure 和 more 共同的特点就是 place 要求在赋值的时候还存在——也就是说可以先试着写 (setf xx) 函数如果发现必须对最开始的 place 进行操作，那么可以尝试去写 define-setf-expander。但是这种情况很少，一般变量往往都在 struct 或者 class 里面直接使用 defun 或 defmethod 创建 (setf xx) 就能解决。

5. 适度编写

除了我刚才提的这些还有一个 defsetf 可以进行 setf 式的宏展开。这就会发现 setf 实际上是一个小系统，它能声明函数也能写宏，这就像 Lisp 本身一样。但是缺点就是很可能导致同伴看不明白，尽可能在编写的时候把副作用都去掉，然后起一个易懂的名字，不要太复杂。

6. 结尾

setf 的“长”并非缺陷，而是一种刻意的留白——它把“如何修改一个位置”抽象成一个可扩展的协议，让 setf 不再是一个死板的关键字，而是由 #'(setf xx)、define-setf-expander、defsetf 等机制共同支撑的统一赋值接口。你可以像操作普通数据一样操作 place，甚至可以组合出 append-setf、union-setf 这类高阶修改器，最终让赋值行为与业务逻辑浑然一体。

这就是 setf 的智慧：它不试图帮你把一切藏进运算符，而是给你一把能随时替换齿轮的扳手。当你真正需要它时，会发现那些看似冗长的字符，每一个都恰如其分。Lisp 的世界里，语法从来不是束缚，setf 如此，其他亦然。