《实战Common Lisp》系列主要讲述在使用Common Lisp时能派上用场的小函数，希望能为Common Lisp的复兴做一些微小的贡献。MAKE COMMON LISP GREAT AGAIN。

序言

因为觉得Common Lisp原生的let操作符在许多时候不够好用，我编写了vertical-let。（详情可以参见这篇文章）比起原生的let，vertical-let的优势在于：

有效减少代码的缩进——尤其是嵌套使用let的时候；
方便增减binding，对其余代码的布局没有影响。

除了let，destructuring-bind也是一个常用的声明binding的语法。但如果用在vertical-let中的话，会打乱原有的代码布局。比如原本的代码为

(vertical-let
 :with a = 1
 :with b = 2
 (+ a b))

如果加入destructuring-bind，就会导致从它之后的代码都增加了一级缩进

(vertical-let
 :with a = 1
 :with b = 2
 (destructuring-bind (c) '(3)
   (+ a b c))) ; <- 这一行开始多了一级缩进，之后的代码全都受到影响

我更希望能写成下面这样

(vertical-let
 :with a = 1
 :with b = 2
 :with (c) = '(3)
 (+ a b c))

然而vertical-let目前的实现方式很难支持这种新语法。

在vertical-let内部，将参数分成了“binding”和“form”两种类型，压入到同一个栈中，再逐一弹出处理。如果要支持展开成destructuring-bind，那么：

如果弹出的是“binding”，就需要决定是将其与旧的合并（都是let的binding的情况），还是先处理已有的变量bindings和forms中的内容（这里又涉及到是组成let还是组成destructuring-bind）；
如果弹出的是“form”，也要考虑与上述场景类似的情况。

可想而知，这会让vertical-let的代码膨胀得厉害，并且显得很混乱。因此，必须先优化一番vertical-let。

重构vertical-let

新的思路是：

从尾部开始遍历vertical-let的参数列表；
如果遍历到的元素不是符号:with，就认为是一个可以求值的表达式，将其压栈。显然，这个栈的元素的顺序，与vertical-let的参数列表的顺序是一致的，可以直接用于合成let表达式；
如果遍历到的元素是符号:with，就从栈中弹出三个元素（它们依次是变量名、等号、待求值的表达式）；
将变量名、待求值的表达式，以及栈内所有元素组成只有一个binding的的let表达式，重新压栈。

当参数列表遍历完后，再看看这个栈：

如果只有一个元素，就是vertical-let的展开结果；
否则，将它们作为progn的参数，返回一个progn表达式。

支持destructuring-bind

在上面的算法中，遇到符号:with后只需要构造出let表达式即可。为了支持展开成destructuring-bind，需要根据栈顶元素类型来做不同处理：

如果是cons，就展开为destructuring-bind——毕竟destructuring-bind是无法嵌套的；
如果是symbol，就展开为let（如果栈只有一个元素并且是let表达式，那么可以将新的binding合并进去，减少展开后代码的缩进）。

现在，可以完整地实现vertical-let了

(defun vertical-let/aux (forms)
  "将FORMS转换为基于DESTRUCTURING-BIND和LET*实现的形式。

将:WITH VAR = VAL . FORMS形式的代码转换为(LET* ((VAR VAL)) . FORMS)；
将:WITH (VAR1 VAR2) = VAL . FORMS形式的代码转换为(DESTRUCTURING-BIND (VAR1 VAR2) VAL . FORMS)。"
  (check-type forms list)
  (setf forms (reverse forms))
  (let (form
        (stack '()))
    (block nil
      (loop
         (when (null forms)
           (return-from nil))

         (setf form (pop forms))
         (cond ((eq form :with)
                (let ((place (pop stack)))
                  ;; 下一个元素必须是一个名称为等号的符号
                  (let ((e (pop stack)))
                    (assert (symbolp e))
                    (assert (string= (symbol-name e) "=")))
                  (let ((val (pop stack)))
                    (etypecase place
                      (cons
                       ;; 展开为DESTRUCTURING-BIND
                       (setf stack `((destructuring-bind ,place ,val ,@stack))))
                      (symbol
                       ;; 如果STAKC中仅有一个LET*表达式就将新的绑定合并进去，否则创建新的LET*表达式
                       (cond ((and (= (length stack) 1)
                                   (consp (car stack))
                                   (eq (caar stack) 'let*))
                              (let* ((form (pop stack))
                                     (bindings (second form)))
                                (setf (second form)
                                      `((,place ,val) ,@bindings))
                                (push form stack)))
                             (t
                              (setf stack `((let* ((,place ,val)) ,@stack))))))))
                  ))
               (t
                (push form stack)))))
    
    (if (= (length stack) 1)
        (car stack)
        `(progn ,@stack))))

(defmacro vertical-let* (&body body)
  "不需要不停缩进的LET*"
  (vertical-let/aux body))

后记

除了let和destructuring-bind，Common Lisp还提供了名为multiple-value-bind的宏，用于捕捉从一个函数返回的多个值。如果又要修改vertical-let的话，多半就是为了支持它了吧。