Re: [Chicken-users] tinyclos and variable argument functions

[John Lenz]

> --- tinyclos.scm      2005-04-05 01:13:56.216978007 -0500
> +++ mytinyclos.scm    2005-04-05 01:13:19.553158943 -0500
> @@ -868,13 +868,24 @@
>      (##tinyclos#slot-set!
>       generic
>       'methods
> -     (cons method
> -        (filter-in
> -         (lambda (m) 
> -           (let ([ms1 (method-specializers m)]
> -                 [ms2 (method-specializers method)] )
> -             (not (every2 (lambda (x y) (eq? x y)) ms1 ms2) ) ) )
> -         (##tinyclos#slot-ref generic 'methods))))
> +       (let filter-in-method ([methods (##tinyclos#slot-ref generic 
> 'methods)])
> +         (if (null? methods)
> +           (list method)
> +           (let ([l1 (length (method-specializers method))]
> +              [l2 (length (method-specializers (##sys#slot methods 0)))])
> +             (cond ((> l1 l2)
> +                    (cons (##sys#slot methods 0) (filter-in-method 
> (##sys#slot methods 1))))
> +                   ((< l1 l2)
> +                    (cons method methods))
> +                   (else
> +                     (let check-method ([ms1 (method-specializers method)]
> +                                        [ms2 (method-specializers 
> (##sys#slot methods 0))])
> +                       (cond ((eq? (##sys#slot ms1 0) (##sys#slot ms2 0))
> +                              (check-method (##sys#slot ms1 1) (##sys#slot 
> ms2 1)))
> +                             ((and (null? ms1) (null? ms2))
> +                              (cons method (##sys#slot methods 1))) ;; skip 
> the method already in the generic

Whups.  The (and (null? ...)) check should come before checking if the first 
elements are equal.
Just switching around those two conditions makes it work fine.

> +                             (else
> +                               (cons (##sys#slot methods 0) 
> (filter-in-method (##sys#slot methods 1))))))))))))
>      (if (memq generic generic-invocation-generics)
>       (set! method-cache-tag (vector))
>       (%entity-cache-set! generic #f) )

I also think there might be a problem with define-macro... With the above patch 
to tinyclos,
the following code gives somewhat strange results:

#;2> (define-method (foo (a <top>) b) (print "two " a " " b))
#;3> (define-method (foo (a <top>)) (print "one " a))
#;4> (foo 3 2)
Error: bad argument count - received 3 but expected 2
#;4> (foo 3)
one 3
"one "
#;5> (define-method (foo (a <top>) (b <top>)) (print "two other " a " " b))
#;6> (foo 3 2)
two other 3 2
"two other "

What is going on here is that when expanding the first define-method, 
define-method is
passing the list of specializers to (add-global-method) as '(<top>).  This is 
because
of lines 482 in chicken-highlevel-macros.scm:
    (if (or (not (pair? args)) 
            (and (not (pair? (car args)))
                 (not (scan (cdr args))) ) )
Since define-method stops generating the list of specializers when it finds no 
more
pairs left in the list of arguments, b's type (which is <top>) is never getting 
added
to the list. It makes for a wierd case where wrapping b inside a (b <top>) works
whereas it doesn't if b is just left open.

Thus, during add-method, since the list of specializers for the first method is 
equal
to the list for the second, the second define-method is replacing the first.

John