Implement get-keyword-values.

diff --git a/src/runtime/list.scm b/src/runtime/list.scm
index 7fa192d84e3691dfe36a4a9719248f98493210b6..898609dce4feec49e8de44d68957c97cb9ae362b 100644 (file)
--- a/src/runtime/list.scm
+++ b/src/runtime/list.scm
@@ -1383,7 +1383,7 @@ USA.
 (define-guarantee unique-keyword-list "unique keyword list")
 
 (define (get-keyword-value klist key #!optional default-value)
-  (let ((lose (lambda () (error:not-keyword-list klist 'GET-KEYWORD-VALUE))))
+  (let ((lose (lambda () (error:not-a keyword-list? klist 'get-keyword-value))))
     (let loop ((klist klist))
       (if (pair? klist)
          (begin
@@ -1397,6 +1397,23 @@ USA.
                (lose))
            default-value)))))
 
+(define (get-keyword-values klist key)
+  (let ((lose
+        (lambda () (error:not-a keyword-list? klist 'get-keyword-values))))
+    (let loop ((klist klist) (values values))
+      (if (pair? klist)
+         (begin
+           (if (not (pair? (cdr klist)))
+               (lose))
+           (loop (cdr (cdr list))
+                 (if (eq? (car klist) key)
+                     (cons (car (cdr klist)) values)
+                     values)))
+         (begin
+           (if (not (null? klist))
+               (lose))
+           (reverse! values))))))
+
 (define (keyword-list->alist klist)
   (let loop ((klist klist))
     (if (pair? klist)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index c954da260d98d84a22a64b721ee3f92b0d294d32..9f5c1f71220401172c859af1c7e02bffc285f1dc 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2891,6 +2891,7 @@ USA.
          fourth
          general-car-cdr
          get-keyword-value
+         get-keyword-values
          guarantee-list->length
          guarantee-list-of-type
          guarantee-list-of-type->length