neach generalization

basis/generalizations/generalizations-docs.factor

@@ -236,6 +236,10 @@ HELP: nspread
 { $description "A generalization of " { $link spread } " that can work for any quotation arity."
 } ;
 
+HELP: neach
+{ $values { "n" integer } }
+{ $description "A generalization of " { $link each } ", " { $link 2each } ", and " { $link 3each } " that can iterate over any number of sequences in parallel." } ;
+
 HELP: mnswap
 { $values { "m" integer } { "n" integer } }
 { $description "Swaps the top " { $snippet "m" } " stack elements with the " { $snippet "n" } " elements directly underneath." }
@@ -345,6 +349,7 @@ ARTICLE: "combinator-generalizations" "Generalized combinators"
     napply
     ncleave
     nspread
+    neach
 } ;
 
 ARTICLE: "other-generalizations" "Additional generalizations"

basis/generalizations/generalizations-tests.factor

@@ -1,5 +1,5 @@
 USING: tools.test generalizations kernel math arrays sequences
-ascii fry math.parser ;
+ascii fry math.parser io io.streams.string ;
 IN: generalizations.tests
 
 { 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test
@@ -79,3 +79,18 @@ IN: generalizations.tests
 [ 1 2 3 4 1 2 3 ] [ nover-test ] unit-test
 
 [ '[ number>string _ append ] 4 napply ] must-infer
+
+: neach-test ( a b c d -- )
+    [ 4 nappend print ] 4 neach ;
+
+[ """A1a!
+B2b@
+C3c#
+D4d$
+""" ] [
+    { "A" "B" "C" "D" }
+    { "1" "2" "3" "4" }
+    { "a" "b" "c" "d" }
+    { "!" "@" "#" "$" }
+    [ neach-test ] with-string-writer
+] unit-test

basis/generalizations/generalizations.factor

@@ -2,7 +2,7 @@
 ! Cavazos, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences sequences.private math combinators
-macros quotations fry effects memoize.private ;
+macros math.order quotations fry effects memoize.private ;
 IN: generalizations
 
 <<
@@ -116,3 +116,17 @@ MACRO: nbi-curry ( n -- )
 
 MACRO: nspin ( n -- )
     [ [ ] ] swap [ swap [ ] curry compose ] n*quot [ call ] 3append ;
+
+MACRO: nmin-length ( n -- )
+    dup 1 - [ min ] n*quot
+    '[ [ length ] _ napply @ ] ;
+
+MACRO: nnth-unsafe ( n -- )
+    '[ [ '[ _ nth-unsafe ] keep ] _ napply drop ] ;
+
+MACRO: (neach) ( n -- )
+    dup dup dup
+    '[ [ [ _ nmin-length ] _ nkeep [ _ nnth-unsafe ] _ ncurry ] dip compose ] ;
+
+: neach ( ... seq quot n -- )
+    (neach) each-integer ; inline