kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

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 @@ keywords not already present in ARGS."
(()
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 @@
(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")))