From 5e1103821a566e55c848c8fa323d07801cce6ab7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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 34a5e6c971..2814247a68 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 611867ca09..a662c9a8d3 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))