CODEWITHSUNDEEP
common-lispclosmop
leinad
leinad

Reputation: 420

Slot Definition Disappearing when using two metaclasses

I'm trying to define a new slot definition called :has-many and the same time use the definitions provided by mito's metaclass mito:dao-table-class. https://github.com/fukamachi/mito?tab=readme-ov-file#deftable-macro

For some reason, when I add the metaclass I created on a normal object, the slot definition for has-many shows up as expected:

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

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

Here's the slot definition code:

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

However, when doing:

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

The class will either not compile if oql-metaclass has the inheritance to be has-many-meta-class first, saying that :col-type is causing a problem, or if using (the commented out) order of mito's metaclass first in the inheritance list, the code compiles, but upon evaluating the class slots :has-many is not there.

Why is this? How can I work with both of them?

Note I used these answers to get this far:

Upvotes: 1

Views: 82

Answers (1)

leinad
leinad

Reputation: 420

Thanks to @beach for the guidance to this answer.

The problem is that direct-slot-definition-class is not specialized for oql-metaclass. What happens then is that since oql-metaclass inherits from two other classes, the CLOS will find the method that matches the most specialized super class of oql-metaclass. That is why changing the order of the super classes affects the condition raised by the compiler.

The solution is then to further specialize the direct-slot-definition-class method for oql-metaclass to return the correct slot definitions we want. Then we realize that we need a new class for those definitions.

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

Notice that we are here extending mito.dao.column:dao-table-column-class which is not the same class as the metaclass used for mito classes. That is because this is the direct slot definition class. I had to check the source code for mito to find it.

Here is the new specialized method for direct slot definitions:

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

And now we can test it with

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

In the inspector you should be able to see:

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>

Which has both has-many and col-type.

I will further suggest, which is what I'm doing, to have the metaclass be a subclass of the mito metaclass in case there are other consequences of using that metaclass.

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

Upvotes: 1

Related Questions