Retropikzel
/
foreign-c
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix method too long errors from JVM on Kawa

This commit is contained in:
retropikzel 2024-08-23 09:30:47 +03:00
parent 1218972deb
commit a049f359f5
1 changed files with 12 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
retropikzel/r7rs-pffi/version/kawa.scm
View File

@ -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))
(lambda vals
(invoke (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))))))))
(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)))))))