Add number (product, sum) implementations

10 files changed, 100 insertions, 34 deletions

diff --git a/algebraic-structures.egg b/algebraic-structures.egg
index 7325c7e..0cba2ef 100644
--- a/algebraic-structures.egg
+++ b/algebraic-structures.egg
@@ -20,6 +20,18 @@
   (extension algebraic-structures.monad)
   (extension algebraic-structures.alternative)
 
+  ;; Number (Product)
+  (extension algebraic-structures.private.number.product)
+  (extension algebraic-structures.number.product.semigroup)
+  (extension algebraic-structures.number.product.monoid)
+  (extension algebraic-structures.number.product.group)
+
+  ;; Number (Sum)
+  (extension algebraic-structures.private.number.sum)
+  (extension algebraic-structures.number.sum.semigroup)
+  (extension algebraic-structures.number.sum.monoid)
+  (extension algebraic-structures.number.sum.group)
+
   ;; List
   (extension algebraic-structures.private.list)
   (extension algebraic-structures.list.semigroup)
diff --git a/algebraic-structures.number.product.group.scm b/algebraic-structures.number.product.group.scm
new file mode 100644
index 0000000..6723097
--- /dev/null
+++ b/algebraic-structures.number.product.group.scm
@@ -0,0 +1,3 @@
+(import (algebraic-structures group)
+        (only (algebraic-structures private number product)))
+(module (algebraic-structures number product group) = ((algebraic-structures group) (algebraic-structures private number product)))
diff --git a/algebraic-structures.number.product.monoid.scm b/algebraic-structures.number.product.monoid.scm
new file mode 100644
index 0000000..6f39c71
--- /dev/null
+++ b/algebraic-structures.number.product.monoid.scm
@@ -0,0 +1,3 @@
+(import (algebraic-structures monoid)
+        (only (algebraic-structures private number product)))
+(module (algebraic-structures number product monoid) = ((algebraic-structures monoid) (algebraic-structures private number product)))
diff --git a/algebraic-structures.number.product.semigroup.scm b/algebraic-structures.number.product.semigroup.scm
new file mode 100644
index 0000000..0155f8b
--- /dev/null
+++ b/algebraic-structures.number.product.semigroup.scm
@@ -0,0 +1,3 @@
+(import (algebraic-structures semigroup)
+        (only (algebraic-structures private number product)))
+(module (algebraic-structures number product semigroup) = ((algebraic-structures semigroup) (algebraic-structures private number product)))
diff --git a/algebraic-structures.number.sum.group.scm b/algebraic-structures.number.sum.group.scm
new file mode 100644
index 0000000..004bb39
--- /dev/null
+++ b/algebraic-structures.number.sum.group.scm
@@ -0,0 +1,3 @@
+(import (algebraic-structures group)
+        (only (algebraic-structures private number sum)))
+(module (algebraic-structures number sum group) = ((algebraic-structures group) (algebraic-structures private number sum)))
diff --git a/algebraic-structures.number.sum.monoid.scm b/algebraic-structures.number.sum.monoid.scm
new file mode 100644
index 0000000..6ded322
--- /dev/null
+++ b/algebraic-structures.number.sum.monoid.scm
@@ -0,0 +1,3 @@
+(import (algebraic-structures monoid)
+        (only (algebraic-structures private number sum)))
+(module (algebraic-structures number sum monoid) = ((algebraic-structures monoid) (algebraic-structures private number sum)))
diff --git a/algebraic-structures.number.sum.semigroup.scm b/algebraic-structures.number.sum.semigroup.scm
new file mode 100644
index 0000000..4c38ef2
--- /dev/null
+++ b/algebraic-structures.number.sum.semigroup.scm
@@ -0,0 +1,3 @@
+(import (algebraic-structures semigroup)
+        (only (algebraic-structures private number sum)))
+(module (algebraic-structures number sum semigroup) = ((algebraic-structures semigroup) (algebraic-structures private number sum)))
diff --git a/algebraic-structures.private.number.product.scm b/algebraic-structures.private.number.product.scm
new file mode 100644
index 0000000..0136b80
--- /dev/null
+++ b/algebraic-structures.private.number.product.scm
@@ -0,0 +1,8 @@
+(module (algebraic-structures private number product) (<> unit inv)
+  (import scheme)
+
+  (define (<> x y) (* x y))
+
+  (define unit 1)
+
+  (define (inv x) (/ x)))
diff --git a/algebraic-structures.private.number.sum.scm b/algebraic-structures.private.number.sum.scm
new file mode 100644
index 0000000..c0db226
--- /dev/null
+++ b/algebraic-structures.private.number.sum.scm
@@ -0,0 +1,8 @@
+(module (algebraic-structures private number sum) (<> unit inv)
+  (import scheme)
+
+  (define (<> x y) (+ x y))
+
+  (define unit 0)
+
+  (define (inv x) (- x)))
diff --git a/tests/run.scm b/tests/run.scm
index bcebd31..adf0fc6 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -25,6 +25,22 @@
 
 (test 5 (mod7:<> 3 4))
 
