default snow-chibi command uses snow.img

Makefile

@@ -18,7 +18,7 @@ GENSTATIC ?= ./tools/chibi-genstatic
 CHIBI ?= LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" DYLD_LIBRARY_PATH=".:$(DYLD_LIBRARY_PATH)" CHIBI_MODULE_PATH=lib ./chibi-scheme$(EXE)
 CHIBI_DEPENDENCIES = ./chibi-scheme$(EXE)
 
-SNOW_CHIBI ?= $(CHIBI) tools/snow-chibi
+SNOW_CHIBI ?= tools/snow-chibi
 
 ########################################################################
 
@@ -46,7 +46,7 @@ MODULE_DOCS := app ast config disasm equiv filesystem generic heap-stats io \
 	system test time trace type-inference uri weak monad/environment \
 	show show/base crypto/sha2
 
-IMAGE_FILES = chibi.img snow.img
+IMAGE_FILES = lib/chibi.img lib/snow.img
 
 HTML_LIBS = $(MODULE_DOCS:%=doc/lib/chibi/%.html)
 
@@ -163,10 +163,10 @@ chibi-scheme.pc: chibi-scheme.pc.in
 lib/chibi/ast$(SO): lib/chibi/ast.c $(INCLUDES) libchibi-scheme$(SO)
 	-$(CC) $(CLIBFLAGS) $(CLINKFLAGS) $(XCPPFLAGS) $(XCFLAGS) $(LDFLAGS) -o $@ $< $(GCLDFLAGS) -L. -lchibi-scheme
 
-chibi.img: $(CHIBI_DEPENDENCIES) all-libs
+lib/chibi.img: $(CHIBI_DEPENDENCIES) all-libs
 	$(CHIBI) -d $@
 
-snow.img: $(CHIBI_DEPENDENCIES) all-libs
+lib/snow.img: $(CHIBI_DEPENDENCIES) all-libs
 	$(CHIBI) -mchibi.snow.commands -mchibi.snow.interface -mchibi.snow.package -mchibi.snow.utils -d $@
 
 doc: doc/chibi.html doc-libs
@@ -277,6 +277,7 @@ install: all
 	$(INSTALL) -m0755 tools/chibi-ffi $(DESTDIR)$(BINDIR)/
 	$(INSTALL) -m0755 tools/chibi-doc $(DESTDIR)$(BINDIR)/
 	$(INSTALL) -m0755 tools/snow-chibi $(DESTDIR)$(BINDIR)/
+	$(INSTALL) -m0755 tools/snow-chibi.scm $(DESTDIR)$(BINDIR)/
 	$(MKDIR) $(DESTDIR)$(MODDIR)/chibi/char-set $(DESTDIR)$(MODDIR)/chibi/crypto $(DESTDIR)$(MODDIR)/chibi/io $(DESTDIR)$(MODDIR)/chibi/iset $(DESTDIR)$(MODDIR)/chibi/loop $(DESTDIR)$(MODDIR)/chibi/match $(DESTDIR)$(MODDIR)/chibi/math $(DESTDIR)$(MODDIR)/chibi/monad $(DESTDIR)$(MODDIR)/chibi/net $(DESTDIR)$(MODDIR)/chibi/optimize $(DESTDIR)$(MODDIR)/chibi/parse $(DESTDIR)$(MODDIR)/chibi/regexp $(DESTDIR)$(MODDIR)/chibi/show $(DESTDIR)$(MODDIR)/chibi/snow $(DESTDIR)$(MODDIR)/chibi/term
 	$(MKDIR) $(DESTDIR)$(MODDIR)/scheme/char
 	$(MKDIR) $(DESTDIR)$(MODDIR)/scheme/time
@@ -352,6 +353,7 @@ uninstall:
 	-$(RM) $(DESTDIR)$(BINDIR)/chibi-ffi
 	-$(RM) $(DESTDIR)$(BINDIR)/chibi-doc
 	-$(RM) $(DESTDIR)$(BINDIR)/snow-chibi
+	-$(RM) $(DESTDIR)$(BINDIR)/snow-chibi.scm
 	-$(RM) $(DESTDIR)$(SOLIBDIR)/libchibi-scheme$(SO)
 	-$(RM) $(DESTDIR)$(SOLIBDIR)/libchibi-scheme$(SO_VERSIONED_SUFFIX)
 	-$(RM) $(DESTDIR)$(SOLIBDIR)/libchibi-scheme$(SO_MAJOR_VERSIONED_SUFFIX)

