From 3d750c335d3a5679410529b7bd767dc9f257b873 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Thu, 9 Oct 2025 16:27:50 +0300 Subject: [PATCH 1/7] Mit-scheme support for snow-chibi --- lib/chibi/snow/commands.scm | 56 ++++++++++++++++++++++++++++++++++++- lib/chibi/snow/utils.scm | 4 +++ 2 files changed, 59 insertions(+), 1 deletion(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 80cc856b..34eed1ae 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1409,6 +1409,22 @@ "/usr/local/share/guile/")))) ((kawa) (list "/usr/local/share/kawa/lib")) + ((mit-scheme) + (list + (make-path + (string-trim + ;; Get the last line of output because there might be warnings and such + (car + (reverse + (string-split + (process->string + '(mit-scheme + --batch-mode --eval + "(display (->namestring (system-library-directory-pathname)))" + --eval "(exit 0)")) + #\newline))) + char-whitespace?) + "libraries"))) ((larceny) (list (make-path @@ -1536,6 +1552,11 @@ --r7rs --script ,file) `(kawa ,(string-append "-Dkawa.import.path=" install-dir) --r7rs --script ,file)))) + ((mit-scheme) + (let ((install-dir (path-resolve install-dir (current-directory)))) + (if lib-path + `(mit-scheme --batch-mode --load ,file --eval "(exit 0)") + `(mit-scheme --batch-mode --load ,file --eval "(exit 0)")))) ((mosh) (if lib-path `(mosh --loadpath= ,install-dir --loadpath= ,lib-path ,file) @@ -1699,6 +1720,8 @@ (guile 0 1 2 4 6 8 9 10 11 13 14 16 17 18 19 23 26 27 28 30 31 34 35 37 38 39 41 42 43 45 46 55 60 61 62 64 67 69 71 87 88 98 105 111 171) + (mit-scheme 0 1 2 6 8 9 14 23 27 30 39 62 69 112 115 124 125 128 129 131 + 133 143 158 162 180 219 228) (kawa 1 2 13 14 34 37 60 69 95) (larceny 0 1 2 4 5 6 7 8 9 11 13 14 16 17 19 22 23 25 26 27 28 29 30 31 37 38 39 41 42 43 45 48 51 54 56 59 60 61 62 63 64 @@ -1771,6 +1794,7 @@ ((eq? impl 'generic) (get-install-library-dir impl cfg)) ((eq? impl 'guile) (get-guile-site-dir)) ((eq? impl 'kawa) (get-install-library-dir impl cfg)) + ((eq? impl 'mit-scheme) (get-install-library-dir impl cfg)) ((eq? impl 'mosh) (get-install-library-dir impl cfg)) ((eq? impl 'racket) (get-install-library-dir impl cfg)) ((eq? impl 'sagittarius) (get-install-library-dir impl cfg)) @@ -1789,6 +1813,7 @@ ((eq? impl 'gauche) (get-install-library-dir impl cfg)) ((eq? impl 'generic) (get-install-library-dir impl cfg)) ((eq? impl 'kawa) (get-install-library-dir impl cfg)) + ((eq? impl 'mit-scheme) (get-install-library-dir impl cfg)) ((eq? impl 'mosh) (get-install-library-dir impl cfg)) ((eq? impl 'racket) (get-install-library-dir impl cfg)) ((eq? impl 'sagittarius) (get-install-library-dir impl cfg)) @@ -1821,6 +1846,8 @@ (get-guile-site-ccache-dir)) ((eq? impl 'kawa) (car (get-install-dirs impl cfg))) + ((eq? impl 'mit-scheme) + (car (get-install-dirs impl cfg))) ((eq? impl 'mosh) (car (get-install-dirs impl cfg))) ((eq? impl 'racket) @@ -2081,6 +2108,18 @@ (cons dest-class-file installed-files)) (else installed-files)))) +(define (mit-scheme-installer impl cfg library dir) + (let* ((binld-file (path-replace-extension + (get-library-file cfg library) "binld")) + (source-binld-file (make-path dir binld-file)) + (install-dir (get-install-source-dir impl cfg)) + (dest-binld-file (make-path install-dir binld-file)) + (installed-files (default-installer impl cfg library dir))) + (cond ((file-exists? source-binld-file) + (install-file cfg source-binld-file dest-binld-file) + (cons binld-file installed-files)) + (else installed-files)))) + ;; Racket can only load files with .rkt suffix. So for each library we create ;; a file that sets language to r7rs and includes the .sld file (define (racket-installer impl cfg library dir) @@ -2115,6 +2154,7 @@ ((gambit) gambit-installer) ((guile) guile-installer) ((kawa) kawa-installer) + ((mit-scheme) mit-scheme-installer) ((racket) racket-installer) (else default-installer))) @@ -2125,6 +2165,7 @@ ((gambit) 'gambit) ((guile) 'guile) ((kawa) 'kawa) + ((mit-scheme) 'mit-scheme) ((racket) 'racket) (else 'default))) @@ -2359,6 +2400,18 @@ " - install anyway?")) library))) +(define (mit-scheme-builder impl cfg library dir) + (let* ((src-library-file (make-path dir (get-library-file cfg library))) + (res (system 'mit-scheme + '--batch-mode + '--eval (string-append "(cf \"" src-library-file "\")") + '--eval "(exit 0)"))) + (and (or (and (pair? res) (zero? (cadr res))) + (yes-or-no? cfg "native-code files failed to build: " + (library-name library) + " - install anyway?")) + library))) + (define (lookup-builder builder) (case builder ((chibi) chibi-builder) @@ -2367,11 +2420,12 @@ ((gambit) gambit-builder) ((guile) guile-builder) ((kawa) kawa-builder) + ((mit-scheme) mit-scheme-builder) (else default-builder))) (define (builder-for-implementation impl cfg) (case impl - ((chibi chicken cyclone gambit guile kawa) impl) + ((chibi chicken cyclone gambit guile kawa mit-scheme) impl) (else 'default))) (define (build-library impl cfg library dir) diff --git a/lib/chibi/snow/utils.scm b/lib/chibi/snow/utils.scm index f238c4d7..3a8f7887 100644 --- a/lib/chibi/snow/utils.scm +++ b/lib/chibi/snow/utils.scm @@ -43,6 +43,10 @@ ,(delay (process->sexp '(kawa -e "(write (features))")))) + (mit-scheme "mit-scheme" (mit-scheme --version) #f + ,(delay + (process->sexp + '(mit-scheme --batch-mode --eval "(display (features))" --eval "(exit 0)")))) (mosh "mosh" (mosh -v) #f ,(delay (call-with-temp-file "snow-mosh.scm" From 7caaea25527ee8ca3891e09993a662ff6176a746 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Thu, 4 Dec 2025 13:33:01 +0200 Subject: [PATCH 2/7] Add capyscheme support into snow-chibi --- lib/chibi/snow/commands.scm | 13 +++++++++++++ lib/chibi/snow/utils.scm | 6 +++++- 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 829b45c3..35be2fc6 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1354,6 +1354,11 @@ (guard (exn (else #f)) (process->sexp `(guile -c ,(write-to-string `(write ,expr)))))) (case impl + ((capyscheme) + (list + (make-path + (process->string + '(capy -c "(printf \"~a\" (car %load-path))"))))) ((chibi) (let* ((dirs (reverse @@ -1516,6 +1521,10 @@ (let ((lib-path (and (pair? o) (car o))) (install-dir (get-install-source-dir impl cfg))) (case impl + ((capyscheme) + (if lib-path + `(capy -L ,install-dir -L ,lib-path --script ,file) + `(capy -L ,install-dir --script ,file))) ((chibi) (let ((chibi (string-split (conf-get cfg 'chibi-path "chibi-scheme")))) (if lib-path @@ -1795,6 +1804,7 @@ (define (get-install-source-dir impl cfg) (cond + ((eq? impl 'capyscheme) (get-install-library-dir impl cfg)) ((eq? impl 'chicken) (get-install-library-dir impl cfg)) ((eq? impl 'cyclone) (get-install-library-dir impl cfg)) ((eq? impl 'gambit) (get-install-library-dir impl cfg)) @@ -1816,6 +1826,7 @@ (define (get-install-data-dir impl cfg) (cond + ((eq? impl 'capyscheme) (get-install-library-dir impl cfg)) ((eq? impl 'chicken) (get-install-library-dir impl cfg)) ((eq? impl 'cyclone) (get-install-library-dir impl cfg)) ((eq? impl 'gambit) (get-install-library-dir impl cfg)) @@ -1837,6 +1848,8 @@ (define (get-install-library-dir impl cfg) (cond ((conf-get cfg 'install-library-dir)) + ((eq? impl 'capyscheme) + (car (get-install-dirs impl cfg))) ((eq? impl 'chicken) (cond ((conf-get cfg 'install-prefix) => (lambda (prefix) diff --git a/lib/chibi/snow/utils.scm b/lib/chibi/snow/utils.scm index 3d5ed2f9..572b3e2e 100644 --- a/lib/chibi/snow/utils.scm +++ b/lib/chibi/snow/utils.scm @@ -2,7 +2,11 @@ (call-with-output-string (lambda (out) (write x out)))) (define known-implementations - `((chibi "chibi-scheme" (chibi-scheme -V) "0.7.3" + `((capyscheme "capy" #f #f + ,(delay + (process->sexp + '(capy --command="(features)")))) + (chibi "chibi-scheme" (chibi-scheme -V) "0.7.3" ,(delay (process->sexp '(chibi-scheme -p "(features)")))) From 5583c39d13b7c238f9679e0f3d362b2a444f1138 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sat, 6 Dec 2025 13:05:12 +0200 Subject: [PATCH 3/7] Add tr7 support to snow-chibi --- lib/chibi/snow/commands.scm | 17 +++++++++++++++-- lib/chibi/snow/utils.scm | 5 +++++ 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 829b45c3..97a12bc9 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1458,7 +1458,11 @@ (list (make-path (process->string '(stklos -e "(display (install-path #:libdir))"))))) - ((ypsilon) + ((tr7) + (list (make-path + (process->string + '(tr7i -c "(import (tr7 misc)) (display (car (scheme-paths)))"))))) + ((ypsilon) (call-with-temp-file "snow-ypsilon.scm" (lambda (tmp-path out preserve) (with-output-to-file tmp-path @@ -1585,6 +1589,10 @@ (if lib-path `(stklos -A ,install-dir -A ,lib-path ,file) `(stklos -A ,install-dir ,file))) + ((tr7) + (if lib-path + `(TR7_LIB_PATH=,lib-path tr7i ,file) + `(tr7i ,file))) ((ypsilon) (if lib-path `(ypsilon --sitelib ,install-dir --sitelib ,lib-path ,file) @@ -1745,7 +1753,8 @@ 127 128 129 130 132 133 134 135 137 138 141 143 144 145 151 152 154 156 158 160 161 162 169 170 171 173 174 175 176 178 180 185 189 190 192 193 195 196 207 208 214 215 216 217 219 221 222 223 224 227 228 - 229 230 232 233 234 235 236 238 244 253 258 260))) + 229 230 232 233 234 235 236 238 244 253 258 260) + (tr7 1 69 111 141 232 259))) (define native-self-support '((kawa base expressions hashtable quaternions reflect regex @@ -1808,6 +1817,7 @@ ((eq? impl 'racket) (get-install-library-dir impl cfg)) ((eq? impl 'sagittarius) (get-install-library-dir impl cfg)) ((eq? impl 'stklos) (get-install-library-dir impl cfg)) + ((eq? impl 'tr7) (get-install-library-dir impl cfg)) ((eq? impl 'ypsilon) (get-install-library-dir impl cfg)) ((conf-get cfg 'install-source-dir)) ((conf-get cfg 'install-prefix) @@ -1828,6 +1838,7 @@ ((eq? impl 'racket) (get-install-library-dir impl cfg)) ((eq? impl 'sagittarius) (get-install-library-dir impl cfg)) ((eq? impl 'stklos) (get-install-library-dir impl cfg)) + ((eq? impl 'tr7) (get-install-library-dir impl cfg)) ((eq? impl 'ypsilon) (get-install-library-dir impl cfg)) ((conf-get cfg 'install-data-dir)) ((conf-get cfg 'install-prefix) @@ -1868,6 +1879,8 @@ (car (get-install-dirs impl cfg))) ((eq? impl 'stklos) (car (get-install-dirs impl cfg))) + ((eq? impl 'tr7) + (car (get-install-dirs impl cfg))) ((eq? impl 'ypsilon) (car (get-install-dirs impl cfg))) ((conf-get cfg 'install-prefix) diff --git a/lib/chibi/snow/utils.scm b/lib/chibi/snow/utils.scm index 3d5ed2f9..ff05ba43 100644 --- a/lib/chibi/snow/utils.scm +++ b/lib/chibi/snow/utils.scm @@ -83,6 +83,10 @@ ,(delay (process->sexp '(stklos -e "(write (features))")))) + (tr7 "tr7i" (tr7i --version) #f + ,(delay + (process->sexp + '(tr7i -c "(write (features))")))) (ypsilon "ypsilon" (ypsilon --version) #f ,(delay (call-with-temp-file "snow-ypsilon" @@ -120,6 +124,7 @@ ((racket) (cond-expand (racket #t) (else #f))) ((sagittarius) (cond-expand (sagittarius #t) (else #f))) ((stklos) (cond-expand (stklos #t) (else #f))) + ((tr7) (cond-expand (tr7 #t) (else #f))) (else #f))) (define (impl->features impl) From 079d89c3fae9a57e0218f820bf3a37c84df07469 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sat, 6 Dec 2025 13:10:53 +0200 Subject: [PATCH 4/7] Add tr7 support to snow-chibi --- lib/chibi/snow/commands.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 97a12bc9..48ad0596 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1461,7 +1461,7 @@ ((tr7) (list (make-path (process->string - '(tr7i -c "(import (tr7 misc)) (display (car (scheme-paths)))"))))) + '(tr7i -c "(import (scheme base) (scheme write) (tr7 misc)) (display (car (scheme-paths)))"))))) ((ypsilon) (call-with-temp-file "snow-ypsilon.scm" (lambda (tmp-path out preserve) From 7a125699ddfa84d8c934435fe031757fc28ce34e Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sat, 6 Dec 2025 13:39:32 +0200 Subject: [PATCH 5/7] Add tr7 support to snow-chibi --- lib/chibi/snow/commands.scm | 2 +- lib/chibi/snow/utils.scm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 48ad0596..95676d02 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1591,7 +1591,7 @@ `(stklos -A ,install-dir ,file))) ((tr7) (if lib-path - `(TR7_LIB_PATH=,lib-path tr7i ,file) + `(sh -c ,(string-append "TR7_LIB_PATH=" lib-path " tr7i " file)) `(tr7i ,file))) ((ypsilon) (if lib-path diff --git a/lib/chibi/snow/utils.scm b/lib/chibi/snow/utils.scm index ff05ba43..98bd9f9b 100644 --- a/lib/chibi/snow/utils.scm +++ b/lib/chibi/snow/utils.scm @@ -83,7 +83,7 @@ ,(delay (process->sexp '(stklos -e "(write (features))")))) - (tr7 "tr7i" (tr7i --version) #f + (tr7 "tr7i" (tr7i -c "(import (scheme base) (scheme write) (tr7 misc)) (display (tr7-version))") #f ,(delay (process->sexp '(tr7i -c "(write (features))")))) From 37662e61b27962b6029312404d8aeb00d8c716ac Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sat, 6 Dec 2025 14:33:22 +0200 Subject: [PATCH 6/7] Add capyscheme SRFI list --- lib/chibi/snow/commands.scm | 3 ++- lib/chibi/snow/utils.scm | 2 ++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 6e64e1a2..29883340 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1738,7 +1738,8 @@ ;; chibi is not included because chibi is already installed with full ;; package information for each builtin library (define native-srfi-support - '((foment 60) + '((capyscheme 1 8 13 14 39 64 124 157 180 226 259) + (foment 60) (gambit 0 4 6 8 9 16 18 21 22 23 27 30 39 62 88 193) (gauche 0 1 4 5 7 9 11 13 14 19 26 27 29 31 37 42 43 55) (guile 0 1 2 4 6 8 9 10 11 13 14 16 17 18 19 23 26 27 28 30 31 34 diff --git a/lib/chibi/snow/utils.scm b/lib/chibi/snow/utils.scm index bfaec050..a7989321 100644 --- a/lib/chibi/snow/utils.scm +++ b/lib/chibi/snow/utils.scm @@ -122,9 +122,11 @@ (define (target-is-host? impl) (case impl + ((capyscheme) (cond-expand (capyscheme #t) (else #f))) ((chibi) (cond-expand (chibi #t) (else #f))) ((gambit) (cond-expand (gambit #t) (else #f))) ((gauche) (cond-expand (gauche #t) (else #f))) + ((mit) (cond-expand (mit #t) (else #f))) ((racket) (cond-expand (racket #t) (else #f))) ((sagittarius) (cond-expand (sagittarius #t) (else #f))) ((stklos) (cond-expand (stklos #t) (else #f))) From 105adebad2c6c9d31dc38cb9e7253641aae18e02 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sat, 6 Dec 2025 14:44:03 +0200 Subject: [PATCH 7/7] Small tr7 fixes --- lib/chibi/snow/utils.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/chibi/snow/utils.scm b/lib/chibi/snow/utils.scm index a7989321..d033819f 100644 --- a/lib/chibi/snow/utils.scm +++ b/lib/chibi/snow/utils.scm @@ -90,7 +90,7 @@ (tr7 "tr7i" (tr7i -c "(import (scheme base) (scheme write) (tr7 misc)) (display (tr7-version))") #f ,(delay (process->sexp - '(tr7i -c "(write (features))")))) + '(tr7i -c "(import (scheme base)) (write (features))")))) (ypsilon "ypsilon" (ypsilon --version) #f ,(delay (call-with-temp-file "snow-ypsilon"