mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-31 01:10:24 +02:00
Code Activity

getopt-long cleanup

Browse source 
* module/ice-9/getopt-long.scm (process-options): Use more internal
  definitions instead of let-bound functions to decrease the nesting
  depth.
This commit is contained in:
Andy Wingo 2011-02-10 11:31:30 +01:00
parent 8b9b0af445
commit cafb15e96e
1 changed files with 58 additions and 71 deletions
Download patch file Download diff file Expand all files Collapse all files

37
module/ice-9/getopt-long.scm
View file

@ -256,8 +256,8 @@
spec)) spec))
(remove-if-not option-spec->single-char specs)))) (remove-if-not option-spec->single-char specs))))
(let loop ((argument-ls argument-ls) (found '()) (etc '())) (let loop ((argument-ls argument-ls) (found '()) (etc '()))
(let ((eat! (lambda (spec ls) (define (eat! spec ls)
(let ((val!loop (lambda (val n-ls n-found n-etc) (define (val!loop val n-ls n-found n-etc)
(set-option-spec-value! (set-option-spec-value!
spec spec
;; handle multiple occurrances ;; handle multiple occurrances
@ -266,37 +266,24 @@
((if (list? cur) cons list) ((if (list? cur) cons list)
val cur))) val cur)))
(else val))) (else val)))
(loop n-ls n-found n-etc))) (loop n-ls n-found n-etc))
(ERR:no-arg (lambda () (define (ERR:no-arg)
(error (string-append (error "option must be specified with argument:"
"option must be specified" (option-spec->name spec)))
" with argument:")
(option-spec->name spec)))))
(cond (cond
((eq? 'optional (option-spec->value-policy spec)) ((eq? 'optional (option-spec->value-policy spec))
(if (or (null? (cdr ls)) (if (or (null? (cdr ls))
(looks-like-an-option (cadr ls))) (looks-like-an-option (cadr ls)))
(val!loop #t (val!loop #t (cdr ls) (cons spec found) etc)
(cdr ls) (val!loop (cadr ls) (cddr ls) (cons spec found) etc)))
(cons spec found)
etc)
(val!loop (cadr ls)
(cddr ls)
(cons spec found)
etc)))
((eq? #t (option-spec->value-policy spec)) ((eq? #t (option-spec->value-policy spec))
(if (or (null? (cdr ls)) (if (or (null? (cdr ls))
(looks-like-an-option (cadr ls))) (looks-like-an-option (cadr ls)))
(ERR:no-arg) (ERR:no-arg)
(val!loop (cadr ls) (val!loop (cadr ls) (cddr ls) (cons spec found) etc)))
(cddr ls)
(cons spec found)
etc)))
(else (else
(val!loop #t (val!loop #t (cdr ls) (cons spec found) etc))))
(cdr ls)
(cons spec found)
etc)))))))
(if (null? argument-ls) (if (null? argument-ls)
(cons found (reverse etc)) ;;; retval (cons found (reverse etc)) ;;; retval
(cond ((regexp-exec short-opt-rx (car argument-ls)) (cond ((regexp-exec short-opt-rx (car argument-ls))
@ -326,7 +313,7 @@
(else (else
(loop (cdr argument-ls) (loop (cdr argument-ls)
found found
(cons (car argument-ls) etc))))))))) (cons (car argument-ls) etc))))))))
(define (getopt-long program-arguments option-desc-list) (define (getopt-long program-arguments option-desc-list)
"Process options, handling both long and short options, similar to "Process options, handling both long and short options, similar to