~ chicken-core (chicken-5) bc20f8b59c60d06d46b0d2a3e925ed5185fef064

commit bc20f8b59c60d06d46b0d2a3e925ed5185fef064
Merge: b159af00 0b974fd1
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Sep 14 22:24:22 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Wed Sep 14 22:24:22 2011 +0200

    Merge remote branch 'origin/felix-pending' into tmpmerge
    
    Merged the following changes
    
    - extension of type-system to "(list T ...)" and "(vector T ...)"
      types, with "(list T)" and "(vector T)" renamed to "(list-of T)"
      and "(vector-of T)", respectively
    - allow matching of "list" with "list-of" in exact/all mode for
      specialization matching
    - types.db fixes suggested by sjamaan
    - slightly more precise types for mem*/ass*
    
    All changes reviewed and acknowledged by sjamaan

diff --cc types.db
index 8ab8b343,82e842d4..a9f292d4
--- a/types.db
+++ b/types.db
@@@ -161,36 -159,45 +159,45 @@@
  	      ((null) '0)
  	      ((list) (##core#inline "C_u_i_length" #(1))))
  
- (list-tail (forall (a) (#(procedure #:clean #:enforce) list-tail ((list a) fixnum) (list a))))
- (list-ref (forall (a) (#(procedure #:clean #:enforce) list-ref ((list a) fixnum) a)))
+ (list-tail (forall (a) (#(procedure #:clean #:enforce) list-tail ((list-of a) fixnum) (list-of a))))
+ (list-ref (forall (a) (#(procedure #:clean #:enforce) list-ref ((list-of a) fixnum) a)))
+ 
  (append (#(procedure #:clean) append (list #!rest) *))
  (##sys#append (#(procedure #:clean) ##sys#append (list #!rest) *))
- (reverse (forall (a) (#(procedure #:clean #:enforce) reverse ((list a)) (list a))))
- (memq (#(procedure #:clean) memq (* list) *) ((* list) (##core#inline "C_u_i_memq" #(1) #(2))))
+ (reverse (forall (a) (#(procedure #:clean #:enforce) reverse ((list-of a)) (list-of a))))
+ 
+ (memq (forall (a b) (#(procedure #:clean) memq (a (list-of b)) (or boolean (list-of b))))
+       ((* list) (##core#inline "C_u_i_memq" #(1) #(2))))
  
- (memv (#(procedure #:clean) memv (* list) *)
-       (((or fixnum boolean char eof undefined null) list)
+ (memv (forall (a b) (#(procedure #:clean) memv (a (list-of b)) (or boolean (list-of b))))
+       (((or symbol procedure immediate) list)
         (##core#inline "C_u_i_memq" #(1) #(2))))
  
- ;; this may be a bit much...
- (member (forall (a) (#(procedure #:clean) member (* list #!optional (procedure (* *) *)) *))
- 	(((or fixnum boolean char eof undefined null) list)
+ (member (forall (a b) (#(procedure #:clean) member
+ 		       (a (list-of b) #!optional (procedure (b a) *)) ; sic
+ 		       (or boolean (list-of b))))
+ 	(((or symbol procedure immediate) list)
  	 (##core#inline "C_u_i_memq" #(1) #(2)))
- 	((* (list (or fixnum boolean char eof undefined null)))
 -	((* (list-of immediate))
++	((* (list-of (or symbol procedure immediate)))
  	 (##core#inline "C_u_i_memq" #(1) #(2))))
  
- (assq (#(procedure #:clean) assq (* list) *) ((* list) (##core#inline "C_u_i_assq" #(1) #(2))))
+ (assq (forall (a b) (#(procedure #:clean) assq (* (list-of (pair a b)))
+ 		     (or boolean (pair a b))))
+       ((* list) (##core#inline "C_u_i_assq" #(1) #(2))))
  
- (assv (#(procedure #:clean) assv (* list) *)
-       (((or fixnum boolean char eof undefined null) list)
+ (assv (forall (a b) (#(procedure #:clean) assv (* (list-of (pair a b))) 
+ 		     (or boolean (pair a b))))
+       (((or symbol immediate procedure) list)
         (##core#inline "C_u_i_assq" #(1) #(2)))
-       ((* (list (or fixnum boolean char eof undefined null)))
+       ((* (list-of (pair (or symbol procedure immediate) *)))
         (##core#inline "C_u_i_assq" #(1) #(2))))
  
- (assoc (#(procedure #:clean) assoc (* list #!optional (procedure (* *) *)) *)
-        (((or fixnum boolean char eof undefined null) list)
+ (assoc (forall (a b c) (#(procedure #:clean) assoc (a (list-of (pair b c))
+ 						      #!optional (procedure (b a) *)) ; sic
+ 			(or boolean (pair b c))))
+        (((or symbol procedure immediate) list)
  	(##core#inline "C_u_i_assq" #(1) #(2)))
-        ((* (list (or fixnum boolean char eof undefined null)))
+        ((* (list-of (pair (or symbol procedure immediate) *)))
  	(##core#inline "C_u_i_assq" #(1) #(2))))
  
  (symbol? (#(procedure #:pure #:predicate symbol) symbol? (*) boolean))
@@@ -1093,9 -1104,8 +1104,10 @@@
  (->string (procedure ->string (*) string)
  	  ((string) #(1)))
  
- (alist-ref (#(procedure #:clean #:enforce) alist-ref (* (list pair) #!optional (procedure (* *) *) *) *))
- (alist-update! (#(procedure #:enforce) alist-update! (* * (list pair) #!optional (procedure (* *) *)) *))
- (alist-update (#(procedure #:clean #:enforce) alist-update (* * (list pair) #!optional (procedure (* *) *) *) *))
+ (alist-ref (#(procedure #:clean #:enforce) alist-ref (* (list-of pair) #!optional (procedure (* *) *) *) *))
+ (alist-update! (#(procedure #:enforce) alist-update! (* * (list-of pair) #!optional (procedure (* *) *)) *))
++(alist-update (#(procedure #:clean #:enforce) alist-update (* * (list-of pair) #!optional (procedure (* *) *) *) *))
++
  (always? deprecated)
  
  (any? (#(procedure #:pure) any? (*) boolean)