module/ice-9/streams.scm

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