diff options
author | Leah Neukirchen <leah@vuxu.org> | 2022-11-19 23:20:46 +0100 |
---|---|---|
committer | Leah Neukirchen <leah@vuxu.org> | 2022-11-19 23:20:46 +0100 |
commit | aff9a08de8df4d050ff0bcb007c25dcb30997327 (patch) | |
tree | f16938bc87599f779b506ce3a9608ef603adfecb | |
parent | a06b95c052b4e70fe6fe61f7d90874fb6be00b56 (diff) | |
download | mew-aff9a08de8df4d050ff0bcb007c25dcb30997327.tar.gz mew-aff9a08de8df4d050ff0bcb007c25dcb30997327.tar.xz mew-aff9a08de8df4d050ff0bcb007c25dcb30997327.zip |
proj: allow multiple arguments
-rw-r--r-- | mew.scm | 17 | ||||
-rw-r--r-- | mew.svnwiki | 5 | ||||
-rw-r--r-- | tests/test.mew | 2 |
3 files changed, 16 insertions, 8 deletions
diff --git a/mew.scm b/mew.scm index 7870656..97ff476 100644 --- a/mew.scm +++ b/mew.scm @@ -864,12 +864,17 @@ (apply and=> result (cdr fs))))))) (define-syntax proj - (syntax-rules () - ((_ 0) (lambda (a . args) a)) - ((_ 1) (lambda (a b . args) b)) - ((_ 2) (lambda (a b c . args) c)) - ((_ 3) (lambda (a b c d . args) d)) - ((_ n) (lambda args (list-ref args n))))) + (er-macro-transformer + (lambda (expr rename compare) + (let* ((items (cdr expr)) + (max-n (if (null? items) 0 (+ 1 (apply max items)))) + (args (list-tabulate max-n + (lambda (n) + (string->symbol + (string-append "x" + (number->string n))))))) + `(,(rename 'lambda) (,@args . rest) + (,(rename 'values) ,@(map (lambda (n) (list-ref args n)) items))))))) (define (fail exn . args) (if (list? exn) diff --git a/mew.svnwiki b/mew.svnwiki index e3cabdb..7fd2d57 100644 --- a/mew.svnwiki +++ b/mew.svnwiki @@ -182,9 +182,10 @@ added implicitly at the end. {{(op* - 0 ... 2)}} is the function that subtracts all its arguments from 0 and finally 2. -<syntax>(proj <N>)</syntax> +<syntax>(proj <N>...)</syntax> -Expands to a function that returns its {{<N>}}th argument. +Expands to a function that returns its {{<N>}}th argument (zero indexed). +Multiple arguments are returned as multiple values. <procedure>(boolean <obj>)</procedure> diff --git a/tests/test.mew b/tests/test.mew index 52de20a..9220312 100644 --- a/tests/test.mew +++ b/tests/test.mew @@ -508,6 +508,8 @@ (test 1 ((proj 0) 1 2 3)) (test 2 ((proj 1) 1 2 3)) (test 3 ((proj 2) 1 2 3)) + (test '(3 2) (receive ((proj 2 1) 1 2 3))) + (test '() (receive ((proj) 1 2 3))) (test-error ((proj 4) 1 2 3))) (test-group "fail" |