; rosettacode.org/wiki/Sieve_of_Eratosthenes#Scheme
; rosettacode.org/wiki/Sieve_of_Eratosthenes#Using_SICP-style_streams
 
 ;;;; Stream Implementation
 (define (head s) (car s))   
 (define (tail s) ((cdr s))) 
 
 ;;;; Stream Utility Functions
 (define (from-By x s)
   (cons x (lambda () (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)
   (cons (f (head s)) (lambda () (s-map f (tail s)))))
 (define (s-diff s1 s2)
   (let ((h1 (head s1)) (h2 (head s2)))
    (cond
     ((< h1 h2) (cons h1 (lambda () (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) (cons h1 (lambda () (s-union (tail s1)       s2 ))))
     ((< h2 h1) (cons h2 (lambda () (s-union       s1  (tail s2)))))
     (else      (cons h1 (lambda () (s-union (tail s1) (tail s2))))))))


 ;;;; all primes' multiples are removed, merged through a tree of unions
 ;;;;  runs in ~ n^1.2 run time in producing n = 2k... 4k primes in Guile(ideone)
 (define (primes-stream)
   (letrec ( (mults (lambda (p) (from-By (* p p) (* 2 p))))
             (no-mults-From (lambda (from)
                  (s-diff (from-By from 2) 
                     (s-tree-join (s-map mults odd-primes)))))
             (odd-primes                        ;; inner feedback loop
                 (cons 3 (lambda () (no-mults-From 5)))) ) 
     (cons 2 (lambda () (no-mults-From 3)))))   ;; result stream
 
 ;;;; 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)
   (cons (head (head sts))
         (lambda () 
           (s-union (tail (head sts))
                    (s-tree-join (pairs (tail sts)))))))
 
 (define (pairs sts)                        ;; {a.(b.t)} -> (a+b).{t}
     (cons (cons (head (head sts)) 
                 (lambda () 
                     (s-union (tail (head sts)) 
                              (head (tail sts)))))
           (lambda () 
             (pairs (tail (tail sts))))))
             
(display (take 2 (drop (- 4000 1) (primes-stream))))