- Some refactorings, new types & functions, and moved the lux/effect module to lux/control/effect.

7 files changed, 90 insertions, 57 deletions

diff --git a/stdlib/source/lux/control/algebra.lux b/stdlib/source/lux/control/algebra.lux
new file mode 100644
index 000000000..e743f4497
--- /dev/null
+++ b/stdlib/source/lux/control/algebra.lux
@@ -0,0 +1,16 @@
+(;module:
+  lux
+  (lux (control functor)))
+
+## Types
+(type: #export (Algebra f a)
+  (-> (f a) a))
+
+(type: #export (CoAlgebra f a)
+  (-> a (f a)))
+
+(type: #export (RAlgebra f a)
+  (-> (f (& (Fix f) a)) a))
+
+(type: #export (RCoAlgebra f a)
+  (-> a (f (| (Fix f) a))))
diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux
index 5ed443040..428bb484f 100644
--- a/stdlib/source/lux/control/comonad.lux
+++ b/stdlib/source/lux/control/comonad.lux
@@ -17,6 +17,11 @@
        (-> (w a) (w (w a))))
      split))
 
+## [Types]
+(type: #export (CoFree F a)
+  {#;doc "The CoFree CoMonad."}
+  [a (F (CoFree F a))])
+
 ## [Syntax]
 (def: _cursor Cursor ["" +0 +0])
 
@@ -43,10 +48,10 @@
                       body
                       (reverse (as-pairs bindings)))]
       (#;Right [state (#;Cons (` (;_lux_case (~ comonad)
-                                             (~' @)
-                                             (;_lux_case (~' @)
-                                                         {#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)}
-                                                         (~ body'))))
+                                   (~' @)
+                                   (;_lux_case (~' @)
+                                     {#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)}
+                                     (~ body'))))
                               #;Nil)]))
 
     _
diff --git a/stdlib/source/lux/effect.lux b/stdlib/source/lux/control/effect.lux
index 2540effb8..d0e2e0576 100644
--- a/stdlib/source/lux/effect.lux
+++ b/stdlib/source/lux/control/effect.lux
@@ -2,7 +2,7 @@
   lux
   (lux (control ["F" functor]
                 applicative
-                monad)
+                ["M" monad #*])
        [io #- run]
        (data (coll [list "List/" Monad<List> Monoid<List>])
              [number "Nat/" Codec<Text,Nat>]
@@ -18,11 +18,6 @@
        [type]))
 
 ## [Type]
-(type: #export (Eff F a)
-  {#;doc "A Free Monad implementation for algebraic effects."}
-  (#Pure a)
-  (#Effect (F (Eff F a))))
-
 (sig: #export (Handler E M)
   {#;doc "A way to interpret effects into arbitrary monads."}
   (: (Monad M)
@@ -31,57 +26,57 @@
      handle))
 
 ## [Values]
-(struct: #export (Functor<Eff> dsl)
-  (All [F] (-> (F;Functor F) (F;Functor (Eff F))))
+(struct: #export (Functor<Free> dsl)
+  (All [F] (-> (F;Functor F) (F;Functor (Free F))))
   (def: (map f ea)
     (case ea
-      (#Pure a)
-      (#Pure (f a))
+      (#M;Pure a)
+      (#M;Pure (f a))
       
-      (#Effect value)
-      (#Effect (:: dsl map (map f) value)))))
+      (#M;Effect value)
+      (#M;Effect (:: dsl map (map f) value)))))
 
-(struct: #export (Applicative<Eff> dsl)
-  (All [F] (-> (F;Functor F) (Applicative (Eff F))))
-  (def: functor (Functor<Eff> dsl))
+(struct: #export (Applicative<Free> dsl)
+  (All [F] (-> (F;Functor F) (Applicative (Free F))))
+  (def: functor (Functor<Free> dsl))
 
   (def: (wrap a)
-    (#Pure a))
+    (#M;Pure a))
   
   (def: (apply ef ea)
     (case [ef ea]
-      [(#Pure f) (#Pure a)]
-      (#Pure (f a))
-
-      [(#Pure f) (#Effect fa)]
-      (#Effect (:: dsl map
-                   (:: (Functor<Eff> dsl) map f)
-                   fa))
-
-      [(#Effect ff) _]
-      (#Effect (:: dsl map
-                   (lambda [f] (apply f ea))
-                   ff))
+      [(#M;Pure f) (#M;Pure a)]
+      (#M;Pure (f a))
+
+      [(#M;Pure f) (#M;Effect fa)]
+      (#M;Effect (:: dsl map
+                     (:: (Functor<Free> dsl) map f)
+                     fa))
+
+      [(#M;Effect ff) _]
+      (#M;Effect (:: dsl map
+                     (lambda [f] (apply f ea))
+                     ff))
       )))
 
-(struct: #export (Monad<Eff> dsl)
-  (All [F] (-> (F;Functor F) (Monad (Eff F))))
-  (def: applicative (Applicative<Eff> dsl))
+(struct: #export (Monad<Free> dsl)
+  (All [F] (-> (F;Functor F) (Monad (Free F))))
+  (def: applicative (Applicative<Free> dsl))
 
   (def: (join efefa)
     (case efefa
-      (#Pure efa)
+      (#M;Pure efa)
       (case efa
-        (#Pure a)
-        (#Pure a)
+        (#M;Pure a)
+        (#M;Pure a)
 
-        (#Effect fa)
-        (#Effect fa))
+        (#M;Effect fa)
+        (#M;Effect fa))
       
-      (#Effect fefa)
-      (#Effect (:: dsl map
-                   (:: (Monad<Eff> dsl) join)
-                   fefa))
+      (#M;Effect fefa)
+      (#M;Effect (:: dsl map
+                     (:: (Monad<Free> dsl) join)
+                     fefa))
       )))
 
 (type: #hidden (|@ L R)
@@ -272,12 +267,12 @@
 
 (def: #export (with-handler handler body)
   {#;doc "Handles an effectful computation with the given handler to produce a monadic value."}
-  (All [E M a] (-> (Handler E M) (Eff E a) (M a)))
+  (All [E M a] (-> (Handler E M) (Free E a) (M a)))
   (case body
-    (#Pure value)
+    (#M;Pure value)
     (:: handler wrap value)
 
-    (#Effect effect)
+    (#M;Effect effect)
     (do (get@ #monad handler)
       [result (:: handler handle effect)]
       (with-handler handler result))
@@ -314,10 +309,10 @@
   (do @
     [g!output (compiler;gensym "")]
     (wrap (list (` (let [(~ g!functor) (~ functor)]
-                     (do (Monad<Eff> (~ g!functor))
+                     (do (Monad<Free> (~ g!functor))
                        [(~@ bindings)
                         (~ g!output) (~ body)]
-                       (#;;Pure (~ g!output)))))))))
+                       (#M;Pure (~ g!output)))))))))
 
 (def: (flatten-effect-stack stack)
   (-> Type (List Type))
@@ -334,7 +329,7 @@
                right))
     (#;Cons left (flatten-effect-stack right))
 
-    (^ (#;AppT (#;AppT (#;NamedT (ident-for ;;Eff) _)
+    (^ (#;AppT (#;AppT (#;NamedT (ident-for M;Free) _)
                        effect)
                param))
     (list effect)
@@ -380,7 +375,7 @@
       (case [input output]
         (^=> [(#;AppT eff0 _) (#;AppT stackT0 recT0)]
              [(type;apply-type stackT0 recT0) (#;Some unfoldT0)]
-             [stackT0 (^ (#;AppT (#;NamedT (ident-for ;;Eff) _)
+             [stackT0 (^ (#;AppT (#;NamedT (ident-for M;Free) _)
                                  stackT1))]
              [(type;apply-type stackT1 recT0) (#;Some unfoldT1)]
              [(flatten-effect-stack unfoldT1) stack]
@@ -388,7 +383,7 @@
                   (list;find (lambda [[idx effect]]
                                (same-effect? effect eff0))))
               (#;Some [idx _])])
-        (wrap (list (` (#;;Effect (:: (~ g!functor) (~' map) (~' wrap)
+        (wrap (list (` (#M;Effect (:: (~ g!functor) (~' map) (~' wrap)
                                       (~ (nest-effect idx (list;size stack) (ast;symbol var))))))))
 
         _
diff --git a/stdlib/source/lux/control/functor.lux b/stdlib/source/lux/control/functor.lux
index 005050efd..3532e0633 100644
--- a/stdlib/source/lux/control/functor.lux
+++ b/stdlib/source/lux/control/functor.lux
@@ -5,6 +5,9 @@
        (-> (-> a b) (f a) (f b)))
      map))
 
+(type: #export (Fix f)
+  (f (Fix f)))
+
 (struct: #export (compF Functor<F> Functor<G>)
   {#;doc "Functor composition."}
   (All [F G] (-> (Functor F) (Functor G) (Functor (All [a] (F (G a))))))
diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux
index a6d0d5988..0563857f4 100644
--- a/stdlib/source/lux/control/monad.lux
+++ b/stdlib/source/lux/control/monad.lux
@@ -48,6 +48,12 @@
        (-> (m (m a)) (m a)))
      join))
 
+## [Types]
+(type: #export (Free F a)
+  {#;doc "The Free Monad."}
+  (#Pure a)
+  (#Effect (F (Free F a))))
+
 ## [Syntax]
 (def: _cursor Cursor ["" +0 +0])
 
diff --git a/stdlib/source/lux/data/product.lux b/stdlib/source/lux/data/product.lux
index 8e8be3cd3..2a25e53a0 100644
--- a/stdlib/source/lux/data/product.lux
+++ b/stdlib/source/lux/data/product.lux
@@ -29,3 +29,9 @@
   (All [a b] (-> [a b] [b a]))
   (let [[x y] xy]
     [y x]))
+
+(def: #export (both f g)
+  (All [a b c] (-> (-> a b) (-> a c)
+                   (-> a [b c])))
+  (lambda [input]
+    [(f input) (g input)]))
diff --git a/stdlib/source/lux/data/sum.lux b/stdlib/source/lux/data/sum.lux
index 716b3908a..ade411e6b 100644
--- a/stdlib/source/lux/data/sum.lux
+++ b/stdlib/source/lux/data/sum.lux
@@ -10,11 +10,13 @@
   [left  a +0]
   [right b +1])
 
-(def: #export (either f g s)
-  (All [a b c] (-> (-> a c) (-> b c) (| a b) c))
-  (case s
-    (+0 x)  (f x)
-    (+1 x) (g x)))
+(def: #export (either f g)
+  (All [a b c] (-> (-> a c) (-> b c)
+                   (-> (| a b) c)))
+  (lambda [input]
+    (case input
+      (+0 l) (f l)
+      (+1 r) (g r))))
 
 (do-template [<name> <side> <tag>]
   [(def: #export (<name> es)