aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj14
-rw-r--r--src/lux/analyser/host.clj93
-rw-r--r--src/lux/compiler.clj8
-rw-r--r--src/lux/compiler/host.clj37
4 files changed, 108 insertions, 44 deletions
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")
<init>-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)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 07:32:53 +0000