Unified tuple and record syntax.

5 files changed, 122 insertions, 101 deletions

diff --git a/lux-bootstrapper/src/lux/analyser.clj b/lux-bootstrapper/src/lux/analyser.clj
index ccd0144f6..27323be2b 100644
--- a/lux-bootstrapper/src/lux/analyser.clj
+++ b/lux-bootstrapper/src/lux/analyser.clj
@@ -88,10 +88,6 @@
 
       (&/$Tuple ?elems)
       (&/with-analysis-meta location exo-type
-        (&&lux/analyse-tuple analyse (&/$Right exo-type) ?elems))
-
-      (&/$Record ?elems)
-      (&/with-analysis-meta location exo-type
         (&&lux/analyse-record analyse exo-type ?elems))
 
       (&/$Tag ?ident)
diff --git a/lux-bootstrapper/src/lux/analyser/case.clj b/lux-bootstrapper/src/lux/analyser/case.clj
index 062467ca3..49d781c3b 100644
--- a/lux-bootstrapper/src/lux/analyser/case.clj
+++ b/lux-bootstrapper/src/lux/analyser/case.clj
@@ -298,51 +298,51 @@
             =kont kont]
         (return (&/T [($TextTestAC ?value) =kont])))
 
-      (&/$Tuple ?members)
-      (|case ?members
-        (&/$End)
-        (|do [_ (&type/check value-type &type/Any)
-              =kont kont]
-          (return (&/T [($TupleTestAC (&/|list)) =kont])))
+      (&/$Tuple (&/$End))
+      (|do [_ (&type/check value-type &type/Any)
+            =kont kont]
+        (return (&/T [($TupleTestAC (&/|list)) =kont])))
 
-        (&/$Item ?member (&/$End))
-        (analyse-pattern var?? value-type ?member kont)
+      (&/$Tuple (&/$Item ?member (&/$End)))
+      (analyse-pattern var?? value-type ?member kont)
 
-        _
-        (|do [must-infer? (&type/unknown? value-type)
-              value-type* (if must-infer?
-                            (|do [member-types (&/map% (fn [_] &type/create-var+) (&/|range (&/|length ?members)))]
-                              (return (&type/fold-prod member-types)))
-                            (adjust-type value-type))]
-          (|case value-type*
-            (&/$Product _)
-            (|let [num-elems (&/|length ?members)
-                   [_shorter _tuple-types] (&type/tuple-types-for (&/|length ?members) value-type*)]
-              (if (= num-elems _shorter)
-                (|do [[=tests =kont] (&/fold (fn [kont* vm]
-                                               (|let [[v m] vm]
-                                                 (|do [[=test [=tests =kont]] (analyse-pattern &/$None v m kont*)]
-                                                   (return (&/T [(&/$Item =test =tests) =kont])))))
-                                             (|do [=kont kont]
-                                               (return (&/T [&/$End =kont])))
-                                             (&/|reverse (&/zip2 _tuple-types ?members)))]
-                  (return (&/T [($TupleTestAC =tests) =kont])))
-                (&/fail-with-loc (str "[Pattern-matching Error] Pattern-matching mismatch. Requires tuple[" (&/|length (&type/flatten-prod value-type*)) "]. Given tuple [" (&/|length ?members) "].\n"
-                                      "           At: " (&/show-ast pattern) "\n"
-                                      "Expected type: " (&type/show-type value-type*) "\n"
-                                      "  Actual type: " (&type/show-type value-type)))))
-
-            _
-            (&/fail-with-loc (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type))))))
-
-      (&/$Record pairs)
-      (|do [[rec-members rec-type] (&&record/order-record pairs)
-            must-infer? (&type/unknown? value-type)
-            rec-type* (if must-infer?
-                        (&type/instantiate-inference rec-type)
-                        (return value-type))
-            _ (&type/check value-type rec-type*)]
-        (analyse-pattern &/$None rec-type* (&/T [meta (&/$Tuple rec-members)]) kont))
+      (&/$Tuple ?members)
+      (|do [rec-members&rec-type (&&record/order-record ?members)]
+        (|case rec-members&rec-type
+          (&/$Some [rec-members rec-type])
+          (|do [must-infer? (&type/unknown? value-type)
+                rec-type* (if must-infer?
+                            (&type/instantiate-inference rec-type)
+                            (return value-type))
+                _ (&type/check value-type rec-type*)]
+            (analyse-pattern &/$None rec-type* (&/T [meta (&/$Tuple rec-members)]) kont))
+
+          (&/$None)
+          (|do [must-infer? (&type/unknown? value-type)
+                value-type* (if must-infer?
+                              (|do [member-types (&/map% (fn [_] &type/create-var+) (&/|range (&/|length ?members)))]
+                                (return (&type/fold-prod member-types)))
+                              (adjust-type value-type))]
+            (|case value-type*
+              (&/$Product _)
+              (|let [num-elems (&/|length ?members)
+                     [_shorter _tuple-types] (&type/tuple-types-for (&/|length ?members) value-type*)]
+                (if (= num-elems _shorter)
+                  (|do [[=tests =kont] (&/fold (fn [kont* vm]
+                                                 (|let [[v m] vm]
+                                                   (|do [[=test [=tests =kont]] (analyse-pattern &/$None v m kont*)]
+                                                     (return (&/T [(&/$Item =test =tests) =kont])))))
+                                               (|do [=kont kont]
+                                                 (return (&/T [&/$End =kont])))
+                                               (&/|reverse (&/zip2 _tuple-types ?members)))]
+                    (return (&/T [($TupleTestAC =tests) =kont])))
+                  (&/fail-with-loc (str "[Pattern-matching Error] Pattern-matching mismatch. Requires tuple[" (&/|length (&type/flatten-prod value-type*)) "]. Given tuple [" (&/|length ?members) "].\n"
+                                        "           At: " (&/show-ast pattern) "\n"
+                                        "Expected type: " (&type/show-type value-type*) "\n"
+                                        "  Actual type: " (&type/show-type value-type)))))
+
+              _
+              (&/fail-with-loc (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type)))))))
 
       (&/$Tag ?ident)
       (|do [[=module =name] (&&/resolved-ident ?ident)
diff --git a/lux-bootstrapper/src/lux/analyser/lux.clj b/lux-bootstrapper/src/lux/analyser/lux.clj
index 8b93faea8..7b8019211 100644
--- a/lux-bootstrapper/src/lux/analyser/lux.clj
+++ b/lux-bootstrapper/src/lux/analyser/lux.clj
@@ -245,20 +245,24 @@
       )))
 
 (defn analyse-record [analyse exo-type ?elems]
-  (|do [[rec-members rec-type] (&&record/order-record ?elems)]
-    (|case exo-type
-      (&/$Var id)
-      (|do [verdict (&type/bound? id)]
-        (if verdict
-          (analyse-tuple analyse (&/$Right exo-type) rec-members)
-          (|do [[[tuple-type tuple-location] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Left rec-type) rec-members))
-                _ (&type/check exo-type tuple-type)]
-            (return (&/|list (&&/|meta exo-type tuple-location
-                                       tuple-analysis))))))
+  (|do [rec-members&rec-type (&&record/order-record ?elems)]
+    (|case rec-members&rec-type
+      (&/$Some [rec-members rec-type])
+      (|case exo-type
+        (&/$Var id)
+        (|do [verdict (&type/bound? id)]
+          (if verdict
+            (analyse-tuple analyse (&/$Right exo-type) rec-members)
+            (|do [[[tuple-type tuple-location] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Left rec-type) rec-members))
+                  _ (&type/check exo-type tuple-type)]
+              (return (&/|list (&&/|meta exo-type tuple-location
+                                         tuple-analysis))))))
 
-      _
-      (analyse-tuple analyse (&/$Right exo-type) rec-members)
-      )))
+        _
+        (analyse-tuple analyse (&/$Right exo-type) rec-members))
+
+      (&/$None)
+      (analyse-tuple analyse (&/$Right exo-type) ?elems))))
 
 (defn ^:private analyse-global [analyse exo-type module name]
   (|do [[[r-module r-name] [exported? endo-type ?annotations ?value]] (&&module/find-def module name)
diff --git a/lux-bootstrapper/src/lux/analyser/record.clj b/lux-bootstrapper/src/lux/analyser/record.clj
index 7af3c17ac..09fd8b988 100644
--- a/lux-bootstrapper/src/lux/analyser/record.clj
+++ b/lux-bootstrapper/src/lux/analyser/record.clj
@@ -8,37 +8,56 @@
 
 ;; [Exports]
 (defn order-record
-  "(-> (List (, Syntax Syntax)) (Lux (List Syntax)))"
+  "(-> (List Syntax) (Lux (Maybe (List Syntax))))"
   [pairs]
-  (|do [[module slot-group slot-type] (|case pairs
-                                        (&/$End)
-                                        (|do [module &/get-module-name]
-                                          (return (&/T [module &/$End &type/Any])))
-                                        
-                                        (&/$Item [[_ (&/$Tag slot1)] _] _)
-                                        (|do [[module name] (&&/resolved-ident slot1)
-                                              [_exported? type slots _index] (&&module/find-slot module (str "#" name))]
-                                          (return (&/T [module slots type])))
+  (if (even? (&/|length pairs))
+    (let [pairs (&/|as-pairs pairs)]
+      (|do [module&slot-group&slot-type (|case pairs
+                                          (&/$End)
+                                          (|do [module &/get-module-name]
+                                            (return (&/$Some (&/T [module &/$End &type/Any]))))
+                                          
+                                          (&/$Item [[_ (&/$Tag slot0)] _] _)
+                                          (|do [[module name] (&&/resolved-ident slot0)
+                                                _exported?&type&slots&_index (fn [lux]
+                                                                               (|case ((&&module/find-slot module (str "#" name)) lux)
+                                                                                 (&/$Left error)
+                                                                                 (&/$Right (&/T [lux &/$None]))
+                                                                                 
+                                                                                 (&/$Right [lux* output])
+                                                                                 (&/$Right (&/T [lux* (&/$Some output)]))))]
+                                            (|case _exported?&type&slots&_index
+                                              (&/$Some [_exported? type slots _index])
+                                              (return (&/$Some (&/T [module slots type])))
 
-                                        _
-                                        (&/fail-with-loc "[Analyser Error] Wrong syntax for records. Odd elements must be slots."))
-        =pairs (&/map% (fn [kv]
-                         (|case kv
-                           [[_ (&/$Tag k)] v]
-                           (|do [=k (&&/resolved-ident k)]
-                             (return (&/T [(&/ident->text =k) v])))
+                                              (&/$None)
+                                              (return &/$None)))
 
-                           _
-                           (&/fail-with-loc "[Analyser Error] Wrong syntax for records. Odd elements must be slots.")))
-                       pairs)
-        _ (let [num-expected (&/|length slot-group)
-                num-got (&/|length =pairs)]
-            (&/assert! (= num-expected num-got)
-                       (str "[Analyser Error] Wrong number of record members. Expected " num-expected ", but got " num-got ".")))
-        =members (&/map% (fn [slot]
-                           (let [slot (&/ident->text (&/T [module slot]))]
-                             (if-let [member (&/|get slot =pairs)]
-                               (return member)
-                               (&/fail-with-loc (str "[Analyser Error] Missing slot: " slot)))))
-                         slot-group)]
-    (return (&/T [=members slot-type]))))
+                                          _
+                                          (return &/$None))]
+        (|case module&slot-group&slot-type
+          (&/$Some [module slot-group slot-type])
+          (|do [=pairs (&/map% (fn [kv]
+                                 (|case kv
+                                   [[_ (&/$Tag k)] v]
+                                   (|do [=k (&&/resolved-ident k)]
+                                     (return (&/T [(&/ident->text =k) v])))
+
+                                   _
+                                   (&/fail-with-loc "[Analyser Error] Wrong syntax for records. Odd elements must be slots.")))
+                               pairs)
+                _ (let [num-expected (&/|length slot-group)
+                        num-got (&/|length =pairs)]
+                    (&/assert! (= num-expected num-got)
+                               (str "[Analyser Error] Wrong number of record members. Expected " num-expected ", but got " num-got ".")))
+                =members (&/map% (fn [slot]
+                                   (let [slot (&/ident->text (&/T [module slot]))]
+                                     (if-let [member (&/|get slot =pairs)]
+                                       (return member)
+                                       (&/fail-with-loc (str "[Analyser Error] Missing slot: " slot)))))
+                                 slot-group)]
+            (return (&/$Some (&/T [=members slot-type]))))
+
+          (&/$None)
+          (return &/$None))))
+    (return &/$None)))
diff --git a/lux-bootstrapper/src/lux/base.clj b/lux-bootstrapper/src/lux/base.clj
index f95c4d6d5..b19bb4fae 100644
--- a/lux-bootstrapper/src/lux/base.clj
+++ b/lux-bootstrapper/src/lux/base.clj
@@ -273,7 +273,7 @@
         :else pattern))
 
 (defmacro |case [value & branches]
-  (assert (= 0 (mod (count branches) 2)))
+  (assert (even? (count branches)))
   (let [value* (if (vector? value)
                  [`(T [~@value])]
                  [value])]
@@ -381,7 +381,7 @@
         ))))
 
 (defmacro |do [steps return]
-  (assert (= 0 (rem (count steps) 2)) "The number of steps must be even!")
+  (assert (even? (count steps)) "The number of steps must be even!")
   (reduce (fn [inner [label computation]]
             (case label
               :let `(|let ~computation ~inner)
@@ -580,20 +580,22 @@
 (defn list-join [xss]
   (fold |++ $End xss))
 
-(defn |as-pairs [xs]
-  (|case xs
-    ($Item x ($Item y xs*))
-    ($Item (T [x y]) (|as-pairs xs*))
-
-    _
-    $End))
-
 (defn |reverse [xs]
   (fold (fn [tail head]
           ($Item head tail))
         $End
         xs))
 
+(defn |as-pairs [xs]
+  (loop [input xs
+         output $End]
+    (|case input
+      ($Item headL ($Item headR tail))
+      (recur tail ($Item (T [headL headR]) output))
+
+      _
+      (|reverse output))))
+
 (defn add-loc [meta ^String msg]
   (if (.startsWith msg "@")
     msg