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

Merge pull request 'Done' (#25) from callback-guile into master 

Reviewed-on: https://codeberg.org/r7rs-pffi/pffi/pulls/25
This commit is contained in:
retropikzel 2024-06-29 11:10:40 +00:00
parent b6fff1cc6c 9dd0fdb260
commit 6bc1db5cde
2 changed files with 13 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
retropikzel/pffi/v0-2-2/guile.scm
View File

@ -9,6 +9,7 @@
(system foreign-library)) (system foreign-library))
(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
@ -45,6 +46,7 @@
((equal? type 'pointer) '*) ((equal? type 'pointer) '*)
((equal? type 'string) '*) ((equal? type 'string) '*)
((equal? type 'void) void) ((equal? type 'void) void)
((equal? type 'callback) '*)
(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?
@ -60,6 +62,14 @@
#:return-type (pffi-type->native-type return-type) #:return-type (pffi-type->native-type return-type)
#:arg-types (map pffi-type->native-type argument-types)))))) #:arg-types (map pffi-type->native-type argument-types))))))
(define-syntax pffi-define-callback
(syntax-rules ()
((pffi-define scheme-name return-type argument-types procedure)
(define scheme-name
(procedure->pointer (pffi-type->native-type return-type)
procedure
(map pffi-type->native-type argument-types))))))
(define pffi-size-of (define pffi-size-of
(lambda (type) (lambda (type)

8
test/800_libcurl.scm
View File

@ -1,8 +1,7 @@
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme process-context) (scheme process-context)
(retropikzel pffi v0-2-2 main) (retropikzel pffi v0-2-2 main))
(sagittarius ffi))
(define libcurl (pffi-shared-object-auto-load (list "curl/curl.h") ; Headers (define libcurl (pffi-shared-object-auto-load (list "curl/curl.h") ; Headers
(list ".") ; Additional search paths (list ".") ; Additional search paths
@ -30,11 +29,10 @@
(define result "") (define result "")
(pffi-define-callback collect-result (pffi-define-callback collect-result
'int 'void
(list 'pointer 'int 'int 'pointer) (list 'pointer 'int 'int 'pointer)
(lambda (pointer size nmemb client-pointer) (lambda (pointer size nmemb client-pointer)
(set! result (set! result (string-append result (pffi-pointer->string pointer)))))
(string-append result (pffi-pointer->string pointer)))))
(define handle (curl-easy-init)) (define handle (curl-easy-init))
(define url (pffi-string->pointer "https://scheme.org")) (define url (pffi-string->pointer "https://scheme.org"))