From 0ab36505d13cdf83391e240b29b34e5cbbe6bed2 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 6 Feb 2016 19:06:02 -0400 Subject: - Added support for defining static methods in JVM classes. - Fixed a bug wherein host data-types weren't getting cleaned when working with type variables. --- src/lux/analyser/base.clj | 13 +++++++++++-- src/lux/analyser/host.clj | 34 +++++++++++++++++++++++++++------- src/lux/analyser/parser.clj | 23 +++++++++++++++++++++++ src/lux/base.clj | 6 ++++-- src/lux/compiler/host.clj | 20 ++++++++++++++++++++ src/lux/host.clj | 13 +++++++++++++ src/lux/type.clj | 6 +++++- 7 files changed, 103 insertions(+), 12 deletions(-) (limited to 'src') diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index 5149456aa..318149b9f 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -152,10 +152,19 @@ "jvm-lushr"]) ;; [Exports] -(defn expr-type* [syntax+] - (|let [[[type _] _] syntax+] +(defn expr-type* [analysis] + (|let [[[type _] _] analysis] type)) +(defn with-type [new-type analysis] + (|let [[[type cursor] adt] analysis] + (&/T [(&/T [new-type cursor]) adt]))) + +(defn clean-analysis [$var an] + "(-> Type Analysis (Lux Analysis))" + (|do [=an-type (&type/clean $var (expr-type* an))] + (return (with-type =an-type an)))) + (def jvm-this "_jvm_this") (defn cap-1 [action] diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index bce75bea7..a467e7822 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -268,6 +268,7 @@ (|case gtype-vars (&/$Nil) (|do [arg-types (&/map% (partial &host-type/instance-param &type/existential gtype-env) gtype-args) + =arg-types (&/map% &type/show-type+ arg-types) =args (&/map2% (partial &&/analyse-1 analyse) arg-types args) =gret (&host-type/instance-param &type/existential gtype-env gret)] (return (&/T [=gret =args]))) @@ -275,8 +276,11 @@ (&/$Cons ^TypeVariable gtv gtype-vars*) (&type/with-var (fn [$var] - (|let [gtype-env* (&/Cons$ (&/T [(.getName gtv) $var]) gtype-env)] - (analyse-method-call-helper analyse gret gtype-env* gtype-vars* gtype-args args)))) + (|do [:let [gtype-env* (&/Cons$ (&/T [(.getName gtv) $var]) gtype-env)] + [=gret =args] (analyse-method-call-helper analyse gret gtype-env* gtype-vars* gtype-args args) + ==gret (&type/clean $var =gret) + ==args (&/map% (partial &&/clean-analysis $var) =args)] + (return (&/T [==gret ==args]))))) )) (let [dummy-type-param (&type/Data$ "java.lang.Object" (&/|list))] @@ -316,11 +320,7 @@ (|do [class-loader &/loader [gret exceptions parent-gvars gvars gargs] (&host/lookup-static-method class-loader class method classes) _ (ensure-catching exceptions) - gtype-env (&/fold% (fn [m ^TypeVariable g] - (|do [=var-type &type/existential] - (return (&/Cons$ (&/T [(.getName g) =var-type]) m)))) - (&/|table) - parent-gvars) + :let [gtype-env (&/|table)] [output-type =args] (analyse-method-call-helper analyse gret gtype-env gvars gargs args) _ (&type/check exo-type (as-otype+ output-type)) _cursor &/cursor] @@ -622,6 +622,23 @@ (&&/analyse-1 analyse output-type ?body) (&/|reverse ?inputs))))] (return (&/V &/$OverridenMethodAnalysis (&/T [?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output =body])))) + + (&/$StaticMethodSyntax ?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output ?body) + (|do [method-env (&/map% (fn [gvar] + (|do [ex &type/existential] + (return (&/T [gvar ex])))) + ?gvars) + :let [full-env method-env] + output-type (generic-class->type full-env ?output) + =body (&/with-type-env full-env + (&/fold (fn [body* input*] + (|do [:let [[iname itype*] input*] + itype (generic-class->type full-env itype*)] + (&&env/with-local iname itype + body*))) + (&&/analyse-1 analyse output-type ?body) + (&/|reverse ?inputs)))] + (return (&/V &/$StaticMethodAnalysis (&/T [?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output =body])))) ))) (defn ^:private mandatory-methods [supers] @@ -641,6 +658,9 @@ (&/$OverridenMethodAnalysis =class-decl =name =anns =gvars =exceptions =inputs =output body) (assoc mmap =name =inputs) + + (&/$StaticMethodAnalysis _) + mmap )) {} methods) diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj index 3c4d4413d..26b161aba 100644 --- a/src/lux/analyser/parser.clj +++ b/src/lux/analyser/parser.clj @@ -229,10 +229,33 @@ _ (fail ""))) +(defn ^:private parse-method-static-def [ast] + (|case ast + [_ (&/$FormS (&/$Cons [_ (&/$TextS "static")] + (&/$Cons [_ (&/$TextS ?name)] + (&/$Cons ?privacy-modifier + (&/$Cons [_ (&/$TupleS anns)] + (&/$Cons [_ (&/$TupleS gvars)] + (&/$Cons [_ (&/$TupleS exceptions)] + (&/$Cons [_ (&/$TupleS inputs)] + (&/$Cons output + (&/$Cons body (&/$Nil)))))))))))] + (|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier) + =anns (&/map% parse-ann anns) + =gvars (&/map% parse-text gvars) + =exceptions (&/map% parse-gclass exceptions) + =inputs (&/map% parse-arg-decl inputs) + =output (parse-gclass output)] + (return (&/V &/$StaticMethodSyntax (&/T [?name =privacy-modifier =anns =gvars =exceptions =inputs =output body])))) + + _ + (fail ""))) + (defn parse-method-def [ast] (&/try-all% (&/|list #((parse-method-init-def ast) %) #((parse-method-virtual-def ast) %) #((parse-method-override-def ast) %) + #((parse-method-static-def ast) %) (fn [state] (fail* (str "[Analyser Error] Invalid method definition: " (&/show-ast ast))))))) diff --git a/src/lux/base.clj b/src/lux/base.clj index 9bfd60350..dc8dc0081 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -120,12 +120,14 @@ (deftags ["ConstructorMethodSyntax" "VirtualMethodSyntax" - "OverridenMethodSyntax"]) + "OverridenMethodSyntax" + "StaticMethodSyntax"]) (deftags ["ConstructorMethodAnalysis" "VirtualMethodAnalysis" - "OverridenMethodAnalysis"]) + "OverridenMethodAnalysis" + "StaticMethodAnalysis"]) ;; Meta-data (deftags diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 291d78ee2..deeb529b5 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -570,6 +570,26 @@ (.visitMaxs 0 0) (.visitEnd))]] (return nil)))) + + (&/$StaticMethodAnalysis ?name ?privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output ?body) + (|let [=method-decl (&/T [?name ?anns ?gvars ?exceptions (&/|map &/|second ?inputs) ?output]) + [simple-signature generic-signature] (&host-generics/method-signatures =method-decl)] + (&/with-writer (.visitMethod class-writer + (+ (privacy-modifer->flag ?privacy-modifier) + Opcodes/ACC_STATIC) + ?name + simple-signature + generic-signature + (->> ?exceptions (&/|map &host-generics/->bytecode-class-name) &/->seq (into-array java.lang.String))) + (|do [^MethodVisitor =method &/get-writer + :let [_ (&/|map (partial compile-annotation =method) ?anns) + _ (.visitCode =method)] + _ (compile ?body) + :let [_ (doto =method + (compile-method-return ?output) + (.visitMaxs 0 0) + (.visitEnd))]] + (return nil)))) )) (defn ^:private compile-method-decl [^ClassWriter class-writer =method-decl] diff --git a/src/lux/host.clj b/src/lux/host.clj index 36375ae0f..fe648c8ff 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -313,6 +313,19 @@ (.visitMaxs 0 0) (.visitEnd))) + (&/$StaticMethodSyntax =name =privacy-modifier =anns =gvars =exceptions =inputs =output body) + (|let [method-decl [=name =anns =gvars =exceptions (&/|map &/|second =inputs) =output] + [simple-signature generic-signature] (&host-generics/method-signatures method-decl)] + (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) + =name + simple-signature + generic-signature + (->> =exceptions (&/|map &host-generics/gclass->bytecode-class-name) &/->seq (into-array java.lang.String))) + .visitCode + (dummy-return =output) + (.visitMaxs 0 0) + (.visitEnd))) + _ (assert false (println-str 'compile-dummy-method (&/adt->text method-def))) )) diff --git a/src/lux/type.clj b/src/lux/type.clj index 936fe9409..d3a5f1493 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -279,6 +279,10 @@ (deref ?id) (return type))) (return type)) + + (&/$DataT ?name ?params) + (|do [=params (&/map% (partial clean* ?tid) ?params)] + (return (Data$ ?name =params))) (&/$LambdaT ?arg ?return) (|do [=arg (clean* ?tid ?arg) @@ -503,7 +507,7 @@ (defn ^:private fp-put [k v fixpoints] (&/Cons$ (&/T [k v]) fixpoints)) -(defn ^:private show-type+ [type] +(defn show-type+ [type] (|case type (&/$VarT ?id) (fn [state] -- cgit v1.2.3