Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Removing asm

  • Loading branch information...
commit c30b1b9bea585ad097cd46458fb39c1e5718a830 1 parent f5e55a1
Aaron Bedra authored May 10, 2011
269  src/mycroft/asm.clj
... ...
@@ -1,269 +0,0 @@
1  
-(ns mycroft.asm
2  
-  (:require [clojure.set :as set])
3  
-  (:require [clojure.string :as str])
4  
-  (:import [clojure.asm ClassReader ClassVisitor Type]
5  
-           [java.lang.reflect Modifier]))
6  
-
7  
-(defprotocol AsmHelper
8  
-  (classname [o]))
9  
-
10  
-(extend-protocol AsmHelper
11  
-  Class
12  
-  (classname
13  
-   [c]
14  
-   (-> (.getName c)
15  
-       (symbol)))
16  
-  
17  
-  Type
18  
-  (classname
19  
-   [t]
20  
-   (-> (.getClassName t)
21  
-       (symbol))))
22  
-
23  
-(defn access-flag
24  
-  [[name flag & contexts]]
25  
-  {:name name :flag flag :contexts (set (map keyword contexts))})
26  
-
27  
-(def flag-descriptors
28  
-  (vec
29  
-   (map access-flag
30  
-        [[:ACC_PUBLIC 0x0001 :class :field ::method]
31  
-         [:ACC_PRIVATE 0x002 :class :field ::method]
32  
-         [:ACC_PRIVATE 0x0002  :class :field :method]
33  
-         [:ACC_PROTECTED 0x0004  :class :field :method]
34  
-         [:ACC_STATIC 0x0008  :field :method]
35  
-         [:ACC_FINAL 0x0010  :class :field :method]
36  
-         ;; ACC_SUPER is ancient history and is unfindable (?) by
37  
-         ;; reflection. skip it
38  
-         #_[:ACC_SUPER 0x0020  :class]        
39  
-         [:ACC_SYNCHRONIZED 0x0020  :method]
40  
-         [:ACC_VOLATILE 0x0040  :field]
41  
-         [:ACC_BRIDGE 0x0040  :method]
42  
-         [:ACC_VARARGS 0x0080  :method]
43  
-         [:ACC_TRANSIENT 0x0080  :field]
44  
-         [:ACC_NATIVE 0x0100  :method]
45  
-         [:ACC_INTERFACE 0x0200  :class]
46  
-         [:ACC_ABSTRACT 0x0400  :class :method]
47  
-         [:ACC_STRICT 0x0800  :method]
48  
-         [:ACC_SYNTHETIC 0x1000  :class :field :method]
49  
-         [:ACC_ANNOTATION 0x2000  :class]
50  
-         [:ACC_ENUM 0x4000  :class :field :inner]])))
51  
-
52  
-(defn parse-flags
53  
-  [flags context]
54  
-  (reduce
55  
-   (fn [result fd]
56  
-     (if (and (get (:contexts fd) context)
57  
-              (not (zero? (bit-and flags (:flag fd)))))
58  
-       (conj result (:name fd))
59  
-       result))
60  
-   #{}
61  
-   flag-descriptors))
62  
-
63  
-(defrecord Constructor
64  
-  [name declaring-class parameter-types exceptions attributes])
65  
-
66  
-(defn constructor?
67  
-  "Is x an instance of mycroft.reflect/Constructor?"
68  
-  [o]
69  
-  (instance? Constructor o))
70  
-
71  
-(defn constructor->map
72  
-  [^java.lang.reflect.Constructor constructor]
73  
-  (Constructor.
74  
-   (symbol (.getName constructor))
75  
-   (classname (.getDeclaringClass constructor))
76  
-   (vec (map classname (.getParameterTypes constructor)))
77  
-   (vec (map classname (.getExceptionTypes constructor)))
78  
-   (parse-flags (.getModifiers constructor) :method)))
79  
-
80  
-(defn declared-constructors
81  
-  "Return a set of the declared constructors of class as a Clojure map."
82  
-  [^Class cls]
83  
-  (set (map
84  
-        constructor->map
85  
-        (.getDeclaredConstructors cls))))
86  
-
87  
-(defrecord Method
88  
-  [name return-type declaring-class parameter-types exception-types attributes])
89  
-
90  
-(defn method?
91  
-  "Is x an instance of mycroft.reflect/Method?"
92  
-  [x]
93  
-  (instance? Method x))
94  
-
95  
-(defn method->map
96  
-  [^java.lang.reflect.Method method]
97  
-  (Method.
98  
-   (symbol (.getName method))
99  
-   (classname (.getReturnType method))
100  
-   (classname (.getDeclaringClass method))
101  
-   (vec (map classname (.getParameterTypes method)))
102  
-   (vec (map classname (.getExceptionTypes method)))
103  
-   (parse-flags (.getModifiers method) :method)))
104  
-
105  
-(defn declared-methods
106  
-  "Return a set of the declared constructors of class as a Clojure map."
107  
-  [^Class cls]
108  
-  (set (map
109  
-        method->map
110  
-        (.getDeclaredMethods cls))))
111  
-
112  
-(defrecord Field
113  
-  [name type declaring-class attributes])
114  
-
115  
-(defn field?
116  
-  "Is x an instance of mycroft.reflect/Field?"
117  
-  [x]
118  
-  (instance? Field x))
119  
-
120  
-(defn field->map
121  
-  [^java.lang.reflect.Field field]
122  
-  (Field.
123  
-   (symbol (.getName field))
124  
-   (classname (.getType field))
125  
-   (classname (.getDeclaringClass field))
126  
-   (parse-flags (.getModifiers field) :field)))
127  
-
128  
-(defn declared-fields
129  
-  "Return a set of the declared fields of class as a Clojure map."
130  
-  [^Class cls]
131  
-  (set (map
132  
-        field->map
133  
-        (.getDeclaredFields cls))))
134  
-
135  
-(def template {:bases #{} :attributes #{} :fields #{} :methods #{} :constructors #{}})
136  
-
137  
-(defn java-reflect
138  
-  [classname]
139  
-  (let [cls (Class/forName (str classname))] ;; TODO use context version
140  
-    {:bases (set (bases cls))
141  
-     :attributes (parse-flags (.getModifiers cls) :class)
142  
-     :fields (declared-fields cls)
143  
-     :methods (declared-methods cls)
144  
-     :constructors (declared-constructors cls)}))
145  
-
146  
-(defn classname->filename
147  
-  [classname]
148  
-  (-> (str classname)
149  
-      (str/replace "." "/")
150  
-      (str ".class")))
151  
-
152  
-(defn descriptor->classname
153  
-  [d]
154  
-  {:pre [(string? d)]}
155  
-  (classname (Type/getType d)))
156  
-
157  
-(defn internal-name->classname
158  
-  [d]
159  
-  {:pre [(string? d)]}
160  
-  (classname (Type/getObjectType d)))
161  
-
162  
-(def add-to-set (fnil conj #{}))
163  
-
164  
-(defn parse-method-descriptor
165  
-  [md]
166  
-  {:parameter-types (vec (map classname (Type/getArgumentTypes md)))
167  
-   :return-type (classname (Type/getReturnType md))})
168  
-
169  
-(defn asm-reflect
170  
-  "Uses context class loader to find class, but does not load it."
171  
-  [classname]
172  
-  (let [is (.. (Thread/currentThread)
173  
-              getContextClassLoader
174  
-              (getResourceAsStream (classname->filename classname)))
175  
-        r (ClassReader. is)
176  
-        result (atom template)]
177  
-    (.accept
178  
-     r
179  
-     (reify
180  
-      ClassVisitor
181  
-      (visit [_ version access name signature superName interfaces]
182  
-             (swap! result merge {:bases (set (map symbol interfaces))
183  
-                                  :attributes (parse-flags access :class)}))
184  
-      (visitSource [_ name debug])
185  
-      (visitInnerClass [_ name outerName innerName access])
186  
-      (visitField [_ access name desc signature value]
187  
-                  (swap! result update-in [:fields] add-to-set
188  
-                         (Field. (symbol name)
189  
-                                 (descriptor->classname desc)
190  
-                                 classname
191  
-                                 (parse-flags access :field)))
192  
-                  nil)
193  
-      (visitMethod [_ access name desc signature exceptions]
194  
-                   (when-not (= name "<clinit>")
195  
-                     (let [constructor? (= name "<init>")]
196  
-                       (swap! result update-in [(if constructor? :constructors :methods)] add-to-set
197  
-                              (let [{:keys [parameter-types return-type]} (parse-method-descriptor desc)
198  
-                                    attributes (parse-flags access :method)]
199  
-                                (if constructor?
200  
-                                  (Constructor. classname
201  
-                                                classname
202  
-                                                parameter-types
203  
-                                                (vec (map internal-name->classname exceptions))
204  
-                                                attributes)
205  
-                                  (Method. (symbol name)
206  
-                                           return-type
207  
-                                           classname
208  
-                                           parameter-types
209  
-                                           (vec (map internal-name->classname exceptions))
210  
-                                           attributes))))))
211  
-                   nil)
212  
-      (visitEnd [_])
213  
-      ) 0)
214  
-    @result))
215  
-
216  
-(defprotocol Diff
217  
-  (diff [x y]))
218  
-
219  
-(extend-protocol Diff
220  
-  java.lang.Object
221  
-  (diff [x y]
222  
-        (if (= x y)
223  
-          [nil nil x]
224  
-          [x y nil]))
225  
-  
226  
-  java.util.Set
227  
-  (diff [x y]
228  
-        [(not-empty (set/difference x y))
229  
-         (not-empty (set/difference y x))
230  
-         (not-empty (set/intersection x y))])
231  
-  
232  
-  java.util.Collection
233  
-  (diff [x y]
234  
-        (let [xc (count x)
235  
-              yc (count y)
236  
-              shared (min xc yc)
237  
-              biggest (if (< xc yc) y x)]
238  
-          (let [subdiffs (map
239  
-                          (fn [k] (map #(when % [k %]) (diff (nth x k) (nth y k))))
240  
-                          (range shared))] ;; slow, fix later
241  
-            #_(pprint {:subdiffs subdiffs})
242  
-            (reduce
243  
-             (fn [diff1 diff2]
244  
-                (map (fn [d1 [k v]] (if k (assoc d1 k v) d1)) diff1 diff2))
245  
-             [(into (vec (repeat shared nil)) (when (> xc yc) (subvec x yc)))
246  
-              (into (vec (repeat shared nil)) (when (> yc xc) (subvec y xc)))
247  
-              (vec (repeat shared nil))] 
248  
-             subdiffs))))
249  
-  
250  
-  java.util.Map
251  
-  (diff [x y]
252  
-        (let [xkeys (set (keys x))
253  
-              ykeys (set (keys y))
254  
-              [only-x only-y shared] (diff xkeys ykeys)]
255  
-          #_(pprint {:xkeys xkeys
256  
-                   :ykeys ykeys
257  
-                   :only-x only-x
258  
-                   :only-y only-y})
259  
-          (let [subdiffs (map
260  
-                          (fn [k] (map #(when % {k %}) (diff (get x k) (get y k))))
261  
-                          shared)]
262  
-            #_(pprint {:subdiffs subdiffs})
263  
-            (reduce
264  
-             (fn [diff1 diff2]
265  
-               (map merge diff1 diff2))
266  
-             [(not-empty (select-keys x only-x))
267  
-              (not-empty (select-keys y only-y))
268  
-              nil]
269  
-             subdiffs)))))
31  test/mycroft/asm_test.clj
... ...
@@ -1,31 +0,0 @@
1  
-(ns mycroft.asm-test
2  
-  (:use mycroft.asm clojure.test clojure.pprint))
3  
-
4  
-(defn compare-reflections
5  
-  [r1 r2]
6  
-  (is (= (:bases r1) (:bases r2)))
7  
-  (is (= (:fields r1) (:fields r2)))
8  
-  (is (= (:constructors r1) (:constructors r2)))
9  
-  (is (= (:methods r1) (:methods r2))))
10  
-
11  
-(defn nodiff
12  
-  [x y]
13  
-  (let [[x-only y-only common] (diff x y)]
14  
-    (when (or x-only y-only)
15  
-      (is false (with-out-str (pprint {:x-only x-only
16  
-                                       :y-only y-only
17  
-                                       :common common}))))))
18  
-
19  
-(deftest compare-reflect-and-asm
20  
-  (doseq [classname '[java.lang.Runnable
21  
-                      java.lang.Object
22  
-                      #_java.io.FileInputStream]]
23  
-    (nodiff (asm-reflect classname) (java-reflect classname))))
24  
-
25  
-(deftest diff-test
26  
-  (are [d x y] (= d (diff x y))
27  
-       [1 2 nil] 1 2
28  
-       [#{:a} #{:b} #{:c :d}] #{:a :c :d} #{:b :c :d}
29  
-       [nil nil {:a 1}] {:a 1} {:a 1}
30  
-       [{:a #{2}} {:a #{4}} {:a #{3}}] {:a #{2 3}} {:a #{3 4}}))
31  
-

0 notes on commit c30b1b9

Please sign in to comment.
Something went wrong with that request. Please try again.