我还记得我最开始学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. 定义组合式setf2.1append-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.2union-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.3define-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.1ensure通常我们会写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-setfunion-setf就不一样了。(incf (ensure integer test 0)) (append-setf (ensure list test ()) (1 2 3)) (push 1 (ensure list test ()))这样就能在变量或者一个place的值不是某个类型时给定一个默认值进行运算最后赋值回去。3.2more有时我们会比较两个变量对较大或者较小的一方做出改变。(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