- Added the (untested) inference of tuple destructuring.

- Removed several (unnecessary) type annotations.

8 files changed, 134 insertions, 119 deletions

diff --git a/source/lux.lux b/source/lux.lux
index c1e7b0046..d661b9268 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -691,8 +691,7 @@
 
 (def'' (make-env xs ys)
   (#LambdaT ($' List Text) (#LambdaT ($' List AST) RepEnv))
-  (_lux_case (_lux_: (#TupleT (#Cons ($' List Text) (#Cons ($' List AST) #Nil)))
-                     [xs ys])
+  (_lux_case [xs ys]
     [(#Cons x xs') (#Cons y ys')]
     (#Cons [x y] (make-env xs' ys'))
 
@@ -823,13 +822,12 @@
     (foldL f (f init x) xs')))
 
 (defmacro' #export (All tokens)
-  (let'' [self-name tokens] (_lux_: (#TupleT (#Cons Text (#Cons ASTList #Nil)))
-                                    (_lux_case tokens
-                                      (#Cons [_ (#SymbolS "" self-name)] tokens)
-                                      [self-name tokens]
+  (let'' [self-name tokens] (_lux_case tokens
+                              (#Cons [_ (#SymbolS "" self-name)] tokens)
+                              [self-name tokens]
 
-                                      _
-                                      ["" tokens]))
+                              _
+                              ["" tokens])
          (_lux_case tokens
            (#Cons [_ (#TupleS args)] (#Cons body #Nil))
            (parse-univq-args args
@@ -850,13 +848,12 @@
          ))
 
 (defmacro' #export (Ex tokens)
-  (let'' [self-name tokens] (_lux_: (#TupleT (#Cons Text (#Cons ASTList #Nil)))
-                                    (_lux_case tokens
-                                      (#Cons [_ (#SymbolS "" self-name)] tokens)
-                                      [self-name tokens]
+  (let'' [self-name tokens] (_lux_case tokens
+                              (#Cons [_ (#SymbolS "" self-name)] tokens)
+                              [self-name tokens]
 
-                                      _
-                                      ["" tokens]))
+                              _
+                              ["" tokens])
          (_lux_case tokens
            (#Cons [_ (#TupleS args)] (#Cons body #Nil))
            (parse-univq-args args
@@ -1313,7 +1310,7 @@
                    (resolve-global-symbol [subst name])
 
                    _
-                   (wrap (_lux_: Ident [module name])))
+                   (wrap [module name]))
        #let [[module name] real-name]]
       (return (wrap-meta (form$ (@list (tag$ ["lux" "SymbolS"]) (tuple$ (@list (text$ module) (text$ name))))))))
 
@@ -1330,7 +1327,7 @@
     (do Lux/Monad
       [output (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems)
        #let [[_ form'] output]]
-      (return (_lux_: AST [meta form'])))
+      (return [meta form']))
 
     [_ [_ (#RecordS fields)]]
     (do Lux/Monad
@@ -1576,7 +1573,7 @@
     ["" name]
     (do Lux/Monad
       [module-name get-module-name]
-      (wrap (_lux_: Ident [module-name name])))
+      (wrap [module-name name]))
 
     _
     (return ident)))
@@ -1910,20 +1907,18 @@
                     #None))]
         (_lux_case parts
           (#Some name args ?type body)
-          (let' [body' (: AST
-                          (_lux_case args
-                            #Nil
-                            body
+          (let' [body' (_lux_case args
+                         #Nil
+                         body
 
-                            _
-                            (` (lambda' (~ name) [(~@ args)] (~ body)))))
-                 body'' (: AST
-                           (_lux_case ?type
-                             (#Some type)
-                             (` (: (~ type) (~ body')))
-                             
-                             #None
-                             body'))]
+                         _
+                         (` (lambda' (~ name) [(~@ args)] (~ body))))
+                 body'' (_lux_case ?type
+                          (#Some type)
+                          (` (: (~ type) (~ body')))
+                          
+                          #None
+                          body')]
                 (return (@list& (` (;_lux_def (~ name) (~ body'')))
                                 (if export?
                                   (@list (` (;_lux_export (~ name))))
@@ -2081,14 +2076,14 @@
     (#Some ident head tail body)
     (let [g!blank (symbol$ ["" ""])
           g!name (symbol$ ident)
-          body+ (: AST (foldL (: (-> AST AST AST)
-                                 (lambda' [body' arg]
-                                          (if (symbol? arg)
-                                            (` (;_lux_lambda (~ g!blank) (~ arg) (~ body')))
-                                            (` (;_lux_lambda (~ g!blank) (~ g!blank)
-                                                        (case (~ g!blank) (~ arg) (~ body')))))))
-                              body
-                              (reverse tail)))]
+          body+ (foldL (: (-> AST AST AST)
+                          (lambda' [body' arg]
+                                   (if (symbol? arg)
+                                     (` (;_lux_lambda (~ g!blank) (~ arg) (~ body')))
+                                     (` (;_lux_lambda (~ g!blank) (~ g!blank)
+                                                 (case (~ g!blank) (~ arg) (~ body')))))))
+                       body
+                       (reverse tail))]
       (return (@list (if (symbol? head)
                        (` (;_lux_lambda (~ g!name) (~ head) (~ body+)))
                        (` (;_lux_lambda (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+))))))))
@@ -2121,20 +2116,18 @@
                    #None))]
     (case parts
       (#Some name args ?type body)
-      (let [body (: AST
-                    (case args
-                      #Nil
-                      body
+      (let [body (case args
+                   #Nil
+                   body
 
-                      _
-                      (` (lambda (~ name) [(~@ args)] (~ body)))))
-            body (: AST
-                    (case ?type
-                      (#Some type)
-                      (` (: (~ type) (~ body)))
-                      
-                      #None
-                      body))]
+                   _
+                   (` (lambda (~ name) [(~@ args)] (~ body))))
+            body (case ?type
+                   (#Some type)
+                   (` (: (~ type) (~ body)))
+                   
+                   #None
+                   body)]
         (return (@list& (` (;_lux_def (~ name) (~ body)))
                         (if export?
                           (@list (` (;_lux_export (~ name))))
@@ -2163,12 +2156,12 @@
     (case name+args+body??
       (#Some [name args body])
       (let [name (symbol$ name)
-            decls (list:++ (: (List AST) (if exported? (@list (` (;_lux_export (~ name)))) #;Nil))
-                           (: (List AST) (@list (` (;;_lux_declare-macro (~ name))))))
-            def-sig (: AST
-                       (case args
-                         #;Nil name
-                         _     (` ((~ name) (~@ args)))))]
+            decls (: (List AST)
+                     (list:++ (if exported? (@list (` (;_lux_export (~ name)))) #;Nil)
+                              (@list (` (;;_lux_declare-macro (~ name))))))
+            def-sig (case args
+                      #;Nil name
+                      _     (` ((~ name) (~@ args))))]
         (return (@list& (` (;;def (~ def-sig) ;;Macro (~ body)))
                         decls)))
       
@@ -2212,15 +2205,14 @@
                def-name (symbol$ name)
                tags (: (List AST) (map (. (: (-> Text AST) (lambda [n] (tag$ ["" n]))) first) members))
                types (map second members)
-               sig-type (: AST (` (#TupleT (~ (untemplate-list types)))))
-               sig-decl (: AST (` (;_lux_declare-tags [(~@ tags)] (~ def-name))))
-               sig+ (: AST
-                       (case args
-                         #Nil
-                         sig-type
+               sig-type (` (#TupleT (~ (untemplate-list types))))
+               sig-decl (` (;_lux_declare-tags [(~@ tags)] (~ def-name)))
+               sig+ (case args
+                      #Nil
+                      sig-type
 
-                         _
-                         (` (#NamedT [(~ (text$ _module)) (~ (text$ _name))] (;All (~ def-name) [(~@ args)] (~ sig-type))))))]]
+                      _
+                      (` (#NamedT [(~ (text$ _module)) (~ (text$ _name))] (;All (~ def-name) [(~@ args)] (~ sig-type)))))]]
         (return (@list& (` (;_lux_def (~ def-name) (~ sig+)))
                         sig-decl
                         (if export?
@@ -2556,13 +2548,12 @@
                     #None))]
     (case ?parts
       (#Some name args type defs)
-      (let [defs' (: AST
-                     (case args
-                       #Nil
-                       (` (struct (~@ defs)))
+      (let [defs' (case args
+                    #Nil
+                    (` (struct (~@ defs)))
 
-                       _
-                       (` (lambda (~ name) [(~@ args)] (;struct (~@ defs))))))]
+                    _
+                    (` (lambda (~ name) [(~@ args)] (;struct (~@ defs)))))]
         (return (@list& (` (def (~ name) (~ type) (~ defs')))
                         (if export?
                           (@list (` (;_lux_export (~ name))))
@@ -3036,7 +3027,7 @@
   (-> Text Ident AST Type (Lux (List AST)))
   (do Lux/Monad
     [output (resolve-type-tags type)
-     #let [source+ (: AST (` (get@ (~ (tag$ [module name])) (~ source))))]]
+     #let [source+ (` (get@ (~ (tag$ [module name])) (~ source)))]]
     (case output
       (#Some [tags members])
       (do Lux/Monad
@@ -3087,7 +3078,7 @@
                           [m-name m-alias m-referrals m-openings]
                           (do Lux/Monad
                             [m-name (clean-module m-name)]
-                            (wrap (: Importation [m-name m-alias m-referrals m-openings]))))))
+                            (wrap [m-name m-alias m-referrals m-openings])))))
                    imports)
      unknowns' (map% Lux/Monad
                      (: (-> Importation (Lux (List Text)))
@@ -3178,11 +3169,11 @@
                          (lambda [so-far part]
                            (case part
                              [_ (#SymbolS slot)]
-                             (return (: AST (` (get@ (~ (tag$ slot)) (~ so-far)))))
+                             (return (` (get@ (~ (tag$ slot)) (~ so-far))))
 
                              (\ [_ (#FormS (@list& [_ (#SymbolS slot)] args))])
-                             (return (: AST (` ((get@ (~ (tag$ slot)) (~ so-far))
-                                                (~@ args)))))
+                             (return (` ((get@ (~ (tag$ slot)) (~ so-far))
+                                         (~@ args))))
 
                              _
                              (fail "Wrong syntax for ::"))))
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index 0da0b3ecb..a6ca4e0f7 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -233,7 +233,7 @@
 (defmacro #export (@list xs state)
   (#;Right state (#;Cons (foldL (: (-> AST AST AST)
                                    (lambda [tail head] (` (#;Cons (~ head) (~ tail)))))
-                                (: AST (` #;Nil))
+                                (` #;Nil)
                                 (reverse xs))
                          #;Nil)))
 
@@ -301,7 +301,7 @@
 ##                          [(~@ tokens)]))]
 ##             (#;Right state (@list code))))
 ##         (#;Left "Can't zip-with no lists."))
-      
+
 ##       _
 ##       (let [g!temp [["" -1 -1] (#SymbolS "" "\ttemp\t")]]
 ##         (#;Right state (@list (` (let [(~ g!temp) (~ _f)]
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index c71fd70b0..edf3a8667 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -110,7 +110,7 @@
     ["" name]
     (do Lux/Monad
       [module-name get-module-name]
-      (wrap (: Ident [module-name name])))
+      (wrap [module-name name]))
 
     _
     (:: Lux/Monad (M;wrap ident))))
diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux
index 01acefd36..ee5a37d53 100644
--- a/source/lux/meta/syntax.lux
+++ b/source/lux/meta/syntax.lux
@@ -248,9 +248,8 @@
                                                   (l;fail (~ error-msg)))))))
                             body
                             (: (List (, AST AST)) (@list& [(symbol$ ["" ""]) (` end^)] (reverse names+parsers))))
-               macro-def (: AST
-                            (` (defmacro ((~ (symbol$ ["" name])) (~ g!tokens))
-                                 (~ body'))))]]
+               macro-def (` (defmacro ((~ (symbol$ ["" name])) (~ g!tokens))
+                              (~ body')))]]
         (wrap (@list& macro-def
                       (if exported?
                         (@list (` (;_lux_export (~ (symbol$ ["" name])))))
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)