merging generic methods from different modules

[Thomas Wawrzinek]

Hi!

Lars J. Aas wrote:
 > If two different modules have generic methods with the same name,
 > the method from the module imported lastly will override the other
 > completely.

Well, only if the method has the same specializers. 

In this case, if you know how the method is defined and it's structure is 
somewhat regular, you can try method inspection. I've come up with the 
appended example. It assumes the method is no more than a (cond ...) and 
extracts the cases to combine them with those of the new method definition.

The illustrated use is somewhat brain-damaged, because instead of doing 
the dispatch yourself, you would normally use different goops types for it.
This is just an example.

I'm not sure either, whether this is good Scheme programming style ...

Maybe it helps with what you have in mind.

I understand that a general solution for this is difficult to achieve, 
since in the genral case you cannot make any assumptions about the method 
definition. I've no idea how to solve this, ...

Mikael Djurfeldt wrote:

 > I'll implement my solution during Christmas.  

... but I would like to see what ever get's born over Xmas.

Regards,

                       Thomas

#-------------- inspect.scm ------------------------

(use-modules (oop goops))

(define-class <foo-object> ()
  (type #:init-value 0 #:getter type-val #:init-keyword #:type)
  (name #:init-value "foo-object" #:getter name-val #:init-keyword #:name))

(define (type-0? obj)
  (if (equal? 0 (type-val obj))
      #t
      #f))

(define (type-1? obj)
  (if (equal? 1 (type-val obj))
      #t
      #f))

(define (type-2? obj)
  (if (equal? 2 (type-val obj))
      #t
      #f))

(define type0 (make <foo-object>))
(define type1 (make <foo-object> #:type 1))
(define type2 (make <foo-object> #:type 2))

(define refine-method
  (procedure->memoizing-macro
    (lambda (exp env)
      ;; Return #t if both signatures are same length and have identical
      ;; arg types in each position (assumes methods are *fully* specialized.
      (define (sig-equal? s1 s2)
        (if (equal? (length s1) (length s2))
            (if (null? s1)
                #t
                (if (not (equal? (cadar s1) (cadar s2)))
                    #f
                    (sig-equal? (cdr s1) (cdr s2))))
            #f))
      ;; Get the body of the method.
      (define (get-method-body def)
        (if (null? def)
            '()
            (if (pair? def)
                (let ((whole (caddr def)))
                  (if (and (pair? whole)
                           (eq? (car whole) 'cond))
                      (cdr whole)
                      (error "EXP not a COND clause")))
                (error "No method body found in EXP"))))
      ;; Get the method source whose signature matches `sig'.
      ;; Returns #f if there is none.
      (define (matching-form meth-list sig)
        (if (null? meth-list)
            #f
            (let ((form (car meth-list)))
              (let ((isig (cadr form)))
                (if (sig-equal? isig sig)
                    form
                    (matching-form (cdr meth-list) sig))))))
      ;;; lambda body
      (let ((name (cadr exp))
            (args (caddr exp)))
        (if (defined? name)
            (let ((form (matching-form 
                         (map method-source 
                              (generic-function-methods (eval name)))
                         args)))
              (if form
                  `(define-method ,name ,args
                     (cond ,@(get-method-body (cdr exp)) 
                           ,@(get-method-body form)))
                  `(define-method ,name ,args
                     (cond ,@(get-method-body (cdr exp)) 
                           (#t (error "Wrong type"))))))
            `(define-method ,name ,args
               (cond ,@(get-method-body (cdr exp)) 
                     (#t (error "Wrong type")))))))))

;; Assume this is in module 1
(refine-method foo-action ((o <foo-object>))
               (cond ((type-0? o)
                      (display "This is a TYPE-0!")
                      (newline))
                     ((type-1? o)
                      (display "This is a TYPE-1!")
                      (newline))))

(foo-action type0)
(foo-action type1)

;; Assum this is in module 2
(refine-method foo-action ((o <foo-object>))
                   (cond ((type-2? o)
                          (display "This is a TYPE-2!")
                          (newline))))

(foo-action type0)
(foo-action type1)
(foo-action type2)