ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

utils: Support defaults in substitute-keyword-arguments.

Browse source 
* guix/utils.scm (collect-default-args, expand-default-args): New
syntax.
(substitute-keyword-arguments): Allow default value declarations.
* tests/utils.scm (substitute-keyword-arguments): New test.
This commit is contained in:
Eric Bavier 2016-09-20 15:41:31 -05:00
parent 347df60158
commit b8b129ebd8
No known key found for this signature in database
GPG key ID: 1EBBD204781F962C
2 changed files with 35 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
guix/utils.scm
View file

@ -375,13 +375,24 @@ (define (default-keyword-arguments args defaults)
(()
args))))
(define-syntax collect-default-args
(syntax-rules ()
((_)
'())
((_ (_ _) rest ...)
(collect-default-args rest ...))
((_ (kw _ dflt) rest ...)
(cons* kw dflt (collect-default-args rest ...)))))
(define-syntax substitute-keyword-arguments
(syntax-rules ()
"Return a new list of arguments where the value for keyword arg KW is
replaced by EXP. EXP is evaluated in a context where VAR is boud to the
previous value of the keyword argument."
((_ original-args ((kw var) exp) ...)
(let loop ((args original-args)
replaced by EXP. EXP is evaluated in a context where VAR is bound to the
previous value of the keyword argument, or DFLT if given."
((_ original-args ((kw var dflt ...) exp) ...)
(let loop ((args (default-keyword-arguments
original-args
(collect-default-args (kw var dflt ...) ...)))
(before '()))
(match args
((kw var rest (... ...))

20
tests/utils.scm
View file

@ -123,6 +123,26 @@ (define temp-file
(default-keyword-arguments '(#:bar 3) '(#:foo 2))
(default-keyword-arguments '(#:foo 2 #:bar 3) '(#:bar 6))))
(test-equal "substitute-keyword-arguments"
'((#:foo 3)
(#:foo 3)
(#:foo 3 #:bar (1 2))
(#:bar (1 2) #:foo 3)
(#:foo 3))
(list (substitute-keyword-arguments '(#:foo 2)
((#:foo f) (1+ f)))
(substitute-keyword-arguments '()
((#:foo f 2) (1+ f)))
(substitute-keyword-arguments '(#:foo 2 #:bar (2))
((#:foo f) (1+ f))
((#:bar b) (cons 1 b)))
(substitute-keyword-arguments '(#:foo 2)
((#:foo _) 3)
((#:bar b '(2)) (cons 1 b)))
(substitute-keyword-arguments '(#:foo 2)
((#:foo f 1) (1+ f))
((#:bar b) (cons 42 b)))))
(test-assert "filtered-port, file"
(let* ((file (search-path %load-path "guix.scm"))
(input (open-file file "r0b")))