;; stream.scm - (c) rohan drape, 2000-2005

;; Binary stream catenation.

(define-syntax stream-++ (syntax-rules () ((_ a b) (stream-append a b))))

;; Stream operations in SRFI-40/41 but not in draft implementation.

(define (stream-unfoldn gen seed n)
  (define (unfold-result-stream gen seed)
    (let loop ((seed seed))
      (call-with-values
          (lambda () (gen seed))
	(lambda (next . results)
	  (stream-cons results (loop next))))))
  (define (result-stream->output-stream result-stream i)
    (let ((result (list-ref (stream-car result-stream) i)))
      (cond ((pair? result)
	     (stream-cons (car result)
			  (result-stream->output-stream
                               (stream-cdr result-stream) i)))
	    ((not result)
	     (result-stream->output-stream (stream-cdr result-stream) i))
	    ((null? result) stream-null)
	    (else (error "stream-unfoldn: can't happen")))))
  (define (result-stream->output-streams result-stream n)
    (let loop ((i 0) (outputs '()))
      (if (= i n)
        (apply values (reverse outputs))
        (loop (+ i 1)
              (cons (result-stream->output-stream result-stream i)
                    outputs)))))
  (result-stream->output-streams (unfold-result-stream gen seed) n))

;; Aliases for SRFI-40/41 procedures.

(define-syntax define-stream
  (syntax-rules ()
    ((_ a ...) 
     (stream-define a ...))))

;; Stream variants of R5RS/SRFI-1 list operations.

(define-stream (stream-iota n start step)
  (if (= n 0)
      stream-null
      (stream-cons start (stream-iota (- n 1) (+ start step) step))))

(define-stream (stream-tail stream index)
  (if (zero? index)
      stream
      (stream-tail (stream-cdr stream) (- index 1))))

;; Stream utilities not in SRFI-40/41.  

;; Math operations on streams.

(define (make-stream-binary-operator op)
  (define-stream (f a b)
    (if (or (stream-null? a)
	    (stream-null? b))
	stream-null
	(stream-cons (op (stream-car a) (stream-car b))
		     (f (stream-cdr a) (stream-cdr b)))))
  f)

(define (make-stream-nary-operator op)
  (define b (make-stream-binary-operator op))
  (define-stream (f . v)
    (case (length v)
      ((0) stream-null)
      ((1) (stream-map op (car v)))
      ((2) (b (car v) (cadr v)))
      (else (b (car v) (apply f (cdr v))))))
  f)

(define stream-+ (make-stream-nary-operator +))
(define stream-- (make-stream-nary-operator -))
(define stream-* (make-stream-nary-operator *))
(define stream-/ (make-stream-nary-operator /))

;; Evaluates to an infite stream having as every element `object'.

(define (value->stream a)
  (stream-cons a (value->stream a)))

(define (as-stream s)
  (cond ((stream? s) s)
	((list? s)   (list->stream))
	(else        (value->stream s))))

;; Count the elements at s.  Diverges if s is not finite.

(define (stream-length s)
  (let loop ((n 0)
	     (s s))
    (if (stream-null? s)
	n
	(loop (+ n 1) (stream-cdr s)))))

;; Evaluates to an infinite stream of integers starting at `n'.

(define-stream (stream-of-integers n)
  (stream-cons n (stream-of-integers (+ n 1))))