问题描述
我正在编写一个宏以生成Common Lisp中另一个宏使用的代码。但是我对此并不陌生，并且很难构造一个接受列表(bar1 bar2 ... barn)并通过循环产生以下代码的宏。
`(foo,@bar1,@bar2
...,@barn)
我想知道是否可以不使用诸如sbcl中的SB-IMPL::UNQUOTE-SPLICE之类的依赖于实现者的单词来实现。
也许我没有明确说明我的问题。实际上，我想编写一个这样的宏gen-case
(gen-case
(simple-array simple-vector)
('(dotimes ($1 $5)
(when (and (= (aref $4 $2 $1) 1) (zerop (aref $3 $1)))
$0))
'(dolist ($1 (aref $4 $2))
(when (zerop (aref $3 $1))
$0)))
objname body)
产生类似
的东西`(case (car (type-of,objname))
(simple-array,@(progn
(setf temp
'(dotimes ($1 $5)
(when (and (= (aref $4 $2 $1) 1) (zerop (aref $3 $1)))
$0)))
(code-gen body)))
(simple-vector,@(progn
(setf temp
'(dolist ($1 (aref $4 $2))
(when (zerop (aref $3 $1))
$0)))
(code-gen body))))
通常情况下，gen-case接受的列表可能包含两个以上的项目。
我尝试过
``(case (car (type-of,objname)),',@(#|Some codes that produce target codes|#))
但是目标代码被插入到quote块中，因此在调用宏gen-case的宏中引发异常。而且，我无法将,@插入目标代码，因为直接插入会导致“逗号不在反引号内”的异常。
(defmacro DSI-Layer ((obj-name tag-name) &body body)
"Data Structure Independent Layer."
(let ((temp))
(defun code-gen (c)
(if (atom c) c
(if (eq (car c) tag-name)
(let ((args (cadr c)) (codes (code-gen (cddr c))) (flag nil))
(defun gen-code (c)
(if (atom c) c
(if (eq (car c) *arg*)
(let ((n (cadr c)))
(if (zerop n) (progn (setf flag t) codes)
(nth (1- n) args)))
(let ((h (gen-code (car c))))
(if flag
(progn
(setf flag nil)
(append h (gen-code (cdr c))))
(cons h (gen-code (cdr c))))))))
(gen-code temp))
(cons (code-gen (car c)) (code-gen (cdr c))))))
`(case (car (type-of,obj-name))
(simple-array,@(progn
(setf temp
'(dotimes ($1 $5)
(when (and (= (aref $4 $2 $1) 1) (zerop (aref $3 $1)))
$0)))
(code-gen body)))
(simple-vector,@(progn
(setf temp
'(dolist ($1 (aref $4 $2))
(when (zerop (aref $3 $1))
$0)))
(code-gen body))))))
我已经设置了一个阅读宏
(defvar *arg* (make-symbol "ARG"))
(set-macro-character #\$
#'(lambda (stream char)
(declare (ignore char))
(list *arg* (read stream t nil t))))
DSI-Layer的目的是添加一段代码来确定输入参数的类型。例如，代码
(defun BFS (G v)
(let* ((n (car (array-dimensions G)))
(visited (make-array n :initial-element 0))
(queue (list v))
(vl nil))
(incf (aref visited v))
(DSI-Layer (G next-vertex)
(do nil ((null queue) nil)
(setf v (pop queue)) (push v vl)
(next-vertex (i v visited G n)
(setf queue (nconc queue (list i)))
(incf (aref visited i)))))
vl))
将转换为
(defun BFS (G v)
(let* ((n (car (array-dimensions G)))
(visited (make-array n :initial-element 0))
(queue (list v))
(vl nil))
(incf (aref visited v))
(case (car (type-of G))
(simple-array
(do nil ((null queue) nil)
(setf v (pop queue))
(push v vl)
(dotimes (i n)
(when (and (= (aref G v i) 1) (zerop (aref visited i)))
(setf queue (nconc queue (list i)))
(incf (aref visited i))))))
(simple-vector
(do nil ((null queue) nil)
(setf v (pop queue))
(push v vl)
(dolist (i (aref G v))
(when (zerop (aref visited i))
(setf queue (nconc queue (list i)))
(incf (aref visited i)))))))))
现在我只是想知道是否可以通过将类型名称和相应的代码模板传递给另一个宏DSI-Layer来生成gen-case。
顺便说一句，我认为生成的代码的具体含义与我的问题无关。它们只是被视为数据。
解决方法
不要试图使用反引号的内部详细信息。如果您有想要在不同变量中追加的列表，只需将它们追加：
`(foo,@(append b1 b2 ... bn))
如果您在单个变量中有它们的列表（例如，如果它们来自&rest或&body参数），请执行类似的操作
`(foo,@(loop for b in bs
appending b))
我看到了您的问题-您不需要为函数调用
但要使用case进行宏调用。
一个人不能以安全的方式使用动态宏。
一个人必须使用eval，但进行范围界定并不安全。
@tfb和我在this question中回答type-case
漫长的。
上一个答案（此情况不正确）
不需要宏。
`(foo,@bar1,@bar2
...,@barn)
及其结果评估 通过纯函数可以是：
(apply foo (loop for bar in '(bar1 bar2 ... barn)
nconc bar))
nconc或nconcing而非collect将列表融合在一起，在loop中非常有用。 -啊，我看到我以前的回答者使用过append appending-nconc nconcing是“附加”的“破坏性”形式。由于此处会破坏局部变量bar，而在loop形式之外我们不需要，因此此处使用“破坏性”形式是安全的-并且具有性能优势（复制的元素少于使用append时）。这就是为什么我总是绞尽脑汁在nconc中使用append而不是loop的原因。
当然，如果您想获取代码构造，可以这样做
`(foo,@(loop for bar in list-of-lists
nconc bar))
尝试一下：
`(foo,@(loop for bar in '((1 2 3) (a b c) (:a :b :c)) nconc bar))
;; => (FOO 1 2 3 A B C :A :B :C)
所有人的回答启发了我，我提出了解决问题的办法。宏
(defmacro Layer-Generator (obj-name tag-name callback body)
(let ((temp (gensym)) (code-gen (gensym)))
`(let ((,temp))
(defun,code-gen (c)
(if (atom c) c
(if (eq (car c),tag-name)
(let ((args (cadr c)) (codes (,code-gen (cddr c))) (flag nil))
(defun gen-code (c)
(if (atom c) c
(if (eq (car c) *arg*)
(let ((n (cadr c)))
(if (zerop n) (progn (setf flag t) codes)
(nth (1- n) args)))
(let ((h (gen-code (car c))))
(if flag
(progn
(setf flag nil)
(append h (gen-code (cdr c))))
(cons h (gen-code (cdr c))))))))
(gen-code,temp))
(cons (,code-gen (car c)) (,code-gen (cdr c))))))
(list 'case `(car (type-of,obj-name)),@(let ((codes nil))
(dolist (item callback)
(push
`(cons ',(car item)
(progn
(setf,temp,(cadr item))
(,code-gen,body)))
codes))
(nreverse codes))))))
产生与DSI-Layer不同的代码，但是产生与后者产生的代码一致的代码。因为代码
`(case (car (type-of,obj-name))
(tag1,@(#|codes1|#))
(tag2,@(#|codes2|#))
...)
等同于
(list 'case `(car (type-of,obj-name))
(cons 'tag1 (#|codes1|#))
(cons 'tag2 (#|codes2|#))
...)
现在我们可以像Layer-Generator一样使用循环来生成它。