nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

utils: Add 'ensure-keyword-arguments'. 

* guix/utils.scm (delkw, ensure-keyword-arguments): New procedures.
* tests/utils.scm ("ensure-keyword-arguments"): New test.
This commit is contained in:
Ludovic Courtès 2016-01-06 22:42:09 +01:00
parent 793a43f409
commit 6071122b71
2 changed files with 50 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
guix/utils.scm
View File

@ -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

10
tests/utils.scm
View File

@ -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))