diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor index cc559ca76e..5df2008e74 100644 --- a/basis/generalizations/generalizations-docs.factor +++ b/basis/generalizations/generalizations-docs.factor @@ -237,9 +237,17 @@ HELP: nspread } ; HELP: neach -{ $values { "n" integer } } +{ $values { "...seq" "a set of " { $snippet "n" } " sequences" } { "quot" "a quotation with stack effect " { $snippet "( ...element -- )" } } { "n" integer } } { $description "A generalization of " { $link each } ", " { $link 2each } ", and " { $link 3each } " that can iterate over any number of sequences in parallel." } ; +HELP: nmap +{ $values { "...seq" "a set of " { $snippet "n" } " sequences" } { "quot" "a quotation with stack effect " { $snippet "( ...element -- result )" } } { "n" integer } { "result" "a sequence of the same type as the first " { $snippet "seq" } } } +{ $description "A generalization of " { $link map } ", " { $link 2map } ", and " { $link 3map } " that can map over any number of sequences in parallel." } ; + +HELP: nmap-as +{ $values { "...seq" "a set of " { $snippet "n" } " sequences" } { "quot" "a quotation with stack effect " { $snippet "( ...element -- result )" } } { "exemplar" sequence } { "n" integer } { "result" "a sequence of the same type as " { $snippet "exemplar" } } } +{ $description "A generalization of " { $link map-as } ", " { $link 2map-as } ", and " { $link 3map-as } " that can map 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." } @@ -350,6 +358,8 @@ ARTICLE: "combinator-generalizations" "Generalized combinators" ncleave nspread neach + nmap + nmap-as } ; ARTICLE: "other-generalizations" "Additional generalizations" diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor index 2c957fefdf..3ae504a33d 100644 --- a/basis/generalizations/generalizations-tests.factor +++ b/basis/generalizations/generalizations-tests.factor @@ -82,6 +82,10 @@ IN: generalizations.tests : neach-test ( a b c d -- ) [ 4 nappend print ] 4 neach ; +: nmap-test ( a b c d -- e ) + [ 4 nappend ] 4 nmap ; +: nmap-as-test ( a b c d -- e ) + [ 4 nappend ] [ ] 4 nmap-as ; [ """A1a! B2b@ @@ -94,3 +98,21 @@ D4d$ { "!" "@" "#" "$" } [ neach-test ] with-string-writer ] unit-test + +[ { "A1a!" "B2b@" "C3c#" "D4d$" } ] +[ + { "A" "B" "C" "D" } + { "1" "2" "3" "4" } + { "a" "b" "c" "d" } + { "!" "@" "#" "$" } + nmap-test +] unit-test + +[ [ "A1a!" "B2b@" "C3c#" "D4d$" ] ] +[ + { "A" "B" "C" "D" } + { "1" "2" "3" "4" } + { "a" "b" "c" "d" } + { "!" "@" "#" "$" } + nmap-as-test +] unit-test diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index 38f8e29da3..d98cc0afa3 100644 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -128,5 +128,11 @@ MACRO: (neach) ( n -- ) dup dup dup '[ [ [ _ nmin-length ] _ nkeep [ _ nnth-unsafe ] _ ncurry ] dip compose ] ; -: neach ( ... seq quot n -- ) +: neach ( ...seq quot n -- ) (neach) each-integer ; inline + +: nmap-as ( ...seq quot exemplar n -- result ) + '[ _ (neach) ] dip map-integers ; inline + +: nmap ( ...seq quot n -- result ) + dup '[ [ _ npick ] dip swap ] dip nmap-as ; inline