Changeset 11590

Timestamp:

01/25/09 23:34:24 (14 years ago)

Author:

astalla

Message:

Merged the scripting branch, providing JSR-223 support and other new
features. JSR-233 is only built if the necessary javax.script.* classes
are found in the CLASSPATH.

Location:

trunk/abcl

Files:

• build.xml (modified) (7 diffs)
• src/META-INF (copied) (copied from branches/scripting/j/src/META-INF)
• src/org/armedbear/lisp/Autoload.java (modified) (1 diff)
• src/org/armedbear/lisp/JProxy.java (modified) (1 diff)
• src/org/armedbear/lisp/Java.java (modified) (3 diffs)
• src/org/armedbear/lisp/JavaClass.java (copied) (copied from branches/scripting/j/src/org/armedbear/lisp/JavaClass.java)
• src/org/armedbear/lisp/JavaObject.java (modified) (2 diffs)
• src/org/armedbear/lisp/LispObject.java (modified) (1 diff)
• src/org/armedbear/lisp/StandardClass.java (modified) (2 diffs)
• src/org/armedbear/lisp/Symbol.java (modified) (1 diff)
• src/org/armedbear/lisp/autoloads.lisp (modified) (1 diff)
• src/org/armedbear/lisp/clos.lisp (modified) (1 diff)
• src/org/armedbear/lisp/java.lisp (modified) (2 diffs)
• src/org/armedbear/lisp/print-object.lisp (modified) (1 diff)
• src/org/armedbear/lisp/scripting (copied) (copied from branches/scripting/j/src/org/armedbear/lisp/scripting)

trunk/abcl/build.xml

@@ -20 +20 @@
     <property name="abcl.ext.dir"
         value="${basedir}/ext"/>
-
+  
     <target name="help">
       <echo>Main Ant targets:
@@ -38 +38 @@
     </target>
 
+    <!-- Checks if JSR-223 support is available - thanks to Mark Everson -->
+    <available property="abcl.jsr-223.p"
+         classname="javax.script.ScriptEngine"/>
+
     <patternset id="abcl.source.java">
       <include name="org/armedbear/lisp/*.java"/>
       <include name="org/armedbear/lisp/util/*.java"/>
+      <include name="org/armedbear/lisp/scripting/*.java" if="abcl.jsr-223.p"/>
+      <include name="org/armedbear/lisp/scripting/util/*.java" if="abcl.jsr-223.p"/>
+      <include name="org/armedbear/Main.java"/>
     </patternset>
 
@@ -47 +54 @@
       <include name="org/armedbear/lisp/tests/*.lisp"/>
       <exclude name="org/armedbear/lisp/j.lisp"/>
+      <include name="org/armedbear/lisp/scripting/lisp/*.lisp" if="abcl.jsr-223.p"/>
     </patternset>
 
@@ -61 +69 @@
     <patternset id="abcl.source.lisp.dist">
       <include name="org/armedbear/lisp/boot.lisp"/>
+    <include name="org/armedbear/lisp/scripting/lisp/*.lisp" if="abcl.jsr-223.p"/>
     </patternset>
 
@@ -68 +77 @@
       <include name="org/armedbear/lisp/*.cls"/> 
       <include name="org/armedbear/lisp/*.abcl"/>
+      <include name="org/armedbear/lisp/scripting/*.class" if="abcl.jsr-223.p"/>
+      <include name="org/armedbear/lisp/scripting/util/*.class" if="abcl.jsr-223.p"/>
       <patternset refid="abcl.source.lisp.dist"/>
     </patternset>
@@ -128 +139 @@
     </target>
   
+    <target name="abcl.jsr-223.notice"
+      depends="abcl.init"
+      unless="abcl.jsr-223.p">
+      <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>
+    </target>
+
     <target name="abcl.compile.java" 
-      depends="abcl.init,abcl.java.warning">
+      depends="abcl.init,abcl.java.warning,abcl.jsr-223.notice">
       <mkdir dir="${build.dir}"/>
       <mkdir dir="${build.classes.dir}"/>
@@ -237 +254 @@
     </section>
   </manifest>
+        <metainf dir="${src.dir}/META-INF">
+        </metainf>
       </jar>
     </target>

trunk/abcl/src/org/armedbear/lisp/Autoload.java

