ice-9/streams.scm

   1 ;;;; streams.scm --- general lazy streams
   2 ;;;; -*- Scheme -*-
   3
   4 ;;;; Copyright (C) 1999, 2001 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 ;;;; 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.
  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)
 121   "Returns the first element in STREAM.  This is equivalent to `car'."
 122   (car (force stream)))
 123
 124 (define (stream-cdr stream)
 125   "Returns the first tail of STREAM. Equivalent to `(force (cdr STREAM))'."
 126   (cdr (force stream)))
 127
 128 (define (stream-null? stream)
 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."
 132   (null? (force stream)))
 133
 134 (define (list->stream l)
 135   "Returns a newly allocated stream whose elements are the elements of
 136 LIST.  Equivalent to `(apply stream LIST)'."
 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)
 166   "Returns a newly allocated list whose elements are the elements of STREAM.
 167 If STREAM has infinite length this procedure will not terminate."
 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
 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))))
 203
 204 (define (stream-for-each f stream . rest)
 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-many 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)))))
 220
 221 (define (stream-map f stream . rest)
 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."
 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