From a498da4f24bb7c9e248c6b00c3bc4283a49e623f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 26 Apr 2016 00:07:30 -0400 Subject: - Made some fixes to type-inference for pattern-matching. --- project.clj | 6 +++-- src/lux/analyser.clj | 3 ++- src/lux/analyser/case.clj | 60 +++++++++++++++-------------------------------- src/lux/analyser/host.clj | 3 --- src/lux/type.clj | 42 +++++++++++++++++++++++++++++++++ 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 (= "" method) (return (&/T [Void/TYPE &/$Nil &/$Nil &/$Nil &/$Nil])) (&host/lookup-virtual-method class-loader class method classes)) - ;; :let [_ (prn ' 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 ' 1 (&type/show-type output-type))] - ;; :let [_ (prn ' 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))) -- cgit v1.2.3