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

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

Answer 2

“调用”宏的方法是使用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)))

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

2 个答案: