1 files changed, 36 insertions, 44 deletions
diff --git a/input/lux/control/monad.lux b/input/lux/control/monad.lux
index 2ca541574..b5552f987 100644
--- a/input/lux/control/monad.lux
+++ b/input/lux/control/monad.lux
@@ -7,13 +7,38 @@
 ##   You must not remove this notice, or any other, from this software.
 
 (;import lux
-         (lux/data list
-                   state)
          (.. (functor #as F)
              (monoid #as M))
          lux/meta/macro)
 
-## Signatures
+## [Utils]
+(def (foldL f init xs)
+  (All [a b]
+    (-> (-> a b a) a (List b) a)) 
+  (case xs
+    #;Nil
+    init
+
+    (#;Cons [x xs'])
+    (foldL f (f init x) xs')))
+
+(def (reverse xs)
+  (All [a]
+    (-> (List a) (List a)))
+  (foldL (lambda [tail head] (#;Cons [head tail]))
+         #;Nil
+         xs))
+
+(def (as-pairs xs)
+  (All [a] (-> (List a) (List (, a a))))
+  (case xs
+    (#;Cons [x1 (#;Cons [x2 xs'])])
+    (#;Cons [[x1 x2] (as-pairs xs')])
+
+    _
+    #;Nil))
+
+## [Signatures]
 (defsig #export (Monad m)
   (: (F;Functor m)
      _functor)
@@ -24,10 +49,11 @@
        (-> (m (m a)) (m a)))
      join))
 
-## Syntax
+## [Syntax]
 (defmacro #export (do tokens state)
   (case tokens
-    (\ (list monad (#;Meta [_ (#;TupleS bindings)]) body))
+    ## (\ (list monad (#;Meta [_ (#;TupleS bindings)]) body))
+    (#;Cons [monad (#;Cons [(#;Meta [_ (#;TupleS bindings)]) (#;Cons [body #;Nil])])])
     (let [body' (foldL (: (-> Syntax (, Syntax Syntax) Syntax)
                           (lambda [body' binding]
                             (let [[var value] binding]
@@ -43,49 +69,15 @@
                                 ))))
                        body
                        (reverse (as-pairs bindings)))]
-      (#;Right [state (list (` (;case (~ monad)
-                                      {#;;_functor ;;_functor #;;wrap ;;wrap #;;join ;;join}
-                                      (~ body'))))]))
+      (#;Right [state (#;Cons [(` (;case (~ monad)
+                                         {#;;_functor ;;_functor #;;wrap ;;wrap #;;join ;;join}
+                                         (~ body')))
+                               #;Nil])]))
 
     _
     (#;Left "Wrong syntax for do")))
 
-## Structures
-(defstruct #export Maybe:Monad (Monad Maybe)
-  (def _functor F;Maybe:Functor)
-
-  (def (wrap x)
-    (#;Some x))
-
-  (def (join mma)
-    (case mma
-      #;None      #;None
-      (#;Some xs) xs)))
-
-(defstruct #export List:Monad (Monad List)
-  (def _functor F;List:Functor)
-
-  (def (wrap x)
-    (#;Cons [x #;Nil]))
-
-  (def (join xss)
-    (using M;List:Monoid
-      (foldL M;++ M;unit xss))))
-
-(defstruct #export State:Monad (All [s]
-                                 (Monad (State s)))
-  (def _functor F;State:Functor)
-
-  (def (wrap x)
-    (lambda [state]
-      [state x]))
-
-  (def (join mma)
-    (lambda [state]
-      (let [[state' ma] (mma state)]
-        (ma state')))))
-
-## Functions
+## [Functions]
 (def #export (bind m f ma)
   (All [m a b]
     (-> (Monad m) (-> a (m b)) (m a) (m b)))