~peter-pearse/ubuntu/natty/guile-1.8/prop001

« back to all changes in this revision

Viewing changes to ice-9/streams.scm

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Schepler
  • Date: 2006-11-09 03:11:16 UTC
  • Revision ID: james.westby@ubuntu.com-20061109031116-hu0q1jxqg12y6yeg
Tags: upstream-1.8.1+1
ImportĀ upstreamĀ versionĀ 1.8.1+1

Show diffs side-by-side

added added

removed removed

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