From 347df60158a11abbc9b84ac36cd113362d7e09e0 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Thu, 1 Sep 2016 08:20:25 -0500 Subject: utils: Fix default-keyword-arguments. * guix/utils.scm (default-keyword-arguments): Properly test for present keywords. * tests/utils.scm (default-keyword-arguments): New test. --- tests/utils.scm | 12 ++++++++++++ 1 file changed, 12 insertions(+) (limited to 'tests') diff --git a/tests/utils.scm b/tests/utils.scm index 6590ed91cf..960928c842 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -111,6 +111,18 @@ (define temp-file (ensure-keyword-arguments '(#:foo 2) '(#:bar 3)) (ensure-keyword-arguments '(#:foo 2) '(#:bar 3 #:foo 42)))) +(test-equal "default-keyword-arguments" + '((#:foo 2) + (#:foo 2) + (#:foo 2 #:bar 3) + (#:foo 2 #:bar 3) + (#:foo 2 #:bar 3)) + (list (default-keyword-arguments '() '(#:foo 2)) + (default-keyword-arguments '(#:foo 2) '(#:foo 4)) + (default-keyword-arguments '() '(#:bar 3 #:foo 2)) + (default-keyword-arguments '(#:bar 3) '(#:foo 2)) + (default-keyword-arguments '(#:foo 2 #:bar 3) '(#:bar 6)))) + (test-assert "filtered-port, file" (let* ((file (search-path %load-path "guix.scm")) (input (open-file file "r0b"))) -- cgit v1.2.3 From b8b129ebd8d017c957094f3d977a1c452d7d450f Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Tue, 20 Sep 2016 15:41:31 -0500 Subject: utils: Support defaults in substitute-keyword-arguments. * 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. --- guix/utils.scm | 19 +++++++++++++++---- tests/utils.scm | 20 ++++++++++++++++++++ 2 files changed, 35 insertions(+), 4 deletions(-) (limited to 'tests') diff --git a/guix/utils.scm b/guix/utils.scm index ded31142aa..decadf64a6 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -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 (... ...)) diff --git a/tests/utils.scm b/tests/utils.scm index 960928c842..bcfaa14faa 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -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"))) -- cgit v1.2.3