(define-macro delay
  (lambda args
    (let ((already-forced (gensym)) (result (gensym)))
      `(let ((,already-forced #f) (,result 0))
	 (lambda ()
	   (if ,already-forced
	       ,result
	       (begin
		 (set! ,already-forced #t)
		 (set! ,result (begin ,@args))
		 ,result)))))))

(define force
  (lambda (f)
    (f)))

(define-macro stream-cons
  (lambda (x y)
    `(cons ,x (delay ,y))))

(define stream-car
  (lambda (x)
    (car x)))

(define stream-cdr
  (lambda (x)
    (force (cdr x))))

(define stream-ref
  (lambda (x n)
    (if (= n 0)
      (stream-car x)
      (stream-ref (stream-cdr x) (- n 1)))))

(define stream-append-helper
  (lambda (x y)
    (if (null? x)
	(force y)
	(stream-cons
	 (stream-car x)
	 (stream-append-helper (stream-cdr x) y)))))

(define-macro stream-append
  (lambda (x y)
    `(stream-append-helper ,x (delay ,y))))

(define stream-map
  (lambda (proc . args)
    (if (null? (car args))
	(stream)
	(stream-cons
	 (apply proc (map stream-car args))
	 (apply stream-map proc (map stream-cdr args))))))

(define stream-for-each
  (lambda (proc . args)
    (if (null? (car args))
	(void)
	(begin
	  (apply proc (map stream-car args))
	  (apply stream-for-each proc (map stream-cdr args))))))

(define stream-filter
  (lambda (pred x)
    (if (null? x)
      (stream)
      (let ((y (stream-car x)))
        (if (pred y)
          (stream-cons y (stream-filter pred (stream-cdr x)))
          (stream-filter pred (stream-cdr x)))))))

(define stream
  (lambda args
    (list->stream args)))

(define list->stream
  (lambda (ls)
    (if (null? ls)
	()
	(stream-cons (car ls)
		     (list->stream (cdr ls))))))

(define stream->list
  (lambda (x)
    (if (null? x)
      ()
      (cons (stream-car x) 
	    (stream->list (stream-cdr x))))))

(define ones
  (stream-cons 1 ones))

(define positive-integers
  (stream-cons 1 (stream-map add1 positive-integers)))


;; 1  1  2  3  5   8  13 ...
;; 0  1  1  2  3   5   8 ...
;; 1  2  3  5  8  13  21 ...

(define fibs
  (stream-map
   + 
   (stream-cons 1 fibs)
   (stream-cons 0 (stream-cons 1 fibs))))

(define fib
  (lambda (n)
    (stream-ref fibs n)))

(define outer-product
  (lambda (proc)
    (stream-map
     (lambda (u) 
       (stream-map (lambda (v) (proc u v)) positive-integers))
     positive-integers)))

(define stream-flatten
  (lambda (x)
    (if (null? x)
	(stream)
	(let ((y (stream-car x)))
	  (stream-append (if (pair? y) y (stream y))
			 (stream-flatten (stream-cdr x)))))))

(define stream-delete
  (lambda (item x)
    (stream-filter (lambda (y) (not (eq? y item)))
		   x)))

(define perms-starting-with
  (lambda (item x)
    (stream-map (lambda (p) (stream-cons item p))
	 (permutations (stream-delete item x)))))

(define permutations
  (lambda (x)
    (if (null? x)
	(stream (stream))
	(stream-flatten 
	 (stream-map (lambda (item) (perms-starting-with item x))
	      x)))))

(define sieve
  (lambda (n)
    (lambda (x)
      (stream-filter
       (lambda (k)
	 (not (zero? (remainder k n))))
       x))))

(define prime-numbers
  (letrec
    ((primes
      (lambda (x)
	(stream-cons
	 (stream-car x)
	 (primes ((sieve (stream-car x)) (stream-cdr x)))))))
    (primes (stream-cdr positive-integers))))