- Made the "open:" and "^open" macros not generate record-patterns, and thus not need (or impose a need on) tags.

- The "do" macro for monads also doesn't need tags anymore.

1 files changed, 58 insertions, 42 deletions

diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 1a3d71480..6fe8100ba 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -447,6 +447,11 @@
   ([_ name] (_ann (#Tag name))))
  [dummy-cursor (#Record #Nil)])
 
+("lux def" local-tag$
+ ("lux check" (#Function Text Code)
+  ([_ name] (_ann (#Tag ["" name]))))
+ [dummy-cursor (#Record #Nil)])
+
 ("lux def" form$
  ("lux check" (#Function (#Apply Code List) Code)
   ([_ tokens] (_ann (#Form tokens))))
@@ -1008,7 +1013,7 @@
 
           (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)))
           (return (#Cons (form$ (#Cons (identifier$ ["lux" "def:''"])
-                                       (#Cons (tag$ ["" "export"])
+                                       (#Cons (local-tag$ "export")
                                               (#Cons (form$ (#Cons name args))
                                                      (#Cons (with-macro-meta (tag$ ["lux" "Nil"]))
                                                             (#Cons (identifier$ ["lux" "Macro"])
@@ -1019,7 +1024,7 @@
 
           (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta-data (#Cons body #Nil))))
           (return (#Cons (form$ (#Cons (identifier$ ["lux" "def:''"])
-                                       (#Cons (tag$ ["" "export"])
+                                       (#Cons (local-tag$ "export")
                                               (#Cons (form$ (#Cons name args))
                                                      (#Cons (with-macro-meta meta-data)
                                                             (#Cons (identifier$ ["lux" "Macro"])
@@ -1424,10 +1429,10 @@
                     (fail "function' requires a non-empty arguments tuple.")
                     
                     (#Cons [harg targs])
-                    (return (list (form$ (list (tuple$ (list (identifier$ ["" name])
+                    (return (list (form$ (list (tuple$ (list (local-identifier$ name)
                                                              harg))
                                                (list@fold (function'' [arg body']
-                                                                      (form$ (list (tuple$ (list (identifier$ ["" ""])
+                                                                      (form$ (list (tuple$ (list (local-identifier$ "")
                                                                                                  arg))
                                                                                    body')))
                                                           body
@@ -1674,8 +1679,8 @@
 
 (macro:' (do tokens)
          ({(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil)))
-           (let' [g!wrap (identifier$ ["" "wrap"])
-                  g!bind (identifier$ ["" " bind "])
+           (let' [g!wrap (local-identifier$ "wrap")
+                  g!bind (local-identifier$ " bind ")
                   body' (list@fold ("lux check" (-> (& Code Code) Code Code)
                                     (function' [binding body']
                                                (let' [[var value] binding]
@@ -1684,7 +1689,7 @@
 
                                                        _
                                                        (form$ (list g!bind
-                                                                    (form$ (list (tuple$ (list (identifier$ ["" ""]) var)) body'))
+                                                                    (form$ (list (tuple$ (list (local-identifier$ "") var)) body'))
                                                                     value))}
                                                       var))))
                                    body
@@ -2948,7 +2953,7 @@
                     #seed   (n/+ 1 seed) #expected expected
                     #cursor cursor #extensions extensions
                     #scope-type-vars scope-type-vars}
-                   (identifier$ ["" ($_ text@compose "__gensym__" prefix (nat@encode seed))]))}
+                   (local-identifier$ ($_ text@compose "__gensym__" prefix (nat@encode seed))))}
           state))
 
 (macro:' #export (Rec tokens)
@@ -2976,7 +2981,7 @@
                            "  " "(log! ''#3'')" ..new-line
                            "''YOLO'')"))])
          ({(#Cons value actions)
-           (let' [dummy (identifier$ ["" ""])]
+           (let' [dummy (local-identifier$ "")]
                  (return (list (list@fold ("lux check" (-> Code Code Code)
                                            (function' [pre post] (` ({(~ dummy) (~ post)}
                                                                      (~ pre)))))
@@ -3250,8 +3255,8 @@
                     _
                     #None))
            (#Some g!name head tail body)
-           (let [g!blank (identifier$ ["" ""])
-                 g!name (identifier$ ["" g!name])
+           (let [g!blank (local-identifier$ "")
+                 g!name (local-identifier$ g!name)
                  body+ (list@fold (: (-> Code Code Code)
                                      (function' [arg body']
                                                 (if (identifier? arg)
@@ -3535,7 +3540,7 @@
                def-name (identifier$ name)
                sig-type (record$ (list@map (: (-> [Text Code] [Code Code])
                                               (function (_ [m-name m-type])
-                                                [(tag$ ["" m-name]) m-type]))
+                                                [(local-tag$ m-name) m-type]))
                                            members))
                sig-meta (meta-code-merge (` {#.sig? #1})
                                          meta)
@@ -3998,7 +4003,7 @@
       (do meta-monad
         [type+tags?? (unfold-type-def type-codes)
          module-name current-module-name]
-        (let [type-name (identifier$ ["" name])
+        (let [type-name (local-identifier$ name)
               [type tags??] type+tags??
               type-meta (: Code
                            (case tags??
@@ -4011,8 +4016,8 @@
               type' (: (Maybe Code)
                        (if rec?
                          (if (empty? args)
-                           (let [g!param (identifier$ ["" ""])
-                                 prime-name (identifier$ ["" name])
+                           (let [g!param (local-identifier$ "")
+                                 prime-name (local-identifier$ name)
                                  type+ (replace-syntax (list [name (` ((~ prime-name) .Nothing))]) type)]
                              (#Some (` ((All (~ prime-name) [(~ g!param)] (~ type+))
                                         .Nothing))))
@@ -4572,25 +4577,25 @@
         (do meta-monad
           [full-body ((: (-> Name [(List Name) (List Type)] Code (Meta Code))
                          (function (recur source [tags members] target)
-                           (let [pattern (record$ (list@map (function (_ [t-module t-name])
-                                                              [(tag$ [t-module t-name])
-                                                               (identifier$ ["" (de-alias "" t-name alias)])])
-                                                            tags))]
+                           (let [locals (list@map (function (_ [t-module t-name])
+                                                    ["" (de-alias "" t-name alias)])
+                                                  tags)
+                                 pattern (tuple$ (list@map identifier$ locals))]
                              (do meta-monad
                                [enhanced-target (monad/fold meta-monad
-                                                            (function (_ [[_ m-name] m-type] enhanced-target)
+                                                            (function (_ [m-local m-type] enhanced-target)
                                                               (do meta-monad
                                                                 [m-structure (resolve-type-tags m-type)]
                                                                 (case m-structure
                                                                   (#Some m-tags&members)
-                                                                  (recur ["" (de-alias "" m-name alias)]
+                                                                  (recur m-local
                                                                          m-tags&members
                                                                          enhanced-target)
 
                                                                   #None
                                                                   (wrap enhanced-target))))
                                                             target
-                                                            (zip2 tags members))]
+                                                            (zip2 locals members))]
                                (wrap (` ({(~ pattern) (~ enhanced-target)} (~ (identifier$ source)))))))))
                       name tags&members body)]
           (wrap (list full-body)))))
@@ -4682,22 +4687,32 @@
     _
     (fail "Wrong syntax for get@")))
 
-(def: (open-field alias [module name] source type)
-  (-> Text Name Code Type (Meta (List Code)))
+(def: (open-field alias tags my-tag-index [module short] source type)
+  (-> Text (List Name) Nat Name Code Type (Meta (List Code)))
   (do meta-monad
     [output (resolve-type-tags type)
-     #let [source+ (` (get@ (~ (tag$ [module name])) (~ source)))]]
+     g!_ (gensym "g!_")
+     #let [g!output (local-identifier$ short)
+           pattern (|> tags
+                       enumerate
+                       (list@map (function (_ [tag-idx tag])
+                                   (if (n/= my-tag-index tag-idx)
+                                     g!output
+                                     g!_)))
+                       tuple$)
+           source+ (` ({(~ pattern) (~ g!output)} (~ source)))]]
     (case output
-      (#Some [tags members])
+      (#Some [tags' members'])
       (do meta-monad
         [decls' (monad@map meta-monad
-                           (: (-> [Name Type] (Meta (List Code)))
-                              (function (_ [sname stype]) (open-field alias sname source+ stype)))
-                           (zip2 tags members))]
+                           (: (-> [Nat Name Type] (Meta (List Code)))
+                              (function (_ [sub-tag-index sname stype])
+                                (open-field alias tags' sub-tag-index sname source+ stype)))
+                           (enumerate (zip2 tags' members')))]
         (return (list@join decls')))
 
       _
-      (return (list (` ("lux def" (~ (identifier$ ["" (de-alias "" name alias)]))
+      (return (list (` ("lux def" (~ (local-identifier$ (de-alias "" short alias)))
                         (~ source+)
                         [(~ cursor-code) (#.Record #Nil)])))))))
 
@@ -4724,10 +4739,10 @@
         (case output
           (#Some [tags members])
           (do meta-monad
-            [decls' (monad@map meta-monad (: (-> [Name Type] (Meta (List Code)))
-                                             (function (_ [sname stype])
-                                               (open-field alias sname source stype)))
-                               (zip2 tags members))]
+            [decls' (monad@map meta-monad (: (-> [Nat Name Type] (Meta (List Code)))
+                                             (function (_ [tag-index sname stype])
+                                               (open-field alias tags tag-index sname source stype)))
+                               (enumerate (zip2 tags members)))]
             (return (list@join decls')))
 
           _
@@ -4837,7 +4852,7 @@
              (wrap (list)))
      #let [defs (list@map (: (-> Text Code)
                              (function (_ def)
-                               (` ("lux def alias" (~ (identifier$ ["" def])) (~ (identifier$ [module-name def]))))))
+                               (` ("lux def alias" (~ (local-identifier$ def)) (~ (identifier$ [module-name def]))))))
                           defs')
            openings (join-map (: (-> Openings (List Code))
                                  (function (_ [alias structs])
@@ -5400,7 +5415,7 @@
                   (#.Some [name bindings body])
                   
                   (^ (list [_ (#Tuple bindings)] body))
-                  (#.Some [(identifier$ ["" "recur"]) bindings body])
+                  (#.Some [(local-identifier$ "recur") bindings body])
 
                   _
                   #.None)]
@@ -5460,7 +5475,8 @@
        g!_ (gensym "_")
        #let [[idx tags exported? type] output
              slot-pairings (list@map (: (-> Name [Text Code])
-                                        (function (_ [module name]) [name (identifier$ ["" name])]))
+                                        (function (_ [module name])
+                                          [name (local-identifier$ name)]))
                                      (list& hslot tslots))
              pattern (record$ (list@map (: (-> Name [Code Code])
                                            (function (_ [module name])
@@ -5819,7 +5835,7 @@
                            (to-list set))))}
   (case tokens
     (^ (list& [_meta (#Form (list [_ (#Identifier ["" name])] pattern))] body branches))
-    (let [g!whole (identifier$ ["" name])]
+    (let [g!whole (local-identifier$ name)]
       (return (list& g!whole
                      (` (case (~ g!whole) (~ pattern) (~ body)))
                      branches)))
@@ -5834,7 +5850,7 @@
                 (foo value)))}
   (case tokens
     (^ (list& [_meta (#Form (list [_ (#Identifier ["" name])] [_ (#Tuple steps)]))] body branches))
-    (let [g!name (identifier$ ["" name])]
+    (let [g!name (local-identifier$ name)]
       (return (list& g!name
                      (` (let [(~ g!name) (|> (~ g!name) (~+ steps))]
                           (~ body)))
@@ -5974,14 +5990,14 @@
      g!compiler (gensym "compiler")
      g!_ (gensym "_")
      #let [rep-env (list@map (function (_ arg)
-                               [arg (` ((~' ~) (~ (identifier$ ["" arg]))))])
+                               [arg (` ((~' ~) (~ (local-identifier$ arg))))])
                              args)]
      this-module current-module-name]
     (wrap (list (` (macro: (~+ (export export?))
-                     ((~ (identifier$ ["" name])) (~ g!tokens) (~ g!compiler))
+                     ((~ (local-identifier$ name)) (~ g!tokens) (~ g!compiler))
                      (~ anns)
                      (case (~ g!tokens)
-                       (^ (list (~+ (list@map (|>> [""] identifier$) args))))
+                       (^ (list (~+ (list@map local-identifier$ args))))
                        (#.Right [(~ g!compiler)
                                  (list (~+ (list@map (function (_ template)
                                                        (` (`' (~ (replace-syntax rep-env template)))))