diff options
author | Jed Barber <jjbarber@y7mail.com> | 2015-10-28 14:57:16 +1100 |
---|---|---|
committer | Jed Barber <jjbarber@y7mail.com> | 2015-10-28 14:57:16 +1100 |
commit | f772c261b8f2d321fec63744300287e8ab0c0b03 (patch) | |
tree | c9ae183fcfda8227449d871ac6e4ce65e1737708 | |
parent | 0f9a7c7fb9d8f1c4fda02e325771ce7b3f75c637 (diff) |
Sieve of Eratosthenes
-rw-r--r-- | sieve/eratosthenes.scm | 37 |
1 files changed, 37 insertions, 0 deletions
diff --git a/sieve/eratosthenes.scm b/sieve/eratosthenes.scm new file mode 100644 index 0000000..d9da30d --- /dev/null +++ b/sieve/eratosthenes.scm @@ -0,0 +1,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)) + + |