summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/clj/clojure/core.clj51
-rw-r--r--src/clj/clojure/genclass.clj1
-rw-r--r--src/jvm/clojure/lang/Compiler.java35
3 files changed, 80 insertions, 7 deletions
diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj
index 7e22d944..b2b08661 100644
--- a/src/clj/clojure/core.clj
+++ b/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"
diff --git a/src/clj/clojure/genclass.clj b/src/clj/clojure/genclass.clj
index de8ae088..4aeb4493 100644
--- a/src/clj/clojure/genclass.clj
+++ b/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)
diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java
index 3febaee6..ffb5c928 100644
--- a/src/jvm/clojure/lang/Compiler.java
+++ b/src/jvm/clojure/lang/Compiler.java
@@ -226,6 +226,9 @@ static final public Var COMPILE_FILES = Var.intern(Namespace.findOrCreate(Symbol
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 @@ static public class ObjExpr implements Expr{
"*E";
cv.visitSource(source, smap);
}
-
+ addAnnotation(cv, classMeta);
//static fields for constants
for(int i = 0; i < constants.count(); i++)
{
@@ -3434,14 +3438,16 @@ static public class ObjExpr implements Expr{
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 @@ static public class NewInstanceExpr extends ObjExpr{
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 @@ static public class NewInstanceExpr extends ObjExpr{
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 @@ static public class NewInstanceExpr extends ObjExpr{
}
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 @@ public static class NewInstanceMethod extends ObjMethod{
}
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 static class NewInstanceMethod extends ObjMethod{
null,
extypes,
cv);
+ addAnnotation(gen,methodMeta);
gen.visitCode();
Label loopLabel = gen.mark();
gen.visitLineNumber(line, loopLabel);
generated by cgit v1.2.3-18-g5258 (git 2.32.0) at 2025-07-09 22:31:42 +0000