| 1 | ;;;; streams.scm --- general lazy streams |
| 2 | ;;;; -*- Scheme -*- |
| 3 | |
| 4 | ;;;; Copyright (C) 1999 Free Software Foundation, Inc. |
| 5 | ;;;; |
| 6 | ;;;; This program is free software; you can redistribute it and/or modify |
| 7 | ;;;; it under the terms of the GNU General Public License as published by |
| 8 | ;;;; the Free Software Foundation; either version 2, or (at your option) |
| 9 | ;;;; any later version. |
| 10 | ;;;; |
| 11 | ;;;; This program is distributed in the hope that it will be useful, |
| 12 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;;; GNU General Public License for more details. |
| 15 | ;;;; |
| 16 | ;;;; You should have received a copy of the GNU General Public License |
| 17 | ;;;; along with this software; see the file COPYING. If not, write to |
| 18 | ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, |
| 19 | ;;;; Boston, MA 02111-1307 USA |
| 20 | |
| 21 | ;; the basic stream operations are inspired by |
| 22 | ;; (i.e. ripped off) Scheme48's `stream' package, |
| 23 | ;; modulo stream-empty? -> stream-null? renaming. |
| 24 | |
| 25 | (define-module (ice-9 streams)) |
| 26 | |
| 27 | (export make-stream |
| 28 | stream-car stream-cdr stream-null? |
| 29 | list->stream vector->stream port->stream |
| 30 | stream->list stream->reversed-list |
| 31 | stream->list&length stream->reversed-list&length |
| 32 | stream->vector |
| 33 | stream-fold stream-for-each stream-map) |
| 34 | |
| 35 | ;; Use: |
| 36 | ;; |
| 37 | ;; (make-stream producer initial-state) |
| 38 | ;; - PRODUCER is a function of one argument, the current state. |
| 39 | ;; it should return either a pair or an atom (i.e. anything that |
| 40 | ;; is not a pair). if PRODUCER returns a pair, then the car of the pair |
| 41 | ;; is the stream's head value, and the cdr is the state to be fed |
| 42 | ;; to PRODUCER later. if PRODUCER returns an atom, then the stream is |
| 43 | ;; considered depleted. |
| 44 | ;; |
| 45 | ;; (stream-car stream) |
| 46 | ;; (stream-cdr stream) |
| 47 | ;; (stream-null? stream) |
| 48 | ;; - yes. |
| 49 | ;; |
| 50 | ;; (list->stream list) |
| 51 | ;; (vector->stream vector) |
| 52 | ;; - make a stream with the same contents as LIST/VECTOR. |
| 53 | ;; |
| 54 | ;; (port->stream port read) |
| 55 | ;; - makes a stream of values which are obtained by READing from PORT. |
| 56 | ;; |
| 57 | ;; (stream->list stream) |
| 58 | ;; - returns a list with the same contents as STREAM. |
| 59 | ;; |
| 60 | ;; (stream->reversed-list stream) |
| 61 | ;; - as above, except the contents are in reversed order. |
| 62 | ;; |
| 63 | ;; (stream->list&length stream) |
| 64 | ;; (stream->reversed-list&length stream) |
| 65 | ;; - multiple-valued versions of the above two, the second value is the |
| 66 | ;; length of the resulting list (so you get it for free). |
| 67 | ;; |
| 68 | ;; (stream->vector stream) |
| 69 | ;; - yes. |
| 70 | ;; |
| 71 | ;; (stream-fold proc init stream0 ...) |
| 72 | ;; - PROC must take (+ 1 <number-of-stream-arguments>) arguments, like this: |
| 73 | ;; (PROC car0 ... init). *NOTE*: the INIT argument is last, not first. |
| 74 | ;; I don't have any preference either way, but it's consistent with |
| 75 | ;; `fold[lr]' procedures from SRFI-1. PROC is applied to successive |
| 76 | ;; elements of the given STREAM(s) and to the value of the previous |
| 77 | ;; invocation (INIT on the first invocation). the last result from PROC |
| 78 | ;; is returned. |
| 79 | ;; |
| 80 | ;; (stream-for-each proc stream0 ...) |
| 81 | ;; - like `for-each' we all know and love. |
| 82 | ;; |
| 83 | ;; (stream-map proc stream0 ...) |
| 84 | ;; - like `map', except returns a stream of results, and not a list. |
| 85 | |
| 86 | ;; Code: |
| 87 | |
| 88 | (define (make-stream m state) |
| 89 | (delay |
| 90 | (let ((o (m state))) |
| 91 | (if (pair? o) |
| 92 | (cons (car o) |
| 93 | (make-stream m (cdr o))) |
| 94 | '())))) |
| 95 | |
| 96 | (define (stream-car stream) |
| 97 | "Returns the first element in STREAM. This is equivalent to `car'." |
| 98 | (car (force stream))) |
| 99 | |
| 100 | (define (stream-cdr stream) |
| 101 | "Returns the first tail of STREAM. Equivalent to `(force (cdr STREAM))'." |
| 102 | (cdr (force stream))) |
| 103 | |
| 104 | (define (stream-null? stream) |
| 105 | "Returns `#t' if STREAM is the end-of-stream marker; otherwise |
| 106 | returns `#f'. This is equivalent to `null?', but should be used |
| 107 | whenever testing for the end of a stream." |
| 108 | (null? (force stream))) |
| 109 | |
| 110 | (define (list->stream l) |
| 111 | "Returns a newly allocated stream whose elements are the elements of |
| 112 | LIST. Equivalent to `(apply stream LIST)'." |
| 113 | (make-stream |
| 114 | (lambda (l) l) |
| 115 | l)) |
| 116 | |
| 117 | (define (vector->stream v) |
| 118 | (make-stream |
| 119 | (let ((len (vector-length v))) |
| 120 | (lambda (i) |
| 121 | (or (= i len) |
| 122 | (cons (vector-ref v i) (+ 1 i))))) |
| 123 | 0)) |
| 124 | |
| 125 | (define (stream->reversed-list&length stream) |
| 126 | (let loop ((s stream) (acc '()) (len 0)) |
| 127 | (if (stream-null? s) |
| 128 | (values acc len) |
| 129 | (loop (stream-cdr s) (cons (stream-car s) acc) (+ 1 len))))) |
| 130 | |
| 131 | (define (stream->reversed-list stream) |
| 132 | (call-with-values |
| 133 | (lambda () (stream->reversed-list&length stream)) |
| 134 | (lambda (l len) l))) |
| 135 | |
| 136 | (define (stream->list&length stream) |
| 137 | (call-with-values |
| 138 | (lambda () (stream->reversed-list&length stream)) |
| 139 | (lambda (l len) (values (reverse! l) len)))) |
| 140 | |
| 141 | (define (stream->list stream) |
| 142 | "Returns a newly allocated list whose elements are the elements of STREAM. |
| 143 | If STREAM has infinite length this procedure will not terminate." |
| 144 | (reverse! (stream->reversed-list stream))) |
| 145 | |
| 146 | (define (stream->vector stream) |
| 147 | (call-with-values |
| 148 | (lambda () (stream->reversed-list&length stream)) |
| 149 | (lambda (l len) |
| 150 | (let ((v (make-vector len))) |
| 151 | (let loop ((i 0) (l l)) |
| 152 | (if (not (null? l)) |
| 153 | (begin |
| 154 | (vector-set! v (- len i 1) (car l)) |
| 155 | (loop (+ 1 i) (cdr l))))) |
| 156 | v)))) |
| 157 | |
| 158 | (define (stream-fold f init stream . rest) |
| 159 | (if (null? rest) ;fast path |
| 160 | (stream-fold-one f init stream) |
| 161 | (stream-fold-many f init (cons stream rest)))) |
| 162 | |
| 163 | (define (stream-fold-one f r stream) |
| 164 | (if (stream-null? stream) |
| 165 | r |
| 166 | (stream-fold-one f (f (stream-car stream) r) (stream-cdr stream)))) |
| 167 | |
| 168 | (define (stream-fold-many f r streams) |
| 169 | (if (or-map stream-null? streams) |
| 170 | r |
| 171 | (stream-fold-many f |
| 172 | (apply f (let recur ((cars |
| 173 | (map stream-car streams))) |
| 174 | (if (null? cars) |
| 175 | (list r) |
| 176 | (cons (car cars) |
| 177 | (recur (cdr cars)))))) |
| 178 | (map stream-cdr streams)))) |
| 179 | |
| 180 | (define (stream-for-each f stream . rest) |
| 181 | (if (null? rest) ;fast path |
| 182 | (stream-for-each-one f stream) |
| 183 | (stream-for-each-many f (cons stream rest)))) |
| 184 | |
| 185 | (define (stream-for-each-one f stream) |
| 186 | (if (not (stream-null? stream)) |
| 187 | (begin |
| 188 | (f (stream-car stream)) |
| 189 | (stream-for-each-one f (stream-cdr stream))))) |
| 190 | |
| 191 | (define (stream-for-each-may f streams) |
| 192 | (if (not (or-map stream-null? streams)) |
| 193 | (begin |
| 194 | (apply f (map stream-car streams)) |
| 195 | (stream-for-each-one f (map stream-cdr streams))))) |
| 196 | |
| 197 | (define (stream-map f stream . rest) |
| 198 | "Returns a newly allocated stream, each element being the result of |
| 199 | invoking F with the corresponding elements of the STREAMs |
| 200 | as its arguments." |
| 201 | (if (null? rest) ;fast path |
| 202 | (make-stream (lambda (s) |
| 203 | (or (stream-null? s) |
| 204 | (cons (f (stream-car s)) (stream-cdr s)))) |
| 205 | stream) |
| 206 | (make-stream (lambda (streams) |
| 207 | (or (or-map stream-null? streams) |
| 208 | (cons (apply f (map stream-car streams)) |
| 209 | (map stream-cdr streams)))) |
| 210 | (cons stream rest)))) |
| 211 | |
| 212 | (define (port->stream port read) |
| 213 | (make-stream (lambda (p) |
| 214 | (let ((o (read p))) |
| 215 | (or (eof-object? o) |
| 216 | (cons o p)))) |
| 217 | port)) |
| 218 | |
| 219 | ;;; streams.scm ends here |