tests/snow/snow-tests.scm

@@ -40,13 +40,13 @@
 ;; run snow-chibi command as a separate process with test defaults
 (define chibi-path "./chibi-scheme")
 (define (snow-command . args)
-  `(,chibi-path -A ,install-libdir "tools/snow-chibi"
+  `("./tools/snow-chibi"
-                --always-no
+    --always-no
-                --implementations "chibi"
+    --implementations "chibi"
-                --chibi-path ,(string-append chibi-path " -A" install-libdir)
+    --chibi-path ,(string-append chibi-path " -A" install-libdir)
-                --install-prefix ,install-prefix
+    --install-prefix ,install-prefix
-                --local-user-repository "tests/snow/repo-cache"
+    --local-user-repository "tests/snow/repo-cache"
-                ,@args))
+    ,@args))
 
 (define-syntax snow
   (syntax-rules ()

tools/snow-chibi

@@ -1,220 +1,13 @@
-#!/usr/bin/env chibi-scheme
+#!/bin/sh
 
-;; This code was written by Alex Shinn in 2013 and placed in the
+CHIBI=${CHIBI:-chibi-scheme}
-;; Public Domain.  All warranties are disclaimed.
+if [ -x ./chibi-scheme ] && ! type $CHIBI 2>/dev/null; then
+    # convenience for running from dev, notable "make test-snow"
+    CHIBI="./chibi-scheme"
+    export LD_LIBRARY_PATH=".:${LD_LIBRARY_PATH}"
+    export DYLD_LIBRARY_PATH=".:${DYLD_LIBRARY_PATH}"
+fi
+SCRIPT_DIR=$(dirname $0)
+SNOW_SCRIPT=${SNOW_SCRIPT:-$SCRIPT_DIR/snow-chibi.scm}
 
-(import (scheme base)
+exec "${CHIBI}" -isnow.img "${SNOW_SCRIPT}" "$@"
-        (scheme process-context)
-        (chibi snow commands)
-        (chibi snow interface)
-        (chibi app)
-        (chibi config)
-        (chibi pathname)
-        (chibi process))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; (define repo-spec
-;;   '((repository
-;;      (conf
-;;       (sibling
-;;        (conf
-;;         (name string)
-;;         (url string)))
-;;       (package
-;;        (conf
-;;         (name (list (or symbol integer)))
-;;         (url string)
-;;         (size integer)
-;;         (checksums (alist symbol string))
-;;         (signature (alist symbol string))
-;;         (library
-;;          (conf
-;;           (name (list (or symbol integer)))
-;;           (path string)
-;;           (depends
-;;            (list (list (or symbol integer string
-;;                            (list (member < > <= >=) string)))))
-;;           (provides (list (list (or symbol string))))
-;;           (platforms (list (or symbol (list symbol))))
-;;           (features (list symbol))
-;;           (authors (list string))
-;;           (maintainers (list string))
-;;           (description string)
-;;           (created string)
-;;           (updated string)
-;;           (version string)
-;;           (licenses
-;;            (list
-;;             (or (member gpl2 gpl3 lgpl mit bsd artistic apache public-domain)
-;;                 (list 'license
-;;                       (conf (name string)
-;;                             (url string)
-;;                             (checksums (alist symbol string)))))))))))))))
-
-(define conf-spec
-  ;; name type aliases doc
-  '((verbose? boolean (#\v "verbose") "print additional informative messages")
-    (always-yes? boolean (#\y "always-yes") "answer all questions with yes")
-    (always-no? boolean (#\n "always-no") "answer all questions with no")
-    (require-signature? boolean ("require-sig" "require-signature")
-                        "require signature on installation")
-    (ignore-signature? boolean ("ignore-sig" "ignore-signature")
-                       "don't verify package signatures")
-    (ignore-digest? boolean ("ignore-digest") "don't verify package checksums")
-    (skip-digest? boolean ("skip-digest") "don't provide digests without rsa")
-    (skip-version-checks? boolean ("skip-version-checks")
-                          "don't verify implementation versions")
-    (sign-uploads? boolean ("sign-uploads") "sign with the rsa key if present")
-    (host string "base uri of snow repository")
-    (repository-uri (list string) ("repo") "uris or paths of snow repositories")
-    (local-root-repository dirname "repository cache dir for root")
-    (local-user-repository dirname "repository cache dir for non-root users")
-    (update-strategy symbol
-                     "when to refresh repo: always, never, cache or confirm")
-    (install-prefix string "prefix directory for installation")
-    (install-source-dir dirname "directory to install library source in")
-    (install-library-dir dirname "directory to install shared libraries in")
-    (install-binary-dir dirname "directory to install programs in")
-    (install-data-dir dirname "directory to install data files in")
-    (library-extension string "the extension to use for library files")
-    (library-separator string "the separator to use for library components")
-    (library-path (list string) "the path to search for local libraries")
-    (installer symbol "name of installer to use")
-    (builder symbol "name of builder to use")
-    (program-builder symbol "name of program builder to use")
-    (implementations (list symbol) ("impls") "impls to install for, or 'all'")
-    (program-implementation symbol "impl to install programs for")
-    (chibi-path filename "path to chibi-scheme executable")
-    (cc string "path to c compiler")
-    (cflags string "flags for c compiler")
-    (use-curl? boolean ("use-curl") "use curl for file uploads")
-    (sexp? boolean ("sexp") "output information in sexp format")
-    ))
-
-(define (conf-default-path name)
-  (or (get-environment-variable "SNOW_CHIBI_CONFIG")
-      (make-path (or (get-environment-variable "HOME") ".")
-                 (string-append "." name)
-                 "config.scm")))
-
-(define search-spec '())
-(define show-spec '())
-(define install-spec
-  '((skip-tests? boolean ("skip-tests") "don't run tests even if present")
-    (show-tests? boolean ("show-tests") "show test output even on success")
-    (install-tests? boolean ("install-tests") "install test-only libraries")
-    (auto-upgrade-dependencies?
-     boolean ("auto-upgrade-dependencies")
-     "upgrade install dependencies when newer versions are available")
-    (use-sudo? symbol ("use-sudo") "always, never, or as-needed (default)")))
-(define upgrade-spec
-  install-spec)
-(define remove-spec '())
-(define status-spec '())
-(define gen-key-spec
-  '((bits integer)
-    (validity-period string)
-    (name string)
-    (library-prefix (list symbol))
-    (email string)
-    (gen-rsa-key? boolean ("gen-rsa-key"))
-    (gen-key-in-process? boolean ("gen-key-in-process"))))
-(define reg-key-spec
-  '((uri string)
-    (email string)))
-(define sign-spec
-  '((output filename #\o)
-    (digest symbol #\d)
-    (email string)))
-(define verify-spec
-  '())
-(define package-spec
-  '((name sexp)
-    (programs (list existing-filename))
-    (data-files (list sexp))
-    (authors (list string))
-    (maintainers (list string))
-    (recursive? boolean (#\r "recursive") "...")
-    (version string)
-    (version-file existing-filename)
-    (license symbol)
-    (doc existing-filename)
-    (doc-from-scribble boolean)
-    (description string)
-    (test existing-filename)
-    (test-library sexp)
-    (sig-file existing-filename)
-    (output filename)
-    (output-dir dirname)
-    ))
-(define upload-spec
-  `((uri string)
-    ,@package-spec))
-(define index-spec
-  '())
-(define update-spec
-  '())
-(define implementations-spec
-  '())
-
-(define app-spec
-  `(snow
-    "Snow package management"
-    (@ ,conf-spec)
-    (begin: ,(lambda (cfg) (restore-history cfg)))
-    (end: ,(lambda (cfg) (save-history cfg)))
-    (or
-     (search
-      "search for packages"
-      (@ ,search-spec) (,command/search terms ...))
-     (show
-      "show package descriptions"
-      (@ ,show-spec) (,command/show names ...))
-     (install
-      "install packages"
-      (@ ,install-spec) (,command/install names ...))
-     (upgrade
-      "upgrade installed packages"
-      (@ ,upgrade-spec) (,command/upgrade names ...))
-     (remove
-      "remove packages"
-      (@ ,remove-spec) (,command/remove names ...))
-     (status
-      "print package status"
-      (@ ,status-spec) (,command/status names ...))
-     (package
-      "create a package"
-      (@ ,package-spec) (,command/package files ...))
-     (gen-key
-      "create an RSA key pair"
-      (@ ,gen-key-spec) (,command/gen-key))
-     (reg-key
-      "register an RSA key pair"
-      (@ ,reg-key-spec) (,command/reg-key))
-     (sign
-      "sign a package"
-      (@ ,sign-spec) (,command/sign file))
-     (verify
-      "verify a signature"
-      (@ ,verify-spec) (,command/verify file))
-     (upload
-      "upload a package to a remote repository"
-      (@ ,upload-spec) (,command/upload files ...))
-     (index
-      "add a package to a local repository file"
-      (@ ,index-spec) (,command/index files ...))
-     (update
-      "force an update of available package status"
-      (@ ,update-spec) (,command/update))
-     (implementations
-      "print currently available scheme implementations"
-      (@ ,implementations-spec) (,command/implementations))
-     (help
-      "print help"
-      (,app-help-command args ...))
-     )))
-
-(run-application app-spec
-                 (command-line)
-                 (conf-load (conf-default-path "snow")))

tools/snow-chibi.scm

@@ -0,0 +1,220 @@
+#!/usr/bin/env chibi-scheme
+
+;; This code was written by Alex Shinn in 2013 and placed in the
+;; Public Domain.  All warranties are disclaimed.
+
+(import (scheme base)
+        (scheme process-context)
+        (chibi snow commands)
+        (chibi snow interface)
+        (chibi app)
+        (chibi config)
+        (chibi pathname)
+        (chibi process))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; (define repo-spec
+;;   '((repository
+;;      (conf
+;;       (sibling
+;;        (conf
+;;         (name string)
+;;         (url string)))
+;;       (package
+;;        (conf
+;;         (name (list (or symbol integer)))
+;;         (url string)
+;;         (size integer)
+;;         (checksums (alist symbol string))
+;;         (signature (alist symbol string))
+;;         (library
+;;          (conf
+;;           (name (list (or symbol integer)))
+;;           (path string)
+;;           (depends
+;;            (list (list (or symbol integer string
+;;                            (list (member < > <= >=) string)))))
+;;           (provides (list (list (or symbol string))))
+;;           (platforms (list (or symbol (list symbol))))
+;;           (features (list symbol))
+;;           (authors (list string))
+;;           (maintainers (list string))
+;;           (description string)
+;;           (created string)
+;;           (updated string)
+;;           (version string)
+;;           (licenses
+;;            (list
+;;             (or (member gpl2 gpl3 lgpl mit bsd artistic apache public-domain)
+;;                 (list 'license
+;;                       (conf (name string)
+;;                             (url string)
+;;                             (checksums (alist symbol string)))))))))))))))
+
+(define conf-spec
+  ;; name type aliases doc
+  '((verbose? boolean (#\v "verbose") "print additional informative messages")
+    (always-yes? boolean (#\y "always-yes") "answer all questions with yes")
+    (always-no? boolean (#\n "always-no") "answer all questions with no")
+    (require-signature? boolean ("require-sig" "require-signature")
+                        "require signature on installation")
+    (ignore-signature? boolean ("ignore-sig" "ignore-signature")
+                       "don't verify package signatures")
+    (ignore-digest? boolean ("ignore-digest") "don't verify package checksums")
+    (skip-digest? boolean ("skip-digest") "don't provide digests without rsa")
+    (skip-version-checks? boolean ("skip-version-checks")
+                          "don't verify implementation versions")
+    (sign-uploads? boolean ("sign-uploads") "sign with the rsa key if present")
+    (host string "base uri of snow repository")
+    (repository-uri (list string) ("repo") "uris or paths of snow repositories")
+    (local-root-repository dirname "repository cache dir for root")
+    (local-user-repository dirname "repository cache dir for non-root users")
+    (update-strategy symbol
+                     "when to refresh repo: always, never, cache or confirm")
+    (install-prefix string "prefix directory for installation")
+    (install-source-dir dirname "directory to install library source in")
+    (install-library-dir dirname "directory to install shared libraries in")
+    (install-binary-dir dirname "directory to install programs in")
+    (install-data-dir dirname "directory to install data files in")
+    (library-extension string "the extension to use for library files")
+    (library-separator string "the separator to use for library components")
+    (library-path (list string) "the path to search for local libraries")
+    (installer symbol "name of installer to use")
+    (builder symbol "name of builder to use")
+    (program-builder symbol "name of program builder to use")
+    (implementations (list symbol) ("impls") "impls to install for, or 'all'")
+    (program-implementation symbol "impl to install programs for")
+    (chibi-path filename "path to chibi-scheme executable")
+    (cc string "path to c compiler")
+    (cflags string "flags for c compiler")
+    (use-curl? boolean ("use-curl") "use curl for file uploads")
+    (sexp? boolean ("sexp") "output information in sexp format")
+    ))
+
+(define (conf-default-path name)
+  (or (get-environment-variable "SNOW_CHIBI_CONFIG")
+      (make-path (or (get-environment-variable "HOME") ".")
+                 (string-append "." name)
+                 "config.scm")))
+
+(define search-spec '())
+(define show-spec '())
+(define install-spec
+  '((skip-tests? boolean ("skip-tests") "don't run tests even if present")
+    (show-tests? boolean ("show-tests") "show test output even on success")
+    (install-tests? boolean ("install-tests") "install test-only libraries")
+    (auto-upgrade-dependencies?
+     boolean ("auto-upgrade-dependencies")
+     "upgrade install dependencies when newer versions are available")
+    (use-sudo? symbol ("use-sudo") "always, never, or as-needed (default)")))
+(define upgrade-spec
+  install-spec)
+(define remove-spec '())
+(define status-spec '())
+(define gen-key-spec
+  '((bits integer)
+    (validity-period string)
+    (name string)
+    (library-prefix (list symbol))
+    (email string)
+    (gen-rsa-key? boolean ("gen-rsa-key"))
+    (gen-key-in-process? boolean ("gen-key-in-process"))))
+(define reg-key-spec
+  '((uri string)
+    (email string)))
+(define sign-spec
+  '((output filename #\o)
+    (digest symbol #\d)
+    (email string)))
+(define verify-spec
+  '())
+(define package-spec
+  '((name sexp)
+    (programs (list existing-filename))
+    (data-files (list sexp))
+    (authors (list string))
+    (maintainers (list string))
+    (recursive? boolean (#\r "recursive") "...")
+    (version string)
+    (version-file existing-filename)
+    (license symbol)
+    (doc existing-filename)
+    (doc-from-scribble boolean)
+    (description string)
+    (test existing-filename)
+    (test-library sexp)
+    (sig-file existing-filename)
+    (output filename)
+    (output-dir dirname)
+    ))
+(define upload-spec
+  `((uri string)
+    ,@package-spec))
+(define index-spec
+  '())
+(define update-spec
+  '())
+(define implementations-spec
+  '())
+
+(define app-spec
+  `(snow
+    "Snow package management"
+    (@ ,conf-spec)
+    (begin: ,(lambda (cfg) (restore-history cfg)))
+    (end: ,(lambda (cfg) (save-history cfg)))
+    (or
+     (search
+      "search for packages"
+      (@ ,search-spec) (,command/search terms ...))
+     (show
+      "show package descriptions"
+      (@ ,show-spec) (,command/show names ...))
+     (install
+      "install packages"
+      (@ ,install-spec) (,command/install names ...))
+     (upgrade
+      "upgrade installed packages"
+      (@ ,upgrade-spec) (,command/upgrade names ...))
+     (remove
+      "remove packages"
+      (@ ,remove-spec) (,command/remove names ...))
+     (status
+      "print package status"
+      (@ ,status-spec) (,command/status names ...))
+     (package
+      "create a package"
+      (@ ,package-spec) (,command/package files ...))
+     (gen-key
+      "create an RSA key pair"
+      (@ ,gen-key-spec) (,command/gen-key))
+     (reg-key
+      "register an RSA key pair"
+      (@ ,reg-key-spec) (,command/reg-key))
+     (sign
+      "sign a package"
+      (@ ,sign-spec) (,command/sign file))
+     (verify
+      "verify a signature"
+      (@ ,verify-spec) (,command/verify file))
+     (upload
+      "upload a package to a remote repository"
+      (@ ,upload-spec) (,command/upload files ...))
+     (index
+      "add a package to a local repository file"
+      (@ ,index-spec) (,command/index files ...))
+     (update
+      "force an update of available package status"
+      (@ ,update-spec) (,command/update))
+     (implementations
+      "print currently available scheme implementations"
+      (@ ,implementations-spec) (,command/implementations))
+     (help
+      "print help"
+      (,app-help-command args ...))
+     )))
+
+(run-application app-spec
+                 (command-line)
+                 (conf-load (conf-default-path "snow")))