Changeset 11590


Ignore:
Timestamp:
01/25/09 23:34:24 (13 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:
12 edited
3 copied

Legend:

Unmodified
Added
Removed
  • trunk/abcl/build.xml

    r11570 r11590  
    2020    <property name="abcl.ext.dir"
    2121        value="${basedir}/ext"/>
    22 
     22 
    2323    <target name="help">
    2424      <echo>Main Ant targets:
     
    3838    </target>
    3939
     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
    4044    <patternset id="abcl.source.java">
    4145      <include name="org/armedbear/lisp/*.java"/>
    4246      <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"/>
    4350    </patternset>
    4451
     
    4754      <include name="org/armedbear/lisp/tests/*.lisp"/>
    4855      <exclude name="org/armedbear/lisp/j.lisp"/>
     56      <include name="org/armedbear/lisp/scripting/lisp/*.lisp" if="abcl.jsr-223.p"/>
    4957    </patternset>
    5058
     
    6169    <patternset id="abcl.source.lisp.dist">
    6270      <include name="org/armedbear/lisp/boot.lisp"/>
     71    <include name="org/armedbear/lisp/scripting/lisp/*.lisp" if="abcl.jsr-223.p"/>
    6372    </patternset>
    6473
     
    6877      <include name="org/armedbear/lisp/*.cls"/>
    6978      <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"/>
    7081      <patternset refid="abcl.source.lisp.dist"/>
    7182    </patternset>
     
    128139    </target>
    129140 
     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
    130147    <target name="abcl.compile.java"
    131       depends="abcl.init,abcl.java.warning">
     148      depends="abcl.init,abcl.java.warning,abcl.jsr-223.notice">
    132149      <mkdir dir="${build.dir}"/>
    133150      <mkdir dir="${build.classes.dir}"/>
     
    237254    </section>
    238255  </manifest>
     256        <metainf dir="${src.dir}/META-INF">
     257        </metainf>
    239258      </jar>
    240259    </target>
  • trunk/abcl/src/org/armedbear/lisp/Autoload.java

    r11529 r11590  
    514514        autoload(PACKAGE_EXT, "thread-unlock", "ThreadLock", true);
    515515        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");
    516519        autoload(PACKAGE_JAVA, "%jnew-runtime-class", "RuntimeClass");
    517520        autoload(PACKAGE_JAVA, "%jredefine-method", "RuntimeClass");
  • trunk/abcl/src/org/armedbear/lisp/JProxy.java

    r11488 r11590  
    135135    }
    136136  }
     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     
    137247}
  • trunk/abcl/src/org/armedbear/lisp/Java.java

    r11488 r11590  
    3434package org.armedbear.lisp;
    3535
     36import java.beans.BeanInfo;
     37import java.beans.IntrospectionException;
     38import java.beans.Introspector;
     39import java.beans.PropertyDescriptor;
    3640import java.lang.reflect.Array;
    3741import java.lang.reflect.Constructor;
     
    4044import java.lang.reflect.Method;
    4145import java.lang.reflect.Modifier;
     46import java.util.HashMap;
    4247import java.util.Map;
    43 import java.util.HashMap;
    4448
    4549public final class Java extends Lisp
     
    723727        }
    724728    };
    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   
    726795    private static Class classForName(String className) throws ConditionThrowable
    727796    {
  • trunk/abcl/src/org/armedbear/lisp/JavaObject.java

    r11488 r11590  
    5252    public LispObject classOf()
    5353    {
    54         return BuiltInClass.JAVA_OBJECT;
     54      if(obj == null) {
     55        return BuiltInClass.JAVA_OBJECT;
     56      } else {
     57        return JavaClass.findJavaClass(obj.getClass());
     58      }
    5559    }
    5660
     
    6266        if (type == BuiltInClass.JAVA_OBJECT)
    6367            return T;
     68        if(type instanceof JavaClass && obj != null) {
     69          return ((JavaClass) type).getJavaClass().isAssignableFrom(obj.getClass()) ? T : NIL;
     70        }
    6471        return super.typep(type);
    6572    }
  • trunk/abcl/src/org/armedbear/lisp/LispObject.java

    r11579 r11590  
    102102  public Object javaInstance() throws ConditionThrowable
    103103  {
    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."));*/
    106107  }
    107108
  • trunk/abcl/src/org/armedbear/lisp/StandardClass.java

    r11529 r11590  
    124124    addStandardClass(Symbol.BUILT_IN_CLASS, list1(CLASS));
    125125
     126  public static final StandardClass JAVA_CLASS =
     127      addStandardClass(Symbol.JAVA_CLASS, list1(CLASS));
     128 
    126129  public static final StandardClass FORWARD_REFERENCED_CLASS =
    127130    addStandardClass(Symbol.FORWARD_REFERENCED_CLASS, list1(CLASS));
     
    281284    BUILT_IN_CLASS.setCPL(BUILT_IN_CLASS, CLASS, STANDARD_OBJECT,
    282285                          BuiltInClass.CLASS_T);
     286    JAVA_CLASS.setCPL(JAVA_CLASS, CLASS, STANDARD_OBJECT,
     287            BuiltInClass.CLASS_T);
    283288    CELL_ERROR.setCPL(CELL_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
    284289                      STANDARD_OBJECT, BuiltInClass.CLASS_T);
  • trunk/abcl/src/org/armedbear/lisp/Symbol.java

    r11539 r11590  
    29002900  public static final Symbol JAVA_OBJECT =
    29012901    PACKAGE_JAVA.addExternalSymbol("JAVA-OBJECT");
     2902  public static final Symbol JAVA_CLASS =
     2903      PACKAGE_JAVA.addExternalSymbol("JAVA-CLASS");
    29022904  public static final Symbol JCALL =
    29032905    PACKAGE_JAVA.addExternalSymbol("JCALL");
  • trunk/abcl/src/org/armedbear/lisp/autoloads.lisp

    r11529 r11590  
    200200(export 'jinterface-implementation "JAVA")
    201201(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")
    202208(export 'jobject-class "JAVA")
    203209(autoload 'jobject-class "java")
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r11550 r11590  
    909909             (setf object (cadr object)))
    910910           (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)))
    911918        (t
    912919         (error "Unknown specializer: ~S" specializer))))
  • trunk/abcl/src/org/armedbear/lisp/java.lisp

    r11529 r11590  
    7575        (push method-name method-names-and-defs)))
    7676    (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))
    77135
    78136(defun jobject-class (obj)
     
    233291      (error "Unknown load-from for ~A" class-name)))))
    234292
     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
    235299(provide "JAVA-EXTENSIONS")
  • trunk/abcl/src/org/armedbear/lisp/print-object.lisp

    r11529 r11590  
    5050    (format stream "~S" (class-name (class-of object))))
    5151  object)
     52
     53(defmethod print-object ((class java:java-class) stream)
     54  (write-string (%write-to-string class) stream))
    5255
    5356(defmethod print-object ((class class) stream)
Note: See TracChangeset for help on using the changeset viewer.