mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 05:48:07 -05:00
utils: Add 'strip-keyword-arguments'.
* guix/utils.scm (strip-keyword-arguments): New procedure. * tests/utils.scm ("strip-keyword-arguments"): New test.
This commit is contained in:
parent
b72a312c30
commit
5e1103821a
2 changed files with 22 additions and 0 deletions
|
@ -48,6 +48,7 @@ (define-module (guix utils)
|
||||||
compile-time-value
|
compile-time-value
|
||||||
fcntl-flock
|
fcntl-flock
|
||||||
memoize
|
memoize
|
||||||
|
strip-keyword-arguments
|
||||||
default-keyword-arguments
|
default-keyword-arguments
|
||||||
substitute-keyword-arguments
|
substitute-keyword-arguments
|
||||||
|
|
||||||
|
@ -424,6 +425,21 @@ (define (memoize proc)
|
||||||
(hash-set! cache args results)
|
(hash-set! cache args results)
|
||||||
(apply values results)))))))
|
(apply values results)))))))
|
||||||
|
|
||||||
|
(define (strip-keyword-arguments keywords args)
|
||||||
|
"Remove all of the keyword arguments listed in KEYWORDS from ARGS."
|
||||||
|
(let loop ((args args)
|
||||||
|
(result '()))
|
||||||
|
(match args
|
||||||
|
(()
|
||||||
|
(reverse result))
|
||||||
|
(((? keyword? kw) arg . rest)
|
||||||
|
(loop rest
|
||||||
|
(if (memq kw keywords)
|
||||||
|
result
|
||||||
|
(cons* arg kw result))))
|
||||||
|
((head . tail)
|
||||||
|
(loop tail (cons head result))))))
|
||||||
|
|
||||||
(define (default-keyword-arguments args defaults)
|
(define (default-keyword-arguments args defaults)
|
||||||
"Return ARGS augmented with any keyword/value from DEFAULTS for
|
"Return ARGS augmented with any keyword/value from DEFAULTS for
|
||||||
keywords not already present in ARGS."
|
keywords not already present in ARGS."
|
||||||
|
|
|
@ -120,6 +120,12 @@ (define temp-file
|
||||||
'(0 1 2 3)))
|
'(0 1 2 3)))
|
||||||
list))
|
list))
|
||||||
|
|
||||||
|
(test-equal "strip-keyword-arguments"
|
||||||
|
'(a #:b b #:c c)
|
||||||
|
(strip-keyword-arguments '(#:foo #:bar #:baz)
|
||||||
|
'(a #:foo 42 #:b b #:baz 3
|
||||||
|
#:c c #:bar 4)))
|
||||||
|
|
||||||
(let* ((tree (alist->vhash
|
(let* ((tree (alist->vhash
|
||||||
'((0 2 3) (1 3 4) (2) (3 5 6) (4 6) (5) (6))
|
'((0 2 3) (1 3 4) (2) (3 5 6) (4 6) (5) (6))
|
||||||
hashq))
|
hashq))
|
||||||
|
|
Loading…
Reference in a new issue