Skip to content

Instantly share code, notes, and snippets.

@leque
Created May 20, 2012 00:33
Show Gist options
  • Save leque/2733012 to your computer and use it in GitHub Desktop.
Save leque/2733012 to your computer and use it in GitHub Desktop.
patch for Gauche/lib/util/stream.scm stream-every
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