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

Parsing non-string values from options.

Browse source
This commit is contained in:
Alex Shinn 2014-05-14 23:52:29 +09:00
parent c8e1f4c18c
commit 52be1ce950
1 changed files with 21 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
lib/chibi/app.scm
View file

@ -5,6 +5,20 @@
;;> Parses command-line options into a config object. ;;> Parses command-line options into a config object.
(define (parse-option prefix conf-spec args fail) (define (parse-option prefix conf-spec args fail)
(define (parse-value type str)
(cond
((not (string? str))
str)
((and (pair? type) (eq? 'list (car type)))
(map (lambda (x) (parse-value (cadr type) x))
(string-split str #\,)))
(else
(case type
((boolean) (not (member str '("#f" "#false" "#F" "#FALSE"))))
((number) (string->number str))
((symbol) (string->symbol str))
((char) (string-ref str 0))
(else str)))))
(define (lookup-conf-spec conf-spec syms strs) (define (lookup-conf-spec conf-spec syms strs)
(let ((sym (car syms)) (let ((sym (car syms))
(str (car strs))) (str (car strs)))
@ -55,12 +69,13 @@
((null? args) ((null? args)
(error "missing argument to option " str)) (error "missing argument to option " str))
(else (else
(cons (cons (append prefix syms) (car args)) (cdr args)))))) (cons (cons (append prefix syms) (parse-value (cadr spec) (car args)))
(cdr args))))))
(define (parse-long-option str args) (define (parse-long-option str args)
(let* ((str+val (string-split str #\= 2)) (let* ((str+val (string-split str #\= 2))
(str (car str+val)) (str (car str+val))
(args (if (pair? (cdr str+val)) (cons (cadr str+val) args) args))) (args2 (if (pair? (cdr str+val)) (cons (cadr str+val) args) args)))
(or (parse-conf-spec str args) (or (parse-conf-spec str args2)
(and (string-prefix? "no-" str) (and (string-prefix? "no-" str)
(let ((res (parse-long-option (substring str 3) args))) (let ((res (parse-long-option (substring str 3) args)))
(cond (cond
@ -88,7 +103,9 @@
args args
(cons (string-append "-" (substring str 1)) args)))) (cons (string-append "-" (substring str 1)) args))))
((> (string-length str) 1) ((> (string-length str) 1)
(cons (cons (append prefix (list (car x))) (substring str 1)) args)) (cons (cons (append prefix (list (car x)))
(parse-value (cadr x) (substring str 1)))
args))
((null? args) ((null? args)
(error "missing argument to option " x)) (error "missing argument to option " x))
(else (else