- Added support for Java annotations.

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)))))