Lisp从零打造一个可扩展的循环宏：do-complex 指南
在 Common Lisp 中，loop 宏对付简单场景很优雅：
(loop for i from 1 to 5 do (print i))
可一旦逻辑变复杂，比如滑动窗口、多序列并行迭代、中途汇聚数据，代码就会迅速膨胀成可读性稍差的“魔法咒语堆”：
(loop for list = '(1 2 3 4 nil 5) then (cdr list)
for first = (first list)
for second = (second list)
while (cdr list) do
(format t "~s~%" (list first second)))
难道我们不能造一个可扩展、可组合、且完全可控的循环宏吗？当然可以。这篇文章会带你从零实现一个名为 do-complex 的循环宏，它既能像 loop 一样简单，又能任意扩展出 :window、:collect 等自定义功能。
基础版：支持 :list 和 :times
我们先从一个简洁的宏开始，它允许指定循环风格（:list 遍历列表，:times 计数循环）：
(defmacro do-complex ((&rest style) &body body)
(destructuring-bind (style-name &rest parameters) style
(ecase style-name
(:list
(destructuring-bind (iter list) parameters
`(loop for ,iter in ,list do (progn ,@body))))
(:times
(destructuring-bind (iter times) parameters
`(loop for ,iter from 0 below ,times do (progn ,@body)))))))
;; 示例
(do-complex (:list i '(1 2 3 4 5))
(format t "~s~%" i))
;; 输出：1 2 3 4 5
(do-complex (:times i 5)
(format t "~s~%" i))
;; 输出：0 1 2 3 4
这只是一个壳，背后依然是 loop。真正的威力来自于用 let* + tagbody 手控循环底层。
使用 let* + tagbody 底层抽象模板
一个通用循环可以拆成四个阶段：
· bindings：初始化变量
· judge-codes：终止条件（不满足时继续）
· next-codes：更新变量的代码
· beg-codes（可选）：每次循环开始时执行的代码
模板如下：
(let* ,bindings
(tagbody
,loop-sym
(unless ,judge-codes
,@body
,next-codes
(go ,loop-sym))))
用这个模板重写 :list 和 :times 版本：
(defmacro do-complex ((&rest style) &body body)
(let ((bindings nil)
(judge-codes nil)
(next-codes nil)
(loop-sym (gensym "loop")))
(destructuring-bind (style-name &rest parameters) style
(ecase style-name
(:list
(destructuring-bind (iter list) parameters
(let ((list-sym (gensym "list")))
(setf bindings `((,list-sym ,list) (,iter (car ,list-sym)))
judge-codes `(not ,list-sym)
next-codes `(setf ,list-sym (cdr ,list-sym)
,iter (car ,list-sym))))))
(:times
(destructuring-bind (iter limit) parameters
(let ((limit-sym (gensym "limit")))
(setf bindings `((,iter 0) (,limit-sym ,limit))
judge-codes `(= ,iter ,limit-sym)
next-codes `(incf ,iter)))))))
`(let* ,bindings
(tagbody
,loop-sym
(unless ,judge-codes
,@body
,next-codes
(go ,loop-sym))))))
测试一下，行为跟之前完全一致，但现在我们拥有了完全的控制权。
多循环同时迭代（OR 逻辑）
loop 可以同时迭代多个序列，只要其中一个结束就终止。我们要让 do-complex 接受多个 style，并用 or 合并所有判断条件：
(defmacro append-setf (var list)
`(setf ,var (append ,var ,list)))
(defmacro do-complex (styles &body body)
(let ((bindings nil)
(judge-codes nil)
(next-codes nil)
(loop-sym (gensym "loop")))
(dolist (style styles)
(destructuring-bind (style-name &rest parameters) style
(ecase style-name
(:list
(destructuring-bind (iter list) parameters
(let ((list-sym (gensym "list")))
(append-setf bindings `((,list-sym ,list) (,iter (car ,list-sym))))
(append-setf judge-codes `((not ,list-sym)))
(append-setf next-codes `((setf ,list-sym (cdr ,list-sym)
,iter (car ,list-sym)))))))
(:times
(destructuring-bind (iter limit) parameters
(let ((limit-sym (gensym "limit")))
(append-setf bindings `((,iter 0) (,limit-sym ,limit)))
(append-setf judge-codes `((= ,iter ,limit-sym)))
(append-setf next-codes `((incf ,iter)))))))))
`(let* ,bindings
(tagbody
,loop-sym
(unless (or ,@judge-codes) ;;模板发生变化
,@body
,@next-codes ;;模板发生变化
(go ,loop-sym))))))
;; 同时迭代列表和计数
(do-complex ((:list i '(1 2 3 4 5))
(:times j 4))
(format t "~s~%" (list i j)))
;; 输出：(1 0) (2 1) (3 2) (4 3) 当 j 达到4 时终止
滑动窗口（:window）
要实现类似 (:window (a b c) '(1 2 3 4 5)) 的滑动窗口，我们需要引入 beg-codes 阶段，每次循环开始时给窗口变量赋值：
(defmacro do-complex (styles &body body)
(let ((bindings nil)
(judge-codes nil)
(next-codes nil)
(beg-codes nil)
(loop-sym (gensym "loop")))
(dolist (style styles)
(destructuring-bind (style-name &rest parameters) style
(ecase style-name
(:list
...) ; 同上
(:times
...)
(:window
(destructuring-bind (elements list) parameters
(let ((list-sym (gensym "list")) (tmp-sym (gensym "tmp")))
(append-setf bindings `((,list-sym ,list)
,tmp-sym
,@(loop for e in elements collect e)))
(append-setf beg-codes `((setf ,tmp-sym ,list-sym)))
(append-setf beg-codes `((setf ,(car elements) (car ,tmp-sym))))
(append-setf beg-codes (loop for e in (cdr elements) collect
`(setf ,tmp-sym (cdr ,tmp-sym)
,e (car ,tmp-sym))))
(append-setf judge-codes `((not ,tmp-sym)))
(append-setf next-codes `((setf ,list-sym (cdr ,list-sym))))))))))
`(let* ,bindings
(tagbody
,loop-sym
,@beg-codes
(unless (or ,@judge-codes)
,@body
,@next-codes
(go ,loop-sym))))))
;; 示例：同时使用 :list, :times 和 :window
(do-complex ((:list i '(1 2 3 4 5))
(:times j 4)
(:window (a b c) '(1 2 3 4 5)))
(format t "~s~%" (list i j (list a b c))))
;; 输出逐渐滑动： (1 0 (1 2 3)) (2 1 (2 3 4)) (3 2 (3 4 5))
;; 滑动窗口最先结束遍历，所以遍历三遍停止
进一步抽象：用 with-codes-collection 整理代码
反复出现的 append-setf 和手动收集代码容易出错。我们可以定义一个辅助宏来简化：
(defmacro with-codes-collection (bindings &body body)
`(let ,(loop for (v nil) in bindings collect v)
(flet ,(loop for (v k) in bindings collect
`(,k (codes)
(append-setf ,v codes)))
,@body)))
然后用它重写 do-complex，代码会清晰很多：
(defmacro do-complex (styles &body body)
(let ((loop-sym (gensym "loop")))
(with-codes-collection ((bindings :bind) (judge-codes :judge)
(next-codes :next) (beg-codes :beg))
(dolist (style styles)
(destructuring-bind (style-name &rest parameters) style
(ecase style-name
(:list
(destructuring-bind (iter list) parameters
(let ((list-sym (gensym "list")))
(:bind `((,list-sym ,list) (,iter (car ,list-sym))))
(:judge `((not ,list-sym)))
(:next `((setf ,list-sym (cdr ,list-sym)
,iter (car ,list-sym)))))))
(:times
(destructuring-bind (iter limit) parameters
(let ((limit-sym (gensym "limit")))
(:bind `((,iter 0) (,limit-sym ,limit)))
(:judge `((= ,iter ,limit-sym)))
(:next `((incf ,iter))))))
(:window
(destructuring-bind (elements list) parameters
(let ((list-sym (gensym "list")) (tmp-sym (gensym "tmp")))
(:bind `((,list-sym ,list)
,tmp-sym
,@(loop for e in elements collect e)))
(:beg `((setf ,tmp-sym ,list-sym)))
(:beg `((setf ,(car elements) (car ,tmp-sym))))
(:beg (loop for e in (cdr elements) collect
`(setf ,tmp-sym (cdr ,tmp-sym)
,e (car ,tmp-sym))))
(:judge `((not ,tmp-sym)))
(:next `((setf ,list-sym (cdr ,list-sym))))))))))
`(let* ,bindings
(tagbody
,loop-sym
,@beg-codes
(unless (or ,@judge-codes)
,@body
,@next-codes
(go ,loop-sym)))))))
添加汇聚操作（Accumulation）
循环往往需要收集结果（如 collect、sum）。这需要引入两个新阶段：macro-bindings 和 return-codes。汇聚操作可以使用 push 最后 nreverse。
(defmacro do-complex (accumulate styles &body body)
(let ((loop-sym (gensym "loop")))
(with-codes-collection ((bindings :bind)
(judge-codes :judge)
(next-codes :next)
(beg-codes :beg)
(macro-bindings :macro)
(return-codes :ret))
;; 处理遍历风格（同上，略）
(dolist (style styles) ...) ; 省略重复代码，见上文
;; 处理汇聚操作
(dolist (acc accumulate)
(destructuring-bind (acc-name &rest parameters) acc
(ecase acc-name
(:collect
(destructuring-bind (mname) parameters
(let ((list-sym (gensym "list")))
(:bind `(,list-sym))
(:macro `((,mname (list)
(list 'push list ',list-sym))))
(:ret `((nreverse ,list-sym)))))))))
`(let* ,bindings
(macrolet ,macro-bindings
(tagbody
,loop-sym
,@beg-codes
(unless (or ,@judge-codes)
,@body
,@next-codes
(go ,loop-sym)))
(values ,@return-codes))))))
;; 使用示例：收集所有 j 的值
(format t "~a~%"
(do-complex ((:collect :clt))
((:list i '(1 2 3 4 5))
(:times j 4)
(:window (a b c) '(1 2 3 4 5)))
(format t "~s~%" (list i j (list a b c)))
(:clt j)))
;; 最后返回 (0 1 2)
总结
通过将循环拆解为 绑定（bind）、开始（beg）、判断（judge）、更新（next）、宏绑定（macro） 和 返回（ret） 等可组合的阶段，我们构造了一个完全自定义、易于扩展的循环宏 do-complex。
这一模式的价值在于：
· 完全控制循环底层——不依赖 loop 的魔法，所有行为都是显式的 tagbody + go。
· 极致的可扩展性——想要新增一种遍历方式（例如 :hash、:ranges）或者汇聚，只需在 ecase 里添加一个分支，定义好各个阶段的代码即可。
· 代码复用性强——with-codes-collection 这类辅助抽象可以应用到其他宏的编写中。
当然，这只是一个教学示例。在实际项目中（https://github.com/cppnb2023/lisp-bpftrace/blob/main/src%2Fdo-varient.lisp ），do-complex 还支持 :first（首次执行）、:main（主体）、:end（末次执行）更丰富的阶段，以及更多遍历类型和汇聚操作。
希望这篇文章能激发你在 Lisp 世界里亲手“造轮子”的兴趣。毕竟从底层一步一步抽象的这个过程真的很好玩。
浙公网安备 33010602011771号