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

Renaming, interface fixes

This commit is contained in:
retropikzel 2025-02-23 10:35:25 +02:00
parent 815e49906f
commit f9517baf5b
5 changed files with 155 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
README.md
View File

@ -221,7 +221,7 @@ Takes as argument a list of C headers, these are for the compiler ones. And an s
used by the dynamic FFI's. The name of the shared object should not contain suffix like .so or
.dll. Nor should it contain any prefix like "lib".
Additional options argument can be provided, which should be a list of lists starting with a
Additional options argument can be provided, theys should be a pair with a
keyword. The options are:
- additional-versions
@ -236,7 +236,11 @@ Example:
(define libc-stdlib
(cond-expand
(windows (pffi-shared-object-auto-load (list "stdlib.h") "ucrtbase"))
(else (pffi-shared-object-auto-load (list "stdlib.h") "c" '((additional-versions ("6")))))))
(else (pffi-shared-object-auto-load (list "stdlib.h")
"c"
'(additional-versions . ("6"))
'(additional-search-paths . ("."))))))
##### **pffi-shared-object-load** headers path [options]

2
retropikzel/r7rs-pffi.rkt → retropikzel/pffi.rkt
View File

@ -1,3 +1,3 @@
#lang r7rs
(import (scheme base))
(include "r7rs-pffi.sld")
(include "pffi.sld")

2
retropikzel/r7rs-pffi.sld → retropikzel/pffi.sld
View File

@ -1,5 +1,5 @@
(define-library
(retropikzel r7rs-pffi)
(retropikzel pffi)
(cond-expand
(chibi
(import (scheme base)

23
retropikzel/r7rs-pffi/main.scm
View File

@ -63,33 +63,24 @@
(cond-expand
(gambit
(define-macro
(pffi-shared-object-auto-load headers object-name options)
(pffi-shared-object-auto-load headers object-name . options)
`(pffi-shared-object-load ,(car headers))))
(cyclone
(define-syntax pffi-shared-object-auto-load
(syntax-rules ()
((pffi-shared-object-auto-load headers object-name)
(pffi-shared-object-auto-load headers object-name (list)))
((pffi-shared-object-auto-load headers object-name options)
(pffi-shared-object-load headers)))))
(else
(define-syntax pffi-shared-object-auto-load
(syntax-rules ()
((pffi-shared-object-auto-load headers object-name)
(pffi-shared-object-auto-load headers object-name (list)))
((pffi-shared-object-auto-load headers object-name options)
(define pffi-shared-object-auto-load
(lambda (headers object-name . options)
(cond-expand
(chicken (pffi-shared-object-load headers))
(cyclone (pffi-shared-object-load headers))
(else
(let* ((additional-paths (if (assoc 'additional-paths options)
(cadr (assoc 'additional-paths options))
(cdr (assoc 'additional-paths options))
(list)))
(additional-versions (if (assoc 'additional-versions options)
(map (lambda (version)
(if (number? version)
(number->string version)
version))
(cadr (assoc 'additional-versions options)))
(cdr (assoc 'additional-versions options)))
(list)))
(slash (cond-expand (windows (string #\\)) (else "/")))
(auto-load-paths
@ -210,4 +201,4 @@
(exit 1))
(pffi-shared-object-load headers
shared-object
`((additional-versions ,versions))))))))))))
`((additional-versions ,versions)))))))))))

14
test.scm
View File

@ -2,7 +2,7 @@
(scheme write)
(scheme char)
(scheme process-context)
(retropikzel r7rs-pffi))
(retropikzel pffi))
(define header-count 1)
@ -392,14 +392,20 @@
(define libc-stdlib
(cond-expand
(windows (pffi-shared-object-auto-load (list "stdlib.h") "ucrtbase"))
(else (pffi-shared-object-auto-load (list "stdlib.h") "c" '((additional-versions ("0" "6")))))))
(else (pffi-shared-object-auto-load (list "stdlib.h")
"c"
'(additional-versions . ("0" "6"))))))
(debug libc-stdlib)
(define c-testlib
(cond-expand
(windows (pffi-shared-object-auto-load (list "libtest.h") "test" '((additional-paths (".")))))
(else (pffi-shared-object-auto-load (list "libtest.h") "test" '((additional-paths (".")))))))
(windows (pffi-shared-object-auto-load (list "libtest.h")
"test"
'(additional-paths . ("."))))
(else (pffi-shared-object-auto-load (list "libtest.h")
"test"
'(additional-paths . ("."))))))
(debug c-testlib)