具有宏列表的宏作为Common Lisp中的参数

Question

在Common Lisp中,如何定义一个"元宏",它将宏(和其他参数)列表作为参数,并组合这些宏以生成所需的代码.

这个问题等同于编写一个"高阶宏",它定义了其他宏的变量列表中的宏.

提示问题的具体情况是我对CLSQL的实验,我想从CLSQL-testsuite重新表达员工类

(clsql:def-view-class employee ()
  ((employee-id
    :db-kind :key
    :db-constraints (:not-null)
    :type integer)
   (first-name
    :accessor employee-first-name
    :type (string 30)
    :initarg :first-name)
   (last-name
    :accessor employee-last-name
    :type (string 30)
    :initarg :last-name)
   (email
    :accessor employee-email
    :type (string 100)
    :initarg :email)
   (company-id
     :type integer
     :initarg :company-id)
   (company
    :accessor employee-company
    :db-kind :join
    :db-info (:join-class company
              :home-key companyid
              :foreign-key companyid
              :set nil))
   (manager-id
    :type integer
    :nulls-ok t
    :initarg :manager-id)
   (manager
    :accessor employee-manager
    :db-kind :join
    :db-info (:join-class employee
              :home-key managerid
              :foreign-key emplid
              :set nil))))

如

(def-view-class-with-traits employee ()
  (trait-mapsto-company trait-mapsto-manager)
  ((employee-id
    :db-kind :key
    :db-constraints (:not-null)
    :type integer)
   (first-name
    :accessor employee-first-name
    :type (string 30)
    :initarg :first-name)
   (last-name
    :accessor employee-last-name
    :type (string 30)
    :initarg :last-name)
   (email
    :accessor employee-email
    :type (string 100)
    :initarg :email)))

在定义复杂的数据库模式时,掌握这种技术将有利于一致性和简洁性.

我定义了我需要的两个特征

(defmacro trait-mapsto-company (class super slots &rest cl-options)
  (declare (ignore super slots cl-options))
  (let ((company-accessor-name
          (intern (concatenate 'string (symbol-name class) "-COMPANY"))))
    `((company-id
       :type integer
       :initarg :company-id)
      (company
       :accessor ,company-accessor-name
       :db-kind :join
       :db-info (:join-class company
                 :home-key companyid
                 :foreign-key companyid
                 :set nil)))))

(defmacro trait-mapsto-manager (class super slots &rest cl-options)
  (declare (ignore super slots cl-options))
  (let ((manager-accessor-name
          (intern (concatenate 'string (symbol-name class) "-MANAGER"))))
    `((manager-id
       :type integer
       :initarg :manager-id)
      (manager
       :accessor ,manager-accessor-name
       :db-kind :join
       :db-info (:join-class manager
                 :home-key managerid
                 :foreign-key emplid
                 :set nil)))))

然而,我写def-view-class-with-traits这篇文章的尝试被挫败了.

(defmacro def-view-class-with-traits (class super traits slots &rest cl-options)
  (let ((actual-slots
          (reduce (lambda (trait ax) (append (apply trait class super slots cl-options) ax))
                  traits
                  :initial-value slots)))
    `(clsql:def-view-class ,class ,super ,actual-slots ,@cl-options)))

在用于缩减的lambda中,trait代表一个宏,而我对apply的使用对Lisp没有任何意义 - 这是正确的! - 但希望将我的意图传达给其他程序员.

如何以适当的方式def-view-class-with-traits处理宏列表traits？

Answer 1

如果你将特征定义为类本身并使用普通继承,我会发现它不那么令人惊讶:

(def-view-class trait-mapsto-company ()
  ((company-id
    :type integer
    :initarg :company-id)
   (company
    :accessor company
    :db-kind :join
    :db-info (:join-class company
              :home-key company-id
              :foreign-key company-id
              :set nil))))

(def-view-class trait-mapsto-manager ()
  ((manager-id
    :type integer
    :initarg :manager-id)
   (manager
    :accessor manager
    :db-kind :join
    :db-info (:join-class manager
              :home-key managerid
              :foreign-key emplid
              :set nil)))

(def-view-class employee (trait-mapsto-company trait-mapsto-manager)
  ((employee-id
    :db-kind :key
    :db-constraints (:not-null)
    :type integer)
   (first-name
    :accessor employee-first-name
    :type (string 30)
    :initarg :first-name)
   (last-name
    :accessor employee-last-name
    :type (string 30)
    :initarg :last-name)
   (email
    :accessor employee-email
    :type (string 100)
    :initarg :email)))

这肯定不会使访问者名称依赖于继承类的名称,但你真的想要吗？我的观点是,这种写它的方式表明,这实际上会打破一个解耦原则.