macros - 如何快速为一个类(class)创建许多相似的槽位？

Question

我有以下类(class)，以及更多类似的类(class):

(defclass weapon ()
  ((base-slice-damage
    :documentation "Base slice damage dealt by weapon"
    :reader base-slice-damage
    :initform 0
    :initarg :base-slice-damage)
   (base-blunt-damage
    :reader base-blunt-damage
    :initform 0
    :initarg :base-blunt-damage)
   (base-pierce-damage
    :reader base-pierce-damage
    :initform 0
    :initarg :base-pierce-damage)))

(defclass dagger (weapon)
  ((base-slice-damage
    :initform 3)
   (base-pierce-damage
    :initform 6)))

(defclass attack ()
  ((slice-damage-dealt
    :initarg :slice-damage-dealt
    :reader slice-damage-dealt)
   (blunt-damage-dealt
    :initarg :blunt-damage-dealt
    :reader blunt-damage-dealt)
   (pierce-damage-dealth
    :initarg :pierce-damage-dealt
    :reader pierce-damage-dealt)))

正如你所看到的，有很多重复。对于其中两个类别，我的插槽都具有相同的选项，仅根据它们是切片、钝还是刺穿而有所不同。

我考虑过使用宏来定义属性类，然后将它们混合在一起。这是我到目前为止所拥有的:

(defmacro defattrclass (attr-name &body class-options)
  `(defclass ,(symb attr-name '-attr) ()
     ((,attr-name
       ,@class-options))))

但这确实还不够。

---

编辑:

我想出了这个，尽管我对此并不完全满意:

(defmacro defattrclass (attr-name &body class-options)
  `(defclass ,(symb attr-name '-attr) ()
     ((,attr-name
       ,@class-options))))

(defmacro defattrclasses (attr-names &body class-options)
  `(progn
     ,@(loop for attr-name in attr-names collect
            `(defattrclass ,attr-name ,@class-options))))

Answer 1

没有完全 100% 覆盖您想要的功能，但我已经使用这个宏一段时间了:

(defmacro defclass-default (class-name superclasses slots &rest class-options)
  "Shorthand defclass syntax; structure similar to defclass
  Pass three values: slot-name, :initform, and :documentation
  Everything else gets filled in to standard defaults"
  `(defclass 
     ,class-name 
     ,superclasses 
     ,(mapcar (lambda (x) `( ,(first x)
                             :accessor ,(first x)
                             :initarg ,(intern (symbol-name (first x)) "KEYWORD")
                             :initform ,(second x)
                             :documentation ,(third x)))
              slots)
     ,@class-options))

使用:

CL-USER> 
(defclass-default weapon ()
  ((base-slice-damage 0 "Base slice damage dealt by a weapon")
   (base-blunt-damage 0 "Needs a doc")
   (base-pierce-damage 0 "Needs a doc")))
#<STANDARD-CLASS WEAPON>
CL-USER>