1 files changed, 62 insertions, 0 deletions
diff --git a/stdlib/source/lux/abstract/comonad.lux b/stdlib/source/lux/abstract/comonad.lux
new file mode 100644
index 000000000..1d6ac49e5
--- /dev/null
+++ b/stdlib/source/lux/abstract/comonad.lux
@@ -0,0 +1,62 @@
+(.module:
+  [lux #*
+   [data
+    [collection
+     ["." list ("#;." fold)]]]]
+  [//
+   ["." functor (#+ Functor)]])
+
+(signature: #export (CoMonad w)
+  {#.doc (doc "CoMonads are the opposite/complement to monads."
+              "CoMonadic structures are often infinite in size and built upon lazily-evaluated functions.")}
+  (: (Functor w)
+     &functor)
+  (: (All [a]
+       (-> (w a) a))
+     unwrap)
+  (: (All [a]
+       (-> (w a) (w (w a))))
+     split))
+
+(type: #export (CoFree F a)
+  {#.doc "The CoFree CoMonad."}
+  [a (F (CoFree F a))])
+
+(def: _cursor Cursor ["" 0 0])
+
+(macro: #export (be tokens state)
+  {#.doc (doc "A co-monadic parallel to the 'do' macro."
+              (let [square (function (_ n) (i/* n n))]
+                (be comonad
+                  [inputs (iterate inc +2)]
+                  (square (head inputs)))))}
+  (case tokens
+    (#.Cons comonad (#.Cons [_ (#.Tuple bindings)] (#.Cons body #.Nil)))
+    (if (|> bindings list.size (n/% 2) (n/= 0))
+      (let [g!_ (: Code [_cursor (#.Identifier ["" " _ "])])
+            g!map (: Code [_cursor (#.Identifier ["" " map "])])
+            g!split (: Code [_cursor (#.Identifier ["" " split "])])
+            body' (list;fold (: (-> [Code Code] Code Code)
+                                (function (_ binding body')
+                                  (let [[var value] binding]
+                                    (case var
+                                      [_ (#.Tag ["" "let"])]
+                                      (` (let (~ value) (~ body')))
+
+                                      _
+                                      (` (|> (~ value) (~ g!split) ((~ g!map) (function ((~ g!_) (~ var)) (~ body')))))
+                                      ))))
+                             body
+                             (list.reverse (list.as-pairs bindings)))]
+        (#.Right [state (#.Cons (` ({(~' @)
+                                     ({{#&functor {#functor.map (~ g!map)}
+                                        #unwrap (~' unwrap)
+                                        #split (~ g!split)}
+                                       (~ body')}
+                                      (~' @))}
+                                    (~ comonad)))
+                                #.Nil)]))
+      (#.Left "'be' bindings must have an even number of parts."))
+
+    _
+    (#.Left "Wrong syntax for 'be'")))