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.alternative.list.base.scm | 8 ----- algebraic-structs.alternative.list.scm | 5 --- algebraic-structs.alternative.make.scm | 10 ------ algebraic-structs.applicative.list.base.scm | 29 ---------------- algebraic-structs.applicative.list.scm | 5 --- algebraic-structs.applicative.make.scm | 28 ---------------- algebraic-structs.egg | 38 --------------------- algebraic-structs.foldable.list.base.scm | 2 -- algebraic-structs.foldable.list.scm | 5 --- algebraic-structs.foldable.make.scm | 39 ---------------------- algebraic-structs.foldable.vector.base.scm | 21 ------------ algebraic-structs.foldable.vector.scm | 5 --- algebraic-structs.functor.list.base.scm | 4 --- algebraic-structs.functor.list.scm | 5 --- algebraic-structs.functor.make.scm | 3 -- algebraic-structs.functor.vector.base.scm | 10 ------ algebraic-structs.functor.vector.scm | 5 --- algebraic-structs.monad.list.base.scm | 7 ---- algebraic-structs.monad.list.scm | 5 --- algebraic-structs.monad.make.scm | 32 ------------------ algebraic-structs.monoid.list.base.scm | 5 --- algebraic-structs.monoid.list.scm | 5 --- algebraic-structs.monoid.make.fold.scm | 4 --- algebraic-structs.monoid.make.scm | 3 -- algebraic-structs.monoid.number.product.base.scm | 5 --- algebraic-structs.monoid.number.product.scm | 5 --- algebraic-structs.monoid.number.sum.base.scm | 5 --- algebraic-structs.monoid.number.sum.scm | 5 --- algebraic-structures.alternative.list.base.scm | 8 +++++ algebraic-structures.alternative.list.scm | 5 +++ algebraic-structures.alternative.make.scm | 10 ++++++ algebraic-structures.applicative.list.base.scm | 29 ++++++++++++++++ algebraic-structures.applicative.list.scm | 5 +++ algebraic-structures.applicative.make.scm | 28 ++++++++++++++++ algebraic-structures.egg | 38 +++++++++++++++++++++ algebraic-structures.foldable.list.base.scm | 2 ++ algebraic-structures.foldable.list.scm | 5 +++ algebraic-structures.foldable.make.scm | 39 ++++++++++++++++++++++ algebraic-structures.foldable.vector.base.scm | 21 ++++++++++++ algebraic-structures.foldable.vector.scm | 5 +++ algebraic-structures.functor.list.base.scm | 4 +++ algebraic-structures.functor.list.scm | 5 +++ algebraic-structures.functor.make.scm | 3 ++ algebraic-structures.functor.vector.base.scm | 10 ++++++ algebraic-structures.functor.vector.scm | 5 +++ algebraic-structures.monad.list.base.scm | 7 ++++ algebraic-structures.monad.list.scm | 5 +++ algebraic-structures.monad.make.scm | 32 ++++++++++++++++++ algebraic-structures.monoid.list.base.scm | 5 +++ algebraic-structures.monoid.list.scm | 5 +++ algebraic-structures.monoid.make.fold.scm | 4 +++ algebraic-structures.monoid.make.scm | 3 ++ ...braic-structures.monoid.number.product.base.scm | 5 +++ algebraic-structures.monoid.number.product.scm | 5 +++ algebraic-structures.monoid.number.sum.base.scm | 5 +++ algebraic-structures.monoid.number.sum.scm | 5 +++ 56 files changed, 303 insertions(+), 303 deletions(-) delete mode 100644 algebraic-structs.alternative.list.base.scm delete mode 100644 algebraic-structs.alternative.list.scm delete mode 100644 algebraic-structs.alternative.make.scm delete mode 100644 algebraic-structs.applicative.list.base.scm delete mode 100644 algebraic-structs.applicative.list.scm delete mode 100644 algebraic-structs.applicative.make.scm delete mode 100644 algebraic-structs.egg delete mode 100644 algebraic-structs.foldable.list.base.scm delete mode 100644 algebraic-structs.foldable.list.scm delete mode 100644 algebraic-structs.foldable.make.scm delete mode 100644 algebraic-structs.foldable.vector.base.scm delete mode 100644 algebraic-structs.foldable.vector.scm delete mode 100644 algebraic-structs.functor.list.base.scm delete mode 100644 algebraic-structs.functor.list.scm delete mode 100644 algebraic-structs.functor.make.scm delete mode 100644 algebraic-structs.functor.vector.base.scm delete mode 100644 algebraic-structs.functor.vector.scm delete mode 100644 algebraic-structs.monad.list.base.scm delete mode 100644 algebraic-structs.monad.list.scm delete mode 100644 algebraic-structs.monad.make.scm delete mode 100644 algebraic-structs.monoid.list.base.scm delete mode 100644 algebraic-structs.monoid.list.scm delete mode 100644 algebraic-structs.monoid.make.fold.scm delete mode 100644 algebraic-structs.monoid.make.scm delete mode 100644 algebraic-structs.monoid.number.product.base.scm delete mode 100644 algebraic-structs.monoid.number.product.scm delete mode 100644 algebraic-structs.monoid.number.sum.base.scm delete mode 100644 algebraic-structs.monoid.number.sum.scm create mode 100644 algebraic-structures.alternative.list.base.scm create mode 100644 algebraic-structures.alternative.list.scm create mode 100644 algebraic-structures.alternative.make.scm create mode 100644 algebraic-structures.applicative.list.base.scm create mode 100644 algebraic-structures.applicative.list.scm create mode 100644 algebraic-structures.applicative.make.scm create mode 100644 algebraic-structures.egg create mode 100644 algebraic-structures.foldable.list.base.scm create mode 100644 algebraic-structures.foldable.list.scm create mode 100644 algebraic-structures.foldable.make.scm create mode 100644 algebraic-structures.foldable.vector.base.scm create mode 100644 algebraic-structures.foldable.vector.scm create mode 100644 algebraic-structures.functor.list.base.scm create mode 100644 algebraic-structures.functor.list.scm create mode 100644 algebraic-structures.functor.make.scm create mode 100644 algebraic-structures.functor.vector.base.scm create mode 100644 algebraic-structures.functor.vector.scm create mode 100644 algebraic-structures.monad.list.base.scm create mode 100644 algebraic-structures.monad.list.scm create mode 100644 algebraic-structures.monad.make.scm create mode 100644 algebraic-structures.monoid.list.base.scm create mode 100644 algebraic-structures.monoid.list.scm create mode 100644 algebraic-structures.monoid.make.fold.scm create mode 100644 algebraic-structures.monoid.make.scm create mode 100644 algebraic-structures.monoid.number.product.base.scm create mode 100644 algebraic-structures.monoid.number.product.scm create mode 100644 algebraic-structures.monoid.number.sum.base.scm create mode 100644 algebraic-structures.monoid.number.sum.scm diff --git a/algebraic-structs.alternative.list.base.scm b/algebraic-structs.alternative.list.base.scm deleted file mode 100644 index 73f3c84..0000000 --- a/algebraic-structs.alternative.list.base.scm +++ /dev/null @@ -1,8 +0,0 @@ -(module (algebraic-structs alternative list base) (pure map map2 alt empty) - (import (except scheme map apply) - (algebraic-structs applicative list)) - - (define (alt x y) - (append x y)) - - (define empty '())) diff --git a/algebraic-structs.alternative.list.scm b/algebraic-structs.alternative.list.scm deleted file mode 100644 index 1c366ad..0000000 --- a/algebraic-structs.alternative.list.scm +++ /dev/null @@ -1,5 +0,0 @@ -(import (only (algebraic-structs alternative make))) -(import (only (algebraic-structs alternative list base))) - -(module (algebraic-structs alternative list) = - ((algebraic-structs alternative make) (algebraic-structs alternative list base))) diff --git a/algebraic-structs.alternative.make.scm b/algebraic-structs.alternative.make.scm deleted file mode 100644 index df4e0f4..0000000 --- a/algebraic-structs.alternative.make.scm +++ /dev/null @@ -1,10 +0,0 @@ -(functor ((algebraic-structs alternative make) (A (pure map map2 alt empty))) - (pure map map2 alt empty guard) - (import (except scheme map apply) - (only (chicken base) void) - A) - - (define (guard b) - (if b - (pure (void)) - empty))) diff --git a/algebraic-structs.applicative.list.base.scm b/algebraic-structs.applicative.list.base.scm deleted file mode 100644 index 01625ff..0000000 --- a/algebraic-structs.applicative.list.base.scm +++ /dev/null @@ -1,29 +0,0 @@ -(module (algebraic-structs applicative list base) (map pure map2) - (import (except scheme map) - (algebraic-structs functor list) - (only (chicken base) atom? cut) - (only (srfi 1) append! reverse!) - matchable) - - (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-structs.applicative.list.scm b/algebraic-structs.applicative.list.scm deleted file mode 100644 index 44d3a28..0000000 --- a/algebraic-structs.applicative.list.scm +++ /dev/null @@ -1,5 +0,0 @@ -(import (only (algebraic-structs applicative make))) -(import (only (algebraic-structs applicative list base))) - -(module (algebraic-structs applicative list) = - ((algebraic-structs applicative make) (algebraic-structs applicative list base))) 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))) diff --git a/algebraic-structs.egg b/algebraic-structs.egg deleted file mode 100644 index 1a1a73d..0000000 --- a/algebraic-structs.egg +++ /dev/null @@ -1,38 +0,0 @@ -;;; -*- scheme -*- - -((synopsis "Provides useful algebraic structures for programming using parameterized module.") - (author "Masaya Tojo") - (license "BSD") - (category data) - (version "0.1.0") - (dependencies matchable) - (test-dependencies test) - (components - (extension algebraic-structs.monoid.make) - (extension algebraic-structs.monoid.list.base) - (extension algebraic-structs.monoid.list) - (extension algebraic-structs.monoid.number.sum.base) - (extension algebraic-structs.monoid.number.sum) - (extension algebraic-structs.monoid.number.product.base) - (extension algebraic-structs.monoid.number.product) - (extension algebraic-structs.monoid.make.fold) - (extension algebraic-structs.foldable.make) - (extension algebraic-structs.foldable.list.base) - (extension algebraic-structs.foldable.list) - (extension algebraic-structs.foldable.vector.base) - (extension algebraic-structs.foldable.vector) - (extension algebraic-structs.functor.make) - (extension algebraic-structs.functor.list.base) - (extension algebraic-structs.functor.list) - (extension algebraic-structs.functor.vector.base) - (extension algebraic-structs.functor.vector) - (extension algebraic-structs.applicative.make) - (extension algebraic-structs.applicative.list.base) - (extension algebraic-structs.applicative.list) - (extension algebraic-structs.monad.make) - (extension algebraic-structs.monad.list.base) - (extension algebraic-structs.monad.list) - (extension algebraic-structs.monad.list) - (extension algebraic-structs.alternative.make) - (extension algebraic-structs.alternative.list.base) - (extension algebraic-structs.alternative.list))) diff --git a/algebraic-structs.foldable.list.base.scm b/algebraic-structs.foldable.list.base.scm deleted file mode 100644 index 0f5c656..0000000 --- a/algebraic-structs.foldable.list.base.scm +++ /dev/null @@ -1,2 +0,0 @@ -(module (algebraic-structs foldable list base) (foldl foldr) - (import (only (chicken base) foldl foldr))) diff --git a/algebraic-structs.foldable.list.scm b/algebraic-structs.foldable.list.scm deleted file mode 100644 index 5f729e2..0000000 --- a/algebraic-structs.foldable.list.scm +++ /dev/null @@ -1,5 +0,0 @@ -(import (only (algebraic-structs foldable list base))) -(import (only (algebraic-structs foldable make))) - -(module (algebraic-structs foldable list) = ((algebraic-structs foldable make) - (algebraic-structs foldable list base))) diff --git a/algebraic-structs.foldable.make.scm b/algebraic-structs.foldable.make.scm deleted file mode 100644 index 46b4dd5..0000000 --- a/algebraic-structs.foldable.make.scm +++ /dev/null @@ -1,39 +0,0 @@ -(functor ((algebraic-structs foldable make) (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))) diff --git a/algebraic-structs.foldable.vector.base.scm b/algebraic-structs.foldable.vector.base.scm deleted file mode 100644 index 0c5af89..0000000 --- a/algebraic-structs.foldable.vector.base.scm +++ /dev/null @@ -1,21 +0,0 @@ -(module (algebraic-structs foldable vector base) (foldl foldr) - (import scheme - (only (chicken base) add1 sub1)) - - (define (foldl f z v) - (let ((len (vector-length v))) - (let loop ((i 0) - (acc z)) - (if (= i len) - acc - (loop (add1 i) - (f acc (vector-ref v i))))))) - - (define (foldr f z v) - (let ((len (vector-length v))) - (let loop ((i (sub1 len)) - (acc z)) - (if (< i 0) - acc - (loop (sub1 i) - (f (vector-ref v i) acc))))))) diff --git a/algebraic-structs.foldable.vector.scm b/algebraic-structs.foldable.vector.scm deleted file mode 100644 index 1d68aaa..0000000 --- a/algebraic-structs.foldable.vector.scm +++ /dev/null @@ -1,5 +0,0 @@ -(import (only (algebraic-structs foldable vector base))) -(import (only (algebraic-structs foldable make))) - -(module (algebraic-structs foldable vector) = ((algebraic-structs foldable make) - (algebraic-structs foldable vector base))) diff --git a/algebraic-structs.functor.list.base.scm b/algebraic-structs.functor.list.base.scm deleted file mode 100644 index e3051d5..0000000 --- a/algebraic-structs.functor.list.base.scm +++ /dev/null @@ -1,4 +0,0 @@ -(module (algebraic-structs functor list base) (map) - (import (rename (scheme) (map list:map))) - - (define (map f lst) (list:map f lst))) diff --git a/algebraic-structs.functor.list.scm b/algebraic-structs.functor.list.scm deleted file mode 100644 index 62c4910..0000000 --- a/algebraic-structs.functor.list.scm +++ /dev/null @@ -1,5 +0,0 @@ -(import (only (algebraic-structs functor list base))) -(import (only (algebraic-structs functor make))) - -(module (algebraic-structs functor list) = ((algebraic-structs functor make) - (algebraic-structs functor list base))) diff --git a/algebraic-structs.functor.make.scm b/algebraic-structs.functor.make.scm deleted file mode 100644 index 23b366f..0000000 --- a/algebraic-structs.functor.make.scm +++ /dev/null @@ -1,3 +0,0 @@ -(functor ((algebraic-structs functor make) (F (map))) - (map) - (import F)) diff --git a/algebraic-structs.functor.vector.base.scm b/algebraic-structs.functor.vector.base.scm deleted file mode 100644 index 2f44673..0000000 --- a/algebraic-structs.functor.vector.base.scm +++ /dev/null @@ -1,10 +0,0 @@ -(module (algebraic-structs functor vector base) (map) - (import (rename scheme (map list-map)) - (only (chicken base) add1)) - - (define (map f v) - (let* ((len (vector-length v)) - (new (make-vector len))) - (do ((i 0 (add1 i))) - ((= i len) new) - (vector-set! new i (vector-ref v i)))))) diff --git a/algebraic-structs.functor.vector.scm b/algebraic-structs.functor.vector.scm deleted file mode 100644 index 26481cc..0000000 --- a/algebraic-structs.functor.vector.scm +++ /dev/null @@ -1,5 +0,0 @@ -(import (only (algebraic-structs functor vector base))) -(import (only (algebraic-structs functor make))) - -(module (algebraic-structs functor vector) = ((algebraic-structs functor make) - (algebraic-structs functor vector base))) diff --git a/algebraic-structs.monad.list.base.scm b/algebraic-structs.monad.list.base.scm deleted file mode 100644 index a7305a0..0000000 --- a/algebraic-structs.monad.list.base.scm +++ /dev/null @@ -1,7 +0,0 @@ -(module (algebraic-structs monad list base) (pure map map2 >>=) - (import (except scheme map) - (algebraic-structs applicative list) - (only (srfi 1) append-map)) - - (define (>>= lst f) - (append-map f lst))) diff --git a/algebraic-structs.monad.list.scm b/algebraic-structs.monad.list.scm deleted file mode 100644 index edb5cf7..0000000 --- a/algebraic-structs.monad.list.scm +++ /dev/null @@ -1,5 +0,0 @@ -(import (only (algebraic-structs monad make))) -(import (only (algebraic-structs monad list base))) - -(module (algebraic-structs monad list) = - ((algebraic-structs monad make) (algebraic-structs monad list base))) diff --git a/algebraic-structs.monad.make.scm b/algebraic-structs.monad.make.scm deleted file mode 100644 index 70ead19..0000000 --- a/algebraic-structs.monad.make.scm +++ /dev/null @@ -1,32 +0,0 @@ -(functor ((algebraic-structs monad make) (M (pure map map2 >>=))) - (pure map map2 >>= do) - (import (rename scheme (map scheme:map) (do scheme:do)) - M) - (import-for-syntax matchable - (chicken syntax) - (only (srfi 1) last)) - - (define-syntax do - (ir-macro-transformer - (lambda (expr inject compare) - (match expr - [(_ body ...) - (foldr (lambda (binding acc) - (match binding - [(var stx expr) - (if (and (symbol? var) - (symbol? stx) - (compare stx '<-)) - `(>>= ,expr (lambda (,var) ,acc)) - `(>>= ,binding (lambda (_) ,acc)))] - [(let-stx var =-stx expr) - (cond ((and (symbol? var) - (symbol? let-stx) (compare let-stx (inject 'let)) - (symbol? =-stx) (compare =-stx (inject '=))) - `((lambda (,var) ,acc) ,expr)) - (else - `(>>= ,binding (lambda (_) ,acc))))] - [expr - `(>>= ,expr (lambda (_) ,acc))])) - (last body) - (butlast body))]))))) diff --git a/algebraic-structs.monoid.list.base.scm b/algebraic-structs.monoid.list.base.scm deleted file mode 100644 index cdda71e..0000000 --- a/algebraic-structs.monoid.list.base.scm +++ /dev/null @@ -1,5 +0,0 @@ -(module (algebraic-structs monoid list base) (op unit) - (import scheme) - - (define op append) - (define unit '())) diff --git a/algebraic-structs.monoid.list.scm b/algebraic-structs.monoid.list.scm deleted file mode 100644 index 226fcd4..0000000 --- a/algebraic-structs.monoid.list.scm +++ /dev/null @@ -1,5 +0,0 @@ -(import (only (algebraic-structs monoid list base))) -(import (only (algebraic-structs monoid make))) - -(module (algebraic-structs monoid list) = ((algebraic-structs monoid make) - (algebraic-structs monoid list base))) diff --git a/algebraic-structs.monoid.make.fold.scm b/algebraic-structs.monoid.make.fold.scm deleted file mode 100644 index 05a1754..0000000 --- a/algebraic-structs.monoid.make.fold.scm +++ /dev/null @@ -1,4 +0,0 @@ -(functor ((algebraic-structs monoid make fold) (M (op unit)) (F (foldl foldr))) (fold) - (import scheme M F) - - (define (fold x) (foldl op unit x))) diff --git a/algebraic-structs.monoid.make.scm b/algebraic-structs.monoid.make.scm deleted file mode 100644 index 8b683a8..0000000 --- a/algebraic-structs.monoid.make.scm +++ /dev/null @@ -1,3 +0,0 @@ -(functor ((algebraic-structs monoid make) (F (op unit))) - (op unit) - (import F)) diff --git a/algebraic-structs.monoid.number.product.base.scm b/algebraic-structs.monoid.number.product.base.scm deleted file mode 100644 index 2790061..0000000 --- a/algebraic-structs.monoid.number.product.base.scm +++ /dev/null @@ -1,5 +0,0 @@ -(module (algebraic-structs monoid number product base) (op unit) - (import scheme) - - (define op *) - (define unit 1)) diff --git a/algebraic-structs.monoid.number.product.scm b/algebraic-structs.monoid.number.product.scm deleted file mode 100644 index 1f1da6e..0000000 --- a/algebraic-structs.monoid.number.product.scm +++ /dev/null @@ -1,5 +0,0 @@ -(import (only (algebraic-structs monoid number product base))) -(import (only (algebraic-structs monoid make))) - -(module (algebraic-structs monoid number product) = ((algebraic-structs monoid make) - (algebraic-structs monoid number product base))) diff --git a/algebraic-structs.monoid.number.sum.base.scm b/algebraic-structs.monoid.number.sum.base.scm deleted file mode 100644 index 1f75e7b..0000000 --- a/algebraic-structs.monoid.number.sum.base.scm +++ /dev/null @@ -1,5 +0,0 @@ -(module (algebraic-structs monoid number sum base) (op unit) - (import scheme) - - (define op +) - (define unit 0)) diff --git a/algebraic-structs.monoid.number.sum.scm b/algebraic-structs.monoid.number.sum.scm deleted file mode 100644 index eac1f08..0000000 --- a/algebraic-structs.monoid.number.sum.scm +++ /dev/null @@ -1,5 +0,0 @@ -(import (only (algebraic-structs monoid number sum base))) -(import (only (algebraic-structs monoid make))) - -(module (algebraic-structs monoid number sum) = ((algebraic-structs monoid make) - (algebraic-structs monoid number sum base))) diff --git a/algebraic-structures.alternative.list.base.scm b/algebraic-structures.alternative.list.base.scm new file mode 100644 index 0000000..73f3c84 --- /dev/null +++ b/algebraic-structures.alternative.list.base.scm @@ -0,0 +1,8 @@ +(module (algebraic-structs alternative list base) (pure map map2 alt empty) + (import (except scheme map apply) + (algebraic-structs applicative list)) + + (define (alt x y) + (append x y)) + + (define empty '())) diff --git a/algebraic-structures.alternative.list.scm b/algebraic-structures.alternative.list.scm new file mode 100644 index 0000000..1c366ad --- /dev/null +++ b/algebraic-structures.alternative.list.scm @@ -0,0 +1,5 @@ +(import (only (algebraic-structs alternative make))) +(import (only (algebraic-structs alternative list base))) + +(module (algebraic-structs alternative list) = + ((algebraic-structs alternative make) (algebraic-structs alternative list base))) diff --git a/algebraic-structures.alternative.make.scm b/algebraic-structures.alternative.make.scm new file mode 100644 index 0000000..df4e0f4 --- /dev/null +++ b/algebraic-structures.alternative.make.scm @@ -0,0 +1,10 @@ +(functor ((algebraic-structs alternative make) (A (pure map map2 alt empty))) + (pure map map2 alt empty guard) + (import (except scheme map apply) + (only (chicken base) void) + A) + + (define (guard b) + (if b + (pure (void)) + empty))) diff --git a/algebraic-structures.applicative.list.base.scm b/algebraic-structures.applicative.list.base.scm new file mode 100644 index 0000000..01625ff --- /dev/null +++ b/algebraic-structures.applicative.list.base.scm @@ -0,0 +1,29 @@ +(module (algebraic-structs applicative list base) (map pure map2) + (import (except scheme map) + (algebraic-structs functor list) + (only (chicken base) atom? cut) + (only (srfi 1) append! reverse!) + matchable) + + (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.applicative.list.scm b/algebraic-structures.applicative.list.scm new file mode 100644 index 0000000..44d3a28 --- /dev/null +++ b/algebraic-structures.applicative.list.scm @@ -0,0 +1,5 @@ +(import (only (algebraic-structs applicative make))) +(import (only (algebraic-structs applicative list base))) + +(module (algebraic-structs applicative list) = + ((algebraic-structs applicative make) (algebraic-structs applicative list base))) diff --git a/algebraic-structures.applicative.make.scm b/algebraic-structures.applicative.make.scm new file mode 100644 index 0000000..3681dfa --- /dev/null +++ b/algebraic-structures.applicative.make.scm @@ -0,0 +1,28 @@ +(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))) diff --git a/algebraic-structures.egg b/algebraic-structures.egg new file mode 100644 index 0000000..1a1a73d --- /dev/null +++ b/algebraic-structures.egg @@ -0,0 +1,38 @@ +;;; -*- scheme -*- + +((synopsis "Provides useful algebraic structures for programming using parameterized module.") + (author "Masaya Tojo") + (license "BSD") + (category data) + (version "0.1.0") + (dependencies matchable) + (test-dependencies test) + (components + (extension algebraic-structs.monoid.make) + (extension algebraic-structs.monoid.list.base) + (extension algebraic-structs.monoid.list) + (extension algebraic-structs.monoid.number.sum.base) + (extension algebraic-structs.monoid.number.sum) + (extension algebraic-structs.monoid.number.product.base) + (extension algebraic-structs.monoid.number.product) + (extension algebraic-structs.monoid.make.fold) + (extension algebraic-structs.foldable.make) + (extension algebraic-structs.foldable.list.base) + (extension algebraic-structs.foldable.list) + (extension algebraic-structs.foldable.vector.base) + (extension algebraic-structs.foldable.vector) + (extension algebraic-structs.functor.make) + (extension algebraic-structs.functor.list.base) + (extension algebraic-structs.functor.list) + (extension algebraic-structs.functor.vector.base) + (extension algebraic-structs.functor.vector) + (extension algebraic-structs.applicative.make) + (extension algebraic-structs.applicative.list.base) + (extension algebraic-structs.applicative.list) + (extension algebraic-structs.monad.make) + (extension algebraic-structs.monad.list.base) + (extension algebraic-structs.monad.list) + (extension algebraic-structs.monad.list) + (extension algebraic-structs.alternative.make) + (extension algebraic-structs.alternative.list.base) + (extension algebraic-structs.alternative.list))) diff --git a/algebraic-structures.foldable.list.base.scm b/algebraic-structures.foldable.list.base.scm new file mode 100644 index 0000000..0f5c656 --- /dev/null +++ b/algebraic-structures.foldable.list.base.scm @@ -0,0 +1,2 @@ +(module (algebraic-structs foldable list base) (foldl foldr) + (import (only (chicken base) foldl foldr))) diff --git a/algebraic-structures.foldable.list.scm b/algebraic-structures.foldable.list.scm new file mode 100644 index 0000000..5f729e2 --- /dev/null +++ b/algebraic-structures.foldable.list.scm @@ -0,0 +1,5 @@ +(import (only (algebraic-structs foldable list base))) +(import (only (algebraic-structs foldable make))) + +(module (algebraic-structs foldable list) = ((algebraic-structs foldable make) + (algebraic-structs foldable list base))) diff --git a/algebraic-structures.foldable.make.scm b/algebraic-structures.foldable.make.scm new file mode 100644 index 0000000..46b4dd5 --- /dev/null +++ b/algebraic-structures.foldable.make.scm @@ -0,0 +1,39 @@ +(functor ((algebraic-structs foldable make) (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))) diff --git a/algebraic-structures.foldable.vector.base.scm b/algebraic-structures.foldable.vector.base.scm new file mode 100644 index 0000000..0c5af89 --- /dev/null +++ b/algebraic-structures.foldable.vector.base.scm @@ -0,0 +1,21 @@ +(module (algebraic-structs foldable vector base) (foldl foldr) + (import scheme + (only (chicken base) add1 sub1)) + + (define (foldl f z v) + (let ((len (vector-length v))) + (let loop ((i 0) + (acc z)) + (if (= i len) + acc + (loop (add1 i) + (f acc (vector-ref v i))))))) + + (define (foldr f z v) + (let ((len (vector-length v))) + (let loop ((i (sub1 len)) + (acc z)) + (if (< i 0) + acc + (loop (sub1 i) + (f (vector-ref v i) acc))))))) diff --git a/algebraic-structures.foldable.vector.scm b/algebraic-structures.foldable.vector.scm new file mode 100644 index 0000000..1d68aaa --- /dev/null +++ b/algebraic-structures.foldable.vector.scm @@ -0,0 +1,5 @@ +(import (only (algebraic-structs foldable vector base))) +(import (only (algebraic-structs foldable make))) + +(module (algebraic-structs foldable vector) = ((algebraic-structs foldable make) + (algebraic-structs foldable vector base))) diff --git a/algebraic-structures.functor.list.base.scm b/algebraic-structures.functor.list.base.scm new file mode 100644 index 0000000..e3051d5 --- /dev/null +++ b/algebraic-structures.functor.list.base.scm @@ -0,0 +1,4 @@ +(module (algebraic-structs functor list base) (map) + (import (rename (scheme) (map list:map))) + + (define (map f lst) (list:map f lst))) diff --git a/algebraic-structures.functor.list.scm b/algebraic-structures.functor.list.scm new file mode 100644 index 0000000..62c4910 --- /dev/null +++ b/algebraic-structures.functor.list.scm @@ -0,0 +1,5 @@ +(import (only (algebraic-structs functor list base))) +(import (only (algebraic-structs functor make))) + +(module (algebraic-structs functor list) = ((algebraic-structs functor make) + (algebraic-structs functor list base))) diff --git a/algebraic-structures.functor.make.scm b/algebraic-structures.functor.make.scm new file mode 100644 index 0000000..23b366f --- /dev/null +++ b/algebraic-structures.functor.make.scm @@ -0,0 +1,3 @@ +(functor ((algebraic-structs functor make) (F (map))) + (map) + (import F)) diff --git a/algebraic-structures.functor.vector.base.scm b/algebraic-structures.functor.vector.base.scm new file mode 100644 index 0000000..2f44673 --- /dev/null +++ b/algebraic-structures.functor.vector.base.scm @@ -0,0 +1,10 @@ +(module (algebraic-structs functor vector base) (map) + (import (rename scheme (map list-map)) + (only (chicken base) add1)) + + (define (map f v) + (let* ((len (vector-length v)) + (new (make-vector len))) + (do ((i 0 (add1 i))) + ((= i len) new) + (vector-set! new i (vector-ref v i)))))) diff --git a/algebraic-structures.functor.vector.scm b/algebraic-structures.functor.vector.scm new file mode 100644 index 0000000..26481cc --- /dev/null +++ b/algebraic-structures.functor.vector.scm @@ -0,0 +1,5 @@ +(import (only (algebraic-structs functor vector base))) +(import (only (algebraic-structs functor make))) + +(module (algebraic-structs functor vector) = ((algebraic-structs functor make) + (algebraic-structs functor vector base))) diff --git a/algebraic-structures.monad.list.base.scm b/algebraic-structures.monad.list.base.scm new file mode 100644 index 0000000..a7305a0 --- /dev/null +++ b/algebraic-structures.monad.list.base.scm @@ -0,0 +1,7 @@ +(module (algebraic-structs monad list base) (pure map map2 >>=) + (import (except scheme map) + (algebraic-structs applicative list) + (only (srfi 1) append-map)) + + (define (>>= lst f) + (append-map f lst))) diff --git a/algebraic-structures.monad.list.scm b/algebraic-structures.monad.list.scm new file mode 100644 index 0000000..edb5cf7 --- /dev/null +++ b/algebraic-structures.monad.list.scm @@ -0,0 +1,5 @@ +(import (only (algebraic-structs monad make))) +(import (only (algebraic-structs monad list base))) + +(module (algebraic-structs monad list) = + ((algebraic-structs monad make) (algebraic-structs monad list base))) diff --git a/algebraic-structures.monad.make.scm b/algebraic-structures.monad.make.scm new file mode 100644 index 0000000..70ead19 --- /dev/null +++ b/algebraic-structures.monad.make.scm @@ -0,0 +1,32 @@ +(functor ((algebraic-structs monad make) (M (pure map map2 >>=))) + (pure map map2 >>= do) + (import (rename scheme (map scheme:map) (do scheme:do)) + M) + (import-for-syntax matchable + (chicken syntax) + (only (srfi 1) last)) + + (define-syntax do + (ir-macro-transformer + (lambda (expr inject compare) + (match expr + [(_ body ...) + (foldr (lambda (binding acc) + (match binding + [(var stx expr) + (if (and (symbol? var) + (symbol? stx) + (compare stx '<-)) + `(>>= ,expr (lambda (,var) ,acc)) + `(>>= ,binding (lambda (_) ,acc)))] + [(let-stx var =-stx expr) + (cond ((and (symbol? var) + (symbol? let-stx) (compare let-stx (inject 'let)) + (symbol? =-stx) (compare =-stx (inject '=))) + `((lambda (,var) ,acc) ,expr)) + (else + `(>>= ,binding (lambda (_) ,acc))))] + [expr + `(>>= ,expr (lambda (_) ,acc))])) + (last body) + (butlast body))]))))) diff --git a/algebraic-structures.monoid.list.base.scm b/algebraic-structures.monoid.list.base.scm new file mode 100644 index 0000000..cdda71e --- /dev/null +++ b/algebraic-structures.monoid.list.base.scm @@ -0,0 +1,5 @@ +(module (algebraic-structs monoid list base) (op unit) + (import scheme) + + (define op append) + (define unit '())) diff --git a/algebraic-structures.monoid.list.scm b/algebraic-structures.monoid.list.scm new file mode 100644 index 0000000..226fcd4 --- /dev/null +++ b/algebraic-structures.monoid.list.scm @@ -0,0 +1,5 @@ +(import (only (algebraic-structs monoid list base))) +(import (only (algebraic-structs monoid make))) + +(module (algebraic-structs monoid list) = ((algebraic-structs monoid make) + (algebraic-structs monoid list base))) diff --git a/algebraic-structures.monoid.make.fold.scm b/algebraic-structures.monoid.make.fold.scm new file mode 100644 index 0000000..05a1754 --- /dev/null +++ b/algebraic-structures.monoid.make.fold.scm @@ -0,0 +1,4 @@ +(functor ((algebraic-structs monoid make fold) (M (op unit)) (F (foldl foldr))) (fold) + (import scheme M F) + + (define (fold x) (foldl op unit x))) diff --git a/algebraic-structures.monoid.make.scm b/algebraic-structures.monoid.make.scm new file mode 100644 index 0000000..8b683a8 --- /dev/null +++ b/algebraic-structures.monoid.make.scm @@ -0,0 +1,3 @@ +(functor ((algebraic-structs monoid make) (F (op unit))) + (op unit) + (import F)) diff --git a/algebraic-structures.monoid.number.product.base.scm b/algebraic-structures.monoid.number.product.base.scm new file mode 100644 index 0000000..2790061 --- /dev/null +++ b/algebraic-structures.monoid.number.product.base.scm @@ -0,0 +1,5 @@ +(module (algebraic-structs monoid number product base) (op unit) + (import scheme) + + (define op *) + (define unit 1)) diff --git a/algebraic-structures.monoid.number.product.scm b/algebraic-structures.monoid.number.product.scm new file mode 100644 index 0000000..1f1da6e --- /dev/null +++ b/algebraic-structures.monoid.number.product.scm @@ -0,0 +1,5 @@ +(import (only (algebraic-structs monoid number product base))) +(import (only (algebraic-structs monoid make))) + +(module (algebraic-structs monoid number product) = ((algebraic-structs monoid make) + (algebraic-structs monoid number product base))) diff --git a/algebraic-structures.monoid.number.sum.base.scm b/algebraic-structures.monoid.number.sum.base.scm new file mode 100644 index 0000000..1f75e7b --- /dev/null +++ b/algebraic-structures.monoid.number.sum.base.scm @@ -0,0 +1,5 @@ +(module (algebraic-structs monoid number sum base) (op unit) + (import scheme) + + (define op +) + (define unit 0)) diff --git a/algebraic-structures.monoid.number.sum.scm b/algebraic-structures.monoid.number.sum.scm new file mode 100644 index 0000000..eac1f08 --- /dev/null +++ b/algebraic-structures.monoid.number.sum.scm @@ -0,0 +1,5 @@ +(import (only (algebraic-structs monoid number sum base))) +(import (only (algebraic-structs monoid make))) + +(module (algebraic-structs monoid number sum) = ((algebraic-structs monoid make) + (algebraic-structs monoid number sum base))) -- cgit v1.2.3