Re: [usocket-devel] [usocket-cvs] r553 - in usocket/trunk: . backend vendor
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
Hi, Erik If I remove JDI stuff, where can I find those JDI functions (do-jmethod-call, ...)? ABCL supply them now? Regards, Chun Tian (binghe) 在 2010-7-20，18:49， Erik Huelsmann 写道：
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
Ah ... I saw a sample from http://common-lisp.net/project/armedbear/doc/abcl-user.html OK, will try to use the new interface. --binghe 在 2010-7-20，19:44， Chun Tian (binghe) 写道：
Hi, Erik
If I remove JDI stuff, where can I find those JDI functions (do-jmethod-call, ...)? ABCL supply them now?
Regards,
Chun Tian (binghe)
在 2010-7-20，18:49， Erik Huelsmann 写道：
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
done. I think ABCL's Java interface is still quite trivial. Maybe some days in the future, people can directly export any Java class into CLOS class and operate them the same way as CLOS. (This requires lots of MOP work, but ABCL's current MOP support is quite limited) --binghe 在 2010-7-20，19:48， Chun Tian (binghe) 写道：
Ah ... I saw a sample from http://common-lisp.net/project/armedbear/doc/abcl-user.html
OK, will try to use the new interface.
--binghe
在 2010-7-20，19:44， Chun Tian (binghe) 写道：
Hi, Erik
If I remove JDI stuff, where can I find those JDI functions (do-jmethod-call, ...)? ABCL supply them now?
Regards,
Chun Tian (binghe)
在 2010-7-20，18:49， Erik Huelsmann 写道：
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.
participants (2)
-
Chun Tian (binghe) -
Erik Huelsmann