chicken-hackers
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Chicken-hackers] OPATCHO Fix procedure subtype relation when #!rest


From: megane
Subject: Re: [Chicken-hackers] OPATCHO Fix procedure subtype relation when #!rest is involved
Date: Fri, 25 May 2018 17:06:42 +0300
User-agent: mu4e 0.9.18; emacs 25.1.1

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 <address@hidden> 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)))
>  




reply via email to

[Prev in Thread] Current Thread [Next in Thread]