summary refs log tree commit diff
diff options
context:
space:
mode:
authorLeah Neukirchen <leah@vuxu.org>2022-12-16 00:21:29 +0100
committerLeah Neukirchen <leah@vuxu.org>2022-12-16 00:22:47 +0100
commit8580001ef44f7a8da3b97c439473cb204a0e34f5 (patch)
tree0322f785becd4137f8e2c0b9dca34694a3140e8f
parent28ad4b62515325463656627fa3d80a984f8c0fdb (diff)
downloadmew-8580001ef44f7a8da3b97c439473cb204a0e34f5.tar.gz
mew-8580001ef44f7a8da3b97c439473cb204a0e34f5.tar.xz
mew-8580001ef44f7a8da3b97c439473cb204a0e34f5.zip
add for/into
-rw-r--r--mew.el2
-rw-r--r--mew.scm14
-rw-r--r--mew.svnwiki4
-rw-r--r--tests/test.mew6
4 files changed, 25 insertions, 1 deletions
diff --git a/mew.el b/mew.el
index 888032d..a635f2c 100644
--- a/mew.el
+++ b/mew.el
@@ -12,6 +12,8 @@
 (put 'until 'scheme-indent-function 1)
 
 (put 'if 'scheme-indent-function 1)
+(put 'for 'scheme-indent-function 1)
+(put 'for/into 'scheme-indent-function 2)
 (put 'match 'scheme-indent-function 1)
 (put 'accumulate 'scheme-indent-function 1)
 
diff --git a/mew.scm b/mew.scm
index 17be96d..7707851 100644
--- a/mew.scm
+++ b/mew.scm
@@ -5,7 +5,7 @@
      comp cross-product
      dec def del-at div dup
      empty? eof esc
-     fail fin final for fun*
+     fail fin final for for/into fun*
      gconcatenate gen generator-xfold generic-for-each genumerate get
      gfix giterate gmatch gpick group-by-accumulator gslice-when
      gsplit gsplit-on gwindow
@@ -435,6 +435,18 @@
        (let ((o obj))
          ((generic-for-each o) (match-lambda (i body ...)) o)))))
 
+  (define-syntax for-into-regroup
+    (syntax-rules ()
+      ((_ acc () ((i obj) ...) body ...)
+       (into acc (gmap (match-lambda* ((i ...) body ...)) (gen obj) ...)))
+      ((_ acc (i obj rest ...) (j ...) body ...)
+       (for-into-regroup acc (rest ...) (j ... (i obj)) body ...))))
+
+  (define-syntax for/into
+    (syntax-rules ()
+      ((_ acc (rest ...) body ...)
+       (for-into-regroup acc (rest ...) () body ...))))
+
   (define (eof) #!eof)
 
   (define (void? x)
diff --git a/mew.svnwiki b/mew.svnwiki
index 958da33..0099046 100644
--- a/mew.svnwiki
+++ b/mew.svnwiki
@@ -388,6 +388,7 @@ up to a level of {{<depth>}}, or infinitely by default.
 
 <syntax>(for (<var> <obj> ...) <body>...)</syntax>
 <syntax>(for ((<key> . <val>) <tbl> ...) <body>...)</syntax>
+<syntax>(for/into <acc> (<var> <obj> ...) <body>...)</syntax>
 
 If {{<obj>}} is a list or a vector, iterate over its elements.
 If {{<obj>}} is a procedure, consider it a SRFI-158 generator
@@ -397,6 +398,9 @@ If {{<obj>}} is a hash-table, iterate over its keys and values.
 Multiple {{<var> <obj>}}-pairs may be specified, then {{for}}
 iterates over these in *parallel*, stopping after the shortest ends.
 
+The variant {{for/into}} accumulates the values of the {{<body>}}
+and returns the result of the accumulation.
+
 <procedure>(search <needle> <haystack> <offset>?)</procedure>
 
 Returns the offset of the sequence (string/list/vector) {{<needle>}}
diff --git a/tests/test.mew b/tests/test.mew
index 3aa70bb..b7e5da7 100644
--- a/tests/test.mew
+++ b/tests/test.mew
@@ -395,6 +395,12 @@
                   y (vector 6 7))
               (c x)))))
 
+(test-group "for/into"
+  (test '(4 5 6) (for/into '() (x (vector 3 4 5))
+                   (inc x)))
+  (test '#(#(3 6) #(4 7)) (for/into #() (x (vector 3 4 5)
+                                         y (vector 6 7))
+                            (vector x y))))
 
 (test-group "eof"
   (test-assert (eof-object? (eof))))