定义宏以将 "address" 转换为嵌套的 caar 和 cddrs

Question

我刚刚在学习宏。我发现它们作为一个概念真的很酷，但我仍然很难对它们进行编程，因为这个 post 将充分证明。

我post回答这个问题是因为我无法解决我为自己设置的练习。

基本上，我想定义以下函数的“宏等效”：

(defun fn-get-at (deeply-nested-thing address)
  (if address
      (if (eql (car address) 'l)
          (fn-get-at (caar deeply-nested-thing) (cdr address))
          (fn-get-at (cddr deeply-nested-thing) (cdr address)))
      deeply-nested-thing))

作为如何使用此功能的示例，如果我首先设置

(setf deeply-nested-thing
      '((((((((NIL) N)) O (NIL) P)) Q (((NIL) S)) R))
        T (((NIL) U (NIL) V)) W (((NIL) X)) Y (NIL) Z))

...然后我可以评估 (fn-get-at deeply-nested-thing '(l l r)) 得到 ((NIL) P)。在此示例中，address 参数是列表 '(l l r)，其中 'l 和 'r 分别代表“向左走”和“向右走”。可以将此列表视为一组方向，从某个二叉树的根节点开始¹.

到目前为止，还不错。现在我想定义 macro-get-at，一个 macro 版本的 fn-get-at。使用此宏，表达式 (macro-get-at deeply-nested-thing '(l l r)) 应扩展为 ²

(cddr (caar (caar deeply-nested-thing)))

我的第一次尝试是这样的：

(defmacro macro-get-at (deeply-nested-thing address)
  (if address
      (if (eql (car address) 'l)
          `(macro-get-at (caar ,deeply-nested-thing) ,(cdr address))
          `(macro-get-at (cddr ,deeply-nested-thing) ,(cdr address)))
      deeply-nested-thing))

这没有达到我本已极低的期望。我曾预料

(pprint (macroexpand-1 '(macro-get-at deeply-nested-thing '(l l r))))

...在最坏的情况下，会输出类似

的内容

(MACRO-GET-AT (CAAR DEEPLY-NESTED-THING) '(L R))

相反，我得到了这个：

(MACRO-GET-AT (CDDR DEEPLY-NESTED-THING) ((L L R)))

对我来说，莫名其妙。首先，由于输出有 CDDR 而不是 CAAR，我必须得出结论，macro-get-at 中的 (eql (car address) 'l) 测试评估为 nil；我不明白：相同的测试在 fn-get-at 中表现正确。其次，我无法理解输出中的 ((L L R))。

我的第二次（也是最后一次）尝试是这样的：

(defmacro macro-get-at (deeply-nested-thing address)
  (if address
      (if (eql (car address) 'l)
          `(macro-get-at (caar ,deeply-nested-thing) (cdr ,address))
          `(macro-get-at (cddr ,deeply-nested-thing) (cdr ,address)))
      deeply-nested-thing))

这个结果稍好一些，但仍然是完全错误的。这次的macroexpand-1输出是：

(MACRO-GET-AT (CDDR DEEPLY-NESTED-THING) (CDR '(L L R)))

同样，CDDR 是错误的（虽然这是预料之中的，因为我的新版本根本没有解决这个问题）。展开式中的第二个参数至少在名义上是正确的，但如果模拟递归地展开结果宏表达式，可以看到该过程将是一个无限循环（因为每个展开式的第二个参数将始终为非空）：

* (pprint (macroexpand-1 (macroexpand-1 (macroexpand-1 (macroexpand-1 '(macro-get-at deeply-nested-thing '(l l r)))))))

(MACRO-GET-AT (CDDR (CDDR (CDDR (CDDR DEEPLY-NESTED-THING))))
              (CDR (CDR (CDR (CDR '(L L R))))))

我希望到现在为止，我已经提供了足够的证据来证明我的无能，可以引出一些仁慈的线索。

^{¹ 当然，在这个例子中，至少对我来说，要看到序列“向左转，向左转”一点也不容易,右转”对应((NIL) P).}

^{²注意caar的顺序和cddr的顺序对应的是[=77的顺序=]“地址”的反向 '(l l r).}

Answer 1

您的第一次尝试成功了。

(defparameter *deeply-nested-thing*
      '((((((((NIL) N)) O (NIL) P)) Q (((NIL) S)) R))
        T (((NIL) U (NIL) V)) W (((NIL) X)) Y (NIL) Z))

(defmacro macro-get-at (deeply-nested-thing address)
  (if address
      (if (eql (car address) 'l)
          `(macro-get-at (caar ,deeply-nested-thing) ,(cdr address))
          `(macro-get-at (cddr ,deeply-nested-thing) ,(cdr address)))
      deeply-nested-thing))

CL-USER 14 > (macroexpand '(macro-get-at *deeply-nested-thing* (l l r)))
(CDDR (CAAR (CAAR *DEEPLY-NESTED-THING*)))
T

CL-USER 12 > (macro-get-at *deeply-nested-thing* (l l r))
((NIL) P)

宏不计算它们的参数，因此方向列表必须写成 (l l r)。在递归的每一步中，删除car：

(cdr (l l r)) => (L R)
(cdr (L R)) => (R)
(cdr (R)) => NIL

您使用了 '(l l r)- 这发生在宏内部：

(cdr (quote (l l r)) => ((L L R))
(cdr ((L L R))) => NIL

Answer 2

用宏替换函数在现代 Lisp 中从来都不是一个好主意（它在非常古老的 Lisp 中有一些用途）。宏将源代码转换为其他源代码：宏将语言编译成更简单的语言，它不会对运行时间数据进行操作。

所以你需要考虑的是这个宏将理解什么语言以及它需要发出什么。嗯，它使用的语言是这样的：

某种表达式的名称；
要对该表达式执行的零个或多个单参数操作的名称列表，按照给定的顺序，每个操作的值是下一个操作的参数。

它将生成的语言将是一些执行此操作的 CL 源代码。

那么，好吧，让我们先写一个比你的简单一点的东西。让我们写一个宏，让你说：

(-> thing car cdr cdr)

并将其变为 (cdr (cdr (car thing)))

请注意，这需要任意数量的参数，而不是一个参数和一个必须是操作列表的参数，因为为什么要有额外的无用括号？

另请注意，这有点像 Unix 管道：它通过一系列操作来传输其第一个参数

这是一个执行此操作的宏：对于许多带有 &rest 参数的情况，使用辅助函数完成大部分工作通常很方便：

(defmacro -> (e &body opnames)
  (labels ((expand-> (otail)
             (if (null otail)
                 e
               `(,(first otail) ,(expand-> (rest otail))))))
    (expand-> (reverse opnames))))

另一种在某些方面更好（好吧，我认为是）的实现方式是：

(defmacro -> (e &body opnames)
  (do* ((otail opnames (rest otail))
        (expression (if (not (null otail))
                        `(,(first otail) ,e)
                      e)
                    (if (not (null otail))
                        `(,(first otail) ,expression)
                      expression)))
       ((null otail) expression)))

所以现在我们有了这个东西，但是我们坚持操作名称是函数名称。不过没关系，我们现在可以将它变成非常接近您的 get-at 宏的东西：

(defmacro get-at (thing &body lrs)
  `(-> ,thing ,@(mapcar (lambda (op)
                          (ecase op
                            (l 'caar)
                            (r 'cddr))) lrs)))

现在您同时拥有 get-at 和一个更通用的工具。

Answer 3

函数求解

虽然问题是关于宏的，但完全可以通过函数解决：

(defun get-at (nested-thing commands)
  (let ((result nested-thing)
        (lookup (list (cons 'l #'caar) (cons 'r #'cddr))))
    (loop for c in commands
          do (setf result (funcall (cdr (assoc c lookup)) result))
          finally (return result))))

这个函数就像是迷你 l-r 语言的解释器。

让我们测试一下：

(setf deeply-nested-thing
      '((((((((NIL) N)) O (NIL) P)) Q (((NIL) S)) R))
        T (((NIL) U (NIL) V)) W (((NIL) X)) Y (NIL) Z))


(get-at deeply-nested-thing '(l l r))
;; => ((NIL) P)

宏解决

作为宏，您可以使用 cons 将代码构造为 code:

(defmacro get-at (nested-thing commands)
  (let ((atable '((l . caar) (r . cddr)))
        (code (list nested-thing)))
    (loop for c in commands
          do (setf code (list (cons (cdr (assoc c atable)) code)))
          finally (return (car code)))))

测试一下：

(macroexpand-1 '(get-at deeply-nested-thing (l l r)))
;; (CDDR (CAAR (CAAR DEEPLY-NESTED-THING))) ;
;; T

(get-at deeply-nested-thing (l l r))
;; => ((NIL) P)

定义宏以将 "address" 转换为嵌套的 caar 和 cddrs

Defining macro to convert "address" into nested caar's and cddrs

macros

common-lisp

函数求解

宏解决