From 326a2a122e76dd9252558551d3f5e61c4014c2c1 Mon Sep 17 00:00:00 2001
From: Masaya Tojo <masaya@tojo.tokyo>
Date: Fri, 14 Jun 2024 02:25:10 +0900
Subject: Fix foldable interfaces

---
 algebraic-structures.foldable.scm    | 54 ++++++++++++++++++------------------
 algebraic-structures.monoid.fold.scm | 12 ++++++--
 tests/run.scm                        | 10 +++----
 3 files changed, 40 insertions(+), 36 deletions(-)

diff --git a/algebraic-structures.foldable.scm b/algebraic-structures.foldable.scm
index 3ab1f6e..be3d615 100644
--- a/algebraic-structures.foldable.scm
+++ b/algebraic-structures.foldable.scm
@@ -1,39 +1,39 @@
-(functor ((algebraic-structures foldable) (F (foldl foldr)))
-    (foldl foldr length find any every ->list)
-  (import (except scheme length) F
+(functor ((algebraic-structures foldable) (F (fold)))
+    (fold
+     length
+     count
+     any
+     every)
+  (import (except scheme length)
+          F
           (only (chicken base) add1 call/cc))
 
   (define (length xs)
-    (foldl (lambda (acc _) (add1 acc))
-           0
-           xs))
+    (fold (lambda (_ acc) (add1 acc))
+          0
+          xs))
 
-  (define (find p? xs)
-    (call/cc
-     (lambda (k)
-       (foldl (lambda (acc e)
-                (if (p? e)
-                    (k e)
-                    acc))
-              #f
-              xs))))
+  (define (count p? xs)
+    (fold (lambda (e acc)
+            (if (p? e)
+                (add1 acc)
+                acc))
+          0
+          xs))
 
   (define (any pred xs)
     (call/cc
      (lambda (return)
-       (foldl (lambda (acc e)
-                (cond ((pred e) => return)
-                      (else acc)))
-              #f
-              xs))))
+       (fold (lambda (e acc)
+               (cond ((pred e) => return)
+                     (else acc)))
+             #f
+             xs))))
 
   (define (every pred xs)
     (call/cc
      (lambda (return)
-       (foldl (lambda (acc e)
-                (or (pred e) (return #f)))
-              #t
-              xs))))
-
-  (define (->list xs)
-    (foldr cons '() xs)))
+       (fold (lambda (e acc)
+               (or (pred e) (return #f)))
+             #t
+             xs)))))
diff --git a/algebraic-structures.monoid.fold.scm b/algebraic-structures.monoid.fold.scm
index b18c03c..5e176f2 100644
--- a/algebraic-structures.monoid.fold.scm
+++ b/algebraic-structures.monoid.fold.scm
@@ -1,4 +1,10 @@
-(functor ((algebraic-structures monoid fold) (M (<> unit)) (F (foldl foldr))) (fold)
-  (import scheme M F)
+(functor ((algebraic-structures monoid fold) (M (<> unit)) (F (fold))) (fold)
+  (import scheme M (rename F (fold foldable:fold)))
 
-  (define (fold x) (foldl <> unit x)))
+  (define (fold x) (foldable:fold <> unit x))
+
+  (define (fold-map f x)
+    (foldable:fold (lambda (x acc)
+                     (<> (f x) acc))
+                   unit
+                   x)))
diff --git a/tests/run.scm b/tests/run.scm
index b49db8e..8d78396 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -71,19 +71,17 @@
 
 (module (data list foldable) = (algebraic-structures foldable)
   (import (chicken module))
-  (reexport (only (chicken base) foldl foldr)))
+  (reexport (only (srfi 1) fold)))
 
 (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)))
+(test '(e d c b a) (list:fold cons '() '(a b c d e)))
 
 (test 0 (list:length '()))
 (test 5 (list:length '(a b c d e)))
 
-(test #f (list:find (constantly #t) '()))
-(test #f (list:find even? '(1 3 5 7)))
-(test 4 (list:find even? '(1 3 4 7 8)))
+(test 0 (list:count even? '(1 3 5 7)))
+(test 2 (list:count even? '(1 3 4 7 8)))
 
 (test #f (list:any (constantly #t) '()))
 (test #f (list:any (cut member 'x <>) '((a b c) (d e f))))
-- 
cgit v1.2.3