Local binding names for (co|indexed-)?monads are now explicitly set.

3 files changed, 111 insertions, 49 deletions

diff --git a/stdlib/source/lux/abstract/comonad.lux b/stdlib/source/lux/abstract/comonad.lux
index d7186bed4..988d7c255 100644
--- a/stdlib/source/lux/abstract/comonad.lux
+++ b/stdlib/source/lux/abstract/comonad.lux
@@ -4,7 +4,7 @@
     [number
      ["n" nat]]
     [collection
-     ["." list ("#;." fold)]]]]
+     ["." list ("#@." fold)]]]]
   [//
    ["." functor (#+ Functor)]])
 
@@ -32,13 +32,25 @@
                 (be comonad
                   [inputs (iterate inc +2)]
                   (square (head inputs)))))}
-  (case tokens
-    (#.Cons comonad (#.Cons [_ (#.Tuple bindings)] (#.Cons body #.Nil)))
+  (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 [g!_ (: Code [_cursor (#.Identifier ["" " _ "])])
-            g!map (: Code [_cursor (#.Identifier ["" " map "])])
-            g!split (: Code [_cursor (#.Identifier ["" " split "])])
-            body' (list;fold (: (-> [Code Code] Code Code)
+      (let [[module short] (name-of ..be)
+            gensym (: (-> Text Code)
+                      (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [_cursor]))
+            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
@@ -50,15 +62,24 @@
                                       ))))
                              body
                              (list.reverse (list.as-pairs bindings)))]
-        (#.Right [state (#.Cons (` ({(~' @)
-                                     ({{#&functor {#functor.map (~ g!map)}
-                                        #unwrap (~' unwrap)
-                                        #split (~ g!split)}
-                                       (~ body')}
-                                      (~' @))}
-                                    (~ comonad)))
-                                #.Nil)]))
+        (#.Right [state (list (case ?name
+                                (#.Some name)
+                                (let [name [_cursor (#.Identifier ["" name])]]
+                                  (` ({(~ name)
+                                       ({{#..&functor {#functor.map (~ g!map)}
+                                          #..unwrap (~' unwrap)
+                                          #..split (~ g!split)}
+                                         (~ body')}
+                                        (~ name))}
+                                      (~ comonad))))
+
+                                #.None
+                                (` ({{#..&functor {#functor.map (~ g!map)}
+                                      #..unwrap (~' unwrap)
+                                      #..split (~ 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/lux/abstract/monad.lux b/stdlib/source/lux/abstract/monad.lux
index 491f9b6a2..12f75e9ac 100644
--- a/stdlib/source/lux/abstract/monad.lux
+++ b/stdlib/source/lux/abstract/monad.lux
@@ -58,12 +58,24 @@
                 [y (f1 x)
                  z (f2 z)]
                 (wrap (f3 z))))}
-  (case tokens
-    (#.Cons monad (#.Cons [_ (#.Tuple bindings)] (#.Cons body #.Nil)))
+  (case (: (Maybe [(Maybe Text) Code (List Code) Code])
+           (case tokens
+             (^ (list [_ (#.Record (list [[_ (#.Identifier ["" name])] monad]))] [_ (#.Tuple bindings)] body))
+             (#.Some [(#.Some name) monad bindings body])
+             
+             (^ (list monad [_ (#.Tuple bindings)] body))
+             (#.Some [#.None monad bindings body])
+
+             _
+             #.None))
+    (#.Some [?name monad bindings body])
     (if (|> bindings list@size .int ("lux i64 %" +2) ("lux i64 =" +0))
-      (let [g!_ (: Code [_cursor (#.Identifier ["" " _ "])])
-            g!map (: Code [_cursor (#.Identifier ["" " map "])])
-            g!join (: Code [_cursor (#.Identifier ["" " join "])])
+      (let [[module short] (name-of ..do)
+            gensym (: (-> Text Code)
+                      (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [_cursor]))
+            g!_ (gensym "_")
+            g!map (gensym "map")
+            g!join (gensym "join")
             body' (list@fold (: (-> [Code Code] Code Code)
                                 (function (_ binding body')
                                   (let [[var value] binding]
@@ -76,15 +88,26 @@
                                       ))))
                              body
                              (reverse (as-pairs bindings)))]
-        (#.Right [state (#.Cons (` ({(~' @)
-                                     ({[(~ g!map) (~' wrap) (~ g!join)]
-                                       (~ body')}
-                                      (~' @))}
-                                    (~ monad)))
-                                #.Nil)]))
+        (#.Right [state (list (case ?name
+                                (#.Some name)
+                                (let [name [_cursor (#.Identifier ["" name])]]
+                                  (` ({(~ name)
+                                       ({{#..&functor {#functor.map (~ g!map)}
+                                          #..wrap (~' wrap)
+                                          #..join (~ g!join)}
+                                         (~ body')}
+                                        (~ name))}
+                                      (~ monad))))
+                                
+                                #.None
+                                (` ({{#..&functor {#functor.map (~ g!map)}
+                                      #..wrap (~' wrap)
+                                      #..join (~ g!join)}
+                                     (~ body')}
+                                    (~ monad)))))]))
       (#.Left "'do' bindings must have an even number of parts."))
 
-    _
+    #.None
     (#.Left "Wrong syntax for 'do'")))
 
 (def: #export (bind monad f)
diff --git a/stdlib/source/lux/abstract/monad/indexed.lux b/stdlib/source/lux/abstract/monad/indexed.lux
index 27bae03f0..caa233884 100644
--- a/stdlib/source/lux/abstract/monad/indexed.lux
+++ b/stdlib/source/lux/abstract/monad/indexed.lux
@@ -6,9 +6,10 @@
      ["s" code (#+ Parser)]]]
    [data
     [collection
-     ["." list ("#;." functor fold)]]]
+     ["." list ("#@." functor fold)]]]
    ["." macro
-    [syntax (#+ syntax:)]]])
+    [syntax (#+ syntax:)]
+    ["." code]]])
 
 (signature: #export (IxMonad m)
   (: (All [p a]
@@ -41,25 +42,42 @@
   (All [a] (-> [a a] (List a)))
   (list binding value))
 
-(syntax: #export (do monad
+(def: named-monad
+  (Parser [(Maybe Text) Code])
+  (p.either (s.record (p.and (:: p.monad map (|>> #.Some)
+                                 s.local-identifier)
+                             s.any))
+            (:: p.monad map (|>> [#.None])
+                s.any)))
+
+(syntax: #export (do {[?name monad] ..named-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)))))))))
+    (let [body (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))]
+      (wrap (list (case ?name
+                    (#.Some name)
+                    (let [name (code.local-identifier name)]
+                      (` (let [(~ name) (~ monad)
+                               {#..wrap (~' wrap)
+                                #..bind (~ g!bind)} (~ name)]
+                           (~ body))))
+
+                    #.None
+                    (` (let [{#..wrap (~' wrap)
+                              #..bind (~ g!bind)} (~ monad)]
+                         (~ body)))))))))