summaryrefslogtreecommitdiff
path: root/sieve/euler.scm
blob: ac23a94d5fb5a7ad39f3d93aceb1ac1ff9141130 (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
38
39



(use-modules (srfi srfi-41))



(define base (stream-from 2))



(define (curry f)
    (lambda (x)
        (lambda (y)
            (f x y))))



(define-stream (stream-ordered-diff xstrm ystrm)
    (stream-match xstrm (() '()) ((x . xs)
        (stream-match ystrm (() xstrm) ((y . ys)
            (cond ((< x y) (stream-cons x (stream-ordered-diff xs ystrm)))
                  ((> x y) (stream-ordered-diff xstrm ys))
                  (else (stream-ordered-diff xs ys))))))))



(define-stream (sieve input)
    (stream-cons
        (stream-car input)
        (sieve (stream-ordered-diff
                    (stream-cdr input)
                    (stream-map ((curry *) (stream-car input)) input)))))



(define euler (sieve base))