From 59240f04b0df145ab68b234b6a67bd45e1312abf Mon Sep 17 00:00:00 2001
From: retropikzel <retropikzel@iki.fi>
Date: Mon, 1 Dec 2025 19:32:13 +0200
Subject: [PATCH] tr7 fixes

---
 Makefile           |  2 +-
 compile-scheme.scm | 22 +++++++++++++
 libs/data.sld      | 79 ++++++++++++++++++++++++++++++++++------------
 3 files changed, 81 insertions(+), 22 deletions(-)

diff --git a/Makefile b/Makefile
index ac0f410..341657d 100644
--- a/Makefile
+++ b/Makefile
@@ -124,7 +124,7 @@ test-r7rs:
 	rm -rf ${R7RSTMP}
 	mkdir -p ${R7RSTMP}
 	cp -r r7rs-testfiles/* ${R7RSTMP}/
-	cd ${R7RSTMP} && COMPILE_R7RS=${SCHEME} compile-scheme -I libs --debug main.scm
+	cd ${R7RSTMP} && COMPILE_R7RS=${SCHEME} compile-scheme -I ./libs --debug main.scm
 	-cd ${R7RSTMP} && ./main 1 2 3 > test-result.txt 2>&1
 	@grep "Test successfull (\"1\" \"2\" \"3\")" ${R7RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R7RSTMP}/test-result.txt && exit 1)
 
diff --git a/compile-scheme.scm b/compile-scheme.scm
index 1f6f8a7..29791df 100644
--- a/compile-scheme.scm
+++ b/compile-scheme.scm
@@ -26,12 +26,34 @@
   (newline)
   (exit 0))
 
+(when (member "--list-r6rs-except" (command-line))
+  (for-each
+    (lambda (scheme)
+      (when (not (member (symbol->string scheme)
+                         (cdr (member "--list-r6rs-except" (command-line)))))
+        (display scheme)
+        (display " ")))
+    r6rs-schemes)
+  (newline)
+  (exit 0))
+
 (when (or (member "--list-r7rs" (command-line))
           (member "--list-r7rs-schemes" (command-line)))
   (for-each (lambda (scheme) (display scheme) (display " ")) r7rs-schemes)
   (newline)
   (exit 0))
 
+(when (member "--list-r7rs-except" (command-line))
+  (for-each
+    (lambda (scheme)
+      (when (not (member (symbol->string scheme)
+                         (cdr (member "--list-r7rs-except" (command-line)))))
+        (display scheme)
+        (display " ")))
+    r7rs-schemes)
+  (newline)
+  (exit 0))
+
 (when (or (member "--list-all" (command-line))
           (member "--list-schemes" (command-line)))
   (for-each (lambda (scheme) (display scheme) (display " ")) all-schemes)
diff --git a/libs/data.sld b/libs/data.sld
index 17dbc1a..119e6b8 100644
--- a/libs/data.sld
+++ b/libs/data.sld
@@ -189,13 +189,13 @@
                                  ,script-file
                                  " "
                                  ,args)))))
-        #;(gambit
+        (gambit
           (type . compiler)
-          (library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
-                                `(,(string-append "gsc "
+          #;(library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
+                                `(,(string-append "gsc -:search="
                                                   (apply string-append
                                                          (map (lambda (item)
-                                                                (string-append item "/ "))
+                                                                (string-append item "/, "))
                                                               (append prepend-directories
                                                                       append-directories)))
                                                   (search-library-file (append append-directories
@@ -211,24 +211,61 @@
                              library-files
                              r6rs?
                              compilation-target)
-                        (let ((output-tmp-file (string-append output-file ".tmp")))
-                          `(,(string-append "echo \"#!/usr/bin/env gsi -:r7rs,search="
+                        (let ((library-files-paths
+                                (map (lambda (item)
+                                       (search-library-file (append prepend-directories
+                                                                    append-directories)
+                                                            item))
+                                     library-files))
+                              (link-file
+                                (string-append
+                                  (string-cut-from-end input-file 4) "_.c")))
+                          `(,(string-append "gsc -:search="
+                                            (string-cut-from-end
+                                              (apply string-append
+                                                     (map (lambda (item)
+                                                            (string-append item ","))
+                                                          (append prepend-directories
+                                                                  append-directories)))
+                                              1)
+                                            " -link -flat -nopreload "
+                                            (string-cut-from-end
+                                              (apply string-append
+                                                     (map (lambda (item)
+                                                            (string-append item " "))
+                                                          library-files-paths))
+                                              1)
+                                            " "
+                                            input-file)
+                            ,(string-append "gsc -:search="
+                                            (string-cut-from-end
+                                              (apply string-append
+                                                     (map (lambda (item)
+                                                            (string-append item ","))
+                                                          (append prepend-directories
+                                                                  append-directories)))
+                                              1)
+                                            " -obj "
                                             (apply string-append
                                                    (map (lambda (item)
-                                                          (string-append item "/ "))
-                                                        (append prepend-directories
-                                                                append-directories)))
-                                            "\" > " output-tmp-file)
-                             ,(string-append "cat " input-file " >> " output-tmp-file)
-                             ,(string-append "gsc "
-                                             (apply string-append
-                                                    (map (lambda (item)
-                                                           (string-append item "/ "))
-                                                         (append prepend-directories
-                                                                 append-directories)))
-                                             " -o " output-file
-                                             " -exe -nopreload "
-                                             output-tmp-file))))))
+                                                          (string-append (string-cut-from-end item 4) ".c "))
+                                                        library-files-paths))
+                                            " "
+                                            (string-append (string-cut-from-end input-file 4) ".c")
+                                            " "
+                                            (string-append (string-cut-from-end input-file 4) "_.c"))
+                            ,(string-append "gcc -o "
+                                            output-file
+                                            " "
+                                            (apply string-append
+                                                   (map (lambda (item)
+                                                          (string-append (string-cut-from-end item 4) ".o "))
+                                                        library-files-paths))
+                                            " "
+                                            (string-append (string-cut-from-end input-file 4) ".o")
+                                            " "
+                                            (string-append (string-cut-from-end input-file 4) "_.o"))
+                            )))))
       (gauche
         (type . interpreter)
         (command . ,(lambda (exec-cmd
@@ -666,7 +703,7 @@
                                         append-directories)
                                  " "
                                  ,exec-cmd
-                                 " tr7i -1 "
+                                 " tr7i "
                                  ,(util-getenv "COMPILE_R7RS_TR7")
                                  ,script-file
                                  " "