*** empty log message ***

[bpt/guile.git] / ice-9 / streams.scm

diff --git a/ice-9/streams.scm b/ice-9/streams.scm
index d9fb763..6aabfb1 100644 (file)
--- a/ice-9/streams.scm
+++ b/ice-9/streams.scm
@@ -1,36 +1,34 @@
 ;;;; streams.scm --- general lazy streams
 ;;;; -*- Scheme -*-
 
-;;;; Copyright (C) 1999 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2004 Free Software Foundation, Inc.
 ;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 of the License, or (at your option) any later version.
 ;;;; 
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
 ;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-;;;; Boston, MA 02111-1307 USA
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 ;; the basic stream operations are inspired by
 ;; (i.e. ripped off) Scheme48's `stream' package,
 ;; modulo stream-empty? -> stream-null? renaming.
 
-(define-module (ice-9 streams))
-
-(export make-stream
-        stream-car stream-cdr stream-null?
-        list->stream vector->stream port->stream
-        stream->list stream->reversed-list
-        stream->list&length stream->reversed-list&length
-        stream->vector
-        stream-fold stream-for-each stream-map)
+(define-module (ice-9 streams)
+  :export (make-stream
+          stream-car stream-cdr stream-null?
+          list->stream vector->stream port->stream
+          stream->list stream->reversed-list
+          stream->list&length stream->reversed-list&length
+          stream->vector
+          stream-fold stream-for-each stream-map))
 
 ;; Use:
 ;;
@@ -157,25 +155,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-many f streams)
+  (if (not (or-map stream-null? streams))
+      (begin
+        (apply f (map stream-car streams))
+        (stream-for-each-many f (map stream-cdr streams)))))
 
 (define (stream-map f stream . rest)
   "Returns a newly allocated stream, each element being the result of