Remove implementations

24 files changed, 157 insertions, 268 deletions

diff --git a/algebraic-structures.alternative.list.base.scm b/algebraic-structures.alternative.list.base.scm
deleted file mode 100644
index 3d1dba4..0000000
--- a/algebraic-structures.alternative.list.base.scm
+++ /dev/null
@@ -1,8 +0,0 @@
-(module (algebraic-structures alternative list base) (pure map map2 alt empty)
-  (import (except scheme map apply)
-          (algebraic-structures applicative list))
-
-  (define (alt x y)
-    (append x y))
-
-  (define empty '()))
diff --git a/algebraic-structures.alternative.list.scm b/algebraic-structures.alternative.list.scm
deleted file mode 100644
index d258b9e..0000000
--- a/algebraic-structures.alternative.list.scm
+++ /dev/null
@@ -1,5 +0,0 @@
-(import (only (algebraic-structures alternative make)))
-(import (only (algebraic-structures alternative list base)))
-
-(module (algebraic-structures alternative list) =
-  ((algebraic-structures alternative make) (algebraic-structures alternative list base)))
diff --git a/algebraic-structures.applicative.list.base.scm b/algebraic-structures.applicative.list.base.scm
deleted file mode 100644
index a8c04d5..0000000
--- a/algebraic-structures.applicative.list.base.scm
+++ /dev/null
@@ -1,29 +0,0 @@
-(module (algebraic-structures applicative list base) (map pure map2)
-  (import (except scheme map)
-          (algebraic-structures functor list)
-          (only (chicken base) atom? cut)
-          (only (srfi 1) append! reverse!)
-          matchable)
-
-  (define (pure x)
-    (list x))
-
-  (define (rev-map f lst)
-    (let loop ((lst lst)
-               (acc '()))
-      (match lst
-        [() acc]
-        [(h . t)
-         (loop t (cons (f h) acc))])))
-
-  (define (product op lst1 lst2)
-    (let loop ((lst lst1)
-               (acc '()))
-      (match lst
-        [() (reverse! acc)]
-        [(h . t)
-         (loop t
-               (append! (rev-map (cut op h <>) lst2)
-                        acc))])))
-
-  (define map2 product))
diff --git a/algebraic-structures.applicative.list.scm b/algebraic-structures.applicative.list.scm
deleted file mode 100644
index 85298e9..0000000
--- a/algebraic-structures.applicative.list.scm
+++ /dev/null
@@ -1,5 +0,0 @@
-(import (only (algebraic-structures applicative make)))
-(import (only (algebraic-structures applicative list base)))
-
-(module (algebraic-structures applicative list) =
-  ((algebraic-structures applicative make) (algebraic-structures applicative list base)))
diff --git a/algebraic-structures.egg b/algebraic-structures.egg
index bf62bd3..6d72bf1 100644
--- a/algebraic-structures.egg
+++ b/algebraic-structures.egg
@@ -9,33 +9,10 @@
  (test-dependencies test)
  (components
   (extension algebraic-structures.monoid.make)
-  (extension algebraic-structures.monoid.list.base)
-  (extension algebraic-structures.monoid.list)
-  (extension algebraic-structures.monoid.number.sum.base)
-  (extension algebraic-structures.monoid.number.sum)
-  (extension algebraic-structures.monoid.number.product.base)
-  (extension algebraic-structures.monoid.number.product)
   (extension algebraic-structures.monoid.make.fold)
   (extension algebraic-structures.group.make)
-  (extension algebraic-structures.group.number.sum)
-  (extension algebraic-structures.group.number.product)
   (extension algebraic-structures.foldable.make)
-  (extension algebraic-structures.foldable.list.base)
-  (extension algebraic-structures.foldable.list)
-  (extension algebraic-structures.foldable.vector.base)
-  (extension algebraic-structures.foldable.vector)
   (extension algebraic-structures.functor.make)
-  (extension algebraic-structures.functor.list.base)
-  (extension algebraic-structures.functor.list)
-  (extension algebraic-structures.functor.vector.base)
-  (extension algebraic-structures.functor.vector)
   (extension algebraic-structures.applicative.make)
-  (extension algebraic-structures.applicative.list.base)
-  (extension algebraic-structures.applicative.list)
   (extension algebraic-structures.monad.make)
-  (extension algebraic-structures.monad.list.base)
-  (extension algebraic-structures.monad.list)
-  (extension algebraic-structures.monad.list)
-  (extension algebraic-structures.alternative.make)
-  (extension algebraic-structures.alternative.list.base)
-  (extension algebraic-structures.alternative.list)))
+  (extension algebraic-structures.alternative.make)))
diff --git a/algebraic-structures.foldable.list.base.scm b/algebraic-structures.foldable.list.base.scm
deleted file mode 100644
index 936f03f..0000000
--- a/algebraic-structures.foldable.list.base.scm
+++ /dev/null
@@ -1,2 +0,0 @@
-(module (algebraic-structures foldable list base) (foldl foldr)
-  (import (only (chicken base) foldl foldr)))
diff --git a/algebraic-structures.foldable.list.scm b/algebraic-structures.foldable.list.scm
deleted file mode 100644
index 378a4c2..0000000
--- a/algebraic-structures.foldable.list.scm
+++ /dev/null
@@ -1,5 +0,0 @@
-(import (only (algebraic-structures foldable list base)))
-(import (only (algebraic-structures foldable make)))
-
-(module (algebraic-structures foldable list) = ((algebraic-structures foldable make)
-                                                (algebraic-structures foldable list base)))
diff --git a/algebraic-structures.foldable.vector.base.scm b/algebraic-structures.foldable.vector.base.scm
deleted file mode 100644
index 90d06da..0000000
--- a/algebraic-structures.foldable.vector.base.scm
+++ /dev/null
@@ -1,21 +0,0 @@
-(module (algebraic-structures foldable vector base) (foldl foldr)
-  (import scheme
-          (only (chicken base) add1 sub1))
-
-  (define (foldl f z v)
-    (let ((len (vector-length v)))
-      (let loop ((i 0)
-                 (acc z))
-        (if (= i len)
-            acc
-            (loop (add1 i)
-                  (f acc (vector-ref v i)))))))
-
-  (define (foldr f z v)
-    (let ((len (vector-length v)))
-      (let loop ((i (sub1 len))
-                 (acc z))
-        (if (< i 0)
-            acc
-            (loop (sub1 i)
-                  (f (vector-ref v i) acc)))))))
diff --git a/algebraic-structures.foldable.vector.scm b/algebraic-structures.foldable.vector.scm
deleted file mode 100644
index 7fa3886..0000000
--- a/algebraic-structures.foldable.vector.scm
+++ /dev/null
@@ -1,5 +0,0 @@
-(import (only (algebraic-structures foldable vector base)))
-(import (only (algebraic-structures foldable make)))
-
-(module (algebraic-structures foldable vector) = ((algebraic-structures foldable make)
-                                                  (algebraic-structures foldable vector base)))
diff --git a/algebraic-structures.functor.list.base.scm b/algebraic-structures.functor.list.base.scm
deleted file mode 100644
index a9ebb01..0000000
--- a/algebraic-structures.functor.list.base.scm
+++ /dev/null
@@ -1,4 +0,0 @@
-(module (algebraic-structures functor list base) (map)
-  (import (rename (scheme) (map list:map)))
-
-  (define (map f lst) (list:map f lst)))
diff --git a/algebraic-structures.functor.list.scm b/algebraic-structures.functor.list.scm
deleted file mode 100644
index 569cc60..0000000
--- a/algebraic-structures.functor.list.scm
+++ /dev/null
@@ -1,5 +0,0 @@
-(import (only (algebraic-structures functor list base)))
-(import (only (algebraic-structures functor make)))
-
-(module (algebraic-structures functor list) = ((algebraic-structures functor make)
-                                               (algebraic-structures functor list base)))
diff --git a/algebraic-structures.functor.vector.base.scm b/algebraic-structures.functor.vector.base.scm
deleted file mode 100644
index 1449ed6..0000000
--- a/algebraic-structures.functor.vector.base.scm
+++ /dev/null
@@ -1,10 +0,0 @@
-(module (algebraic-structures functor vector base) (map)
-  (import (rename scheme (map list-map))
-          (only (chicken base) add1))
-
-  (define (map f v)
-    (let* ((len (vector-length v))
-           (new (make-vector len)))
-      (do ((i 0 (add1 i)))
-          ((= i len) new)
-        (vector-set! new i (vector-ref v i))))))
diff --git a/algebraic-structures.functor.vector.scm b/algebraic-structures.functor.vector.scm
deleted file mode 100644
index 748afca..0000000
--- a/algebraic-structures.functor.vector.scm
+++ /dev/null
@@ -1,5 +0,0 @@
-(import (only (algebraic-structures functor vector base)))
-(import (only (algebraic-structures functor make)))
-
-(module (algebraic-structures functor vector) = ((algebraic-structures functor make)
-                                                 (algebraic-structures functor vector base)))
diff --git a/algebraic-structures.group.number.product.scm b/algebraic-structures.group.number.product.scm
deleted file mode 100644
index a57cdf6..0000000
--- a/algebraic-structures.group.number.product.scm
+++ /dev/null
@@ -1,8 +0,0 @@
-(import (only (algebraic-structures group make)))
-(module (algebraic-structures group number product) = (algebraic-structures group make)
-  (import scheme
-          (chicken module)
-          (algebraic-structures monoid number product))
-  (export <> unit inv)
-
-  (define (inv x) (/ x)))
diff --git a/algebraic-structures.group.number.sum.scm b/algebraic-structures.group.number.sum.scm
deleted file mode 100644
index 2bb7331..0000000
--- a/algebraic-structures.group.number.sum.scm
+++ /dev/null
@@ -1,8 +0,0 @@
-(import (only (algebraic-structures group make)))
-(module (algebraic-structures group number sum) = (algebraic-structures group make)
-  (import scheme
-          (chicken module)
-          (algebraic-structures monoid number sum))
-  (export <> unit inv)
-
-  (define (inv x) (- x)))
diff --git a/algebraic-structures.monad.list.base.scm b/algebraic-structures.monad.list.base.scm
deleted file mode 100644
index e6a36ad..0000000
--- a/algebraic-structures.monad.list.base.scm
+++ /dev/null
@@ -1,7 +0,0 @@
-(module (algebraic-structures monad list base) (pure map map2 >>=)
-  (import (except scheme map)
-          (algebraic-structures applicative list)
-          (only (srfi 1) append-map))
-
-  (define (>>= lst f)
-    (append-map f lst)))
diff --git a/algebraic-structures.monad.list.scm b/algebraic-structures.monad.list.scm
deleted file mode 100644
index 7292bd1..0000000
--- a/algebraic-structures.monad.list.scm
+++ /dev/null
@@ -1,5 +0,0 @@
-(import (only (algebraic-structures monad make)))
-(import (only (algebraic-structures monad list base)))
-
-(module (algebraic-structures monad list) =
-  ((algebraic-structures monad make) (algebraic-structures monad list base)))
diff --git a/algebraic-structures.monoid.list.base.scm b/algebraic-structures.monoid.list.base.scm
deleted file mode 100644
index 900c12e..0000000
--- a/algebraic-structures.monoid.list.base.scm
+++ /dev/null
@@ -1,5 +0,0 @@
-(module (algebraic-structures monoid list base) (<> unit)
-  (import scheme)
-
-  (define <> append)
-  (define unit '()))
diff --git a/algebraic-structures.monoid.list.scm b/algebraic-structures.monoid.list.scm
deleted file mode 100644
index b91eeb0..0000000
--- a/algebraic-structures.monoid.list.scm
+++ /dev/null
@@ -1,5 +0,0 @@
-(import (only (algebraic-structures monoid list base)))
-(import (only (algebraic-structures monoid make)))
-
-(module (algebraic-structures monoid list) = ((algebraic-structures monoid make)
-                                              (algebraic-structures monoid list base)))
diff --git a/algebraic-structures.monoid.number.product.base.scm b/algebraic-structures.monoid.number.product.base.scm
deleted file mode 100644
index 796a6c9..0000000
--- a/algebraic-structures.monoid.number.product.base.scm
+++ /dev/null
@@ -1,5 +0,0 @@
-(module (algebraic-structures monoid number product base) (<> unit)
-  (import scheme)
-
-  (define <> *)
-  (define unit 1))
diff --git a/algebraic-structures.monoid.number.product.scm b/algebraic-structures.monoid.number.product.scm
deleted file mode 100644
index 225e0a1..0000000
--- a/algebraic-structures.monoid.number.product.scm
+++ /dev/null
@@ -1,5 +0,0 @@
-(import (only (algebraic-structures monoid number product base)))
-(import (only (algebraic-structures monoid make)))
-
-(module (algebraic-structures monoid number product) = ((algebraic-structures monoid make)
-                                                        (algebraic-structures monoid number product base)))
diff --git a/algebraic-structures.monoid.number.sum.base.scm b/algebraic-structures.monoid.number.sum.base.scm
deleted file mode 100644
index 6fb1c59..0000000
--- a/algebraic-structures.monoid.number.sum.base.scm
+++ /dev/null
@@ -1,5 +0,0 @@
-(module (algebraic-structures monoid number sum base) (<> unit)
-  (import scheme)
-
-  (define <> +)
-  (define unit 0))
diff --git a/algebraic-structures.monoid.number.sum.scm b/algebraic-structures.monoid.number.sum.scm
deleted file mode 100644
index 28e025c..0000000
--- a/algebraic-structures.monoid.number.sum.scm
+++ /dev/null
@@ -1,5 +0,0 @@
-(import (only (algebraic-structures monoid number sum base)))
-(import (only (algebraic-structures monoid make)))
-
-(module (algebraic-structures monoid number sum) = ((algebraic-structures monoid make)
-                                                    (algebraic-structures monoid number sum base)))
diff --git a/tests/run.scm b/tests/run.scm
index 6b6a74e..2a5c941 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -2,24 +2,78 @@
 
 (test-begin "algebraic-structures")
 
-(import (prefix (algebraic-structures monoid list) list:))
+(test-begin "monoid")
+
+(import (algebraic-structures monoid make))
+
+(module (mod7 monoid) = (algebraic-structures monoid make)
+  (import scheme
+          (chicken module)
+          (chicken base))
+  (export <> unit)
+
+  (define (<> x y)
+    (assert (integer? x))
+    (assert (integer? y))
+    (assert (not (zero? x)))
+    (assert (not (zero? y)))
+    (modulo (* x y) 7))
+
+  (define unit 1))
+
+(import (prefix (mod7 monoid) mod7:)
+        (srfi 1))
 
-(import (only (algebraic-structures monoid make fold)))
-(import (prefix (algebraic-structures foldable list) list:))
-(import (prefix (algebraic-structures foldable vector) vector:))
-(import (prefix (algebraic-structures monoid number sum) sum:))
-(import (prefix (algebraic-structures monoid number product) product:))
+(test 5 (mod7:<> 3 4))
+(test 1 mod7:unit)
 
-(import (prefix (algebraic-structures functor list) list:))
-(import (prefix (algebraic-structures applicative list) list:))
-(import (prefix (algebraic-structures monad list) list:))
-(import (prefix (algebraic-structures alternative list) list:))
+(test-end "monoid")
+
+(test-begin "group")
 
-(import (prefix (only (scheme) apply) list:))
+(import (algebraic-structures group make))
+(module (mod7 group) = (algebraic-structures group make)
+  (import scheme
+          (chicken base)
+          (chicken module)
+          matchable)
+  (reexport (mod7 monoid))
+  (export inv)
+
+  (define (inv n)
+    (assert (integer? n))
+    (assert (not (zero? n)))
+    (match (modulo n 7)
+      (1 1)
+      (2 4)
+      (3 5)
+      (4 2)
+      (5 3)
+      (6 6))))
+
+(import (prefix (mod7 group) mod7:))
+
+(test (make-list 6 mod7:unit)
+      (map mod7:<>
+           '(1 2 3 4 5 6)
+           (map mod7:inv '(1 2 3 4 5 6))))
+
+(test '(3 2 6 4 5 1)
+      (map (cut mod7:pow 3 <>) '(1 2 3 4 5 6)))
+
+(test (mod7:inv 4) (mod7:pow 4 -1))
+
+(test-end "group")
 
 (test-begin "foldable")
 
-(test-begin "foldable.list")
+(import (algebraic-structures foldable make))
+
+(module (data list foldable) = (algebraic-structures foldable make)
+  (import (chicken module))
+  (reexport (only (chicken base) foldl foldr)))
+
+(import (prefix (data list foldable) list:))
 
 (test '(a b c d e) (list:foldr cons '() '(a b c d e)))
 (test '(((((() a) b) c) d) e) (list:foldl list '() '(a b c d e)))
@@ -39,88 +93,43 @@
 (test #f (list:every (cut member 'x <>) '((a b c) (d x f))))
 (test '(x f) (list:every (cut member 'x <>) '((a x c) (d x f))))
 
-
-(test '(a b c d e) (list:->list '(a b c d e)))
-
-(test-end "foldable.list")
-
-(test-begin "foldable.vector")
-
-(test '(a b c d e) (vector:foldr cons '() #(a b c d e)))
-(test '(((((() a) b) c) d) e) (vector:foldl list '() #(a b c d e)))
-
-(test 0 (vector:length #()))
-(test 5 (vector:length #(a b c d e)))
-
-(test #f (vector:find (constantly #t) #()))
-(test #f (vector:find even? #(1 3 5 7)))
-(test 4 (vector:find even? #(1 3 4 7 8)))
-
-(test #f (vector:any (constantly #t) #()))
-(test #f (vector:any (cut member 'x <>) #((a b c) (d e f))))
-(test '(x f) (vector:any (cut member 'x <>) #((a b c) (d x f))))
-
-(test #t (vector:every (constantly #f) #()))
-(test #f (vector:every (cut member 'x <>) #((a b c) (d x f))))
-(test '(x f) (vector:every (cut member 'x <>) #((a x c) (d x f))))
-
-(test '(a b c d e) (vector:->list #(a b c d e)))
-
-(test-end "foldable.vector")
-
 (test-end "foldable")
 
-(test-begin "monoid")
-
-(test-begin "monoid.list")
-
-(test '(a b c 1 2 3) (list:<> '(a b c) '(1 2 3)))
-(test '(a b c x y z 1 2 3) (list:<> (list:<> '(a b c) '(x y z)) '(1 2 3)))
-(test '(a b c x y z 1 2 3) (list:<> '(a b c) (list:<> '(x y z) '(1 2 3))))
-
-(test-end "monoid.list")
-
-(test-begin "monoid.sum.fold.list")
-
-(module sum-fold = ((algebraic-structures monoid make fold)
-                    (algebraic-structures monoid number sum)
-                    (algebraic-structures foldable list)))
-(import (prefix sum-fold sum:))
+(test-begin "monoid.fold")
 
-(test 15 (sum:fold '(1 2 3 4 5)))
-(test 0 (sum:fold '()))
+(module (product monoid) = (algebraic-structures monoid make)
+  (import scheme
+          (chicken base)
+          (chicken module))
+  (export <> unit)
 
+  (define (<> x y)
+    (assert (number? x))
+    (assert (not (zero? x)))
+    (assert (number? y))
+    (assert (not (zero? y)))
+    (* x y))
 
-(test-end "monoid.sum.fold.list")
+  (define unit 1))
 
-(test-begin "monoid.product.fold.vector")
+(import (algebraic-structures monoid make fold))
+(module (product fold) = ((algebraic-structures monoid make fold) (product monoid) (data list foldable)))
 
-(module product-fold = ((algebraic-structures monoid make fold)
-                        (algebraic-structures monoid number product)
-                        (algebraic-structures foldable vector)))
-(import (prefix product-fold product:))
-
-(test 120 (product:fold #(1 2 3 4 5)))
-(test 1 (product:fold #()))
-
-(test-end "monoid.product.fold.vector")
-
-(test-end "monoid")
-
-(test-begin "group")
+(import (prefix (product monoid) product:))
+(import (prefix (product fold) product:))
 
-(import (prefix (algebraic-structures group number product) product:))
-(import (prefix (algebraic-structures group number sum) sum:))
+(test 120 (product:fold '(1 2 3 4 5)))
 
-(test -9 (sum:inv 9))
-(test 9 (sum:pow 3 3))
+(test-end "monoid.fold")
 
-(test 1/9 (product:inv 9))
-(test 9 (product:pow 3 2))
+(test-begin "functor")
 
-(test-end "group")
+(import (algebraic-structures functor make))
+(module (data list functor) = (algebraic-structures functor make)
+  (import scheme (chicken module))
+  (export map))
 
-(test-begin "functor")
+(import (prefix (data list functor) list:))
 
 (test '((a) (b) (c)) (list:map list '(a b c)))
 
@@ -128,6 +137,42 @@
 
 (test-begin "applicative")
 
+(import (algebraic-structures applicative make))
+(module (data list applicative) = (algebraic-structures applicative make)
+  (import (except scheme map)
+          (chicken module)
+          (srfi 1)
+          matchable
+          (chicken base)
+          (data list functor))
+  (reexport (data list functor))
+  (export pure map2)
+
+  (define (pure x)
+    (list x))
+
+  (define (rev-map f lst)
+    (let loop ((lst lst)
+               (acc '()))
+      (match lst
+        [() acc]
+        [(h . t)
+         (loop t (cons (f h) acc))])))
+
+  (define (product op lst1 lst2)
+    (let loop ((lst lst1)
+               (acc '()))
+      (match lst
+        [() (reverse! acc)]
+        [(h . t)
+         (loop t
+               (append! (rev-map (cut op h <>) lst2)
+                        acc))])))
+
+  (define map2 product))
+
+(import (prefix (data list applicative) list:))
+
 (test '(a) (list:pure 'a))
 
 (test '((a 1) (a 2) (b 1) (b 2) (c 1) (c 2))
@@ -140,6 +185,19 @@
 
 (test-begin "monad")
 
+(import (algebraic-structures monad make))
+(module (data list monad) = (algebraic-structures monad make)
+  (import (except scheme map)
+          (chicken module)
+          (srfi 1))
+  (reexport (data list applicative))
+  (export >>=)
+
+  (define (>>= lst f)
+    (append-map f lst)))
+
+(import (prefix (data list monad) list:))
+
 (test '((1 a) (2 a))
       (list:>>= (list:pure 'a)
                 (lambda (x)
@@ -157,6 +215,22 @@
 
 (test-begin "alternative")
 
+(import (algebraic-structures alternative make))
+(module (data list alternative) = (algebraic-structures alternative make)
+  (import (except scheme map)
+          (chicken module)
+          (chicken base)
+          (data list applicative))
+  (reexport (data list applicative))
+  (export alt empty)
+
+  (define (alt x y)
+    (append x y))
+
+  (define empty '()))
+
+(import (prefix (data list alternative) list:))
+
 (test '(9 25)
       (list:do (x <- '(2 3 4 5))
                (list:guard (odd? x))