123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169 |
- (define-module (ice-9 streams)
- #:use-module ((srfi srfi-41) #:prefix srfi-41:)
- #:export (make-stream
- vector->stream port->stream
- stream->reversed-list
- stream->list&length stream->reversed-list&length
- stream->vector
- stream-fold)
- #:re-export ((srfi-41:stream-car . stream-car)
- (srfi-41:stream-cdr . stream-cdr)
- (srfi-41:stream-null? . stream-null?)
- (srfi-41:list->stream . list->stream)
- (srfi-41:stream->list . stream->list)
- (srfi-41:stream-for-each . stream-for-each)
- (srfi-41:stream-map . stream-map)))
- (define (make-stream m state)
- (srfi-41:stream-let recur ((state state))
- (let ((state (m state)))
- (if (pair? state)
- (srfi-41:stream-cons (car state) (recur (cdr state)))
- srfi-41:stream-null))))
- (define (vector->stream v)
- (make-stream
- (let ((len (vector-length v)))
- (lambda (i)
- (or (= i len)
- (cons (vector-ref v i) (+ 1 i)))))
- 0))
- (define (stream->reversed-list&length stream)
- (let loop ((s stream) (acc '()) (len 0))
- (if (srfi-41:stream-null? s)
- (values acc len)
- (loop (srfi-41:stream-cdr s)
- (cons (srfi-41:stream-car s) acc) (+ 1 len)))))
- (define (stream->reversed-list stream)
- (call-with-values
- (lambda () (stream->reversed-list&length stream))
- (lambda (l len) l)))
- (define (stream->list&length stream)
- (call-with-values
- (lambda () (stream->reversed-list&length stream))
- (lambda (l len) (values (reverse! l) len))))
- (define (stream->vector stream)
- (call-with-values
- (lambda () (stream->reversed-list&length stream))
- (lambda (l len)
- (let ((v (make-vector len)))
- (let loop ((i 0) (l l))
- (if (not (null? l))
- (begin
- (vector-set! v (- len i 1) (car l))
- (loop (+ 1 i) (cdr l)))))
- v))))
- (define (stream-fold f init stream . rest)
- (if (null? rest)
- (stream-fold-one f init stream)
- (stream-fold-many f init (cons stream rest))))
- (define (stream-fold-one f r stream)
- (if (srfi-41:stream-null? stream)
- r
- (stream-fold-one f
- (f (srfi-41:stream-car stream) r)
- (srfi-41:stream-cdr stream))))
- (define (stream-fold-many f r streams)
- (if (or-map srfi-41:stream-null? streams)
- r
- (stream-fold-many f
- (apply f (let recur ((cars
- (map srfi-41:stream-car streams)))
- (if (null? cars)
- (list r)
- (cons (car cars)
- (recur (cdr cars))))))
- (map srfi-41:stream-cdr streams))))
- (define (port->stream port read)
- (make-stream (lambda (p)
- (let ((o (read p)))
- (or (eof-object? o)
- (cons o p))))
- port))
|