1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
; Copyright (c) Chris Houser, July 2008. 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.
; Functions for generating interface classes, which can then be loaded
; or saved to a .class file.
(ns clojure.contrib.gen-interface
(:refer-clojure :exclude (gen-interface))
(:import (clojure.asm ClassWriter Opcodes Type)
(java.io File FileOutputStream IOException)))
(defn- asm-type
"Returns an asm Type object for c, which may be a primitive class
(such as Integer/TYPE), any other class (such as Double), or a
fully-qualified class name given as a string or symbol
(such as 'java.lang.String)"
[c]
(if (instance? Class c)
(Type/getType c)
(Type/getObjectType (.replace (str c) "." "/"))))
(defn- iname
"Returns the internal name of given class or class name. Cannot be
used for primitive types."
[c] (.getInternalName (asm-type c)))
(defstruct #^{:private true} spec-map :cname :iname :extends :methods)
(defn- make-spec
"Returns an interface spec object based on the given description.
cname is the fully-qualified classname (string or symbol) of the
interface to be created.
extends is a collection of classes this interface will extend (each
may be a string, symbol, or a class). These are followed by the
method descriptions, each of which is a vector: [methodName,
arg types, return type]"
[cname extends & methods]
(struct spec-map
(str cname)
(iname cname)
(set (map iname extends))
(set (map (fn [[mname pclasses rclass]]
[(str mname)
(map asm-type pclasses)
(asm-type rclass)])
methods))))
(defn- spec-from-class
"Returns an interface spec object based on the given class."
[c]
(struct spec-map
(.getName c)
(iname c)
(set (map iname (.getInterfaces c)))
(set (map (fn [m]
[(.getName m)
(map asm-type (.getParameterTypes m))
(asm-type (.getReturnType m))])
(.getDeclaredMethods c)))))
(def #^{:private true} object-iname (iname Object))
(defn- spec-bytecode
"Uses the given interface spec object (such as created by make-spec)
to generate a Java interface. Returns a byte array containing the
Java bytecode for the interface. You'll almost always want to use
gen-interface instead."
[{:keys [iname extends methods]}]
(let [cv (ClassWriter. ClassWriter/COMPUTE_MAXS)]
(. cv visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT
Opcodes/ACC_INTERFACE)
iname nil object-iname
(when (seq extends)
(into-array extends)))
(doseq [[mname pclasses rclass] methods]
(. cv visitMethod (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT)
mname
(Type/getMethodDescriptor rclass (if pclasses
(into-array pclasses)
(make-array Type 0)))
nil nil))
(. cv visitEnd)
(. cv toByteArray)))
(defn- load-interface-bytecode
[{:keys [cname] :as spec} bytecode]
(let [old-class (try (Class/forName cname) (catch Throwable t nil))]
(if old-class
(when-not (= spec (spec-from-class old-class))
(throw (Exception. (str "A different class named "
cname " already loaded"))))
(.. clojure.lang.RT
ROOT_CLASSLOADER (defineClass cname bytecode)))))
(defn- save-interface-bytecode
[path {:keys [cname]} bytecode]
(let [file (File. path (str (.replace cname \. File/separatorChar)
".class"))]
(try
(.createNewFile file)
(catch IOException e
(throw (Exception. (str "Failed to create " file) e))))
(with-open [f (FileOutputStream. file)]
(.write f bytecode))))
(defn gen-and-load-interface
"Uses the given interface description to generate a Java interface
and immediately load it. make-spec-args is the interface
description as documented in make-spec. This function is not
generally useful since you'll usually want a .class file in order
to write Java code that uses the generated interface -- see
gen-interface instead."
[& make-spec-args]
(let [spec (apply make-spec make-spec-args)]
(load-interface-bytecode spec (spec-bytecode spec))))
(defn gen-and-save-interface
"Uses the given interface description to generate a Java interface
and save it to a .class file. make-spec-args is the interface
description as documented in make-spec. The .class file will be
written into a sub-directory of the given base path (note that the
appropriate sub-directories under path must already exist or this
will throw an exception). If you intend to use this interface
immediately (for example to refer to it in a later gen-interface or
gen-class call), you'll want to use gen-interface instead."
[path & make-spec-args]
(let [spec (apply make-spec make-spec-args)]
(save-interface-bytecode path spec (spec-bytecode spec))))
(defn gen-save-and-interface
"Uses the given interface description to generate a Java interface,
save it to a .class file, and immediately load it so it's ready
for use by subsequent gen-interface or gen-class calls. The .class
file will be written into a sub-directory of the given base path.
make-spec-args is the interface description as documented in
make-spec."
[path & make-spec-args]
(let [spec (apply make-spec make-spec-args)
bytecode (spec-bytecode spec)]
(load-interface-bytecode spec bytecode)
(save-interface-bytecode path spec bytecode)))
(comment
(gen-interface "/tmp" 'net.n01se.Foo [Appendable]
['foo [] Integer]
['bar [Integer/TYPE String] Double])
; re-genning an identical interface doesn't try to load anything
(gen-interface "/tmp" 'net.n01se.Foo [Appendable]
['foo [] Integer]
['bar [Integer/TYPE String] Double])
; re-genning a different interface throws an exception
;(gen-interface "/tmp" 'net.n01se.Foo [Appendable]
; ['foo [] Integer])
; gen-and-save-interface is used directly in this example because I
; want to refer to a class that's not yet defined in this runtime
; (Other). This is possible because I specify the class as a quoted
; symbol, and then don't load it -- but this isn't really recommended.
; Instead, why not make sure Other is defined -- then you can use
; gen-interface.
(gen-and-save-interface "/tmp" 'net.n01se.Bar ['net.n01se.Other Iterable]
['baz [] net.n01se.Foo])
(prn :isInterface (.isInterface (identity net.n01se.Foo)))
(prn :interfaces (seq (.getGenericInterfaces (identity net.n01se.Foo))))
(doseq [m (seq (.getMethods (identity net.n01se.Foo)))]
(prn m))
)
|
