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

时间:2015-08-29 02:00:45

标签: loops macros common-lisp clos

在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

到底发生了什么?当插槽甚至没有定义时,编译器如何告诉(汽车插槽)的类型?如何继续正确定义此宏?

1 个答案:

答案 0 :(得分:12)

基本错误

这个宏是错误的,因为它不应该是一个宏:

(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变体中,也不应该有引号。

让我们尝试改进它

来自某个虚构代码库的 form 示例:

(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)))

看起来没问题。