Commit | Line | Data |
---|---|---|
8cdfb9aa JB |
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 | |
a482f2cc MV |
20 | ;;;; |
21 | ;;;; As a special exception, the Free Software Foundation gives permission | |
22 | ;;;; for additional uses of the text contained in its release of GUILE. | |
23 | ;;;; | |
24 | ;;;; The exception is that, if you link the GUILE library with other files | |
25 | ;;;; to produce an executable, this does not by itself cause the | |
26 | ;;;; resulting executable to be covered by the GNU General Public License. | |
27 | ;;;; Your use of that executable is in no way restricted on account of | |
28 | ;;;; linking the GUILE library code into it. | |
29 | ;;;; | |
30 | ;;;; This exception does not however invalidate any other reasons why | |
31 | ;;;; the executable file might be covered by the GNU General Public License. | |
32 | ;;;; | |
33 | ;;;; This exception applies only to the code released by the | |
34 | ;;;; Free Software Foundation under the name GUILE. If you copy | |
35 | ;;;; code from other Free Software Foundation releases into a copy of | |
36 | ;;;; GUILE, as the General Public License permits, the exception does | |
37 | ;;;; not apply to the code that you add in this way. To avoid misleading | |
38 | ;;;; anyone as to the status of such modified files, you must delete | |
39 | ;;;; this exception notice from them. | |
40 | ;;;; | |
41 | ;;;; If you write modifications of your own for GUILE, it is your choice | |
42 | ;;;; whether to permit this exception to apply to your modifications. | |
43 | ;;;; If you do not wish that, delete this exception notice. | |
8cdfb9aa JB |
44 | |
45 | ;; the basic stream operations are inspired by | |
46 | ;; (i.e. ripped off) Scheme48's `stream' package, | |
47 | ;; modulo stream-empty? -> stream-null? renaming. | |
48 | ||
49 | (define-module (ice-9 streams)) | |
50 | ||
51 | (export make-stream | |
52 | stream-car stream-cdr stream-null? | |
53 | list->stream vector->stream port->stream | |
54 | stream->list stream->reversed-list | |
55 | stream->list&length stream->reversed-list&length | |
56 | stream->vector | |
57 | stream-fold stream-for-each stream-map) | |
58 | ||
59 | ;; Use: | |
60 | ;; | |
61 | ;; (make-stream producer initial-state) | |
62 | ;; - PRODUCER is a function of one argument, the current state. | |
63 | ;; it should return either a pair or an atom (i.e. anything that | |
64 | ;; is not a pair). if PRODUCER returns a pair, then the car of the pair | |
65 | ;; is the stream's head value, and the cdr is the state to be fed | |
66 | ;; to PRODUCER later. if PRODUCER returns an atom, then the stream is | |
67 | ;; considered depleted. | |
68 | ;; | |
69 | ;; (stream-car stream) | |
70 | ;; (stream-cdr stream) | |
71 | ;; (stream-null? stream) | |
72 | ;; - yes. | |
73 | ;; | |
74 | ;; (list->stream list) | |
75 | ;; (vector->stream vector) | |
76 | ;; - make a stream with the same contents as LIST/VECTOR. | |
77 | ;; | |
78 | ;; (port->stream port read) | |
79 | ;; - makes a stream of values which are obtained by READing from PORT. | |
80 | ;; | |
81 | ;; (stream->list stream) | |
82 | ;; - returns a list with the same contents as STREAM. | |
83 | ;; | |
84 | ;; (stream->reversed-list stream) | |
85 | ;; - as above, except the contents are in reversed order. | |
86 | ;; | |
87 | ;; (stream->list&length stream) | |
88 | ;; (stream->reversed-list&length stream) | |
89 | ;; - multiple-valued versions of the above two, the second value is the | |
90 | ;; length of the resulting list (so you get it for free). | |
91 | ;; | |
92 | ;; (stream->vector stream) | |
93 | ;; - yes. | |
94 | ;; | |
95 | ;; (stream-fold proc init stream0 ...) | |
96 | ;; - PROC must take (+ 1 <number-of-stream-arguments>) arguments, like this: | |
97 | ;; (PROC car0 ... init). *NOTE*: the INIT argument is last, not first. | |
98 | ;; I don't have any preference either way, but it's consistent with | |
99 | ;; `fold[lr]' procedures from SRFI-1. PROC is applied to successive | |
100 | ;; elements of the given STREAM(s) and to the value of the previous | |
101 | ;; invocation (INIT on the first invocation). the last result from PROC | |
102 | ;; is returned. | |
103 | ;; | |
104 | ;; (stream-for-each proc stream0 ...) | |
105 | ;; - like `for-each' we all know and love. | |
106 | ;; | |
107 | ;; (stream-map proc stream0 ...) | |
108 | ;; - like `map', except returns a stream of results, and not a list. | |
109 | ||
110 | ;; Code: | |
111 | ||
112 | (define (make-stream m state) | |
113 | (delay | |
114 | (let ((o (m state))) | |
115 | (if (pair? o) | |
116 | (cons (car o) | |
117 | (make-stream m (cdr o))) | |
118 | '())))) | |
119 | ||
120 | (define (stream-car stream) | |
ed11b876 | 121 | "Returns the first element in STREAM. This is equivalent to `car'." |
8cdfb9aa JB |
122 | (car (force stream))) |
123 | ||
124 | (define (stream-cdr stream) | |
ed11b876 | 125 | "Returns the first tail of STREAM. Equivalent to `(force (cdr STREAM))'." |
8cdfb9aa JB |
126 | (cdr (force stream))) |
127 | ||
128 | (define (stream-null? stream) | |
ed11b876 GB |
129 | "Returns `#t' if STREAM is the end-of-stream marker; otherwise |
130 | returns `#f'. This is equivalent to `null?', but should be used | |
131 | whenever testing for the end of a stream." | |
8cdfb9aa JB |
132 | (null? (force stream))) |
133 | ||
134 | (define (list->stream l) | |
ed11b876 GB |
135 | "Returns a newly allocated stream whose elements are the elements of |
136 | LIST. Equivalent to `(apply stream LIST)'." | |
8cdfb9aa JB |
137 | (make-stream |
138 | (lambda (l) l) | |
139 | l)) | |
140 | ||
141 | (define (vector->stream v) | |
142 | (make-stream | |
143 | (let ((len (vector-length v))) | |
144 | (lambda (i) | |
145 | (or (= i len) | |
146 | (cons (vector-ref v i) (+ 1 i))))) | |
147 | 0)) | |
148 | ||
149 | (define (stream->reversed-list&length stream) | |
150 | (let loop ((s stream) (acc '()) (len 0)) | |
151 | (if (stream-null? s) | |
152 | (values acc len) | |
153 | (loop (stream-cdr s) (cons (stream-car s) acc) (+ 1 len))))) | |
154 | ||
155 | (define (stream->reversed-list stream) | |
156 | (call-with-values | |
157 | (lambda () (stream->reversed-list&length stream)) | |
158 | (lambda (l len) l))) | |
159 | ||
160 | (define (stream->list&length stream) | |
161 | (call-with-values | |
162 | (lambda () (stream->reversed-list&length stream)) | |
163 | (lambda (l len) (values (reverse! l) len)))) | |
164 | ||
165 | (define (stream->list stream) | |
ed11b876 GB |
166 | "Returns a newly allocated list whose elements are the elements of STREAM. |
167 | If STREAM has infinite length this procedure will not terminate." | |
8cdfb9aa JB |
168 | (reverse! (stream->reversed-list stream))) |
169 | ||
170 | (define (stream->vector stream) | |
171 | (call-with-values | |
172 | (lambda () (stream->reversed-list&length stream)) | |
173 | (lambda (l len) | |
174 | (let ((v (make-vector len))) | |
175 | (let loop ((i 0) (l l)) | |
176 | (if (not (null? l)) | |
177 | (begin | |
178 | (vector-set! v (- len i 1) (car l)) | |
179 | (loop (+ 1 i) (cdr l))))) | |
180 | v)))) | |
181 | ||
182 | (define (stream-fold f init stream . rest) | |
183 | (if (null? rest) ;fast path | |
b87e3d4d ML |
184 | (stream-fold-one f init stream) |
185 | (stream-fold-many f init (cons stream rest)))) | |
186 | ||
187 | (define (stream-fold-one f r stream) | |
188 | (if (stream-null? stream) | |
189 | r | |
190 | (stream-fold-one f (f (stream-car stream) r) (stream-cdr stream)))) | |
191 | ||
192 | (define (stream-fold-many f r streams) | |
193 | (if (or-map stream-null? streams) | |
194 | r | |
195 | (stream-fold-many f | |
196 | (apply f (let recur ((cars | |
197 | (map stream-car streams))) | |
198 | (if (null? cars) | |
199 | (list r) | |
200 | (cons (car cars) | |
201 | (recur (cdr cars)))))) | |
202 | (map stream-cdr streams)))) | |
8cdfb9aa JB |
203 | |
204 | (define (stream-for-each f stream . rest) | |
b87e3d4d ML |
205 | (if (null? rest) ;fast path |
206 | (stream-for-each-one f stream) | |
207 | (stream-for-each-many f (cons stream rest)))) | |
208 | ||
209 | (define (stream-for-each-one f stream) | |
210 | (if (not (stream-null? stream)) | |
211 | (begin | |
212 | (f (stream-car stream)) | |
213 | (stream-for-each-one f (stream-cdr stream))))) | |
214 | ||
215 | (define (stream-for-each-may f streams) | |
216 | (if (not (or-map stream-null? streams)) | |
217 | (begin | |
218 | (apply f (map stream-car streams)) | |
219 | (stream-for-each-one f (map stream-cdr streams))))) | |
8cdfb9aa JB |
220 | |
221 | (define (stream-map f stream . rest) | |
ed11b876 GB |
222 | "Returns a newly allocated stream, each element being the result of |
223 | invoking F with the corresponding elements of the STREAMs | |
224 | as its arguments." | |
8cdfb9aa JB |
225 | (if (null? rest) ;fast path |
226 | (make-stream (lambda (s) | |
227 | (or (stream-null? s) | |
228 | (cons (f (stream-car s)) (stream-cdr s)))) | |
229 | stream) | |
230 | (make-stream (lambda (streams) | |
231 | (or (or-map stream-null? streams) | |
232 | (cons (apply f (map stream-car streams)) | |
233 | (map stream-cdr streams)))) | |
234 | (cons stream rest)))) | |
235 | ||
236 | (define (port->stream port read) | |
237 | (make-stream (lambda (p) | |
238 | (let ((o (read p))) | |
239 | (or (eof-object? o) | |
240 | (cons o p)))) | |
241 | port)) | |
242 | ||
243 | ;;; streams.scm ends here |