Work in progress.

[jlisp] / jj.lisp

diff --git a/jj.lisp b/jj.lisp
index d07d2b4..65cf675 100644 (file)
--- 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)))