Implement keyword-option-parser.

diff --git a/src/runtime/list.scm b/src/runtime/list.scm
index 32fcdd3e65d0feb07cbc7900c622cf453927594d..8a8c75b71b50a7a0fb86e6bc21301dc682d085bc 100644 (file)
--- a/src/runtime/list.scm
+++ b/src/runtime/list.scm
@@ -1428,6 +1428,25 @@ USA.
              (cons (cdr (car alist))
                    (loop (cdr alist))))
        '())))
+
+(define (keyword-option-parser keyword-option-specs)
+  (guarantee-list-of keyword-option-spec? keyword-option-specs
+                    'keyword-option-parser)
+  (lambda (options caller)
+    (guarantee keyword-list? options caller)
+    (apply values
+          (map (lambda (spec)
+                 (let ((value (get-keyword-value options (car spec))))
+                   (if (default-object? value)
+                       (caddr spec)
+                       (guarantee (cadr spec) value caller))))
+               keyword-option-specs))))
+
+(define (keyword-option-spec? object)
+  (and (list? object)
+       (fix:= 3 (length object))
+       (interned-symbol? (car object))
+       (unary-procedure? (cadr object))))
 \f
 ;;;; Last pair
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 64c2daf381dbb686241ac0a07a3566f63da79d15..3f100ce9ccfba54f4fcba2fc9c9785380ae83c79 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2995,6 +2995,7 @@ USA.
          keep-matching-items!
          keyword-list->alist
          keyword-list?
+         keyword-option-parser
          last                          ;SRFI-1
          last-pair
          length