使用两个元类时槽定义消失

Question

我正在尝试定义一个名为

:has-many

的新槽定义，同时使用 mito 元类

mito:dao-table-class

提供的定义。 https://github.com/fukamachi/mito?tab=readme-ov-file#deftable-macro

由于某种原因，当我添加在普通对象上创建的元类时，

has-many

的插槽定义按预期显示：

(defclass sample-class ()
   ((hello :has-many T))
   (:metaclass oql-metaclass))

(inspect (closer-mop:class-direct-slots (find-class 'sample-class)))

这是插槽定义代码：

(defclass has-many-meta-class (closer-mop:standard-class) ())

(defclass has-many-standard-direct-slot-definition (c2mop:standard-direct-slot-definition)
  ((has-many :initform nil
             :initarg :has-many
             :accessor has-many-slot-value)))

(defclass has-many-standard-effective-slot-definition (closer-mop:standard-effective-slot-definition)
  ((has-many :initform nil
             :initarg :has-many
             :accessor has-many-slot-value)))

(closer-mop:defmethod direct-slot-definition-class ((class has-many-meta-class)
                                                    &rest initargs)
  (find-class 'has-many-standard-direct-slot-definition))

(closer-mop:defmethod effective-slot-definition-class ((class has-many-meta-class)
                                                       &rest initargs)
  (find-class 'has-many-standard-effective-slot-definition))

(closer-mop:defmethod validate-superclass ((class has-many-meta-class)
                                           (superclass closer-mop:standard-class))
  t)

;; (defclass oql-metaclass (mito:dao-table-class
;;                          has-many-meta-class)
;;   ())

(defclass oql-metaclass (has-many-meta-class mito:dao-table-class)
  ())

但是，在做的时候：

(defclass new-model () 
  ((author :has-many T :col-type :null))
  (:metaclass oql-metaclass))

如果

oql-metaclass

的继承首先是

has-many-meta-class

，则该类将不会编译，表示

:col-type

导致了问题，或者如果在继承列表中首先使用 mito 元类的（注释掉的）顺序，则代码可以编译，但在评估类槽时

:has-many

不存在。

这是为什么呢？我怎样才能与他们一起工作？

注意我使用这些答案来达到此目的：

• 插槽定义的附加属性
• Common Lisp 多个元类

Answer 1

感谢 @beach 对此答案的指导。

问题是

direct-slot-definition-class

不是专门针对

oql-metaclass

的。然后发生的事情是，由于

oql-metaclass

继承自其他两个类，CLOS 将找到与

oql-metaclass

最专业的超类相匹配的方法。这就是为什么更改超类的顺序会影响编译器引发的条件。

解决方案是进一步专门化direct-slot-definition-class

方法，让

oql-metaclass

返回我们想要的正确的槽定义。然后我们意识到我们需要一个新的类来定义这些定义。

(defclass oql-standard-direct-slot-definition 
   (mito.dao.column:dao-table-column-class 
    has-many-standard-direct-slot-definition)
  ())

请注意，我们在这里扩展

mito.dao.column:dao-table-column-class

，它与用于 mito 类的元类

不是同一个类。那是因为这是直接槽定义类。我必须检查 mito 的源代码才能找到它。

这是直接槽定义的新专用方法：

(defmethod closer-mop:direct-slot-definition-class ((class oql-metaclass)
                                                    &rest initargs)
  (find-class 'oql-standard-direct-slot-definition))

现在我们可以用

来测试它

(defclass oql-class-2 ()
  ((a :ghost T :has-many T))
  (:metaclass oql-metaclass))

(inspect (find-class 'oql-class-2))
(inspect (closer-mop:class-direct-slots (find-class 'oql-class-2)))

在检查器中您应该能够看到：

CL-USER> (closer-mop:class-direct-slots (find-class 'oql-class-2))
(#<OQL-STANDARD-DIRECT-SLOT-DEFINITION COMMON-LISP-USER::A>)
CL-USER> (inspect (closer-mop:class-direct-slots (find-class 'oql-class-2)))

The object is a CONS.
0. CAR: #<OQL-STANDARD-DIRECT-SLOT-DEFINITION COMMON-LISP-USER::A>
1. CDR: NIL
> 0

The object is a STANDARD-OBJECT of type OQL-STANDARD-DIRECT-SLOT-DEFINITION.
0. SOURCE: #S(SB-C:DEFINITION-SOURCE-LOCATION :NAMESTRING NIL :INDICES 0)
1. NAME: A
2. INITFORM: NIL
3. INITFUNCTION: NIL
4. INITARGS: (:A)
5. %TYPE: T
6. %DOCUMENTATION: NIL
7. %CLASS: #<OQL-METACLASS COMMON-LISP-USER::OQL-CLASS-2>
8. READERS: NIL
9. WRITERS: NIL
10. ALLOCATION: :INSTANCE
11. ALLOCATION-CLASS: NIL
12. HAS-MANY: T
13. COL-TYPE: NIL
14. REFERENCES: NIL
15. PRIMARY-KEY: NIL
16. GHOST: T
17. INFLATE: #<unbound slot>
18. DEFLATE: #<unbound slot>

同时具有

has-many

 和 

col-type

。

我将进一步建议，这就是我正在做的事情，让元类成为 mito 元类的子类，以防使用该元类产生其他后果。

(defclass oql-metaclass (mito:dao-table-class)
  ())