diff --git a/Makefile b/Makefile index e7822d97..65c3e8cb 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 @@ -502,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 diff --git a/doc/chibi.scrbl b/doc/chibi.scrbl index f65ecd2f..df61b473 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. @@ -1613,6 +1630,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 @@ -1630,18 +1652,20 @@ 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{gambit} +\item{gambit - version >= 4.9.3} +\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} \item{sagittarius - version >= 0.98} +\item{stklos - version > 2.10} ] 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/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)) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 00a49bea..fa768b70 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -24,9 +24,10 @@ (else (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) + (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)))) @@ -129,7 +130,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 +160,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 '())) @@ -1361,7 +1364,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"))) @@ -1373,6 +1377,11 @@ ((gambit) (list (string-append (get-environment-variable "HOME") "/.gambit_userlib"))) + ((generic) + (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 @@ -1401,6 +1410,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" @@ -1493,6 +1506,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)))))) @@ -1634,7 +1651,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 @@ -1646,8 +1670,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 @@ -1688,7 +1711,9 @@ ((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)) + ((eq? impl 'generic) (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))) @@ -1699,6 +1724,8 @@ ((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)) + ((eq? impl 'generic) (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))) @@ -1714,12 +1741,16 @@ (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 'gambit) (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 9a7acfc3..f8179d59 100644 --- a/lib/chibi/snow/utils.scm +++ b/lib/chibi/snow/utils.scm @@ -29,6 +29,8 @@ ,(delay (process->sexp '(gsc -e "(write (features))")))) + (generic "generic" #f #f + ,(delay (write-string "generic\n"))) (gauche "gosh" (gosh -E "print (gauche-version)") "0.9.4" ,(delay (process->sexp @@ -46,7 +48,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)) @@ -66,6 +72,7 @@ ((gambit) (cond-expand (gambit #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) 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 '#())))) 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 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") ))