@@ -514 +514 @@
         autoload(PACKAGE_EXT, "thread-unlock", "ThreadLock", true);
         autoload(PACKAGE_JAVA, "%jnew-proxy", "JProxy");
+        autoload(PACKAGE_JAVA, "%find-java-class", "JavaClass");
+        autoload(PACKAGE_JAVA, "%jmake-invocation-handler", "JProxy");
+        autoload(PACKAGE_JAVA, "%jmake-proxy", "JProxy");
         autoload(PACKAGE_JAVA, "%jnew-runtime-class", "RuntimeClass");
         autoload(PACKAGE_JAVA, "%jredefine-method", "RuntimeClass");

trunk/abcl/src/org/armedbear/lisp/JProxy.java

@@ -135 +135 @@
     }
   }
+  
+    //NEW IMPLEMENTATION by Alessio Stalla 
+  
+    /**
+     * A weak map associating each proxy instance with a "Lisp-this" object. 
+     */
+    private static final Map<Object, LispObject> proxyMap = new WeakHashMap<Object, LispObject>();
+  
+    public static class LispInvocationHandler implements InvocationHandler {
+      
+      private Function function;
+      private static Method hashCodeMethod;
+      private static Method equalsMethod;
+      private static Method toStringMethod;
+      
+      static {
+        try {
+        hashCodeMethod = Object.class.getMethod("hashCode", new Class[] {});
+        equalsMethod = Object.class.getMethod("equals", new Class[] { Object.class });
+        toStringMethod = Object.class.getMethod("toString", new Class[] {});
+      } catch (Exception e) {
+        throw new Error("Something got horribly wrong - can't get a method from Object.class", e);
+      }
+      }
+
+      public LispInvocationHandler(Function function) {
+        this.function = function;
+      }
+      
+    public Object invoke(Object proxy, Method method, Object[] args) throws Throwable {
+        if(hashCodeMethod.equals(method)) {
+          return System.identityHashCode(proxy);
+        }
+        if(equalsMethod.equals(method)) {
+          return proxy == args[0];
+        }
+        if(toStringMethod.equals(method)) {
+          return proxy.getClass().getName() + '@' + Integer.toHexString(proxy.hashCode());
+        }
+        
+        if(args == null) {
+          args = new Object[0];
+        }
+      LispObject[] lispArgs = new LispObject[args.length + 2];
+      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]);
+      }
+      Object retVal = (function.execute(lispArgs)).javaInstance();
+      /* DOES NOT WORK due to autoboxing!
+      if(retVal != null && !method.getReturnType().isAssignableFrom(retVal.getClass())) {
+        return error(new TypeError(new JavaObject(retVal), new JavaObject(method.getReturnType())));
+      }*/
+      return retVal;
+    }
+  }
+  
+    private static final Primitive _JMAKE_INVOCATION_HANDLER =
+      new Primitive("%jmake-invocation-handler", PACKAGE_JAVA, false,
+                    "function") {
+    
+          public LispObject execute(LispObject[] args) throws ConditionThrowable {
+            int length = args.length;
+            if (length != 1) {
+              return error(new WrongNumberOfArgumentsException(this));
+            }
+            if(!(args[0] instanceof Function)) {
+              return error(new TypeError(args[0], Symbol.FUNCTION));
+            }
+            return new JavaObject(new LispInvocationHandler((Function) args[0]));
+          }
+      };
+
+    private static final Primitive _JMAKE_PROXY =
+      new Primitive("%jmake-proxy", PACKAGE_JAVA, false,
+                    "interface invocation-handler") {
+    
+          public LispObject execute(final LispObject[] args) throws ConditionThrowable {
+            int length = args.length;
+            if (length != 3) {
+              return error(new WrongNumberOfArgumentsException(this));
+            }
+            if(!(args[0] instanceof JavaObject) ||
+               !(((JavaObject) args[0]).javaInstance() instanceof Class)) {
+              return error(new TypeError(args[0], new SimpleString(Class.class.getName())));
+            }
+            if(!(args[1] instanceof JavaObject) ||
+               !(((JavaObject) args[1]).javaInstance() instanceof InvocationHandler)) {
+              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();
+            Object proxy = Proxy.newProxyInstance(
+                iface.getClassLoader(),
+                new Class[] { iface },
+                invocationHandler);
+            synchronized(proxyMap) {
+              proxyMap.put(proxy, args[2]);
+            }
+            return new JavaObject(proxy);
+          }
+      };    
+      
+  private static LispObject toLispObject(Object obj) {
+    return (obj instanceof LispObject) ? (LispObject) obj : new JavaObject(obj);
+  }
+      
 }

