aboutsummaryrefslogtreecommitdiff
path: root/tests
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 /tests
parenta1b1d10ad5fc505f8b83ac6976e5eb68b87427ff (diff)
Remove implementations
Diffstat (limited to 'tests')
-rw-r--r--tests/run.scm238
1 files changed, 156 insertions, 82 deletions
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))