New subject: [usocket-devel] [usocket-cvs] r553 - in usocket/trunk: . backend vendor

20 Jul 2010

Hi Chun,
I think the JDI stuff I added way back when, isn't needed anymore. You
could try removing it. Before, it wasn't always possible to
dynamically determine retrieve a method from a JavaObject. Now, since
it has an IntendedClass slot, the information that JDI was trying to
capture, has been added to the base JavaObject class.
If you want, I can help to phase out JDI.
With kind regards,
Erik.
On Tue, Jul 20, 2010 at 7:48 AM, Chun Tian ctian@common-lisp.net wrote:
...
Author: ctian
Date: Tue Jul 20 01:48:39 2010
New Revision: 553
Log:
ABCL: move JDI into vendor directory.
Added:
  usocket/trunk/vendor/abcl-jdi.lisp   (contents, props changed)
Modified:
  usocket/trunk/backend/armedbear.lisp
  usocket/trunk/usocket.asd
Modified: usocket/trunk/backend/armedbear.lisp

--- usocket/trunk/backend/armedbear.lisp        (original)
+++ usocket/trunk/backend/armedbear.lisp        Tue Jul 20 01:48:39 2010
@@ -5,178 +5,6 @@
(in-package :usocket)



-;;; Proposed contribution to the JAVA package



