- Added inference during construction of variants.

3 files changed, 98 insertions, 44 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index d17eeea2a..a9689a9d0 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -43,6 +43,23 @@
     _
     (fail (str "[Analyser Error] Not a tag: " (&/show-ast ast)))))
 
+(defn analyse-variant+ [analyser exo-type ident values]
+  (|do [[module tag-name] (&/normalize ident)
+        idx (&&module/tag-index module tag-name)]
+    (|case exo-type
+      (&/$VarT id)
+      (|do [? (&type/bound? id)]
+        (if (or ? (&&/type-tag? module tag-name))
+          (&&lux/analyse-variant analyser (&/V &/$Right exo-type) idx values)
+          (|do [wanted-type (&&module/tag-type module tag-name)
+                [variant-analysis variant-type] (&&/cap-1 (&&lux/analyse-variant analyser (&/V &/$Left wanted-type) idx values))
+                _ (&type/check exo-type variant-type)]
+            (return (&/|list (&/T variant-analysis exo-type))))))
+
+      _
+      (&&lux/analyse-variant analyser (&/V &/$Right exo-type) idx values)
+      )))
+
 (defn ^:private aba7 [analyse eval! compile-module compile-token exo-type token]
   (|case token
     ;; Arrays
@@ -505,9 +522,7 @@
     (&&lux/analyse-record analyse exo-type ?elems)
 
     (&/$TagS ?ident)
-    (|do [[module tag-name] (&/normalize ?ident)
-          idx (&&module/tag-index module tag-name)]
-      (&&lux/analyse-variant analyse exo-type idx (&/|list)))
+    (analyse-variant+ analyse exo-type ?ident (&/|list))
     
     (&/$SymbolS _ "_jvm_null")
     (&&host/analyse-jvm-null analyse exo-type)
@@ -573,16 +588,10 @@
       (&/with-expected-type exo-type
         (|case token
           [meta (&/$FormS (&/$Cons [_ (&/$IntS idx)] ?values))]
-          (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) exo-type idx ?values)
+          (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) (&/V &/$Right exo-type) idx ?values)
 
           [meta (&/$FormS (&/$Cons [_ (&/$TagS ?ident)] ?values))]
-          (|do [;; :let [_ (println 'analyse-ast/_0 (&/ident->text ?ident))]
-                [module tag-name] (&/normalize ?ident)
-                ;; :let [_ (println 'analyse-ast/_1 (&/ident->text (&/T module tag-name)))]
-                idx (&&module/tag-index module tag-name)
-                ;; :let [_ (println 'analyse-ast/_2 idx)]
-                ]
-            (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) exo-type idx ?values))
+          (analyse-variant+ (partial analyse-ast eval! compile-module compile-token) exo-type ?ident ?values)
           
           [meta (&/$FormS (&/$Cons ?fn ?args))]
           (fn [state]
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index e27b2e42e..1507a3a76 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -156,3 +156,8 @@
                     &/get-module-name
                     (return ?module))]
       (return (&/T module* ?name)))))
+
+(let [tag-names #{"DataT" "VariantT" "TupleT" "LambdaT" "BoundT" "VarT" "ExT" "UnivQ" "ExQ" "AppT" "NamedT"}]
+  (defn type-tag? [module name]
+    (and (= "lux" module)
+         (contains? tag-names name))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index a6f41c9fd..b8239d1a9 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -133,41 +133,75 @@
       _
       (fail "[Analyser Error] Can't expand to other than 1 element."))))
 
-(defn analyse-variant [analyse exo-type idx ?values]
-  (|do [exo-type* (|case exo-type
-                    (&/$VarT ?id)
-                    (&/try-all% (&/|list (|do [exo-type* (&type/deref ?id)]
-                                           (&type/actual-type exo-type*))
-                                         (|do [_ (&type/set-var ?id &type/Type)]
-                                           (&type/actual-type &type/Type))))
-
-                    _
-                    (&type/actual-type exo-type))]
-    (|case exo-type*
-      (&/$VariantT ?cases)
-      (|case (&/|at idx ?cases)
-        (&/$Some vtype)
-        (|do [=value (with-attempt
-                       (analyse-variant-body analyse vtype ?values)
-                       (fn [err]
-                         (|do [_exo-type (&type/deref+ exo-type)]
-                           (fail (str err "\n"
-                                      'analyse-variant " " idx " " (&type/show-type exo-type) " " (&type/show-type _exo-type)
-                                      " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))))]
-          (return (&/|list (&/T (&/V &&/$variant (&/T idx =value))
-                                exo-type))))
+(defn analyse-variant [analyse ?exo-type idx ?values]
+  (|case ?exo-type
+    (&/$Left exo-type)
+    (|do [;; :let [_ (println 'analyse-variant/Left 0 (&type/show-type exo-type))]
+          exo-type* (&type/actual-type exo-type)
+          ;; :let [_ (println 'analyse-variant/Left 1 (&type/show-type exo-type*))]
+          ]
+      (|case exo-type*
+        (&/$UnivQ _)
+        (&type/with-var
+          (fn [$var]
+            (|do [exo-type** (&type/apply-type exo-type* $var)
+                  ;; :let [_ (println 'analyse-variant/Left 2 (&type/show-type exo-type**))]
+                  [variant-analysis variant-type] (&&/cap-1 (analyse-variant analyse (&/V &/$Left exo-type**) idx ?values))
+                  ;; :let [_ (println 'analyse-variant/Left 3 (&type/show-type variant-type))]
+                  =var (&type/resolve-type $var)
+                  ;; :let [_ (println 'analyse-variant/Left 4 (&type/show-type =var))]
+                  inferred-type (|case =var
+                                  (&/$VarT iid)
+                                  (|do [:let [=var* (next-bound-type variant-type)]
+                                        _ (&type/set-var iid =var*)
+                                        variant-type* (&type/clean $var variant-type)]
+                                    (return (&type/Univ$ (&/|list) variant-type*)))
 
-        (&/$None)
-        (fail (str "[Analyser Error] There is no case " idx " for variant type " (&type/show-type exo-type*))))
+                                  _
+                                  (&type/clean $var variant-type))
+                  ;; :let [_ (println 'analyse-variant/Left 5 (&type/show-type inferred-type))]
+                  ]
+              (return (&/|list (&/T variant-analysis inferred-type))))))
 
-      (&/$UnivQ _)
-      (&type/with-var
-        (fn [$var]
-          (|do [exo-type** (&type/apply-type exo-type* $var)]
-            (analyse-variant analyse exo-type** idx ?values))))
-      
-      _
-      (fail (str "[Analyser Error] Can't create a variant if the expected type is " (&type/show-type exo-type*))))))
+        _
+        (analyse-variant analyse (&/V &/$Right exo-type*) idx ?values)))
+
+    (&/$Right exo-type)
+    ;; [_ exo-type]
+    (|do [;; :let [_ (println 'analyse-variant/Right 0 (&type/show-type exo-type))]
+          exo-type* (|case exo-type
+                      (&/$VarT ?id)
+                      (&/try-all% (&/|list (|do [exo-type* (&type/deref ?id)]
+                                             (&type/actual-type exo-type*))
+                                           (|do [_ (&type/set-var ?id &type/Type)]
+                                             (&type/actual-type &type/Type))))
+
+                      _
+                      (&type/actual-type exo-type))]
+      (|case exo-type*
+        (&/$VariantT ?cases)
+        (|case (&/|at idx ?cases)
+          (&/$Some vtype)
+          (|do [=value (with-attempt
+                         (analyse-variant-body analyse vtype ?values)
+                         (fn [err]
+                           (|do [_exo-type (&type/deref+ exo-type)]
+                             (fail (str err "\n"
+                                        'analyse-variant " " idx " " (&type/show-type exo-type) " " (&type/show-type _exo-type)
+                                        " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))))]
+            (return (&/|list (&/T (&/V &&/$variant (&/T idx =value))
+                                  exo-type))))
+
+          (&/$None)
+          (fail (str "[Analyser Error] There is no case " idx " for variant type " (&type/show-type exo-type*))))
+
+        (&/$UnivQ _)
+        (|do [$var &type/existential
+              exo-type** (&type/apply-type exo-type* $var)]
+          (analyse-variant analyse (&/V &/$Right exo-type**) idx ?values))
+        
+        _
+        (fail (str "[Analyser Error] Can't create a variant if the expected type is " (&type/show-type exo-type*)))))))
 
 (defn analyse-record [analyse exo-type ?elems]
   (|do [[rec-members rec-type] (&&record/order-record ?elems)]
@@ -465,6 +499,12 @@
           _
           (do ;; (println 'DEF (str module-name ";" ?name))
               (|do [_ (compile-token (&/V &&/$def (&/T ?name =value)))
+                    ;; _ (if (and (= "lux" module-name)
+                    ;;            (= "Type" ?name))
+                    ;;     (|do [newly-defined-Type 
+                    ;;           :let [_ (&type/redefine-type! newly-defined-Type)]]
+                    ;;       (return nil))
+                    ;;     (return nil))
                     :let [;; _ (println 'DEF/COMPILED (str module-name ";" ?name))
                           [def-analysis def-type] =value
                           _ (println 'DEF (str module-name ";" ?name) ;; (&type/show-type def-type)