summaryrefslogtreecommitdiff
path: root/sieve
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2015-10-25 12:36:33 +1100
committerJed Barber <jjbarber@y7mail.com>2015-10-25 12:36:33 +1100
commit0f9a7c7fb9d8f1c4fda02e325771ce7b3f75c637 (patch)
tree73a6540811c071ddf649ec1bd601a4ead5f7fbd6 /sieve
parent0a48ed023ea65d75851ba2a4151100602695a2fd (diff)
Factored out common scheme code into modules
Diffstat (limited to 'sieve')
-rw-r--r--sieve/euler.scm23
-rw-r--r--sieve/extra-functional.scm47
-rw-r--r--sieve/my-streams.scm26
-rw-r--r--sieve/sundaram.scm36
4 files changed, 87 insertions, 45 deletions
diff --git a/sieve/euler.scm b/sieve/euler.scm
index ac23a94..dfc12de 100644
--- a/sieve/euler.scm
+++ b/sieve/euler.scm
@@ -1,27 +1,16 @@
-(use-modules (srfi srfi-41))
+(add-to-load-path (dirname (current-filename)))
+(import
+ (srfi srfi-41)
+ (extra-functional)
+ (my-streams))
-(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 base (stream-from 2))
diff --git a/sieve/extra-functional.scm b/sieve/extra-functional.scm
new file mode 100644
index 0000000..ab480c0
--- /dev/null
+++ b/sieve/extra-functional.scm
@@ -0,0 +1,47 @@
+
+(library (extra-functional)
+ (export curry uncurry flip part compose)
+ (import (rnrs base))
+
+
+
+(define (curry f)
+ (lambda (x)
+ (lambda (y . r)
+ (apply f (cons x (cons y r))))))
+
+
+
+(define (uncurry f)
+ (lambda (x y . r)
+ (apply (f x) (cons y r))))
+
+
+
+(define (flip f)
+ (lambda (x y . r)
+ (apply f (cons y (cons x r)))))
+
+
+
+(define-syntax part
+ (syntax-rules () ((_ f x)
+ ((curry f) x))))
+
+
+
+(define-syntax dot
+ (syntax-rules ()
+ ((_ x f) (f x))
+ ((_ x f g ...) (f (dot x g ...)))))
+
+
+
+; (compose f g h) => (lambda (x) (f (g (h x))))
+(define-syntax compose
+ (syntax-rules ()
+ ((_ f ...) (lambda (x) (dot x f ...)))))
+
+
+
+)
diff --git a/sieve/my-streams.scm b/sieve/my-streams.scm
new file mode 100644
index 0000000..6c08762
--- /dev/null
+++ b/sieve/my-streams.scm
@@ -0,0 +1,26 @@
+
+(library (my-streams)
+ (export stream-ordered-diff stream-merge)
+ (import (rnrs base) (srfi srfi-41))
+
+
+
+(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 (stream-merge xstrm ystrm)
+ (stream-match xstrm (() ystrm) ((x . xs)
+ (stream-match ystrm (() xstrm) ((y . ys)
+ (cond ((< x y) (stream-cons x (stream-merge xs ystrm)))
+ ((> x y) (stream-cons y (stream-merge xstrm ys)))
+ (else (stream-cons x (stream-merge xs ys)))))))))
+
+
+
+)
diff --git a/sieve/sundaram.scm b/sieve/sundaram.scm
index 384bc3d..8e5bf53 100644
--- a/sieve/sundaram.scm
+++ b/sieve/sundaram.scm
@@ -1,36 +1,16 @@
-(use-modules (srfi srfi-41))
+(add-to-load-path (dirname (current-filename)))
+(import
+ (srfi srfi-41)
+ (extra-functional)
+ (my-streams))
-(define base (stream-from 1))
-
-
-
-(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 (stream-merge xstrm ystrm)
- (stream-match xstrm (() ystrm) ((x . xs)
- (stream-match ystrm (() xstrm) ((y . ys)
- (cond ((< x y) (stream-cons x (stream-merge xs ystrm)))
- ((> x y) (stream-cons y (stream-merge xstrm ys)))
- (else (stream-cons x (stream-merge xs ys)))))))))
+(define base (stream-from 1))
@@ -41,7 +21,7 @@
(define-stream (i-stream i)
(stream-map
- ((curry f) i)
+ (part f i)
(stream-from i)))
@@ -58,7 +38,7 @@
(define-stream (sieve input)
(stream-map
- (lambda (x) (+ 1 (* 2 x)))
+ (compose (part + 1) (part * 2))
(stream-ordered-diff input ij-stream)))