Ignore:
Timestamp:
10/28/08 21:16:05 (13 years ago)
Author:
astalla
Message:

New jimplement-interface functionality allowing some sort of limited single-dispatch OO. Changed LispObject.javaObject() to return this instead of signaling an error.

File:
1 edited

Legend:

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

    r11297 r11368  
    6363        (push method-name method-names-and-defs)))
    6464    (apply #'%jnew-proxy interface method-names-and-defs)))
     65
     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)))
    65104
    66105(defun jobject-class (obj)
Note: See TracChangeset for help on using the changeset viewer.