- Added the (untested) inference of tuple destructuring.

- Removed several (unnecessary) type annotations.

4 files changed, 62 insertions, 37 deletions

diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 414d005f1..7f7980e76 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -139,6 +139,14 @@
       _
       (fail "[Analyser Error] Can't expand to other than 1 element."))))
 
+(defn analyse-1+ [analyse ?token]
+  (&type/with-var
+    (fn [$var]
+      (|do [=expr (analyse-1 analyse $var ?token)
+            :let [[?item ?type] =expr]
+            =type (&type/clean $var ?type)]
+        (return (&/T ?item =type))))))
+
 (defn resolved-ident [ident]
   (|let [[?module ?name] ident]
     (|do [module* (if (.equals "" ?module)
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index f302088d9..3b12270c2 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -184,11 +184,7 @@
       
       (&/$RecordS pairs)
       (|do [?members (&&record/order-record pairs)
-            ;; :let [_ (prn 'PRE (&type/show-type value-type))]
-            value-type* (adjust-type value-type)
-            ;; :let [_ (prn 'POST (&type/show-type value-type*))]
-            ;; value-type* (resolve-type value-type)
-            ]
+            value-type* (adjust-type value-type)]
         (|case value-type*
           (&/$TupleT ?member-types)
           (if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members)))
@@ -333,6 +329,15 @@
           (return (&/V $VariantTotal (&/T total? structs))))
         ))))
 
+(defn check-totality+ [check-totality]
+  (fn [?token]
+    (&type/with-var
+      (fn [$var]
+        (|do [=output (check-totality $var ?token)
+              ?type (&type/deref+ $var)
+              =type (&type/clean $var ?type)]
+          (return (&/T =output =type)))))))
+
 (defn ^:private check-totality [value-type struct]
   ;; (prn 'check-totality (&type/show-type value-type) (&/adt->text struct))
   (|case struct
@@ -340,34 +345,45 @@
     (return ?total)
 
     ($BoolTotal ?total ?values)
-    (return (or ?total
-                (= #{true false} (set (&/->seq ?values)))))
+    (|do [_ (&type/check value-type &type/Bool)]
+      (return (or ?total
+                  (= #{true false} (set (&/->seq ?values))))))
 
     ($IntTotal ?total _)
-    (return ?total)
+    (|do [_ (&type/check value-type &type/Int)]
+      (return ?total))
 
     ($RealTotal ?total _)
-    (return ?total)
+    (|do [_ (&type/check value-type &type/Real)]
+      (return ?total))
 
     ($CharTotal ?total _)
-    (return ?total)
+    (|do [_ (&type/check value-type &type/Char)]
+      (return ?total))
 
     ($TextTotal ?total _)
-    (return ?total)
+    (|do [_ (&type/check value-type &type/Text)]
+      (return ?total))
 
     ($TupleTotal ?total ?structs)
-    (if ?total
-      (return true)
-      (|do [value-type* (resolve-type value-type)]
-        (|case value-type*
-          (&/$TupleT ?members)
-          (|do [totals (&/map2% (fn [sub-struct ?member]
-                                  (check-totality ?member sub-struct))
-                                ?structs ?members)]
-            (return (&/fold #(and %1 %2) true totals)))
+    (|do [unknown? (&type/unknown? value-type)]
+      (if unknown?
+        (|do [=structs (&/map% (check-totality+ check-totality) ?structs)
+              _ (&type/check value-type (&/V &/$TupleT (&/|map &/|second =structs)))]
+          (return (or ?total
+                      (&/fold #(and %1 %2) true (&/|map &/|first =structs)))))
+        (if ?total
+          (return true)
+          (|do [value-type* (resolve-type value-type)]
+            (|case value-type*
+              (&/$TupleT ?members)
+              (|do [totals (&/map2% (fn [sub-struct ?member]
+                                      (check-totality ?member sub-struct))
+                                    ?structs ?members)]
+                (return (&/fold #(and %1 %2) true totals)))
 
-          _
-          (fail "[Pattern-maching Error] Tuple is not total."))))
+              _
+              (fail "[Pattern-maching Error] Tuple is not total."))))))
 
     ($VariantTotal ?total ?structs)
     (if ?total
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 62202c1c9..3a9b822ca 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -18,19 +18,11 @@
                           [module :as &&module]
                           [record :as &&record])))
 
-(defn ^:private analyse-1+ [analyse ?token]
-  (&type/with-var
-    (fn [$var]
-      (|do [=expr (&&/analyse-1 analyse $var ?token)
-            :let [[?item ?type] =expr]
-            =type (&type/clean $var ?type)]
-        (return (&/T ?item =type))))))
-
 ;; [Exports]
 (defn analyse-tuple [analyse exo-type ?elems]
   (|do [unknown? (&type/unknown? exo-type)]
     (if unknown?
-      (|do [=elems (&/map% #(|do [=analysis (analyse-1+ analyse %)]
+      (|do [=elems (&/map% #(|do [=analysis (&&/analyse-1+ analyse %)]
                               (return =analysis))
                            ?elems)
             _ (&type/check exo-type (&/V &/$TupleT (&/|map &&/expr-type* =elems)))]
@@ -52,7 +44,7 @@
                 (analyse-tuple analyse exo-type** ?elems))))
 
           _
-          (fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*))))))))
+          (fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*) (&type/show-type exo-type))))))))
 
 (defn ^:private analyse-variant-body [analyse exo-type ?values]
   (|do [output (|case ?values
@@ -303,7 +295,7 @@
   (|do [:let [num-branches (&/|length ?branches)]
         _ (&/assert! (> num-branches 0) "[Analyser Error] Can't have empty branches in \"case'\" expression.")
         _ (&/assert! (even? num-branches) "[Analyser Error] Unbalanced branches in \"case'\" expression.")
-        =value (analyse-1+ analyse ?value)
+        =value (&&/analyse-1+ analyse ?value)
         =match (&&case/analyse-branches analyse exo-type (&&/expr-type* =value) (&/|as-pairs ?branches))]
     (return (&/|list (&/T (&/V &&/$case (&/T =value =match))
                           exo-type)))))
@@ -382,7 +374,7 @@
     (if ?
       (fail (str "[Analyser Error] Can't redefine " (str module-name ";" ?name)))
       (|do [=value (&/with-scope ?name
-                     (analyse-1+ analyse ?value))]
+                     (&&/analyse-1+ analyse ?value))]
         (|case =value
           [(&&/$var (&/$Global ?r-module ?r-name)) _]
           (|do [_ (&&module/def-alias module-name ?name ?r-module ?r-name (&&/expr-type* =value))
@@ -452,6 +444,6 @@
   (|do [=type (&&/analyse-1 analyse &type/Type ?type)
         ==type (eval! =type)
         _ (&type/check exo-type ==type)
-        =value (analyse-1+ analyse ?value)]
+        =value (&&/analyse-1+ analyse ?value)]
     (return (&/|list (&/T (&/V &&/$ann (&/T =value =type))
                           ==type)))))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index f067867d8..5fbc33de2 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -336,6 +336,14 @@
         (fail* (str "[Type Error] Unbound type-var: " id)))
       (fail* (str "[Type Error] <deref> Unknown type-var: " id)))))
 
+(defn deref+ [type]
+  (|case type
+    (&/$VarT id)
+    (deref id)
+
+    _
+    (fail (str "[Type Error] Type is not a variable: " (show-type type)))))
+
 (defn set-var [id type]
   (fn [state]
     (if-let [tvar (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) (&/|get id))]
@@ -914,8 +922,9 @@
     (|do [type* (apply-type ?all ?param)]
       (actual-type type*))
 
-    (&/$VarT ?id)
-    (deref ?id)
+    (&/$VarT id)
+    (|do [=type (deref id)]
+      (actual-type =type))
 
     (&/$NamedT ?name ?type)
     (actual-type ?type)