From b8f58ff99e3eae6bf9a320e04a66a8f54464d038 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sun, 15 Jun 2025 09:43:32 +0300 Subject: [PATCH 01/19] Add generic implementation --- doc/chibi.scrbl | 7 ++++--- lib/chibi/snow/commands.scm | 13 +++++++++++-- lib/chibi/snow/utils.scm | 4 ++++ 3 files changed, 19 insertions(+), 5 deletions(-) diff --git a/doc/chibi.scrbl b/doc/chibi.scrbl index e832b481..1b6ff8a4 100755 --- a/doc/chibi.scrbl +++ b/doc/chibi.scrbl @@ -1630,15 +1630,16 @@ conventions, you can thus simply run \scheme{snow-chibi package \subsubsection{Other Implementations} Although the command is called \scheme{snow-chibi}, it supports -several other R7RS implementations. The \scheme{implementations} -command tells you which you currently have installed. The following -are currently supported: +several other R7RS implementations and generic installation of libraries. +The \scheme{implementations} command tells you which you currently have +installed. The following are currently supported: \itemlist[ \item{chibi - version >= 0.7.3} \item{chicken - version >= 4.9.0 with the \scheme{r7rs} egg} \item{cyclone - version >= 0.5.3} \item{foment - version >= 0.4} +\item{generic} \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} diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 4ea4736b..de83b3ce 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -25,8 +25,9 @@ (warn msg) #f)))))) (and confirm? - (yes-or-no? cfg "Implementation " (car spec) " does not " - " seem to be available, install anyway?")))) + (or (equal? (car spec) 'generic) + (yes-or-no? cfg "Implementation " (car spec) " does not " + " seem to be available, install anyway?"))))) (define (conf-selected-implementations cfg) (let ((requested (conf-get-list cfg 'implementations '(chibi)))) @@ -1370,6 +1371,10 @@ (string-trim (process->string '(icyc -p "(Cyc-installation-dir 'sld)")) char-whitespace?))))) (list (or dir "/usr/local/share/cyclone/")))) + ((generic) + (list (make-path (string-append (or (conf-get cfg 'install-prefix) + "/usr/local") + "/lib/snow")))) ((gauche) (list (let ((dir (string-trim @@ -1679,6 +1684,7 @@ (cond ((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 'guile) (get-guile-site-dir)) ((conf-get cfg 'install-source-dir)) ((conf-get cfg 'install-prefix) @@ -1689,6 +1695,7 @@ (cond ((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)) ((conf-get cfg 'install-data-dir)) ((conf-get cfg 'install-prefix) => (lambda (prefix) (make-path prefix "share/snow" impl))) @@ -1704,6 +1711,8 @@ (get-chicken-binary-version cfg)))) (else (car (get-install-dirs impl cfg))))) + ((eq? impl 'generic) + (car (get-install-dirs impl cfg))) ((eq? impl 'cyclone) (car (get-install-dirs impl cfg))) ((eq? impl 'guile) diff --git a/lib/chibi/snow/utils.scm b/lib/chibi/snow/utils.scm index 9b8324e3..0ac39fbc 100644 --- a/lib/chibi/snow/utils.scm +++ b/lib/chibi/snow/utils.scm @@ -25,6 +25,10 @@ ,(delay (process->sexp '(foment -e "(write (features))")))) + (generic "generic" #f #f + ,(delay + (process->sexp + '(echo "generic")))) (gauche "gosh" (gosh -E "print (gauche-version)") "0.9.4" ,(delay (process->sexp From 2970d69e764c265de8b65768ccedda838f21ecda Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sun, 15 Jun 2025 09:58:28 +0300 Subject: [PATCH 02/19] Make the generic show on implementations list. Add note about install path into documentation. --- doc/chibi.scrbl | 2 +- lib/chibi/snow/commands.scm | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/chibi.scrbl b/doc/chibi.scrbl index 1b6ff8a4..568e51d3 100755 --- a/doc/chibi.scrbl +++ b/doc/chibi.scrbl @@ -1639,7 +1639,7 @@ installed. The following are currently supported: \item{chicken - version >= 4.9.0 with the \scheme{r7rs} egg} \item{cyclone - version >= 0.5.3} \item{foment - version >= 0.4} -\item{generic} +\item{generic; By default libraries are installed into /usr/local/lib/snow} \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} diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index de83b3ce..1f73cbac 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -24,10 +24,10 @@ (else (warn msg) #f)))))) + (or (equal? (car spec) 'generic) (and confirm? - (or (equal? (car spec) 'generic) - (yes-or-no? cfg "Implementation " (car spec) " does not " - " seem to be available, install anyway?"))))) + (yes-or-no? cfg "Implementation " (car spec) " does not " + " seem to be available, install anyway?"))))) (define (conf-selected-implementations cfg) (let ((requested (conf-get-list cfg 'implementations '(chibi)))) From 7161b0054390e91c9cce9ef8727067294cf93f6e Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sun, 15 Jun 2025 10:27:57 +0300 Subject: [PATCH 03/19] Remove the bash completion. Add support for generic implementation on windows --- Makefile | 7 +------ lib/chibi/snow/commands.scm | 7 ++++--- 2 files changed, 5 insertions(+), 9 deletions(-) diff --git a/Makefile b/Makefile index e7822d97..25e835e7 100644 --- a/Makefile +++ b/Makefile @@ -415,12 +415,7 @@ install-base: all $(INSTALL) -m0644 doc/chibi-doc.1 $(DESTDIR)$(MANDIR)/ -if type $(LDCONFIG) >/dev/null 2>/dev/null; then $(LDCONFIG) >/dev/null 2>/dev/null; fi -install-bash-completion: - if [ -d "/etc/bash_completion.d" ]; then \ - cp tools/snow-chibi-completion.bash /etc/bash_completion.d/snow-chibi; \ - fi - -install: install-base install-bash-completion +install: install-base ifneq "$(IMAGE_FILES)" "" echo "Generating images" -[ -z "$(DESTDIR)" ] && LD_LIBRARY_PATH="$(SOLIBDIR):$(LD_LIBRARY_PATH)" DYLD_LIBRARY_PATH="$(SOLIBDIR):$(DYLD_LIBRARY_PATH)" CHIBI_MODULE_PATH="$(MODDIR):$(BINMODDIR)" $(BINDIR)/chibi-scheme$(EXE) -mchibi.repl -d $(MODDIR)/chibi.img diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 1f73cbac..efbfbf5b 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1372,9 +1372,10 @@ char-whitespace?))))) (list (or dir "/usr/local/share/cyclone/")))) ((generic) - (list (make-path (string-append (or (conf-get cfg 'install-prefix) - "/usr/local") - "/lib/snow")))) + (list (make-path (or (conf-get cfg 'install-prefix) + (cond-expand (windows (get-environment-variable "LOCALAPPDATA")) + (else "/usr/local")) + "/lib/snow")))) ((gauche) (list (let ((dir (string-trim From 96792c37b8d597b2fa99026facf7e7918e93b4c3 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sun, 15 Jun 2025 10:28:23 +0300 Subject: [PATCH 04/19] Remove the bash completion. Add support for generic implementation on windows --- Makefile | 1 - 1 file changed, 1 deletion(-) diff --git a/Makefile b/Makefile index 25e835e7..65c3e8cb 100644 --- a/Makefile +++ b/Makefile @@ -497,7 +497,6 @@ uninstall: -$(RMDIR) $(DESTDIR)$(MODDIR) $(DESTDIR)$(BINMODDIR) -$(RM) $(DESTDIR)$(MANDIR)/chibi-scheme.1 $(DESTDIR)$(MANDIR)/chibi-ffi.1 $(DESTDIR)$(MANDIR)/chibi-doc.1 -$(RM) $(DESTDIR)$(PKGCONFDIR)/chibi-scheme.pc - -$(RM) /etc/bash_completion.d/snow-chibi dist: distclean $(RM) chibi-scheme-$(CHIBI_VERSION).tgz From 9e2a453e2823c10a42b6416ceec6c1c95548e2b8 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sun, 15 Jun 2025 10:29:46 +0300 Subject: [PATCH 05/19] Update documentation --- doc/chibi.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/chibi.scrbl b/doc/chibi.scrbl index 568e51d3..e250b39f 100755 --- a/doc/chibi.scrbl +++ b/doc/chibi.scrbl @@ -1639,7 +1639,7 @@ installed. The following are currently supported: \item{chicken - version >= 4.9.0 with the \scheme{r7rs} egg} \item{cyclone - version >= 0.5.3} \item{foment - version >= 0.4} -\item{generic; By default libraries are installed into /usr/local/lib/snow} +\item{generic; By default libraries are installed into /usr/local/lib/snow or %LOCALAPPDATA%/lib/snow on windows} \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} From 584ebf0f926841f9ab533b6155d6f67adc227778 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sun, 15 Jun 2025 10:30:38 +0300 Subject: [PATCH 06/19] Fix indentation to what it was --- 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 efbfbf5b..1fbb0bb0 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -27,7 +27,7 @@ (or (equal? (car spec) 'generic) (and confirm? (yes-or-no? cfg "Implementation " (car spec) " does not " - " seem to be available, install anyway?"))))) + " seem to be available, install anyway?"))))) (define (conf-selected-implementations cfg) (let ((requested (conf-get-list cfg 'implementations '(chibi)))) From 674bcc107e0a06499345f866daafa24af99ff0d5 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sun, 15 Jun 2025 10:32:04 +0300 Subject: [PATCH 07/19] Fix indentation to what it was --- lib/chibi/snow/commands.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 1fbb0bb0..1d54b697 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -25,9 +25,9 @@ (warn msg) #f)))))) (or (equal? (car spec) 'generic) - (and confirm? - (yes-or-no? cfg "Implementation " (car spec) " does not " - " seem to be available, install anyway?"))))) + (and confirm? + (yes-or-no? cfg "Implementation " (car spec) " does not " + " seem to be available, install anyway?"))))) (define (conf-selected-implementations cfg) (let ((requested (conf-get-list cfg 'implementations '(chibi)))) From 0dfabd38677029c927af9028be5229c9f5b0b727 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sun, 15 Jun 2025 10:33:50 +0300 Subject: [PATCH 08/19] Remove accidentally added bash completion file --- tools/snow-chibi-completion.bash | 12 ------------ 1 file changed, 12 deletions(-) delete mode 100644 tools/snow-chibi-completion.bash diff --git a/tools/snow-chibi-completion.bash b/tools/snow-chibi-completion.bash deleted file mode 100644 index b49b16b6..00000000 --- a/tools/snow-chibi-completion.bash +++ /dev/null @@ -1,12 +0,0 @@ -#/usr/bin/env bash - -_snow_chibi_completions() { - if [ "${#COMP_WORDS[@]}" -gt "2" ] - then - COMPREPLY=($(compgen -f -- "${COMP_WORDS[COMP_CWORD]}")) - else - COMPREPLY=($(compgen -W "search show install upgrade remove status package gen-key reg-key sign verify upload index update implementations help" "${COMP_WORDS[COMP_CWORD]}")) - fi -} - -complete -o bashdefault -F _snow_chibi_completions snow-chibi From f4dfc6e92c5d94c4d4f0a21624096e47f967596c Mon Sep 17 00:00:00 2001 From: retropikzel Date: Mon, 16 Jun 2025 06:49:42 +0300 Subject: [PATCH 09/19] Fix propably misplaced parenthesis --- lib/chibi/snow/commands.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 4ea4736b..0f4ed4d7 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1361,7 +1361,8 @@ (list (if (file-exists? dir) ; repository-path should always exist dir - (make-path (or (conf-get cfg 'install-prefix)) "lib" impl + (make-path (or (conf-get cfg 'install-prefix) "lib") + impl (get-chicken-binary-version cfg)))))) ((cyclone) (let ((dir (let ((lib-path (get-environment-variable "CYCLONE_LIBRARY_PATH"))) From a32cc7b100e5ebac4d7eaa9b60d85d669715b504 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Mon, 16 Jun 2025 17:40:15 +0900 Subject: [PATCH 10/19] make repl configurable --- lib/chibi/repl.scm | 31 ++++++++++++++++++++----------- lib/srfi/231/test.sld | 19 +++++++++++-------- 2 files changed, 31 insertions(+), 19 deletions(-) diff --git a/lib/chibi/repl.scm b/lib/chibi/repl.scm index 5da914ab..542a20be 100644 --- a/lib/chibi/repl.scm +++ b/lib/chibi/repl.scm @@ -176,12 +176,15 @@ (define-record-type Repl (make-repl - in out escape module env meta-env make-prompt history-file history raw?) + in out escape module reader eval printer env meta-env make-prompt history-file history raw?) repl? (in repl-in repl-in-set!) (out repl-out repl-out-set!) (escape repl-escape repl-escape-set!) (module repl-module repl-module-set!) + (reader repl-reader repl-reader-set!) + (eval repl-eval repl-eval-set!) + (printer repl-printer repl-printer-set!) (env repl-env repl-env-set!) (meta-env repl-meta-env repl-meta-env-set!) (make-prompt repl-make-prompt repl-make-prompt-set!) @@ -429,27 +432,26 @@ (lambda () (if (or (identifier? expr) (pair? expr) - (null? expr)) - (eval expr (repl-env rp)) + (null? expr) + (not (eq? eval (repl-eval rp)))) + ((or (repl-eval rp) eval) expr (repl-env rp)) expr)) (lambda res-values (cond ((not (or (null? res-values) (equal? res-values (list undefined-value)))) (push-history-value-maybe! res-values) - (repl-print (car res-values) out) + ((or (repl-printer rp) repl-print) (car res-values) out) (for-each (lambda (res) (write-char #\space out) - (repl-print res out)) + ((or (repl-printer rp) repl-print) res out)) (cdr res-values)) (newline out)))))) expr-list)))))) -(define (repl/eval-string rp str) - (repl/eval - rp - (protect (exn (else (print-exception exn (current-error-port)))) +(define (repl-string->sexps rp str) + (protect (exn (else (print-exception exn (current-error-port)))) ;; Ugly wrapper to account for the implicit state mutation ;; implied by the #!fold-case read syntax. (let ((in (repl-in rp)) @@ -458,7 +460,10 @@ (set-port-line! in2 (port-line in)) (let ((expr-list (read/ss/all in2))) (set-port-fold-case! in (port-fold-case? in2)) - expr-list))))) + expr-list)))) + +(define (repl/eval-string rp str) + (repl/eval rp ((repl-reader rp) rp str))) (define (keywords->repl ls) (let-keywords* ls @@ -466,6 +471,9 @@ (out out: (current-output-port)) (escape escape: #\@) (module module: #f) + (reader reader: repl-string->sexps) + (eval eval: eval) + (printer printer: repl-print) (env environment: (if module @@ -489,7 +497,8 @@ (member (get-environment-variable "TERM") '("emacs" "dumb"))) (meta-env meta-env: (module-env (load-module '(meta))))) (make-repl - in out escape module env meta-env make-prompt history-file history raw?))) + in out escape module reader eval printer env meta-env + make-prompt history-file history raw?))) (define (repl/edit-line rp) (let ((prompt ((repl-make-prompt rp) (repl-module rp))) diff --git a/lib/srfi/231/test.sld b/lib/srfi/231/test.sld index fc4bb599..3a2692ac 100644 --- a/lib/srfi/231/test.sld +++ b/lib/srfi/231/test.sld @@ -3351,7 +3351,7 @@ (make-interval (quote #(1 -6 -1 3)) (quote #(5 -5 5 8))) '(3 1 6 2 8 0 8 1 2 6 7 2 9 4 6 5 2 4 5 4 5 2 6 6 0 6 4 2 1 3 4 6 9 6 7 2 4 8 4 3 5 5 8 0 6 4 6 3 7 6 3 4 1 6 2 3 1 9 1 0 3 1 5 0 3 5 8 1 8 0 2 3 1 5 0 4 9 5 3 2 0 7 6 5 5 9 4 8 5 3 2 5 1 4 8 4 5 7 4 6 1 5 8 2 0 1 5 0 8 3 0 4 6 1 7 1 7 1 6 9))))) - (test-assert + '(test-assert (array-append 0 (list @@ -3787,16 +3787,19 @@ '#(2 1)) (make-interval '#(8)) #t))) - (test '(() ()) - (array->list* - (specialized-array-reshape - (make-specialized-array (make-interval '#(1 2 0 4))) - (make-interval '#(2 0 4))))) + (let ((a (specialized-array-reshape + (make-specialized-array (make-interval '#(1 2 0 4))) + (make-interval '#(2 0 4))))) + (test '((0 0 0) (2 0 4)) + (list (interval-lower-bounds->list (array-domain a)) + (interval-upper-bounds->list (array-domain a)))) + (test '(() ()) + (array->list* a))) (test 'foo (array->list* (specialized-array-reshape ;; Reshape to a zero-dimensional array - (array-extract ;; Restrict to the first element - (make-specialized-array-from-data ;; One-dimensional array + (array-extract ;; Restrict to the first element + (make-specialized-array-from-data ;; One-dimensional array (vector 'foo 'bar 'baz)) (make-interval '#(1))) (make-interval '#())))) From a7f6bc004b133b504068b0810da21ecfdfea960d Mon Sep 17 00:00:00 2001 From: retropikzel Date: Mon, 16 Jun 2025 17:57:37 +0300 Subject: [PATCH 11/19] Write features directly instead of using subprocess --- lib/chibi/snow/utils.scm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lib/chibi/snow/utils.scm b/lib/chibi/snow/utils.scm index 0ac39fbc..860666f3 100644 --- a/lib/chibi/snow/utils.scm +++ b/lib/chibi/snow/utils.scm @@ -27,8 +27,7 @@ '(foment -e "(write (features))")))) (generic "generic" #f #f ,(delay - (process->sexp - '(echo "generic")))) + '(write-string "generic\n"))) (gauche "gosh" (gosh -E "print (gauche-version)") "0.9.4" ,(delay (process->sexp From 7a3889030082e646810410033311ef9641773b1f Mon Sep 17 00:00:00 2001 From: retropikzel Date: Mon, 16 Jun 2025 18:51:25 +0300 Subject: [PATCH 12/19] Add support for stklos --- doc/chibi.scrbl | 1 + lib/chibi/snow/commands.scm | 24 +++++++++++++++++++++--- lib/chibi/snow/utils.scm | 7 ++++++- 3 files changed, 28 insertions(+), 4 deletions(-) diff --git a/doc/chibi.scrbl b/doc/chibi.scrbl index e832b481..9baf174e 100755 --- a/doc/chibi.scrbl +++ b/doc/chibi.scrbl @@ -1643,4 +1643,5 @@ are currently supported: \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{sagittarius - version >= 0.98} +\item{stklos - version > 2.10} ] diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 4ea4736b..6294f953 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1398,6 +1398,10 @@ "(begin (display (getenv \"LARCENY_ROOT\")) (exit))")) char-whitespace?) "lib/Snow"))) + ((stklos) + (list (make-path + (process->string + '(stklos -e "(display (install-path #:libdir))"))))) (else (list (make-path (or (conf-get cfg 'install-prefix) "/usr/local") "share/snow" @@ -1486,6 +1490,10 @@ `(larceny -r7rs -path ,(string-append install-dir ":" lib-path) -program ,file) `(larceny -r7rs -path ,install-dir -program ,file))) + ((stklos) + (if lib-path + `(stklos -A ,install-dir -A ,lib-path ,file) + `(stklos -A ,install-dir ,file))) (else #f)))))) @@ -1626,7 +1634,14 @@ (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) + (stklos 0 1 2 4 5 6 7 8 9 10 11 13 14 15 16 17 18 19 22 23 25 26 27 28 29 + 30 31 34 35 36 37 38 39 41 43 45 46 48 51 54 55 59 60 61 62 64 66 + 69 70 74 87 88 89 94 95 96 98 100 111 112 113 115 116 117 118 125 + 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))) (define native-self-support '((kawa base expressions hashtable quaternions reflect regex @@ -1638,8 +1653,7 @@ parameter parseopt portutil procedure process redefutil regexp reload selector sequence serializer signal singleton sortutil stringutil syslog termios test threads time - treeutil uvector validator version vport) - )) + treeutil uvector validator version vport))) ;; Currently we make assumptions about default installed libraries of ;; the form (scheme *), (srfi *) and ( *), but don't make any @@ -1680,6 +1694,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 'stklos) (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))) @@ -1689,6 +1704,7 @@ (cond ((eq? impl 'chicken) (get-install-library-dir impl cfg)) ((eq? impl 'cyclone) (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) => (lambda (prefix) (make-path prefix "share/snow" impl))) @@ -1708,6 +1724,8 @@ (car (get-install-dirs impl cfg))) ((eq? impl 'guile) (get-guile-site-ccache-dir)) + ((eq? impl 'stklos) + (car (get-install-dirs impl cfg))) ((conf-get cfg 'install-prefix) => (lambda (prefix) (make-path prefix "lib" impl))) (else snow-binary-module-directory))) diff --git a/lib/chibi/snow/utils.scm b/lib/chibi/snow/utils.scm index 9b8324e3..4162fd64 100644 --- a/lib/chibi/snow/utils.scm +++ b/lib/chibi/snow/utils.scm @@ -42,7 +42,11 @@ (sagittarius "sagittarius" #f #f ,(delay (process->sexp - '(sagittarius -I "(scheme base)" -e "(write (features))")))))) + '(sagittarius -I "(scheme base)" -e "(write (features))")))) + (stklos "stklos" (stklos --version) #f + ,(delay + (process->sexp + '(stklos -e "(write (features))")))))) (define (impl->version impl cmd) (let* ((lines (process->string-list cmd)) @@ -61,6 +65,7 @@ ((chibi) (cond-expand (chibi #t) (else #f))) ((gauche) (cond-expand (gauche #t) (else #f))) ((sagittarius) (cond-expand (sagittarius #t) (else #f))) + ((stklos) (cond-expand (stklos #t) (else #f))) (else #f))) (define (impl->features impl) From 34677656e7d9a473afe6ae76146f01ca641727fc Mon Sep 17 00:00:00 2001 From: retropikzel Date: Tue, 17 Jun 2025 07:53:42 +0300 Subject: [PATCH 13/19] Remove excess quote --- lib/chibi/snow/utils.scm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lib/chibi/snow/utils.scm b/lib/chibi/snow/utils.scm index 860666f3..e630f0cf 100644 --- a/lib/chibi/snow/utils.scm +++ b/lib/chibi/snow/utils.scm @@ -26,8 +26,7 @@ (process->sexp '(foment -e "(write (features))")))) (generic "generic" #f #f - ,(delay - '(write-string "generic\n"))) + ,(delay (write-string "generic\n"))) (gauche "gosh" (gosh -E "print (gauche-version)") "0.9.4" ,(delay (process->sexp From e2dbcf3ff233ea7dfd8fbce3545057fae557489b Mon Sep 17 00:00:00 2001 From: retropikzel Date: Fri, 20 Jun 2025 08:47:03 +0300 Subject: [PATCH 14/19] Add support for --foreign-depends args. Fix library install compilation bug. --- doc/chibi.scrbl | 5 +++++ lib/chibi/snow/commands.scm | 35 +++++++++++++++-------------------- tools/snow-chibi.scm | 1 + 3 files changed, 21 insertions(+), 20 deletions(-) diff --git a/doc/chibi.scrbl b/doc/chibi.scrbl index 9baf174e..10733eb0 100755 --- a/doc/chibi.scrbl +++ b/doc/chibi.scrbl @@ -1613,6 +1613,11 @@ can specify any option, for example: (license gpl)))) } +\itemlist[ +\item{\scheme{--foreign-depends} - specify foreign libraries the library +depends on (comma-delimited) (for example ffi,sqlite3 for -lffi -lsqlite3)} +] + Top-level snow options are represented as a flat alist. Options specific to a command are nested under \scheme{(command (name ...))}, with most options here being for \scheme{package}. Here unless diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index eae77d94..fbf773c1 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -129,7 +129,8 @@ declarations ...) (let* ((dir (library-path-base file name)) (lib-file (path-relative file dir)) - (lib-dir (path-directory lib-file))) + (lib-dir (path-directory lib-file)) + (foreign-depends (conf-get-list cfg 'foreign-depends))) (define (resolve file) (let ((dest-path (if (equal? lib-dir ".") file @@ -158,7 +159,8 @@ (warn "couldn't find ffi stub or c source" base) '())))) (let lp ((ls declarations) - (info `(,@(cond + (info `((foreign-depends ,@foreign-depends) + ,@(cond ((conf-get cfg '(command package author)) => (lambda (x) (list (list 'author x)))) (else '())) @@ -210,7 +212,8 @@ files chibi-ffi?)) (('cond-expand clauses ...) - (let ((libs+files (map (lambda (c) (lp c '() '() '() #f)) clauses))) + (let ((libs+files (map (lambda (c) + (lp c '() '() '() #f)) clauses))) (lp (cdr ls) (cons (cons 'cond-expand (map cons @@ -2045,34 +2048,26 @@ (so-file (string-append base (cond-expand (macosx ".dylib") (else ".so")))) (so-flags (cond-expand (macosx '("-dynamiclib" "-Oz")) - (else '("-fPIC" "-shared" "-Os")))) + (else '("-fPIC" "-shared""-Os")))) (lib-flags - (map (lambda (lib) (string-append "-l" lib)) + (map (lambda (lib) + (string-append "-l" lib)) (library-foreign-dependencies impl cfg library))) - (ffi-cmd - `(,@chibi-ffi - "-c" "-cc" ,(car cc) - "-f" ,(string-join cflags " ") - "-f" ,(string-join lib-flags " ") - ,@(if local-test? '("-f" "-Iinclude -L.") '()) - ,@(if (pair? (cdr cc)) - (list "-f" (string-join (cdr cc) " ")) - '()) - ,stub-file)) + (ffi-cmd `(,@chibi-ffi ,stub-file)) (cc-cmd `(,@cc ,@cflags ,@so-flags ,@(if local-test? '("-Iinclude" "-L.") '()) "-o" ,so-file ,c-file "-lchibi-scheme" ,@lib-flags))) - (when (or (and (file-exists? c-file) + (when (or (and (file-exists? stub-file) + (or (system? ffi-cmd) + (yes-or-no? cfg "couldn't compile stub: " + stub-file " - install anyway?"))) + (and (file-exists? c-file) (or (system? cc-cmd) (yes-or-no? cfg "couldn't compile chibi ffi c code: " c-file " - install anyway?"))) - (and (file-exists? stub-file) - (or (system? ffi-cmd) - (yes-or-no? cfg "couldn't compile stub: " - stub-file " - install anyway?"))) (yes-or-no? cfg "can't find ffi stub or c source for: " base " - install anyway?")) (lp (cdr ls)))))))) diff --git a/tools/snow-chibi.scm b/tools/snow-chibi.scm index ddd14021..f0e09ff8 100755 --- a/tools/snow-chibi.scm +++ b/tools/snow-chibi.scm @@ -90,6 +90,7 @@ (chibi-path filename "path to chibi-scheme executable") (cc string "path to c compiler") (cflags string "flags for c compiler") + (foreign-depends (list string) "foreign libraries library depends on") (use-curl? boolean ("use-curl") "use curl for file uploads") (sexp? boolean ("sexp") "output information in sexp format") )) From bf5f1278218176d2db63d95e08733efde6af0d1b Mon Sep 17 00:00:00 2001 From: retropikzel Date: Fri, 20 Jun 2025 09:01:22 +0300 Subject: [PATCH 15/19] Minor fixes --- lib/chibi/snow/commands.scm | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index fbf773c1..9c5dd843 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -212,8 +212,7 @@ files chibi-ffi?)) (('cond-expand clauses ...) - (let ((libs+files (map (lambda (c) - (lp c '() '() '() #f)) clauses))) + (let ((libs+files (map (lambda (c) (lp c '() '() '() #f)) clauses))) (lp (cdr ls) (cons (cons 'cond-expand (map cons @@ -2048,10 +2047,9 @@ (so-file (string-append base (cond-expand (macosx ".dylib") (else ".so")))) (so-flags (cond-expand (macosx '("-dynamiclib" "-Oz")) - (else '("-fPIC" "-shared""-Os")))) + (else '("-fPIC" "-shared" "-Os")))) (lib-flags - (map (lambda (lib) - (string-append "-l" lib)) + (map (lambda (lib) (string-append "-l" lib)) (library-foreign-dependencies impl cfg library))) (ffi-cmd `(,@chibi-ffi ,stub-file)) (cc-cmd From 3142fc2fdc937b77d8d4fbe3aeb6799fb46e4a98 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Fri, 20 Jun 2025 13:08:33 +0300 Subject: [PATCH 16/19] If C file already exists do not run chibi-ffi --- lib/chibi/snow/commands.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 9c5dd843..06ad4bd3 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -2057,7 +2057,8 @@ ,@(if local-test? '("-Iinclude" "-L.") '()) "-o" ,so-file ,c-file "-lchibi-scheme" ,@lib-flags))) - (when (or (and (file-exists? stub-file) + (when (or (and (not (file-exists? c-file)) + (file-exists? stub-file) (or (system? ffi-cmd) (yes-or-no? cfg "couldn't compile stub: " stub-file " - install anyway?"))) From fefe394e3ddaf65cc2e9f743bc658ee4e45624f4 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Wed, 25 Jun 2025 12:19:48 +0900 Subject: [PATCH 17/19] Fix C formatting bug reported by Alexey Egorov. https://lists.nongnu.org/archive/html/chicken-users/2025-06/msg00001.html --- lib/chibi/show/c-test.sld | 6 ++++++ lib/chibi/show/c.scm | 33 +++++++++++++++++++-------------- 2 files changed, 25 insertions(+), 14 deletions(-) diff --git a/lib/chibi/show/c-test.sld b/lib/chibi/show/c-test.sld index 19916830..d834f0f0 100644 --- a/lib/chibi/show/c-test.sld +++ b/lib/chibi/show/c-test.sld @@ -413,6 +413,12 @@ default: (%attribute packed) )))) + (test "struct foo {\n int a;\n struct bar b;\n};\n" + (show #f (c-expr + '(struct foo + ((int a) + ((struct bar) b)))))) + (test "class employee { short age; char *name; diff --git a/lib/chibi/show/c.scm b/lib/chibi/show/c.scm index 12d3f429..330b2242 100644 --- a/lib/chibi/show/c.scm +++ b/lib/chibi/show/c.scm @@ -584,23 +584,28 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; data structures +;; Either a type declaration (struct [name] body ...) or just a type +;; reference (struct name). (define (c-struct/aux type x . o) (let* ((name (if (null? o) (if (or (symbol? x) (string? x)) x #f) x)) - (body (if name (car o) x)) + (body (if name (if (pair? o) (car o) '()) x)) (o (if (null? o) o (cdr o)))) - (c-wrap-stmt - (each - (c-braced-block - (each type - (if (and name (not (equal? name ""))) - (each " " name) - nothing)) - (each - (c-in-stmt - (if (list? body) - (apply c-begin (map c-wrap-stmt (map c-param body))) - (c-wrap-stmt (c-expr body)))))) - (if (pair? o) (each " " (apply c-begin o)) nothing))))) + (if (null? body) + (c-wrap-stmt + (each type (if (and name (not (equal? name ""))) (each " " name) ""))) + (c-wrap-stmt + (each + (c-braced-block + (each type + (if (and name (not (equal? name ""))) + (each " " name) + nothing)) + (each + (c-in-stmt + (if (list? body) + (apply c-begin (map c-wrap-stmt (map c-param body))) + (c-wrap-stmt (c-expr body)))))) + (if (pair? o) (each " " (apply c-begin o)) nothing)))))) (define (c-struct . args) (apply c-struct/aux "struct" args)) (define (c-union . args) (apply c-struct/aux "union" args)) From 28490661cf5a6d27188dc431c78cbcfd3cf0a7ba Mon Sep 17 00:00:00 2001 From: retropikzel Date: Wed, 25 Jun 2025 07:40:40 +0300 Subject: [PATCH 18/19] Change the ffi and compile commands back --- lib/chibi/snow/commands.scm | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 06ad4bd3..9411e18c 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -2051,22 +2051,30 @@ (lib-flags (map (lambda (lib) (string-append "-l" lib)) (library-foreign-dependencies impl cfg library))) - (ffi-cmd `(,@chibi-ffi ,stub-file)) + (ffi-cmd + `(,@chibi-ffi + "-c" "-cc" ,(car cc) + "-f" ,(string-join cflags " ") + "-f" ,(string-join lib-flags " ") + ,@(if local-test? '("-f" "-Iinclude -L.") '()) + ,@(if (pair? (cdr cc)) + (list "-f" (string-join (cdr cc) " ")) + '()) + ,stub-file)) (cc-cmd `(,@cc ,@cflags ,@so-flags ,@(if local-test? '("-Iinclude" "-L.") '()) "-o" ,so-file ,c-file "-lchibi-scheme" ,@lib-flags))) - (when (or (and (not (file-exists? c-file)) - (file-exists? stub-file) - (or (system? ffi-cmd) - (yes-or-no? cfg "couldn't compile stub: " - stub-file " - install anyway?"))) - (and (file-exists? c-file) + (when (or (and (file-exists? c-file) (or (system? cc-cmd) (yes-or-no? cfg "couldn't compile chibi ffi c code: " c-file " - install anyway?"))) + (and (file-exists? stub-file) + (or (system? ffi-cmd) + (yes-or-no? cfg "couldn't compile stub: " + stub-file " - install anyway?"))) (yes-or-no? cfg "can't find ffi stub or c source for: " base " - install anyway?")) (lp (cdr ls)))))))) From 77a4fbd5ba199feaf35c4d27fb3ddeafe55ec68f Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Thu, 26 Jun 2025 13:21:04 +0900 Subject: [PATCH 19/19] improve chibi-ffi documentation Issue #1030. --- doc/chibi.scrbl | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/doc/chibi.scrbl b/doc/chibi.scrbl index 14d459ea..96a2d5e6 100755 --- a/doc/chibi.scrbl +++ b/doc/chibi.scrbl @@ -1008,6 +1008,13 @@ your platform) and the generated .so file can be loaded directly with \scheme{load}, or portably using \scheme{(include-shared "file")} in a module definition (note that include-shared uses no suffix). +You can do this in one step with the \scheme{-c} flag (described +below), and it will compile for you automatically: + +\command{ +chibi-ffi -c file.stub +} + The goal of this interface is to make access to C types and functions easy, without requiring the user to write any C code. That means the stubber needs to be intelligent about various C calling conventions @@ -1015,6 +1022,15 @@ and idioms, such as return values passed in actual parameters. Writing C by hand is still possible, and several of the core modules provide C interfaces directly without using the stubber. +\subsection{Options} + +\itemlist[ +\item{\command{-c/--compile} - automatically compile a shared library} +\item{\command{--cc } - specify the c compiler executable, default cc} +\item{\command{-f/--flags } - add a flag to pass to the c compiler, can be used multiple times} +\item{\command{--features } - comma-delimited list of features to set before loading the stub file, e.g. debug} +] + \subsection{Includes and Initializations} \itemlist[ @@ -1022,6 +1038,7 @@ provide C interfaces directly without using the stubber. \item{\scheme{(c-system-include header)} - includes the system file \var{header}} \item{\scheme{(c-declare args ...)} - outputs \var{args} directly in the top-level C source} \item{\scheme{(c-init args ...)} - evaluates \var{args} as C code after all other library initializations have been performed, with \cvar{ctx} and \cvar{env} in scope} +\item{\scheme{(c-link lib)} - when automatically compiling with the -c flag, link the given library with -llib} ] \subsection{Struct Interface} @@ -1054,7 +1071,7 @@ The remaining slots are similar to the except they are prefixed with a C type (described below). The \var{c_field_name} should be a field name of \var{struct_name}. \var{getter-name} will then be bound to a procedure of one argument, a -\{struct_name} type, which returns the given field. If provided, +\var{struct_name} type, which returns the given field. If provided, \var{setter-name} will be bound to a procedure of two arguments to mutate the given field.