diff options
author | Masaya Tojo <masaya@tojo.tokyo> | 2024-06-13 02:11:07 +0900 |
---|---|---|
committer | Masaya Tojo <masaya@tojo.tokyo> | 2024-06-13 02:11:07 +0900 |
commit | ca1584a5c87c2952af08c74ce80b1cb2a75a1d19 (patch) | |
tree | 6a6f5ebde7bb00f8bd74501ecac563c5a1dc51f6 /algebraic-structures.monad.scm | |
parent | 653b204b583da363a97464960a00f1bd0dbed865 (diff) |
Rename modules from (<feature name> ... make) to (<feature name>)
Diffstat (limited to 'algebraic-structures.monad.scm')
-rw-r--r-- | algebraic-structures.monad.scm | 32 |
1 files changed, 32 insertions, 0 deletions
diff --git a/algebraic-structures.monad.scm b/algebraic-structures.monad.scm new file mode 100644 index 0000000..fd5ff82 --- /dev/null +++ b/algebraic-structures.monad.scm @@ -0,0 +1,32 @@ +(functor ((algebraic-structures monad) (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))]))))) |