为什么这个符号扩展在 Common Lisp 中是畸形的?

Why this symbol expasion is being malformed in Common Lisp?

我正在尝试使用 SBCL 和 Slime (Emacs) 在这个 tutorial 上做关于 CLOS 的练习。

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

(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 版本。

我有部分实现我的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))

但是,出于某种我不知道的原因,Slime 抛出了错误:

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

为什么会这样?我该如何解决这个问题?

您需要 return 表达式,当代入宏扩展时将调用 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))

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

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

应该return这个结果:

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

你需要 <invisible-variable> 所以你只计算 <object-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)))

嗯,将源代码作为参数和 returns 其他源代码的函数是一个宏。所以,最后,我们需要将这个函数安装为宏扩展器,安排忽略宏函数获得的第二个参数:

(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 以使第一个在编译器中正常工作)。