trunk/abcl/src/org/armedbear/lisp/Java.java

@@ -34 +34 @@
 package org.armedbear.lisp;
 
+import java.beans.BeanInfo;
+import java.beans.IntrospectionException;
+import java.beans.Introspector;
+import java.beans.PropertyDescriptor;
 import java.lang.reflect.Array;
 import java.lang.reflect.Constructor;
@@ -40 +44 @@
 import java.lang.reflect.Method;
 import java.lang.reflect.Modifier;
+import java.util.HashMap;
 import java.util.Map;
-import java.util.HashMap;
 
 public final class Java extends Lisp
@@ -723 +727 @@
         }
     };
-
+    
+    private static final Primitive JGET_PROPERTY_VALUE =
+      new Primitive("%jget-property-value", PACKAGE_JAVA, true,
+                    "java-object property-name") {
+      
+      public LispObject execute(LispObject javaObject, LispObject propertyName) throws ConditionThrowable {
+      try {
+        Object obj = javaObject.javaInstance();
+        PropertyDescriptor pd = getPropertyDescriptor(obj, propertyName);
+        Object value = pd.getReadMethod().invoke(obj);
+        if(value instanceof LispObject) {
+            return (LispObject) value;
+        } else if(value != null) {
+            return new JavaObject(value);
+        } else {
+            return NIL;
+        }
+      } catch (Exception e) {
+        ConditionThrowable t = new ConditionThrowable("Exception reading property");
+        t.initCause(e);
+        throw t;
+      }
+        }
+    };
+    
+    private static final Primitive JSET_PROPERTY_VALUE =
+      new Primitive("%jset-property-value", PACKAGE_JAVA, true,
+                    "java-object property-name value") {
+      
+      public LispObject execute(LispObject javaObject, LispObject propertyName, LispObject value) throws ConditionThrowable {
+      Object obj = null;
+      try {
+    obj = javaObject.javaInstance();
+    PropertyDescriptor pd = getPropertyDescriptor(obj, propertyName);
+    Object jValue;
+    if(value == NIL) {
+        if(Boolean.TYPE.equals(pd.getPropertyType()) ||
+           Boolean.class.equals(pd.getPropertyType())) {
+      jValue = false;
+        } else {
+      jValue = null;
+        }
+    } else {
+        jValue = value.javaInstance();
+    }
+    pd.getWriteMethod().invoke(obj, jValue);
+    return value;
+      } catch (Exception e) {
+    ConditionThrowable t = new ConditionThrowable("Exception writing property " + propertyName.writeToString() + " in object " + obj + " to " + value.writeToString());
+    t.initCause(e);
+    throw t;
+      }
+        }
+    };
+    
+    private static PropertyDescriptor getPropertyDescriptor(Object obj, LispObject propertyName) throws ConditionThrowable, IntrospectionException {
+        String prop = ((AbstractString) propertyName).getStringValue();
+        BeanInfo beanInfo = Introspector.getBeanInfo(obj.getClass());
+        for(PropertyDescriptor pd : beanInfo.getPropertyDescriptors()) {
+          if(pd.getName().equals(prop)) {
+            return pd;
+          }
+        }
+    throw new ConditionThrowable("Property " + prop + " not found in " + obj);
+    }
+    
     private static Class classForName(String className) throws ConditionThrowable
     {

trunk/abcl/src/org/armedbear/lisp/JavaObject.java

@@ -52 +52 @@
     public LispObject classOf()
     {
-        return BuiltInClass.JAVA_OBJECT;
+      if(obj == null) {
+        return BuiltInClass.JAVA_OBJECT;
+      } else {
+        return JavaClass.findJavaClass(obj.getClass());
+      }
     }
 
@@ -62 +66 @@
         if (type == BuiltInClass.JAVA_OBJECT)
             return T;
+        if(type instanceof JavaClass && obj != null) {
+          return ((JavaClass) type).getJavaClass().isAssignableFrom(obj.getClass()) ? T : NIL;
+        }
         return super.typep(type);
     }

