diff options
| -rw-r--r-- | build.xml | 1 | ||||
| -rw-r--r-- | src/clj/clojure/reflect.clj | 123 | ||||
| -rw-r--r-- | src/clj/clojure/reflect/java.clj | 253 | ||||
| -rw-r--r-- | test/clojure/test_clojure.clj | 1 | ||||
| -rw-r--r-- | test/clojure/test_clojure/reflect.clj | 33 |
5 files changed, 411 insertions, 0 deletions
@@ -120,6 +120,7 @@ <arg value="clojure.java.browse-ui"/> <arg value="clojure.string"/> <arg value="clojure.data"/> + <arg value="clojure.reflect"/> </java> </target> diff --git a/src/clj/clojure/reflect.clj b/src/clj/clojure/reflect.clj new file mode 100644 index 00000000..cf639568 --- /dev/null +++ b/src/clj/clojure/reflect.clj @@ -0,0 +1,123 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +(ns ^{:author "Stuart Halloway" + :added "1.3" + :doc "Reflection on Host Types +Alpha - subject to change. + +Two main entry points: + +* type-reflect reflects on something that implements TypeReference. +* reflect (for REPL use) reflects on the class of an instance, or + on a class if passed a class + +Key features: + +* Exposes the read side of reflection as pure data. Reflecting + on a type returns a map with keys :bases, :flags, and :members. + +* Canonicalizes class names as Clojure symbols. Types can extend + to the TypeReference protocol to indicate that they can be + unambiguously resolved as a type name. The canonical format + requires one non-Java-ish convention: array brackets are <> + instead of [] so they can be part of a Clojure symbol. + +* Pluggable Reflectors for different implementations. The default + JavaReflector is good when you have a class in hand, or use + the AsmReflector for \"hands off\" reflection without forcing + classes to load. + +Platform implementers must: + +* Create an implementation of Reflector. +* Create one or more implementations of TypeReference. +* def default-reflector to be an instance that satisfies Reflector."} + clojure.reflect + (:require [clojure.set :as set])) + +(defprotocol Reflector + "Protocol for reflection implementers." + (do-reflect [reflector typeref])) + +(defprotocol TypeReference + "A TypeReference can be unambiguously converted to a type name on + the host platform. + + All typerefs are normalized into symbols. If you need to + normalize a typeref yourself, call typesym." + (typename [o] "Returns Java name as returned by ASM getClassName, e.g. byte[], java.lang.String[]")) + +(declare default-reflector) + +(defn type-reflect + "Alpha - subject to change. + Reflect on a typeref, returning a map with :bases, :flags, and + :members. In the discussion below, names are always Clojure symbols. + + :bases a set of names of the type's bases + :flags a set of keywords naming the boolean attributes + of the type. + :members a set of the type's members. Each membrer is a map + and can be a constructor, method, or field. + + Keys common to all members: + :name name of the type + :declaring-class name of the declarer + :flags keyword naming boolean attributes of the member + + Keys specific to constructors: + :parameter-types vector of parameter type names + :exception-types vector of exception type names + + Key specific to methods: + :parameter-types vector of parameter type names + :exception-types vector of exception type names + :return-type return type name + + Keys specific to fields: + :type type name + + Options: + + :ancestors in addition to the keys described above, also + include an :ancestors key with the entire set of + ancestors, and add all ancestor members to + :members. + :reflector implementation to use. Defaults to JavaReflector, + AsmReflector is also an option." + {:added "1.3"} + [typeref & options] + (let [{:keys [ancestors reflector]} + (merge {:reflector default-reflector} + (apply hash-map options)) + refl (partial do-reflect reflector) + result (refl typeref)] + ;; could make simpler loop of two args: names an + (if ancestors + (let [make-ancestor-map (fn [names] + (zipmap names (map refl names)))] + (loop [reflections (make-ancestor-map (:bases result))] + (let [ancestors-visited (set (keys reflections)) + ancestors-to-visit (set/difference (set (mapcat :bases (vals reflections))) + ancestors-visited)] + (if (seq ancestors-to-visit) + (recur (merge reflections (make-ancestor-map ancestors-to-visit))) + (apply merge-with into result {:ancestors ancestors-visited} + (map #(select-keys % [:members]) (vals reflections))))))) + result))) + +(defn reflect + "Alpha - subject to change. + Reflect on the type of obj (or obj itself if obj is a class). + Return value and options are the same as for type-reflect. " + {:added "1.3"} + [obj & options] + (apply type-reflect (if (class? obj) obj (class obj)) options)) + +(load "reflect/java") diff --git a/src/clj/clojure/reflect/java.clj b/src/clj/clojure/reflect/java.clj new file mode 100644 index 00000000..9a030899 --- /dev/null +++ b/src/clj/clojure/reflect/java.clj @@ -0,0 +1,253 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +;; Java-specific parts of clojure.reflect +(in-ns 'clojure.reflect) + +(require '[clojure.set :as set] + '[clojure.string :as str]) +(import '[clojure.asm ClassReader ClassVisitor Type] + '[java.lang.reflect Modifier] + java.io.InputStream) + +(extend-protocol TypeReference + clojure.lang.Symbol + (typename [s] (str/replace (str s) "<>" "[]")) + + Class + ;; neither .getName not .getSimpleName returns the right thing, so best to delegate to Type + (typename + [c] + (typename (Type/getType c))) + + Type + (typename + [t] + (-> (.getClassName t)))) + +(defn- typesym + "Given a typeref, create a legal Clojure symbol version of the + type's name." + [t] + (-> (typename t) + (str/replace "[]" "<>") + (symbol))) + +(defn- resource-name + "Given a typeref, return implied resource name. Used by Reflectors + such as ASM that need to find and read classbytes from files." + [typeref] + (-> (typename typeref) + (str/replace "." "/") + (str ".class"))) + +(defn- access-flag + [[name flag & contexts]] + {:name name :flag flag :contexts (set (map keyword contexts))}) + +(defn- field-descriptor->class-symbol + "Convert a Java field descriptor to a Clojure class symbol. Field + descriptors are described in section 4.3.2 of the JVM spec, 2nd ed.: + http://java.sun.com/docs/books/jvms/second_edition/html/ClassFile.doc.html#14152" + [^String d] + {:pre [(string? d)]} + (typesym (Type/getType d))) + +(defn- internal-name->class-symbol + "Convert a Java internal name to a Clojure class symbol. Internal + names uses slashes instead of dots, e.g. java/lang/String. See + Section 4.2 of the JVM spec, 2nd ed.: + + http://java.sun.com/docs/books/jvms/second_edition/html/ClassFile.doc.html#14757" + [d] + {:pre [(string? d)]} + (typesym (Type/getObjectType d))) + +(def ^{:doc "The Java access bitflags, along with their friendly names and +the kinds of objects to which they can apply."} + flag-descriptors + (vec + (map access-flag + [[:public 0x0001 :class :field :method] + [:private 0x002 :class :field :method] + [:protected 0x0004 :class :field :method] + [:static 0x0008 :field :method] + [:final 0x0010 :class :field :method] + ;; :super is ancient history and is unfindable (?) by + ;; reflection. skip it + #_[:super 0x0020 :class] + [:synchronized 0x0020 :method] + [:volatile 0x0040 :field] + [:bridge 0x0040 :method] + [:varargs 0x0080 :method] + [:transient 0x0080 :field] + [:native 0x0100 :method] + [:interface 0x0200 :class] + [:abstract 0x0400 :class :method] + [:strict 0x0800 :method] + [:synthetic 0x1000 :class :field :method] + [:annotation 0x2000 :class] + [:enum 0x4000 :class :field :inner]]))) + +(defn- parse-flags + "Convert reflection bitflags into a set of keywords." + [flags context] + (reduce + (fn [result fd] + (if (and (get (:contexts fd) context) + (not (zero? (bit-and flags (:flag fd))))) + (conj result (:name fd)) + result)) + #{} + flag-descriptors)) + +(defrecord Constructor + [name declaring-class parameter-types exception-types flags]) + +(defn- constructor->map + [^java.lang.reflect.Constructor constructor] + (Constructor. + (symbol (.getName constructor)) + (typesym (.getDeclaringClass constructor)) + (vec (map typesym (.getParameterTypes constructor))) + (vec (map typesym (.getExceptionTypes constructor))) + (parse-flags (.getModifiers constructor) :method))) + +(defn- declared-constructors + "Return a set of the declared constructors of class as a Clojure map." + [^Class cls] + (set (map + constructor->map + (.getDeclaredConstructors cls)))) + +(defrecord Method + [name return-type declaring-class parameter-types exception-types flags]) + +(defn- method->map + [^java.lang.reflect.Method method] + (Method. + (symbol (.getName method)) + (typesym (.getReturnType method)) + (typesym (.getDeclaringClass method)) + (vec (map typesym (.getParameterTypes method))) + (vec (map typesym (.getExceptionTypes method))) + (parse-flags (.getModifiers method) :method))) + +(defn- declared-methods + "Return a set of the declared constructors of class as a Clojure map." + [^Class cls] + (set (map + method->map + (.getDeclaredMethods cls)))) + +(defrecord Field + [name type declaring-class flags]) + +(defn- field->map + [^java.lang.reflect.Field field] + (Field. + (symbol (.getName field)) + (typesym (.getType field)) + (typesym (.getDeclaringClass field)) + (parse-flags (.getModifiers field) :field))) + +(defn- declared-fields + "Return a set of the declared fields of class as a Clojure map." + [^Class cls] + (set (map + field->map + (.getDeclaredFields cls)))) + +(deftype JavaReflector [classloader] + Reflector + (do-reflect [_ typeref] + (let [cls (Class/forName (typename typeref) false classloader)] + {:bases (not-empty (set (map typesym (bases cls)))) + :flags (parse-flags (.getModifiers cls) :class) + :members (set/union (declared-fields cls) + (declared-methods cls) + (declared-constructors cls))}))) + +(def ^:private default-reflector + (JavaReflector. (.getContextClassLoader (Thread/currentThread)))) + +(defn- parse-method-descriptor + [^String md] + {:parameter-types (vec (map typesym (Type/getArgumentTypes md))) + :return-type (typesym (Type/getReturnType md))}) + +(defprotocol ClassResolver + (^InputStream resolve-class [this name] + "Given a class name, return that typeref's class bytes as an InputStream.")) + +(extend-protocol ClassResolver + clojure.lang.Fn + (resolve-class [this typeref] (this typeref)) + + ClassLoader + (resolve-class [this typeref] + (.getResourceAsStream this (resource-name typeref)))) + +(deftype AsmReflector [class-resolver] + Reflector + (do-reflect [_ typeref] + (with-open [is (resolve-class class-resolver typeref)] + (let [class-symbol (typesym typeref) + r (ClassReader. is) + result (atom {:bases #{} :flags #{} :members #{}})] + (.accept + r + (reify + ClassVisitor + (visit [_ version access name signature superName interfaces] + (let [flags (parse-flags access :class) + ;; ignore java.lang.Object on interfaces to match reflection + superName (if (and (flags :interface) + (= superName "java/lang/Object")) + nil + superName) + bases (->> (cons superName interfaces) + (remove nil?) + (map internal-name->class-symbol) + (map symbol) + (set) + (not-empty))] + (swap! result merge {:bases bases + :flags flags}))) + (visitSource [_ name debug]) + (visitInnerClass [_ name outerName innerName access]) + (visitField [_ access name desc signature value] + (swap! result update-in [:members] (fnil conj #{}) + (Field. (symbol name) + (field-descriptor->class-symbol desc) + class-symbol + (parse-flags access :field))) + nil) + (visitMethod [_ access name desc signature exceptions] + (when-not (= name "<clinit>") + (let [constructor? (= name "<init>")] + (swap! result update-in [:members] (fnil conj #{}) + (let [{:keys [parameter-types return-type]} (parse-method-descriptor desc) + flags (parse-flags access :method)] + (if constructor? + (Constructor. class-symbol + class-symbol + parameter-types + (vec (map internal-name->class-symbol exceptions)) + flags) + (Method. (symbol name) + return-type + class-symbol + parameter-types + (vec (map internal-name->class-symbol exceptions)) + flags)))))) + nil) + (visitEnd [_]) + ) 0) + @result)))) + diff --git a/test/clojure/test_clojure.clj b/test/clojure/test_clojure.clj index a82ed0ae..2f3fc4f8 100644 --- a/test/clojure/test_clojure.clj +++ b/test/clojure/test_clojure.clj @@ -65,6 +65,7 @@ :def :keywords :data + :reflect ]) (def test-namespaces diff --git a/test/clojure/test_clojure/reflect.clj b/test/clojure/test_clojure/reflect.clj new file mode 100644 index 00000000..416092ac --- /dev/null +++ b/test/clojure/test_clojure/reflect.clj @@ -0,0 +1,33 @@ +(ns clojure.test-clojure.reflect + (:use clojure.data [clojure.reflect :as reflect] clojure.test clojure.pprint) + (:import [clojure.reflect AsmReflector JavaReflector])) + +(defn nodiff + [x y] + (let [[x-only y-only common] (diff x y)] + (when (or x-only y-only) + (is false (with-out-str (pprint {:x-only x-only + :y-only y-only + :common common})))))) + +(deftest compare-reflect-and-asm + (let [cl (.getContextClassLoader (Thread/currentThread)) + asm-reflector (AsmReflector. cl) + java-reflector (JavaReflector. cl)] + (doseq [classname '[java.lang.Runnable + java.lang.Object + java.io.FileInputStream + clojure.lang.Compiler + clojure.lang.PersistentVector]] + (nodiff (type-reflect classname :reflector asm-reflector) + (type-reflect classname :reflector java-reflector))))) + +(deftest field-descriptor->class-symbol-test + (are [s d] (= s (@#'reflect/field-descriptor->class-symbol d)) + 'clojure.asm.Type<><> "[[Lclojure/asm/Type;" + 'int "I" + 'java.lang.Object "Ljava.lang.Object;")) + +(deftest internal-name->class-symbol-test + (are [s n] (= s (@#'reflect/internal-name->class-symbol n)) + 'java.lang.Exception "java/lang/Exception")) |