From 170608b72c0751e4c0f632ac351fcd465c908b94 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 27 Feb 2017 22:13:19 -0800
Subject: [PATCH] Implement keyword-option-parser.

---
 src/runtime/list.scm    | 19 +++++++++++++++++++
 src/runtime/runtime.pkg |  1 +
 2 files changed, 20 insertions(+)

diff --git a/src/runtime/list.scm b/src/runtime/list.scm
index 32fcdd3e6..8a8c75b71 100644
--- 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))))
 
 ;;;; Last pair
 
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 64c2daf38..3f100ce9c 100644
--- 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
-- 
2.25.1