Lisp从零打造一个可扩展的循环宏：`do-complex` 指南

isp从零打造一个可扩展的循环宏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的魔法所有行为都是显式的tagbodygo。· 极致的可扩展性——想要新增一种遍历方式例如:hash、:ranges或者汇聚只需在ecase里添加一个分支定义好各个阶段的代码即可。· 代码复用性强——with-codes-collection这类辅助抽象可以应用到其他宏的编写中。