~ chicken-core (chicken-5) 4d07d9e713fa68a11033d3edd03e333df107ee10

commit 4d07d9e713fa68a11033d3edd03e333df107ee10
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Sat Aug 16 16:16:29 2014 +1200
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Sun Oct 19 13:32:11 2014 +0200

    Fix list-copy types.db entry to allow any argument type
    
    list-copy accepts any argument type (returning non-pair arguments
    unchanged), so its type should be a -> a. This also means it can be
    marked pure, and improves the scrutinizer's accuracy on list-copy calls
    since the argument type can be preserved as the result type.
    
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>

diff --git a/tests/typematch-tests.scm b/tests/typematch-tests.scm
index bbd5a3cd..6cbcc9a6 100644
--- a/tests/typematch-tests.scm
+++ b/tests/typematch-tests.scm
@@ -263,6 +263,9 @@
 (mx fixnum (##sys#vector-ref '#(1 2 3.4) 0))
 (mx (vector fixnum float) (vector 1 2.3))
 (mx (list fixnum float) (list 1 2.3))
+(mx (list fixnum float) (list-copy (list 1 2.3)))
+(mx (pair fixnum float) (list-copy (cons 1 2.3)))
+(mx fixnum (list-copy 1))
 
 (: f1 (forall (a) ((list-of a) -> a)))
 (define (f1 x) (car x))
diff --git a/types.db b/types.db
index b036928b..7d555383 100644
--- a/types.db
+++ b/types.db
@@ -1924,7 +1924,7 @@
 (last (#(procedure #:clean #:enforce) last (pair) *))
 (last-pair (#(procedure #:clean #:enforce) last-pair (pair) *))
 (length+ (#(procedure #:clean #:enforce) length+ (list) *))
-(list-copy (forall (a) (#(procedure #:clean #:enforce) list-copy ((list-of a)) (list-of a))))
+(list-copy (forall (a) (#(procedure #:pure) list-copy (a) a)))
 (list-index (forall (a) (#(procedure #:enforce) list-index ((procedure (a #!rest) *) (list-of a) #!rest list) *)))
 (list-tabulate (forall (a) (#(procedure #:enforce) list-tabulate (fixnum (procedure (fixnum) a)) (list-of a))))
 (list= (#(procedure #:clean #:enforce) list= (#!optional (procedure (list list) *) #!rest list) boolean)