module/ice-9/streams.scm

   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 3 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