- Made some fixes to type-inference for pattern-matching.

5 files changed, 67 insertions, 47 deletions

diff --git a/project.clj b/project.clj
index c00605591..c08d03930 100644
--- a/project.clj
+++ b/project.clj
@@ -1,4 +1,4 @@
-(defproject com.github.luxlang/luxc-jvm "0.3.3-SNAPSHOT"
+(defproject com.github.luxlang/luxc-jvm "0.3.3"
   :description "The JVM compiler for the Lux programming language."
   :url "https://github.com/LuxLang/lux"
   :license {:name "Mozilla Public License (Version 2.0)"
@@ -7,4 +7,6 @@
                  [org.clojure/core.match "0.2.1"]
                  [org.ow2.asm/asm-all "5.0.3"]]
   :warn-on-reflection true
-  :main lux)
+  :main lux
+  :repositories [["snapshots" "https://oss.sonatype.org/content/repositories/snapshots/"]
+                 ["releases" "https://oss.sonatype.org/service/local/staging/deploy/maven2/"]])
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 44c173864..73a1dcb07 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -34,7 +34,8 @@
           (if (or ? (&&/type-tag? module tag-name))
             (&&lux/analyse-variant analyse (&/$Right exo-type) idx is-last? values)
             (|do [wanted-type (&&module/tag-type module tag-name)
-                  [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (&&lux/analyse-variant analyse (&/$Left wanted-type) idx is-last? values))
+                  wanted-type* (&type/instantiate-inference wanted-type)
+                  [[variant-type variant-cursor] variant-analysis] (&&/cap-1 (&&lux/analyse-variant analyse (&/$Left wanted-type*) idx is-last? values))
                   _ (&type/check exo-type variant-type)]
               (return (&/|list (&&/|meta exo-type variant-cursor variant-analysis))))))
 
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 792999a68..71dc1d7bf 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -111,7 +111,7 @@
 
     (&/$VarT ?id)
     (|do [type* (&/try-all% (&/|list (&type/deref ?id)
-                                     (fail "##2##")))]
+                                     (fail (str "##2##: " ?id))))]
       (adjust-type* up type*))
 
     (&/$NamedT ?name ?type)
@@ -124,36 +124,6 @@
     (fail (str "[Pattern-matching Error] Can't adjust type: " (&type/show-type type)))
     ))
 
-(defn ^:private push-app [inf-type inf-var]
-  (|case inf-type
-    (&/$AppT inf-type* inf-var*)
-    (&/$AppT (push-app inf-type* inf-var) inf-var*)
-
-    _
-    (&/$AppT inf-type inf-var)))
-
-(defn ^:private push-name [name inf-type]
-  (|case inf-type
-    (&/$AppT inf-type* inf-var*)
-    (&/$AppT (push-name name inf-type*) inf-var*)
-
-    _
-    (&/$NamedT name inf-type)))
-
-(defn ^:private instantiate-inference [type]
-  (|case type
-    (&/$NamedT ?name ?type)
-    (|do [output (instantiate-inference ?type)]
-      (return (push-name ?name output)))
-
-    (&/$UnivQ _aenv _abody)
-    (|do [inf-var &type/create-var
-          output (instantiate-inference _abody)]
-      (return (push-app output inf-var)))
-
-    _
-    (return type)))
-
 (defn adjust-type [type]
   "(-> Type (Lux Type))"
   (adjust-type* &/$Nil type))
@@ -215,7 +185,7 @@
         _
         (|do [must-infer? (&type/unknown? value-type)
               value-type* (if must-infer?
-                            (|do [member-types (&/map% (fn [_] &type/create-var) (&/|range (&/|length ?members)))]
+                            (|do [member-types (&/map% (fn [_] &type/create-var+) (&/|range (&/|length ?members)))]
                               (return (&type/fold-prod member-types)))
                             (adjust-type value-type))]
           (|case value-type*
@@ -243,22 +213,23 @@
       (|do [[rec-members rec-type] (&&record/order-record pairs)
             must-infer? (&type/unknown? value-type)
             rec-type* (if must-infer?
-                        (instantiate-inference rec-type)
+                        (&type/instantiate-inference rec-type)
                         (return value-type))
             _ (&type/check value-type rec-type*)]
         (analyse-pattern &/$None rec-type* (&/T [meta (&/$TupleS rec-members)]) kont))
 
       (&/$TagS ?ident)
       (|do [[=module =name] (&&/resolved-ident ?ident)
-            value-type* (adjust-type value-type)
+            must-infer? (&type/unknown? value-type)
+            variant-type (if must-infer?
+                           (|do [variant-type (&module/tag-type =module =name)
+                                 variant-type* (&type/instantiate-inference variant-type)
+                                 _ (&type/check value-type variant-type*)]
+                             (return variant-type*))
+                           (return value-type))
+            value-type* (adjust-type variant-type)
             idx (&module/tag-index =module =name)
             group (&module/tag-group =module =name)
-            must-infer? (&type/unknown? value-type*)
-            variant-type (if must-infer?
-                           (|do [variant-type (&module/tag-type =module =name)]
-                             (return (instantiate-inference variant-type)))
-                           (return value-type*))
-            _ (&type/check value-type variant-type)
             case-type (&type/sum-at idx value-type*)
             [=test =kont] (analyse-pattern &/$None case-type unit kont)]
         (return (&/T [($VariantTestAC (&/T [idx (&/|length group) =test])) =kont])))
@@ -266,7 +237,14 @@
       (&/$FormS (&/$Cons [_ (&/$TagS ?ident)]
                          ?values))
       (|do [[=module =name] (&&/resolved-ident ?ident)
-            value-type* (adjust-type value-type)
+            must-infer? (&type/unknown? value-type)
+            variant-type (if must-infer?
+                           (|do [variant-type (&module/tag-type =module =name)
+                                 variant-type* (&type/instantiate-inference variant-type)
+                                 _ (&type/check value-type variant-type*)]
+                             (return variant-type*))
+                           (return value-type))
+            value-type* (adjust-type variant-type)
             idx (&module/tag-index =module =name)
             group (&module/tag-group =module =name)
             case-type (&type/sum-at idx value-type*)
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 55d534f96..20028441c 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -304,7 +304,6 @@
             [gret exceptions parent-gvars gvars gargs] (if (= "<init>" method)
                                                          (return (&/T [Void/TYPE &/$Nil &/$Nil &/$Nil &/$Nil]))
                                                          (&host/lookup-virtual-method class-loader class method classes))
-            ;; :let [_ (prn '<name> 0 gret)]
             _ (ensure-catching exceptions)
             =object (&&/analyse-1+ analyse object)
             [sub-class sub-params] (ensure-object (&&/expr-type* =object))
@@ -314,8 +313,6 @@
                                      parent-gvars
                                      super-params*)]
             [output-type =args] (analyse-method-call-helper analyse gret gtype-env gvars gargs args)
-            ;; :let [_ (prn '<name> 1 (&type/show-type output-type))]
-            ;; :let [_ (prn '<name> 2 (&type/show-type (as-otype+ output-type)))]
             _ (&type/check exo-type (as-otype+ output-type))
             _cursor &/cursor]
         (return (&/|list (&&/|meta exo-type _cursor
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 2b5f27d4e..c6e76f66e 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -915,3 +915,45 @@
   unfold-prod &/$ProdT
   unfold-sum  &/$SumT
   )
+
+(def create-var+
+  (|do [id create-var]
+    (return (&/$VarT id))))
+
+(defn ^:private push-app [inf-type inf-var]
+  (|case inf-type
+    (&/$AppT inf-type* inf-var*)
+    (&/$AppT (push-app inf-type* inf-var) inf-var*)
+
+    _
+    (&/$AppT inf-type inf-var)))
+
+(defn ^:private push-name [name inf-type]
+  (|case inf-type
+    (&/$AppT inf-type* inf-var*)
+    (&/$AppT (push-name name inf-type*) inf-var*)
+
+    _
+    (&/$NamedT name inf-type)))
+
+(defn ^:private push-univq [env inf-type]
+  (|case inf-type
+    (&/$AppT inf-type* inf-var*)
+    (&/$AppT (push-univq env inf-type*) inf-var*)
+
+    _
+    (&/$UnivQ env inf-type)))
+
+(defn instantiate-inference [type]
+  (|case type
+    (&/$NamedT ?name ?type)
+    (|do [output (instantiate-inference ?type)]
+      (return (push-name ?name output)))
+
+    (&/$UnivQ _aenv _abody)
+    (|do [inf-var create-var
+          output (instantiate-inference _abody)]
+      (return (push-univq _aenv (push-app output (&/$VarT inf-var)))))
+
+    _
+    (return type)))