1 files changed, 32 insertions, 0 deletions
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))])))))