diff options
Diffstat (limited to 'csc/flag.csc')
| -rw-r--r-- | csc/flag.csc | 32 |
1 files changed, 22 insertions, 10 deletions
diff --git a/csc/flag.csc b/csc/flag.csc index c328dcf..c0a28a8 100644 --- a/csc/flag.csc +++ b/csc/flag.csc @@ -38,14 +38,26 @@ (define *parsers* (make-map compare-strings)) + ; I'm working around a Guile bug, which wrongly concludes + ; that *parsers* is immutable. + (set! *parsers* *parsers*) + + + (define-record-type <flag> + (make-flag bool? setter) + flag? + (bool? flag-bool?) + (setter flag-setter)) (define-syntax define-flag (syntax-rules () ((define-flag name flag type default) - (define name (begin - (set! *parsers* (insert *parsers* flag (lambda (x) (set! name (type x))))) - default))))) + (begin + (define name default) + (set! *parsers* (insert *parsers* flag + (make-flag (eq? type bool-flag) + (lambda (x) (set! name (type x)))))))))) (define *args* '()) @@ -85,13 +97,13 @@ (set! name a) b) (_ #f))) - (define parser (guard (e ((key-not-found-error? e) - (raise (make-parse-error "flag provided but not defined" s)))) - (lookup *parsers* name))) - (if (eq? parser bool-flag) ; Special case: doesn't need an arg. + (define flag (guard (e ((key-not-found-error? e) + (raise (make-parse-error "flag provided but not defined" s)))) + (lookup *parsers* name))) + (if (flag-bool? flag) ; Special case: doesn't need an arg. (if value - (parser value) - (parser "true")) + ((flag-setter flag) value) + ((flag-setter flag) "true")) (begin ; It must have a value, which might be the next argument. (when (and (not value) @@ -101,7 +113,7 @@ (set! args (cdr args))) (unless value (raise (make-parse-error "flag needs an argument" s))) - (parser value))) + ((flag-setter flag) value))) #t))) (loop while (parse-one)) (set! *args* args)))) |