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
