Changeset 11379


Ignore:
Timestamp:
11/05/08 20:20:57 (13 years ago)
Author:
astalla
Message:

jmake-proxy now is a generic function. A couple of simple methods are provided. TBD: automagic proxy generation from functions in a package.

Location:
branches/scripting/j/src/org/armedbear/lisp
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • branches/scripting/j/src/org/armedbear/lisp/Autoload.java

    r11378 r11379  
    489489        autoload(PACKAGE_EXT, "thread-unlock", "ThreadLock", true);
    490490        autoload(PACKAGE_JAVA, "%jnew-proxy", "JProxy");
    491         autoload(PACKAGE_JAVA, "%jimplement-interface", "JProxy");
    492491        autoload(PACKAGE_JAVA, "%find-java-class", "JavaClass");
    493492        autoload(PACKAGE_JAVA, "%jmake-invocation-handler", "JProxy");
  • branches/scripting/j/src/org/armedbear/lisp/JProxy.java

    r11370 r11379  
    222222  private static LispObject toLispObject(Object obj) {
    223223    return (obj instanceof LispObject) ? (LispObject) obj : new JavaObject(obj);
    224   }   
    225      
    226     private static final Primitive _JIMPLEMENT_INTERFACE =
    227       new Primitive("%jimplement-interface", PACKAGE_JAVA, false,
    228                     "interface &rest method-names-and-defs") {
    229      
    230           public LispObject execute(LispObject[] args) throws ConditionThrowable {
    231             int length = args.length;
    232             if (length < 3 || length % 2 != 1) {
    233               return error(new WrongNumberOfArgumentsException(this));
    234             }
    235             final Map<String,Function> lispDefinedMethods = new HashMap<String,Function>();
    236             for (int i = 1; i < length; i += 2) {
    237               lispDefinedMethods.put(args[i].getStringValue(), (Function) args[i + 1]);
    238             }
    239             final Class<?> iface = (Class<?>) args[0].javaInstance();
    240             return new Function() {
    241 
    242               public LispObject execute(LispObject lispProxy) {
    243                 Object proxy = Proxy.newProxyInstance(
    244                       iface.getClassLoader(),
    245                       new Class[] { iface },
    246                       new LispHandler2(lispProxy, lispDefinedMethods));
    247                   return new JavaObject(proxy);               
    248               }
    249              
    250             };
    251            
    252           }
    253       };
    254  
    255     private static class LispHandler2 implements InvocationHandler {
    256 
    257       private Map<String, Function> lispDefinedMethods;
    258       private LispObject lispProxy;
    259 
    260       LispHandler2(LispObject lispProxy, Map<String, Function> lispDefinedMethods) {
    261         this.lispProxy = lispProxy;
    262         this.lispDefinedMethods = lispDefinedMethods;
    263       }
    264    
    265       public Object invoke(Object proxy, Method method, Object[] args) throws ConditionThrowable {
    266         String methodName = method.getName();
    267  
    268         //TODO are these implemented correctly?
    269         if(methodName.equals("hashCode")) {
    270           return lispProxy.hashCode();
    271         }
    272         if (methodName.equals("equals")) {
    273           return (args[0] instanceof LispObject) && (T == lispProxy.EQ((LispObject) args[0]));
    274         }
    275         if (methodName.equals("toString")) {
    276           return lispProxy.writeToString();
    277         }
    278 
    279         Function f = lispDefinedMethods.get(methodName);
    280         if (f != null) {
    281           try {
    282             LispObject lispArgs = NIL;
    283             if (args != null) {
    284               for (int i = args.length - 1 ; 0 <= i  ; i--) {
    285                 lispArgs = lispArgs.push(new JavaObject(args[i]));
    286               }
    287             }
    288             lispArgs = lispArgs.push(lispProxy);
    289             LispObject result = evalCall(f, lispArgs, new Environment(),
    290                            LispThread.currentThread());
    291             return (method.getReturnType() == void.class ? null : result.javaInstance());
    292           } catch (ConditionThrowable t) {
    293             t.printStackTrace();
    294           }
    295           }
    296         return null;
    297       }
    298     }     
     224  }
    299225     
    300226}
  • branches/scripting/j/src/org/armedbear/lisp/autoloads.lisp

    r11369 r11379  
    188188(export 'jinterface-implementation "JAVA")
    189189(autoload 'jinterface-implementation "java")
    190 (export 'jimplement-interface "JAVA")
    191 (autoload 'jimplement-interface "java")
    192190(export 'jmake-invocation-handler "JAVA")
    193191(autoload 'jmake-invocation-handler "java")
  • branches/scripting/j/src/org/armedbear/lisp/java.lisp

    r11369 r11379  
    6464    (apply #'%jnew-proxy interface method-names-and-defs)))
    6565
    66 (defun jimplement-interface (interface &rest method-names-and-defs)
    67   "Creates and returns an implementation of a Java interface with
    68    methods calling Lisp closures as given in METHOD-NAMES-AND-DEFS.
    69 
    70    INTERFACE is either a Java interface or a string naming one.
    71 
    72    METHOD-NAMES-AND-DEFS is an alternating list of method names
    73    (strings) and method definitions (closures).
    74 
    75    For missing methods, a dummy implementation is provided that
    76    returns nothing or null depending on whether the return type is
    77    void or not. This is for convenience only, and a warning is issued
    78    for each undefined method."
    79   (let ((interface (jclass interface))
    80         (implemented-methods
    81          (loop for m in method-names-and-defs
    82            for i from 0
    83            if (evenp i)
    84            do (assert (stringp m) (m) "Method names must be strings: ~s" m) and collect m
    85            else
    86            do (assert (or (symbolp m) (functionp m)) (m) "Methods must be function designators: ~s" m)))
    87         (null (make-immediate-object nil :ref)))
    88     (loop for method across
    89       (jclass-methods interface :declared nil :public t)
    90       for method-name = (jmethod-name method)
    91       when (not (member method-name implemented-methods :test #'string=))
    92       do
    93       (let* ((void-p (string= (jclass-name (jmethod-return-type method)) "void"))
    94              (arglist '(&rest ignore))
    95              (def `(lambda
    96                      ,arglist
    97                      ,(when arglist '(declare (ignore ignore)))
    98                      ,(if void-p '(values) null))))
    99         (warn "Implementing dummy method ~a for interface ~a"
    100               method-name (jclass-name interface))
    101         (push (coerce def 'function) method-names-and-defs)
    102         (push method-name method-names-and-defs)))
    103     (apply #'%jimplement-interface interface method-names-and-defs)))
    104 
    10566(defun jmake-invocation-handler (function)
    10667  (%jmake-invocation-handler function))
    10768
    108 (defun jmake-proxy (interface invocation-handler)
    109   (let ((handler (if (functionp invocation-handler)
    110          (jmake-invocation-handler invocation-handler)
    111          invocation-handler)))
    112     (%jmake-proxy (jclass interface) handler)))
     69(when (autoloadp 'jmake-proxy)
     70  (fmakunbound 'jmake-proxy))
     71
     72(defgeneric jmake-proxy (interface implementation))
     73
     74;(defun jmake-proxy (interface implementation)
     75;  (jmake-proxy-impl interface implementation))
     76
     77(defmethod jmake-proxy (interface invocation-handler)
     78  (%jmake-proxy (jclass interface) invocation-handler))
     79
     80(defmethod jmake-proxy (interface (implementation function))
     81  (%jmake-proxy (jclass interface) (jmake-invocation-handler implementation)))
     82
     83#|
     84TODO java->lisp wrong (coding at night has nasty effects)
     85(defmethod jmake-proxy (interface (implementation package))
     86  (flet ((java->lisp (name)
     87     (substitute #\- #\. (string-upcase name))))
     88    (%jmake-proxy (jclass interface)
     89      (jmake-invocation-handler
     90       (lambda (obj method &rest args)
     91         (let* ((sym (find-symbol (java->lisp (jmethod-name method))))
     92          (fn (symbol-function sym)))
     93           (if fn
     94         (apply fn obj args)
     95         (error "Function ~A, implementation of method ~A, not found in ~A"
     96          sym (jmethod-name method) implementation))))))))
     97|#
     98(defmethod jmake-proxy (interface (implementation hash-table))
     99  (%jmake-proxy (jclass interface)
     100    (jmake-invocation-handler
     101     (lambda (obj method &rest args)
     102       (let ((fn (gethash (jmethod-name method) implementation)))
     103         (if fn
     104       (apply fn obj args)
     105       (error "Implementation for method ~A not found in ~A"
     106        (jmethod-name method) implementation)))))))
    113107
    114108(defun jobject-class (obj)
  • branches/scripting/j/src/org/armedbear/lisp/print-object.lisp

    r11297 r11379  
    3737    (format stream "~S" (class-name (class-of object))))
    3838  object)
     39
     40(defmethod print-object ((class java:java-class) stream)
     41  (write-string (%write-to-string object) stream))
    3942
    4043(defmethod print-object ((class class) stream)
  • branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp

    r11368 r11379  
    7373         actual-engine-bindings
    7474         (jcall +get-bindings+ script-context +engine-scope+)))))))))
    75 
    76 (defstruct (java-interface-implementation (:type list))
    77   (method-definitions (list) :type list))
    78 
    79 (defun define-java-interface-implementation (interface &rest method-definitions)
    80   (register-java-interface-implementation
    81    (canonicalize-interface interface)
    82    (make-java-interface-implementation :method-definitions method-definitions)))
    83 
    84 (defun canonicalize-interface (interface)
    85   (cond
    86     ((stringp interface) interface)
    87     ((jclass-interface-p interface) (jclass-name interface))
    88     (t (error "not an interface: ~A" interface))))
    89 
    90 (defun register-java-interface-implementation (interface implementation)
    91   (setf (gethash (canonicalize-interface interface)
    92      *java-interface-implementations*)
    93   (implement-java-interface interface implementation)))
    94 
    95 (defun find-java-interface-implementation (interface)
    96   (gethash (canonicalize-interface interface)
    97      *java-interface-implementations*))
    98 
    99 (defun implement-java-interface (interface implementation)
    100   (apply #'jimplement-interface
    101    `(,interface
    102      ,@(java-interface-implementation-method-definitions implementation))))
Note: See TracChangeset for help on using the changeset viewer.