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))))