~ chicken-core (chicken-5) a2fdf43eb402b9abadff942a10210182a56fb5b2


commit a2fdf43eb402b9abadff942a10210182a56fb5b2
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Aug 24 10:38:51 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Wed Aug 24 10:38:51 2011 +0200

    workaround for typematch-bug found by Sven Hartrumpf

diff --git a/types.db b/types.db
index 640c0101..60ea3c21 100644
--- a/types.db
+++ b/types.db
@@ -369,7 +369,7 @@
 (number->string (procedure! number->string (number #!optional number) string)
 		((fixnum) (##sys#fixnum->string #(1))))
 
-(string->number (procedure! string->number (string #!optional number) (or number boolean)))
+(string->number (procedure! string->number (string #!optional number) *))
 
 (char? (procedure? char char? (*) boolean))
 
@@ -969,8 +969,8 @@
 (rassoc (procedure! rassoc (* list #!optional (procedure (* *) *)) *))
 (reverse-string-append (procedure! reverse-string-append (list) string))
 (shuffle deprecated)
-(sort (procedure! sort ((or list vector) (procedure (* *) *)) (or list vector)))
-(sort! (procedure! sort! ((or list vector) (procedure (* *) *)) (or list vector)))
+(sort (procedure! sort ((or list vector) (procedure (* *) *)) *))
+(sort! (procedure! sort! ((or list vector) (procedure (* *) *)) *))
 (sorted? (procedure! sorted? ((or list vector) (procedure (* *) *)) boolean))
 (topological-sort (procedure! topological-sort (list (procedure (* *) *)) list))
 (string-chomp (procedure! string-chomp (string #!optional string) string))
@@ -1136,8 +1136,8 @@
 (address->pointer (procedure! address->pointer (fixnum) pointer)
 		  ((fixnum) (##sys#address->pointer #(1))))
 
-(align-to-word (procedure align-to-word ((or number pointer locative procedure port)) (or pointer number)))
-(allocate (procedure! allocate (fixnum) (or boolean pointer)))
+(align-to-word (procedure align-to-word ((or number pointer locative procedure port))) *)
+(allocate (procedure! allocate (fixnum) *))
 (block-ref (procedure! block-ref (* fixnum) *))
 (block-set! (procedure! block-set! (* fixnum *) *))
 (extend-procedure (procedure! extend-procedure (procedure *) procedure))
@@ -1223,7 +1223,7 @@
 (pointer-s8-ref (procedure! pointer-s8-ref (pointer) fixnum))
 (pointer-s8-set! (procedure! pointer-s8-set! (pointer fixnum) undefined))
 
-(pointer-tag (procedure! pointer-tag ((or pointer locative procedure port)) (or boolean number))
+(pointer-tag (procedure! pointer-tag ((or pointer locative procedure port)) *)
 	     (((or locative procedure port)) (let ((#(tmp) #(1))) '#f)))
 
 (pointer-u16-ref (procedure! pointer-u16-ref (pointer) fixnum))
@@ -1656,8 +1656,8 @@
 (string-concatenate-reverse (procedure! string-concatenate-reverse (list #!optional string fixnum) string))
 (string-concatenate-reverse/shared (procedure! string-concatenate-reverse/shared (list #!optional string fixnum) string))
 (string-concatenate/shared (procedure! string-concatenate/shared (list) string))
-(string-contains (procedure! string-contains (string string #!optional fixnum fixnum fixnum fixnum) (or fixnum boolean)))
-(string-contains-ci (procedure! string-contains-ci (string string #!optional fixnum fixnum fixnum fixnum) (or fixnum boolean)))
+(string-contains (procedure! string-contains (string string #!optional fixnum fixnum fixnum fixnum) *))
+(string-contains-ci (procedure! string-contains-ci (string string #!optional fixnum fixnum fixnum fixnum) *))
 (string-copy (procedure! string-copy (string #!optional fixnum fixnum) string))
 (string-copy! (procedure! string-copy! (string fixnum string #!optional fixnum fixnum) undefined))
 (string-count (procedure! string-count (string * #!optional fixnum fixnum) fixnum))
@@ -1673,8 +1673,8 @@
 (string-fold-right (procedure! string-fold-right ((procedure (char *) *) * string #!optional fixnum fixnum) *))
 (string-for-each (procedure! string-for-each ((procedure (char) . *) string #!optional fixnum fixnum) undefined))
 (string-for-each-index (procedure! string-for-each-index ((procedure (fixnum) . *) string #!optional fixnum fixnum) undefined))
-(string-index (procedure! string-index (string * #!optional fixnum fixnum) (or fixnum boolean)))
-(string-index-right (procedure! string-index-right (string * #!optional fixnum fixnum) (or fixnum boolean)))
+(string-index (procedure! string-index (string * #!optional fixnum fixnum) *))
+(string-index-right (procedure! string-index-right (string * #!optional fixnum fixnum) *))
 (string-join (procedure! string-join (list #!optional string symbol) string))
 (string-kmp-partial-search (procedure! string-kmp-partial-search (string vector string fixnum #!optional (procedure (char char) *) fixnum fixnum fixnum) fixnum))
 (string-map (procedure! string-map ((procedure (char) char) string #!optional fixnum fixnum) string))
@@ -1694,8 +1694,8 @@
 (string-replace (procedure! string-replace (string string fixnum fixnum #!optional fixnum fixnum) string))
 (string-reverse (procedure! string-reverse (string #!optional fixnum fixnum) string))
 (string-reverse! (procedure! string-reverse! (string #!optional fixnum fixnum) string))
-(string-skip (procedure! string-skip (string * #!optional fixnum fixnum) (or fixnum boolean)))
-(string-skip-right (procedure! string-skip-right (string * #!optional fixnum fixnum) (or fixnum boolean)))
+(string-skip (procedure! string-skip (string * #!optional fixnum fixnum) *))
+(string-skip-right (procedure! string-skip-right (string * #!optional fixnum fixnum) *))
 (string-suffix-ci? (procedure! string-suffix-ci? (string string #!optional fixnum fixnum fixnum fixnum) boolean))
 (string-suffix-length (procedure! string-suffix-length (string string #!optional fixnum fixnum fixnum fixnum) fixnum))
 (string-suffix-length-ci (procedure! string-suffix-length-ci (string string #!optional fixnum fixnum fixnum fixnum) fixnum))
@@ -2139,7 +2139,7 @@
 (read-all (procedure! read-all (#!optional (or port string)) string))
 (system* (procedure! system* (string #!rest) undefined))
 (qs (procedure! qs (string) string))
-(compile-file (procedure! compile-file (string #!rest) (or boolean string)))
+(compile-file (procedure! compile-file (string #!rest) *))
 (compile-file-options (procedure! compile-file-options (#!optional list) list))
 (scan-input-lines (procedure! scan-input-lines (* #!optional port) *))
 (yes-or-no? (procedure! yes-or-no? (string #!rest) *))
Trap