From 232f2fe6e0650c194f4e63a9a123d77e050cf794 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Tue, 17 Jun 2025 07:48:47 +0300 Subject: [PATCH 1/7] Add racket support for snow-chibi --- doc/chibi.scrbl | 1 + lib/chibi/snow/commands.scm | 36 +++++++++++++++++++++++++++++++++++- lib/chibi/snow/utils.scm | 5 +++++ 3 files changed, 41 insertions(+), 1 deletion(-) diff --git a/doc/chibi.scrbl b/doc/chibi.scrbl index e832b481..a37627d7 100755 --- a/doc/chibi.scrbl +++ b/doc/chibi.scrbl @@ -1642,5 +1642,6 @@ are currently supported: \item{gauche - version >= 0.9.4} \item{kawa - version >= 2.0; you need to add the install dir to the search path, e.g. \scheme{-Dkawa.import.path=/usr/local/share/kawa}} \item{larceny - version 0.98; you need to add "lib/Snow" to the paths in startup.sch} +\item{racket ; With the r7rs library} \item{sagittarius - version >= 0.98} ] diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 0f4ed4d7..62de2d6a 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1399,6 +1399,11 @@ "(begin (display (getenv \"LARCENY_ROOT\")) (exit))")) char-whitespace?) "lib/Snow"))) + ((racket) + (list + (make-path + (process->string + '(racket -I racket/base -e "(display (find-system-path 'collects-dir))"))))) (else (list (make-path (or (conf-get cfg 'install-prefix) "/usr/local") "share/snow" @@ -1487,6 +1492,10 @@ `(larceny -r7rs -path ,(string-append install-dir ":" lib-path) -program ,file) `(larceny -r7rs -path ,install-dir -program ,file))) + ((racket) + (if lib-path + `(racket -I r7rs -S ,install-dir -S ,lib-path --script ,file) + `(racket -S ,install-dir --script ,file))) (else #f)))))) @@ -1627,7 +1636,8 @@ (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 - 66 67 69 71 74 78 86 87 95 96 98))) + 66 67 69 71 74 78 86 87 95 96 98) + (racket))) (define native-self-support '((kawa base expressions hashtable quaternions reflect regex @@ -1681,6 +1691,7 @@ ((eq? impl 'chicken) (get-install-library-dir impl cfg)) ((eq? impl 'cyclone) (get-install-library-dir impl cfg)) ((eq? impl 'guile) (get-guile-site-dir)) + ((eq? impl 'racket) (get-install-library-dir impl cfg)) ((conf-get cfg 'install-source-dir)) ((conf-get cfg 'install-prefix) => (lambda (prefix) (make-path prefix "share/snow" impl))) @@ -1690,6 +1701,7 @@ (cond ((eq? impl 'chicken) (get-install-library-dir impl cfg)) ((eq? impl 'cyclone) (get-install-library-dir impl cfg)) + ((eq? impl 'racket) (get-install-library-dir impl cfg)) ((conf-get cfg 'install-data-dir)) ((conf-get cfg 'install-prefix) => (lambda (prefix) (make-path prefix "share/snow" impl))) @@ -1709,6 +1721,8 @@ (car (get-install-dirs impl cfg))) ((eq? impl 'guile) (get-guile-site-ccache-dir)) + ((eq? impl 'racket) + (car (get-install-dirs impl cfg))) ((conf-get cfg 'install-prefix) => (lambda (prefix) (make-path prefix "lib" impl))) (else snow-binary-module-directory))) @@ -1912,12 +1926,31 @@ (library-shared-include-files impl cfg (make-path dir source-scm-file)))))))) +;; 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) + (for-each + (lambda (path) + (let* ((path-length (string-length path)) + (suffix (string-copy path (- path-length 3)))) + (when (string=? suffix "sld") + (let ((path-without-suffix (string-copy path 0 (- path-length 3)))) + (with-output-to-file + (string-append path-without-suffix "rkt") + (lambda () + (map display + (list "#lang r7rs" #\newline + "(import (scheme base))" #\newline + "(include \"" (path-strip-directory path) "\")")))))))) + (default-installer impl cfg library dir))) + ;; installers should return the list of installed files (define (lookup-installer installer) (case installer ((chicken) chicken-installer) ((cyclone) cyclone-installer) ((guile) guile-installer) + ((racket) racket-installer) (else default-installer))) (define (installer-for-implementation impl cfg) @@ -1925,6 +1958,7 @@ ((chicken) 'chicken) ((cyclone) 'cyclone) ((guile) 'guile) + ((racket) 'racket) (else 'default))) (define (install-library impl cfg library dir) diff --git a/lib/chibi/snow/utils.scm b/lib/chibi/snow/utils.scm index 9b8324e3..a04e3ccf 100644 --- a/lib/chibi/snow/utils.scm +++ b/lib/chibi/snow/utils.scm @@ -39,6 +39,10 @@ '(kawa -e "(write (features))")))) (larceny "larceny" (larceny --version) "v0.98" ,(delay '())) + (racket "racket" #f #f + ,(delay + (process->sexp + '(racket -I r7rs -e "(import (scheme base) (scheme write)) (display (features))")))) (sagittarius "sagittarius" #f #f ,(delay (process->sexp @@ -60,6 +64,7 @@ (case impl ((chibi) (cond-expand (chibi #t) (else #f))) ((gauche) (cond-expand (gauche #t) (else #f))) + ((racket) (cond-expand (racket #t) (else #f))) ((sagittarius) (cond-expand (sagittarius #t) (else #f))) (else #f))) From 0482dc74018b6672a5f2d9590e52c51d1979ef52 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Tue, 17 Jun 2025 08:07:56 +0300 Subject: [PATCH 2/7] Add newline to end of .rkt file --- lib/chibi/snow/commands.scm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 62de2d6a..284ae32b 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1939,9 +1939,12 @@ (string-append path-without-suffix "rkt") (lambda () (map display - (list "#lang r7rs" #\newline - "(import (scheme base))" #\newline - "(include \"" (path-strip-directory path) "\")")))))))) + (list "#lang r7rs" + #\newline + "(import (scheme base))" + #\newline + "(include \"" (path-strip-directory path) "\")" + #\newline)))))))) (default-installer impl cfg library dir))) ;; installers should return the list of installed files From ef1a2abfcce04cef69fc2d649a7fed5e3089b4f4 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Thu, 26 Jun 2025 20:21:34 +0300 Subject: [PATCH 3/7] Add Racket support for snow-chibi --- doc/chibi.scrbl | 1 + lib/chibi/snow/commands.scm | 68 +++++++++++++++++++++++++++++++++++++ lib/chibi/snow/utils.scm | 4 +++ 3 files changed, 73 insertions(+) diff --git a/doc/chibi.scrbl b/doc/chibi.scrbl index 96a2d5e6..d75c8a1c 100755 --- a/doc/chibi.scrbl +++ b/doc/chibi.scrbl @@ -1665,6 +1665,7 @@ installed. The following are currently supported: \item{gauche - version >= 0.9.4} \item{kawa - version >= 2.0; you need to add the install dir to the search path, e.g. \scheme{-Dkawa.import.path=/usr/local/share/kawa}} \item{larceny - version 0.98; you need to add "lib/Snow" to the paths in startup.sch} +\item{racket - version >= 8.16 with the \scheme{r7rs} pkg} \item{sagittarius - version >= 0.98} \item{stklos - version > 2.10} ] diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 6b08cd63..9edb439d 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1407,6 +1407,9 @@ "(begin (display (getenv \"LARCENY_ROOT\")) (exit))")) char-whitespace?) "lib/Snow"))) + ((racket) + (list (process->string + '(racket -e "(display (find-system-path 'collects-dir))")))) ((stklos) (list (make-path (process->string @@ -1499,6 +1502,10 @@ `(larceny -r7rs -path ,(string-append install-dir ":" lib-path) -program ,file) `(larceny -r7rs -path ,install-dir -program ,file))) + ((racket) + (if lib-path + `(racket -I r7rs -S ,install-dir -S ,lib-path --script ,file) + `(racket -I r7rs -S ,install-dir --script ,file))) ((stklos) (if lib-path `(stklos -A ,install-dir -A ,lib-path ,file) @@ -1704,6 +1711,7 @@ ((eq? impl 'cyclone) (get-install-library-dir impl cfg)) ((eq? impl 'generic) (get-install-library-dir impl cfg)) ((eq? impl 'guile) (get-guile-site-dir)) + ((eq? impl 'racket) (get-install-library-dir impl cfg)) ((eq? impl 'stklos) (get-install-library-dir impl cfg)) ((conf-get cfg 'install-source-dir)) ((conf-get cfg 'install-prefix) @@ -1715,6 +1723,7 @@ ((eq? impl 'chicken) (get-install-library-dir impl cfg)) ((eq? impl 'cyclone) (get-install-library-dir impl cfg)) ((eq? impl 'generic) (get-install-library-dir impl cfg)) + ((eq? impl 'racket) (get-install-library-dir impl cfg)) ((eq? impl 'stklos) (get-install-library-dir impl cfg)) ((conf-get cfg 'install-data-dir)) ((conf-get cfg 'install-prefix) @@ -1737,6 +1746,8 @@ (car (get-install-dirs impl cfg))) ((eq? impl 'guile) (get-guile-site-ccache-dir)) + ((eq? impl 'racket) + (car (get-install-dirs impl cfg))) ((eq? impl 'stklos) (car (get-install-dirs impl cfg))) ((conf-get cfg 'install-prefix) @@ -1942,12 +1953,68 @@ (library-shared-include-files impl cfg (make-path dir source-scm-file)))))))) +(define (racket-installer impl cfg library dir) + (let* ((library-file (get-library-file cfg library)) + (rkt-file (path-replace-extension library-file "rkt")) + (library-file-name (path-strip-directory library-file)) + (ext (get-library-extension impl cfg)) + (dest-library-file + (string-append (library->path cfg library) "." ext)) + (dest-rkt-file (path-replace-extension dest-library-file "rkt")) + (include-files + (library-include-files impl cfg (make-path dir library-file))) + (install-dir (get-install-source-dir impl cfg)) + (install-lib-dir (get-install-library-dir impl cfg))) + (display "HERE: ") + (display dir) + (newline) + (display "HERE1: ") + (display rkt-file) + (newline) + ;; Create .rkt file + (with-output-to-file + (string-append dir "/" rkt-file) + (lambda () + (map display + `("#lang r7rs" #\newline + "(import (scheme base))" #\newline + "(include \"" ,library-file-name "\")" #\newline)))) + ;; install the library file + (let ((path (make-path install-dir dest-library-file)) + (rkt-path (make-path install-dir dest-rkt-file))) + (install-directory cfg (path-directory path)) + (install-file cfg (make-path dir library-file) path) + (install-file cfg (make-path dir rkt-file) rkt-path) + ;; install any includes + (cons + path + (append + (map + (lambda (x) + (let ((dest-file (make-path install-dir (path-relative x dir)))) + (install-directory cfg (path-directory dest-file)) + (install-file cfg x dest-file) + dest-file)) + include-files) + (map + (lambda (x) + (let* ((so-file (string-append x (cond-expand (macosx ".dylib") + (else ".so")))) + (dest-file (make-path install-lib-dir + (path-relative so-file dir)))) + (install-directory cfg (path-directory dest-file)) + (install-file cfg so-file dest-file) + dest-file)) + (library-shared-include-files + impl cfg (make-path dir library-file)))))))) + ;; installers should return the list of installed files (define (lookup-installer installer) (case installer ((chicken) chicken-installer) ((cyclone) cyclone-installer) ((guile) guile-installer) + ((racket) racket-installer) (else default-installer))) (define (installer-for-implementation impl cfg) @@ -1955,6 +2022,7 @@ ((chicken) 'chicken) ((cyclone) 'cyclone) ((guile) 'guile) + ((racket) 'racket) (else 'default))) (define (install-library impl cfg library dir) diff --git a/lib/chibi/snow/utils.scm b/lib/chibi/snow/utils.scm index 0bee1db5..b871a481 100644 --- a/lib/chibi/snow/utils.scm +++ b/lib/chibi/snow/utils.scm @@ -41,6 +41,10 @@ '(kawa -e "(write (features))")))) (larceny "larceny" (larceny --version) "v0.98" ,(delay '())) + (racket "racket" (racket --version) #f + ,(delay + (process->sexp + '(racket -I r7rs -e "(import (scheme base) (scheme write)) (display (features))")))) (sagittarius "sagittarius" #f #f ,(delay (process->sexp From 23100943549318b0566af5c4d2558710049f7a47 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Fri, 27 Jun 2025 07:40:34 +0300 Subject: [PATCH 4/7] Remove debug displays --- lib/chibi/snow/commands.scm | 6 ------ 1 file changed, 6 deletions(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 7254c6f8..f33949ac 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1969,12 +1969,6 @@ (path-strip-directory (path-strip-extension path)) ".sld"))) - (display "HERE: ") - (display source-rkt-file) - (newline) - (display dest-rkt-file) - (newline) - (with-output-to-file source-rkt-file (lambda () From 1b6c0fb9da13c862b15801e331bdf6c9b8c51874 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sat, 28 Jun 2025 07:26:44 +0300 Subject: [PATCH 5/7] racket-installer now returns list of installed files --- lib/chibi/snow/commands.scm | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index f33949ac..fb03dbba 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1955,20 +1955,18 @@ ;; a file that sets language to r7rs and includes the .sld file (define (racket-installer impl cfg library dir) (let* ((source-rkt-file - (string-append dir - "/" - (path-strip-extension (get-library-file cfg library)) - ".rkt")) + (make-path dir + (string-append (path-strip-extension (get-library-file cfg library)) + ".rkt"))) (install-dir (get-install-source-dir impl cfg)) (dest-rkt-file - (string-append install-dir - "/" - (library->path cfg library) ".rkt")) + (make-path install-dir + (string-append (library->path cfg library) ".rkt"))) (path (make-path install-dir dest-rkt-file)) (include-filename (string-append - (path-strip-directory - (path-strip-extension path)) - ".sld"))) + (path-strip-directory (path-strip-extension path)) + ".sld")) + (installed-files (default-installer impl cfg library dir))) (with-output-to-file source-rkt-file (lambda () @@ -1979,8 +1977,8 @@ #\newline "(include \"" include-filename "\")" #\newline)))) - (default-installer impl cfg library dir) - (install-file cfg source-rkt-file dest-rkt-file))) + (install-file cfg source-rkt-file dest-rkt-file) + (cons dest-rkt-file installed-files))) ;; installers should return the list of installed files (define (lookup-installer installer) From 7f2f3ba155e367b735f241e673f78882ea2bd152 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sat, 28 Jun 2025 07:28:34 +0300 Subject: [PATCH 6/7] Add back accidentally removed stklos part --- lib/chibi/snow/commands.scm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index fb03dbba..9d3db488 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1407,6 +1407,10 @@ "(begin (display (getenv \"LARCENY_ROOT\")) (exit))")) char-whitespace?) "lib/Snow"))) + ((stklos) + (list (make-path + (process->string + '(stklos -e "(display (install-path #:libdir))"))))) ((racket) (list (make-path From a2591d0e4ab1a14b8c5f9637ac69a263a25eb12c Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sat, 28 Jun 2025 07:32:02 +0300 Subject: [PATCH 7/7] Minor cleanup --- lib/chibi/snow/commands.scm | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 9d3db488..f8ba482f 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1975,12 +1975,9 @@ source-rkt-file (lambda () (map display - (list "#lang r7rs" - #\newline - "(import (scheme base))" - #\newline - "(include \"" include-filename "\")" - #\newline)))) + (list "#lang r7rs" #\newline + "(import (scheme base))" #\newline + "(include \"" include-filename "\")" #\newline)))) (install-file cfg source-rkt-file dest-rkt-file) (cons dest-rkt-file installed-files)))