X-Git-Url: https://git.distorted.org.uk/~mdw/jlisp/blobdiff_plain/a2e7266a20fff562054c0f546e4a49c03b93ce20..HEAD:/jj.lisp

diff --git a/jj.lisp b/jj.lisp
index d07d2b4..65cf675 100644
--- a/jj.lisp
+++ b/jj.lisp
@@ -24,7 +24,7 @@
 (defpackage #:jj
   (:use #:common-lisp #:java)
   (:export #:java-name #:lisp-name
-	   #:java-true #:java-false #:java-null
+	   #:java-true #:java-false #:java-null #:jboolean
 	   #:send #:send-class #:make #:make-java-array #:java-array
 	   #:field #:class-field
 	   #:magic-constant-case
@@ -262,6 +262,10 @@
 (defconstant java-null (make-immediate-object nil :ref)
   "A Java null reference.")
 
+(defun jboolean (thing)
+  "Return JAVA-TRUE if THING is non-nil, JAVA-FALSE if THING is nil."
+  (if thing java-true java-false))
+
 (defmacro define-java-method (lisp-name class method &body args)
   "Define a Lisp function LISP-NAME to call the named METHOD of CLASS on the
    given arguments.  The CLASS may be a string or symbol (it is converted by
@@ -382,10 +386,11 @@
   (list (java-class-name java-class)
 	(cons :constructors
 	      (expand-java-method (ensure-java-constructor java-class)))
-	(loop for name being the hash-keys
-	      of (ensure-java-method-table java-class)
-	      using (hash-value method)
-	      collect (cons name (expand-java-method method)))))
+	(sort (loop for name being the hash-keys
+		    of (ensure-java-method-table java-class)
+		    using (hash-value method)
+		    collect (cons name (expand-java-method method)))
+	      (lambda (x y) (string< (car x) (car y))))))
 
 (defparameter *conversions*
   (let ((raw '((java.lang.*object boolean)
@@ -414,7 +419,8 @@
 (defun jclass-convertible-p (from to)
   "Return whether there is an automatic conversion between FROM and TO.  This
    can be considered a partial order on types."
-  (or (jclass-superclass-p to from)
+  (or (null from)
+      (jclass-superclass-p to from)
       (member from (assoc to *conversions* :test #'equal)
 	      :test #'equal)))
 
@@ -428,7 +434,7 @@
 	(t (and (jclass-convertible-p (car first) (car second))
 		(argument-list-betterp (cdr first) (cdr second))))))
 
-(defun get-jmethod-for-argument-types (java-method argument-types)
+(defun get-jmethod-for-argument-types (java-class java-method argument-types)
   "Given a JAVA-METHOD structure, return the best match overload for the
    given list of ARGUMENT-TYPES.
 
@@ -494,7 +500,10 @@
 	    (format t "*** chosen = ~S~%"
 		    (expand-methodlist chosen)))
 	  (cond ((null chosen)
-		 (error "No match found.~%  method = ~A, args = ~A"
+		 (error "No match found.~%  ~
+			 class = ~A, method = ~A~%  ~
+			 args = ~A"
+			(java-class-name java-class)
 			(java-method-name java-method)
 			(expand-arglist argument-types)))
 		((cdr chosen)
@@ -517,14 +526,20 @@
 (defun find-jmethod (class name arg-types)
   "Given a CLASS, a method NAME, and a list of ARG-TYPES, return the Java
    method object for the best matching overload of the method."
-  (get-jmethod-for-argument-types (find-java-method class name)
-				  (argument-type-list-from-names arg-types)))
+  (let ((java-class (find-java-class class)))
+    (get-jmethod-for-argument-types
+     java-class
+     (find-java-method java-class name)
+     (argument-type-list-from-names arg-types))))
 
 (defun find-jconstructor (class arg-types)
   "Given a CLASS and a list of ARG-TYPES, return the Java constructor object
    for the best matching constructor overload."
-  (get-jmethod-for-argument-types (find-java-constructor class)
-				  (argument-type-list-from-names arg-types)))
+  (let ((java-class (find-java-class class)))
+    (get-jmethod-for-argument-types
+     java-class
+     (find-java-constructor java-class)
+     (argument-type-list-from-names arg-types))))
 
 (defun send (object message &rest arguments)
   "Given an OBJECT, a MESSAGE name (Lisp symbol or Java name string) and
@@ -533,7 +548,11 @@
   (let ((jargs (mapcar #'make-immediate-object arguments)))
     (apply #'jcall
 	   (find-jmethod (jobject-class object) message
-			 (mapcar (lambda (jarg) (jobject-class jarg)) jargs))
+			 (mapcar (lambda (jarg)
+				   (if (equal jarg java-null)
+				       nil
+				       (jobject-class jarg)))
+				 jargs))
 	   object
 	   jargs)))