Macros Common Lisp：定义setf扩展器时最小化代码重复的方法

从这个关于setf扩展器的问题触发：

在为用户定义的getter编写setf expander时，我通常会发现getter和setter中存在代码重复，就如何检索属性而言。例如：

CL-USER>
(defun new-car (lst)
  (car lst))
NEW-CAR
CL-USER> 
(defun (setf new-car) (new-value lst)
  (setf (car lst) new-value))
(SETF NEW-CAR)
CL-USER> 
(defparameter *lst* (list 5 4 3))
*LST*
CL-USER> 
*lst*
(5 4 3)
CL-USER> 
(setf (new-car *lst*) 3)
3
CL-USER> 
*lst*
(3 4 3)
CL-USER> 

注意（car lst）表单，即已经定义了setf扩展器的实际访问器，是如何在两个DEFUN中进行的。这总是让我有点恼火。能够在第一个defun上说，‘嘿，我正在定义一个作为getter的defun，但我也希望它有一个典型的setf扩展器’，这将是一件好事

通用lisp标准有什么方法来表达这一点吗？有没有其他人担心这个问题，并定义了一个宏来实现这一点

需要明确的是，这里我想要的是一种定义getter和典型setter的方法，其中getter编译为已经有setter（（car lst），例如）的公共lisp表单的方法在代码中只编写一次

---

我也知道有时您不想这样做，b/c设置程序需要在设置值之前执行一些副作用。或者它是一个抽象，实际上设置了多个值，或者其他什么。在那种情况下，这个问题就不那么重要了。这里我要说的是setter执行标准操作，只设置getter的位置。

使用宏可以实现您想要的

(defmacro define-place (name lambda-list sexp)
  (let ((value-var (gensym)))
    `(progn
       (defun ,name ,lambda-list
         ,sexp)

       (defun (setf ,name) (,value-var ,@lambda-list)
         (setf ,sexp ,value-var)))))

(define-place new-chr (list)
  (car list))

---

有关宏的更多信息，请参阅Peter Seibel的书。保罗·格雷厄姆（Paul Graham）的书《ANSI Common Lisp》（ANSI Common Lisp）的第10章是另一个参考资料。

您想要的东西可以通过使用宏来实现

(defmacro define-place (name lambda-list sexp)
  (let ((value-var (gensym)))
    `(progn
       (defun ,name ,lambda-list
         ,sexp)

       (defun (setf ,name) (,value-var ,@lambda-list)
         (setf ,sexp ,value-var)))))

(define-place new-chr (list)
  (car list))

---

有关宏的更多信息，请参阅Peter Seibel的书。保罗·格雷厄姆（Paul Graham）的《ANSI Common Lisp》（ANSI Common Lisp）一书的第10章是另一个参考资料。

我从马克的方法、雷纳的文章和阿马洛伊的文章中得出以下结论：

(defmacro with-setters (&body body)
  `(macrolet ((defun-mod (name args &body body)
                `(,@(funcall (macro-function 'defun)
                             `(defun ,name ,args ,@body) nil))))
     (macrolet ((defun (name args &body body)
                  `(progn
                     (defun-mod ,name ,args ,@body)
                     (defun-mod (setf ,name) (new-val ,@args)
                                (setf ,@body new-val)))))
       (progn
         ,@body))))

使用：

Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664)  Port: 4005  Pid: 41757
; SWANK 2012-03-06
CL-USER>
(with-setters
 (defun new-car (lst)
    (car lst))
 (defun new-first (lst)
    (first lst)))
(SETF NEW-FIRST)
CL-USER>
(defparameter *t* (list 5 4 3))
*T*
CL-USER>
(new-car *t*)
5
CL-USER>
(new-first *t*)
5
CL-USER>
(setf (new-first *t*) 3)
3
CL-USER>
(new-first *t*)
3
CL-USER>
*t*
(3 4 3)
CL-USER>
(setf (new-car *t*) 9)
9
CL-USER>
*t*
(9 4 3)

---

在生产代码中使用此宏之前，这里可能需要注意一些变量捕获问题。

根据Mark的方法、Rainer的文章和Amalloy的文章，我得出了以下结论：

(defmacro with-setters (&body body)
  `(macrolet ((defun-mod (name args &body body)
                `(,@(funcall (macro-function 'defun)
                             `(defun ,name ,args ,@body) nil))))
     (macrolet ((defun (name args &body body)
                  `(progn
                     (defun-mod ,name ,args ,@body)
                     (defun-mod (setf ,name) (new-val ,@args)
                                (setf ,@body new-val)))))
       (progn
         ,@body))))

