问题描述
我正在学习（通用）Lisp，作为练习，我想实现“xond”，一个 cond 宏，来改变这个愚蠢的例子：
(xond (= n 1) (setq x 2) (= n 2) (setq x 1))
进入一个 if-else 链：
(if (= n 1) (setq x 2) (if (= n 2) (setq x 1)))
目前，我有这个宏：
(defmacro xond (&rest x) (if x (list 'progn (list 'if (pop x) (pop x)))))
仅展开 x 中的前两项：
(macroexpand '(xond (= x 1) (setq y 2)))
生产
(PROGN (IF (= X 1) (SETQ Y 2))) ;
现在我想处理 x 中的所有项目，所以我添加了一个 loop 来生成一个 if-serie（迈向 if-else-version 的一步）：
(defmacro xond (&rest x)
(loop (if x
(list 'progn (list 'if (pop x) (pop x)))
(return t))))
但随后宏似乎停止工作：
(macroexpand '(xond (= x 1) (setq y 2)))
T ;
我在这里缺少什么？
版本
verdammelt 的回答让我走上了正轨，而 coredump 的回答让我改变了迭代方法。
现在我将 (xond test1 exp1 test2 exp2) 实现为：
(block nil
test1 (return exp1)
test2 (return exp2)
)
这可以通过迭代来完成。
我是为我的最小 Lisp 解释器写的；我只实现了最基本的功能。
这是我写的。我正在使用 la 来累积输出的各个部分。
(defmacro xond (&rest x)
(let ((la '()))
(loop
(if x (push (list 'if (pop x) (list 'return (pop x))) la)
(progn (push 'nil la)
(push 'block la)
(return la)
)))))
与
(macroexpand '(xond (= x 1) (setq y 2) (= X 2) (setq y 1)))
结果：
(BLOCK NIL
(IF (= X 2) (RETURN (SETQ Y 1)))
(IF (= X 1) (RETURN (SETQ Y 2)))
) ;
第二版
为 block 添加标签并将 return 更改为 return-from，以避免与其他 return 内部参数发生冲突。还将 push 更改为 append 以生成与参数相同顺序的代码。
(defmacro xond (&rest x)
(let ((label (gensym)) (la '()) (condition nil) (expresion nil))
(setq la (append la (list 'block label)))
(loop
(if x
(setq la (append la (list
(list 'if (pop x) (list 'return-from label (pop x))))))
(return la)))))
所以
(macroexpand '(xond (= x 1) (setq y 2) (= X 2) (setq y 1)))
现在给
(BLOCK #:G3187 (IF (= X 1) (RETURN-FROM #:G3187 (SETQ Y 2))) (IF (= X 2) (RETURN-FROM #:G3187 (SETQ Y 1))))
解决方法
一些备注
- 当您只扩展为单个
progn时，您不需要if - 使用
pop可能会让读者（以及程序员）感到困惑，因为它改变了一个地方，也许您想从一种不太必要的方法开始
此外，在这种情况下，我认为 loop 方法没有帮助，因为您需要将 after 后面的表达式嵌套在 inside 正文中> 以前构建的表单，尽管可以完成，但仅通过递归函数或“递归”宏来完成它有点复杂。
这里我解释了这两种方法，从“递归”宏开始（这里的引用是因为宏不调用自身，而是扩展为对自身的调用）。
宏扩展固定点
如果我必须实现 xond，我会编写一个宏来扩展到其他对 xond 的调用，直到宏扩展达到没有更多 xond 的基本情况：>
(defmacro xond (&rest body)
(if (rest body)
(destructuring-bind (test if-action . rest) body
`(if,test,if-action (xond,@rest)))
(first body)))
例如这个表达式：
(xond (= n 1) (setq x 2) (= n 2) (setq x 1))
第一个宏扩展为：
(if (= n 1)
(setq x 2)
(xond (= n 2) (setq x 1)))
并最终达到一个固定点：
(if (= n 1)
(setq x 2)
(if (= n 2)
(setq x 1)
nil))
小心，你不能在 xond 的定义中直接使用 xond，发生的情况是宏 expands 作为对 xond 的调用， Lisp 然后再次扩展。如果您不小心，最终可能会得到无限的宏展开，这就是为什么您需要一个基本情况，其中宏不展开为 xond。
调用递归函数的宏
或者，您可以在宏内部调用递归函数，并一次展开所有内部形式。
使用 LABELS，您将 xond-expand 绑定到递归函数。这是一个实际的递归方法：
(labels ((xond-expand (body)
(if body
(list 'if
(pop body)
(pop body)
(xond-expand body))
nil)))
(xond-expand '((= n 1) (setq x 2) (= n 2) (setq x 1))))
; => (IF (= N 1)
; (SETQ X 2)
; (IF (= N 2)
; (SETQ X 1)
; NIL))
您的 xond 宏以 (return t) 结尾，因此它的计算结果为 t 而不是您累积的 if 表达式。
您可以使用 loop 的 collect 子句来累积您希望返回的代码。例如：(loop for x in '(1 2 3) collect (* 2 x)) 的计算结果为 (2 4 6)。
怎么样
(ql:quickload :alexandria)
(defun as-last (l1 l2)
`(,@l1,l2))
(defmacro xond (&rest args)
(reduce #'as-last
(loop for (condition . branch) in (alexandria:plist-alist args)
collect `(if,condition,branch))
:from-end t))
(macroexpand-1 '(xond c1 b1 c2 b2 c3 b3))
;; (IF C1 B1 (IF C2 B2 (IF C3 B3))) ;
;; T
alexandria 的 plist-alist 用于配对参数，
loop 中用于提取条件和分支的内在解构。
辅助函数 as-last 将列表堆叠在一起
(a b c) (d e f) => (a b c (d e f))。
(reduce ... :from-end t) 将收集到的 (if condition branch) 子句的序列右折叠，使用 #'as-last 将它们堆叠在一起。
无任何依赖
('不过，alexandria 是否也算作依赖？;) )
(defun pairs (l &key (acc '()) (fill-with-nil-p nil))
(cond ((null l) (nreverse acc))
((null (cdr l)) (pairs (cdr l)
:acc (cons (if fill-with-nil-p
(list (car l) nil)
l)
acc)
:fill-with-nil-p fill-with-nil-p))
(t (pairs (cdr (cdr l))
:acc (cons (list (car l) (cadr l)) acc)
:fill-with-nil-p fill-with-nil-p))))
(defun as-last (l1 l2)
`(,l2))
(defmacro xond (&rest args)
(reduce #'as-last
(loop for (condition branch) in (pairs args)
collect `(if,branch))
:from-end t))
(macroexpand-1 '(xond c1 b1 c2 b2 c3 b3))
;; (IF C1 B1 (IF C2 B2 (IF C3 B3))) ;
;; T
辅助函数 pairs 由 (a b c d e f) => ((a b) (c d) (e f)) 组成。
(:fill-with-nil-p 确定在列表元素为奇数的情况下，最后一个元素将被列出 (last-el) 或 (last-el nil) - 在后一种情况下填充 nil) .