MOP improvement(?)

On Sagittarius,  MOP was not totally compatible with Tiny CLOS's MOP. That's because of my laziness. However I have noticed that once I use non builtin generic class, then it's not possible to use method qualifiers. This is not good to me. So I have improved some stuff.

The problem was that it was only implemented in C code and not in Scheme code so once I used custom generic class then it won't check those qualifiers. So I have removed builtin compute-applicable-method and moved to Scheme. Then implemented all required procedures and duplicated the logic in Scheme. (I actually don't want to do this but so far I couldn't find any better way.)

Now, I can do something like this;

(import (rnrs) (clos user) (clos core) (srfi :1))
 
(define-class <my-generic> (<generic>) ())
(define-generic foo :class <my-generic>)

(define-method compute-applicable-methods ((gf <my-generic>) args)
  (let ((m* (generic-methods gf)))
    (let-values (((supported others)
                  (partition (lambda (m) 
                               (memq (method-qualifier m)
                                     '(:before :after :around :primary)))
                             m*)))
      (for-each (lambda (m) (remove-method gf m)) others)
      (let ((methods (call-next-method)))
        (for-each (lambda (m) (add-method gf m)) others)
        (append others methods)))))

(define-class <human> ()())
(define-class <businessman> (<human>) ())
(define-method foo :append ((h <human>))
  (print "something else")
  (call-next-method))

(define-method foo :around ((h <human>))
  (print "human around before")
  (call-next-method)
  (print "human around after"))

(define-method foo :before ((h <human>))
  (print "human before"))
(define-method foo :before ((b <businessman>))
  (print "businessman before"))
 
(define-method foo ((h <human>))
  (print "human body"))
(define-method foo ((b <businessman>))
  (print "businessman body"))
 
(foo (make <businessman>))
#|
something else
human around before
businessman before
human before
businessman body
human around after
|#

I have no idea what I'm doing in above code!! Well, default implementation of method qualifier refuses non supported keywords so first remove other keywords from generic function then compute builtin qualifiers and adds the removed ones. At last append the non supported qualifier methods in front of the computed ones. The result is the other qualifier one is called first then the rest. If you put this append after the around method then all methods need to call call-next-method otherwise it won't reach there.

I have no idea if I will use this or not but at least I have something if I want to change the behaviour!