diff mbox

[2/2] utils: Support defaults in substitute-keyword-arguments.

Message ID 20160925230823.3782ff7b@openmailbox.org
State New
Headers show

Commit Message

Eric Bavier Sept. 26, 2016, 4:08 a.m. UTC 
On Sat, 24 Sep 2016 11:21:40 +0900
ludo@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

Comments

Ludovic Courtès Sept. 30, 2016, 8:24 p.m. UTC | #1 
Eric Bavier <ericbavier@openmailbox.org> skribis:

> On Sat, 24 Sep 2016 11:21:40 +0900
> ludo@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:

[...]

> From 9481121fef60f0c3f4ea0f742d77336906771167 Mon Sep 17 00:00:00 2001
> From: Eric Bavier <bavier@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.

[...]

> +(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 ...)))))

I think you just need the base case (zero args), the default-value case,
and the no-default-value case:

  (define-syntax collect-default-args
    (syntax-rules ()
      ((_)   ;done
       '())
      ((_ (kw var) rest ...)
       (collect-default-args rest ...))
      ((_ (kw var 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 ...)))))

AFAICS this macro can be removed altogether.

OK with changes along these lines, thanks!

Ludo’.
diff mbox

Patch

From 9481121fef60f0c3f4ea0f742d77336906771167 Mon Sep 17 00:00:00 2001
From: Eric Bavier <bavier@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