Changeset 11368


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.

Location:
branches/scripting/j/src/org/armedbear/lisp
Files:
1 deleted
7 edited

Legend:

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

    r11299 r11368  
    489489        autoload(PACKAGE_EXT, "thread-unlock", "ThreadLock", true);
    490490        autoload(PACKAGE_JAVA, "%jnew-proxy", "JProxy");
     491        autoload(PACKAGE_JAVA, "%jimplement-interface", "JProxy");
    491492        autoload(PACKAGE_JAVA, "%jnew-runtime-class", "RuntimeClass");
    492493        autoload(PACKAGE_JAVA, "%jredefine-method", "RuntimeClass");
  • branches/scripting/j/src/org/armedbear/lisp/JProxy.java

    r11297 r11368  
    122122    }
    123123  }
     124 
     125    //NEW IMPLEMENTATION by Alessio Stalla
     126 
     127   
     128 
     129    private static final Primitive _JIMPLEMENT_INTERFACE =
     130      new Primitive("%jimplement-interface", PACKAGE_JAVA, false,
     131                    "interface &rest method-names-and-defs") {
     132     
     133          public LispObject execute(LispObject[] args) throws ConditionThrowable {
     134            int length = args.length;
     135            if (length < 3 || length % 2 != 1) {
     136              return error(new WrongNumberOfArgumentsException(this));
     137            }
     138            final Map<String,Function> lispDefinedMethods = new HashMap<String,Function>();
     139            for (int i = 1; i < length; i += 2) {
     140              lispDefinedMethods.put(args[i].getStringValue(), (Function) args[i + 1]);
     141            }
     142            final Class<?> iface = (Class<?>) args[0].javaInstance();
     143            return new Function() {
     144
     145              public LispObject execute(LispObject lispProxy) {
     146                Object proxy = Proxy.newProxyInstance(
     147                      iface.getClassLoader(),
     148                      new Class[] { iface },
     149                      new LispHandler2(lispProxy, lispDefinedMethods));
     150                  return new JavaObject(proxy);               
     151              }
     152             
     153            };
     154           
     155          }
     156      };
     157 
     158    private static class LispHandler2 implements InvocationHandler {
     159
     160      private Map<String, Function> lispDefinedMethods;
     161      private LispObject lispProxy;
     162
     163      LispHandler2(LispObject lispProxy, Map<String, Function> lispDefinedMethods) {
     164        this.lispProxy = lispProxy;
     165        this.lispDefinedMethods = lispDefinedMethods;
     166      }
     167   
     168      public Object invoke(Object proxy, Method method, Object[] args) throws ConditionThrowable {
     169        String methodName = method.getName();
     170 
     171        //TODO are these implemented correctly?
     172        if(methodName.equals("hashCode")) {
     173          return lispProxy.hashCode();
     174        }
     175        if (methodName.equals("equals")) {
     176          return (args[0] instanceof LispObject) && (T == lispProxy.EQ((LispObject) args[0]));
     177        }
     178        if (methodName.equals("toString")) {
     179          return lispProxy.writeToString();
     180        }
     181
     182        Function f = lispDefinedMethods.get(methodName);
     183        if (f != null) {
     184          try {
     185            LispObject lispArgs = NIL;
     186            if (args != null) {
     187              for (int i = args.length - 1 ; 0 <= i  ; i--) {
     188                lispArgs = lispArgs.push(new JavaObject(args[i]));
     189              }
     190            }
     191            lispArgs = lispArgs.push(lispProxy);
     192            LispObject result = evalCall(f, lispArgs, new Environment(),
     193                           LispThread.currentThread());
     194            return (method.getReturnType() == void.class ? null : result.javaInstance());
     195          } catch (ConditionThrowable t) {
     196            t.printStackTrace();
     197          }
     198          }
     199        return null;
     200      }
     201    }     
     202     
    124203}
  • branches/scripting/j/src/org/armedbear/lisp/LispObject.java

    r11297 r11368  
    8686  public Object javaInstance() throws ConditionThrowable
    8787  {
    88     return error(new LispError("The value " + writeToString() +
    89                                 " is not of primitive type."));
     88  return this;
     89    /*return error(new LispError("The value " + writeToString() +
     90                                " is not of primitive type."));*/
    9091  }
    9192
  • branches/scripting/j/src/org/armedbear/lisp/autoloads.lisp

    r11297 r11368  
    188188(export 'jinterface-implementation "JAVA")
    189189(autoload 'jinterface-implementation "java")
     190(export 'jimplement-interface "JAVA")
     191(autoload 'jimplement-interface "java")
    190192(export 'jobject-class "JAVA")
    191193(autoload 'jobject-class "java")
  • 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)
  • branches/scripting/j/src/org/armedbear/lisp/scripting/AbclScriptEngine.java

    r11360 r11368  
    3737import javax.script.SimpleBindings;
    3838
    39 import org.armedbear.lisp.AbstractString;
    4039import org.armedbear.lisp.Bignum;
    4140import org.armedbear.lisp.ConditionThrowable;
     
    5251import org.armedbear.lisp.LispThread;
    5352import org.armedbear.lisp.SimpleString;
     53import org.armedbear.lisp.SimpleVector;
    5454import org.armedbear.lisp.SingleFloat;
    5555import org.armedbear.lisp.Stream;
     
    337337 
    338338  public static LispObject toLisp(Object javaObject) {
    339     if(javaObject instanceof LispObject) {
     339    if(javaObject == null) {
     340            return Lisp.NIL;
     341    } else if(javaObject instanceof Boolean) {
     342            return ((Boolean)javaObject).booleanValue() ? Lisp.T : Lisp.NIL;
     343    } else if(javaObject instanceof Byte) {
     344            return new Fixnum(((Byte)javaObject).intValue());
     345    } else if(javaObject instanceof Integer) {
     346            return new Fixnum(((Integer)javaObject).intValue());
     347    } else if(javaObject instanceof Short) {
     348            return new Fixnum(((Short)javaObject).shortValue());
     349    } else if(javaObject instanceof Long) {
     350            return new Bignum((Long)javaObject);
     351    } else if(javaObject instanceof BigInteger) {
     352      return new Bignum((BigInteger) javaObject);
     353    } else if(javaObject instanceof Float) {
     354            return new SingleFloat(((Float)javaObject).floatValue());
     355    } else if(javaObject instanceof Double) {
     356            return new DoubleFloat(((Double)javaObject).doubleValue());
     357    } else if(javaObject instanceof String) {
     358            return new SimpleString((String)javaObject);
     359    } else if(javaObject instanceof Character) {
     360            return LispCharacter.getInstance((Character)javaObject);
     361    } else if(javaObject instanceof Object[]) {
     362            Object[] array = (Object[]) javaObject;
     363            SimpleVector v = new SimpleVector(array.length);
     364            for(int i = array.length; i > 0; --i) {
     365              try {
     366          v.aset(i, new JavaObject(array[i]));
     367        } catch (ConditionThrowable e) {
     368          throw new Error("Can't set simplevector index " + i, e);
     369        }
     370            }
     371            return v;
     372        } else if(javaObject instanceof LispObject) {
     373            return (LispObject) javaObject;
     374        } else {
     375          return new JavaObject(javaObject);
     376        }
     377    /*if(javaObject instanceof LispObject) {
    340378      return (LispObject) javaObject;
    341379    } else if(javaObject instanceof Float) {
     
    355393    } else {
    356394      return new JavaObject(javaObject);
    357     }
     395    }*/
    358396  }
    359397 
     
    361399  @Override
    362400  public <T> T getInterface(Class<T> clasz) {
     401    return getInterface(Lisp.NIL, clasz);
     402  }
     403
     404  @SuppressWarnings("unchecked")
     405  @Override
     406  public <T> T getInterface(Object thiz, Class<T> clasz) {
    363407    try {
    364408      Symbol s = findSymbol("find-java-interface-implementation", "abcl-script");
    365409      Object obj = s.getSymbolFunction().execute(new JavaObject(clasz));
    366       if(obj instanceof JavaObject) {
    367         return (T) ((JavaObject) obj).getObject();
     410      if(obj instanceof Function) {
     411        return (T) ((JavaObject) ((Function) obj).execute((LispObject) thiz)).getObject();
    368412      } else {
    369413        return null;
    370414      }
    371     } catch (ConditionThrowable e) {
    372       throw new Error(e);
    373     }
    374   }
    375 
    376   @SuppressWarnings("unchecked")
    377   @Override
    378   public <T> T getInterface(Object thiz, Class<T> clasz) {
    379     try {
    380       Symbol s = findSymbol("implement-java-interface", "abcl-script");
    381       Object obj = s.getSymbolFunction().execute(new JavaObject(clasz), (LispObject) thiz);
    382       return (T) ((JavaObject) obj).getObject();
    383415    } catch (ConditionThrowable e) {
    384416      throw new Error(e);
  • branches/scripting/j/src/org/armedbear/lisp/scripting/lisp/abcl-script.lisp

    r11360 r11368  
    9898
    9999(defun implement-java-interface (interface implementation)
    100   (apply #'jinterface-implementation
     100  (apply #'jimplement-interface
    101101   `(,interface
    102102     ,@(java-interface-implementation-method-definitions implementation))))
Note: See TracChangeset for help on using the changeset viewer.