From 8d472fb85b0e9ffc60096665b13c70c9429a807a Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 17 Jan 2017 13:16:18 -0800
Subject: [PATCH] Implement get-keyword-values.
---
src/runtime/list.scm | 19 ++++++++++++++++++-
src/runtime/runtime.pkg | 1 +
2 files changed, 19 insertions(+), 1 deletion(-)
diff --git a/src/runtime/list.scm b/src/runtime/list.scm
index 7fa192d84..898609dce 100644
--- 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 c954da260..9f5c1f712 100644
--- 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
--
2.25.1