[armedbear-cvs] r11389 - in branches/scripting/j/src/org/armedbear/lisp: . scripting scripting/lisp
Alessio Stalla
astalla at common-lisp.net
Mon Nov 10 22:34:37 UTC 2008
Author: astalla
Date: Mon Nov 10 22:34:36 2008
New Revision: 11389
Log:
- Added support for lisp-this for interface implementations
- Correctly implemented package-based jmake-proxy
- Passed only the method name to lisp functions implementing java interfaces, instead of the full blown method metaobject
Modified:
branches/scripting/j/src/org/armedbear/lisp/JProxy.java
branches/scripting/j/src/org/armedbear/lisp/java.lisp
branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java
branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp
Modified: branches/scripting/j/src/org/armedbear/lisp/JProxy.java
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/JProxy.java (original)
+++ branches/scripting/j/src/org/armedbear/lisp/JProxy.java Mon Nov 10 22:34:36 2008
@@ -124,6 +124,8 @@
//NEW IMPLEMENTATION by Alessio Stalla
+ private static final Map<Object, LispObject> proxyMap = new WeakHashMap<Object, LispObject>();
+
public static class LispInvocationHandler implements InvocationHandler {
private Function function;
@@ -148,21 +150,23 @@
@Override
public Object invoke(Object proxy, Method method, Object[] args) throws Throwable {
if(hashCodeMethod.equals(method)) {
- return proxy.hashCode();
+ return System.identityHashCode(proxy);
}
if(equalsMethod.equals(method)) {
- return proxy.equals(args[0]);
+ return proxy == args[0];
}
if(toStringMethod.equals(method)) {
- return proxy.toString();
+ return proxy.getClass().getName() + '@' + Integer.toHexString(proxy.hashCode());
}
if(args == null) {
args = new Object[0];
}
LispObject[] lispArgs = new LispObject[args.length + 2];
- lispArgs[0] = toLispObject(proxy);
- lispArgs[1] = new JavaObject(method);
+ synchronized(proxyMap) {
+ lispArgs[0] = toLispObject(proxyMap.get(proxy));
+ }
+ lispArgs[1] = new SimpleString(method.getName());
for(int i = 0; i < args.length; i++) {
lispArgs[i + 2] = toLispObject(args[i]);
}
@@ -187,7 +191,6 @@
if(!(args[0] instanceof Function)) {
return error(new TypeError(args[0], Symbol.FUNCTION));
}
-
return new JavaObject(new LispInvocationHandler((Function) args[0]));
}
};
@@ -198,7 +201,7 @@
public LispObject execute(final LispObject[] args) throws ConditionThrowable {
int length = args.length;
- if (length != 2) {
+ if (length != 3) {
return error(new WrongNumberOfArgumentsException(this));
}
if(!(args[0] instanceof JavaObject) ||
@@ -207,14 +210,17 @@
}
if(!(args[1] instanceof JavaObject) ||
!(((JavaObject) args[1]).javaInstance() instanceof InvocationHandler)) {
- return error(new TypeError(args[1], new SimpleString(InvocationHandler.class.getName())));
- }
+ return error(new TypeError(args[1], new SimpleString(InvocationHandler.class.getName())));
+ }
Class<?> iface = (Class<?>) ((JavaObject) args[0]).javaInstance();
- InvocationHandler invocationHandler = (InvocationHandler) ((JavaObject) args[1]).javaInstance();
+ InvocationHandler invocationHandler = (InvocationHandler) ((JavaObject) args[1]).javaInstance();
Object proxy = Proxy.newProxyInstance(
iface.getClassLoader(),
new Class[] { iface },
invocationHandler);
+ synchronized(proxyMap) {
+ proxyMap.put(proxy, args[2]);
+ }
return new JavaObject(proxy);
}
};
Modified: branches/scripting/j/src/org/armedbear/lisp/java.lisp
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/java.lisp (original)
+++ branches/scripting/j/src/org/armedbear/lisp/java.lisp Mon Nov 10 22:34:36 2008
@@ -69,41 +69,57 @@
(when (autoloadp 'jmake-proxy)
(fmakunbound 'jmake-proxy))
-(defgeneric jmake-proxy (interface implementation))
+(defgeneric jmake-proxy (interface implementation &optional lisp-this)
+ (:documentation "Returns a proxy Java object implementing the provided interface using methods implemented in Lisp - typically closures, but implementations are free to provide other mechanisms. You can pass an optional 'lisp-this' object that will be passed to the implementing methods as their first argument. If you don't provide this object, NIL will be used. The second argument of the Lisp methods is the name of the Java method being implemented. This has the implication that overloaded methods are merged, so you have to manually discriminate them if you want to. The remaining arguments are java-objects wrapping the method's parameters."))
-;(defun jmake-proxy (interface implementation)
-; (jmake-proxy-impl interface implementation))
+(defmethod jmake-proxy (interface invocation-handler &optional lisp-this)
+ "Basic implementation that directly uses an invocation handler."
+ (%jmake-proxy (jclass interface) invocation-handler lisp-this))
+
+(defmethod jmake-proxy (interface (implementation function) &optional lisp-this)
+ "Implements a Java interface forwarding method calls to a Lisp function."
+ (%jmake-proxy (jclass interface) (jmake-invocation-handler implementation) lisp-this))
-(defmethod jmake-proxy (interface invocation-handler)
- (%jmake-proxy (jclass interface) invocation-handler))
-
-(defmethod jmake-proxy (interface (implementation function))
- (%jmake-proxy (jclass interface) (jmake-invocation-handler implementation)))
-
-#|
-TODO java->lisp wrong (coding at night has nasty effects)
-(defmethod jmake-proxy (interface (implementation package))
+(defmethod jmake-proxy (interface (implementation package) &optional lisp-this)
+ "Implements a Java interface mapping Java method names to symbols in a given package. javaMethodName is mapped to a JAVA-METHOD-NAME symbol. An error is signaled if no such symbol exists in the package, or if the symbol exists but does not name a function."
(flet ((java->lisp (name)
- (substitute #\- #\. (string-upcase name))))
+ (with-output-to-string (str)
+ (let ((last-lower-p nil))
+ (map nil (lambda (char)
+ (let ((upper-p (char= (char-upcase char) char)))
+ (when (and last-lower-p upper-p)
+ (princ "-" str))
+ (setf last-lower-p (not upper-p))
+ (princ (char-upcase char) str)))
+ name)))))
(%jmake-proxy (jclass interface)
(jmake-invocation-handler
(lambda (obj method &rest args)
- (let* ((sym (find-symbol (java->lisp (jmethod-name method))))
- (fn (symbol-function sym)))
- (if fn
- (apply fn obj args)
- (error "Function ~A, implementation of method ~A, not found in ~A"
- sym (jmethod-name method) implementation))))))))
-|#
-(defmethod jmake-proxy (interface (implementation hash-table))
+ (let ((sym (find-symbol
+ (java->lisp method)
+ implementation)))
+ (unless sym
+ (error "Symbol ~A, implementation of method ~A, not found in ~A"
+ (java->lisp method)
+ method
+ implementation))
+ (if (fboundp sym)
+ (apply (symbol-function sym) obj method args)
+ (error "Function ~A, implementation of method ~A, not found in ~A"
+ sym method implementation)))))
+ lisp-this)))
+
+(defmethod jmake-proxy (interface (implementation hash-table) &optional lisp-this)
+ "Implements a Java interface using closures in an hash-table keyed by Java method name."
(%jmake-proxy (jclass interface)
(jmake-invocation-handler
(lambda (obj method &rest args)
- (let ((fn (gethash (jmethod-name method) implementation)))
+ (let ((fn (gethash method implementation)))
(if fn
(apply fn obj args)
(error "Implementation for method ~A not found in ~A"
- (jmethod-name method) implementation)))))))
+ method implementation)))))
+ lisp-this))
(defun jobject-class (obj)
"Returns the Java class that OBJ belongs to"
Modified: branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java (original)
+++ branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java Mon Nov 10 22:34:36 2008
@@ -278,15 +278,11 @@
in = new ReaderInputStream(ctx.getReader());
out = new WriterOutputStream(ctx.getWriter());
Stream outStream = new Stream(out, Symbol.CHARACTER);
+ Stream inStream = new Stream(in, Symbol.CHARACTER);
retVal = evalScript.execute(makeBindings(ctx.getBindings(ScriptContext.GLOBAL_SCOPE)),
makeBindings(ctx.getBindings(ScriptContext.ENGINE_SCOPE)),
- new Stream(in, Symbol.CHARACTER),
- outStream,
+ inStream, outStream,
new SimpleString(code), new JavaObject(ctx));
- outStream._finishOutput();
- out.flush();
- //in.close();
- out.close();
return toJava(retVal);
} catch (ConditionThrowable e) {
throw new ScriptException(new Exception(e));
@@ -322,24 +318,6 @@
private static Object toJava(LispObject lispObject) throws ConditionThrowable {
return lispObject.javaInstance();
- /*
- if(lispObject instanceof JavaObject) {
- return ((JavaObject) lispObject).getObject();
- } else if(lispObject instanceof SingleFloat) {
- return ((SingleFloat) lispObject).value;
- } else if(lispObject instanceof DoubleFloat) {
- return ((DoubleFloat) lispObject).value;
- } else if(lispObject instanceof LispCharacter) {
- return ((LispCharacter) lispObject).value;
- } else if(lispObject instanceof Bignum) {
- return ((Bignum) lispObject).value;
- } else if(lispObject instanceof Fixnum) {
- return ((Fixnum) lispObject).value;
- } else if(lispObject instanceof SimpleString) {
- return ((SimpleString) lispObject).javaInstance();
- } else {
- return lispObject;
- }*/
}
public static LispObject toLisp(Object javaObject) {
@@ -385,8 +363,11 @@
@Override
public <T> T getInterface(Class<T> clasz) {
- //return getInterface(Lisp.NIL, clasz);
- throw new UnsupportedOperationException("Not implemented");
+ try {
+ return getInterface(eval("(cl:find-package '#:ABCL-SCRIPT-USER)"), clasz);
+ } catch (ScriptException e) {
+ throw new Error(e);
+ }
}
@SuppressWarnings("unchecked")
@@ -394,9 +375,8 @@
public <T> T getInterface(Object thiz, Class<T> clasz) {
try {
Symbol s = findSymbol("jmake-proxy", "JAVA");
- LispObject f = s.getSymbolFunction();
JavaObject iface = new JavaObject(clasz);
- return (T) ((JavaObject) f.execute(iface, (LispObject) thiz)).javaInstance();
+ return (T) ((JavaObject) s.execute(iface, (LispObject) thiz)).javaInstance();
} catch (ConditionThrowable e) {
throw new Error(e);
}
Modified: branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp
==============================================================================
--- branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp (original)
+++ branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp Mon Nov 10 22:34:36 2008
@@ -18,8 +18,6 @@
(in-package :abcl-script)
-(defvar *java-interface-implementations* (make-hash-table :test #'equal))
-
(defconstant +global-scope+
(jfield "javax.script.ScriptContext" "GLOBAL_SCOPE"))
More information about the armedbear-cvs
mailing list