使用：

Clozure Common Lisp Version 1.8-r15286M  (DarwinX8664)  Port: 4005  Pid: 41757
; SWANK 2012-03-06
CL-USER>
(with-setters
 (defun new-car (lst)
    (car lst))
 (defun new-first (lst)
    (first lst)))
(SETF NEW-FIRST)
CL-USER>
(defparameter *t* (list 5 4 3))
*T*
CL-USER>
(new-car *t*)
5
CL-USER>
(new-first *t*)
5
CL-USER>
(setf (new-first *t*) 3)
3
CL-USER>
(new-first *t*)
3
CL-USER>
*t*
(3 4 3)
CL-USER>
(setf (new-car *t*) 9)
9
CL-USER>
*t*
(9 4 3)

在生产代码中使用此宏之前，可能需要注意一些变量捕获问题

注意（car lst）表单，即已经定义了setf扩展器的实际访问器，是如何在两个DEFUN中进行的

但只有在宏观经济扩张之前，这才是明显的事实。在setter中，

（carlst）

表单是赋值的目标。它将扩展到其他方面，比如对类似于

rplaca

的内部函数的调用：

您可以手动执行类似的操作：

(defun new-car (lst)
  (car lst))

(defun (setf new-car) (new-value lst)
  (rplaca lst new-value)
  new-value)

瞧；您不再有对

汽车的重复呼叫

；getter调用

car

，setter调用

rplaca

请注意，我们必须手动返回

新值

，因为

rplaca

返回

lst

您会发现，在许多Lisp中，

car

的内置

setf

扩展器使用一个替代函数（可能名为

sys:rplaca

，或其变体）返回指定的值

在公共Lisp中定义新类型的位置时，我们通常使用的方法是使用

使用此宏，我们将一个新的位置符号与两个项目关联：

• 定义位置语法的宏lambda列表
• 计算和返回信息的代码体，作为五个返回值。这些统称为“

  setf

  expansion”

位置变异宏（如

setf

使用宏lambda列表）来分解位置语法，并调用计算这五部分的代码体。然后使用这五个部分生成位置访问/更新代码

然而，请注意，

setf

扩展的最后两项是存储表单和访问表单。我们无法摆脱这种二元性。如果我们为一个类似于

car

的地方定义

setf

扩展，我们的访问表单将调用

car

，存储表单将基于

rplaca

，确保返回新值，就像在上述两个函数中一样

但是，也可能存在访问和存储之间可以共享重要内部计算的位置

假设我们定义的是

my cadar

，而不是

my car

：

(defun new-cadar (lst)
  (cadar lst))

(defun (setf new-cadar) (new-value lst)
  (rplaca (cdar lst) new-value)
  new-value)

请注意，如果我们这样做（incf（my cadar place）），列表结构的重复遍历是浪费的，因为调用

cadar

获取旧值，然后再次调用

cdar

来计算存储新值的单元格

通过使用难度更高、级别更低的

define setf expander

接口，我们可以使用它，以便在访问表单和存储表单之间共享

cdar

计算。也就是说，

（incf（my cadar x））

将计算

（cadr x）

一次，并将其存储到一个临时变量

：c

。然后，通过访问

（car#：c）

，向其中添加1，并将其与

（rplaca#：c…）

一起存储来进行更新

这看起来像：

(define-setf-expander my-cadar (cell)
  (let ((cell-temp (gensym))
        (new-val-temp (gensym)))
    (values (list cell-temp)       ;; these syms
            (list `(cdar ,cell))   ;; get bound to these forms
            (list new-val-temp)    ;; these vars receive the values of access form
            ;; this form stores the new value(s) into the place:
            `(progn (rplaca ,cell-temp ,new-val-temp) ,new-val-temp)
            ;; this form retrieves the current value(s):
            `(car ,cell-temp))))

测试：

#：G3318

来自

单元格温度

，

#：G3319

是

新的val温度

gensym

但是，请注意，上面只定义了

setf

扩展。有了以上内容，我们只能使用

mycadar

作为一个地方。如果我们试图将其作为函数调用，它就会丢失

注意（car lst）表单，即已经定义了setf扩展器的实际访问器，是如何在两个DEFUN中进行的

但只有在宏观经济扩张之前，这才是明显的事实。在setter中，

（carlst）

表单是赋值的目标。它将扩展到其他方面，比如