mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

match-lambda in getopt-long

Browse source 
* module/ice-9/getopt-long.scm (parse-option-spec): Use match-lambda to
  parse the grammar.
This commit is contained in:
Andy Wingo 2011-02-10 11:19:02 +01:00
parent 23f11f1dfd
commit 887fac4521
1 changed files with 18 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

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

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