[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH 2/5] Simplify getopt-long handling of option values, esp with mul
From: |
Neil Jerram |
Subject: |
[PATCH 2/5] Simplify getopt-long handling of option values, esp with multiple occurrences |
Date: |
Sun, 8 May 2011 23:18:14 +0100 |
Basically, accumulate values in the `process-options' loop variables,
instead of using set-option-spec-value!
* module/ice-9/getopt-long.scm (option-spec): Delete the `value' slot.
(process-options): Delete `val!loop' and just use `loop' everywhere
instead. When adding an option spec to `found', add the
corresponding value too; hence `found' becomes an alist, where it
was previously a list of specs.
(getopt-long): Use assq-ref to get values out of `found'. Remove
unhittable error condition for detecting an option that requires an
explicit value, where a value wasn't supplied. This condition is
actually caught and handled in `process-options'. Rewrite the end
of the procedure much more simply.
---
module/ice-9/getopt-long.scm | 52 +++++++++---------------------------------
1 files changed, 11 insertions(+), 41 deletions(-)
diff --git a/module/ice-9/getopt-long.scm b/module/ice-9/getopt-long.scm
index c3939dc..5c73f9a 100644
--- a/module/ice-9/getopt-long.scm
+++ b/module/ice-9/getopt-long.scm
@@ -179,8 +179,6 @@
option-spec?
(name
option-spec->name set-option-spec-name!)
- (value
- option-spec->value set-option-spec-value!)
(required?
option-spec->required? set-option-spec-required?!)
(option-spec->single-char
@@ -268,30 +266,20 @@
(remove-if-not option-spec->single-char specs))))
(let loop ((argument-ls argument-ls) (found '()) (etc '()))
(define (eat! spec ls)
- (define (val!loop val n-ls n-found n-etc)
- (set-option-spec-value!
- spec
- ;; handle multiple occurrences
- (cond ((option-spec->value spec)
- => (lambda (cur)
- ((if (list? cur) cons list)
- val cur)))
- (else val)))
- (loop n-ls n-found n-etc))
(cond
((eq? 'optional (option-spec->value-policy spec))
(if (or (null? ls)
(looks-like-an-option (car ls)))
- (val!loop #t ls (cons spec found) etc)
- (val!loop (car ls) (cdr ls) (cons spec found) etc)))
+ (loop ls (acons spec #t found) etc)
+ (loop (cdr ls) (acons spec (car ls) found) etc)))
((eq? #t (option-spec->value-policy spec))
(if (or (null? ls)
(looks-like-an-option (car ls)))
(fatal-error "option must be specified with argument: --~a"
(option-spec->name spec))
- (val!loop (car ls) (cdr ls) (cons spec found) etc)))
+ (loop (cdr ls) (acons spec (car ls) found) etc)))
(else
- (val!loop #t ls (cons spec found) etc))))
+ (loop ls (acons spec #t found) etc))))
(match argument-ls
(()
@@ -363,37 +351,19 @@ to add a `single-char' clause to the option description."
(rest-ls (append (cdr found/etc) non-split-ls)))
(for-each (lambda (spec)
(let ((name (option-spec->name spec))
- (val (option-spec->value spec)))
+ (val (assq-ref found spec)))
(and (option-spec->required? spec)
- (or (memq spec found)
+ (or val
(fatal-error "option must be specified: --~a"
name)))
- (and (memq spec found)
- (eq? #t (option-spec->value-policy spec))
- (or val
- (fatal-error
- "option must be specified with argument: --~a"
- name)))
(let ((pred (option-spec->predicate spec)))
(and pred (pred name val)))))
specifications)
- (cons (cons '() rest-ls)
- (let ((multi-count (map (lambda (desc)
- (cons (car desc) 0))
- option-desc-list)))
- (map (lambda (spec)
- (let ((name (string->symbol (option-spec->name spec))))
- (cons name
- ;; handle multiple occurrences
- (let ((maybe-ls (option-spec->value spec)))
- (if (list? maybe-ls)
- (let* ((look (assq name multi-count))
- (idx (cdr look))
- (val (list-ref maybe-ls idx)))
- (set-cdr! look (1+ idx)) ; ugh!
- val)
- maybe-ls)))))
- found))))))
+ (for-each (lambda (spec+val)
+ (set-car! spec+val
+ (string->symbol (option-spec->name (car
spec+val)))))
+ found)
+ (cons (cons '() rest-ls) found))))
(define (option-ref options key default)
"Return value in alist OPTIONS using KEY, a symbol; or DEFAULT if not found.
--
1.7.4.1
- [PATCH] Simplifying guile-tools, Neil Jerram, 2011/05/08
- [PATCH 3/5] Handle short option unclumping progressively, instead of all upfront, Neil Jerram, 2011/05/08
- [PATCH 2/5] Simplify getopt-long handling of option values, esp with multiple occurrences,
Neil Jerram <=
- [PATCH 1/5] Fix "occurrances" typos in getopt-long code and test, Neil Jerram, 2011/05/08
- [PATCH 4/5] Implement #:stop-at-first-non-option option for getopt-long, Neil Jerram, 2011/05/08
- [PATCH 5/5] Reveal guile-tools's inner simplicity..., Neil Jerram, 2011/05/08
- Re: [PATCH] Simplifying guile-tools, Neil Jerram, 2011/05/23