在Common Lisp中使用宏循环生成类的插槽

Question

在做CLOS类时，我遇到了多次相同的模式：

(defclass class-name () 
  ((field-1
      :initarg field-1
      :initform some-value
      :accessor field-1)
   (field-2
      :initarg field-2
      :initform another-value
      :accessor field-2)
   (...)
   (field-n
      :initarg field-n
      :initform n-value
      :accessor field-n)))

（这是否是良好的设计，我将随着时间的推移而学习）

我尝试使用宏来解决这个问题，以便我可以调用：

(defclass-with-accessors 'class-name
   (('field-1 some-value)
    ('field-2 another-value)
    (...)
    ('field-n n-value)))

忽略卫生问题，我的第一个尝试是拆分成两个宏：一个用于创建每个字段，另一个用于创建类本身。

创建访问器字段的宏似乎是正确的：

(defmacro make-accessor-field (name form)
  `(,name
   :initarg ,(make-keyword name)
   :initform ,form
   :accessor ,name))

但是我没有正确理解主要的宏。我的第一次尝试是：

(defmacro defclass-with-accessors (name body)
  `(defclass ,name () \(
     ,(loop for my-slot in body collect
       (make-accessor-field (car my-slot) (cadr my-slot)))))

但是这是无效的，SBCL在defmacro评估时会给我以下错误：

; in: DEFMACRO DEFCLASS-WITH-ACCESSORS
;     (MAKE-ACCESSOR-FIELD (CAR MY-SLOT) (CADR MY-SLOT))
; 
; caught ERROR:
;   during macroexpansion of (MAKE-ACCESSOR-FIELD (CAR MY-SLOT) (CADR MY-SLOT)).
;   Use *BREAK-ON-SIGNALS* to intercept.
;   
;    The value (CAR MY-SLOT)
;    is not of type
;      (OR (VECTOR CHARACTER) (VECTOR NIL) BASE-STRING SYMBOL CHARACTER).
; 
; compilation unit finished
;   caught 1 ERROR condition
STYLE-WARNING:
   redefining COMMON-LISP-USER::DEFCLASS-WITH-ACCESSORS in DEFMACRO

到底发生了什么？当slot甚至没有被定义时，编译器如何确定(car slot)的类型？我该如何继续正确定义这个宏？

- fsanches

---

考虑使用 yasnippet 软件包来解决此问题。 - PuercoPop

我猜每个Lisper在他的职业生涯中都做过类似这样的事情。问题是是否值得在已经相当简洁的标准形式周围引入这样一个薄薄的包装器。 - Svante

Answer 1

基本错误

这个宏是错误的，因为它不应该是一个宏：

(defmacro make-accessor-field (name form)
  `(,name
   :initarg ,(make-keyword name)
   :initform ,form
   :accessor ,name))

宏形式应该扩展为代码。此宏将表单扩展为用于描​​述槽的列表。描​​述槽不是代码，而是defclass插槽列表的一部分。因此，您不能像这样使用宏，因为返回的值应该是代码，而不是槽描述列表。

通常也不会在宏名称中使用MAKE-。那更多的是一种惯例。MAKE-SOMETHING应该是一个函数。每当你创建某些东西时，就会在运行时创建一些东西，因此应该是一个函数。有时候人们也想将make应用于一系列事物，这时候也更倾向于使用函数。

这也是错误的，因为有一个带括号作为其名称的符号：

(defmacro defclass-with-accessors (name body)
  `(defclass ,name () \(    ;  <-  what is this?
     ,(loop for my-slot in body collect
       (make-accessor-field (car my-slot) (cadr my-slot)))))

这段代码也不是一个好主意，因为引号没有用处：

(defclass-with-accessors 'class-name
   (('field-1 some-value)
    ('field-2 another-value)
    (...)
    ('field-n n-value)))

如果你查看defclass，它不需要用引号括起来的名称。因此，在您的defclass变体中，也不应该有引号。

让我们试着改进一下

来自某个想象代码库的示例表格:

(defclass-with-accessors foo
   ((bar 10)
    (baz (sin pi)))

MAKE-ACCESSOR-FIELD现在是一个函数:

(defun make-accessor-field (name form)
  `(,name
    :initarg  ,(intern (symbol-name name) "KEYWORD")
    :initform ,form
    :accessor ,name))

新的DEFCLASS-WITH-ACCESSORS：

(defmacro defclass-with-accessors (name slot-descriptions)
  `(defclass ,name ()
     ,(loop for (slot-name form) in slot-descriptions
            collect (make-accessor-field slot-name form))))

让我们来看一下扩展：

macroexpand-1 在顶层扩展一个表单一次，pprint 以某种自动格式化的方式打印S表达式：

CL-USER 12 > (pprint (macroexpand-1 '(defclass-with-accessors foo
                                         ((bar 10)
                                          (baz (sin pi))))))

(DEFCLASS FOO
          NIL
          ((BAR :INITARG :BAR :INITFORM 10 :ACCESSOR BAR)
           (BAZ :INITARG :BAZ :INITFORM (SIN PI) :ACCESSOR BAZ)))

看起来还不错。

- Rainer Joswig