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

Question

While making classes on CLOS I've met the same pattern multiple times:

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

(whether this is good design is something I'll learn with time)

I've tried to tackle this with a macro so I could call, say:

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

My first tackle (ignoring hygiene for now) was to split into two macros: one to make each field, other to make the class itself.

The macro to make the accessor fields seems to be correct:

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

But I'm not getting the main macro right. My first attempt was:

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

But this isn't valid, SBCL giving me the following error at the defmacro evaluation:

; 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

What's happening exactly? How can the compiler tell the type of (car slot) when slot isn't even defined? How can I proceed to correctly define this macro?

Answer 1

The basic mistakes

This macro is wrong, because it should not be a macro:

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

Macro forms should expand into code. This macro expands a form into a list used for a slot description. A slot description is not code, but a part of the defclass slots list. Thus you can't use a macro like this, because the value returned should be code, not a slot description list.

Also one usually would not use MAKE- in a macro name. That's more a convention. MAKE-SOMETHING should be a function. Whenever you make something, there is something being created at runtime and thus it should be a function. Sometimes one also wants to apply make to a list of things and then again, a function is preferred.

This also is wrong, because there is a symbol with a parenthesis as its name:

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

This code is also not a good idea, because the quotes are not useful:

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

If you look at defclass , it does not need quoted names. Thus in your defclass variant, there should be no quotes either.

Let's try to improve it

Example form from some imaginary code base:

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

MAKE-ACCESSOR-FIELD is now a function:

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

The new 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))))

Let's check the expansion:

macroexpand-1 expands a form once at the toplevel and pprint prints the s-expression in some automagically formatted way:

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

Looks okay.