2 files changed, 107 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/abstract/comonad.lux b/stdlib/source/library/lux/abstract/comonad.lux
new file mode 100644
index 000000000..362556f50
--- /dev/null
+++ b/stdlib/source/library/lux/abstract/comonad.lux
@@ -0,0 +1,79 @@
+(.module:
+  [library
+   [lux #*
+    [data
+     [collection
+      ["." list ("#\." fold)]]]
+    [math
+     [number
+      ["n" nat]]]
+    [meta
+     ["." location]]]]
+  [//
+   [functor (#+ Functor)]])
+
+(interface: #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))
+
+(macro: #export (be tokens state)
+  {#.doc (doc "A co-monadic parallel to the 'do' macro."
+              (let [square (function (_ n) (* n n))]
+                (be comonad
+                  [inputs (iterate inc +2)]
+                  (square (head inputs)))))}
+  (case (: (Maybe [(Maybe Text) Code (List Code) Code])
+           (case tokens
+             (^ (list [_ (#.Record (list [[_ (#.Identifier ["" name])] comonad]))] [_ (#.Tuple bindings)] body))
+             (#.Some [(#.Some name) comonad bindings body])
+             
+             (^ (list comonad [_ (#.Tuple bindings)] body))
+             (#.Some [#.None comonad bindings body])
+
+             _
+             #.None))
+    (#.Some [?name comonad bindings body])
+    (if (|> bindings list.size (n.% 2) (n.= 0))
+      (let [[module short] (name_of ..be)
+            gensym (: (-> Text Code)
+                      (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [location.dummy]))
+            g!_ (gensym "_")
+            g!map (gensym "map")
+            g!split (gensym "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 (list (case ?name
+                                (#.Some name)
+                                (let [name [location.dummy (#.Identifier ["" name])]]
+                                  (` ({(~ name)
+                                       ({[(~ g!map) (~' unwrap) (~ g!split)]
+                                         (~ body')}
+                                        (~ name))}
+                                      (~ comonad))))
+
+                                #.None
+                                (` ({[(~ g!map) (~' unwrap) (~ g!split)]
+                                     (~ body')}
+                                    (~ comonad)))))]))
+      (#.Left "'be' bindings must have an even number of parts."))
+
+    #.None
+    (#.Left "Wrong syntax for 'be'")))
diff --git a/stdlib/source/library/lux/abstract/comonad/cofree.lux b/stdlib/source/library/lux/abstract/comonad/cofree.lux
new file mode 100644
index 000000000..c0236f079
--- /dev/null
+++ b/stdlib/source/library/lux/abstract/comonad/cofree.lux
@@ -0,0 +1,28 @@
+(.module:
+  [library
+   [lux #*]]
+  [// (#+ CoMonad)
+   [//
+    [functor (#+ Functor)]]])
+
+(type: #export (CoFree F a)
+  {#.doc "The CoFree CoMonad."}
+  [a (F (CoFree F a))])
+
+(implementation: #export (functor dsl)
+  (All [F] (-> (Functor F) (Functor (CoFree F))))
+  
+  (def: (map f [head tail])
+    [(f head) (\ dsl map (map f) tail)]))
+
+(implementation: #export (comonad dsl)
+  (All [F] (-> (Functor F) (CoMonad (CoFree F))))
+
+  (def: &functor (..functor dsl))
+
+  (def: (unwrap [head tail])
+    head)
+
+  (def: (split [head tail])
+    [[head tail]
+     (\ dsl map split tail)]))