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

Merge pull request 'callback-racket' (#30) from callback-racket into master 

Reviewed-on: https://codeberg.org/r7rs-pffi/pffi/pulls/30
This commit is contained in:
retropikzel 2024-07-01 17:15:56 +00:00
parent c37e72bf8d b02222ad35
commit e74cddae4d
1 changed files with 103 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
retropikzel/pffi/v0-2-2/racket.rkt
View File

@ -11,6 +11,7 @@
(ffi vector)) (ffi vector))
(export pffi-shared-object-load (export pffi-shared-object-load
pffi-define pffi-define
pffi-define-callback
pffi-size-of pffi-size-of
pffi-pointer-allocate pffi-pointer-allocate
pffi-pointer-null pffi-pointer-null
@ -47,6 +48,7 @@
((equal? type 'pointer) _pointer) ((equal? type 'pointer) _pointer)
((equal? type 'string) _pointer) ((equal? type 'string) _pointer)
((equal? type 'void) _void) ((equal? type 'void) _void)
((equal? type 'callback) _pointer)
(else (error "pffi-type->native-type -- No such pffi type" type))))) (else (error "pffi-type->native-type -- No such pffi type" type)))))
(define pffi-pointer? (define pffi-pointer?
@ -62,6 +64,15 @@
(_cprocedure (mlist->list (map pffi-type->native-type argument-types)) (_cprocedure (mlist->list (map pffi-type->native-type argument-types))
(pffi-type->native-type return-type))))))) (pffi-type->native-type return-type)))))))
(define-syntax pffi-define-callback
(syntax-rules ()
((pffi-define-callback scheme-name return-type argument-types procedure)
(define scheme-name (function-ptr procedure
(_cprocedure
(mlist->list (map pffi-type->native-type argument-types))
(pffi-type->native-type return-type)))
))))
(define pffi-size-of (define pffi-size-of
(lambda (type) (lambda (type)
(ctype-sizeof (pffi-type->native-type type)))) (ctype-sizeof (pffi-type->native-type type))))