This is totally wrong. The tests should be something more like this (use < instead of <=): (test (< (procedure (#!rest x) *) (procedure (x x) *))) (test (< (procedure (x #!rest x) *) (procedure (x x) *))) (test (< (procedure (x x #!rest x) *) (procedure (x x) *))) (test (not (< (procedure (#!rest x) *) (procedure (x y) *)))) (test (< (procedure (#!rest (or x y)) *) (procedure (x y) *))) (test (< (procedure (x #!rest y) *) (procedure (x y) *)))
(test (= (procedure (#!rest x) *) (procedure (#!rest x) *))) (test (< (procedure (#!rest x) *) (procedure (x #!rest x) *))) (test (< (procedure (#!rest (or x y)) *) (procedure (#!rest x) *))) (test (< (procedure (#!rest (or x y)) *) (procedure (y #!rest x) *))) I'm trying to find a better fix. megane <megan...@gmail.com> writes: > Hi, > > Currently this doesn't compile: > (compiler-typecase (the (#!rest fixnum -> *) 1) > ((fixnum fixnum -> *) 1)) > > Error: at toplevel: > (rest.scm:7) no clause applies in `compiler-typecase' for expression of type > `(procedure (#!rest fixnum) *)': > (procedure (fixnum fixnum) *) > > Here's a more concrete case where this happens. The warning only appears > when the procedure contravariant patch is applied: > > (: foo ((number number -> number) number number -> number)) > (define (foo f a b) > (f a b)) > > (print (foo max 1 2)) > > Warning: at toplevel: > (rest.scm:14) in procedure call to `foo', expected argument #1 of type > `(procedure (number number) number)' but was given an argument of type > `(procedure max (#!rest number) number)' > > diff --git a/scrutinizer.scm b/scrutinizer.scm > index ece07ed..5fc6524 100644 > --- a/scrutinizer.scm > +++ b/scrutinizer.scm > @@ -969,7 +969,9 @@ > (or (eq? '#!optional t) > (match1 rtype t))) > head) > - (match1 rtype (if (pair? tail) (rest-type (cdr tail)) '*))))) > + (if (pair? tail) > + (match1 rtype (rest-type (cdr tail))) > + #t)))) > > (define (optargs? a) > (memq a '(#!rest #!optional))) > diff --git a/tests/scrutinizer-tests.scm b/tests/scrutinizer-tests.scm > index ed313a4..da4fa4f 100644 > --- a/tests/scrutinizer-tests.scm > +++ b/tests/scrutinizer-tests.scm > @@ -240,6 +240,26 @@ > > (test (! (procedure () x) (procedure ()))) > (test (! (procedure () x) (procedure () x y))) > + > +(test (<= (procedure (#!rest x) *) > + (procedure (x x) *))) > +(test (<= (procedure (x #!rest x) *) > + (procedure (x x) *))) > +(test (<= (procedure (x x #!rest x) *) > + (procedure (x x) *))) > +(test (not (<= (procedure (#!rest x) *) > + (procedure (x y) *)))) > +(test (<= (procedure (#!rest (or x y)) *) > + (procedure (x y) *))) > +(test (<= (procedure (x #!rest y) *) > + (procedure (x y) *))) > + > +(test (<= (procedure (#!rest x) *) > + (procedure (#!rest x) *))) > +(test (<= (procedure (#!rest x) *) > + (procedure (x #!rest x) *))) > +(test (<= (procedure (#!rest (or x y)) *) > + (procedure (y #!rest x) *))) > ;; s.a. > ;(test (? (procedure () x) (procedure () x . y))) > _______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers