aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2016-04-26 00:07:30 -0400
committerEduardo Julian2016-04-26 00:07:30 -0400
commita498da4f24bb7c9e248c6b00c3bc4283a49e623f (patch)
tree89178f96fb37905684a89b2ac181a9a05601855a
parent067c48feb464475cfa428b0c048f6d618a2b30e6 (diff)
- Made some fixes to type-inference for pattern-matching.
-rw-r--r--project.clj6
-rw-r--r--src/lux/analyser.clj3
-rw-r--r--src/lux/analyser/case.clj60
-rw-r--r--src/lux/analyser/host.clj3
-rw-r--r--src/lux/type.clj42
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)))