1 files changed, 64 insertions, 0 deletions
diff --git a/stdlib/source/lux/abstract/monad/indexed.lux b/stdlib/source/lux/abstract/monad/indexed.lux
new file mode 100644
index 000000000..57a18c109
--- /dev/null
+++ b/stdlib/source/lux/abstract/monad/indexed.lux
@@ -0,0 +1,64 @@
+(.module:
+  [lux #*
+   [control
+    [monad]
+    ["p" parser]]
+   [data
+    [collection
+     ["." list ("#;." functor fold)]]]
+   ["." macro
+    ["s" syntax (#+ Syntax syntax:)]]])
+
+(signature: #export (IxMonad m)
+  (: (All [p a]
+       (-> a (m p p a)))
+     wrap)
+
+  (: (All [ii it io vi vo]
+       (-> (-> vi (m it io vo))
+           (m ii it vi)
+           (m ii io vo)))
+     bind))
+
+(type: Binding [Code Code])
+
+(def: binding
+  (Syntax Binding)
+  (p.and s.any s.any))
+
+(type: Context
+  (#Let (List Binding))
+  (#Bind Binding))
+
+(def: context
+  (Syntax Context)
+  (p.or (p.after (s.this (' #let))
+                 (s.tuple (p.some binding)))
+        binding))
+
+(def: (pair-list [binding value])
+  (All [a] (-> [a a] (List a)))
+  (list binding value))
+
+(syntax: #export (do monad
+                   {context (s.tuple (p.some context))}
+                   expression)
+  (macro.with-gensyms [g!_ g!bind]
+    (wrap (list (` (let [(~' @) (~ monad)
+                         {#..wrap (~' wrap)
+                          #..bind (~ g!bind)} (~' @)]
+                     (~ (list;fold (function (_ context next)
+                                     (case context
+                                       (#Let bindings)
+                                       (` (let [(~+ (|> bindings
+                                                        (list;map pair-list)
+                                                        list.concat))]
+                                            (~ next)))
+                                       
+                                       (#Bind [binding value])
+                                       (` ((~ g!bind)
+                                           (.function ((~ g!_) (~ binding))
+                                             (~ next))
+                                           (~ value)))))
+                                   expression
+                                   (list.reverse context)))))))))