From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Neil Jerram Newsgroups: gmane.lisp.guile.devel Subject: [PATCH 2/5] Simplify getopt-long handling of option values, esp with multiple occurrences Date: Sun, 8 May 2011 23:18:14 +0100 Message-ID: <1304893097-10889-3-git-send-email-neil@ossau.uklinux.net> References: <1304893097-10889-1-git-send-email-neil@ossau.uklinux.net> NNTP-Posting-Host: lo.gmane.org X-Trace: dough.gmane.org 1304893189 27069 80.91.229.12 (8 May 2011 22:19:49 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sun, 8 May 2011 22:19:49 +0000 (UTC) Cc: Neil Jerram To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Mon May 09 00:19:45 2011 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([140.186.70.17]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1QJCKE-0003pL-QM for guile-devel@m.gmane.org; Mon, 09 May 2011 00:19:43 +0200 Original-Received: from localhost ([::1]:37252 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QJCKE-0000cW-9p for guile-devel@m.gmane.org; Sun, 08 May 2011 18:19:42 -0400 Original-Received: from eggs.gnu.org ([140.186.70.92]:42006) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QJCKA-0000ZM-5J for guile-devel@gnu.org; Sun, 08 May 2011 18:19:39 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1QJCK9-0002qM-1H for guile-devel@gnu.org; Sun, 08 May 2011 18:19:38 -0400 Original-Received: from mail3.uklinux.net ([80.84.72.33]:52031) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QJCK8-0002qB-M1 for guile-devel@gnu.org; Sun, 08 May 2011 18:19:36 -0400 Original-Received: from arudy (unknown [78.149.196.143]) by mail3.uklinux.net (Postfix) with ESMTP id F422F1F6660 for ; Sun, 8 May 2011 23:18:52 +0100 (BST) Original-Received: from neil-laptop.520b.com (unknown [192.168.11.9]) by arudy (Postfix) with ESMTP id 1170D3803E; Sun, 8 May 2011 23:18:44 +0100 (BST) X-Mailer: git-send-email 1.7.4.1 In-Reply-To: <1304893097-10889-1-git-send-email-neil@ossau.uklinux.net> X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.4-2.6 X-Received-From: 80.84.72.33 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:12466 Archived-At: 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