为什么这个符号扩展在 Common Lisp 中格式错误？

Question

我正在尝试使用 SBCL 和 Slime 在这个关于 CLOS 的 教程 上进行练习（ Emacs）。

我有这个类、实例和函数来设置插槽的值：

(defclass point ()
  (x y z))

(defvar my-point
  (make-instance 'point))

(defun with-slots-set-point-values (point a b c)
  (with-slots (x y z) point (setf x a y b z c)))

使用 REPL，它工作正常：

CL-USER> (with-slots-set-point-values my-point 111 222 333)

333

CL-USER> (describe my-point)
#<POINT {1003747793}>
  [standard-object]

Slots with :INSTANCE allocation:
  X                              = 111
  Y                              = 222
  Z                              = 333
; No value

现在，练习表明使用 symbol-macrolet 我需要实现我的 版本代码>带槽。

我有我的 with-slots 的部分实现（我仍然需要插入添加操作）：

(defun partial-my-with-slots (slot-list object)
   (mapcar #'(lambda (alpha beta) (list alpha beta))
           slot-list
           (mapcar #'(lambda (var) (slot-value object var)) slot-list)))

调用它时它可以工作：

CL-USER> (partial-my-with-slots '(x y z) my-point)
((X 111) (Y 222) (Z 333))

因为符号宏的这种使用有效：

CL-USER> (symbol-macrolet ((x 111) (y 222) (z 333))
   (+ x y z))
666

我尝试这样做：

CL-USER> (symbol-macrolet (partial-my-with-slots '(x y z) my-point)
   (+ x y z))

但是，对于由于某种我不知道的原因，史莱姆抛出错误：

malformed symbol/expansion pair: PARTIAL-MY-WITH-SLOTS
   [Condition of type SB-INT:SIMPLE-PROGRAM-ERROR]

为什么会发生这种情况？我该如何解决这个问题？

Answer 1

您不能将 with-slots 编写为在运行时调用的函数。相反，它需要是一个将源代码作为参数并返回其他源代码的函数。特别是如果给定这个参数，

(my-with-slots (x ...) <something> <form> ...)

它应该返回这个结果：

(let ((<invisible-variable> <something))
  (symbol-macrolet ((x (slot-value <invisible-variable>)) ...)
    <form> ...))

您需要 因此您只需评估 一次。

好吧，这里有一个函数可以完成大部分工作：

(defun mws-expander (form)
  (destructuring-bind (mws (&rest slot-names) object-form &rest forms) form
    (declare (ignore mws))
    `(let ((<invisible-variable> ,object-form))
       (symbol-macrolet ,(mapcar (lambda (slot-name)
                                    `(,slot-name (slot-value <invisible-variable> 
                                                             ',slot-name)))
                                  slot-names)
         ,@forms))))

你可以检查一下：

> (mws-expander '(my-with-slots (x y) a (list x y)))
(let ((<invisible-variable> a))
  (symbol-macrolet ((x (slot-value <invisible-variable> 'x))
                    (y (slot-value <invisible-variable> 'y)))
    (list x y)))

所以这几乎是正确的，除了不可见变量确实需要不可见：

(defun mws-expander (form)
  (destructuring-bind (mws (&rest slot-names) object-form &rest forms) form
    (declare (ignore mws))
    (let ((<invisible-variable> (gensym)))
      `(let ((,<invisible-variable> ,object-form))
         (symbol-macrolet ,(mapcar (lambda (slot-name)
                                     `(,slot-name (slot-value ,<invisible-variable>
                                                              ',slot-name)))
                                   slot-names)
         ,@forms)))))

现在：

> (mws-expander '(my-with-slots (x y) a (list x y)))
(let ((#:g1509 a))
  (symbol-macrolet ((x (slot-value #:g1509 'x))
                    (y (slot-value #:g1509 'y)))
    (list x y)))

好吧，一个函数将源代码作为参数并返回其他值源代码是一个宏。因此，最后，我们需要将此函数安装为宏扩展器，并安排忽略宏函数获得的第二个参数：

(setf (macro-function 'mws)
      (lambda (form environment)
        (declare (ignore environment))
        (mws-expander form)))

现在：

> (macroexpand '(mws (x y) a (list x y)))
(let ((#:g1434 a))
  (symbol-macrolet ((x (slot-value #:g1434 'x)) (y (slot-value #:g1434 'y)))
    (list x y)))

当然，这将更传统地使用 defmacro 编写：

(defmacro mws ((&rest slot-names) object-form &rest forms)
  (let ((<invisible-variable> (gensym)))
    `(let ((,<invisible-variable> ,object-form))
       (symbol-macrolet ,(mapcar (lambda (slot-name)
                                   `(,slot-name (slot-value ,<invisible-variable> ',slot-name)))
                                 slot-names)
         ,@forms))))

但是这两个定义是等效的（模数需要一些eval-whenery才能使第一个与编译器一起正常工作）。

Answer 2

您需要返回在代入宏扩展时调用slot-value 的表达式，而不是立即调用该函数。反引号对此很有用。

(defun partial-my-with-slots (slot-list object)
   (mapcar #'(lambda (alpha beta) (list alpha beta))
           slot-list
           (mapcar #'(lambda (var) `(slot-value ,object ',var)) slot-list)))
> (partial-my-with-slots '(x y z) 'my-point)
((x (slot-value my-point 'x)) (y (slot-value my-point 'y)) (z (slot-value my-point 'z)))

您可以在 with-slots 宏中使用它，如下所示：

(defmacro my-with-slots ((&rest slot-names) instance-form &body body)
  `(symbol-macrolet ,(partial-my-with-slots slot-names instance-form)
     ,@body))

> (macroexpand '(my-with-slots (x y z) point (setf x a y b z c))) 
(SYMBOL-MACROLET ((X (SLOT-VALUE POINT 'X))
                  (Y (SLOT-VALUE POINT 'Y))
                  (Z (SLOT-VALUE POINT 'Z)))
  (SETF X A
        Y B
        Z C))