Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-18 21:29:19 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

default snow-chibi command uses snow.img

Browse source
This commit is contained in:
Alex Shinn 2016-03-13 15:42:47 +09:00
parent 4599766346
commit ec430071eb
4 changed files with 244 additions and 229 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
Makefile
View file

@ -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)

2
tests/snow/snow-tests.scm
View file

@ -40,7 +40,7 @@
;; 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
--implementations "chibi"
--chibi-path ,(string-append chibi-path " -A" install-libdir)

229
tools/snow-chibi
View file

@ -1,220 +1,13 @@
#!/usr/bin/env chibi-scheme
#!/bin/sh
;; This code was written by Alex Shinn in 2013 and placed in the
;; Public Domain. All warranties are disclaimed.
CHIBI=${CHIBI:-chibi-scheme}
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)
(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")))
exec "${CHIBI}" -isnow.img "${SNOW_SCRIPT}" "$@"

220
tools/snow-chibi.scm Executable file
View file

@ -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")))