Permalink
Browse files

#453 reflection

Signed-off-by: Stuart Halloway <stu@thinkrelevance.com>
  • Loading branch information...
stuarthalloway committed Oct 14, 2010
1 parent 11aed89 commit 479bb230b410cd39f3ca94120729096a38c8df67
Showing with 411 additions and 0 deletions.
  1. +1 −0 build.xml
  2. +123 −0 src/clj/clojure/reflect.clj
  3. +253 −0 src/clj/clojure/reflect/java.clj
  4. +1 −0 test/clojure/test_clojure.clj
  5. +33 −0 test/clojure/test_clojure/reflect.clj
View
@@ -120,6 +120,7 @@
<arg value="clojure.java.browse-ui"/>
<arg value="clojure.string"/>
<arg value="clojure.data"/>
+ <arg value="clojure.reflect"/>
</java>
</target>
View
@@ -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")
@@ -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))))
+
@@ -65,6 +65,7 @@
:def
:keywords
:data
+ :reflect
])
(def test-namespaces
Oops, something went wrong.

0 comments on commit 479bb23

Please sign in to comment.