From 887fac45215f301e13d7c9521f4ff20ed1db9c81 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Thu, 10 Feb 2011 11:19:02 +0100
Subject: [PATCH] match-lambda in getopt-long

* module/ice-9/getopt-long.scm (parse-option-spec): Use match-lambda to
  parse the grammar.
---
 module/ice-9/getopt-long.scm | 40 ++++++++++++++++--------------------
 1 file changed, 18 insertions(+), 22 deletions(-)

diff --git a/module/ice-9/getopt-long.scm b/module/ice-9/getopt-long.scm
index 98c8accbf..a81d61c96 100644
--- a/module/ice-9/getopt-long.scm
+++ b/module/ice-9/getopt-long.scm
@@ -159,6 +159,7 @@
 (define-module (ice-9 getopt-long)
   #:use-module ((ice-9 common-list) #:select (some remove-if-not))
   #:use-module (srfi srfi-9)
+  #:use-module (ice-9 match)
   #:export (getopt-long option-ref))
 
 (define-record-type option-spec
@@ -183,28 +184,23 @@
 
 (define (parse-option-spec desc)
   (let ((spec (make-option-spec (symbol->string (car desc)))))
-    (for-each (lambda (desc-elem)
-                (let ((given (lambda () (cadr desc-elem))))
-                  (case (car desc-elem)
-                    ((required?)
-                     (set-option-spec-required?! spec (given)))
-                    ((value)
-                     (set-option-spec-value-policy! spec (given)))
-                    ((single-char)
-                     (or (char? (given))
-                         (error "`single-char' value must be a char!"))
-                     (set-option-spec-single-char! spec (given)))
-                    ((predicate)
-                     (set-option-spec-predicate!
-                      spec ((lambda (pred)
-                              (lambda (name val)
-                                (or (not val)
-                                    (pred val)
-                                    (error "option predicate failed:" name))))
-                            (given))))
-                    (else
-                     (error "invalid getopt-long option property:"
-                            (car desc-elem))))))
+    (for-each (match-lambda
+               (('required? val)
+                (set-option-spec-required?! spec val))
+               (('value val)
+                (set-option-spec-value-policy! spec val))
+               (('single-char val)
+                (or (char? val)
+                    (error "`single-char' value must be a char!"))
+                (set-option-spec-single-char! spec val))
+               (('predicate pred)
+                (set-option-spec-predicate!
+                 spec (lambda (name val)
+                        (or (not val)
+                            (pred val)
+                            (error "option predicate failed:" name)))))
+               ((prop val)
+                (error "invalid getopt-long option property:" prop)))
               (cdr desc))
     spec))