From 13f607c175b7df585a248145dfd7426334630ee7 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Thu, 10 Feb 2011 11:40:24 +0100
Subject: [PATCH] getopt-long cleanups

* module/ice-9/getopt-long.scm (process-options): Use `match' in the
  loop.  Clean up `eat' to not take the option being processed.
---
 module/ice-9/getopt-long.scm | 74 ++++++++++++++++++------------------
 1 file changed, 36 insertions(+), 38 deletions(-)

diff --git a/module/ice-9/getopt-long.scm b/module/ice-9/getopt-long.scm
index 18cf3b689..c16efdd63 100644
--- a/module/ice-9/getopt-long.scm
+++ b/module/ice-9/getopt-long.scm
@@ -272,48 +272,46 @@
                  (option-spec->name spec)))
         (cond
          ((eq? 'optional (option-spec->value-policy spec))
-          (if (or (null? (cdr ls))
-                  (looks-like-an-option (cadr ls)))
-              (val!loop #t (cdr ls) (cons spec found) etc)
-              (val!loop (cadr ls) (cddr ls) (cons spec found) etc)))
+          (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)))
          ((eq? #t (option-spec->value-policy spec))
-          (if (or (null? (cdr ls))
-                  (looks-like-an-option (cadr ls)))
+          (if (or (null? ls)
+                  (looks-like-an-option (car ls)))
               (ERR:no-arg)
-              (val!loop (cadr ls) (cddr ls) (cons spec found) etc)))
+              (val!loop (car ls) (cdr ls) (cons spec found) etc)))
          (else
-          (val!loop #t (cdr ls) (cons spec found) etc))))
+          (val!loop #t ls (cons spec found) etc))))
       
-      (if (null? argument-ls)
-          (cons found (reverse etc)) ;;; retval
-          (cond ((regexp-exec short-opt-rx (car argument-ls))
-                 => (lambda (match)
-                      (let* ((c (match:substring match 1))
-                             (spec (or (assoc-ref sc-idx c)
-                                       (error "no such option:" c))))
-                        (eat! spec argument-ls))))
-                ((regexp-exec long-opt-no-value-rx (car argument-ls))
-                 => (lambda (match)
-                      (let* ((opt (match:substring match 1))
-                             (spec (or (assoc-ref idx opt)
-                                       (error "no such option:" opt))))
-                        (eat! spec argument-ls))))
-                ((regexp-exec long-opt-with-value-rx (car argument-ls))
-                 => (lambda (match)
-                      (let* ((opt (match:substring match 1))
-                             (spec (or (assoc-ref idx opt)
-                                       (error "no such option:" opt))))
-                        (if (option-spec->value-policy spec)
-                            (eat! spec (append
-                                        (list 'ignored
-                                              (match:substring match 2))
-                                        (cdr argument-ls)))
-                            (error "option does not support argument:"
-                                   opt)))))
-                (else
-                 (loop (cdr argument-ls)
-                       found
-                       (cons (car argument-ls) etc))))))))
+      (match argument-ls
+        (()
+         (cons found (reverse etc)))
+        ((opt . rest)
+         (cond
+          ((regexp-exec short-opt-rx opt)
+           => (lambda (match)
+                (let* ((c (match:substring match 1))
+                       (spec (or (assoc-ref sc-idx c)
+                                 (error "no such option:" c))))
+                  (eat! spec rest))))
+          ((regexp-exec long-opt-no-value-rx opt)
+           => (lambda (match)
+                (let* ((opt (match:substring match 1))
+                       (spec (or (assoc-ref idx opt)
+                                 (error "no such option:" opt))))
+                  (eat! spec rest))))
+          ((regexp-exec long-opt-with-value-rx opt)
+           => (lambda (match)
+                (let* ((opt (match:substring match 1))
+                       (spec (or (assoc-ref idx opt)
+                                 (error "no such option:" opt))))
+                  (if (option-spec->value-policy spec)
+                      (eat! spec (cons (match:substring match 2) rest))
+                      (error "option does not support argument:"
+                             opt)))))
+          (else
+           (loop rest found (cons opt etc)))))))))
 
 (define (getopt-long program-arguments option-desc-list)
   "Process options, handling both long and short options, similar to