From 2ff726127ca20afc0b0fe6d590d7af3c52834a4e Mon Sep 17 00:00:00 2001
From: retropikzel <retropikzel@iki.fi>
Date: Sat, 22 Mar 2025 18:50:20 +0200
Subject: [PATCH] Sagittarius and Racket to pffi-define-library

---
 retropikzel/pffi/racket.scm      |  4 ++--
 retropikzel/pffi/shared/main.scm | 34 +++++++++++---------------------
 tests/compliance.scm             | 30 +++++++++++++++++++---------
 3 files changed, 34 insertions(+), 34 deletions(-)

diff --git a/retropikzel/pffi/racket.scm b/retropikzel/pffi/racket.scm
index 8f6b6ed..6abd4ff 100644
--- a/retropikzel/pffi/racket.scm
+++ b/retropikzel/pffi/racket.scm
@@ -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))))
 
diff --git a/retropikzel/pffi/shared/main.scm b/retropikzel/pffi/shared/main.scm
index 2729f35..192cb09 100644
--- a/retropikzel/pffi/shared/main.scm
+++ b/retropikzel/pffi/shared/main.scm
@@ -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)))))))))))
diff --git a/tests/compliance.scm b/tests/compliance.scm
index a7575ec..f68b623 100755
--- a/tests/compliance.scm
+++ b/tests/compliance.scm
@@ -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)