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

Sagittarius and Racket to pffi-define-library

This commit is contained in:
retropikzel 2025-03-22 18:50:20 +02:00
parent 993588e286
commit 2ff726127c
3 changed files with 34 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
retropikzel/pffi/racket.scm
View File

@ -80,12 +80,12 @@
(define pffi-shared-object-load (define pffi-shared-object-load
(lambda (header path options) (lambda (header path options)
(write options) (write (cadr (assoc 'additional-versions options)))
(newline) (newline)
(if (and (not (null? options)) (if (and (not (null? options))
(assoc 'additional-versions options)) (assoc 'additional-versions options))
(ffi-lib path (mlist->list (append (cadr (assoc 'additional-versions (ffi-lib path (mlist->list (append (cadr (assoc 'additional-versions
(car options))) options))
(list #f)))) (list #f))))
(ffi-lib path)))) (ffi-lib path))))

34
retropikzel/pffi/shared/main.scm
View File

@ -91,28 +91,27 @@
((or chicken cyclone) ((or chicken cyclone)
(define-syntax pffi-define-library (define-syntax pffi-define-library
(syntax-rules () (syntax-rules ()
((_ scheme-name headers object-name . options) ((_ scheme-name headers object-name options)
(begin (begin
(define scheme-name #t) (define scheme-name #t)
(pffi-shared-object-load headers)))))) (pffi-shared-object-load headers))))))
(else (else
(define-syntax pffi-define-library (define-syntax pffi-define-library
(syntax-rules ()
((_ scheme-name headers object-name options)
(define scheme-name #t))))
#;(define-syntax pffi-define-library-old
(syntax-rules () (syntax-rules ()
((_ scheme-name headers object-name options) ((_ scheme-name headers object-name options)
(define scheme-name (define scheme-name
(let* ((additional-paths (if (assoc 'additional-paths options) (let* ((internal-options (if (null? 'options)
(cdr (assoc 'additional-paths options)) (list)
(cadr 'options)))
(additional-paths (if (assoc 'additional-paths internal-options)
(cadr (assoc 'additional-paths internal-options))
(list))) (list)))
(additional-versions (if (assoc 'additional-versions options) (additional-versions (if (assoc 'additional-versions internal-options)
(map (lambda (version) (map (lambda (version)
(if (number? version) (if (number? version)
(number->string version) (number->string version)
version)) version))
(cdr (assoc 'additional-versions options))) (cadr (assoc 'additional-versions internal-options)))
(list))) (list)))
(slash (cond-expand (windows (string #\\)) (else "/"))) (slash (cond-expand (windows (string #\\)) (else "/")))
(auto-load-paths (auto-load-paths
@ -174,21 +173,10 @@
(auto-load-versions (list "")) (auto-load-versions (list ""))
(paths (append auto-load-paths additional-paths)) (paths (append auto-load-paths additional-paths))
(versions (append additional-versions auto-load-versions)) (versions (append additional-versions auto-load-versions))
(platform-lib-prefix (platform-lib-prefix (cond-expand (windows "") (else "lib")))
(cond-expand (platform-file-extension (cond-expand (windows ".dll") (else ".so")))
;(racket (if (equal? (system-type 'os) 'windows) "" "lib"))
(windows "")
(else "lib")))
(platform-file-extension
(cond-expand
;(racket (if (equal? (system-type 'os) 'windows) ".dll" ".so"))
(windows ".dll")
(else ".so")))
(shared-object #f) (shared-object #f)
(searched-paths (list))) (searched-paths (list)))
(display "HERE: ")
(write additional-versions)
(newline)
(for-each (for-each
(lambda (path) (lambda (path)
(for-each (for-each
@ -236,4 +224,4 @@
(exit 1)) (exit 1))
(pffi-shared-object-load headers (pffi-shared-object-load headers
shared-object shared-object
`((additional-versions ,versions))))))))))) `((additional-versions ,additional-versions)))))))))))

30
tests/compliance.scm
View File

@ -403,23 +403,35 @@
(print-header 'pffi-define-library) (print-header 'pffi-define-library)
(pffi-define-library libc-stdlib (cond-expand
(list "stdlib.h") (windows (pffi-define-library libc-stdlib
(cond-expand (windows "ucrtbase") (else "c")) (list "stdlib.h")
'((additional-versions . ("0" "6")))) "ucrtbase"
'((additional-versions ("0" "6")))
))
(else (pffi-define-library libc-stdlib
(list "stdlib.h")
"c"
'((additional-versions ("0" "6"))))))
(debug libc-stdlib) (debug libc-stdlib)
(pffi-define-library libc-stdio (cond-expand
(list "stdio.h") (windows (pffi-define-library libc-stdio
(cond-expand (windows "ucrtbase") (else "c")) (list "stdio.h")
'((additional-versions . ("0" "6")))) "ucrtbase"
'((additional-versions ("0" "6")))))
(else (pffi-define-library libc-stdio
(list "stdio.h")
"c"
'((additional-versions ("0" "6"))))))
(debug libc-stdio) (debug libc-stdio)
(pffi-define-library c-testlib (pffi-define-library c-testlib
(list "libtest.h") (list "libtest.h")
"test" "test"
'((additional-paths . (".")))) '((additional-paths ("." "./tests"))))
(debug c-testlib) (debug c-testlib)