-(defpackage :jdi

(:use :cl)
(:export #:jcoerce
#:jop-deref
#:do-jmethod-call
#:do-jmethod
#:do-jstatic-call
#:do-jstatic
#:do-jnew-call
#:do-jfield
#:jequals))

-;; but still requires the :java package.



-(in-package :jdi)



-(defstruct (java-object-proxy (:conc-name :jop-)

:copier)
value
class)


-(defvar *jm-get-return-type*

(java:jmethod "java.lang.reflect.Method" "getReturnType"))


-(defvar *jf-get-type*

(java:jmethod "java.lang.reflect.Field" "getType"))


-(defvar *jc-get-declaring-class*

(java:jmethod "java.lang.reflect.Constructor" "getDeclaringClass"))


-(declaim (inline make-return-type-proxy))
-(defun make-return-type-proxy (jmethod jreturned-value)

(if (java:java-object-p jreturned-value)
(let ((rt (java:jcall *jm-get-return-type* jmethod)))
(make-java-object-proxy :value jreturned-value
:class rt))
jreturned-value))


-(defun make-field-type-proxy (jfield jreturned-value)

(if (java:java-object-p jreturned-value)
(let ((rt (java:jcall *jf-get-type* jfield)))
(make-java-object-proxy :value jreturned-value
:class rt))
jreturned-value))


-(defun make-constructor-type-proxy (jconstructor jreturned-value)

(if (java:java-object-p jreturned-value)
(let ((rt (java:jcall *jc-get-declaring-class* jconstructor)))
(make-java-object-proxy :value jreturned-value
:class rt))
jreturned-value))


-(defun jcoerce (instance &optional output-type-spec)

(cond
((java-object-proxy-p instance)
(let ((new-instance (copy-structure (the java-object-proxy instance))))
(setf (jop-class new-instance)
(java:jclass output-type-spec))
new-instance))
((java:java-object-p instance)
(make-java-object-proxy :class (java:jclass output-type-spec)
:value instance))
((stringp instance)
(make-java-object-proxy :class "java.lang.String"
:value instance))
((keywordp output-type-spec)
;; all that remains is creating an immediate type...
(let ((jval (java:make-immediate-object instance output-type-spec)))
(make-java-object-proxy :class output-type-spec
:value jval)))
))


-(defun jtype-of (instance) ;;instance must be a jop

(cond
((stringp instance)
"java.lang.String")
((keywordp (jop-class instance))
(string-downcase (symbol-name (jop-class instance))))
(t
(java:jclass-name (jop-class instance)))))


-(declaim (inline jop-deref))
-(defun jop-deref (instance)

(if (java-object-proxy-p instance)
(jop-value instance)
instance))


-(defun java-value-and-class (object)

(values (jop-deref object)
(jtype-of object)))


-(defun do-jmethod-call (object method-name &rest arguments)

(multiple-value-bind
(instance class-name)
(java-value-and-class object)
(let* ((argument-types (mapcar #'jtype-of arguments))
(jm (apply #'java:jmethod class-name method-name argument-types))
(rv (apply #'java:jcall jm instance
(mapcar #'jop-deref arguments))))
(make-return-type-proxy jm rv))))


-(defun do-jstatic-call (class-name method-name &rest arguments)

(let* ((argument-types (mapcar #'jtype-of arguments))
(jm (apply #'java:jmethod class-name method-name argument-types))
(rv (apply #'java:jstatic jm (java:jclass class-name)
(mapcar #'jop-deref arguments))))
(make-return-type-proxy jm rv)))


-(defun do-jnew-call (class-name &rest arguments)

(let* ((argument-types (mapcar #'jtype-of arguments))
(jm (apply #'java:jconstructor class-name argument-types))
(rv (apply #'java:jnew jm (mapcar #'jop-deref arguments))))
(make-constructor-type-proxy jm rv)))


-(defun do-jfield (class-or-instance-or-name field-name)

(let* ((class (cond
((stringp class-or-instance-or-name)
(java:jclass class-or-instance-or-name))
((java:java-object-p class-or-instance-or-name)
(java:jclass-of class-or-instance-or-name))
((java-object-proxy-p class-or-instance-or-name)
(java:jclass (jtype-of class-or-instance-or-name)))))
(jf (java:jcall (java:jmethod "java.lang.Class" "getField"
"java.lang.String")
class field-name)))
(make-field-type-proxy jf
(java:jfield class field-name)))) ;;class))))


-(defmacro do-jstatic (&rest arguments)

`(do-jstatic-call ,@arguments))


-(defmacro do-jmethod (&rest arguments)

`(do-jmethod-call ,@arguments))


-;;



-(defmacro jstatic-call (class-name (method-name &rest arg-spec)

&rest args)
(let ((class-sym (gensym)))
`(let ((,class-sym ,class-name))
(java:jstatic
(java:jmethod ,class-sym ,method-name ,@arg-spec)
(java:jclass ,class-sym) ,@args))))


-(defmacro jmethod-call (instance-and-class (method &rest arg-spec) &rest args)

(let ((isym (gensym)))
(multiple-value-bind
(instance class-name)
(if (listp instance-and-class)
(values (first instance-and-class)
(second instance-and-class))
(values instance-and-class))
(when (null class-name)
(setf class-name `(java:jclass-name (java:jclass-of ,isym))))
`(let* ((,isym ,instance))
(java:jcall (java:jmethod ,class-name ,method ,@arg-spec)
,isym ,@args)))))


-(defun jequals (x y)

(do-jmethod-call (jcoerce x "java.lang.Object") "equals"
(jcoerce y "java.lang.Object")))


-(defmacro jnew-call ((class &rest arg-spec) &rest args)

`(java:jnew (java:jconstructor ,class ,@arg-spec)
,@args))




-(in-package :usocket)



(defun get-host-name ()
  (jdi:do-jmethod-call (jdi:do-jstatic-call "java.net.InetAddress"
                                            "getLocalHost")
Modified: usocket/trunk/usocket.asd
--- usocket/trunk/usocket.asd   (original)
+++ usocket/trunk/usocket.asd   Tue Jul 20 01:48:39 2010
@@ -23,6 +23,7 @@
                 :components ((:file "split-sequence")
                              #+mcl (:file "kqueue")
                              #+openmcl (:file "ccl-send")

#+armedbear (:file "abcl-jdi")

(:file "spawn-thread")))
                 (:file "usocket" :depends-on ("vendor"))
                 (:file "condition" :depends-on ("usocket"))
Added: usocket/trunk/vendor/abcl-jdi.lisp
--- (empty file)
+++ usocket/trunk/vendor/abcl-jdi.lisp  Tue Jul 20 01:48:39 2010
@@ -0,0 +1,170 @@
+;;;; $Id$
+;;;; $URL$



+;;;; Proposed contribution to the JAVA package, by Erik Huelsmann



+(defpackage :jdi

(:use :cl)
(:export #:jcoerce
#:jop-deref
#:do-jmethod-call
#:do-jmethod
#:do-jstatic-call
#:do-jstatic
#:do-jnew-call
#:do-jfield
#:jequals))


+;; but still requires the :java package.



+(in-package :jdi)



+(defstruct (java-object-proxy (:conc-name :jop-)

:copier)
value
class)


+(defvar *jm-get-return-type*

(java:jmethod "java.lang.reflect.Method" "getReturnType"))


+(defvar *jf-get-type*

(java:jmethod "java.lang.reflect.Field" "getType"))


+(defvar *jc-get-declaring-class*

(java:jmethod "java.lang.reflect.Constructor" "getDeclaringClass"))


+(declaim (inline make-return-type-proxy))
+(defun make-return-type-proxy (jmethod jreturned-value)

(if (java:java-object-p jreturned-value)
(let ((rt (java:jcall *jm-get-return-type* jmethod)))
(make-java-object-proxy :value jreturned-value
:class rt))
jreturned-value))


+(defun make-field-type-proxy (jfield jreturned-value)

(if (java:java-object-p jreturned-value)
(let ((rt (java:jcall *jf-get-type* jfield)))
(make-java-object-proxy :value jreturned-value
:class rt))
jreturned-value))


+(defun make-constructor-type-proxy (jconstructor jreturned-value)

(if (java:java-object-p jreturned-value)
(let ((rt (java:jcall *jc-get-declaring-class* jconstructor)))
(make-java-object-proxy :value jreturned-value
:class rt))
jreturned-value))


+(defun jcoerce (instance &optional output-type-spec)

(cond
((java-object-proxy-p instance)
(let ((new-instance (copy-structure (the java-object-proxy instance))))
(setf (jop-class new-instance)
(java:jclass output-type-spec))
new-instance))
((java:java-object-p instance)
(make-java-object-proxy :class (java:jclass output-type-spec)
:value instance))
((stringp instance)
(make-java-object-proxy :class "java.lang.String"
:value instance))
((keywordp output-type-spec)
;; all that remains is creating an immediate type...
(let ((jval (java:make-immediate-object instance output-type-spec)))
(make-java-object-proxy :class output-type-spec
:value jval)))
))


+(defun jtype-of (instance) ;;instance must be a jop

(cond
((stringp instance)
"java.lang.String")
((keywordp (jop-class instance))
(string-downcase (symbol-name (jop-class instance))))
(t
(java:jclass-name (jop-class instance)))))


+(declaim (inline jop-deref))
+(defun jop-deref (instance)

(if (java-object-proxy-p instance)
(jop-value instance)
instance))


+(defun java-value-and-class (object)

(values (jop-deref object)
(jtype-of object)))


+(defun do-jmethod-call (object method-name &rest arguments)

(multiple-value-bind
(instance class-name)
(java-value-and-class object)
(let* ((argument-types (mapcar #'jtype-of arguments))
(jm (apply #'java:jmethod class-name method-name argument-types))
(rv (apply #'java:jcall jm instance
(mapcar #'jop-deref arguments))))
(make-return-type-proxy jm rv))))


+(defun do-jstatic-call (class-name method-name &rest arguments)

(let* ((argument-types (mapcar #'jtype-of arguments))
(jm (apply #'java:jmethod class-name method-name argument-types))
(rv (apply #'java:jstatic jm (java:jclass class-name)
(mapcar #'jop-deref arguments))))
(make-return-type-proxy jm rv)))


+(defun do-jnew-call (class-name &rest arguments)

(let* ((argument-types (mapcar #'jtype-of arguments))
(jm (apply #'java:jconstructor class-name argument-types))
(rv (apply #'java:jnew jm (mapcar #'jop-deref arguments))))
(make-constructor-type-proxy jm rv)))


+(defun do-jfield (class-or-instance-or-name field-name)

(let* ((class (cond
((stringp class-or-instance-or-name)
(java:jclass class-or-instance-or-name))
((java:java-object-p class-or-instance-or-name)
(java:jclass-of class-or-instance-or-name))
((java-object-proxy-p class-or-instance-or-name)
(java:jclass (jtype-of class-or-instance-or-name)))))
(jf (java:jcall (java:jmethod "java.lang.Class" "getField"
"java.lang.String")
class field-name)))
(make-field-type-proxy jf
(java:jfield class field-name)))) ;;class))))


+(defmacro do-jstatic (&rest arguments)

`(do-jstatic-call ,@arguments))


+(defmacro do-jmethod (&rest arguments)

`(do-jmethod-call ,@arguments))


+;;



+(defmacro jstatic-call (class-name (method-name &rest arg-spec)

&rest args)
(let ((class-sym (gensym)))
`(let ((,class-sym ,class-name))
(java:jstatic
(java:jmethod ,class-sym ,method-name ,@arg-spec)
(java:jclass ,class-sym) ,@args))))


+(defmacro jmethod-call (instance-and-class (method &rest arg-spec) &rest args)

(let ((isym (gensym)))
(multiple-value-bind
(instance class-name)
(if (listp instance-and-class)
(values (first instance-and-class)
(second instance-and-class))
(values instance-and-class))
(when (null class-name)
(setf class-name `(java:jclass-name (java:jclass-of ,isym))))
`(let* ((,isym ,instance))
(java:jcall (java:jmethod ,class-name ,method ,@arg-spec)
,isym ,@args)))))


+(defun jequals (x y)

(do-jmethod-call (jcoerce x "java.lang.Object") "equals"
(jcoerce y "java.lang.Object")))


+(defmacro jnew-call ((class &rest arg-spec) &rest args)

`(java:jnew (java:jconstructor ,class ,@arg-spec)
,@args))


usocket-cvs mailing list
usocket-cvs@common-lisp.net
http://common-lisp.net/cgi-bin/mailman/listinfo/usocket-cvs

    

Re: [usocket-devel] [usocket-cvs] r553 - in usocket/trunk: . backend vendor

Modified: usocket/trunk/backend/armedbear.lisp

Modified: usocket/trunk/usocket.asd

Added: usocket/trunk/vendor/abcl-jdi.lisp

Modified: usocket/trunk/backend/armedbear.lisp

Modified: usocket/trunk/usocket.asd

Added: usocket/trunk/vendor/abcl-jdi.lisp

Modified: usocket/trunk/backend/armedbear.lisp

Modified: usocket/trunk/usocket.asd

Added: usocket/trunk/vendor/abcl-jdi.lisp