From aff9a08de8df4d050ff0bcb007c25dcb30997327 Mon Sep 17 00:00:00 2001
From: Leah Neukirchen <leah@vuxu.org>
Date: Sat, 19 Nov 2022 23:20:46 +0100
Subject: proj: allow multiple arguments

---
 mew.scm        | 17 +++++++++++------
 mew.svnwiki    |  5 +++--
 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"
-- 
cgit 1.4.1