Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

178 lines (155 sloc) 7.125 kb
; 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
(: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-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))
)
Jump to Line
Something went wrong with that request. Please try again.