initial annotation support, for definterface/type/record types (put i…

…n metadata on type name), deftype/record fields (in metadata on field names), and deftype/record methods (in metadata on method name)

src/clj/clojure/core.clj

@@ -3803,6 +3803,57 @@
   "Returns true if x is an instance of Class"
   [x] (instance? Class x))
 
+(defn- is-annotation? [c]
+  (and (class? c)
+       (.isAssignableFrom java.lang.annotation.Annotation c)))
+
+(defn- is-runtime-annotation? [#^Class c]
+  (boolean 
+   (and (is-annotation? c)
+        (when-let [#^java.lang.annotation.Retention r 
+                   (.getAnnotation c java.lang.annotation.Retention)] 
+          (= (.value r) java.lang.annotation.RetentionPolicy/RUNTIME)))))
+
+(defn- descriptor [#^Class c] (clojure.asm.Type/getDescriptor c))
+
+(declare process-annotation)
+(defn- add-annotation [#^clojure.asm.AnnotationVisitor av name v]
+  (cond
+   (vector? v) (let [avec (.visitArray av name)]
+                 (doseq [vval v]
+                   (add-annotation avec "value" vval))
+                 (.visitEnd avec))
+   (symbol? v) (let [ev (eval v)]
+                 (cond 
+                  (instance? java.lang.Enum ev)
+                  (.visitEnum av name (descriptor (class ev)) (str ev))
+                  (class? ev) (.visit av name (clojure.asm.Type/getType ev))
+                  :else (throw (IllegalArgumentException. 
+                                (str "Unsupported annotation value: " v " of class " (class ev))))))
+   (seq? v) (let [[nested nv] v
+                  c (resolve nested)
+                  nav (.visitAnnotation av name (descriptor c))]
+              (process-annotation nav nv)
+              (.visitEnd nav))
+   :else (.visit av name v)))
+
+(defn- process-annotation [av v]
+  (if (map? v) 
+    (doseq [[k v] v]
+      (add-annotation av (name k) v))
+    (add-annotation av "value" v)))
+
+(defn- add-annotations [visitor m]
+  (doseq [[k v] m]
+    (when (symbol? k)
+      (when-let [c (resolve k)]
+        (when (is-annotation? c)
+          ;this is known duck/reflective as no common base of ASM Visitors
+          (let [av (.visitAnnotation visitor (descriptor c) 
+                                     (is-runtime-annotation? c))]
+            (process-annotation av v)
+            (.visitEnd av)))))))
+
 (defn alter-var-root
   "Atomically alters the root binding of var v by applying f to its
   current value plus any args"

src/clj/clojure/genclass.clj

@@ -621,6 +621,7 @@
        iname nil "java/lang/Object"
        (when (seq extends)
          (into-array (map #(.getInternalName (asm-type %)) extends))))
+    (add-annotations cv (meta name))
     (doseq [[mname pclasses rclass] methods]
       (. cv visitMethod (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT)
          (str mname)

src/jvm/clojure/lang/Compiler.java

@@ -226,6 +226,9 @@ public class Compiler implements Opcodes{
 static final public Var INSTANCE = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")),
                                             Symbol.create("instance?"));
 
+static final public Var ADD_ANNOTATIONS = Var.intern(Namespace.findOrCreate(Symbol.create("clojure.core")),
+                                            Symbol.create("add-annotations"));
+
 //Integer
 static final public Var LINE = Var.create(0);
 
@@ -3208,6 +3211,7 @@ static public class ObjExpr implements Expr{
 	Object src;
 
 	final static Method voidctor = Method.getMethod("void <init>()");
+	protected IPersistentMap classMeta;
 
 	public final String name(){
 		return name;
@@ -3350,7 +3354,7 @@ void compile(String superName, String[] interfaceNames, boolean oneTimeUse) thro
 			              "*E";
 			cv.visitSource(source, smap);
 			}
-
+		addAnnotation(cv, classMeta);
 		//static fields for constants
 		for(int i = 0; i < constants.count(); i++)
 			{
@@ -3434,14 +3438,16 @@ void compile(String superName, String[] interfaceNames, boolean oneTimeUse) thro
 				int access = isVolatile(lb) ? ACC_VOLATILE :
 				             isMutable(lb) ? 0 :
 				             (ACC_PUBLIC + ACC_FINAL);
+				FieldVisitor fv;
 				if(lb.getPrimitiveType() != null)
-					cv.visitField(access
+					fv = cv.visitField(access
 							, lb.name, Type.getType(lb.getPrimitiveType()).getDescriptor(),
 								  null, null);
 				else
 				//todo - when closed-overs are fields, use more specific types here and in ctor and emitLocal?
-					cv.visitField(access
+					fv = cv.visitField(access
 							, lb.name, OBJECT_TYPE.getDescriptor(), null, null);
+				addAnnotation(fv, RT.meta(lb.sym));
 				}
 			else
 				{
@@ -4336,6 +4342,7 @@ abstract public static class ObjMethod{
 	int maxLocal = 0;
 	int line;
 	PersistentHashSet localsUsedInCatchFinally = PersistentHashSet.EMPTY;
+	protected IPersistentMap methodMeta;
 
 	public final IPersistentMap locals(){
 		return locals;
@@ -5432,6 +5439,17 @@ static PathNode commonPath(PathNode n1, PathNode n2){
     return (PathNode) RT.first(xp);
 }
 
+static void addAnnotation(Object visitor, IPersistentMap meta){
+	try{
+	if(ADD_ANNOTATIONS.isBound())
+		 ADD_ANNOTATIONS.invoke(visitor, meta);
+	}
+	catch (Exception e)
+		{
+		throw new RuntimeException(e);
+		}
+}
+
 private static Expr analyzeSymbol(Symbol sym) throws Exception{
 	Symbol tag = tagOf(sym);
 	if(sym.ns == null) //ns-qualified syms are always Vars
@@ -5949,7 +5967,7 @@ public Expr parse(C context, final Object frm) throws Exception{
 			rform = RT.next(rform);
 			String tagname = ((Symbol) rform.first()).toString();
 			rform = rform.next();
-			String classname = ((Symbol) rform.first()).toString();
+			Symbol classname = (Symbol) rform.first();
 			rform = rform.next();
 			IPersistentVector fields = (IPersistentVector) rform.first();
 			rform = rform.next();
@@ -5985,7 +6003,7 @@ public Expr parse(C context, Object frm) throws Exception{
 		rform = RT.next(rform);
 
 
-		ObjExpr ret = build(interfaces, null, null, classname, classname, null, rform, frm);
+		ObjExpr ret = build(interfaces, null, null, classname, Symbol.intern(classname), null, rform, frm);
 		if(frm instanceof IObj && ((IObj) frm).meta() != null)
 			return new MetaExpr(ret, (MapExpr) MapExpr
 					.parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) frm).meta()));
@@ -5995,12 +6013,13 @@ public Expr parse(C context, Object frm) throws Exception{
 	}
 
 	static ObjExpr build(IPersistentVector interfaceSyms, IPersistentVector fieldSyms, Symbol thisSym,
-	                     String tagName, String className,
+	                     String tagName, Symbol className,
 	                  Symbol typeTag, ISeq methodForms, Object frm) throws Exception{
 		NewInstanceExpr ret = new NewInstanceExpr(null);
 
 		ret.src = frm;
-		ret.name = className;
+		ret.name = className.toString();
+		ret.classMeta = RT.meta(className);
 		ret.internalName = ret.name.replace('.', '/');
 		ret.objtype = Type.getObjectType(ret.internalName);
 
@@ -6451,6 +6470,7 @@ static NewInstanceMethod parse(ObjExpr objx, ISeq form, Symbol thistag,
 				}
 			LOOP_LOCALS.set(argLocals);
 			method.name = name.name;
+			method.methodMeta = RT.meta(name);
 			method.argLocals = argLocals;
 			method.body = (new BodyExpr.Parser()).parse(C.RETURN, body);
 			return method;
@@ -6500,6 +6520,7 @@ public void emit(ObjExpr obj, ClassVisitor cv){
 		                                            null,
 		                                            extypes,
 		                                            cv);
+		addAnnotation(gen,methodMeta);
 		gen.visitCode();
 		Label loopLabel = gen.mark();
 		gen.visitLineNumber(line, loopLabel);