Changeset 11590
- Timestamp:
- 01/25/09 23:34:24 (15 years ago)
- Location:
- trunk/abcl
- Files:
-
- 12 edited
- 3 copied
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/build.xml
r11570 r11590 20 20 <property name="abcl.ext.dir" 21 21 value="${basedir}/ext"/> 22 22 23 23 <target name="help"> 24 24 <echo>Main Ant targets: … … 38 38 </target> 39 39 40 <!-- Checks if JSR-223 support is available - thanks to Mark Everson --> 41 <available property="abcl.jsr-223.p" 42 classname="javax.script.ScriptEngine"/> 43 40 44 <patternset id="abcl.source.java"> 41 45 <include name="org/armedbear/lisp/*.java"/> 42 46 <include name="org/armedbear/lisp/util/*.java"/> 47 <include name="org/armedbear/lisp/scripting/*.java" if="abcl.jsr-223.p"/> 48 <include name="org/armedbear/lisp/scripting/util/*.java" if="abcl.jsr-223.p"/> 49 <include name="org/armedbear/Main.java"/> 43 50 </patternset> 44 51 … … 47 54 <include name="org/armedbear/lisp/tests/*.lisp"/> 48 55 <exclude name="org/armedbear/lisp/j.lisp"/> 56 <include name="org/armedbear/lisp/scripting/lisp/*.lisp" if="abcl.jsr-223.p"/> 49 57 </patternset> 50 58 … … 61 69 <patternset id="abcl.source.lisp.dist"> 62 70 <include name="org/armedbear/lisp/boot.lisp"/> 71 <include name="org/armedbear/lisp/scripting/lisp/*.lisp" if="abcl.jsr-223.p"/> 63 72 </patternset> 64 73 … … 68 77 <include name="org/armedbear/lisp/*.cls"/> 69 78 <include name="org/armedbear/lisp/*.abcl"/> 79 <include name="org/armedbear/lisp/scripting/*.class" if="abcl.jsr-223.p"/> 80 <include name="org/armedbear/lisp/scripting/util/*.class" if="abcl.jsr-223.p"/> 70 81 <patternset refid="abcl.source.lisp.dist"/> 71 82 </patternset> … … 128 139 </target> 129 140 141 <target name="abcl.jsr-223.notice" 142 depends="abcl.init" 143 unless="abcl.jsr-223.p"> 144 <echo>Notice: JSR-223 support won't be built since it is not supported, neither natively by your JVM nor by libraries in the CLASSPATH.</echo> 145 </target> 146 130 147 <target name="abcl.compile.java" 131 depends="abcl.init,abcl.java.warning ">148 depends="abcl.init,abcl.java.warning,abcl.jsr-223.notice"> 132 149 <mkdir dir="${build.dir}"/> 133 150 <mkdir dir="${build.classes.dir}"/> … … 237 254 </section> 238 255 </manifest> 256 <metainf dir="${src.dir}/META-INF"> 257 </metainf> 239 258 </jar> 240 259 </target> -
trunk/abcl/src/org/armedbear/lisp/Autoload.java
r11529 r11590 514 514 autoload(PACKAGE_EXT, "thread-unlock", "ThreadLock", true); 515 515 autoload(PACKAGE_JAVA, "%jnew-proxy", "JProxy"); 516 autoload(PACKAGE_JAVA, "%find-java-class", "JavaClass"); 517 autoload(PACKAGE_JAVA, "%jmake-invocation-handler", "JProxy"); 518 autoload(PACKAGE_JAVA, "%jmake-proxy", "JProxy"); 516 519 autoload(PACKAGE_JAVA, "%jnew-runtime-class", "RuntimeClass"); 517 520 autoload(PACKAGE_JAVA, "%jredefine-method", "RuntimeClass"); -
trunk/abcl/src/org/armedbear/lisp/JProxy.java
r11488 r11590 135 135 } 136 136 } 137 138 //NEW IMPLEMENTATION by Alessio Stalla 139 140 /** 141 * A weak map associating each proxy instance with a "Lisp-this" object. 142 */ 143 private static final Map<Object, LispObject> proxyMap = new WeakHashMap<Object, LispObject>(); 144 145 public static class LispInvocationHandler implements InvocationHandler { 146 147 private Function function; 148 private static Method hashCodeMethod; 149 private static Method equalsMethod; 150 private static Method toStringMethod; 151 152 static { 153 try { 154 hashCodeMethod = Object.class.getMethod("hashCode", new Class[] {}); 155 equalsMethod = Object.class.getMethod("equals", new Class[] { Object.class }); 156 toStringMethod = Object.class.getMethod("toString", new Class[] {}); 157 } catch (Exception e) { 158 throw new Error("Something got horribly wrong - can't get a method from Object.class", e); 159 } 160 } 161 162 public LispInvocationHandler(Function function) { 163 this.function = function; 164 } 165 166 public Object invoke(Object proxy, Method method, Object[] args) throws Throwable { 167 if(hashCodeMethod.equals(method)) { 168 return System.identityHashCode(proxy); 169 } 170 if(equalsMethod.equals(method)) { 171 return proxy == args[0]; 172 } 173 if(toStringMethod.equals(method)) { 174 return proxy.getClass().getName() + '@' + Integer.toHexString(proxy.hashCode()); 175 } 176 177 if(args == null) { 178 args = new Object[0]; 179 } 180 LispObject[] lispArgs = new LispObject[args.length + 2]; 181 synchronized(proxyMap) { 182 lispArgs[0] = toLispObject(proxyMap.get(proxy)); 183 } 184 lispArgs[1] = new SimpleString(method.getName()); 185 for(int i = 0; i < args.length; i++) { 186 lispArgs[i + 2] = toLispObject(args[i]); 187 } 188 Object retVal = (function.execute(lispArgs)).javaInstance(); 189 /* DOES NOT WORK due to autoboxing! 190 if(retVal != null && !method.getReturnType().isAssignableFrom(retVal.getClass())) { 191 return error(new TypeError(new JavaObject(retVal), new JavaObject(method.getReturnType()))); 192 }*/ 193 return retVal; 194 } 195 } 196 197 private static final Primitive _JMAKE_INVOCATION_HANDLER = 198 new Primitive("%jmake-invocation-handler", PACKAGE_JAVA, false, 199 "function") { 200 201 public LispObject execute(LispObject[] args) throws ConditionThrowable { 202 int length = args.length; 203 if (length != 1) { 204 return error(new WrongNumberOfArgumentsException(this)); 205 } 206 if(!(args[0] instanceof Function)) { 207 return error(new TypeError(args[0], Symbol.FUNCTION)); 208 } 209 return new JavaObject(new LispInvocationHandler((Function) args[0])); 210 } 211 }; 212 213 private static final Primitive _JMAKE_PROXY = 214 new Primitive("%jmake-proxy", PACKAGE_JAVA, false, 215 "interface invocation-handler") { 216 217 public LispObject execute(final LispObject[] args) throws ConditionThrowable { 218 int length = args.length; 219 if (length != 3) { 220 return error(new WrongNumberOfArgumentsException(this)); 221 } 222 if(!(args[0] instanceof JavaObject) || 223 !(((JavaObject) args[0]).javaInstance() instanceof Class)) { 224 return error(new TypeError(args[0], new SimpleString(Class.class.getName()))); 225 } 226 if(!(args[1] instanceof JavaObject) || 227 !(((JavaObject) args[1]).javaInstance() instanceof InvocationHandler)) { 228 return error(new TypeError(args[1], new SimpleString(InvocationHandler.class.getName()))); 229 } 230 Class<?> iface = (Class<?>) ((JavaObject) args[0]).javaInstance(); 231 InvocationHandler invocationHandler = (InvocationHandler) ((JavaObject) args[1]).javaInstance(); 232 Object proxy = Proxy.newProxyInstance( 233 iface.getClassLoader(), 234 new Class[] { iface }, 235 invocationHandler); 236 synchronized(proxyMap) { 237 proxyMap.put(proxy, args[2]); 238 } 239 return new JavaObject(proxy); 240 } 241 }; 242 243 private static LispObject toLispObject(Object obj) { 244 return (obj instanceof LispObject) ? (LispObject) obj : new JavaObject(obj); 245 } 246 137 247 } -
trunk/abcl/src/org/armedbear/lisp/Java.java
r11488 r11590 34 34 package org.armedbear.lisp; 35 35 36 import java.beans.BeanInfo; 37 import java.beans.IntrospectionException; 38 import java.beans.Introspector; 39 import java.beans.PropertyDescriptor; 36 40 import java.lang.reflect.Array; 37 41 import java.lang.reflect.Constructor; … … 40 44 import java.lang.reflect.Method; 41 45 import java.lang.reflect.Modifier; 46 import java.util.HashMap; 42 47 import java.util.Map; 43 import java.util.HashMap;44 48 45 49 public final class Java extends Lisp … … 723 727 } 724 728 }; 725 729 730 private static final Primitive JGET_PROPERTY_VALUE = 731 new Primitive("%jget-property-value", PACKAGE_JAVA, true, 732 "java-object property-name") { 733 734 public LispObject execute(LispObject javaObject, LispObject propertyName) throws ConditionThrowable { 735 try { 736 Object obj = javaObject.javaInstance(); 737 PropertyDescriptor pd = getPropertyDescriptor(obj, propertyName); 738 Object value = pd.getReadMethod().invoke(obj); 739 if(value instanceof LispObject) { 740 return (LispObject) value; 741 } else if(value != null) { 742 return new JavaObject(value); 743 } else { 744 return NIL; 745 } 746 } catch (Exception e) { 747 ConditionThrowable t = new ConditionThrowable("Exception reading property"); 748 t.initCause(e); 749 throw t; 750 } 751 } 752 }; 753 754 private static final Primitive JSET_PROPERTY_VALUE = 755 new Primitive("%jset-property-value", PACKAGE_JAVA, true, 756 "java-object property-name value") { 757 758 public LispObject execute(LispObject javaObject, LispObject propertyName, LispObject value) throws ConditionThrowable { 759 Object obj = null; 760 try { 761 obj = javaObject.javaInstance(); 762 PropertyDescriptor pd = getPropertyDescriptor(obj, propertyName); 763 Object jValue; 764 if(value == NIL) { 765 if(Boolean.TYPE.equals(pd.getPropertyType()) || 766 Boolean.class.equals(pd.getPropertyType())) { 767 jValue = false; 768 } else { 769 jValue = null; 770 } 771 } else { 772 jValue = value.javaInstance(); 773 } 774 pd.getWriteMethod().invoke(obj, jValue); 775 return value; 776 } catch (Exception e) { 777 ConditionThrowable t = new ConditionThrowable("Exception writing property " + propertyName.writeToString() + " in object " + obj + " to " + value.writeToString()); 778 t.initCause(e); 779 throw t; 780 } 781 } 782 }; 783 784 private static PropertyDescriptor getPropertyDescriptor(Object obj, LispObject propertyName) throws ConditionThrowable, IntrospectionException { 785 String prop = ((AbstractString) propertyName).getStringValue(); 786 BeanInfo beanInfo = Introspector.getBeanInfo(obj.getClass()); 787 for(PropertyDescriptor pd : beanInfo.getPropertyDescriptors()) { 788 if(pd.getName().equals(prop)) { 789 return pd; 790 } 791 } 792 throw new ConditionThrowable("Property " + prop + " not found in " + obj); 793 } 794 726 795 private static Class classForName(String className) throws ConditionThrowable 727 796 { -
trunk/abcl/src/org/armedbear/lisp/JavaObject.java
r11488 r11590 52 52 public LispObject classOf() 53 53 { 54 return BuiltInClass.JAVA_OBJECT; 54 if(obj == null) { 55 return BuiltInClass.JAVA_OBJECT; 56 } else { 57 return JavaClass.findJavaClass(obj.getClass()); 58 } 55 59 } 56 60 … … 62 66 if (type == BuiltInClass.JAVA_OBJECT) 63 67 return T; 68 if(type instanceof JavaClass && obj != null) { 69 return ((JavaClass) type).getJavaClass().isAssignableFrom(obj.getClass()) ? T : NIL; 70 } 64 71 return super.typep(type); 65 72 } -
trunk/abcl/src/org/armedbear/lisp/LispObject.java
r11579 r11590 102 102 public Object javaInstance() throws ConditionThrowable 103 103 { 104 return error(new LispError("The value " + writeToString() + 105 " is not of primitive type.")); 104 return this; 105 /*return error(new LispError("The value " + writeToString() + 106 " is not of primitive type."));*/ 106 107 } 107 108 -
trunk/abcl/src/org/armedbear/lisp/StandardClass.java
r11529 r11590 124 124 addStandardClass(Symbol.BUILT_IN_CLASS, list1(CLASS)); 125 125 126 public static final StandardClass JAVA_CLASS = 127 addStandardClass(Symbol.JAVA_CLASS, list1(CLASS)); 128 126 129 public static final StandardClass FORWARD_REFERENCED_CLASS = 127 130 addStandardClass(Symbol.FORWARD_REFERENCED_CLASS, list1(CLASS)); … … 281 284 BUILT_IN_CLASS.setCPL(BUILT_IN_CLASS, CLASS, STANDARD_OBJECT, 282 285 BuiltInClass.CLASS_T); 286 JAVA_CLASS.setCPL(JAVA_CLASS, CLASS, STANDARD_OBJECT, 287 BuiltInClass.CLASS_T); 283 288 CELL_ERROR.setCPL(CELL_ERROR, ERROR, SERIOUS_CONDITION, CONDITION, 284 289 STANDARD_OBJECT, BuiltInClass.CLASS_T); -
trunk/abcl/src/org/armedbear/lisp/Symbol.java
r11539 r11590 2900 2900 public static final Symbol JAVA_OBJECT = 2901 2901 PACKAGE_JAVA.addExternalSymbol("JAVA-OBJECT"); 2902 public static final Symbol JAVA_CLASS = 2903 PACKAGE_JAVA.addExternalSymbol("JAVA-CLASS"); 2902 2904 public static final Symbol JCALL = 2903 2905 PACKAGE_JAVA.addExternalSymbol("JCALL"); -
trunk/abcl/src/org/armedbear/lisp/autoloads.lisp
r11529 r11590 200 200 (export 'jinterface-implementation "JAVA") 201 201 (autoload 'jinterface-implementation "java") 202 (export 'jmake-invocation-handler "JAVA") 203 (autoload 'jmake-invocation-handler "java") 204 (export 'jmake-proxy "JAVA") 205 (autoload 'jmake-proxy "java") 206 (export 'jproperty-value "JAVA") 207 (autoload 'jproperty-value "java") 202 208 (export 'jobject-class "JAVA") 203 209 (autoload 'jobject-class "java") -
trunk/abcl/src/org/armedbear/lisp/clos.lisp
r11550 r11590 909 909 (setf object (cadr object))) 910 910 (intern-eql-specializer object))) 911 ((and (consp specializer) 912 (eq (car specializer) 'java:jclass)) 913 (let ((class-name (cadr specializer))) 914 (when (and (consp class-name) 915 (eq (car class-name) 'quote)) 916 (setf class-name (cadr class-name))) 917 (java::%find-java-class class-name))) 911 918 (t 912 919 (error "Unknown specializer: ~S" specializer)))) -
trunk/abcl/src/org/armedbear/lisp/java.lisp
r11529 r11590 75 75 (push method-name method-names-and-defs))) 76 76 (apply #'%jnew-proxy interface method-names-and-defs))) 77 78 (defun jmake-invocation-handler (function) 79 (%jmake-invocation-handler function)) 80 81 (when (autoloadp 'jmake-proxy) 82 (fmakunbound 'jmake-proxy)) 83 84 (defgeneric jmake-proxy (interface implementation &optional lisp-this) 85 (: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.")) 86 87 (defmethod jmake-proxy (interface invocation-handler &optional lisp-this) 88 "Basic implementation that directly uses an invocation handler." 89 (%jmake-proxy (jclass interface) invocation-handler lisp-this)) 90 91 (defmethod jmake-proxy (interface (implementation function) &optional lisp-this) 92 "Implements a Java interface forwarding method calls to a Lisp function." 93 (%jmake-proxy (jclass interface) (jmake-invocation-handler implementation) lisp-this)) 94 95 (defmethod jmake-proxy (interface (implementation package) &optional lisp-this) 96 "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." 97 (flet ((java->lisp (name) 98 (with-output-to-string (str) 99 (let ((last-lower-p nil)) 100 (map nil (lambda (char) 101 (let ((upper-p (char= (char-upcase char) char))) 102 (when (and last-lower-p upper-p) 103 (princ "-" str)) 104 (setf last-lower-p (not upper-p)) 105 (princ (char-upcase char) str))) 106 name))))) 107 (%jmake-proxy (jclass interface) 108 (jmake-invocation-handler 109 (lambda (obj method &rest args) 110 (let ((sym (find-symbol 111 (java->lisp method) 112 implementation))) 113 (unless sym 114 (error "Symbol ~A, implementation of method ~A, not found in ~A" 115 (java->lisp method) 116 method 117 implementation)) 118 (if (fboundp sym) 119 (apply (symbol-function sym) obj method args) 120 (error "Function ~A, implementation of method ~A, not found in ~A" 121 sym method implementation))))) 122 lisp-this))) 123 124 (defmethod jmake-proxy (interface (implementation hash-table) &optional lisp-this) 125 "Implements a Java interface using closures in an hash-table keyed by Java method name." 126 (%jmake-proxy (jclass interface) 127 (jmake-invocation-handler 128 (lambda (obj method &rest args) 129 (let ((fn (gethash method implementation))) 130 (if fn 131 (apply fn obj args) 132 (error "Implementation for method ~A not found in ~A" 133 method implementation))))) 134 lisp-this)) 77 135 78 136 (defun jobject-class (obj) … … 233 291 (error "Unknown load-from for ~A" class-name))))) 234 292 293 (defun jproperty-value (obj prop) 294 (%jget-property-value obj prop)) 295 296 (defun (setf jproperty-value) (value obj prop) 297 (%jset-property-value obj prop value)) 298 235 299 (provide "JAVA-EXTENSIONS") -
trunk/abcl/src/org/armedbear/lisp/print-object.lisp
r11529 r11590 50 50 (format stream "~S" (class-name (class-of object)))) 51 51 object) 52 53 (defmethod print-object ((class java:java-class) stream) 54 (write-string (%write-to-string class) stream)) 52 55 53 56 (defmethod print-object ((class class) stream)
Note: See TracChangeset
for help on using the changeset viewer.