From 552cd6c999f3e44b13be88e45c4a8cb391eb40cf Mon Sep 17 00:00:00 2001 From: Masaya Tojo Date: Tue, 11 Jun 2024 02:10:37 +0900 Subject: Rename filename from `algebraic-structs` to `algebraic-structures` --- algebraic-structs.applicative.make.scm | 28 ---------------------------- 1 file changed, 28 deletions(-) delete mode 100644 algebraic-structs.applicative.make.scm (limited to 'algebraic-structs.applicative.make.scm') diff --git a/algebraic-structs.applicative.make.scm b/algebraic-structs.applicative.make.scm deleted file mode 100644 index 3681dfa..0000000 --- a/algebraic-structs.applicative.make.scm +++ /dev/null @@ -1,28 +0,0 @@ -(functor ((algebraic-structs applicative make) (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