0

我正在编写一个宏来生成 Common Lisp 中另一个宏使用的代码。但是我对此很陌生，并且很难构建一个接收列表(bar1 bar2 ... barn)并通过循环生成以下代码的宏。

`(foo
   ,@bar1
   ,@bar2
     ...
   ,@barn)

我想知道这是否可以在不涉及依赖SB-IMPL::UNQUOTE-SPLICE于实现的单词（例如 sbcl）的情况下实现。

也许我没有对我的问题给出明确的描述。事实上，我想写一个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通过将类型名称和相应的代码模板传递给它来从另一个宏生成。

顺便说一句，我认为生成代码的具体含义在我的问题中并不重要。它们只是被视为数据。

4

3 回答 3

1

不要试图使用反引号的内部细节。如果您有要附加到不同变量中的列表，只需附加它们：

`(foo
  ,@(append b1 b2 ... bn))

如果您在某个变量中有它们的列表（例如，如果它们来自一个&rest或&body参数），那么执行类似的操作

`(foo
  ,@(loop for b in bs
          appending b))
于 2020-10-14T08:18:56.657 回答
0

我看到了您的问题-您不需要它来进行函数调用，而是使用case.

不能以安全的方式使用动态宏。一个人必须使用eval，但它对范围界定是不安全的。

@tfb 和我在这个问题上回答了很长时间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)
于 2020-10-15T08:54:28.460 回答
0

你们所有人的回答启发了我，我想出了一个解决我的问题的方法。宏

(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那样。

于 2020-10-20T13:58:53.957 回答