- Added support for Java annotations.

3 files changed, 81 insertions, 15 deletions

diff --git a/source/lux.lux b/source/lux.lux
index fbdd71904..dddf5c80d 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -4,8 +4,8 @@
 ##  You can obtain one at http://mozilla.org/MPL/2.0/.
 
 ## First things first, must define functions
-(_jvm_interface "Function" []
-  ("apply" ["public" "abstract"] [] ["java.lang.Object"] "java.lang.Object"))
+(_jvm_interface "Function" [] []
+  ("apply" ["public" "abstract"] [] [] ["java.lang.Object"] "java.lang.Object"))
 
 ## Basic types
 (_lux_def Bool (10 ["lux" "Bool"]
diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux
index 4892ba333..bbb396874 100644
--- a/source/lux/host/jvm.lux
+++ b/source/lux/host/jvm.lux
@@ -33,9 +33,17 @@
 (deftype Modifier Text)
 (deftype JvmType Text)
 
+(deftype AnnotationParam
+  (, Text AST))
+
+(deftype Annotation
+  (& #ann-name Text
+     #ann-params (List AnnotationParam)))
+
 (deftype MemberDecl
-  (& #member-modifiers (List Modifier)
-     #member-name      Text))
+  (& #member-name      Text
+     #member-modifiers (List Modifier)
+     #member-anns      (List Annotation)))
 
 (deftype FieldDecl
   JvmType)
@@ -86,9 +94,34 @@
     (wrap [vars var-types (list:join var-rebinds) arg-classes])))
 
 ## Parsers
+(def annotation-params^
+  (Parser (List AnnotationParam))
+  (record^ (*^ (tuple^ (&^ local-tag^ id^)))))
+
+(def annotation^
+  (Parser Annotation)
+  (form^ (&^ local-symbol^
+             annotation-params^)))
+
+(def annotations^'
+  (Parser (List Annotation))
+  (do Parser/Monad
+    [_ (tag!^ ["" "ann"])]
+    (tuple^ (*^ annotation^))))
+
+(def annotations^
+  (Parser (List Annotation))
+  (do Parser/Monad
+    [anns?? (?^ annotations^')]
+    (wrap (? (@list) anns??))))
+
 (def member-decl^
   (Parser MemberDecl)
-  (&^ (*^ local-tag^) local-symbol^))
+  (do Parser/Monad
+    [modifiers (*^ local-tag^)
+     name local-symbol^
+     anns annotations^]
+    (wrap [name modifiers anns])))
 
 (def throws-decl'^
   (Parser (List JvmType))
@@ -152,18 +185,29 @@
     (wrap [ex? opt? return])))
 
 ## Generators
-(def (gen-method-decl [[modifiers name] [inputs output exs]])
+(def (gen-annotation-param [name value])
+  (-> AnnotationParam (, AST AST))
+  [(text$ name) value])
+
+(def (gen-annotation [name params])
+  (-> Annotation AST)
+  (` ((~ (text$ name))
+      (~ (record$ (map gen-annotation-param params))))))
+
+(def (gen-method-decl [[name modifiers anns] [inputs output exs]])
   (-> (, MemberDecl MethodDecl) AST)
   (` ((~ (text$ name))
       [(~@ (map text$ modifiers))]
+      [(~@ (map gen-annotation anns))]
       [(~@ (map text$ exs))]
       [(~@ (map text$ inputs))]
       (~ (text$ output)))))
 
-(def (gen-field-decl [[modifiers name] class])
+(def (gen-field-decl [[name modifiers anns] class])
   (-> (, MemberDecl FieldDecl) AST)
   (` ((~ (text$ name))
       [(~@ (map text$ modifiers))]
+      [(~@ (map gen-annotation anns))]
       (~ (text$ class))
       )))
 
@@ -171,10 +215,11 @@
   (-> ArgDecl AST)
   (form$ (@list (symbol$ ["" name]) (text$ type))))
 
-(def (gen-method-def [[modifiers name] [inputs output body exs]])
+(def (gen-method-def [[name modifiers anns] [inputs output body exs]])
   (-> (, MemberDecl MethodDef) AST)
   (` ((~ (text$ name))
       [(~@ (map text$ modifiers))]
+      [(~@ (map gen-annotation anns))]
       [(~@ (map text$ exs))]
       [(~@ (map gen-arg-decl inputs))]
       (~ (text$ output))
@@ -217,18 +262,23 @@
     (|> t get-stack-trace stack-trace->text)))
 
 ## [Syntax]
-(defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)])
-  (emit (@list (` (;_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))]
-                                   (~@ (map gen-method-decl members)))))))
-
 (defsyntax #export (defclass [name local-symbol^] [super local-symbol^] [interfaces (tuple^ (*^ local-symbol^))]
+                     [annotations annotations^]
                      [fields (*^ field-decl^)]
                      [methods (*^ method-def^)])
   (emit (@list (` (;_jvm_class (~ (text$ name)) (~ (text$ super))
                                [(~@ (map text$ interfaces))]
+                               [(~@ (map gen-annotation annotations))]
                                [(~@ (map gen-field-decl fields))]
                                [(~@ (map gen-method-def methods))])))))
 
+(defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))]
+                     [annotations annotations^]
+                     [members (*^ method-decl^)])
+  (emit (@list (` (;_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))]
+                                   [(~@ (map gen-annotation annotations))]
+                                   (~@ (map gen-method-decl members)))))))
+
 (defsyntax #export (object [super local-symbol^] [interfaces (tuple^ (*^ local-symbol^))]
                            [methods (*^ method-def^)])
   (emit (@list (` (;_jvm_anon-class (~ (text$ super))
diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux
index d9f3c6dc3..641dfba0d 100644
--- a/source/lux/meta/syntax.lux
+++ b/source/lux/meta/syntax.lux
@@ -12,7 +12,7 @@
               (data (bool #as b)
                     (char #as c)
                     (text #as t #open ("text:" Text/Monoid Text/Eq))
-                    (list #refer #all #open ("" List/Fold))
+                    (list #refer #all #open ("" List/Functor List/Fold))
                     (number (int #open ("i" Int/Ord))
                             (real #open ("r" Real/Eq))))))
 
@@ -28,6 +28,10 @@
     #;Nil                   #;Nil
     (#;Cons [[x y] pairs']) (@list& x y (join-pairs pairs'))))
 
+(def (pair->tuple [left right])
+  (-> (, AST AST) AST)
+  (tuple$ (@list left right)))
+
 ## [Types]
 (deftype #export (Parser a)
   (-> (List AST) (Maybe (, (List AST) a))))
@@ -163,8 +167,8 @@
      (All [a]
        (-> (Parser a) (Parser a)))
      (case tokens
-       (#;Cons [[_ (<tag> form)] tokens'])
-       (case (p form)
+       (#;Cons [[_ (<tag> members)] tokens'])
+       (case (p members)
          (#;Some [#;Nil x]) (#;Some [tokens' x])
          _                  #;None)
 
@@ -175,6 +179,18 @@
   [tuple^ #;TupleS]
   )
 
+(def #export (record^ p tokens)
+  (All [a]
+    (-> (Parser a) (Parser a)))
+  (case tokens
+    (#;Cons [[_ (#;RecordS pairs)] tokens'])
+    (case (p (map pair->tuple pairs))
+      (#;Some [#;Nil x]) (#;Some [tokens' x])
+      _                  #;None)
+
+    _
+    #;None))
+
 (def #export (?^ p tokens)
   (All [a]
     (-> (Parser a) (Parser (Maybe a))))