[MOP] defmethod should accept the subtype of mop:specializer as its specializer

[bohonghuang]

Hi! Learning MOP these days, I tried evaluating the following in REPL:

(ql:quickload :closer-mop)

(in-package #:c2cl-user)

(defclass my-spec (specializer) 
  (#| ... |#))

(defparameter *my-spec* (make-instance 'my-spec))

(defclass my-generic-function (standard-generic-function)
  ()
  (:metaclass funcallable-standard-class)
  (:default-initargs :method-class (find-class 'standard-method)))

;;; ...

(defgeneric foo (obj)
  (:generic-function-class my-generic-function))

(defmethod foo ((obj #.*my-spec*)) t)

which seems legal to do in MOP, but ABCL emitted this error:

Unknown specializer: #<MY-SPEC {54ED018C}>

Tried in SBCL, CCL, and ECL, the code seems to work without problems. Any help on this?

[alanruttenberg]

I haven't used this facility of CLOS, so was surprised you could do this. I looked in a version of the AMOP book I have and I don't see specializer metaobjects except as an informal term. What's the most up-to-date reference for the MOP?

[bohonghuang]

@alanruttenberg I was also reading AMOP, but I found a paper mentioning the possibility of defining custom specialized using MOP. It seems to work on most implementations supported by closer-mop.

[alanruttenberg]

Thanks @bohonghuang, I'll have a look.

[alanruttenberg]

I did a couple of patches but I'm stuck on

The slot system:direct-methods is missing from the class #<standard-class my-spec {47F8EC15}>.

I then tried the code in SBCL and I get a similar error

When attempting to read the slot's value (slot-value), the slot
SB-PCL::DIRECT-METHODS is missing from the object
#<MY-SPEC {100370B923}>.

My SBCL is 2.1.11 and *features* is

(:CLOSER-MOP :SWANK :QUICKLISP :QUICKLISP-SUPPORT-HTTPS :ASDF3.3 :ASDF3.2
 :ASDF3.1 :ASDF3 :ASDF2 :ASDF :OS-MACOSX :OS-UNIX :NON-BASE-CHARS-EXIST-P
 :ASDF-UNICODE :ROS.INIT :X86-64 :GENCGC :64-BIT :ANSI-CL :BSD :COMMON-LISP
 :DARWIN :IEEE-FLOATING-POINT :LITTLE-ENDIAN :MACH-O :PACKAGE-LOCAL-NICKNAMES
 :SB-CORE-COMPRESSION :SB-LDB :SB-PACKAGE-LOCKS :SB-THREAD :SB-UNICODE :SBCL
 :UNIX)

Thoughts?

[bohonghuang]

I apologize for my carelessness. SBCL needs slot sb-pcl::direct-methods, while other implementations do not, which is omitted in my code:

;; ...
(defclass my-spec (specializer) 
  ((sb-pcl::direct-methods :initform (cons nil nil))))
;; ...

[alanruttenberg]

I might try to implement this, as I've been playing around inside CLOS for another project. But there's more to it than just making it possible to specialize specializer. Do you have a full test case - defining the new specializer and then verifying that the specializer can be successfully be used in dispatching? I'm scanning closer-mop and it's not looking like there's a lot of mechanism for implementing it, and I'd be surprised if all the lisps implemented it internally. E.g. the methods defined in the dictionary section of the paper aren't in closer-mop or my sbcl, and the paper says:

Firstly, initial explorations revealed that current Common Lisp implementations have only partial support for subclassing mop:specializer; most implementations will allow defining the subclass, but very few recognize such a subclass as a valid specializer

[bohonghuang]

The following code is tested on SBCL, CCL, and ECL:

(ql:quickload :closer-mop)

(in-package #:c2cl-user)

(defclass fixnum>= (specializer) 
  (#+sbcl (sb-pcl::direct-methods :initform (cons nil nil) :allocation :class)
   (number :type fixnum :initarg :number :initform most-negative-fixnum)))

(defmethod make-load-form ((spec fixnum>=) &optional env)
  (declare (ignore env))
  (make-load-form-saving-slots spec))

(defun fixnum>= (spec n)
  (and (typep n 'fixnum) (>= n (slot-value spec 'number))))

(defun fixnum>=-compare (spec-a spec-b)
  (> (slot-value spec-a 'number) (slot-value spec-b 'number)))

(defclass range-generic-function (standard-generic-function)
  ()
  (:metaclass funcallable-standard-class)
  (:default-initargs :method-class (find-class 'standard-method)))

(defmethod compute-applicable-methods-using-classes ((function range-generic-function) classes)
  (declare (ignore function classes))
  (values nil nil))

(defmethod compute-applicable-methods ((function range-generic-function) args)
  (let ((applicable-methods (remove-if-not (lambda (method)
                                             (every #'fixnum>= (method-specializers method) args))
                                       (generic-function-methods function))))
    (values (sort applicable-methods
                  (lambda (method-a method-b)
                    (fixnum>=-compare (first (method-specializers method-a)) ; For simplicity, we only sort the applicable methods by their first arguments.
                                      (first (method-specializers method-b)))))
            t)))

(defmacro define-range-method (name lambda-list &body body) ; Unlike the default specializers provided by CL which are parsed in `defmethod', a (reader) macro is required for custom specializers to be created at compile time.
  `(defmethod ,name ,(mapcar (lambda (spec)
                               (if (and (listp spec)
                                        (second spec)
                                        (listp (second spec))
                                        (eql (first (second spec)) 'fixnum>=))
                                   (list (first spec)
                                         (make-instance 'fixnum>= :number (second (second spec))))
                                   spec))
                      lambda-list)
     ,@body))

(defgeneric foo (number)
  (:generic-function-class range-generic-function))

(define-range-method foo ((number (fixnum>= 0)))
  (list 0))

(define-range-method foo ((number (fixnum>= 10)))
  (cons 10 (call-next-method)))

(define-range-method foo ((number (fixnum>= 100)))
  (cons 100 (call-next-method)))

(foo -1)                                ; NO-APPLICABLE-METHOD

(foo 5.0)                               ; NO-APPLICABLE-METHOD

(foo 5)                                 ; => (0)

(foo 50)                                ; => (10 0)

(foo 500)                               ; => (100 10 0)

[alanruttenberg]

This is a patch for clos.lisp you can try. Seems to work, at least for this case. For the moment you also need to define class-name, because I didn't want to mess around with print-object to handle non-classes.

Note that here and in SBCL if you redefine one of those methods the old one is not removed. So if you define the fixnum>=10 a second time then (foo 500) will get (100 10 10 1).

I also had to tweak the class definition to add the direct-methods slot and make-load-form to not try to dump the methods, which will be updated when foo is defined.

Let me know if this does what you want.

(defclass fixnum>= (specializer) 
  (#+sbcl (sb-pcl::direct-methods :initform (cons nil nil) :allocation :class)
   #+abcl (sys::direct-methods :initform nil :allocation :class)
   (number :type fixnum :initarg :number :initform most-negative-fixnum)))

(defmethod make-load-form ((spec fixnum>=) &optional env)
  (declare (ignore env))
  #+abcl (make-load-form-saving-slots spec :slot-names '(number))
  #+sbcl (make-load-form-saving-slots spec  ))

(defmethod class-name ((f fixnum>=))
  `(fixnum>= ,(slot-value f 'number)))

@@ -1939,6 +1939,8 @@ compare the method combination name to the symbol 'standard.")
               (eq (car specializer) 'java:jclass))
          (let ((jclass (eval specializer)))
            (java::ensure-java-class jclass)))
+        ((typep specializer 'specializer) ;; specializer fix 
+         specializer)
         (t
          (error "Unknown specializer: ~S" specializer))))
 
@@ -2248,13 +2250,13 @@ Initialized with the true value near the end of the file.")
 ;;; To be redefined as generic functions later
 (declaim (notinline add-direct-method))
 (defun add-direct-method (specializer method)
-  (if (typep specializer 'eql-specializer)
+  (if (or (typep specializer 'eql-specializer) (typep specializer 'specializer)) ;; specializer fix
       (pushnew method (std-slot-value specializer 'direct-methods))
       (pushnew method (class-direct-methods specializer))))
 
 (declaim (notinline remove-direct-method))
 (defun remove-direct-method (specializer method)
-  (if (typep specializer 'eql-specializer)
+  (if (or (typep specializer 'eql-specializer) (typep specializer 'specializer)) ;; specializer fix
       (setf (std-slot-value specializer 'direct-methods)
             (remove method (std-slot-value specializer 'direct-methods)))
       (setf (class-direct-methods specializer)
@@ -2568,7 +2570,8 @@ to ~S with argument list ~S."
             (setf emfun
                   (wrap-emfun-for-keyword-args-check gf emfun non-keyword-args
                                                      applicable-keywords)))
-          (cache-emf gf args emfun)
+          (when (eq (class-of gf) 'standard-generic-function) ; specializer fix. Cache only understands classes and eql specializers
+              (cache-emf gf args emfun))
           (funcall emfun args))
         (apply #'no-applicable-method gf args))))

[bohonghuang]

Thanks! It works exactly as I expect. It would be awesome if this becomes available in the next version of ABCL.

[easye]

I'd take this as part of abcl-1.9.1, but we should document such behavior in the fine manual. A patch would be welcome…

[easye]

I could use some help getting Alan's test code to work.

I've packaged a version as https://github.com/armedbear/abcl/pull/551/files#diff-97e13c2383d3a39b26c31d5a8b3c44a1ed79befd32c2a1c4c364510b13625c52 in the pull request associated with this ticket.

For ABCL, I get an error

Can't compute class precedence list for class #<STANDARD-CLASS FIXNUM>= {32276D39}> which depends on forward referenced class #<SYSTEM:FORWARD-REFERENCED-CLASS SPECIALIZER {5ECB257C}>.

For SBCL, there is a problem getting the right syntax for sb-pcl::direct-methods (which should be using sb-mop in any case).

@bohonghuang or @alanruttenberg could you take a look, please?

[bohonghuang]

@bohonghuang or @alanruttenberg could you take a look, please?

@easye It seems that some symbols like specializer are not imported in package cl-user, so the following modifications should make the code work:

- (defclass fixnum>= (specializer)
+ (defclass fixnum>= (mop:specializer)
  ((number :type fixnum :initarg :number :initform most-negative-fixnum)))

(defmethod compute-applicable-methods ((function range-generic-function) args)
  (let ((applicable-methods (remove-if-not (lambda (method)
-                                             (every #'fixnum>= (method-specializers method) args))
-                                           (generic-function-methods function))))
+                                             (every #'fixnum>= (mop:method-specializers method) args))
+                                           (mop:generic-function-methods function))))
    (values (sort applicable-methods
                  (lambda (method-a method-b)
                    (fixnum>=-compare
                     ;; For simplicity, we only sort the applicable methods by their first arguments.
-                     (first (method-specializers method-a)) 
-                     (first (method-specializers method-b)))))
+                     (first (mop:method-specializers method-a)) 
+                     (first (mop:method-specializers method-b)))))
            t)))

[easye]

@bohonghuang or @alanruttenberg could you take a look, please?

@easye It seems that some symbols like specializer are not imported in package cl-user, so the following modifications should make the code work:

Supposedly the evaluation of the progn wrapping the test is in the closer-common-mop-user package, where all this has been appropiately encapsulated by CLOSER-MOP.

But I will try your patch. Does this test execute for you?

   (unless (asdf:make :abcl-prove/closer-mop)
     (asdf:make :quicklisp-abcl)
     (ql:quickload :abcl-prove/closer-mop))
   (asdf:test-system :abcl-prove/closer-mop)

[easye]

@bohonghuang or @alanruttenberg could you take a look, please?

@easye It seems that some symbols like specializer are not imported in package cl-user, so the following modifications should make the code work:

Still not working, I get with d80ea0b

     No primary methods for the generic function #<STANDARD-GENERIC-FUNCTION MOP:ADD-DIRECT-METHOD {3914B91E}>.
        [Condition of type SIMPLE-ERROR]

     Restarts:
      0: [SKIP-TEST-FILE] Skip this test file.
      1: [SKIP-ALL-TEST-FILES] Give up all test files.
      2: [RETRY] Retry #<ASDF/LISP-ACTION:TEST-OP > on #<ASDF/SYSTEM:SYSTEM "abcl-prove/closer-mop">.
      3: [ACCEPT] Continue, treating #<ASDF/LISP-ACTION:TEST-OP > on #<ASDF/SYSTEM:SYSTEM "abcl-prove/closer-mop"> as having been successful.
      4: [RETRY] Retry ASDF operation.
      5: [CLEAR-CONFIGURATION-AND-RETRY] Retry ASDF operation after resetting the configuration.
      --more--

     Backtrace:
       0: (INVOKE-DEBUGGER #<SIMPLE-ERROR {3572B9D3}>)
       1: (MOP::STD-COMPUTE-EFFECTIVE-METHOD #<STANDARD-GENERIC-FUNCTION MOP:ADD-DIRECT-METHOD {3914B91E}> #<METHOD-COMBINATION STANDARD {5262F35B}> (#<STANDARD-METHOD MOP:ADD-DIRECT-METHOD :AFTER (T T) {CB7785..
       2: (MOP:ADD-DIRECT-METHOD #<CLOSER-COMMON-LISP-USER::FIXNUM>= {47740D0}> [error printing frame]
       3: (MOP::STD-ADD-METHOD #<CLOSER-COMMON-LISP-USER::RANGE-GENERIC-FUNCTION CLOSER-COMMON-LISP-USER::FOO {7D10D70E}> [error printing frame]
       4: (ADD-METHOD #<CLOSER-COMMON-LISP-USER::RANGE-GENERIC-FUNCTION CLOSER-COMMON-LISP-USER::FOO {7D10D70E}> [error printing frame]
       5: (MOP::ENSURE-METHOD CLOSER-COMMON-LISP-USER::FOO :LAMBDA-LIST (NUMBER) :QUALIFIERS NIL :SPECIALIZERS (#<CLOSER-COMMON-LISP-USER::FIXNUM>= {47740D0}>) :FUNCTION #<ANONYMOUS-INTERPRETED-FUNCTION {3E366D..
       6: (SYSTEM::%LOAD #P"/Users/evenson/work/abcl/t/mop-specializer.lisp" T NIL T :UTF-8)
       7: (LOAD #P"/Users/evenson/work/abcl/t/mop-specializer.lisp" :EXTERNAL-FORMAT :UTF-8)
       8: (APPLY LOAD #P"/Users/evenson/work/abcl/t/mop-specializer.lisp" (:EXTERNAL-FORMAT :UTF-8))
    […]

[bohonghuang]

@easye Add slot direct-methods:

(defclass fixnum>= (mop:specializer)
     ((number :type fixnum :initarg :number :initform most-negative-fixnum)
+      (sys::direct-methods :initform nil)))

and evaluate:

(declaim (notinline add-direct-method))
(defun add-direct-method (specializer method)
  (if (or (typep specializer 'eql-specializer) (typep specializer 'specializer)) ;; specializer fix
      (pushnew method (std-slot-value specializer 'direct-methods))
      (pushnew method (class-direct-methods specializer))))

which is on line 2251 of file clos.lisp. Doesn't this take into effect during the compilation of ABCL?

[easye]

This is a patch for clos.lisp you can try. Seems to work, at least for this case.

@alanruttenberg One needs to actually change the behavior further along in clos.lisp https://github.com/armedbear/abcl/pull/551/files#diff-3c383d9f47896bf3fed0eb32a76989c9cd633297fb5471e66251de53423aac64R4458 in the associated atomic-defgeneric forms. Otherwise, such a patch has practically no effect on an ABCL process started from scratch.

But thanks for the initial work: tracking down why it didn't work in CI tests taught me a bit about ABCL sets up CLOS.

[easye]

I've updated the assocated pull request with simple documentation https://github.com/armedbear/abcl/pull/551/files#diff-93c0928f1b7f2bf0071613efc4311aa27e3e88179042a571be20e9cda04ddf77R1432, and working tests for SBCL and ABCL.

If someone could polish up the prose in the manual for implementing this feature, I would appreciate it, as I find my description rather flat.

[easye]

TODO: write better documentation in the fine manual, e.g. give example.