From a565d6221efc325e7b3edc087cf6805e996e2b3c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 6 Feb 2016 22:25:42 -0400 Subject: - Added support for "final" fields, methods & classes. --- src/lux/analyser.clj | 12 +++++++----- src/lux/analyser/host.clj | 12 ++++++------ src/lux/analyser/parser.clj | 29 ++++++++++++++++++++++------- src/lux/base.clj | 9 ++++++++- src/lux/compiler.clj | 4 ++-- src/lux/compiler/host.clj | 10 ++++++---- src/lux/host.clj | 24 ++++++++++++++++-------- 7 files changed, 67 insertions(+), 33 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 25bb09b6d..ae4d81a39 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -162,17 +162,19 @@ (&/$Cons ?class-decl (&/$Cons ?super-class (&/$Cons [_ (&/$TupleS ?interfaces)] - (&/$Cons [_ (&/$TupleS ?anns)] - (&/$Cons [_ (&/$TupleS ?fields)] - (&/$Cons [_ (&/$TupleS ?methods)] - (&/$Nil))))))))) + (&/$Cons ?inheritance-modifier + (&/$Cons [_ (&/$TupleS ?anns)] + (&/$Cons [_ (&/$TupleS ?fields)] + (&/$Cons [_ (&/$TupleS ?methods)] + (&/$Nil)))))))))) (|do [=gclass-decl (&&a-parser/parse-gclass-decl ?class-decl) =super-class (&&a-parser/parse-gclass-super ?super-class) =interfaces (&/map% &&a-parser/parse-gclass-super ?interfaces) + =inheritance-modifier (&&a-parser/parse-inheritance-modifier ?inheritance-modifier) =anns (&/map% &&a-parser/parse-ann ?anns) =fields (&/map% &&a-parser/parse-field ?fields) =methods (&/map% &&a-parser/parse-method-def ?methods)] - (&&host/analyse-jvm-class analyse compile-token =gclass-decl =super-class =interfaces =anns =fields =methods)) + (&&host/analyse-jvm-class analyse compile-token =gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods)) (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_interface")] (&/$Cons ?class-decl diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 99a1da65f..80b627ec9 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -589,7 +589,7 @@ (&/|reverse ?inputs))))] (return (&/V &/$ConstructorMethodAnalysis (&/T [=privacy-modifier ?anns ?gvars ?exceptions ?inputs =ctor-args =body])))) - (&/$VirtualMethodSyntax ?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output ?body) + (&/$VirtualMethodSyntax ?name =privacy-modifier =final? ?anns ?gvars ?exceptions ?inputs ?output ?body) (|do [method-env (&/map% (fn [gvar] (|do [ex &type/existential] (return (&/T [gvar ex])))) @@ -605,7 +605,7 @@ body*))) (&&/analyse-1 analyse output-type ?body) (&/|reverse ?inputs))))] - (return (&/V &/$VirtualMethodAnalysis (&/T [?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output =body])))) + (return (&/V &/$VirtualMethodAnalysis (&/T [?name =privacy-modifier =final? ?anns ?gvars ?exceptions ?inputs ?output =body])))) (&/$OverridenMethodSyntax ?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output ?body) (|do [super-env (gen-super-env class-env all-supers ?class-decl) @@ -688,7 +688,7 @@ (|let [[am-name am-inputs] missing-method] (fail (str "[Analyser Error] Missing method: " am-name " " "(" (->> am-inputs (&/|interpose " ") (&/fold str "")) ")")))))) -(defn analyse-jvm-class [analyse compile-token class-decl super-class interfaces =anns =fields methods] +(defn analyse-jvm-class [analyse compile-token class-decl super-class interfaces =inheritance-modifier =anns =fields methods] (&/with-closure (|do [module &/get-module-name :let [[?name ?params] class-decl @@ -701,7 +701,7 @@ _ (&host/use-dummy-class class-decl super-class interfaces &/None$ =fields methods) =methods (&/map% (partial analyse-method analyse class-decl class-env all-supers) methods) _ (check-method-completion all-supers =methods) - _ (compile-token (&/V &&/$jvm-class (&/T [class-decl super-class interfaces =anns =fields =methods (&/|list) &/None$]))) + _ (compile-token (&/V &&/$jvm-class (&/T [class-decl super-class interfaces =inheritance-modifier =anns =fields =methods (&/|list) &/None$]))) :let [_ (println 'DEF full-name)]] (return &/Nil$)))) @@ -750,12 +750,12 @@ (|let [[idx _] idx+capt] (&/T [(str &c!base/closure-prefix idx) (&/V &/$PublicPM &/unit-tag) - (&/V &/$DefaultSM &/unit-tag) + (&/V &/$FinalSM &/unit-tag) (&/|list) captured-slot-type]))) (&/enumerate =captured))] :let [sources (&/|map captured-source =captured)] - _ (compile-token (&/V &&/$jvm-class (&/T [class-decl super-class interfaces (&/|list) =fields =methods =captured (&/Some$ =ctor-args)]))) + _ (compile-token (&/V &&/$jvm-class (&/T [class-decl super-class interfaces (&/V &/$DefaultIM &/unit-tag) (&/|list) =fields =methods =captured (&/Some$ =ctor-args)]))) _cursor &/cursor] (return (&/|list (&&/|meta anon-class-type _cursor (&/V &&/$jvm-new (&/T [anon-class (&/|repeat (&/|length sources) captured-slot-class) sources])) diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj index eebfb6693..28b8d93c6 100644 --- a/src/lux/analyser/parser.clj +++ b/src/lux/analyser/parser.clj @@ -171,9 +171,23 @@ [_ (&/$TextS "volatile")] (return (&/V &/$VolatileSM &/unit-tag)) + [_ (&/$TextS "final")] + (return (&/V &/$FinalSM &/unit-tag)) + _ (fail (str "[Analyser Error] Invalid state modifier: " (&/show-ast ast))))) +(defn parse-inheritance-modifier [ast] + (|case ast + [_ (&/$TextS "default")] + (return (&/V &/$DefaultIM &/unit-tag)) + + [_ (&/$TextS "final")] + (return (&/V &/$FinalIM &/unit-tag)) + + _ + (fail (str "[Analyser Error] Invalid inheritance modifier: " (&/show-ast ast))))) + (defn ^:private parse-method-init-def [ast] (|case ast [_ (&/$FormS (&/$Cons [_ (&/$TextS "init")] @@ -200,19 +214,20 @@ [_ (&/$FormS (&/$Cons [_ (&/$TextS "virtual")] (&/$Cons [_ (&/$TextS ?name)] (&/$Cons ?privacy-modifier - (&/$Cons [_ (&/$TupleS anns)] - (&/$Cons [_ (&/$TupleS gvars)] - (&/$Cons [_ (&/$TupleS exceptions)] - (&/$Cons [_ (&/$TupleS inputs)] - (&/$Cons output - (&/$Cons body (&/$Nil)))))))))))] + (&/$Cons [_ (&/$BoolS =final?)] + (&/$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 &/$VirtualMethodSyntax (&/T [?name =privacy-modifier =anns =gvars =exceptions =inputs =output body])))) + (return (&/V &/$VirtualMethodSyntax (&/T [?name =privacy-modifier =final? =anns =gvars =exceptions =inputs =output body])))) _ (fail ""))) diff --git a/src/lux/base.clj b/src/lux/base.clj index 3a03ddf9a..bbd610b5c 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -116,9 +116,16 @@ "PrivatePM" "ProtectedPM"]) +;; State Modifiers (deftags ["DefaultSM" - "VolatileSM"]) + "VolatileSM" + "FinalSM"]) + +;; Inheritance Modifiers +(deftags + ["DefaultIM" + "FinalIM"]) ;; Methods (deftags diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 31e0ca3a2..157be60bd 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -433,8 +433,8 @@ (&o/$jvm-interface ?name ?supers ?anns ?methods) (&&host/compile-jvm-interface compile-expression ?name ?supers ?anns ?methods) - (&o/$jvm-class ?name ?super-class ?interfaces ?anns ?fields ?methods ??env ??ctor-args) - (&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?anns ?fields ?methods ??env ??ctor-args) + (&o/$jvm-class ?name ?super-class ?interfaces ?anns ?inheritance-modifier ?fields ?methods ??env ??ctor-args) + (&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?anns ?inheritance-modifier ?fields ?methods ??env ??ctor-args) _ (compile-expression syntax))) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 4fd3b7e0f..b7f5c8679 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -524,11 +524,12 @@ (.visitEnd))]] (return nil)))) - (&/$VirtualMethodAnalysis ?name ?privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output ?body) + (&/$VirtualMethodAnalysis ?name ?privacy-modifier =final? ?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 - (&host/privacy-modifier->flag ?privacy-modifier) + (+ (&host/privacy-modifier->flag ?privacy-modifier) + (if =final? Opcodes/ACC_FINAL 0)) ?name simple-signature generic-signature @@ -661,7 +662,7 @@ (return nil))))) ) -(defn compile-jvm-class [compile class-decl ?super-class ?interfaces ?anns ?fields ?methods env ??ctor-args] +(defn compile-jvm-class [compile class-decl ?super-class ?interfaces ?inheritance-modifier ?anns ?fields ?methods env ??ctor-args] (|do [module &/get-module-name [file-name line column] &/cursor :let [[?name ?params] class-decl @@ -669,7 +670,8 @@ full-name (str module "/" ?name) super-class* (&host-generics/->bytecode-class-name (&host-generics/super-class-name ?super-class)) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) + (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER + (&host/inheritance-modifier->flag ?inheritance-modifier)) full-name (if (= "" class-signature) nil class-signature) super-class* (->> ?interfaces (&/|map (comp &host-generics/->bytecode-class-name &host-generics/super-class-name)) &/->seq (into-array String))) (.visitSource file-name nil)) _ (&/|map (partial compile-annotation =class) ?anns) diff --git a/src/lux/host.clj b/src/lux/host.clj index 0e39aa6df..241a975ea 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -287,10 +287,11 @@ (.visitMaxs 0 0) (.visitEnd))) - (&/$VirtualMethodSyntax =name =privacy-modifier =anns =gvars =exceptions =inputs =output body) + (&/$VirtualMethodSyntax =name =privacy-modifier =final? =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 + (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC + (if =final? Opcodes/ACC_FINAL 0)) =name simple-signature generic-signature @@ -330,12 +331,6 @@ (assert false (println-str 'compile-dummy-method (&/adt->text method-def))) )) -(defn state-modifier->flag [state-modifier] - "(-> State Int)" - (|case state-modifier - (&/$DefaultSM) 0 - (&/$VolatileSM) Opcodes/ACC_VOLATILE)) - (defn privacy-modifier->flag [privacy-modifier] "(-> PrivacyModifier Int)" (|case privacy-modifier @@ -345,6 +340,19 @@ (&/$DefaultPM) 0 )) +(defn state-modifier->flag [state-modifier] + "(-> StateModifier Int)" + (|case state-modifier + (&/$DefaultSM) 0 + (&/$VolatileSM) Opcodes/ACC_VOLATILE + (&/$FinalSM) Opcodes/ACC_FINAL)) + +(defn inheritance-modifier->flag [inheritance-modifier] + "(-> InheritanceModifier Int)" + (|case inheritance-modifier + (&/$DefaultIM) 0 + (&/$FinalIM) Opcodes/ACC_FINAL)) + (defn use-dummy-class [class-decl super-class interfaces ctor-args fields methods] (|do [module &/get-module-name :let [[?name ?params] class-decl -- cgit v1.2.3