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

Fixing (chibi app) option abbrevs.

Browse source
This commit is contained in:
Alex Shinn 2015-05-08 00:23:43 +09:00
parent c8066e2eb7
commit 8814f5951c
2 changed files with 14 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
lib/chibi/app.scm
View file

@ -197,8 +197,11 @@
(let ((x (car ls))) (let ((x (car ls)))
(cond (cond
((eq? sym (car x)) x) ((eq? sym (car x)) x)
((and (pair? (cddr x)) (member str (car (cddr x)))) x) ((and (pair? (cddr x)) (pair? (third x))
((and (pair? (cddr x)) (member `(not ,str) (car (cddr x)))) (member str (third x)))
x)
((and (pair? (cddr x)) (pair? (third x))
(member `(not ,str) (third x)))
`(not ,x)) `(not ,x))
(else (lp (cdr ls)))))))) (else (lp (cdr ls))))))))
(else (else
@ -207,7 +210,8 @@
(let ((x (car ls))) (let ((x (car ls)))
(cond (cond
((or (eq? sym (car x)) ((or (eq? sym (car x))
(and (pair? (cddr x)) (member str (car (cddr x))))) (and (pair? (cddr x)) (pair? (third x))
(member str (third x))))
(let ((type (cadr x))) (let ((type (cadr x)))
(if (not (and (pair? type) (eq? 'conf (car type)))) (if (not (and (pair? type) (eq? 'conf (car type))))
(error "option prefix not a subconf" sym) (error "option prefix not a subconf" sym)
@ -218,9 +222,10 @@
(and (pair? ls) (and (pair? ls)
(let ((x (car ls))) (let ((x (car ls)))
(cond (cond
((and (pair? (cddr x)) (memv ch (car (cddr x)))) ((and (pair? (cddr x)) (pair? (third x)) (memv ch (third x)))
x) x)
((and (pair? (cddr x)) (member `(not ,ch) (car (cddr x)))) ((and (pair? (cddr x)) (pair? (third x))
(member `(not ,ch) (third x)))
`(not ,x)) `(not ,x))
(else (lp (cdr ls)))))))) (else (lp (cdr ls))))))))
(define (parse-long-option str args fail) (define (parse-long-option str args fail)
@ -256,7 +261,8 @@
(let ((val+err (parse-value (cadr spec) (car args)))) (let ((val+err (parse-value (cadr spec) (car args))))
(if (cadr val+err) (if (cadr val+err)
(fail prefix conf-spec (car fail-args) fail-args (cadr val+err)) (fail prefix conf-spec (car fail-args) fail-args (cadr val+err))
(cons (cons (append prefix syms) (car val+err)) (cons (cons (append prefix (drop-right syms 1) (list (car spec)))
(car val+err))
(cdr args)))))))) (cdr args))))))))
(define (parse-short-option str args fail) (define (parse-short-option str args fail)
(let* ((ch (string-ref str 0)) (let* ((ch (string-ref str 0))

4
tools/snow-chibi
View file

@ -67,7 +67,7 @@
"don't verify implementation versions") "don't verify implementation versions")
(sign-uploads? boolean ("sign-uploads") "sign with the rsa key if present") (sign-uploads? boolean ("sign-uploads") "sign with the rsa key if present")
(host string "base uri of snow repository") (host string "base uri of snow repository")
(repository-uri (list string) "uris or paths of snow repositories") (repository-uri (list string) ("repo") "uris or paths of snow repositories")
(local-root-repository dirname "repository cache dir for root") (local-root-repository dirname "repository cache dir for root")
(local-user-repository dirname "repository cache dir for non-root users") (local-user-repository dirname "repository cache dir for non-root users")
(update-strategy symbol (update-strategy symbol
@ -83,7 +83,7 @@
(installer symbol "name of installer to use") (installer symbol "name of installer to use")
(builder symbol "name of builder to use") (builder symbol "name of builder to use")
(program-builder symbol "name of program builder to use") (program-builder symbol "name of program builder to use")
(implementations (list symbol) "impls to install for, or 'all'") (implementations (list symbol) ("impls") "impls to install for, or 'all'")
(program-implementation symbol "impl to install programs for") (program-implementation symbol "impl to install programs for")
(chibi-path filename "path to chibi-scheme executable") (chibi-path filename "path to chibi-scheme executable")
(cc string "path to c compiler") (cc string "path to c compiler")