[j-devel] [PATCH] compile constant immediate objects (True, False and null) as constants

[XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX]

Now that I know how to generate constant values (or at least, one-time
evaluations), I thought it would be nice to extend it to
make-immediate-object for the cases where it is actually a constant
transformation.

bye,


Erik.


Index: src/org/armedbear/lisp/java.lisp
===================================================================
RCS file: /cvsroot/armedbear-j/j/j/src/org/armedbear/lisp/java.lisp,v
retrieving revision 1.26
diff -u -r1.26 java.lisp
--- src/org/armedbear/lisp/java.lisp    31 May 2007 19:11:09 -0000      1.26
+++ src/org/armedbear/lisp/java.lisp    1 Jun 2007 22:44:55 -0000
@@ -190,8 +190,16 @@

 (defmethod make-load-form ((object java-object) &optional environment)
   (declare (ignore environment))
-  (let ((class-name (jclass-name (jclass-of object))))
+  (let ((class-name (ignore-errors
+                      ;; a null-value object will cause an error here!
+                      (jclass-name (jclass-of object)))))
     (cond
+     ((null class-name)
+      ;; so, when we have a null class-name, it's because retrieving it
+      ;; errored and we have a null object at our hands :-)
+      `(java:make-immediate-object NIL :ref))
+     ((string= class-name "java.lang.Boolean")
+      `(java:make-immediate-object ,(jobject-lisp-value object) :boolean))
      ((string= class-name "java.lang.reflect.Constructor")
       `(java:jconstructor ,(jclass-name
                             (jcall (jmethod "java.lang.reflect.Constructor"
Index: src/org/armedbear/lisp/jvm.lisp
===================================================================
RCS file: /cvsroot/armedbear-j/j/j/src/org/armedbear/lisp/jvm.lisp,v
retrieving revision 1.781
diff -u -r1.781 jvm.lisp
--- src/org/armedbear/lisp/jvm.lisp     31 May 2007 19:10:47 -0000      1.781
+++ src/org/armedbear/lisp/jvm.lisp     1 Jun 2007 22:44:56 -0000
@@ -9355,6 +9355,23 @@
           (t
            (compile-function-call form target representation)))))

+(defknown p2-java-make-immediate-object (t t t) t)
+(defun p2-java-make-immediate-object (form target representation)
+  (destructuring-bind (func value &optional type)
+      form
+    (when (and (eq type :boolean)
+               (or (eq t value)
+                   (null value)))
+      (compile-constant (java:make-immediate-object value :boolean)
+                        target representation)
+      (return-from p2-java-make-immediate-object))
+    (when (and (eq type :ref)
+               (null value))
+      (compile-constant (java:make-immediate-object NIL :ref)
+                        target representation)
+      (return-from p2-java-make-immediate-object))
+  (compile-function-call form target representation))
+
 (defknown p2-java-jclass (t t t) t)
 (defun p2-java-jclass (form target representation)
   (unless (and (= 2 (length form))
@@ -10452,6 +10469,8 @@
   (install-p2-handler 'cdr                 'p2-cdr)
   (install-p2-handler 'char                'p2-char/schar)
   (install-p2-handler 'char-code           'p2-char-code)
+  (install-p2-handler 'java:make-immediate-object
+                                           'p2-java-make-immediate-object)
   (install-p2-handler 'java:jclass         'p2-java-jclass)
   (install-p2-handler 'java:jconstructor   'p2-java-jconstructor)
   (install-p2-handler 'java:jmethod        'p2-java-jmethod)