[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Chicken-users] tinyclos and variable argument functions
From: |
John Lenz |
Subject: |
Re: [Chicken-users] tinyclos and variable argument functions |
Date: |
Tue, 05 Apr 2005 19:17:10 +0000 |
> --- 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