On Sat, 24 Sep 2016 11:21:40 +0900
l...@gnu.org (Ludovic Courtès) wrote:
>
> > +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."
> > + (syntax-case x ()
> > + ((_ original-args ((kw var dflt ...) exp) ...)
> > + #`(let loop ((args (default-keyword-arguments
> > + original-args
> > + (list #,@(append-map (match-lambda
> > + ((k) '())
> > + (x x))
> > + #'((kw dflt ...) ...)))))
> > + (before '()))
>
> I would prefer to stick to ‘syntax-rules’ when matching the clauses,
> with a helper macro:
Right, I was wanting to do that, but was having a difficult time
working with mixed cases, where some keywords are declared with a
default and others are not.
> But this would be a bonus;
How about this patch instead?
`~Eric
From 9481121fef60f0c3f4ea0f742d77336906771167 Mon Sep 17 00:00:00 2001
From: Eric Bavier <bav...@member.fsf.org>
Date: Tue, 20 Sep 2016 15:41:31 -0500
Subject: [PATCH] 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 | 29 +++++++++++++++++++++++++----
tests/utils.scm | 20 ++++++++++++++++++++
2 files changed, 45 insertions(+), 4 deletions(-)
diff --git a/guix/utils.scm b/guix/utils.scm
index ded3114..cbad4ea 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -375,13 +375,34 @@ keywords not already present in ARGS."
(()
args))))
+(define-syntax collect-default-args
+ (syntax-rules ()
+ ((_ (_ _))
+ (list))
+ ((_ (kw _ dflt))
+ (list kw dflt))
+ ((_ (_ _) rest ...)
+ (collect-default-args rest ...))
+ ((_ (kw _ dflt) rest ...)
+ (cons* kw dflt (collect-default-args rest ...)))))
+
+(define-syntax expand-default-args
+ (syntax-rules ()
+ ((_ original-args (kw var) ...)
+ original-args)
+ ((_ original-args clause ...)
+ (default-keyword-arguments
+ original-args
+ (collect-default-args clause ...)))))
+
(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 (expand-default-args original-args
+ (kw var dflt ...) ...))
(before '()))
(match args
((kw var rest (... ...))
diff --git a/tests/utils.scm b/tests/utils.scm
index 960928c..bcfaa14 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -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")))
--
2.9.2
