Changeset 12831

Timestamp:

07/28/10 22:13:15 (13 years ago)

Author:

astalla

Message:

First stab at Java collections integration with the sequences protocol.

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• JavaObject.java (modified) (1 diff)
• compile-system.lisp (modified) (1 diff)
• java-collections.lisp (added)
• java.lisp (modified) (3 diffs)

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

@@ -98 +98 @@
         if (type == BuiltInClass.JAVA_OBJECT)
             return T;
-  if(type.typep(LispClass.findClass(JAVA_CLASS, false)) != NIL) {
+  LispObject cls = NIL;
+  if(type instanceof Symbol) {
+      cls = LispClass.findClass(type, false);
+  }
+  if(cls == NIL) {
+      cls = type;
+  }
+  if(cls.typep(LispClass.findClass(JAVA_CLASS, false)) != NIL) {
       if(obj != null) {
-    Class c = (Class) JAVA_CLASS_JCLASS.execute(type).javaInstance();
+    Class c = (Class) JAVA_CLASS_JCLASS.execute(cls).javaInstance();
     return c.isAssignableFrom(obj.getClass()) ? T : NIL;
       } else {
     return T;
       }
+  } else if(cls == BuiltInClass.SEQUENCE) {
+      //This information is replicated here from java.lisp; it is a very
+      //specific case, not worth implementing CPL traversal in typep
+      if(java.util.List.class.isInstance(obj) ||
+         java.util.Set.class.isInstance(obj)) {
+    return T;
+      }
   }
         return super.typep(type);
     }
-
 
     @Override

trunk/abcl/src/org/armedbear/lisp/compile-system.lisp

@@ -187 +187 @@
                            ;;"j.lisp"
                            "java.lisp"
+                           "java-collections.lisp"
                            "known-functions.lisp"
                            "known-symbols.lisp"

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

@@ -149 +149 @@
         method implementation)))))
     lisp-this))
+
+(defun jequal (obj1 obj2)
+  "Compares obj1 with obj2 using java.lang.Object.equals()"
+  (jcall (jmethod "java.lang.Object" "equals" "java.lang.Object")
+   obj1 obj2))
 
 (defun jobject-class (obj)
@@ -364 +369 @@
              :java-class +java-lang-object+)))
 
+(defun jclass-additional-superclasses (jclass)
+  "Extension point to put additional CLOS classes on the CPL of a CLOS Java class."
+  (let ((supers nil))
+    (when (jclass-interface-p jclass)
+      (push (find-class 'java-object) supers))
+    (when (jequal jclass (jclass "java.util.List"))
+      (push (find-class 'sequence) supers))
+    supers))
+
 (defun ensure-java-class (jclass)
   (let ((class (%find-java-class jclass)))
@@ -379 +393 @@
                  (list (jclass-superclass jclass))
                  (jclass-interfaces jclass))))))
-       (if (jclass-interface-p jclass)
-           (append supers (list (find-class 'java-object)))
-           supers))
+       (append supers (jclass-additional-superclasses jclass)))
      :java-class jclass)))))