Factored out common scheme code into modules

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)))