From 506ec627005cca8a2e6f7c4fcf374634be3653de Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 26 Sep 2015 18:10:00 -0400 Subject: - Added support for Java annotations. --- src/lux/analyser.clj | 14 ++++--- src/lux/analyser/host.clj | 93 ++++++++++++++++++++++++++++++++++------------- src/lux/compiler.clj | 8 ++-- src/lux/compiler/host.clj | 37 +++++++++++++++---- 4 files changed, 108 insertions(+), 44 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 190b34b03..5659a066e 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -160,18 +160,20 @@ (&/$Cons [_ (&/$TextS ?name)] (&/$Cons [_ (&/$TextS ?super-class)] (&/$Cons [_ (&/$TupleS ?interfaces)] - (&/$Cons [_ (&/$TupleS ?fields)] - (&/$Cons [_ (&/$TupleS ?methods)] - (&/$Nil)))))))) + (&/$Cons [_ (&/$TupleS ?anns)] + (&/$Cons [_ (&/$TupleS ?fields)] + (&/$Cons [_ (&/$TupleS ?methods)] + (&/$Nil))))))))) (|do [=interfaces (&/map% extract-text ?interfaces)] - (&&host/analyse-jvm-class analyse compile-token ?name ?super-class =interfaces ?fields ?methods)) + (&&host/analyse-jvm-class analyse compile-token ?name ?super-class =interfaces ?anns ?fields ?methods)) (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_interface")] (&/$Cons [_ (&/$TextS ?name)] (&/$Cons [_ (&/$TupleS ?supers)] - ?methods)))) + (&/$Cons [_ (&/$TupleS ?anns)] + ?methods))))) (|do [=supers (&/map% extract-text ?supers)] - (&&host/analyse-jvm-interface analyse compile-token ?name =supers ?methods)) + (&&host/analyse-jvm-interface analyse compile-token ?name =supers ?anns ?methods)) (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_anon-class")] (&/$Cons [_ (&/$TextS ?super-class)] diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 53ab1de5b..5208b2883 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -411,15 +411,45 @@ :concurrency nil} modifiers)) +(let [failure (fail (str "[Analyser Error] Invalid annotation parameter."))] + (defn ^:private extract-ann-param [param] + (|case param + [[_ (&/$TextS param-name)] param-value] + (|case param-value + [_ (&/$BoolS param-value*)] (return (&/T param-name (boolean param-value*))) + [_ (&/$IntS param-value*)] (return (&/T param-name (int param-value*))) + [_ (&/$RealS param-value*)] (return (&/T param-name (float param-value*))) + [_ (&/$CharS param-value*)] (return (&/T param-name (char param-value*))) + [_ (&/$TextS param-value*)] (return (&/T param-name param-value*)) + + _ + failure) + + _ + failure))) + +(defn ^:private analyse-ann [ann] + (|case ann + [_ (&/$FormS (&/$Cons [_ (&/$TextS ann-name)] (&/$Cons [_ (&/$RecordS ann-params)] (&/$Nil))))] + (|do [=ann-params (&/map% extract-ann-param ann-params)] + (return {:name ann-name + :params ann-params})) + + _ + (fail (str "[Analyser Error] Invalid annotation: " (&/show-ast ann))))) + (defn ^:private analyse-field [field] (|case field [_ (&/$FormS (&/$Cons [_ (&/$TextS ?field-name)] (&/$Cons [_ (&/$TupleS ?field-modifiers)] - (&/$Cons [_ (&/$TextS ?field-type)] - (&/$Nil)))))] - (|do [=field-modifiers (analyse-modifiers ?field-modifiers)] + (&/$Cons [_ (&/$TupleS ?anns)] + (&/$Cons [_ (&/$TextS ?field-type)] + (&/$Nil))))))] + (|do [=field-modifiers (analyse-modifiers ?field-modifiers) + =anns (&/map% analyse-ann ?anns)] (return {:name ?field-name :modifiers =field-modifiers + :anns =anns :type ?field-type})) _ @@ -429,11 +459,12 @@ (|case method [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)] (&/$Cons [_ (&/$TupleS method-modifiers)] - (&/$Cons [_ (&/$TupleS method-exs)] - (&/$Cons [_ (&/$TupleS method-inputs)] - (&/$Cons [_ (&/$TextS method-output)] - (&/$Cons method-body - (&/$Nil))))))))] + (&/$Cons [_ (&/$TupleS method-anns)] + (&/$Cons [_ (&/$TupleS method-exs)] + (&/$Cons [_ (&/$TupleS method-inputs)] + (&/$Cons [_ (&/$TextS method-output)] + (&/$Cons method-body + (&/$Nil)))))))))] (|do [=method-modifiers (analyse-modifiers method-modifiers) =method-exs (&/map% extract-text method-exs) =method-inputs (&/map% (fn [minput] @@ -448,23 +479,26 @@ method-inputs)] (return {:name method-name :modifiers =method-modifiers + :anns (&/|list) :exceptions =method-exs :inputs (&/|map &/|second =method-inputs) :output method-output})) _ - (fail "[Analyser Error] Wrong syntax for method."))) + (fail (str "[Analyser Error] Wrong syntax for method: " (&/show-ast method))))) (defn ^:private analyse-method [analyse owner-class method] (|case method [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)] (&/$Cons [_ (&/$TupleS method-modifiers)] - (&/$Cons [_ (&/$TupleS method-exs)] - (&/$Cons [_ (&/$TupleS method-inputs)] - (&/$Cons [_ (&/$TextS method-output)] - (&/$Cons method-body - (&/$Nil))))))))] + (&/$Cons [_ (&/$TupleS method-anns)] + (&/$Cons [_ (&/$TupleS method-exs)] + (&/$Cons [_ (&/$TupleS method-inputs)] + (&/$Cons [_ (&/$TextS method-output)] + (&/$Cons method-body + (&/$Nil)))))))))] (|do [=method-modifiers (analyse-modifiers method-modifiers) + =anns (&/map% analyse-ann method-anns) =method-exs (&/map% extract-text method-exs) =method-inputs (&/map% (fn [minput] (|case minput @@ -487,27 +521,31 @@ =method-inputs)))] (return {:name method-name :modifiers =method-modifiers + :anns =anns :exceptions =method-exs :inputs (&/|map &/|second =method-inputs) :output method-output :body =method-body})) _ - (fail "[Analyser Error] Wrong syntax for method."))) + (fail (str "[Analyser Error] Wrong syntax for method: " (&/show-ast method))))) (defn ^:private analyse-method-decl [method] (|case method [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)] (&/$Cons [_ (&/$TupleS modifiers)] - (&/$Cons [_ (&/$TupleS method-exs)] - (&/$Cons [_ (&/$TupleS inputs)] - (&/$Cons [_ (&/$TextS output)] - (&/$Nil)))))))] - (|do [=inputs (&/map% extract-text inputs) - =modifiers (analyse-modifiers modifiers) + (&/$Cons [_ (&/$TupleS ?anns)] + (&/$Cons [_ (&/$TupleS method-exs)] + (&/$Cons [_ (&/$TupleS inputs)] + (&/$Cons [_ (&/$TextS output)] + (&/$Nil))))))))] + (|do [=modifiers (analyse-modifiers modifiers) + =anns (&/map% analyse-ann ?anns) + =inputs (&/map% extract-text inputs) =method-exs (&/map% extract-text method-exs)] (return {:name method-name :modifiers =modifiers + :anns =anns :exceptions =method-exs :inputs =inputs :output output})) @@ -544,11 +582,12 @@ (return nil) (fail (str "[Analyser Error] Missing method: " missing-method))))) -(defn analyse-jvm-class [analyse compile-token name super-class interfaces fields methods] +(defn analyse-jvm-class [analyse compile-token name super-class interfaces anns fields methods] (&/with-closure (|do [module &/get-module-name :let [full-name (str module "." name)] ;; :let [_ (prn 'analyse-jvm-class/_0)] + =anns (&/map% analyse-ann anns) =fields (&/map% analyse-field fields) ;; :let [_ (prn 'analyse-jvm-class/_1)] =method-descs (&/map% dummy-method-desc methods) @@ -557,14 +596,15 @@ ;; :let [_ (prn 'analyse-jvm-class/_2)] _ (check-method-completion (&/Cons$ super-class interfaces) =methods) ;; :let [_ (prn 'analyse-jvm-class/_3)] - _ (compile-token (&/V &&/$jvm-class (&/T name super-class interfaces =fields =methods nil))) + _ (compile-token (&/V &&/$jvm-class (&/T name super-class interfaces =anns =fields =methods nil))) :let [_ (println 'DEF (str module "." name))]] (return &/Nil$)))) -(defn analyse-jvm-interface [analyse compile-token name supers methods] +(defn analyse-jvm-interface [analyse compile-token name supers anns methods] (|do [module &/get-module-name + =anns (&/map% analyse-ann anns) =methods (&/map% analyse-method-decl methods) - _ (compile-token (&/V &&/$jvm-interface (&/T name supers =methods))) + _ (compile-token (&/V &&/$jvm-interface (&/T name supers =anns =methods))) :let [_ (println 'DEF (str module "." name))]] (return &/Nil$))) @@ -598,6 +638,7 @@ :let [=fields (&/|map (fn [idx+capt] {:name (str &c!base/closure-prefix (aget idx+capt 0)) :modifiers captured-slot-modifier + :anns (&/|list) :type captured-slot-type}) (&/enumerate =captured)) ;; _ (prn '=methods (&/adt->text (&/|map :body =methods))) @@ -606,7 +647,7 @@ :let [sources (&/|map captured-source =captured)] ;; :let [_ (prn 'analyse-jvm-anon-class/_5 name anon-class)] ;; _ (compile-token (&/T (&/V &&/$jvm-anon-class (&/T name super-class interfaces =captured =methods)) exo-type)) - _ (compile-token (&/V &&/$jvm-class (&/T name super-class interfaces =fields =methods =captured))) + _ (compile-token (&/V &&/$jvm-class (&/T name super-class interfaces (&/|list) =fields =methods =captured))) :let [_ (println 'DEF anon-class)] _cursor &/cursor] (return (&/|list (&&/|meta (&type/Data$ anon-class (&/|list)) _cursor diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index d89684bcc..90b8bcc05 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -430,11 +430,11 @@ (&a/$jvm-program ?body) (&&host/compile-jvm-program compile-expression ?body) - (&a/$jvm-interface ?name ?supers ?methods) - (&&host/compile-jvm-interface compile-expression ?name ?supers ?methods) + (&a/$jvm-interface ?name ?supers ?anns ?methods) + (&&host/compile-jvm-interface compile-expression ?name ?supers ?anns ?methods) - (&a/$jvm-class ?name ?super-class ?interfaces ?fields ?methods ??env) - (&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?fields ?methods ??env) + (&a/$jvm-class ?name ?super-class ?interfaces ?anns ?fields ?methods ??env) + (&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?anns ?fields ?methods ??env) _ (compile-expression syntax))) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 95d63b0fb..2322b0e32 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -410,6 +410,25 @@ (&&/wrap-boolean))]] (return nil))) +(defn ^:private compile-annotation [writer ann] + (doto (.visitAnnotation writer (&host/->class (:name ann)) true) + (-> (.visit param-name param-value) + (->> (|let [[param-name param-value] param]) + (doseq [param (&/->seq (:params ann))]))) + (.visitEnd)) + nil) + +(defn ^:private compile-field [writer field] + (let [=field (.visitField writer (&host/modifiers->int (:modifiers field)) (:name field) + (&host/->type-signature (:type field)) nil nil)] + (&/|map (partial compile-annotation =field) (:anns field)) + (.visitEnd =field) + nil) + ;; (doto (.visitField writer (&host/modifiers->int (:modifiers field)) (:name field) + ;; (&host/->type-signature (:type field)) nil nil) + ;; (.visitEnd)) + ) + (defn ^:private compile-method-return [writer output] (case output "void" (.visitInsn writer Opcodes/RETURN) @@ -453,7 +472,8 @@ nil (->> (:exceptions method) (&/|map &host/->class) &/->seq (into-array java.lang.String))) (|do [^MethodVisitor =method &/get-writer - :let [_ (.visitCode =method)] + :let [_ (&/|map (partial compile-annotation =method) (:anns method)) + _ (.visitCode =method)] _ (compile (:body method)) :let [_ (doto =method (compile-method-return (:output method)) @@ -464,7 +484,9 @@ (defn ^:private compile-method-decl [class-writer method] (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")" (&host/->type-signature (:output method)))] - (.visitMethod class-writer (&host/modifiers->int (:modifiers method)) (:name method) signature nil (->> (:exceptions method) (&/|map &host/->class) &/->seq (into-array java.lang.String))))) + (let [=method (.visitMethod class-writer (&host/modifiers->int (:modifiers method)) (:name method) signature nil (->> (:exceptions method) (&/|map &host/->class) &/->seq (into-array java.lang.String)))] + (&/|map (partial compile-annotation =method) (:anns method)) + nil))) (let [clo-field-sig (&host/->type-signature "java.lang.Object") -return "V"] @@ -489,7 +511,7 @@ (.visitEnd))) ) -(defn compile-jvm-class [compile ?name ?super-class ?interfaces ?fields ?methods env] +(defn compile-jvm-class [compile ?name ?super-class ?interfaces ?anns ?fields ?methods env] (|do [;; :let [_ (prn 'compile-jvm-class/_0)] module &/get-module-name ;; :let [_ (prn 'compile-jvm-class/_1)] @@ -500,10 +522,8 @@ (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) full-name nil super-class* (->> ?interfaces (&/|map &host/->class) &/->seq (into-array String))) (.visitSource file-name nil)) - _ (&/|map (fn [field] - (doto (.visitField =class (&host/modifiers->int (:modifiers field)) (:name field) - (&host/->type-signature (:type field)) nil nil) - (.visitEnd))) + _ (&/|map (partial compile-annotation =class) ?anns) + _ (&/|map (partial compile-field =class) ?fields)] ;; :let [_ (prn 'compile-jvm-class/_2)] _ (&/map% (partial compile-method compile =class) ?methods) @@ -514,7 +534,7 @@ ] (&&/save-class! ?name (.toByteArray (doto =class .visitEnd))))) -(defn compile-jvm-interface [compile ?name ?supers ?methods] +(defn compile-jvm-interface [compile ?name ?supers ?anns ?methods] ;; (prn 'compile-jvm-interface (->> ?supers &/->seq pr-str)) (|do [module &/get-module-name [file-name _ _] &/cursor] @@ -522,6 +542,7 @@ (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_INTERFACE) (str module "/" ?name) nil "java/lang/Object" (->> ?supers (&/|map &host/->class) &/->seq (into-array String))) (.visitSource file-name nil)) + _ (&/|map (partial compile-annotation =interface) ?anns) _ (do (&/|map (partial compile-method-decl =interface) ?methods) (.visitEnd =interface))] (&&/save-class! ?name (.toByteArray =interface))))) -- cgit v1.2.3