summaryrefslogtreecommitdiff
path: root/module/ice-9/streams.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/ice-9/streams.scm')
-rw-r--r--module/ice-9/streams.scm168
1 files changed, 168 insertions, 0 deletions
diff --git a/module/ice-9/streams.scm b/module/ice-9/streams.scm
new file mode 100644
index 000000000..587fb8c99
--- /dev/null
+++ b/module/ice-9/streams.scm
@@ -0,0 +1,168 @@
+;;;; streams.scm --- general lazy streams
+;;;; -*- Scheme -*-
+
+;;;; Copyright (C) 1999, 2001, 2004, 2006, 2015 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;; the basic stream operations are inspired by
+;; (i.e. ripped off) Scheme48's `stream' package,
+;; modulo stream-empty? -> stream-null? renaming.
+
+(define-module (ice-9 streams)
+ #:use-module ((srfi srfi-41) #:prefix srfi-41:)
+ #:export (make-stream
+ vector->stream port->stream
+ stream->reversed-list
+ stream->list&length stream->reversed-list&length
+ stream->vector
+ stream-fold)
+ #:re-export ((srfi-41:stream-car . stream-car)
+ (srfi-41:stream-cdr . stream-cdr)
+ (srfi-41:stream-null? . stream-null?)
+ (srfi-41:list->stream . list->stream)
+ (srfi-41:stream->list . stream->list)
+ (srfi-41:stream-for-each . stream-for-each)
+ (srfi-41:stream-map . stream-map)))
+
+;; Use:
+;;
+;; (make-stream producer initial-state)
+;; - PRODUCER is a function of one argument, the current state.
+;; it should return either a pair or an atom (i.e. anything that
+;; is not a pair). if PRODUCER returns a pair, then the car of the pair
+;; is the stream's head value, and the cdr is the state to be fed
+;; to PRODUCER later. if PRODUCER returns an atom, then the stream is
+;; considered depleted.
+;;
+;; (stream-car stream)
+;; (stream-cdr stream)
+;; (stream-null? stream)
+;; - yes.
+;;
+;; (list->stream list)
+;; (vector->stream vector)
+;; - make a stream with the same contents as LIST/VECTOR.
+;;
+;; (port->stream port read)
+;; - makes a stream of values which are obtained by READing from PORT.
+;;
+;; (stream->list stream)
+;; - returns a list with the same contents as STREAM.
+;;
+;; (stream->reversed-list stream)
+;; - as above, except the contents are in reversed order.
+;;
+;; (stream->list&length stream)
+;; (stream->reversed-list&length stream)
+;; - multiple-valued versions of the above two, the second value is the
+;; length of the resulting list (so you get it for free).
+;;
+;; (stream->vector stream)
+;; - yes.
+;;
+;; (stream-fold proc init stream0 ...)
+;; - PROC must take (+ 1 <number-of-stream-arguments>) arguments, like this:
+;; (PROC car0 ... init). *NOTE*: the INIT argument is last, not first.
+;; I don't have any preference either way, but it's consistent with
+;; `fold[lr]' procedures from SRFI-1. PROC is applied to successive
+;; elements of the given STREAM(s) and to the value of the previous
+;; invocation (INIT on the first invocation). the last result from PROC
+;; is returned.
+;;
+;; (stream-for-each proc stream0 ...)
+;; - like `for-each' we all know and love.
+;;
+;; (stream-map proc stream0 ...)
+;; - like `map', except returns a stream of results, and not a list.
+
+;; Code:
+
+(define (make-stream m state)
+ (srfi-41:stream-let recur ((state state))
+ (let ((state (m state)))
+ (if (pair? state)
+ (srfi-41:stream-cons (car state) (recur (cdr state)))
+ srfi-41:stream-null))))
+
+(define (vector->stream v)
+ (make-stream
+ (let ((len (vector-length v)))
+ (lambda (i)
+ (or (= i len)
+ (cons (vector-ref v i) (+ 1 i)))))
+ 0))
+
+(define (stream->reversed-list&length stream)
+ (let loop ((s stream) (acc '()) (len 0))
+ (if (srfi-41:stream-null? s)
+ (values acc len)
+ (loop (srfi-41:stream-cdr s)
+ (cons (srfi-41:stream-car s) acc) (+ 1 len)))))
+
+(define (stream->reversed-list stream)
+ (call-with-values
+ (lambda () (stream->reversed-list&length stream))
+ (lambda (l len) l)))
+
+(define (stream->list&length stream)
+ (call-with-values
+ (lambda () (stream->reversed-list&length stream))
+ (lambda (l len) (values (reverse! l) len))))
+
+(define (stream->vector stream)
+ (call-with-values
+ (lambda () (stream->reversed-list&length stream))
+ (lambda (l len)
+ (let ((v (make-vector len)))
+ (let loop ((i 0) (l l))
+ (if (not (null? l))
+ (begin
+ (vector-set! v (- len i 1) (car l))
+ (loop (+ 1 i) (cdr l)))))
+ v))))
+
+(define (stream-fold f init stream . rest)
+ (if (null? rest) ;fast path
+ (stream-fold-one f init stream)
+ (stream-fold-many f init (cons stream rest))))
+
+(define (stream-fold-one f r stream)
+ (if (srfi-41:stream-null? stream)
+ r
+ (stream-fold-one f
+ (f (srfi-41:stream-car stream) r)
+ (srfi-41:stream-cdr stream))))
+
+(define (stream-fold-many f r streams)
+ (if (or-map srfi-41:stream-null? streams)
+ r
+ (stream-fold-many f
+ (apply f (let recur ((cars
+ (map srfi-41:stream-car streams)))
+ (if (null? cars)
+ (list r)
+ (cons (car cars)
+ (recur (cdr cars))))))
+ (map srfi-41:stream-cdr streams))))
+
+(define (port->stream port read)
+ (make-stream (lambda (p)
+ (let ((o (read p)))
+ (or (eof-object? o)
+ (cons o p))))
+ port))
+
+;;; streams.scm ends here