Support n-ary keyword arguments.

* ccwl/utils.scm: New file.

1 files changed, 41 insertions, 0 deletions

diff --git a/ccwl/utils.scm b/ccwl/utils.scm
new file mode 100644
index 0000000..90d6f0c
--- /dev/null
+++ b/ccwl/utils.scm
@@ -0,0 +1,41 @@
+(define-module (ccwl utils)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-71)
+  #:use-module (ice-9 match)
+  #:export (group-arguments))
+
+(define (group-keyword-arguments args unary-keywords)
+  "Group ARGS, a list of keyword arguments of arbitrary arity. Return
+a list of unary keyword arguments. n-ary arguments are grouped
+together into lists. Keywords that are to be treated as having unit
+arity are listed in UNARY-KEYWORDS."
+  (match args
+    (((? (lambda (keyword)
+           (and (keyword? keyword)
+                (not (member keyword unary-keywords))))
+         this-keyword)
+      tail ...)
+     (let ((this-keyword-args tail (break keyword? tail)))
+       (cons* this-keyword
+              (apply list this-keyword-args)
+              (group-keyword-arguments tail unary-keywords))))
+    (((? (lambda (keyword)
+           (and (keyword? keyword)
+                (member keyword unary-keywords)))
+         this-keyword)
+      this-keyword-arg tail ...)
+     (cons* this-keyword this-keyword-arg
+            (group-keyword-arguments tail unary-keywords)))
+    ((non-keyword _ ...)
+     (error "Invalid sequence of keywords arguments" args))
+    (() '())))
+
+(define* (group-arguments args #:optional (unary-keywords '()))
+  "Group ARGS, a list of positional arguments followed by keyword
+arguments of arbitrary arity. Return a list of positional arguments
+followed by unary keyword arguments. n-ary arguments are grouped
+together into lists. Keywords that are to be treated as having unit
+arity are listed in UNARY-KEYWORDS."
+  (let ((positional-arguments keyword-arguments (break keyword? args)))
+    (append positional-arguments
+            (group-keyword-arguments keyword-arguments unary-keywords))))