add proj

3 files changed, 19 insertions, 1 deletions

diff --git a/mew.scm b/mew.scm
index 31ad492..7fc161a 100644
--- a/mew.scm
+++ b/mew.scm
@@ -15,7 +15,7 @@
      mod
      negate
      one-of op op*
-     per prn puts
+     per prn proj puts
      range rep
      sing? seq set set-at str slurp
      tally-accumulator tbl time
@@ -740,6 +740,14 @@
   (define (act x . fs)
     ((apply per fs) x))
 
+  (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)))))
+
   (let ((old-repl-prompt (repl-prompt)))
     (repl-prompt (lambda ()
                    (let ((old-prompt (old-repl-prompt)))
diff --git a/mew.svnwiki b/mew.svnwiki
index cf0ecd3..4549f7b 100644
--- a/mew.svnwiki
+++ b/mew.svnwiki
@@ -167,6 +167,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>
+
+Expands to a function that returns its {{<N>}}th argument.
+
 <procedure>(boolean <obj>)</procedure>
 
 Return false if {{<obj>}} is {{#f}}, and true else.
diff --git a/tests/test.mew b/tests/test.mew
index feaf357..9cbef3e 100644
--- a/tests/test.mew
+++ b/tests/test.mew
@@ -444,4 +444,10 @@
   (test #t (void? (void)))
   (test #t (void? (if #f #f))))
 
+(test-group "proj"
+  (test 1 ((proj 0) 1 2 3))
+  (test 2 ((proj 1) 1 2 3))
+  (test 3 ((proj 2) 1 2 3))
+  (test-error ((proj 4) 1 2 3)))
+
 (test-exit)