; Purely Functional Streams
; Copyright (C) 2006 Nils M Holm. All rights reserved.

; Simplified versions
;
; (define (stream1 init rest)
;   (lambda ()
;     (cons init
;           (stream1 (rest init) rest))))
;
; (define (stream2 init first rest lim final)
;   (letrec
;     ((new-stream
;        (lambda (v)
;          (lambda ()
;            (cond ((lim v) final)
;              (else (cons (first v)
;                          (new-stream (rest v)))))))))
;     ((new-stream init))))

(define (stream init first filter rest lim final)
  (letrec
    ((new-stream
       (lambda (v)
         (lambda ()
           (letrec
             ((find
                (lambda (x)
                  (cond ((lim x) x)
                    ((filter (first x)) x)
                    (else (find (rest x)))))))
             (let ((nxt (find v)))
               (cond ((lim nxt) final)
                 (else (cons (first nxt)
                             (new-stream (rest nxt)))))))))))
    ((new-stream init))))

(define (all x) #t)

(define (none x) #f)

(define (id x) x)

(define value car)

(define (next s) ((cdr s)))

(define eos #f)

(define eos? not)

(define (list->stream v)
  (stream v car all cdr null? eos))

(define (stream->list s)
  (letrec
    ((s->l
       (lambda (s lst)
         (cond (s (s->l (next s)
                        (cons (value s) lst)))
           (else (reverse lst))))))
    (s->l s ())))

(define (map-stream f s)
  (stream s (lambda (s) (f (value s)))
            all next eos?  eos))

(define (append-streams s1 s2)
  (stream s1 value all next eos?  s2))

(define (filter-stream p s)
  (stream s value p next eos?  eos))

(define (stream-member p s)
  (cond ((eos? s) #f)
    ((p (value s)) s)
    (else (mem-stream p (next s)))))

(define (extract n stream)
  (cond ((zero? n) '())
    (else (cons (car stream)
                (extract (- n 1)
                         ((cdr stream)))))))