aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ccwl/utils.scm25
-rw-r--r--tests/utils.scm6
2 files changed, 28 insertions, 3 deletions
diff --git a/ccwl/utils.scm b/ccwl/utils.scm
index b4e167e..14b1c0a 100644
--- a/ccwl/utils.scm
+++ b/ccwl/utils.scm
@@ -135,7 +135,15 @@ for example, be invoked as:
(list a b foo bar))
1 2 #:foo 123 #:bar 1 2 3)
-=> (1 2 123 (1 2 3))"
+=> (1 2 123 (1 2 3))
+
+lambda** also supports default values for both unary and n-ary keyword
+arguments. For example,
+
+((lambda** (foo aal #:key vale (pal 9) #:key* naal (irandu 7) (sol 3 2 1))
+ (list foo aal vale pal naal irandu sol))
+ 1 2 #:vale 123 #:naal 321 456)
+=> (1 2 123 9 (321 456) (7) (3 2 1))"
(syntax-case x ()
((_ (args-spec ...) body ...)
#`(lambda args
@@ -147,12 +155,23 @@ for example, be invoked as:
(nary-arguments (or (plist-ref grouped-rest #:key*)
(list))))
#`(apply (lambda* #,(append positionals
- (cons #:key (append unary-arguments nary-arguments)))
+ (cons #:key unary-arguments)
+ (map (lambda (x)
+ (syntax-case x ()
+ ((arg defaults ...)
+ #'(arg (list defaults ...)))
+ (arg #'arg)))
+ nary-arguments))
body ...)
(let ((positionals rest (break keyword? args)))
(append positionals
(group-keyword-arguments
- rest (list #,@(map (compose symbol->keyword syntax->datum)
+ rest (list #,@(map (lambda (x)
+ (symbol->keyword
+ (syntax->datum
+ (syntax-case x ()
+ ((arg default) #'arg)
+ (arg #'arg)))))
unary-arguments))))))))))))
(define-syntax-rule (syntax-lambda** formal-args body ...)
diff --git a/tests/utils.scm b/tests/utils.scm
index 6b38708..473bd45 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -64,6 +64,12 @@
(list a b foo bar))
1 2 #:foo 123 #:bar 1 2 3))
+(test-equal "lambda** with default values"
+ '(1 2 123 9 (321 456) (7) (3 2 1))
+ ((lambda** (foo aal #:key vale (pal 9) #:key* naal (irandu 7) (sol 3 2 1))
+ (list foo aal vale pal naal irandu sol))
+ 1 2 #:vale 123 #:naal 321 456))
+
(test-assert "syntax-lambda**"
(equal? (list #'1 #'2 #'123 (list #'1 #'2 #'3))
((syntax-lambda** (a b #:key foo #:key* bar)