Streams library

streams.scm

;;;; Streams library

;;;; Copyright (c) 2016, Jeandre Kruger
;;;; All rights reserved.

;;;; Redistribution and use in source and binary forms, with or without modification,
;;;; are permitted provided that the following conditions are met:

;;;; 1. Redistributions of source code must retain the above copyright notice, this
;;;; list of conditions and the following disclaimer.

;;;; 2. Redistributions in binary form must reproduce the above copyright notice, this
;;;; list of conditions and the following disclaimer in the documentation and/or other
;;;; materials provided with the distribution.

;;;; 3. Neither the name of the copyright holder nor the names of its contributors may
;;;; be used to endorse or promote products derived from this software without specific
;;;; prior written permission.

;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY
;;;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;;;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT
;;;; SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;;;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
;;;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
;;;; EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(define the-empty-stream '())

;;; Return #T if the stream STRM is empty
;;; and #F otherwise.
(define (stream-empty? strm)
  (eq? strm the-empty-stream))

;;; Construct and return a new stream with the
;;; head HEAD and the tail TAIL.
(define-syntax cons-stream
  (syntax-rules ()
    ((cons-stream head tail)
     (delay (cons head tail)))))

;;; Return the first item of the stream STRM.
(define (stream-car strm) (car (force strm)))

;;; Return a stream with all elements of the stream
;;; except for the first item.
(define (stream-cdr strm) (cdr (force strm)))

;;; Replace the head of the stream STRM with OBJ.
(define (set-stream-car! strm obj)
  (set-car! (force strm) obj))

;;; Replace the tail of the stream STRM with OBJ.
(define (set-stream-cdr! strm obj)
  (set-cdr! (force strm) obj))

;;; Return a list with the items of the stream
;;; STRM.
(define (stream->list strm)
  (if (stream-empty? strm)
      '()
      (cons (stream-car strm)
            (stream->list (stream-cdr strm)))))

;;; Return a new stream with the items of the
;;; list LST.
(define (list->stream lst)
  (if (null? lst)
      the-empty-stream
      (cons-stream (car lst)
                   (list->stream (cdr lst)))))

;;; Return a new stream of STREAM's arguments.
(define (stream . lst)
  (list->stream lst))

;;; Return the length of the stream STRM.
(define (stream-length strm)
  (let iter ((strm strm)
             (accum 0))
    (if (stream-empty? strm)
        accum
        (iter (stream-cdr strm)
              (+ accum 1)))))

;;; Return a new stream containing all the items
;;; of the streams STRMS in order.
(define (stream-append . strms)
  (cond ((null? strms) the-empty-stream)
        ((stream-empty? (car strms))
         (apply stream-append (cdr strms)))
        (else
         (cons-stream
          (stream-car (car strms))
          (apply stream-append
                 (stream-cdr (car strms))
                 (cdr strms))))))

;;; Return a new stream containing all the items
;;; of A followed by all the items of the stream
;;; obtained by forcing the promise DELAYED-B.
(define (stream-append-delayed a delayed-b)
  (if (stream-empty? a)
      (force delayed-b)
      (cons-stream
       (stream-car a)
       (stream-append-delayed (stream-cdr a) delayed-b))))

;;; Return a new stream containing all the items
;;; of the streams in the stream STRM in order.
(define (stream-flatten strm)
  (if (stream-empty? strm)
      the-empty-stream
      (stream-append-delayed
       (stream-car strm)
       (delay (stream-flatten (stream-cdr strm))))))

;;; Return a stream with the items of the stream
;;; STRM backwards.
(define (stream-reverse strm)
  (let iter ((strm strm)
             (accum the-empty-stream))
    (if (stream-empty? strm)
        accum
        (iter (stream-cdr strm)
              (cons-stream (stream-car strm) accum)))))

;;; Return a new stream with the first K items of
;;; the stream STRM.
(define (stream-head strm k)
  (if (= k 0)
      '()
      (cons-stream (stream-car strm)
                   (stream-head (stream-cdr strm) (- k 1)))))

;;; Return a stream with all items of the stream
;;; STRM except for the first K.
(define (stream-tail strm k)
  (if (= k 0)
      strm
      (stream-tail (stream-cdr strm) (- k 1))))

;;; Return the Kth item of the stream STRM.
(define (stream-ref strm k)
  (stream-car (stream-tail strm k)))

;;; Apply the procedure PROC to each item of
;;; the streams STRMS and return a stream of the
;;; results.
(define (stream-map proc . strms)
  (if (stream-empty? (car strms))
      the-empty-stream
      (cons-stream
       (apply proc (map stream-car strms))
       (apply stream-map proc (map stream-cdr strms)))))

;;; Apply the procedure PROC to each item of
;;; the streams STRMS, returning an unspecified
;;; value.
(define (stream-for-each proc . strms)
  (if (not (stream-empty? (car strms)))
      (begin (apply proc (map stream-car strms))
             (apply stream-for-each
                    proc
                    (map stream-cdr strms)))))

;;; Return a new stream containing all the items
;;; of the stream STRM which satisfy the predicate
;;; PRED.
(define (stream-filter pred strm)
  (cond ((stream-empty? strm) the-empty-stream)
        ((pred (stream-car strm))
         (cons-stream
          (stream-car strm)
          (stream-filter pred (stream-cdr strm))))
        (else (stream-filter pred (stream-cdr strm)))))

;;; Accumulate the items of the stream STRM left,
;;; combining using the procedure PROC and starting
;;; with ACCUM, and return the result.
(define (stream-fold-left proc accum strm)
  (if (stream-empty? strm)
      accum
      (stream-fold-left
       proc
       (proc accum (stream-car strm))
       (stream-cdr strm))))

;;; Accumulate the items of the stream STRM right,
;;; combining using the procedure PROC and ending
;;; with END, and return the result.
(define (stream-fold-right proc end strm)
  (if (stream-empty? strm)
      end
      (proc
       (stream-car strm)
       (stream-fold-right proc end (stream-cdr strm)))))

;;; Return an infinite stream containing all the
;;; items of the stream STRM followed by itself.
(define (stream-cycle strm)
  (stream-append-delayed strm (delay (stream-cycle strm))))

;;; Return an infinite stream where every element is
;;; OBJ.
(define (stream-repeat obj)
  (define strm (cons-stream obj strm))
  strm)

;;; Return a new stream with every element of the stream
;;; STRM up to, but not including, the first element that
;;; does not satisfy PRED.
(define (stream-while pred strm)
  (cond ((stream-empty? strm) the-empty-stream)
        ((pred (stream-car strm))
         (cons-stream (stream-car strm)
                      (stream-while pred (stream-cdr strm))))
        (else the-empty-stream)))