Changeset 12583


Ignore:
Timestamp:
04/08/10 19:44:14 (12 years ago)
Author:
astalla
Message:

JAVA-CLASS metaclass reimplemented in Lisp.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
1 deleted
8 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/Autoload.java

    r12576 r12583  
    506506        autoload(PACKAGE_EXT, "string-position", "StringFunctions");
    507507        autoload(PACKAGE_JAVA, "%jnew-proxy", "JProxy");
    508         autoload(PACKAGE_JAVA, "%find-java-class", "JavaClass");
     508        autoload(PACKAGE_JAVA, "%find-java-class", "JavaObject");
     509        autoload(PACKAGE_JAVA, "%register-java-class", "JavaObject");
    509510        autoload(PACKAGE_JAVA, "%jmake-invocation-handler", "JProxy");
    510511        autoload(PACKAGE_JAVA, "%jmake-proxy", "JProxy");
  • trunk/abcl/src/org/armedbear/lisp/JavaObject.java

    r12581 r12583  
    3939import java.lang.reflect.Field;
    4040import java.math.BigInteger;
    41 import java.util.ArrayList;
    42 import java.util.Collection;
    43 import java.util.HashSet;
    44 import java.util.LinkedList;
    45 import java.util.Set;
     41import java.util.*;
    4642
    4743public final class JavaObject extends LispObject {
     
    5450      obj != null ? Java.maybeBoxClass(obj.getClass()) : null;
    5551    }
     52
     53    public static final Symbol JAVA_CLASS_JCLASS = PACKAGE_JAVA.intern("JAVA-CLASS-JCLASS");
     54    public static final Symbol JAVA_CLASS = PACKAGE_JAVA.intern("JAVA-CLASS");
     55    public static final Symbol ENSURE_JAVA_CLASS = PACKAGE_JAVA.intern("ENSURE-JAVA-CLASS");
    5656
    5757    /**
     
    8888                return BuiltInClass.JAVA_OBJECT;
    8989        } else {
    90                 return JavaClass.findJavaClass(obj.getClass());
     90      return ENSURE_JAVA_CLASS.execute(new JavaObject(obj.getClass()));
    9191        }
    9292    }
    9393
    9494    @Override
    95     public LispObject typep(LispObject type)
    96     {
     95    public LispObject typep(LispObject type) {
    9796        if (type == Symbol.JAVA_OBJECT)
    9897            return T;
    9998        if (type == BuiltInClass.JAVA_OBJECT)
    10099            return T;
    101         if(type instanceof JavaClass && obj != null) {
    102                 return ((JavaClass) type).getJavaClass().isAssignableFrom(obj.getClass()) ? T : NIL;
    103         }
     100  if(type.typep(LispClass.findClass(JAVA_CLASS, false)) != NIL) {
     101      if(obj != null) {
     102    Class c = (Class) JAVA_CLASS_JCLASS.execute(type).javaInstance();
     103    return c.isAssignableFrom(obj.getClass()) ? T : NIL;
     104      } else {
     105    return T;
     106      }
     107  }
    104108        return super.typep(type);
    105109    }
     
    523527        }
    524528    };
     529
     530    //JAVA-CLASS support
     531
     532    //There is no point for this Map to be weak since values keep a reference to the corresponding
     533    //key (the Java class). This should not be a problem since Java classes are limited in number -
     534    //if they grew indefinitely, the JVM itself would crash.
     535    private static final Map<Class<?>, LispObject> javaClassMap = new HashMap<Class<?>, LispObject>();
     536
     537    public static LispObject registerJavaClass(Class<?> javaClass, LispObject classMetaObject) {
     538  synchronized (javaClassMap) {
     539      javaClassMap.put(javaClass, classMetaObject);
     540      return classMetaObject;
     541  }
     542    }
     543
     544    public static LispObject findJavaClass(Class<?> javaClass) {
     545  synchronized (javaClassMap) {
     546      LispObject c = javaClassMap.get(javaClass);
     547      if (c != null) {
     548    return c;
     549      } else {
     550    return NIL;
     551      }
     552  }
     553    }
     554
     555    private static final Primitive _FIND_JAVA_CLASS = new Primitive("%find-java-class", PACKAGE_JAVA, false, "class-name-or-class") {
     556      public LispObject execute(LispObject arg) {
     557    try {
     558        if(arg instanceof AbstractString) {
     559      return findJavaClass(Class.forName((String) arg.getStringValue()));
     560        } else {
     561      return findJavaClass((Class<?>) arg.javaInstance());
     562        }
     563    } catch (ClassNotFoundException e) {
     564        return error(new LispError("Cannot find Java class " + arg.getStringValue()));
     565    }
     566      }
     567     
     568  };
     569
     570    private static final Primitive _REGISTER_JAVA_CLASS = new Primitive("%register-java-class", PACKAGE_JAVA, false, "jclass class-metaobject") {
     571      public LispObject execute(LispObject jclass, LispObject classMetaObject) {
     572    return registerJavaClass((Class<?>) jclass.javaInstance(), classMetaObject);
     573      }
     574     
     575  };
     576
    525577}
  • trunk/abcl/src/org/armedbear/lisp/StandardClass.java

    r12582 r12583  
    396396    addStandardClass(Symbol.BUILT_IN_CLASS, list(CLASS));
    397397
    398   public static final StandardClass JAVA_CLASS =
    399       addStandardClass(Symbol.JAVA_CLASS, list(CLASS));
    400  
    401398  public static final StandardClass FORWARD_REFERENCED_CLASS =
    402399    addStandardClass(Symbol.FORWARD_REFERENCED_CLASS, list(CLASS));
     
    549546    BUILT_IN_CLASS.setCPL(BUILT_IN_CLASS, CLASS, STANDARD_OBJECT,
    550547                          BuiltInClass.CLASS_T);
    551     JAVA_CLASS.setCPL(JAVA_CLASS, CLASS, STANDARD_OBJECT,
    552             BuiltInClass.CLASS_T);
    553548    CELL_ERROR.setCPL(CELL_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
    554549                      STANDARD_OBJECT, BuiltInClass.CLASS_T);
  • trunk/abcl/src/org/armedbear/lisp/autoloads.lisp

    r12516 r12583  
    280280(export 'jruntime-class-exists-p "JAVA")
    281281(autoload 'jruntime-class-exists-p "runtime-class")
     282(export 'ensure-java-class "JAVA")
     283(autoload 'ensure-java-class "java")
    282284
    283285;; Profiler.
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r12578 r12583  
    579579  (getf canonical-slot :name))
    580580
    581 (defvar *extensible-built-in-classes* (list (find-class 'sequence)))
     581(defvar *extensible-built-in-classes* (list (find-class 'sequence) (find-class 'java:java-object)))
    582582
    583583(defun ensure-class (name &rest all-keys &key metaclass &allow-other-keys)
     
    972972  ((and (consp specializer)
    973973              (eq (car specializer) 'java:jclass))
    974          (let ((class-name (cadr specializer)))
    975            (when (and (consp class-name)
    976                       (eq (car class-name) 'quote))
    977              (setf class-name (cadr class-name)))
    978            (java::%find-java-class class-name)))
     974         (let ((jclass (eval specializer)))
     975     (java::ensure-java-class jclass)))
    979976        (t
    980977         (error "Unknown specializer: ~S" specializer))))
  • trunk/abcl/src/org/armedbear/lisp/java.lisp

    r12315 r12583  
    3333
    3434(require "CLOS")
     35(require "PRINT-OBJECT")
    3536
    3637(defun jregister-handler (object event handler &key data count)
     
    309310  (%jset-property-value obj prop value))
    310311
    311 (provide "JAVA-EXTENSIONS")
     312;;; print-object
     313
     314(defmethod print-object ((obj java:java-object) stream)
     315  (write-string (sys::%write-to-string obj) stream))
     316
     317(defmethod print-object ((e java:java-exception) stream)
     318  (if *print-escape*
     319      (print-unreadable-object (e stream :type t :identity t)
     320        (format stream "~A"
     321                (java:jcall (java:jmethod "java.lang.Object" "toString")
     322                            (java:java-exception-cause e))))
     323      (format stream "Java exception '~A'."
     324              (java:jcall (java:jmethod "java.lang.Object" "toString")
     325                          (java:java-exception-cause e)))))
     326
     327;;; JAVA-CLASS support
     328
     329(defclass java-class (standard-class)
     330  ((jclass :initarg :java-class
     331     :initform (error "class is required")
     332     :reader java-class-jclass)))
     333
     334(defun ensure-java-class (jclass)
     335  (let ((class (%find-java-class jclass)))
     336    (if class
     337  class
     338  (%register-java-class
     339   jclass (mop::ensure-class (make-symbol (jclass-name jclass))
     340           :metaclass (find-class 'java-class)
     341           :direct-superclasses (if (jclass-superclass-p jclass (jclass "java.lang.Object"))
     342                  (list (find-class 'java-object))
     343                  (mapcar #'ensure-java-class
     344                    (delete nil
     345                      (concatenate 'list (list (jclass-superclass jclass))
     346                       (jclass-interfaces jclass)))))
     347           :java-class jclass)))))
     348   
     349(defmethod make-instance ((class java-class) &rest initargs &key &allow-other-keys)
     350  (declare (ignore initargs))
     351  (error "make-instance not supported for ~S" class))
     352
     353(provide "JAVA")
  • trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp

    r12400 r12583  
    3232(in-package #:system)
    3333
     34(require "JAVA")
     35
    3436(export '(lookup-known-symbol))
    3537
  • trunk/abcl/src/org/armedbear/lisp/print-object.lisp

    r12379 r12583  
    3333
    3434(require 'clos)
    35 (require 'java)
    3635
    3736(when (autoloadp 'print-object)
     
    5049    (format stream "~S" (class-name (class-of object))))
    5150  object)
    52 
    53 (defmethod print-object ((obj java:java-object) stream)
    54   (write-string (%write-to-string obj) stream))
    55 
    56 (defmethod print-object ((class java:java-class) stream)
    57   (write-string (%write-to-string class) stream))
    5851
    5952(defmethod print-object ((class class) stream)
     
    124117      (format stream "The variable ~S is unbound." (cell-error-name x))))
    125118
    126 (defmethod print-object ((e java:java-exception) stream)
    127   (if *print-escape*
    128       (print-unreadable-object (e stream :type t :identity t)
    129         (format stream "~A"
    130                 (java:jcall (java:jmethod "java.lang.Object" "toString")
    131                             (java:java-exception-cause e))))
    132       (format stream "Java exception '~A'."
    133               (java:jcall (java:jmethod "java.lang.Object" "toString")
    134                           (java:java-exception-cause e)))))
    135 
    136119(provide 'print-object)
Note: See TracChangeset for help on using the changeset viewer.