no title pasted by mercora on Mon Apr 8 17:21:21 2013

(define-syntax jlambda-method*
  (syntax-rules ()
    ((_ modifier class-name return-type method-name (arg-type ...) (arg-name ...))
     (let ((class-object (class class-name))
	   (method (method-id modifier class-object return-type method-name arg-type ...))
	   (jvalue-array (make-jvalue-array* (arg-name ...))))       
       (lambda (arg-name ...)
	 (build-jvalue-array* jvalue-array (arg-type ...) (arg-name ...))
	 (check-jexception))))))

(pp (expand* '(jlambda-method* static java.lang.String java.lang.String valueOf (int long double java.lang.String) (a1 a2 a3 a4))))


(define-syntax arg-types->arg-names*
  (er-macro-transformer
   (lambda (x r c)
     (let ((arg-types (cdr x)))
       (map (lambda (x)
	      (symbol-append 'a x)) 
	    (map (compose string->symbol number->string) 
		 (iota (length arg-types))))))))


(define-syntax jlambda-method**
  (syntax-rules ()
    ((_ modifier class-name return-type method-name arg-type ...)
     (jlambda-method* modifier class-name return-type method-name (arg-type ...) (arg-types->arg-names* arg-type ...)))))

no title pasted by mercora on Mon Apr 8 17:37:15 2013


(define-syntax build-jvalue-array*
  (er-macro-transformer
   (lambda (x r c)
     (pp x)
     (let ((jvalue-array (cadr x))
	   (argument-types (caddr x))
	   (argument-names (cadddr x)))
       
       (let ((%begin (r 'begin)))
	 `(,%begin
	    ,@(map (lambda (type value-name index)
		     (case type
		       ((boolean byte char short int long float double)
			`(set-jvalue! ,type ,jvalue-array ,index ,value-name))
		       (else
			`(set-jvalue! object ,jvalue-array ,index ,value-name))))
		   argument-types argument-names (iota (length argument-types)))))))))

no title pasted by mercora on Mon Apr 8 17:55:12 2013

(##core#let
  ((class-object573 (find-class/jni582 "java/lang/String"))
   (method575
     (get-static-method-id585
       class-object573
       (symbol->string586 (##core#quote valueOf))
       "(IJDLjava/lang/String;)Ljava/lang/String;"))
   (jvalue-array577 (make-jvalue-array589 5)))
  (##core#lambda
    (a0 a1 a2 a3)
    (##core#begin
      (set-int-jvalue!596 jvalue-array577 0 arg-types->arg-names*571)
      (set-long-jvalue!603 jvalue-array577 1 int)
      (set-double-jvalue!612 jvalue-array577 2 long)
      (set-object-jvalue!622 jvalue-array577 3 double))
    (check-jexception581)))

no title added by mercora on Mon Apr 8 17:59:34 2013

(define-syntax set-jvalue!
       (syntax-rules (boolean byte char short int long float double object)
	 ((_ boolean jvalue-array index value)
	  (set-boolean-jvalue! jvalue-array index value))
	 ((_ byte    jvalue-array index value)
	  (set-byte-jvalue!    jvalue-array index value))
	 ((_ char    jvalue-array index value)
	  (set-char-jvalue!    jvalue-array index value))
	 ((_ short   jvalue-array index value)
	  (set-short-jvalue!   jvalue-array index value))
	 ((_ int     jvalue-array index value)
	  (set-int-jvalue!     jvalue-array index value))
	 ((_ long    jvalue-array index value)
	  (set-long-jvalue!    jvalue-array index value))
	 ((_ float   jvalue-array index value)
	  (set-flaot-jvalue!   jvalue-array index value))
	 ((_ double  jvalue-array index value)
	  (set-double-jvalue!  jvalue-array index value))
	 ((_ object jvalue-array index value)
	  (set-object-jvalue!  jvalue-array index value))))