From f772c261b8f2d321fec63744300287e8ab0c0b03 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Wed, 28 Oct 2015 14:57:16 +1100 Subject: Sieve of Eratosthenes --- sieve/eratosthenes.scm | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) create mode 100644 sieve/eratosthenes.scm 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)) + + -- cgit