diff options
| -rw-r--r-- | ccwl/utils.scm | 32 | ||||
| -rw-r--r-- | tests/utils.scm | 15 |
2 files changed, 42 insertions, 5 deletions
diff --git a/ccwl/utils.scm b/ccwl/utils.scm index 4be2fe7..f7c1e14 100644 --- a/ccwl/utils.scm +++ b/ccwl/utils.scm @@ -144,7 +144,16 @@ while that for n-ary arguments is the empty list. For example, ((lambda** (foo bar #:key aal vale (pal 9) #:key* naal (irandu 7) (sol 3 2 1) uruthi) (list foo bar aal vale pal naal irandu sol uruthi)) 1 2 #:vale 123 #:naal 321 456) -=> (1 2 #f 123 9 (321 456) (7) (3 2 1) ())" +=> (1 2 #f 123 9 (321 456) (7) (3 2 1) ()) + +Like lambda*, lambda** supports #:allow-other-keys. For example, + +((lambda** (#:key foo #:allow-other-keys) + foo) + #:foo 1 #:bar 2) +=> 1 + +However, #:optional and #:rest are not supported." (syntax-case x () ((_ (args-spec ...) body ...) #`(lambda args @@ -154,7 +163,8 @@ while that for n-ary arguments is the empty list. For example, (unary-arguments (or (plist-ref grouped-rest #:key) (list))) (nary-arguments (or (plist-ref grouped-rest #:key*) - (list)))) + (list))) + (allow-other-keys? (plist-ref grouped-rest #:allow-other-keys))) (for-each (lambda (keyword) (unless (memq keyword (list #:key #:key* #:allow-other-keys)) (scm-error 'misc-error @@ -170,7 +180,10 @@ while that for n-ary arguments is the empty list. For example, ((arg defaults ...) #'(arg (list defaults ...))) (arg #'(arg '())))) - nary-arguments)) + nary-arguments) + (if allow-other-keys? + (list #:allow-other-keys) + (list))) body ...) (let ((positionals rest (break keyword? args))) (append positionals @@ -191,13 +204,22 @@ while that for n-ary arguments is the empty list. For example, #'1 #'2 #'#:foo #'123 #'#:bar #'1 #'2 #'3) => (#'1 #'2 #'123 (#'1 #'2 #'3)) -Just like lambda**, syntax-lambda** also supports default values for +Like lambda**, syntax-lambda** supports default values for arguments. For example, ((syntax-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))" +=> (#'1 #'2 #'123 9 (#'321 #'456) (7) (3 2 1)) + +Like lambda**, syntax-lambda** supports #:allow-other-keys. + +((syntax-lambda** (#:key foo #:allow-other-keys) + foo) + #'#:foo #'1 #'#:bar #'2) +=> #'1 + +#:optional and #:rest are not supported." (lambda args (apply (lambda** formal-args body ...) (unsyntax-keywords args)))) diff --git a/tests/utils.scm b/tests/utils.scm index a123719..3c8fac4 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -85,6 +85,12 @@ '(lambda** (#:key foo #:foo bar) foo))) +(test-equal "Allow other keys in lambda**" + 1 + ((lambda** (#:key foo #:allow-other-keys) + foo) + #:foo 1 #:bar 2)) + (test-assert "syntax-lambda**" (equal? (list #'1 #'2 #'123 (list #'1 #'2 #'3)) ((syntax-lambda** (a b #:key foo #:key* bar) @@ -97,6 +103,15 @@ (list foo aal vale pal naal irandu sol)) #'1 #'2 #'#:vale #'123 #'#:naal #'321 #'456))) +;; We cannot use test-equal to compare syntax objects, since +;; test-equal does not preserve the lexical contexts of the test +;; expressions. +(test-assert "Allow other keys in syntax-lambda**" + (equal? #'1 + ((syntax-lambda** (#:key foo #:allow-other-keys) + foo) + #'#:foo #'1 #'#:bar #'2))) + (test-equal "filter-mapi" '(1 3 5 7 9) (filter-mapi (lambda (item index) |