* streams.scm (stream-fold, stream-for-each): don't use named let,

because it prevents the gc from junking the stream argument.

diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index 8ecf4f8..c92eb01 100644 (file)
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -1,3 +1,8 @@
+2000-04-03  Michael Livshin  <mlivshin@bigfoot.com>
+
+       * streams.scm (stream-fold, stream-for-each): don't use named let, 
+       because it prevents the gc from junking the stream argument.
+
 Thu Mar  9 08:05:08 2000  Greg J. Badros  <gjb@cs.washington.edu>
 
        * slib.scm: Back-out change to software-type -- renamed

diff --git a/ice-9/streams.scm b/ice-9/streams.scm
index d9fb763..008a05c 100644 (file)
--- a/ice-9/streams.scm
+++ b/ice-9/streams.scm
@@ -157,25 +157,42 @@ If STREAM has infinite length this procedure will not terminate."
 
 (define (stream-fold f init stream . rest)
   (if (null? rest) ;fast path
-      (let loop ((stream stream) (r init))
-        (if (stream-null? stream)
-            r
-            (loop (stream-cdr stream) (f (stream-car stream) r))))
-      (let loop ((streams (cons stream rest)) (r init))
-        (if (or-map stream-null? streams)
-            r
-            (loop (map stream-cdr streams)
-                  (apply f (let recur ((cars (map stream-car streams)))
-                             (if (null? cars)
-                                 (list r)
-                                 (cons (car cars)
-                                       (recur (cdr cars)))))))))))
+      (stream-fold-one f init stream)
+      (stream-fold-many f init (cons stream rest))))
+
+(define (stream-fold-one f r stream)
+  (if (stream-null? stream)
+      r
+      (stream-fold-one f (f (stream-car stream) r) (stream-cdr stream))))
+
+(define (stream-fold-many f r streams)
+  (if (or-map stream-null? streams)
+      r
+      (stream-fold-many f
+                        (apply f (let recur ((cars
+                                              (map stream-car streams)))
+                                   (if (null? cars)
+                                       (list r)
+                                       (cons (car cars)
+                                             (recur (cdr cars))))))
+                        (map stream-cdr streams))))
 
 (define (stream-for-each f stream . rest)
-  (apply stream-fold
-         (lambda (elt _) (f elt))
-         #f
-         stream rest))
+  (if (null? rest) ;fast path
+      (stream-for-each-one f stream)
+      (stream-for-each-many f (cons stream rest))))
+
+(define (stream-for-each-one f stream)
+  (if (not (stream-null? stream))
+      (begin
+        (f (stream-car stream))
+        (stream-for-each-one f (stream-cdr stream)))))
+
+(define (stream-for-each-may f streams)
+  (if (not (or-map stream-null? streams))
+      (begin
+        (apply f (map stream-car streams))
+        (stream-for-each-one f (map stream-cdr streams)))))
 
 (define (stream-map f stream . rest)
   "Returns a newly allocated stream, each element being the result of