aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--algebraic-structures.egg18
-rw-r--r--algebraic-structures.list.alternative.scm4
-rw-r--r--algebraic-structures.list.applicative.scm4
-rw-r--r--algebraic-structures.list.foldable.scm3
-rw-r--r--algebraic-structures.list.functor.scm3
-rw-r--r--algebraic-structures.list.monad.scm4
-rw-r--r--algebraic-structures.list.monoid.scm3
-rw-r--r--algebraic-structures.list.reducible.scm3
-rw-r--r--algebraic-structures.list.semigroup.scm3
-rw-r--r--algebraic-structures.list.zip.applicative.scm4
-rw-r--r--algebraic-structures.private.list.alternative.scm9
-rw-r--r--algebraic-structures.private.list.applicative.scm30
-rw-r--r--algebraic-structures.private.list.monad.scm8
-rw-r--r--algebraic-structures.private.list.scm19
-rw-r--r--algebraic-structures.private.list.zip.applicative.scm14
-rw-r--r--tests/run.scm114
16 files changed, 151 insertions, 92 deletions
diff --git a/algebraic-structures.egg b/algebraic-structures.egg
index ba4fd46..5e7eba3 100644
--- a/algebraic-structures.egg
+++ b/algebraic-structures.egg
@@ -18,4 +18,20 @@
(extension algebraic-structures.functor)
(extension algebraic-structures.applicative)
(extension algebraic-structures.monad)
- (extension algebraic-structures.alternative)))
+ (extension algebraic-structures.alternative)
+
+ ;; List
+ (extension algebraic-structures.private.list)
+ (extension algebraic-structures.list.semigroup)
+ (extension algebraic-structures.list.monoid)
+ (extension algebraic-structures.list.foldable)
+ (extension algebraic-structures.list.reducible)
+ (extension algebraic-structures.list.functor)
+ (extension algebraic-structures.private.list.zip.applicative)
+ (extension algebraic-structures.list.zip.applicative)
+ (extension algebraic-structures.private.list.applicative)
+ (extension algebraic-structures.list.applicative)
+ (extension algebraic-structures.private.list.monad)
+ (extension algebraic-structures.list.monad)
+ (extension algebraic-structures.private.list.alternative)
+ (extension algebraic-structures.list.alternative)))
diff --git a/algebraic-structures.list.alternative.scm b/algebraic-structures.list.alternative.scm
new file mode 100644
index 0000000..2804d61
--- /dev/null
+++ b/algebraic-structures.list.alternative.scm
@@ -0,0 +1,4 @@
+(import (algebraic-structures alternative)
+ (only (algebraic-structures private list alternative)))
+(module (algebraic-structures list alternative) = ((algebraic-structures alternative)
+ (algebraic-structures private list alternative)))
diff --git a/algebraic-structures.list.applicative.scm b/algebraic-structures.list.applicative.scm
new file mode 100644
index 0000000..5165e96
--- /dev/null
+++ b/algebraic-structures.list.applicative.scm
@@ -0,0 +1,4 @@
+(import (algebraic-structures applicative)
+ (only (algebraic-structures private list applicative)))
+(module (algebraic-structures list applicative) = ((algebraic-structures applicative)
+ (algebraic-structures private list applicative)))
diff --git a/algebraic-structures.list.foldable.scm b/algebraic-structures.list.foldable.scm
new file mode 100644
index 0000000..5150f9b
--- /dev/null
+++ b/algebraic-structures.list.foldable.scm
@@ -0,0 +1,3 @@
+(import (algebraic-structures foldable)
+ (only (algebraic-structures private list)))
+(module (algebraic-structures list foldable) = ((algebraic-structures foldable) (algebraic-structures private list)))
diff --git a/algebraic-structures.list.functor.scm b/algebraic-structures.list.functor.scm
new file mode 100644
index 0000000..a9707f2
--- /dev/null
+++ b/algebraic-structures.list.functor.scm
@@ -0,0 +1,3 @@
+(import (algebraic-structures functor)
+ (only (algebraic-structures private list)))
+(module (algebraic-structures list functor) = ((algebraic-structures functor) (algebraic-structures private list)))
diff --git a/algebraic-structures.list.monad.scm b/algebraic-structures.list.monad.scm
new file mode 100644
index 0000000..ebf142f
--- /dev/null
+++ b/algebraic-structures.list.monad.scm
@@ -0,0 +1,4 @@
+(import (algebraic-structures monad)
+ (only (algebraic-structures private list monad)))
+(module (algebraic-structures list monad) = ((algebraic-structures monad)
+ (algebraic-structures private list monad)))
diff --git a/algebraic-structures.list.monoid.scm b/algebraic-structures.list.monoid.scm
new file mode 100644
index 0000000..87e6119
--- /dev/null
+++ b/algebraic-structures.list.monoid.scm
@@ -0,0 +1,3 @@
+(import (algebraic-structures monoid)
+ (only (algebraic-structures private list)))
+(module (algebraic-structures list monoid) = ((algebraic-structures monoid) (algebraic-structures private list)))
diff --git a/algebraic-structures.list.reducible.scm b/algebraic-structures.list.reducible.scm
new file mode 100644
index 0000000..b98cfd7
--- /dev/null
+++ b/algebraic-structures.list.reducible.scm
@@ -0,0 +1,3 @@
+(import (algebraic-structures reducible)
+ (only (algebraic-structures private list)))
+(module (algebraic-structures list reducible) = ((algebraic-structures reducible) (algebraic-structures private list)))
diff --git a/algebraic-structures.list.semigroup.scm b/algebraic-structures.list.semigroup.scm
new file mode 100644
index 0000000..eac0c5e
--- /dev/null
+++ b/algebraic-structures.list.semigroup.scm
@@ -0,0 +1,3 @@
+(import (algebraic-structures semigroup)
+ (only (algebraic-structures private list)))
+(module (algebraic-structures list semigroup) = ((algebraic-structures semigroup) (algebraic-structures private list)))
diff --git a/algebraic-structures.list.zip.applicative.scm b/algebraic-structures.list.zip.applicative.scm
new file mode 100644
index 0000000..c72a8ec
--- /dev/null
+++ b/algebraic-structures.list.zip.applicative.scm
@@ -0,0 +1,4 @@
+(import (algebraic-structures applicative)
+ (only (algebraic-structures private list zip applicative)))
+(module (algebraic-structures list zip applicative) = ((algebraic-structures applicative)
+ (algebraic-structures private list zip applicative)))
diff --git a/algebraic-structures.private.list.alternative.scm b/algebraic-structures.private.list.alternative.scm
new file mode 100644
index 0000000..a386e81
--- /dev/null
+++ b/algebraic-structures.private.list.alternative.scm
@@ -0,0 +1,9 @@
+(module (algebraic-structures private list alternative) (alt empty)
+ (import (except scheme map apply)
+ (chicken module))
+ (reexport (algebraic-structures list applicative))
+
+ (define empty '())
+
+ (define (alt xs ys)
+ (append xs ys)))
diff --git a/algebraic-structures.private.list.applicative.scm b/algebraic-structures.private.list.applicative.scm
new file mode 100644
index 0000000..6bbfad7
--- /dev/null
+++ b/algebraic-structures.private.list.applicative.scm
@@ -0,0 +1,30 @@
+(module (algebraic-structures private list applicative) ()
+ (import scheme
+ (only (srfi 1) append! reverse!)
+ (only (chicken base) assert cut)
+ (only matchable match)
+ (chicken module))
+ (export pure map2)
+ (reexport (algebraic-structures list functor))
+
+ (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.private.list.monad.scm b/algebraic-structures.private.list.monad.scm
new file mode 100644
index 0000000..96da332
--- /dev/null
+++ b/algebraic-structures.private.list.monad.scm
@@ -0,0 +1,8 @@
+(module (algebraic-structures private list monad) (>>=)
+ (import (except scheme map apply)
+ (chicken module)
+ (only (srfi 1) append-map))
+ (reexport (algebraic-structures list applicative))
+
+ (define (>>= xs f)
+ (append-map f xs)))
diff --git a/algebraic-structures.private.list.scm b/algebraic-structures.private.list.scm
new file mode 100644
index 0000000..4710b40
--- /dev/null
+++ b/algebraic-structures.private.list.scm
@@ -0,0 +1,19 @@
+(module (algebraic-structures private list) (<> unit fold reduce map1)
+ (import scheme
+ (rename (only (srfi 1) fold reduce)
+ (fold srfi:fold)
+ (reduce srfi:reduce))
+ (only (chicken base) assert))
+
+ (define <> append)
+
+ (define unit '())
+
+ (define fold srfi:fold)
+
+ (define (reduce f xs)
+ (assert (not (null? xs)))
+ (srfi:reduce f #f xs))
+
+ (define (map1 f xs)
+ (map f xs)))
diff --git a/algebraic-structures.private.list.zip.applicative.scm b/algebraic-structures.private.list.zip.applicative.scm
new file mode 100644
index 0000000..8713ef9
--- /dev/null
+++ b/algebraic-structures.private.list.zip.applicative.scm
@@ -0,0 +1,14 @@
+(module (algebraic-structures private list zip applicative) ()
+ (import scheme
+ (rename (only (srfi 1) fold reduce)
+ (fold srfi:fold)
+ (reduce srfi:reduce))
+ (only (chicken base) assert)
+ (chicken module))
+ (export pure map2)
+ (reexport (algebraic-structures list functor))
+
+ (define (pure x) (list x))
+
+ (define (map2 f xs ys)
+ (map f xs ys)))
diff --git a/tests/run.scm b/tests/run.scm
index 8195ea8..eac7569 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -83,13 +83,7 @@
(test-begin "foldable")
-(import (algebraic-structures foldable))
-
-(module (data list foldable) = (algebraic-structures foldable)
- (import (chicken module))
- (reexport (only (srfi 1) fold)))
-
-(import (prefix (data list foldable) list:))
+(import (prefix (algebraic-structures list foldable) list:))
(test '(e d c b a) (list:fold cons '() '(a b c d e)))
@@ -116,20 +110,7 @@
(test-begin "reducible")
-(module (data list reducible) = (algebraic-structures reducible)
- (import scheme
- (algebraic-structures reducible)
- (rename (srfi 1) (reduce srfi:reduce))
- (only (chicken base) assert)
- (chicken module))
- (export reduce)
-
- (define (reduce f xs)
- (assert (list? xs))
- (assert (not (null? xs)))
- (srfi:reduce f #f xs)))
-
-(import (prefix (data list reducible) list:))
+(import (prefix (algebraic-structures list reducible) list:))
(test 10 (list:reduce + '(1 2 3 4)))
(test -3 (list:minimum '(1 8 -3 5 4) <))
@@ -149,7 +130,9 @@
(+ x y)))
(import (algebraic-structures semigroup reduce))
-(module (sum reduce) = ((algebraic-structures semigroup reduce) (sum semigroup) (data list reducible)))
+(module (sum reduce) = ((algebraic-structures semigroup reduce)
+ (sum semigroup)
+ (algebraic-structures list reducible)))
(import (prefix (sum reduce) sum:))
@@ -182,7 +165,9 @@
(define unit 1))
(import (algebraic-structures monoid fold))
-(module (product fold) = ((algebraic-structures monoid fold) (product monoid) (data list foldable)))
+(module (product fold) = ((algebraic-structures monoid fold)
+ (product monoid)
+ (algebraic-structures list foldable)))
(import (prefix (product monoid) product:))
(import (prefix (product fold) product:))
@@ -196,12 +181,7 @@
(test-begin "functor")
-(import (algebraic-structures functor))
-(module (data list functor) = (algebraic-structures functor)
- (import (chicken module))
- (reexport (rename scheme (map map1))))
-
-(import (prefix (data list functor) list:))
+(import (prefix (algebraic-structures list functor) list:))
(test '((a) (b) (c)) (list:map1 list '(a b c)))
@@ -209,41 +189,7 @@
(test-begin "applicative")
-(import (algebraic-structures applicative))
-(module (data list applicative) = (algebraic-structures applicative)
- (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:))
+(import (prefix (algebraic-structures list applicative) list:))
(test '(a) (list:pure 'a))
@@ -253,22 +199,22 @@
(test '((a 1 z) (a 2 z) (b 1 z) (b 2 z) (c 1 z) (c 2 z))
(list:map list '(a b c) '(1 2) '(z)))
-(test-end "applicative")
+(test-begin "list.zip")
-(test-begin "monad")
+(import (prefix (algebraic-structures list zip applicative) list-zip:))
-(import (algebraic-structures monad))
-(module (data list monad) = (algebraic-structures monad)
- (import scheme
- (chicken module)
- (srfi 1))
- (reexport (data list applicative))
- (export >>=)
+(test '(a) (list:pure 'a))
+
+(test '((a 1) (b 2))
+ (list-zip:map2 list '(a b c) '(1 2)))
+
+(test-end "list.zip")
+
+(test-end "applicative")
- (define (>>= lst f)
- (append-map f lst)))
+(test-begin "monad")
-(import (prefix (data list monad) list:))
+(import (prefix (algebraic-structures list monad) list:))
(test '((1 a) (2 a))
(list:>>= (list:pure 'a)
@@ -287,21 +233,7 @@
(test-begin "alternative")
-(import (algebraic-structures alternative))
-(module (data list alternative) = (algebraic-structures alternative)
- (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:))
+(import (prefix (algebraic-structures list alternative) list:))
(test '(9 25)
(list:do (x <- '(2 3 4 5))