summaryrefslogtreecommitdiff
path: root/sieve/eratosthenes.scm
blob: d9da30d12c213256279778923194e3dcf7cfc483 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37



(add-to-load-path (dirname (current-filename)))

(import
    (srfi srfi-41)
    (extra-functional)
    (my-streams))



(define base (stream-from 2))



(define (mark n item)
    (if (eq? (remainder (car item) n) 0)
        (cons (car item) #f)
        item))



(define-stream (sieve input)
    (stream-let loop ((strm (stream-map (part (flip cons) #t) input)))
        (stream-match strm ((item . rest)
            (if (cdr item)
                (stream-cons
                    (car item)
                    (loop (stream-map (part mark (car item)) rest)))
                (loop rest))))))



(define eratosthenes (sieve base))