From ca1584a5c87c2952af08c74ce80b1cb2a75a1d19 Mon Sep 17 00:00:00 2001 From: Masaya Tojo Date: Thu, 13 Jun 2024 02:11:07 +0900 Subject: Rename modules from ( ... make) to () --- algebraic-structures.foldable.scm | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 algebraic-structures.foldable.scm (limited to 'algebraic-structures.foldable.scm') diff --git a/algebraic-structures.foldable.scm b/algebraic-structures.foldable.scm new file mode 100644 index 0000000..3ab1f6e --- /dev/null +++ b/algebraic-structures.foldable.scm @@ -0,0 +1,39 @@ +(functor ((algebraic-structures foldable) (F (foldl foldr))) + (foldl foldr length find any every ->list) + (import (except scheme length) F + (only (chicken base) add1 call/cc)) + + (define (length xs) + (foldl (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 (any pred xs) + (call/cc + (lambda (return) + (foldl (lambda (acc e) + (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))) -- cgit v1.2.3