+(test-begin "number.product")
+
+(import (prefix (algebraic-structures number product semigroup) product:))
+
+(test 12 (product:<> 3 4))
+
+(test-end "number.product")
+
+(test-begin "number.sum")
+
+(import (prefix (algebraic-structures number sum semigroup) sum:))
+
+(test 7 (sum:<> 3 4))
+
+(test-end "number.sum")
+
 (test-begin "list")
 
 (import (prefix (algebraic-structures list semigroup) list:))
@@ -66,6 +82,22 @@
 
 (test 1 mod7:unit)
 
+(test-begin "number.product")
+
+(import (prefix (algebraic-structures number product monoid) product:))
+
+(test 1 (begin product:unit))
+
+(test-end "number.product")
+
+(test-begin "number.sum")
+
+(import (prefix (algebraic-structures number sum monoid) sum:))
+
+(test 0 (begin sum:unit))
+
+(test-end "number.sum")
+
 (test-begin "list")
 
 (import (prefix (algebraic-structures list monoid) list:))
@@ -123,6 +155,26 @@
 
 (test (mod7:inv 4) (mod7:pow 4 -1))
 
+(test-begin "number.product")
+
+(import (prefix (algebraic-structures number product group) product:))
+
+(test 1/2 (product:inv 2))
+(test 8 (product:pow 2 3))
+(test 1/8 (product:pow 2 -3))
+
+(test-end "number.product")
+
+(test-begin "number.sum")
+
+(import (prefix (algebraic-structures number sum group) sum:))
+
+(test -2 (sum:inv 2))
+(test 6 (sum:pow 2 3))
+(test -6 (sum:pow 2 -3))
+
+(test-end "number.sum")
+
 (test-end "group")
 
 (test-begin "foldable")
@@ -242,18 +294,9 @@
 
 (test-begin "semigroup.reducible")
 
-(module (sum semigroup) = (algebraic-structures semigroup)
-  (import scheme
-          (chicken base)
-          (chicken module))
-  (export <>)
-
-  (define (<> x y)
-    (+ x y)))
-
 (import (algebraic-structures semigroup reduce))
 (module (sum reduce) = ((algebraic-structures semigroup reduce)
-                        (sum semigroup)
+                        (algebraic-structures number sum semigroup)
                         (algebraic-structures list reducible)))
 
 (import (prefix (sum reduce) sum:))
@@ -264,34 +307,11 @@
 
 (test-begin "monoid.fold")
 
-(module (product semigroup) = (algebraic-structures semigroup)
-  (import scheme
-          (chicken base)
-          (chicken module))
-  (export <>)
-
-  (define (<> x y)
-    (assert (number? x))
-    (assert (not (zero? x)))
-    (assert (number? y))
-    (assert (not (zero? y)))
-    (* x y)))
-
-(module (product monoid) = (algebraic-structures monoid)
-  (import scheme
-          (chicken base)
-          (chicken module))
-  (reexport (product semigroup))
-  (export unit)
-
-  (define unit 1))
-
 (import (algebraic-structures monoid fold))
 (module (product fold) = ((algebraic-structures monoid fold)
-                          (product monoid)
+                          (algebraic-structures number product monoid)
                           (algebraic-structures list foldable)))
 
-(import (prefix (product monoid) product:))
 (import (prefix (product fold) product:))
 
 (test 1 (product:fold '()))