From 5e1103821a566e55c848c8fa323d07801cce6ab7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 1 Oct 2014 10:19:14 +0200
Subject: [PATCH] utils: Add 'strip-keyword-arguments'.
* guix/utils.scm (strip-keyword-arguments): New procedure.
* tests/utils.scm ("strip-keyword-arguments"): New test.
---
guix/utils.scm | 16 ++++++++++++++++
tests/utils.scm | 6 ++++++
2 files changed, 22 insertions(+)
diff --git a/guix/utils.scm b/guix/utils.scm
index 34a5e6c9714..2814247a689 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -48,6 +48,7 @@ (define-module (guix utils)
compile-time-value
fcntl-flock
memoize
+ strip-keyword-arguments
default-keyword-arguments
substitute-keyword-arguments
@@ -424,6 +425,21 @@ (define (memoize proc)
(hash-set! cache args 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)
"Return ARGS augmented with any keyword/value from DEFAULTS for
keywords not already present in ARGS."
diff --git a/tests/utils.scm b/tests/utils.scm
index 611867ca09f..a662c9a8d38 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -120,6 +120,12 @@ (define temp-file
'(0 1 2 3)))
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
'((0 2 3) (1 3 4) (2) (3 5 6) (4 6) (5) (6))
hashq))
--
GitLab