From bcca540bf8a8434e822677d86f16da79ba7d5b47 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 8 Feb 2016 15:24:19 -0400 Subject: - Added the ability to define constant fields in classes. --- src/lux/analyser/host.clj | 27 +++++++++++++----- src/lux/analyser/parser.clj | 23 ++++++++++++---- src/lux/base.clj | 9 ++++++ src/lux/compiler.clj | 4 +-- src/lux/compiler/host.clj | 67 +++++++++++++++++++++++++++++++++++---------- src/lux/host.clj | 13 +++++++-- src/lux/type/host.clj | 27 ++++++++++++++++++ 7 files changed, 139 insertions(+), 31 deletions(-) (limited to 'src') diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 603fccc42..f8d6060d4 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -238,7 +238,7 @@ _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor - (&&/$jvm-putstatic (&/T [class field =value gclass =type]))))))) + (&&/$jvm-putstatic (&/T [class field =value gclass]))))))) (defn analyse-jvm-putfield [analyse exo-type class field value object] (|do [class-loader &/loader @@ -694,7 +694,19 @@ (|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 =inheritance-modifier =anns =fields methods] +(defn ^:private analyse-field [analyse gtype-env field] + "(-> Analyser GTypeEnv FieldSyntax (Lux FieldAnalysis))" + (|case field + (&/$ConstantFieldSyntax ?name ?anns ?gclass ?value) + (|do [=gtype (&host-type/instance-gtype &type/existential gtype-env ?gclass) + =value (&&/analyse-1 analyse =gtype ?value)] + (return (&/$ConstantFieldAnalysis ?name ?anns ?gclass =value))) + + (&/$VariableFieldSyntax ?name ?privacy-modifier ?state-modifier ?anns ?type) + (return (&/$VariableFieldAnalysis ?name ?privacy-modifier ?state-modifier ?anns ?type)) + )) + +(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 @@ -704,6 +716,7 @@ (|do [ex &type/existential] (return (&/T [gvar ex])))) ?params) + =fields (&/map% (partial analyse-field analyse class-env) ?fields) _ (&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) @@ -755,11 +768,11 @@ =captured &&env/captured-vars :let [=fields (&/|map (fn [^objects idx+capt] (|let [[idx _] idx+capt] - (&/T [(str &c!base/closure-prefix idx) - &/$PublicPM - &/$FinalSM - &/$Nil - captured-slot-type]))) + (&/$VariableFieldAnalysis (str &c!base/closure-prefix idx) + &/$PublicPM + &/$FinalSM + &/$Nil + captured-slot-type))) (&/enumerate =captured))] :let [sources (&/|map captured-source =captured)] _ (compile-token (&&/$jvm-class (&/T [class-decl super-class interfaces &/$DefaultIM &/$Nil =fields =methods =captured (&/$Some =ctor-args)]))) diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj index 61f6c5960..85aae913a 100644 --- a/src/lux/analyser/parser.clj +++ b/src/lux/analyser/parser.clj @@ -315,17 +315,28 @@ (defn parse-field [ast] (|case ast - [_ (&/$FormS (&/$Cons [_ (&/$TextS ?name)] - (&/$Cons ?privacy-modifier - (&/$Cons ?state-modifier - (&/$Cons [_ (&/$TupleS ?anns)] - (&/$Cons ?type + [_ (&/$FormS (&/$Cons [_ (&/$TextS "constant")] + (&/$Cons [_ (&/$TextS ?name)] + (&/$Cons [_ (&/$TupleS ?anns)] + (&/$Cons ?type + (&/$Cons ?value (&/$Nil)))))))] + (|do [=anns (&/map% parse-ann ?anns) + =type (parse-gclass ?type)] + (return (&/$ConstantFieldSyntax ?name =anns =type ?value))) + + [_ (&/$FormS (&/$Cons [_ (&/$TextS "variable")] + (&/$Cons [_ (&/$TextS ?name)] + (&/$Cons ?privacy-modifier + (&/$Cons ?state-modifier + (&/$Cons [_ (&/$TupleS ?anns)] + (&/$Cons ?type + (&/$Nil))))))))] (|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier) =state-modifier (parse-state-modifier ?state-modifier) =anns (&/map% parse-ann ?anns) =type (parse-gclass ?type)] - (return (&/T [?name =privacy-modifier =state-modifier =anns =type]))) + (return (&/$VariableFieldSyntax ?name =privacy-modifier =state-modifier =anns =type))) _ (fail (str "[Analyser Error] Invalid field declaration: " (&/show-ast ast))))) diff --git a/src/lux/base.clj b/src/lux/base.clj index 96c1a82a6..1c7c894b3 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -167,6 +167,15 @@ ("AbstractIM" 0) ("FinalIM" 0)) +;; Fields +(defvariant + ("ConstantFieldSyntax" 4) + ("VariableFieldSyntax" 5)) + +(defvariant + ("ConstantFieldAnalysis" 4) + ("VariableFieldAnalysis" 5)) + ;; Methods (defvariant ("ConstructorMethodSyntax" 1) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 157be60bd..4323317cc 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -219,8 +219,8 @@ (&o/$jvm-getfield ?class ?field ?object ?output-type) (&&host/compile-jvm-getfield compile-expression ?class ?field ?object ?output-type) - (&o/$jvm-putstatic ?class ?field ?value input-gclass ?input-type) - (&&host/compile-jvm-putstatic compile-expression ?class ?field ?value input-gclass ?input-type) + (&o/$jvm-putstatic ?class ?field ?value input-gclass) + (&&host/compile-jvm-putstatic compile-expression ?class ?field ?value input-gclass) (&o/$jvm-putfield ?class ?field ?value input-gclass ?object ?input-type) (&&host/compile-jvm-putfield compile-expression ?class ?field ?object ?value input-gclass ?input-type) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 6eeb61355..bddb25f67 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -394,11 +394,11 @@ (prepare-return! ?output-type))]] (return nil))) -(defn compile-jvm-putstatic [compile ?class ?field ?value input-gclass ?input-type] +(defn compile-jvm-putstatic [compile ?class ?field ?value input-gclass] (|do [^MethodVisitor *writer* &/get-writer _ (compile ?value) - =input-sig (&host/->java-sig ?input-type) - :let [_ (doto *writer* + :let [=input-sig (&host-type/gclass->sig input-gclass) + _ (doto *writer* (prepare-arg! (&host-generics/gclass->class-name input-gclass)) (.visitFieldInsn Opcodes/PUTSTATIC (&host-generics/->bytecode-class-name (&host-type/as-obj ?class)) ?field =input-sig) (.visitInsn Opcodes/ACONST_NULL))]] @@ -435,16 +435,28 @@ nil) (defn ^:private compile-field [^ClassWriter writer field] - (|let [[=name =privacy-modifier =state-modifier =anns =type] field - =field (.visitField writer - (+ (&host/privacy-modifier->flag =privacy-modifier) - (&host/state-modifier->flag =state-modifier)) - =name - (&host-generics/gclass->simple-signature =type) - (&host-generics/gclass->signature =type) nil)] - (do (&/|map (partial compile-annotation =field) =anns) - (.visitEnd =field) - nil))) + (|case field + (&/$ConstantFieldSyntax ?name ?anns ?gclass ?value) + (|let [=field (.visitField writer + (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC Opcodes/ACC_FINAL) + ?name + (&host-generics/gclass->simple-signature ?gclass) + (&host-generics/gclass->signature ?gclass) nil)] + (do (&/|map (partial compile-annotation =field) ?anns) + (.visitEnd =field) + nil)) + + (&/$VariableFieldSyntax =name =privacy-modifier =state-modifier =anns =type) + (|let [=field (.visitField writer + (+ (&host/privacy-modifier->flag =privacy-modifier) + (&host/state-modifier->flag =state-modifier)) + =name + (&host-generics/gclass->simple-signature =type) + (&host-generics/gclass->signature =type) nil)] + (do (&/|map (partial compile-annotation =field) =anns) + (.visitEnd =field) + nil)) + )) (defn ^:private compile-method-return [^MethodVisitor writer output] (|case output @@ -680,6 +692,20 @@ (return nil))))) ) +(defn ^:private constant-inits [fields] + "(-> (List FieldAnalysis) (List [Text GenericClass Analysis]))" + (&/fold &/|++ + &/$Nil + (&/|map (fn [field] + (|case field + (&/$ConstantFieldSyntax ?name ?anns ?gclass ?value) + (&/|list (&/T [?name ?gclass ?value])) + + (&/$VariableFieldSyntax _) + (&/|list) + )) + fields))) + (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 @@ -701,7 +727,20 @@ (add-anon-class- =class compile full-name ?super-class env ctor-args) _ - (return nil))] + (return nil)) + _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "" "()V" nil nil) + (|do [^MethodVisitor =method &/get-writer + :let [_ (doto =method + (.visitCode))] + _ (&/map% (fn [ftriple] + (|let [[fname fgclass fvalue] ftriple] + (compile-jvm-putstatic compile ?name fname fvalue fgclass))) + (constant-inits ?fields)) + :let [_ (doto =method + (.visitInsn Opcodes/RETURN) + (.visitMaxs 0 0) + (.visitEnd))]] + (return nil)))] (&&/save-class! ?name (.toByteArray (doto =class .visitEnd))))) (defn compile-jvm-interface [compile interface-decl ?supers ?anns ?methods] diff --git a/src/lux/host.clj b/src/lux/host.clj index d98e1154f..6bbf752f2 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -376,12 +376,21 @@ (&host-generics/->bytecode-class-name (&host-generics/super-class-name super-class)) (->> interfaces (&/|map (comp &host-generics/->bytecode-class-name &host-generics/super-class-name)) &/->seq (into-array String)))) _ (&/|map (fn [field] - (|let [[=name =privacy-modifier =state-modifier =anns =type] field] + (|case field + (&/$ConstantFieldAnalysis =name =anns =type ?value) + (doto (.visitField =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC Opcodes/ACC_FINAL) =name + (&host-generics/gclass->simple-signature =type) + (&host-generics/gclass->signature =type) + nil) + (.visitEnd)) + + (&/$VariableFieldAnalysis =name =privacy-modifier =state-modifier =anns =type) (doto (.visitField =class (+ Opcodes/ACC_PUBLIC (state-modifier->flag =state-modifier)) =name (&host-generics/gclass->simple-signature =type) (&host-generics/gclass->signature =type) nil) - (.visitEnd)))) + (.visitEnd)) + )) fields) _ (&/|map (partial compile-dummy-method =class super-class) methods) bytecode (.toByteArray (doto =class .visitEnd))] diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj index 531169538..1a174bb27 100644 --- a/src/lux/type/host.clj +++ b/src/lux/type/host.clj @@ -271,3 +271,30 @@ (if-let [bound (->> ^WildcardType gtype .getUpperBounds seq first)] (gtype->gclass bound) &/$GenericWildcard))) + +(let [generic-type-sig "Ljava/lang/Object;"] + (defn gclass->sig [gclass] + "(-> GenericClass Text)" + (|case gclass + (&/$GenericClass gclass-name (&/$Nil)) + (|case gclass-name + "void" "V" + "boolean" "Z" + "byte" "B" + "short" "S" + "int" "I" + "long" "J" + "float" "F" + "double" "D" + "char" "C" + _ (str "L" (clojure.string/replace gclass-name #"\." "/") ";")) + + (&/$GenericArray inner-gtype) + (str "[" (gclass->sig inner-gtype)) + + (&/$GenericTypeVar ?vname) + generic-type-sig + + (&/$GenericWildcard) + generic-type-sig + ))) -- cgit v1.2.3