[racket-dev] [PATCH] Add multiple streams and a contract to stream-map

Adding multiple streams feature to stream-map makes it more in line
with its list counterpart.
---
There was some talk a while back about adding multiple streams to
stream-map but it ceased. I still think it's a good idea to add this
feature.

There were some challenges with the previous definition of stream-map
because of the expectation of returning multiple values, but as far as I
can see, and reading the mailing list, it has been dropped.

Also reading the mailing list, I saw a request for the use of contracts
instead of the previous error handling, so I added that.

There is also a pull request at github to add this feature.

 collects/racket/stream.rkt |   14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/collects/racket/stream.rkt b/collects/racket/stream.rkt
index f5cceb4..8ba3cc5 100644
--- a/collects/racket/stream.rkt
+++ b/collects/racket/stream.rkt
@@ -1,6 +1,7 @@
 #lang racket/base
 
 (require racket/private/generic
+         racket/contract
          (rename-in "private/for.rkt"
                     [stream-ref    stream-get-generics]
                     [stream-empty? -stream-empty?]
@@ -30,7 +31,8 @@
          stream-ref
          stream-tail
          stream-append
-         stream-map
+         (contract-out
+          (stream-map (->* (procedure? stream?) () #:rest (listof stream?) stream?)))
          stream-andmap
          stream-ormap
          stream-for-each
@@ -112,13 +114,11 @@
                     (lambda () (-stream-first (car l)))
                     (lambda () (streams-append (cons (-stream-rest (car l)) (cdr l)))))]))
 
-(define (stream-map f s)
-  (unless (procedure? f) (raise-argument-error 'stream-map "procedure?" f))
-  (unless (stream? s) (raise-argument-error 'stream-map "stream?" s))
-  (let loop ([s s])
-    (if (-stream-empty? s)
+(define (stream-map f s . ss)
+  (if (ormap stream-empty? (cons s ss))
       empty-stream
-      (stream-cons (f (-stream-first s)) (loop (-stream-rest s))))))
+      (stream-cons (apply f (map -stream-first (cons s ss)))
+                   (apply stream-map f (-stream-rest s) (map -stream-rest ss)))))
 
 (define (stream-andmap f s)
   (unless (procedure? f) (raise-argument-error 'stream-andmap "procedure?" f))
-- 
1.7.9.5