blob: 90d6f0c12d4a8c5b3fc66d696e9748845cd2790d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
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))))
|
