share/guile/1.6.0/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   :export (make-stream
  51            stream-car stream-cdr stream-null?
  52            list->stream vector->stream port->stream
  53            stream->list stream->reversed-list
  54            stream->list&length stream->reversed-list&length
  55            stream->vector
  56            stream-fold stream-for-each stream-map))
  57
  58 ;; Use:
  59 ;;
  60 ;; (make-stream producer initial-state)
  61 ;;  - PRODUCER is a function of one argument, the current state.
  62 ;;    it should return either a pair or an atom (i.e. anything that
  63 ;;    is not a pair).  if PRODUCER returns a pair, then the car of the pair
  64 ;;    is the stream's head value, and the cdr is the state to be fed
  65 ;;    to PRODUCER later.  if PRODUCER returns an atom, then the stream is
  66 ;;    considered depleted.
  67 ;;
  68 ;; (stream-car stream)
  69 ;; (stream-cdr stream)
  70 ;; (stream-null? stream)
  71 ;;  - yes.
  72 ;;
  73 ;; (list->stream list)
  74 ;; (vector->stream vector)
  75 ;;  - make a stream with the same contents as LIST/VECTOR.
  76 ;;
  77 ;; (port->stream port read)
  78 ;;  - makes a stream of values which are obtained by READing from PORT.
  79 ;;
  80 ;; (stream->list stream)
  81 ;;  - returns a list with the same contents as STREAM.
  82 ;;
  83 ;; (stream->reversed-list stream)
  84 ;;  - as above, except the contents are in reversed order.
  85 ;;
  86 ;; (stream->list&length stream)
  87 ;; (stream->reversed-list&length stream)
  88 ;;  - multiple-valued versions of the above two, the second value is the
  89 ;;    length of the resulting list (so you get it for free).
  90 ;;
  91 ;; (stream->vector stream)
  92 ;;  - yes.
  93 ;;
  94 ;; (stream-fold proc init stream0 ...)
  95 ;;  - PROC must take (+ 1 <number-of-stream-arguments>) arguments, like this:
  96 ;;    (PROC car0 ... init).  *NOTE*: the INIT argument is last, not first.
  97 ;;    I don't have any preference either way, but it's consistent with
  98 ;;    `fold[lr]' procedures from SRFI-1.  PROC is applied to successive
  99 ;;    elements of the given STREAM(s) and to the value of the previous
 100 ;;    invocation (INIT on the first invocation).  the last result from PROC
 101 ;;    is returned.
 102 ;;
 103 ;; (stream-for-each proc stream0 ...)
 104 ;;  - like `for-each' we all know and love.
 105 ;;
 106 ;; (stream-map proc stream0 ...)
 107 ;;  - like `map', except returns a stream of results, and not a list.
 108
 109 ;; Code:
 110
 111 (define (make-stream m state)
 112   (delay
 113     (let ((o (m state)))
 114       (if (pair? o)
 115           (cons (car o)
 116                 (make-stream m (cdr o)))
 117           '()))))
 118
 119 (define (stream-car stream)
 120   "Returns the first element in STREAM.  This is equivalent to `car'."
 121   (car (force stream)))
 122
 123 (define (stream-cdr stream)
 124   "Returns the first tail of STREAM. Equivalent to `(force (cdr STREAM))'."
 125   (cdr (force stream)))
 126
 127 (define (stream-null? stream)
 128   "Returns `#t' if STREAM is the end-of-stream marker; otherwise
 129 returns `#f'.  This is equivalent to `null?', but should be used
 130 whenever testing for the end of a stream."
 131   (null? (force stream)))
 132
 133 (define (list->stream l)
 134   "Returns a newly allocated stream whose elements are the elements of
 135 LIST.  Equivalent to `(apply stream LIST)'."
 136   (make-stream
 137    (lambda (l) l)
 138    l))
 139
 140 (define (vector->stream v)
 141   (make-stream
 142    (let ((len (vector-length v)))
 143      (lambda (i)
 144        (or (= i len)
 145            (cons (vector-ref v i) (+ 1 i)))))
 146    0))
 147
 148 (define (stream->reversed-list&length stream)
 149   (let loop ((s stream) (acc '()) (len 0))
 150     (if (stream-null? s)
 151         (values acc len)
 152         (loop (stream-cdr s) (cons (stream-car s) acc) (+ 1 len)))))
 153
 154 (define (stream->reversed-list stream)
 155   (call-with-values
 156    (lambda () (stream->reversed-list&length stream))
 157    (lambda (l len) l)))
 158
 159 (define (stream->list&length stream)
 160   (call-with-values
 161    (lambda () (stream->reversed-list&length stream))
 162    (lambda (l len) (values (reverse! l) len))))
 163
 164 (define (stream->list stream)
 165   "Returns a newly allocated list whose elements are the elements of STREAM.
 166 If STREAM has infinite length this procedure will not terminate."
 167   (reverse! (stream->reversed-list stream)))
 168
 169 (define (stream->vector stream)
 170   (call-with-values
 171    (lambda () (stream->reversed-list&length stream))
 172    (lambda (l len)
 173      (let ((v (make-vector len)))
 174        (let loop ((i 0) (l l))
 175          (if (not (null? l))
 176              (begin
 177                (vector-set! v (- len i 1) (car l))
 178                (loop (+ 1 i) (cdr l)))))
 179        v))))
 180
 181 (define (stream-fold f init stream . rest)
 182   (if (null? rest) ;fast path
 183       (stream-fold-one f init stream)
 184       (stream-fold-many f init (cons stream rest))))
 185
 186 (define (stream-fold-one f r stream)
 187   (if (stream-null? stream)
 188       r
 189       (stream-fold-one f (f (stream-car stream) r) (stream-cdr stream))))
 190
 191 (define (stream-fold-many f r streams)
 192   (if (or-map stream-null? streams)
 193       r
 194       (stream-fold-many f
 195                         (apply f (let recur ((cars
 196                                               (map stream-car streams)))
 197                                    (if (null? cars)
 198                                        (list r)
 199                                        (cons (car cars)
 200                                              (recur (cdr cars))))))
 201                         (map stream-cdr streams))))
 202
 203 (define (stream-for-each f stream . rest)
 204   (if (null? rest) ;fast path
 205       (stream-for-each-one f stream)
 206       (stream-for-each-many f (cons stream rest))))
 207
 208 (define (stream-for-each-one f stream)
 209   (if (not (stream-null? stream))
 210       (begin
 211         (f (stream-car stream))
 212         (stream-for-each-one f (stream-cdr stream)))))
 213
 214 (define (stream-for-each-many f streams)
 215   (if (not (or-map stream-null? streams))
 216       (begin
 217         (apply f (map stream-car streams))
 218         (stream-for-each-one f (map stream-cdr streams)))))
 219
 220 (define (stream-map f stream . rest)
 221   "Returns a newly allocated stream, each element being the result of
 222 invoking F with the corresponding elements of the STREAMs
 223 as its arguments."
 224   (if (null? rest) ;fast path
 225       (make-stream (lambda (s)
 226                      (or (stream-null? s)
 227                          (cons (f (stream-car s)) (stream-cdr s))))
 228                    stream)
 229       (make-stream (lambda (streams)
 230                      (or (or-map stream-null? streams)
 231                          (cons (apply f (map stream-car streams))
 232                                (map stream-cdr streams))))
 233                    (cons stream rest))))
 234
 235 (define (port->stream port read)
 236   (make-stream (lambda (p)
 237                  (let ((o (read p)))
 238                    (or (eof-object? o)
 239                        (cons o p))))
 240                port))
 241
 242 ;;; streams.scm ends here