~ chicken-core (chicken-5) 231a1c7fd5aaeab7289aac74a904b9c182530390

commit 231a1c7fd5aaeab7289aac74a904b9c182530390
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Wed Oct 1 20:39:55 2014 +1300
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Sun Nov 16 12:52:43 2014 +0100

    Mark circular-list?, dotted-list? and atom? as foldable in types.db
    
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>

diff --git a/c-platform.scm b/c-platform.scm
index e646ef7d..c93947cc 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -148,7 +148,8 @@
     fpfloor fpceiling fptruncate fpround fpsin fpcos fptan fpasin fpacos fpatan
     fpatan2 fpexp fpexpt fplog fpsqrt fpabs fpinteger?
     arithmetic-shift void flush-output
-    not-pair? atom? null-list? print print* error proper-list? call/cc
+    not-pair? atom? null-list? dotted-list? circular-list?
+    print print* error proper-list? call/cc
     blob-size u8vector->blob/shared s8vector->blob/shared u16vector->blob/shared
     s16vector->blob/shared u32vector->blob/shared s32vector->blob/shared
     f32vector->blob/shared f64vector->blob/shared
diff --git a/types.db b/types.db
index 80f24d14..79092733 100644
--- a/types.db
+++ b/types.db
@@ -1219,7 +1219,7 @@
 (any? (#(procedure #:pure #:foldable) any? (*) boolean)
       ((*) (let ((#(tmp) #(1))) '#t)))
 
-(atom? (#(procedure #:pure) atom? (*) boolean)
+(atom? (#(procedure #:pure #:foldable) atom? (*) boolean)
        ((pair) (let ((#(tmp) #(1))) '#f))
        (((not (or pair list))) (let ((#(tmp) #(1))) '#t)))
 
@@ -1868,7 +1868,7 @@
 (car+cdr (forall (a b) (#(procedure #:clean #:enforce) car+cdr ((pair a b)) a b)))
 (circular-list (#(procedure #:clean) circular-list (#!rest) list))
 
-(circular-list? (#(procedure #:clean) circular-list? (*) boolean)
+(circular-list? (#(procedure #:clean #:foldable) circular-list? (*) boolean)
 		((null) (let ((#(tmp) #(1))) '#f)))
 
 (concatenate (#(procedure #:clean #:enforce) concatenate ((list-of list)) list))
@@ -1884,7 +1884,7 @@
 (delete-duplicates!
  (forall (a) (#(procedure #:enforce) delete-duplicates! ((list-of a) #!optional (procedure (a *) *)) (list-of a))))
 
-(dotted-list? (#(procedure #:clean) dotted-list? (*) boolean))
+(dotted-list? (#(procedure #:clean #:foldable) dotted-list? (*) boolean))
 (drop (forall (a) (#(procedure #:enforce) drop ((list-of a) fixnum) (list-of a))))
 (drop-right (forall (a) (#(procedure #:enforce) drop-right ((list-of a) fixnum) (list-of a))))
 (drop-right! (forall (a) (#(procedure #:enforce) drop-right! ((list-of a) fixnum) (list-of a))))