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

Question

在 Common Lisp 中，如何定义一个“元宏”，它将宏列表（和其他参数）作为参数并组合这些宏以生成所需的代码。

这个问题相当于写一个“高阶宏”，从其他宏的变量列表中定义一个宏。

提出问题的具体情况对我来说是一个 CLSQL 实验，我想从 CLSQL-testsuite

中重新表达员工 class

(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

“调用”宏的方法是 macroexpand-1:

(defmacro def-view-class-with-traits (class super traits slots
                                      &rest cl-options
                                      &environment env)
  (let ((tslots
           (loop for m in traits
                 append (macroexpand-1 (list* m class super slots options)
                                       env))))
    `(def-view-class ,class ,super (,@tslots ,@slots) ,@cl-options)))

Answer 2

如果您将特征定义为 classes 本身并使用正常继承，我会发现它并不那么令人惊讶：

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

这当然不会使访问器名称依赖于继承 class 的名称，但您真的想要那样吗？我的观点是，这种写法表明这实际上会破坏解耦原则。

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

Macro with a list of macros as argument in Common Lisp

common-lisp

clsql

lisp-macros