Add jtypecase form, fix print-object of null pointer

(Alan Ruttenberg)

Like typecase except the check is whether the form is an instance of
one of the classes, which are lookup up using find-java-class.

Also included: a minor fix to print-java-object-by-class - it was
getting an error while printing a null pointer.

The printer now prints null references as "#<null>".

Merges <>
parent 82f80346
......@@ -7,9 +7,11 @@
:components ((:file "packages")
(:file "invoke")
(:file "collections")
(:file "optimize-java-call")
(:file "optimize-java-call")
(:file "classpath")
(:file "transform-to-field")
(:file "compat"))))
(:file "transform-to-field")
(:file "compat")
(:file "jtypecase"))))
:perform (asdf:test-op (op c)
(asdf:test-system :jss-tests)))
(in-package :jss)
(defvar *jtypecache* (make-hash-table :test 'eq))
(defun jtypep (object type)
(declare (optimize (speed 3) (safety 0)))
(let ((class (or (gethash type *jtypecache*)
(ignore-errors (setf (gethash type *jtypecache*) (find-java-class type)))))
(method (load-time-value (jmethod "java.lang.Class" "isInstance" "java.lang.Object"))))
(and class
(jcall method class object))))
(defmacro jtypecase (keyform &body cases)
"JTYPECASE Keyform {(Type Form*)}*
Evaluates the Forms in the first clause for which Type names a class that Keyform isInstance of
is true."
(sys::case-body 'jtypecase keyform cases t 'jtypep nil nil nil))
......@@ -457,7 +457,9 @@ is equivalent to the following Java code:
;;; print-object
(defmethod print-object ((obj java:java-object) stream)
(print-java-object-by-class (intern (jclass-name (jobject-class obj)) 'keyword) obj stream))
(if (jnull-ref-p obj)
(write-string "#<null>" stream)
(print-java-object-by-class (intern (jclass-name (jobject-class obj)) 'keyword) obj stream)))
;;define extensions by eql methods on class name interned in keyword package
;;e.g. (defmethod java::print-java-object-by-class ((class (eql ':||)) obj stream)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment