Created
May 20, 2012 00:33
-
-
Save leque/2733012 to your computer and use it in GitHub Desktop.
patch for Gauche/lib/util/stream.scm stream-every
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
diff --git a/lib/util/stream.scm b/lib/util/stream.scm | |
index b2f67ae..5a45317 100644 | |
--- a/lib/util/stream.scm | |
+++ b/lib/util/stream.scm | |
@@ -576,10 +576,15 @@ | |
(apply stream-any pred (map stream-cdr strs))))) | |
(define (stream-every pred . strs) | |
- (let loop ((strs strs)) | |
- (or (find stream-null? strs) | |
- (and (apply pred (map stream-car strs)) | |
- (loop (map stream-cdr strs)))))) | |
+ (or (any stream-null? strs) | |
+ (let loop ((strs strs)) | |
+ (cond ((apply pred (map stream-car strs)) | |
+ => (lambda (r) | |
+ (let ((cdrs (map stream-cdr strs))) | |
+ (if (any stream-null? cdrs) | |
+ r | |
+ (loop cdrs))))) | |
+ (else #f))))) | |
(define (stream-index pred . strs) | |
(let loop ((strs strs) (pos 0)) | |
diff --git a/test/util.scm b/test/util.scm | |
index 54b3a7b..6318c35 100644 | |
--- a/test/util.scm | |
+++ b/test/util.scm | |
@@ -800,6 +800,66 @@ | |
(test* "stream-count" 4 | |
(stream-count odd? (stream-iota 8))) | |
+(test* "stream-any" #f | |
+ (stream-any even? stream-null)) | |
+ | |
+(test* "stream-any" #f | |
+ (stream-any even? (list->stream '(1 3)))) | |
+ | |
+(test* "stream-any" #t | |
+ (stream-any even? (list->stream '(1 2)))) | |
+ | |
+(test* "stream-any" 1 | |
+ (stream-any string->number (list->stream '("1" "a")))) | |
+ | |
+(test* "stream-any" 1 | |
+ (stream-any string->number (list->stream '("1" "2")))) | |
+ | |
+(test* "stream-any" 1 | |
+ (stream-any string->number | |
+ (list->stream '("1" "2")) | |
+ (list->stream '(10 10)))) | |
+ | |
+(test* "stream-any" 1 | |
+ (stream-any string->number | |
+ (list->stream '("1" "2")) | |
+ (list->stream '(10)))) | |
+ | |
+(test* "stream-any" #f | |
+ (stream-any string->number | |
+ (list->stream '("1" "2")) | |
+ (list->stream '()))) | |
+ | |
+(test* "stream-every" #t | |
+ (stream-every odd? stream-null)) | |
+ | |
+(test* "stream-every" #t | |
+ (stream-every odd? (list->stream '(1 3)))) | |
+ | |
+(test* "stream-every" #f | |
+ (stream-every odd? (list->stream '(1 2)))) | |
+ | |
+(test* "stream-every" #f | |
+ (stream-every string->number (list->stream '("1" "a")))) | |
+ | |
+(test* "stream-every" 2 | |
+ (stream-every string->number (list->stream '("1" "2")))) | |
+ | |
+(test* "stream-every" 2 | |
+ (stream-every string->number | |
+ (list->stream '("1" "2")) | |
+ (list->stream '(10 10)))) | |
+ | |
+(test* "stream-every" 1 | |
+ (stream-every string->number | |
+ (list->stream '("1" "2")) | |
+ (list->stream '(10)))) | |
+ | |
+(test* "stream-every" #t | |
+ (stream-every string->number | |
+ (list->stream '("1" "2")) | |
+ (list->stream '()))) | |
+ | |
;;----------------------------------------------- | |
(test-section "util.toposort") | |
(use util.toposort) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment