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
(lambda (header path options)
(write options)
(write (cadr (assoc 'additional-versions options)))
(newline)
(if (and (not (null? options))
(assoc 'additional-versions options))
(ffi-lib path (mlist->list (append (cadr (assoc 'additional-versions
(car options)))
options))
(list #f))))
(ffi-lib path))))

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

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

30
tests/compliance.scm
View File

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