trunk/abcl/src/org/armedbear/lisp/LispObject.java

@@ -102 +102 @@
   public Object javaInstance() throws ConditionThrowable
   {
-    return error(new LispError("The value " + writeToString() +
-                                " is not of primitive type."));
+  return this;
+    /*return error(new LispError("The value " + writeToString() +
+                                " is not of primitive type."));*/
   }
 

trunk/abcl/src/org/armedbear/lisp/StandardClass.java

@@ -124 +124 @@
     addStandardClass(Symbol.BUILT_IN_CLASS, list1(CLASS));
 
+  public static final StandardClass JAVA_CLASS =
+      addStandardClass(Symbol.JAVA_CLASS, list1(CLASS));
+  
   public static final StandardClass FORWARD_REFERENCED_CLASS =
     addStandardClass(Symbol.FORWARD_REFERENCED_CLASS, list1(CLASS));
@@ -281 +284 @@
     BUILT_IN_CLASS.setCPL(BUILT_IN_CLASS, CLASS, STANDARD_OBJECT,
                           BuiltInClass.CLASS_T);
+    JAVA_CLASS.setCPL(JAVA_CLASS, CLASS, STANDARD_OBJECT,
+            BuiltInClass.CLASS_T);
     CELL_ERROR.setCPL(CELL_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
                       STANDARD_OBJECT, BuiltInClass.CLASS_T);

trunk/abcl/src/org/armedbear/lisp/Symbol.java

@@ -2900 +2900 @@
   public static final Symbol JAVA_OBJECT =
     PACKAGE_JAVA.addExternalSymbol("JAVA-OBJECT");
+  public static final Symbol JAVA_CLASS =
+      PACKAGE_JAVA.addExternalSymbol("JAVA-CLASS");
   public static final Symbol JCALL =
     PACKAGE_JAVA.addExternalSymbol("JCALL");

trunk/abcl/src/org/armedbear/lisp/autoloads.lisp

@@ -200 +200 @@
 (export 'jinterface-implementation "JAVA")
 (autoload 'jinterface-implementation "java")
+(export 'jmake-invocation-handler "JAVA")
+(autoload 'jmake-invocation-handler "java")
+(export 'jmake-proxy "JAVA")
+(autoload 'jmake-proxy "java")
+(export 'jproperty-value "JAVA")
+(autoload 'jproperty-value "java")
 (export 'jobject-class "JAVA")
 (autoload 'jobject-class "java")

trunk/abcl/src/org/armedbear/lisp/clos.lisp

@@ -909 +909 @@
              (setf object (cadr object)))
            (intern-eql-specializer object)))
+  ((and (consp specializer)
+              (eq (car specializer) 'java:jclass))
+         (let ((class-name (cadr specializer)))
+           (when (and (consp class-name)
+                      (eq (car class-name) 'quote))
+             (setf class-name (cadr class-name)))
+           (java::%find-java-class class-name)))
         (t
          (error "Unknown specializer: ~S" specializer))))

trunk/abcl/src/org/armedbear/lisp/java.lisp

@@ -75 +75 @@
         (push method-name method-names-and-defs)))
     (apply #'%jnew-proxy interface method-names-and-defs)))
+
+(defun jmake-invocation-handler (function)
+  (%jmake-invocation-handler function))
+
+(when (autoloadp 'jmake-proxy)
+  (fmakunbound 'jmake-proxy))
+
+(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."))
+
+(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 (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)
+     (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 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 method implementation)))
+         (if fn
+       (apply fn obj args)
+       (error "Implementation for method ~A not found in ~A"
+        method implementation)))))
+    lisp-this))
 
 (defun jobject-class (obj)
@@ -233 +291 @@
       (error "Unknown load-from for ~A" class-name)))))
 
+(defun jproperty-value (obj prop)
+  (%jget-property-value obj prop))
+
+(defun (setf jproperty-value) (value obj prop)
+  (%jset-property-value obj prop value))
+
 (provide "JAVA-EXTENSIONS")

trunk/abcl/src/org/armedbear/lisp/print-object.lisp

@@ -50 +50 @@
     (format stream "~S" (class-name (class-of object))))
   object)
+
+(defmethod print-object ((class java:java-class) stream)
+  (write-string (%write-to-string class) stream))
 
 (defmethod print-object ((class class) stream)