mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
* module/srfi/srfi-41.scm: Add record type printer for streams. (stream-promise-visit): New helper for visiting stream promises.
505 lines
20 KiB
Scheme
505 lines
20 KiB
Scheme
;;; srfi-41.scm -- SRFI 41 streams
|
|
|
|
;; Copyright (c) 2007 Philip L. Bewig
|
|
;; Copyright (c) 2011, 2012, 2013 Free Software Foundation, Inc.
|
|
|
|
;; Permission is hereby granted, free of charge, to any person obtaining
|
|
;; a copy of this software and associated documentation files (the
|
|
;; "Software"), to deal in the Software without restriction, including
|
|
;; without limitation the rights to use, copy, modify, merge, publish,
|
|
;; distribute, sublicense, and/or sell copies of the Software, and to
|
|
;; permit persons to whom the Software is furnished to do so, subject to
|
|
;; the following conditions:
|
|
;;
|
|
;; The above copyright notice and this permission notice shall be
|
|
;; included in all copies or substantial portions of the Software.
|
|
;;
|
|
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
|
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
|
|
;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND
|
|
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
|
|
;; BE LIABLE FOR ANY CLAIM, DAMAGES, OR OTHER LIABILITY, WHETHER IN AN
|
|
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF, OR IN
|
|
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
|
;; SOFTWARE.
|
|
|
|
(define-module (srfi srfi-41)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-8)
|
|
#:use-module (srfi srfi-9)
|
|
#:use-module (srfi srfi-9 gnu)
|
|
#:use-module (srfi srfi-26)
|
|
#:use-module (ice-9 match)
|
|
#:export (stream-null stream-cons stream? stream-null? stream-pair?
|
|
stream-car stream-cdr stream-lambda define-stream
|
|
list->stream port->stream stream stream->list stream-append
|
|
stream-concat stream-constant stream-drop stream-drop-while
|
|
stream-filter stream-fold stream-for-each stream-from
|
|
stream-iterate stream-length stream-let stream-map
|
|
stream-match stream-of stream-range stream-ref stream-reverse
|
|
stream-scan stream-take stream-take-while stream-unfold
|
|
stream-unfolds stream-zip))
|
|
|
|
(cond-expand-provide (current-module) '(srfi-41))
|
|
|
|
;;; Private supporting functions and macros.
|
|
|
|
(define-syntax-rule (must pred obj func msg args ...)
|
|
(let ((item obj))
|
|
(unless (pred item)
|
|
(throw 'wrong-type-arg func msg (list args ...) (list item)))))
|
|
|
|
(define-syntax-rule (must-not pred obj func msg args ...)
|
|
(let ((item obj))
|
|
(when (pred item)
|
|
(throw 'wrong-type-arg func msg (list args ...) (list item)))))
|
|
|
|
(define-syntax-rule (must-every pred objs func msg args ...)
|
|
(let ((flunk (remove pred objs)))
|
|
(unless (null? flunk)
|
|
(throw 'wrong-type-arg func msg (list args ...) flunk))))
|
|
|
|
(define-syntax-rule (first-value expr)
|
|
(receive (first . _) expr
|
|
first))
|
|
|
|
(define-syntax-rule (second-value expr)
|
|
(receive (first second . _) expr
|
|
second))
|
|
|
|
(define-syntax-rule (third-value expr)
|
|
(receive (first second third . _) expr
|
|
third))
|
|
|
|
(define-syntax define-syntax*
|
|
(syntax-rules ()
|
|
((_ (name . args) body ...)
|
|
(define-syntax name (lambda* args body ...)))
|
|
((_ name syntax)
|
|
(define-syntax name syntax))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;; Here we include a copy of the code of srfi-45.scm (but with renamed
|
|
;; identifiers), in order to create a new promise type that's disjoint
|
|
;; from the promises created by srfi-45. Ideally this should be done
|
|
;; using a 'make-promise-type' macro that instantiates a copy of this
|
|
;; code, but a psyntax bug in Guile 2.0 prevents this from working
|
|
;; properly: <http://bugs.gnu.org/13995>. So for now, we duplicate the
|
|
;; code.
|
|
|
|
;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
|
|
;; Copyright (C) 2003 André van Tonder. All Rights Reserved.
|
|
|
|
;; Permission is hereby granted, free of charge, to any person
|
|
;; obtaining a copy of this software and associated documentation
|
|
;; files (the "Software"), to deal in the Software without
|
|
;; restriction, including without limitation the rights to use, copy,
|
|
;; modify, merge, publish, distribute, sublicense, and/or sell copies
|
|
;; of the Software, and to permit persons to whom the Software is
|
|
;; furnished to do so, subject to the following conditions:
|
|
|
|
;; The above copyright notice and this permission notice shall be
|
|
;; included in all copies or substantial portions of the Software.
|
|
|
|
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
|
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
|
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
|
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
|
|
;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
|
|
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
|
|
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
|
;; SOFTWARE.
|
|
|
|
(define-record-type stream-promise (make-stream-promise val) stream-promise?
|
|
(val stream-promise-val stream-promise-val-set!))
|
|
|
|
(define-record-type stream-value (make-stream-value tag proc) stream-value?
|
|
(tag stream-value-tag stream-value-tag-set!)
|
|
(proc stream-value-proc stream-value-proc-set!))
|
|
|
|
(define-syntax-rule (stream-lazy exp)
|
|
(make-stream-promise (make-stream-value 'lazy (lambda () exp))))
|
|
|
|
(define (stream-eager x)
|
|
(make-stream-promise (make-stream-value 'eager x)))
|
|
|
|
(define-syntax-rule (stream-delay exp)
|
|
(stream-lazy (stream-eager exp)))
|
|
|
|
(define (stream-force promise)
|
|
(let ((content (stream-promise-val promise)))
|
|
(case (stream-value-tag content)
|
|
((eager) (stream-value-proc content))
|
|
((lazy) (let* ((promise* ((stream-value-proc content)))
|
|
(content (stream-promise-val promise)))
|
|
(if (not (eqv? (stream-value-tag content) 'eager))
|
|
(begin (stream-value-tag-set! content
|
|
(stream-value-tag (stream-promise-val promise*)))
|
|
(stream-value-proc-set! content
|
|
(stream-value-proc (stream-promise-val promise*)))
|
|
(stream-promise-val-set! promise* content)))
|
|
(stream-force promise))))))
|
|
|
|
;;
|
|
;; End of the copy of the code from srfi-45.scm
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;; Primitive stream functions and macros: (streams primitive)
|
|
|
|
(define stream? stream-promise?)
|
|
|
|
(define %stream-null (cons 'stream 'null))
|
|
(define stream-null (stream-eager %stream-null))
|
|
|
|
(define (stream-null? obj)
|
|
(and (stream-promise? obj)
|
|
(eqv? (stream-force obj) %stream-null)))
|
|
|
|
(define-record-type stream-pare (make-stream-pare kar kdr) stream-pare?
|
|
(kar stream-kar)
|
|
(kdr stream-kdr))
|
|
|
|
(define (stream-pair? obj)
|
|
(and (stream-promise? obj) (stream-pare? (stream-force obj))))
|
|
|
|
(define-syntax-rule (stream-cons obj strm)
|
|
(stream-eager (make-stream-pare (stream-delay obj) (stream-lazy strm))))
|
|
|
|
(define (stream-car strm)
|
|
(must stream? strm 'stream-car "non-stream")
|
|
(let ((pare (stream-force strm)))
|
|
(must stream-pare? pare 'stream-car "null stream")
|
|
(stream-force (stream-kar pare))))
|
|
|
|
(define (stream-cdr strm)
|
|
(must stream? strm 'stream-cdr "non-stream")
|
|
(let ((pare (stream-force strm)))
|
|
(must stream-pare? pare 'stream-cdr "null stream")
|
|
(stream-kdr pare)))
|
|
|
|
(define-syntax-rule (stream-lambda formals body0 body1 ...)
|
|
(lambda formals (stream-lazy (begin body0 body1 ...))))
|
|
|
|
(define* (stream-promise-visit promise #:key on-eager on-lazy)
|
|
(define content (stream-promise-val promise))
|
|
(case (stream-value-tag content)
|
|
((eager) (on-eager (stream-value-proc content)))
|
|
((lazy) (on-lazy (stream-value-proc content)))))
|
|
|
|
(set-record-type-printer! stream-promise
|
|
(lambda (strm port)
|
|
(display "#<stream" port)
|
|
(let loop ((strm strm))
|
|
(stream-promise-visit strm
|
|
#:on-eager (lambda (pare)
|
|
(cond ((eq? pare %stream-null)
|
|
(write-char #\> port))
|
|
(else
|
|
(write-char #\space port)
|
|
(stream-promise-visit (stream-kar pare)
|
|
#:on-eager (cut write <> port)
|
|
#:on-lazy (lambda (_) (write-char #\? port)))
|
|
(loop (stream-kdr pare)))))
|
|
#:on-lazy (lambda (_) (display " ...>" port))))))
|
|
|
|
;;; Derived stream functions and macros: (streams derived)
|
|
|
|
(define-syntax-rule (define-stream (name . formal) body0 body1 ...)
|
|
(define name (stream-lambda formal body0 body1 ...)))
|
|
|
|
(define-syntax-rule (stream-let tag ((name val) ...) body1 body2 ...)
|
|
((letrec ((tag (stream-lambda (name ...) body1 body2 ...))) tag) val ...))
|
|
|
|
(define (list->stream objs)
|
|
(define (list? x)
|
|
(or (proper-list? x) (circular-list? x)))
|
|
(must list? objs 'list->stream "non-list argument")
|
|
(stream-let recur ((objs objs))
|
|
(if (null? objs) stream-null
|
|
(stream-cons (car objs) (recur (cdr objs))))))
|
|
|
|
(define* (port->stream #:optional (port (current-input-port)))
|
|
(must input-port? port 'port->stream "non-input-port argument")
|
|
(stream-let recur ()
|
|
(let ((c (read-char port)))
|
|
(if (eof-object? c) stream-null
|
|
(stream-cons c (recur))))))
|
|
|
|
(define-syntax stream
|
|
(syntax-rules ()
|
|
((_) stream-null)
|
|
((_ x y ...) (stream-cons x (stream y ...)))))
|
|
|
|
;; Common helper for the various eager-folding functions, such as
|
|
;; stream-fold, stream-drop, stream->list, stream-length, etc.
|
|
(define-inlinable (stream-fold-aux proc base strm limit)
|
|
(do ((val base (and proc (proc val (stream-car strm))))
|
|
(strm strm (stream-cdr strm))
|
|
(limit limit (and limit (1- limit))))
|
|
((or (and limit (zero? limit)) (stream-null? strm))
|
|
(values val strm limit))))
|
|
|
|
(define stream->list
|
|
(case-lambda
|
|
((strm) (stream->list #f strm))
|
|
((n strm)
|
|
(must stream? strm 'stream->list "non-stream argument")
|
|
(when n
|
|
(must integer? n 'stream->list "non-integer count")
|
|
(must exact? n 'stream->list "inexact count")
|
|
(must-not negative? n 'stream->list "negative count"))
|
|
(reverse! (first-value (stream-fold-aux xcons '() strm n))))))
|
|
|
|
(define (stream-append . strms)
|
|
(must-every stream? strms 'stream-append "non-stream argument")
|
|
(stream-let recur ((strms strms))
|
|
(if (null? strms) stream-null
|
|
(let ((strm (car strms)))
|
|
(if (stream-null? strm) (recur (cdr strms))
|
|
(stream-cons (stream-car strm)
|
|
(recur (cons (stream-cdr strm) (cdr strms)))))))))
|
|
|
|
(define (stream-concat strms)
|
|
(must stream? strms 'stream-concat "non-stream argument")
|
|
(stream-let recur ((strms strms))
|
|
(if (stream-null? strms) stream-null
|
|
(let ((strm (stream-car strms)))
|
|
(must stream? strm 'stream-concat "non-stream object in input stream")
|
|
(if (stream-null? strm) (recur (stream-cdr strms))
|
|
(stream-cons (stream-car strm)
|
|
(recur (stream-cons (stream-cdr strm)
|
|
(stream-cdr strms)))))))))
|
|
|
|
(define stream-constant
|
|
(case-lambda
|
|
(() stream-null)
|
|
(objs (list->stream (apply circular-list objs)))))
|
|
|
|
(define-syntax* (stream-do x)
|
|
(define (end x)
|
|
(syntax-case x ()
|
|
(() #'(if #f #f))
|
|
((result) #'result)
|
|
((result ...) #'(begin result ...))))
|
|
(define (var-step v s)
|
|
(syntax-case s ()
|
|
(() v)
|
|
((e) #'e)
|
|
(_ (syntax-violation 'stream-do "bad step expression" x s))))
|
|
|
|
(syntax-case x ()
|
|
((_ ((var init . step) ...)
|
|
(test result ...)
|
|
expr ...)
|
|
(with-syntax ((result (end #'(result ...)))
|
|
((step ...) (map var-step #'(var ...) #'(step ...))))
|
|
#'(stream-let loop ((var init) ...)
|
|
(if test result
|
|
(begin
|
|
expr ...
|
|
(loop step ...))))))))
|
|
|
|
(define (stream-drop n strm)
|
|
(must integer? n 'stream-drop "non-integer argument")
|
|
(must exact? n 'stream-drop "inexact argument")
|
|
(must-not negative? n 'stream-drop "negative argument")
|
|
(must stream? strm 'stream-drop "non-stream argument")
|
|
(second-value (stream-fold-aux #f #f strm n)))
|
|
|
|
(define (stream-drop-while pred? strm)
|
|
(must procedure? pred? 'stream-drop-while "non-procedural argument")
|
|
(must stream? strm 'stream-drop-while "non-stream argument")
|
|
(stream-do ((strm strm (stream-cdr strm)))
|
|
((or (stream-null? strm) (not (pred? (stream-car strm)))) strm)))
|
|
|
|
(define (stream-filter pred? strm)
|
|
(must procedure? pred? 'stream-filter "non-procedural argument")
|
|
(must stream? strm 'stream-filter "non-stream argument")
|
|
(stream-let recur ((strm strm))
|
|
(cond ((stream-null? strm) stream-null)
|
|
((pred? (stream-car strm))
|
|
(stream-cons (stream-car strm) (recur (stream-cdr strm))))
|
|
(else (recur (stream-cdr strm))))))
|
|
|
|
(define (stream-fold proc base strm)
|
|
(must procedure? proc 'stream-fold "non-procedural argument")
|
|
(must stream? strm 'stream-fold "non-stream argument")
|
|
(first-value (stream-fold-aux proc base strm #f)))
|
|
|
|
(define stream-for-each
|
|
(case-lambda
|
|
((proc strm)
|
|
(must procedure? proc 'stream-for-each "non-procedural argument")
|
|
(must stream? strm 'stream-for-each "non-stream argument")
|
|
(do ((strm strm (stream-cdr strm)))
|
|
((stream-null? strm))
|
|
(proc (stream-car strm))))
|
|
((proc strm . rest)
|
|
(let ((strms (cons strm rest)))
|
|
(must procedure? proc 'stream-for-each "non-procedural argument")
|
|
(must-every stream? strms 'stream-for-each "non-stream argument")
|
|
(do ((strms strms (map stream-cdr strms)))
|
|
((any stream-null? strms))
|
|
(apply proc (map stream-car strms)))))))
|
|
|
|
(define* (stream-from first #:optional (step 1))
|
|
(must number? first 'stream-from "non-numeric starting number")
|
|
(must number? step 'stream-from "non-numeric step size")
|
|
(stream-let recur ((first first))
|
|
(stream-cons first (recur (+ first step)))))
|
|
|
|
(define (stream-iterate proc base)
|
|
(must procedure? proc 'stream-iterate "non-procedural argument")
|
|
(stream-let recur ((base base))
|
|
(stream-cons base (recur (proc base)))))
|
|
|
|
(define (stream-length strm)
|
|
(must stream? strm 'stream-length "non-stream argument")
|
|
(- -1 (third-value (stream-fold-aux #f #f strm -1))))
|
|
|
|
(define stream-map
|
|
(case-lambda
|
|
((proc strm)
|
|
(must procedure? proc 'stream-map "non-procedural argument")
|
|
(must stream? strm 'stream-map "non-stream argument")
|
|
(stream-let recur ((strm strm))
|
|
(if (stream-null? strm) stream-null
|
|
(stream-cons (proc (stream-car strm))
|
|
(recur (stream-cdr strm))))))
|
|
((proc strm . rest)
|
|
(let ((strms (cons strm rest)))
|
|
(must procedure? proc 'stream-map "non-procedural argument")
|
|
(must-every stream? strms 'stream-map "non-stream argument")
|
|
(stream-let recur ((strms strms))
|
|
(if (any stream-null? strms) stream-null
|
|
(stream-cons (apply proc (map stream-car strms))
|
|
(recur (map stream-cdr strms)))))))))
|
|
|
|
(define-syntax* (stream-match x)
|
|
(define (make-matcher x)
|
|
(syntax-case x ()
|
|
(() #'(? stream-null?))
|
|
(rest (identifier? #'rest) #'rest)
|
|
((var . rest) (identifier? #'var)
|
|
(with-syntax ((next (make-matcher #'rest)))
|
|
#'(? (negate stream-null?)
|
|
(= stream-car var)
|
|
(= stream-cdr next))))))
|
|
(define (make-guarded x fail)
|
|
(syntax-case (list x fail) ()
|
|
(((expr) _) #'expr)
|
|
(((guard expr) fail) #'(if guard expr (fail)))))
|
|
|
|
(syntax-case x ()
|
|
((_ strm-expr (pat . expr) ...)
|
|
(with-syntax (((fail ...) (generate-temporaries #'(pat ...))))
|
|
(with-syntax (((matcher ...) (map make-matcher #'(pat ...)))
|
|
((expr ...) (map make-guarded #'(expr ...) #'(fail ...))))
|
|
#'(let ((strm strm-expr))
|
|
(must stream? strm 'stream-match "non-stream argument")
|
|
(match strm (matcher (=> fail) expr) ...)))))))
|
|
|
|
(define-syntax-rule (stream-of expr rest ...)
|
|
(stream-of-aux expr stream-null rest ...))
|
|
|
|
(define-syntax stream-of-aux
|
|
(syntax-rules (in is)
|
|
((_ expr base)
|
|
(stream-cons expr base))
|
|
((_ expr base (var in stream) rest ...)
|
|
(stream-let recur ((strm stream))
|
|
(if (stream-null? strm) base
|
|
(let ((var (stream-car strm)))
|
|
(stream-of-aux expr (recur (stream-cdr strm)) rest ...)))))
|
|
((_ expr base (var is exp) rest ...)
|
|
(let ((var exp)) (stream-of-aux expr base rest ...)))
|
|
((_ expr base pred? rest ...)
|
|
(if pred? (stream-of-aux expr base rest ...) base))))
|
|
|
|
(define* (stream-range first past #:optional step)
|
|
(must number? first 'stream-range "non-numeric starting number")
|
|
(must number? past 'stream-range "non-numeric ending number")
|
|
(when step
|
|
(must number? step 'stream-range "non-numeric step size"))
|
|
(let* ((step (or step (if (< first past) 1 -1)))
|
|
(lt? (if (< 0 step) < >)))
|
|
(stream-let recur ((first first))
|
|
(if (lt? first past)
|
|
(stream-cons first (recur (+ first step)))
|
|
stream-null))))
|
|
|
|
(define (stream-ref strm n)
|
|
(must stream? strm 'stream-ref "non-stream argument")
|
|
(must integer? n 'stream-ref "non-integer argument")
|
|
(must exact? n 'stream-ref "inexact argument")
|
|
(must-not negative? n 'stream-ref "negative argument")
|
|
(let ((res (stream-drop n strm)))
|
|
(must-not stream-null? res 'stream-ref "beyond end of stream")
|
|
(stream-car res)))
|
|
|
|
(define (stream-reverse strm)
|
|
(must stream? strm 'stream-reverse "non-stream argument")
|
|
(stream-do ((strm strm (stream-cdr strm))
|
|
(rev stream-null (stream-cons (stream-car strm) rev)))
|
|
((stream-null? strm) rev)))
|
|
|
|
(define (stream-scan proc base strm)
|
|
(must procedure? proc 'stream-scan "non-procedural argument")
|
|
(must stream? strm 'stream-scan "non-stream argument")
|
|
(stream-let recur ((base base) (strm strm))
|
|
(if (stream-null? strm) (stream base)
|
|
(stream-cons base (recur (proc base (stream-car strm))
|
|
(stream-cdr strm))))))
|
|
|
|
(define (stream-take n strm)
|
|
(must stream? strm 'stream-take "non-stream argument")
|
|
(must integer? n 'stream-take "non-integer argument")
|
|
(must exact? n 'stream-take "inexact argument")
|
|
(must-not negative? n 'stream-take "negative argument")
|
|
(stream-let recur ((n n) (strm strm))
|
|
(if (or (zero? n) (stream-null? strm)) stream-null
|
|
(stream-cons (stream-car strm) (recur (1- n) (stream-cdr strm))))))
|
|
|
|
(define (stream-take-while pred? strm)
|
|
(must procedure? pred? 'stream-take-while "non-procedural argument")
|
|
(must stream? strm 'stream-take-while "non-stream argument")
|
|
(stream-let recur ((strm strm))
|
|
(cond ((stream-null? strm) stream-null)
|
|
((pred? (stream-car strm))
|
|
(stream-cons (stream-car strm) (recur (stream-cdr strm))))
|
|
(else stream-null))))
|
|
|
|
(define (stream-unfold mapper pred? generator base)
|
|
(must procedure? mapper 'stream-unfold "non-procedural mapper")
|
|
(must procedure? pred? 'stream-unfold "non-procedural pred?")
|
|
(must procedure? generator 'stream-unfold "non-procedural generator")
|
|
(stream-let recur ((base base))
|
|
(if (pred? base)
|
|
(stream-cons (mapper base) (recur (generator base)))
|
|
stream-null)))
|
|
|
|
(define (stream-unfolds gen seed)
|
|
(define-stream (generator-stream seed)
|
|
(receive (next . items) (gen seed)
|
|
(stream-cons (list->vector items) (generator-stream next))))
|
|
(define-stream (make-result-stream genstrm index)
|
|
(define head (vector-ref (stream-car genstrm) index))
|
|
(define-stream (tail) (make-result-stream (stream-cdr genstrm) index))
|
|
(match head
|
|
(() stream-null)
|
|
(#f (tail))
|
|
((item) (stream-cons item (tail)))
|
|
((? list? items) (stream-append (list->stream items) (tail)))))
|
|
|
|
(must procedure? gen 'stream-unfolds "non-procedural argument")
|
|
(let ((genstrm (generator-stream seed)))
|
|
(apply values (list-tabulate (vector-length (stream-car genstrm))
|
|
(cut make-result-stream genstrm <>)))))
|
|
|
|
(define (stream-zip strm . rest)
|
|
(let ((strms (cons strm rest)))
|
|
(must-every stream? strms 'stream-zip "non-stream argument")
|
|
(stream-let recur ((strms strms))
|
|
(if (any stream-null? strms) stream-null
|
|
(stream-cons (map stream-car strms) (recur (map stream-cdr strms)))))))
|