ice-9/streams.scm

   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
  20
  21 ;; the basic stream operations are inspired by
  22 ;; (i.e. ripped off) Scheme48's `stream' package,
  23 ;; modulo stream-empty? -> stream-null? renaming.
  24
  25 (define-module (ice-9 streams))
  26
  27 (export make-stream
  28         stream-car stream-cdr stream-null?
  29         list->stream vector->stream port->stream
  30         stream->list stream->reversed-list
  31         stream->list&length stream->reversed-list&length
  32         stream->vector
  33         stream-fold stream-for-each stream-map)
  34
  35 ;; Use:
  36 ;;
  37 ;; (make-stream producer initial-state)
  38 ;;  - PRODUCER is a function of one argument, the current state.
  39 ;;    it should return either a pair or an atom (i.e. anything that
  40 ;;    is not a pair).  if PRODUCER returns a pair, then the car of the pair
  41 ;;    is the stream's head value, and the cdr is the state to be fed
  42 ;;    to PRODUCER later.  if PRODUCER returns an atom, then the stream is
  43 ;;    considered depleted.
  44 ;;
  45 ;; (stream-car stream)
  46 ;; (stream-cdr stream)
  47 ;; (stream-null? stream)
  48 ;;  - yes.
  49 ;;
  50 ;; (list->stream list)
  51 ;; (vector->stream vector)
  52 ;;  - make a stream with the same contents as LIST/VECTOR.
  53 ;;
  54 ;; (port->stream port read)
  55 ;;  - makes a stream of values which are obtained by READing from PORT.
  56 ;;
  57 ;; (stream->list stream)
  58 ;;  - returns a list with the same contents as STREAM.
  59 ;;
  60 ;; (stream->reversed-list stream)
  61 ;;  - as above, except the contents are in reversed order.
  62 ;;
  63 ;; (stream->list&length stream)
  64 ;; (stream->reversed-list&length stream)
  65 ;;  - multiple-valued versions of the above two, the second value is the
  66 ;;    length of the resulting list (so you get it for free).
  67 ;;
  68 ;; (stream->vector stream)
  69 ;;  - yes.
  70 ;;
  71 ;; (stream-fold proc init stream0 ...)
  72 ;;  - PROC must take (+ 1 <number-of-stream-arguments>) arguments, like this:
  73 ;;    (PROC car0 ... init).  *NOTE*: the INIT argument is last, not first.
  74 ;;    I don't have any preference either way, but it's consistent with
  75 ;;    `fold[lr]' procedures from SRFI-1.  PROC is applied to successive
  76 ;;    elements of the given STREAM(s) and to the value of the previous
  77 ;;    invocation (INIT on the first invocation).  the last result from PROC
  78 ;;    is returned.
  79 ;;
  80 ;; (stream-for-each proc stream0 ...)
  81 ;;  - like `for-each' we all know and love.
  82 ;;
  83 ;; (stream-map proc stream0 ...)
  84 ;;  - like `map', except returns a stream of results, and not a list.
  85
  86 ;; Code:
  87
  88 (define (make-stream m state)
  89   (delay
  90     (let ((o (m state)))
  91       (if (pair? o)
  92           (cons (car o)
  93                 (make-stream m (cdr o)))
  94           '()))))
  95
  96 (define (stream-car stream)
  97   (car (force stream)))
  98
  99 (define (stream-cdr stream)
 100   (cdr (force stream)))
 101
 102 (define (stream-null? stream)
 103   (null? (force stream)))
 104
 105 (define (list->stream l)
 106   (make-stream
 107    (lambda (l) l)
 108    l))
 109
 110 (define (vector->stream v)
 111   (make-stream
 112    (let ((len (vector-length v)))
 113      (lambda (i)
 114        (or (= i len)
 115            (cons (vector-ref v i) (+ 1 i)))))
 116    0))
 117
 118 (define (stream->reversed-list&length stream)
 119   (let loop ((s stream) (acc '()) (len 0))
 120     (if (stream-null? s)
 121         (values acc len)
 122         (loop (stream-cdr s) (cons (stream-car s) acc) (+ 1 len)))))
 123
 124 (define (stream->reversed-list stream)
 125   (call-with-values
 126    (lambda () (stream->reversed-list&length stream))
 127    (lambda (l len) l)))
 128
 129 (define (stream->list&length stream)
 130   (call-with-values
 131    (lambda () (stream->reversed-list&length stream))
 132    (lambda (l len) (values (reverse! l) len))))
 133
 134 (define (stream->list stream)
 135   (reverse! (stream->reversed-list stream)))
 136
 137 (define (stream->vector stream)
 138   (call-with-values
 139    (lambda () (stream->reversed-list&length stream))
 140    (lambda (l len)
 141      (let ((v (make-vector len)))
 142        (let loop ((i 0) (l l))
 143          (if (not (null? l))
 144              (begin
 145                (vector-set! v (- len i 1) (car l))
 146                (loop (+ 1 i) (cdr l)))))
 147        v))))
 148
 149 (define (stream-fold f init stream . rest)
 150   (if (null? rest) ;fast path
 151       (let loop ((stream stream) (r init))
 152         (if (stream-null? stream)
 153             r
 154             (loop (stream-cdr stream) (f (stream-car stream) r))))
 155       (let loop ((streams (cons stream rest)) (r init))
 156         (if (or-map stream-null? streams)
 157             r
 158             (loop (map stream-cdr streams)
 159                   (apply f (let recur ((cars (map stream-car streams)))
 160                              (if (null? cars)
 161                                  (list r)
 162                                  (cons (car cars)
 163                                        (recur (cdr cars)))))))))))
 164
 165 (define (stream-for-each f stream . rest)
 166   (apply stream-fold
 167          (lambda (elt _) (f elt))
 168          #f
 169          stream rest))
 170
 171 (define (stream-map f stream . rest)
 172   (if (null? rest) ;fast path
 173       (make-stream (lambda (s)
 174                      (or (stream-null? s)
 175                          (cons (f (stream-car s)) (stream-cdr s))))
 176                    stream)
 177       (make-stream (lambda (streams)
 178                      (or (or-map stream-null? streams)
 179                          (cons (apply f (map stream-car streams))
 180                                (map stream-cdr streams))))
 181                    (cons stream rest))))
 182
 183 (define (port->stream port read)
 184   (make-stream (lambda (p)
 185                  (let ((o (read p)))
 186                    (or (eof-object? o)
 187                        (cons o p))))
 188                port))
 189
 190 ;;; streams.scm ends here