Changeset 13937

Timestamp:

05/16/12 12:10:06 (12 years ago)

Author:

Mark Evenson

Message:

jss: fix ticket #205 JSS:WITH-CONSTANT-SIGNATURE.

Add more docstrings to JSS.

JAVA-CLASS-METHOD-NAMES is now a synonym for JSS.

Location:

trunk/abcl

Files:

• contrib/jss/compat.lisp (modified) (1 diff)
• contrib/jss/invoke.lisp (modified) (12 diffs)
• contrib/jss/jss.asd (modified) (1 diff)
• contrib/jss/packages.lisp (modified) (1 diff)
• test/lisp/abcl/bugs.lisp (modified) (1 diff)

trunk/abcl/contrib/jss/compat.lisp

@@ -5 +5 @@
 
 (defun ensure-compatibility ()
+  "Ensure backwards compatibility with JSS's use of CL-USER."
   (require 'abcl-asdf)
   (loop :for symbol :in '("add-directory-jars-to-class-path"

trunk/abcl/contrib/jss/invoke.lisp

@@ -2 +2 @@
 ;;
 ;; Copyright (C) 2005 Alan Ruttenberg
-;; Copyright (C) 2011 Mark Evenson
+;; Copyright (C) 2011-2 Mark Evenson
 ;;
 ;; Since most of this code is derivative of the Jscheme System, it is
@@ -123 +123 @@
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (defvar *do-auto-imports* t))
+  (defvar *do-auto-imports* t 
+    "Whether to automatically introspect all Java classes on the classpath when JSS is loaded."))
 
 (defvar *imports-resolved-classes* (make-hash-table :test 'equal))
 
 (defun find-java-class (name)
+  "Returns the java.lang.Class representation of NAME.
+
+NAME can either string or a symbol according to the usual JSS conventions."
   (jclass (maybe-resolve-class-against-imports name)))
 
@@ -177 +181 @@
                 (apply #'jcall method object args))))))
 
-;;; Method name as String --> String  | Symbol --> jmethod
-(defvar *methods-cache* (make-hash-table :test #'equal))
-
-(defun get-jmethod (method object) 
-  (when (gethash method *methods-cache*)
-    (gethash 
-     (if (symbolp object) (lookup-class-name object) (jobject-class object))
-     (gethash method *methods-cache*))))
-
-(defun set-jmethod (method object jmethod) 
-  (unless (gethash method *methods-cache*)
-    (setf (gethash method *methods-cache*) (make-hash-table :test #'equal)))
-  (setf 
-   (gethash 
-    (if (symbolp object) (lookup-class-name object) (jobject-class object))
-    (gethash method *methods-cache*))
-   jmethod))
-
 (defconstant +set-accessible+ 
   (jmethod "java.lang.reflect.AccessibleObject" "setAccessible" "boolean"))
 
-;;; TODO optimize me!
 (defun invoke-find-method (method object args)
-  (let ((jmethod (get-jmethod method object)))
-    (unless jmethod
-      (setf jmethod 
-            (if (symbolp object)
+  (let ((result 
+         (if (symbolp object)
                 ;;; static method
-                (apply #'jmethod (lookup-class-name object) 
-                       method (mapcar #'jobject-class args))
+             (apply #'jmethod (lookup-class-name object) 
+                    method (mapcar #'jobject-class args))
                   ;;; instance method
-                (apply #'jresolve-method 
-                       method object args)))
-      (jcall +set-accessible+ jmethod +true+)
-      (set-jmethod method object jmethod))
-    jmethod))
+             (apply #'jresolve-method 
+                    method object args))))
+    (jcall +set-accessible+ result +true+)
+    result))
 
 ;; This is the reader macro for java methods. it translates the method
@@ -233 +215 @@
 
 (defmacro with-constant-signature (fname-jname-pairs &body body)
+  "Expand all references to FNAME-JNAME-PAIRS in BODY into static function calls promising that the same function bound in the FNAME-JNAME-PAIRS will be invoked with the same argument signature.
+
+FNAME-JNAME-PAIRS is a list of (symbol function &optional raw)
+elements where symbol will be the symbol bound to the method named by
+the string function.  If the optional parameter raw is non-nil, the
+result will be the raw JVM object, uncoerced by the usual conventions.
+
+Use this macro if you are making a lot of calls and 
+want to avoid the overhead of the dynamic dispatch."
+
   (if (null fname-jname-pairs)
       `(progn ,@body)
@@ -260 +252 @@
                   (jclass "java.util.regex.Pattern") 
                   ".*?([^.]*)$")))
-
    (last-name 
     (let ((matcher (#0"matcher" last-name-pattern name)))
@@ -309 +300 @@
 
 (defun jar-import (file)
+  "Import all the Java classes contained in the pathname FILE into the JSS dynamic lookup cache."
   (when (probe-file file)
     (loop for (name . full-class-name) in (get-all-jar-classnames file)
@@ -316 +308 @@
 
 (defun new (class-name &rest args)
+  "Invoke the Java constructor for CLASS-NAME with ARGS.
+
+CLASS-NAME may either be a symbol or a string according to the usual JSS conventions."
   (invoke-restargs 'new class-name args))
 
@@ -405 +400 @@
 
 (defun japropos (string)
+"Output the names of all Java class names loaded in the current process which match STRING.."
   (setq string (string string))
   (let ((matches nil))
@@ -426 +422 @@
    (ignore-errors (remove-duplicates (map 'list (if full #"toString" 'jmethod-name) (#"getConstructors" (find-java-class class))) :test 'equal))))
 
-(defun jcmn (class &optional full)
-  (if full 
+(defun java-class-method-names (class &optional stream)
+  "Return a list of the public methods encapsulated by the JVM CLASS.
+
+If STREAM non-nil, output a verbose description to the named output stream.
+
+CLASS may either be a string naming a fully qualified JVM class in dot
+notation, or a symbol resolved against all class entries in the
+current classpath."
+  (if stream
       (dolist (method (jclass-method-names class t))
-  (format t "~a~%" method))
+  (format stream "~a~%" method))
       (jclass-method-names class)))
+
+(setf (symbol-function 'jcmn) 'java-class-method-names)
 
 (defun path-to-class (classname)
@@ -504 +509 @@
 
 (defun classfiles-import (directory)
+  "Load all Java classes recursively contained under DIRECTORY in the current process."
   (setq directory (truename directory))
   (loop for full-class-name in (all-classes-below-directory directory)
@@ -526 +532 @@
 
 (defun jarray-to-list (jarray)
+  "Convert the Java array named by JARRARY into a Lisp list."
   (declare (optimize (speed 3) (safety 0)))
   (jlist-to-list
@@ -546 +553 @@
 
 (defun iterable-to-list (iterable)
+  "Return the items contained the java.lang.Iterable ITERABLE as a list."
  (declare (optimize (speed 3) (safety 0)))
  (let ((it (#"iterator" iterable)))

trunk/abcl/contrib/jss/jss.asd

@@ -4 +4 @@
 (defsystem :jss
   :author "Alan Ruttenberg, Mark Evenson"
-  :version "3.0.2" 
+  :version "3.0.3" 
   :components 
   ((:module base 

trunk/abcl/contrib/jss/packages.lisp

@@ -12 +12 @@
    #:invoke-add-imports
    #:find-java-class
-   #:jcmn
+   #:jcmn #:java-class-method-names
    #:japropos
    #:new 

trunk/abcl/test/lisp/abcl/bugs.lisp

@@ -111 +111 @@
       (require :jss)
       (jss:with-constant-signature ((substring "substring")) 
-        (substring "some string" 2)))
-  t)
+        (substring "01234" 2)))
+  "234")