my c2 wiki SoE on Scheme coinductive streams.scm

;;;; http://wiki.c2.com/?SieveOfEratosthenesInManyProgrammingLanguages

;;;; Stream Implementation
 (define (head s) (car s))          ;; _odd_ non-memoized streams,
 (define (tail s) ((cdr s)))        ;;  per SRFI-41
 (define-syntax s-cons
   (syntax-rules () ((s-cons h t) (cons h (lambda () t))))) 


 ;;;; Stream Utility Functions
 (define (from-By x s)
   (s-cons x (from-By (+ x s) s)))
 
 (define (take n s) 
   (cond 
     ((> n 1) (cons (head s) (take (- n 1) (tail s))))
     ((= n 1) (list (head s)))      ;; don't force it too soon
     (else '())))       ;; so (take 4 (s-map / (from-By 4 -1))) works

 (define (drop n s)
   (cond 
     ((> n 0) (drop (- n 1) (tail s)))
     (else s)))

 (define (s-map f s)
   (s-cons (f (head s)) (s-map f (tail s))))

 (define (s-diff s1 s2)
   (let ((h1 (head s1)) (h2 (head s2)))
    (cond
     ((< h1 h2) (s-cons h1 (s-diff  (tail s1)       s2 )))
     ((< h2 h1)            (s-diff        s1  (tail s2)))
     (else                 (s-diff  (tail s1) (tail s2))))))

 (define (s-union s1 s2)
   (let ((h1 (head s1)) (h2 (head s2)))
    (cond
     ((< h1 h2) (s-cons h1 (s-union (tail s1)       s2 )))
     ((< h2 h1) (s-cons h2 (s-union       s1  (tail s2))))
     (else      (s-cons h1 (s-union (tail s1) (tail s2)))))))

 
 ;;;; odd multiples of an odd prime
 (define (mults p) (from-By (* p p) (* 2 p)))


 ;;;; The Sieve itself, bounded, ~ O(n^1.4) in n primes produced
 ;;;;   (unbounded version runs at ~ O(n^2.2), and growing worse)
 ;;;;   **only valid up to m**, includes composites above it
 (define (primes-To m)
   (define (sieve s) 
	(let ((p (head s))) 
	 (cond ((> (* p p) m) s) 
	  (else (s-cons p 
	          (sieve (s-diff (tail s) (mults p))))))))
   (s-cons 2 (sieve (from-By 3 2))))

 
 ;;;; all the primes' multiples, tree-merged, removed; 
 ;;;;    ~O(n^1.17..1.15) time in producing 100K .. 1M primes
 ;;;;    ~O(1) space (O(pi(sqrt(m))) probably)
 (define (primes-TM)
   (define (no-mults-From from)
       (s-diff (from-By from 2) (s-tree-join (s-map mults odd-primes))))
   (define odd-primes 
       (s-cons 3 (no-mults-From 5)))
   (s-cons 2 (no-mults-From 3)))


 ;;;; join an ordered stream of streams (here, of primes' multiples)
 ;;;; into one ordered stream, via an infinite right-deepening tree
 (define (s-tree-join sts)                               ;; sts -> s
   (define (join-With of-Tail sts)                       ;; sts -> s
     (s-cons (head (head sts))
              (s-union (tail (head sts)) (of-Tail (tail sts)))))
   (define (pairs sts)                                   ;; sts -> sts
     (s-cons (join-With head sts) (pairs (tail (tail sts)))))
   (join-With (lambda (t) (s-tree-join (pairs t))) sts))


 ;;;; Print 10 last primes from the first thousand primes
 (begin 
   (display (take 10 (drop 990 (primes-To 7919)))) (newline)
   (display (take 10 (drop 990 (primes-TM)))) (newline))