;;; Public domain.

(define-syntax lazy
  (syntax-rules ()
    ((LAZY exp)
     (VECTOR (CONS #F (LAMBDA () exp))))))

(define (eager value)
  (vector (cons #t value)))

(define-syntax delay
  (syntax-rules ()
    ((DELAY exp)
     (LAZY (EAGER exp)))))

(define (force promise)
  (let* ((cell (vector-ref promise 0))
         (val (cdr cell)))
    (if (car cell)
        val
        (let* ((new-promise (val))
               ;; For reentrancy.
               (cell (vector-ref promise 0)))
          (cond ((not (car cell))
                 (let ((new-cell (vector-ref new-promise 0)))
                   (set-car! cell (car new-cell))
                   (set-cdr! cell (cdr new-cell)))
                 (vector-set! new-promise 0 cell)))
          (force promise)))))

(define-syntax stream-cons
  (syntax-rules ()
    ((STREAM-CONS a d)
     (DELAY (CONS a d)))))

(define stream-nil (delay '()))

(define (stream-unop op) (lambda (stream) (op (force stream))))

(define stream-null? (stream-unop null?))
(define stream-pair? (stream-unop pair?))

(define stream-car (stream-unop car))
(define stream-cdr (stream-unop cdr))

(define (stream-car+cdr stream)
  (values (stream-car stream) (stream-cdr stream)))

(define-syntax receive
  (syntax-rules ()
    ((RECEIVE formals producer body0 body1 ...)
     (CALL-WITH-VALUES (LAMBDA () producer)
       (LAMBDA formals body0 body1 ...)))))

(define (any? pred list)
  (and (pair? list)
       (or (pred (car list))
           (any? pred (cdr list)))))

(define (stream-map fn . streams)
  (lazy (if (any? stream-null? streams)
            stream-nil
            (stream-cons (apply fn (map stream-car streams))
                         (apply stream-map fn
                                (map stream-cdr streams))))))

(define (stream-filter pred stream)
  (lazy (if (stream-null? stream)
            stream-nil
            (receive (elt more) (stream-car+cdr stream)
              (if (pred elt)
                  (stream-cons elt (stream-filter pred more))
                  (stream-filter pred more))))))

(define (substream-fold cons nil count stream)
  (let loop ((state nil) (count count) (stream stream))
    (if (< count 0)
        state
        (loop (cons (stream-car stream) state)
              (- count 1)
              (stream-cdr stream)))))