From a049f359f5657c879ec1fab30b318169fce03fd5 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Fri, 23 Aug 2024 09:30:47 +0300 Subject: [PATCH] Fix method too long errors from JVM on Kawa --- retropikzel/r7rs-pffi/version/kawa.scm | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/retropikzel/r7rs-pffi/version/kawa.scm b/retropikzel/r7rs-pffi/version/kawa.scm index 001229a..d9ea767 100644 --- a/retropikzel/r7rs-pffi/version/kawa.scm +++ b/retropikzel/r7rs-pffi/version/kawa.scm @@ -55,20 +55,18 @@ (syntax-rules () ((pffi-define scheme-name shared-object c-name return-type argument-types) (define scheme-name - (let* ((of-void (class-methods java.lang.foreign.FunctionDescriptor 'ofVoid)) - (of (class-methods java.lang.foreign.FunctionDescriptor 'of)) - (function-descriptor (if (equal? return-type 'void) - (apply of-void (map pffi-type->native-type argument-types)) - (apply of (append (list (pffi-type->native-type return-type)) (map pffi-type->native-type argument-types))))) - (method-handle (invoke (cdr (assoc 'linker shared-object)) - 'downcallHandle - (invoke (invoke (cdr (assoc 'lookup shared-object)) - 'find - (symbol->string c-name)) - 'orElseThrow) - function-descriptor))) - (lambda vals - (invoke method-handle 'invokeWithArguments (map value->object vals argument-types)))))))) + (lambda vals + (invoke (invoke (cdr (assoc 'linker shared-object)) + 'downcallHandle + (invoke (invoke (cdr (assoc 'lookup shared-object)) + 'find + (symbol->string c-name)) + 'orElseThrow) + (if (equal? return-type 'void) + (apply (class-methods java.lang.foreign.FunctionDescriptor 'ofVoid) (map pffi-type->native-type argument-types)) + (apply (class-methods java.lang.foreign.FunctionDescriptor 'of) (cons (pffi-type->native-type return-type) (map pffi-type->native-type argument-types))))) + 'invokeWithArguments + (map value->object vals argument-types)))))))