mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

getopt-long uses srfi-9 records internally

Browse source 
* module/ice-9/getopt-long.scm: #:keywords in the define-module block.
  (option-spec): Define as a srfi-9 record instead of playing macro
  games with boot-9 records.
This commit is contained in:
Andy Wingo 2011-02-10 11:04:31 +01:00
parent 7112a34d56
commit 23f11f1dfd
1 changed files with 22 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,4 +1,4 @@
;;; Copyright (C) 1998, 2001, 2006, 2009 Free Software Foundation, Inc. ;;; Copyright (C) 1998, 2001, 2006, 2009, 2011 Free Software Foundation, Inc.
;;; ;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -157,44 +157,29 @@
;;; Code: ;;; Code:
(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))
:export (getopt-long option-ref)) #:use-module (srfi srfi-9)
#:export (getopt-long option-ref))
(eval-when (eval load compile) (define-record-type option-spec
;; This binding is used both at compile-time and run-time. (%make-option-spec name value required? single-char predicate
(define option-spec-fields '(name value-policy)
value option-spec?
required? (name
single-char option-spec->name set-option-spec-name!)
predicate (value
value-policy))) option-spec->value set-option-spec-value!)
(required?
option-spec->required? set-option-spec-required?!)
(option-spec->single-char
option-spec->single-char set-option-spec-single-char!)
(predicate
option-spec->predicate set-option-spec-predicate!)
(value-policy
option-spec->value-policy set-option-spec-value-policy!))
(define option-spec (make-record-type 'option-spec option-spec-fields)) (define (make-option-spec name)
(define make-option-spec (record-constructor option-spec option-spec-fields)) (%make-option-spec name #f #f #f #f #f))
(eval-when (eval load compile)
;; The following procedures are used only at compile-time when expanding
;; `define-all-option-spec-accessors/modifiers' (see below).
(define (define-one-option-spec-field-accessor field)
`(define ,(symbol-append 'option-spec-> field) ;;; name slib-compat
(record-accessor option-spec ',field)))
(define (define-one-option-spec-field-modifier field)
`(define ,(symbol-append 'set-option-spec- field '!) ;;; name slib-compat
(record-modifier option-spec ',field))))
(defmacro define-all-option-spec-accessors/modifiers ()
`(begin
,@(map define-one-option-spec-field-accessor option-spec-fields)
,@(map define-one-option-spec-field-modifier option-spec-fields)))
(define-all-option-spec-accessors/modifiers)
(define make-option-spec
(let ((ctor (record-constructor option-spec '(name))))
(lambda (name)
(ctor name))))
(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)))))