diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2016-01-06 22:42:09 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2016-01-06 23:08:22 +0100 |
| commit | 6071122b713e8a87158cdd4e913851fab283ead3 (patch) | |
| tree | 68f763513ee1a9ed494f8489ff18cf6169f62640 | |
| parent | 793a43f4099c94a74fa3374b0ed732cb14e120e9 (diff) | |
| download | gnu-guix-6071122b713e8a87158cdd4e913851fab283ead3.tar gnu-guix-6071122b713e8a87158cdd4e913851fab283ead3.tar.gz | |
utils: Add 'ensure-keyword-arguments'.
* guix/utils.scm (delkw, ensure-keyword-arguments): New procedures.
* tests/utils.scm ("ensure-keyword-arguments"): New test.
| -rw-r--r-- | guix/utils.scm | 42 | ||||
| -rw-r--r-- | tests/utils.scm | 10 |
2 files changed, 50 insertions, 2 deletions
diff --git a/guix/utils.scm b/guix/utils.scm index 7b589e68a8..c61f105513 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net> @@ -52,6 +52,7 @@ strip-keyword-arguments default-keyword-arguments substitute-keyword-arguments + ensure-keyword-arguments <location> location @@ -453,6 +454,45 @@ previous value of the keyword argument." (() (reverse before))))))) +(define (delkw kw lst) + "Remove KW and its associated value from LST, a keyword/value list such +as '(#:foo 1 #:bar 2)." + (let loop ((lst lst) + (result '())) + (match lst + (() + (reverse result)) + ((kw? value rest ...) + (if (eq? kw? kw) + (append (reverse result) rest) + (loop rest (cons* value kw? result))))))) + +(define (ensure-keyword-arguments args kw/values) + "Force the keywords arguments KW/VALUES in the keyword argument list ARGS. +For instance: + + (ensure-keyword-arguments '(#:foo 2) '(#:foo 2)) + => (#:foo 2) + + (ensure-keyword-arguments '(#:foo 2) '(#:bar 3)) + => (#:foo 2 #:bar 3) + + (ensure-keyword-arguments '(#:foo 2) '(#:bar 3 #:foo 42)) + => (#:foo 42 #:bar 3) +" + (let loop ((args args) + (kw/values kw/values) + (result '())) + (match args + (() + (append (reverse result) kw/values)) + ((kw value rest ...) + (match (memq kw kw/values) + ((_ value . _) + (loop rest (delkw kw kw/values) (cons* value kw result))) + (#f + (loop rest kw/values (cons* value kw result)))))))) + (define* (nix-system->gnu-triplet #:optional (system (%current-system)) (vendor "unknown")) "Return a guess of the GNU triplet corresponding to Nix system diff --git a/tests/utils.scm b/tests/utils.scm index 04a859fc9d..a05faabc15 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; ;;; This file is part of GNU Guix. @@ -141,6 +141,14 @@ '(a #:foo 42 #:b b #:baz 3 #:c c #:bar 4))) +(test-equal "ensure-keyword-arguments" + '((#:foo 2) + (#:foo 2 #:bar 3) + (#:foo 42 #:bar 3)) + (list (ensure-keyword-arguments '(#:foo 2) '(#:foo 2)) + (ensure-keyword-arguments '(#:foo 2) '(#:bar 3)) + (ensure-keyword-arguments '(#:foo 2) '(#:bar 3 #:foo 42)))) + (let* ((tree (alist->vhash '((0 2 3) (1 3 4) (2) (3 5 6) (4 6) (5) (6)) hashq)) |