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.applicative.scm | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 algebraic-structures.applicative.scm (limited to 'algebraic-structures.applicative.scm') diff --git a/algebraic-structures.applicative.scm b/algebraic-structures.applicative.scm new file mode 100644 index 0000000..ac3028a --- /dev/null +++ b/algebraic-structures.applicative.scm @@ -0,0 +1,28 @@ +(functor ((algebraic-structures applicative) (A (pure map map2))) + (pure map map2 map* apply) + (import (rename scheme (map scheme:map) (apply scheme:apply)) + (only (chicken base) sub1 add1 foldl case-lambda) + A + matchable) + + (define (curry-n f n) + (let rec ((i n) + (k (lambda (args) + (scheme:apply f args)))) + (if (= i 1) + (lambda (x) (k (list x))) + (lambda (x) + (rec (sub1 i) + (lambda (args) + (k (cons x args)))))))) + + (define map* + (case-lambda + ((f x) (map f x)) + ((f x y) (map2 f x y)) + ((f x . xs) + (let ((g (curry-n f (add1 (length xs))))) + (foldl apply (apply (pure g) x) xs))))) + + (define (apply a1 a2) + (map2 (lambda (f x) (f x)) a1 a2))) -- cgit v1.2.3