aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMasaya Tojo <masaya@tojo.tokyo>2024-06-13 02:07:46 +0900
committerMasaya Tojo <masaya@tojo.tokyo>2024-06-13 02:07:46 +0900
commit653b204b583da363a97464960a00f1bd0dbed865 (patch)
tree5ea996f90f54053601476bfa9cff646d28417bfe
parenta1b1d10ad5fc505f8b83ac6976e5eb68b87427ff (diff)
Remove implementations
-rw-r--r--algebraic-structures.alternative.list.base.scm8
-rw-r--r--algebraic-structures.alternative.list.scm5
-rw-r--r--algebraic-structures.applicative.list.base.scm29
-rw-r--r--algebraic-structures.applicative.list.scm5
-rw-r--r--algebraic-structures.egg25
-rw-r--r--algebraic-structures.foldable.list.base.scm2
-rw-r--r--algebraic-structures.foldable.list.scm5
-rw-r--r--algebraic-structures.foldable.vector.base.scm21
-rw-r--r--algebraic-structures.foldable.vector.scm5
-rw-r--r--algebraic-structures.functor.list.base.scm4
-rw-r--r--algebraic-structures.functor.list.scm5
-rw-r--r--algebraic-structures.functor.vector.base.scm10
-rw-r--r--algebraic-structures.functor.vector.scm5
-rw-r--r--algebraic-structures.group.number.product.scm8
-rw-r--r--algebraic-structures.group.number.sum.scm8
-rw-r--r--algebraic-structures.monad.list.base.scm7
-rw-r--r--algebraic-structures.monad.list.scm5
-rw-r--r--algebraic-structures.monoid.list.base.scm5
-rw-r--r--algebraic-structures.monoid.list.scm5
-rw-r--r--algebraic-structures.monoid.number.product.base.scm5
-rw-r--r--algebraic-structures.monoid.number.product.scm5
-rw-r--r--algebraic-structures.monoid.number.sum.base.scm5
-rw-r--r--algebraic-structures.monoid.number.sum.scm5
-rw-r--r--tests/run.scm238
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))